neighbor list selection tuning bugfix from Stan

also consistently use memory->destroy() and memory->create()
and not mix it with memory->sfree() and memory->smalloc()

cmake/CMakeLists.txt

@@ -474,13 +474,13 @@ if(BUILD_OMP)
   if(CMAKE_VERSION VERSION_LESS 3.28)
     get_filename_component(_exe "${CMAKE_CXX_COMPILER}" NAME)
     if((CMAKE_CXX_COMPILER_ID STREQUAL "Clang") AND (_exe STREQUAL "crayCC"))
-      set(CMAKE_SHARED_LINKER_FLAGS_${BTYPE} "${CMAKE_SHARED_LINKER_FLAGS_${BTYPE} -fopenmp")
-      set(CMAKE_STATIC_LINKER_FLAGS_${BTYPE} "${CMAKE_STATIC_LINKER_FLAGS_${BTYPE} -fopenmp")
+      set(CMAKE_SHARED_LINKER_FLAGS_${BTYPE} "${CMAKE_SHARED_LINKER_FLAGS_${BTYPE}} -fopenmp")
+      set(CMAKE_STATIC_LINKER_FLAGS_${BTYPE} "${CMAKE_STATIC_LINKER_FLAGS_${BTYPE}} -fopenmp")
     endif()
   else()
     if(CMAKE_CXX_COMPILER_ID STREQUAL "CrayClang")
-      set(CMAKE_SHARED_LINKER_FLAGS_${BTYPE} "${CMAKE_SHARED_LINKER_FLAGS_${BTYPE} -fopenmp")
-      set(CMAKE_STATIC_LINKER_FLAGS_${BTYPE} "${CMAKE_STATIC_LINKER_FLAGS_${BTYPE} -fopenmp")
+      set(CMAKE_SHARED_LINKER_FLAGS_${BTYPE} "${CMAKE_SHARED_LINKER_FLAGS_${BTYPE}} -fopenmp")
+      set(CMAKE_STATIC_LINKER_FLAGS_${BTYPE} "${CMAKE_STATIC_LINKER_FLAGS_${BTYPE}} -fopenmp")
     endif()
   endif()
 endif()
@@ -515,12 +515,20 @@ if(PKG_ATC OR PKG_AWPMD OR PKG_ML-QUIP OR PKG_ML-POD OR PKG_ELECTRODE OR BUILD_T
   endif()
 endif()
 
-find_package(CURL QUIET COMPONENTS HTTP HTTPS)
+find_package(CURL QUIET)
 option(WITH_CURL "Enable libcurl support" ${CURL_FOUND})
 if(WITH_CURL)
-  find_package(CURL REQUIRED COMPONENTS HTTP HTTPS)
   target_compile_definitions(lammps PRIVATE -DLAMMPS_CURL)
-  target_link_libraries(lammps PRIVATE CURL::libcurl)
+
+  # need to use pkgconfig for fully static bins to find custom static libs
+  if (CMAKE_SYSTEM_NAME STREQUAL "LinuxMUSL")
+    include(FindPkgConfig)
+    pkg_check_modules(CURL IMPORTED_TARGET libcurl libssl libcrypto)
+    target_link_libraries(lammps PUBLIC PkgConfig::CURL)
+  else()
+    find_package(CURL REQUIRED)
+    target_link_libraries(lammps PRIVATE CURL::libcurl)
+  endif()
 endif()
 
 # tweak jpeg library names to avoid linker errors with MinGW cross-compilation
@@ -1078,12 +1086,15 @@ if(BUILD_TOOLS)
   message(STATUS "<<< Building Tools >>>")
 endif()
 if(BUILD_LAMMPS_GUI)
-  message(STATUS "<<< Building LAMMPS GUI >>>")
+  message(STATUS "<<< Building LAMMPS-GUI >>>")
   if(LAMMPS_GUI_USE_PLUGIN)
     message(STATUS "Loading LAMMPS library as plugin at run time")
   else()
     message(STATUS "Linking LAMMPS library at compile time")
   endif()
+  if(BUILD_WHAM)
+    message(STATUS "<<< Building WHAM >>>")
+  endif()
 endif()
 if(ENABLE_TESTING)
   message(STATUS "<<< Building Unit Tests >>>")

cmake/Modules/Packages/GPU.cmake

@@ -189,7 +189,7 @@ if(GPU_API STREQUAL "CUDA")
   endif()
 
   add_executable(nvc_get_devices ${LAMMPS_LIB_SOURCE_DIR}/gpu/geryon/ucl_get_devices.cpp)
-  target_compile_definitions(nvc_get_devices PRIVATE -DUCL_CUDADR)
+  target_compile_definitions(nvc_get_devices PRIVATE -DUCL_CUDADR -DLAMMPS_${LAMMPS_SIZES})
   target_link_libraries(nvc_get_devices PRIVATE ${CUDA_LIBRARIES} ${CUDA_CUDA_LIBRARY})
   target_include_directories(nvc_get_devices PRIVATE ${CUDA_INCLUDE_DIRS})
 
@@ -489,7 +489,7 @@ else()
   target_link_libraries(gpu PRIVATE mpi_stubs)
 endif()
 
-target_compile_definitions(gpu PRIVATE -DLAMMPS_${LAMMPS_SIZES})
 set_target_properties(gpu PROPERTIES OUTPUT_NAME lammps_gpu${LAMMPS_MACHINE})
+target_compile_definitions(gpu PRIVATE -DLAMMPS_${LAMMPS_SIZES})
 target_sources(lammps PRIVATE ${GPU_SOURCES})
 target_include_directories(lammps PRIVATE ${GPU_SOURCES_DIR})

cmake/Modules/Packages/H5MD.cmake

@@ -3,7 +3,7 @@ enable_language(C)
 # we don't use the parallel i/o interface.
 set(HDF5_PREFER_PARALLEL FALSE)
 
-find_package(HDF5 REQUIRED)
+find_package(HDF5 COMPONENTS C REQUIRED)
 
 # parallel HDF5 will import incompatible MPI headers with a serial build
 if((NOT BUILD_MPI) AND HDF5_IS_PARALLEL)

cmake/Modules/Packages/ML-PACE.cmake

@@ -40,6 +40,13 @@ else()
     WORKING_DIRECTORY ${CMAKE_BINARY_DIR}
   )
   get_newest_file(${CMAKE_BINARY_DIR}/lammps-user-pace-* lib-pace)
+
+  # fixup yaml-cpp/emitterutils.cpp for GCC 15+ until patch is applied
+  file(READ ${lib-pace}/yaml-cpp/src/emitterutils.cpp yaml_emitterutils)
+  string(REPLACE "#include <sstream>" "#include <sstream>\n#include <cinttypes>" yaml_tmp_emitterutils "${yaml_emitterutils}")
+  string(REPLACE "#include <cinttypes>\n#include <cinttypes>" "#include <cinttypes>" yaml_emitterutils "${yaml_tmp_emitterutils}")
+  file(WRITE ${lib-pace}/yaml-cpp/src/emitterutils.cpp "${yaml_emitterutils}")
+
 endif()
 
 add_subdirectory(${lib-pace} build-pace)

cmake/Modules/Packages/VTK.cmake

@@ -1,3 +1,5 @@
+# FindVTK requires that C support is enabled when looking for MPI support
+enable_language(C)
 find_package(VTK REQUIRED NO_MODULE)
 target_compile_definitions(lammps PRIVATE -DLAMMPS_VTK)
 if (VTK_MAJOR_VERSION VERSION_LESS 9.0)

cmake/packaging/linux_wrapper.sh

@@ -7,6 +7,11 @@ export LC_ALL=C
 BASEDIR="$(dirname "$0")"
 EXENAME="$(basename "$0")"
 
+# save old settings (for restoring them later)
+OLDPATH="${PATH}"
+OLDLDLIB="${LD_LIBRARY_PATH}"
+
+# prepend path to find our custom executables
 PATH="${BASEDIR}/bin:${PATH}"
 
 # append to LD_LIBRARY_PATH to prefer local (newer) libs
@@ -15,6 +20,8 @@ LD_LIBRARY_PATH="${LD_LIBRARY_PATH}:${BASEDIR}/lib"
 # set some environment variables for LAMMPS etc.
 LAMMPS_POTENTIALS="${BASEDIR}/share/lammps/potentials"
 MSI2LMP_LIBRARY="${BASEDIR}/share/lammps/frc_files"
-export LD_LIBRARY_PATH LAMMPS_POTENTIALS MSI2LMP_LIBRARY PATH
+
+# export everything
+export LD_LIBRARY_PATH LAMMPS_POTENTIALS MSI2LMP_LIBRARY PATH OLDPATH OLDLDLIB
 
 exec "${BASEDIR}/bin/${EXENAME}" "$@"

cmake/packaging/xdg-open

@@ -33,6 +33,14 @@
 #
 #---------------------------------------------
 
+# restore previously saved environment variables, if available
+if [ -n "${OLDPATH}" ]
+then
+    PATH="${OLDPATH}"
+    LD_LIBRARY_PATH="${OLDLDLIB}"
+    export PATH LD_LIBRARY_PATH
+fi
+
 NEW_LIBRARY_PATH="/usr/local/lib64"
 for s in $(echo $LD_LIBRARY_PATH | sed -e 's/:/ /g')
 do \

cmake/presets/kokkos-cuda.cmake

@@ -1,10 +1,8 @@
 # preset that enables KOKKOS and selects CUDA compilation with OpenMP
-# enabled as well. This preselects CC 5.0 as default GPU arch, since
-# that is compatible with all higher CC, but not the default CC 3.5
+# enabled as well. The GPU architecture *must* match your hardware (If not manually set, Kokkos will try to autodetect it).
 set(PKG_KOKKOS ON CACHE BOOL "" FORCE)
 set(Kokkos_ENABLE_SERIAL ON CACHE BOOL "" FORCE)
 set(Kokkos_ENABLE_CUDA   ON CACHE BOOL "" FORCE)
-set(Kokkos_ARCH_PASCAL60 ON CACHE BOOL "" FORCE)
 set(BUILD_OMP ON CACHE BOOL "" FORCE)
 get_filename_component(NVCC_WRAPPER_CMD ${CMAKE_CURRENT_SOURCE_DIR}/../lib/kokkos/bin/nvcc_wrapper ABSOLUTE)
 set(CMAKE_CXX_COMPILER ${NVCC_WRAPPER_CMD} CACHE FILEPATH "" FORCE)

doc/src/Build_basics.rst

@@ -502,6 +502,8 @@ using CMake or Make.
                                       # chain.x, micelle2d.x, msi2lmp, phana,
                                       # stl_bin2txt
          -D BUILD_LAMMPS_GUI=value    # yes or no (default). Build LAMMPS-GUI
+         -D BUILD_WHAM=value          # yes (default). Download and build WHAM;
+                                      # only available for BUILD_LAMMPS_GUI=yes
 
       The generated binaries will also become part of the LAMMPS installation
       (see below).

doc/src/Howto_lammps_gui.rst

@@ -1,44 +1,45 @@
 Using LAMMPS-GUI
 ================
 
-This document describes **LAMMPS-GUI version 1.6**.
+.. image:: JPG/lammps-gui-banner.png
+   :align: center
+   :scale: 75%
+
+LAMMPS-GUI is a graphical text editor programmed using the `Qt Framework
+<https://www.qt.io/>`_ and customized for editing and running LAMMPS
+input files.  It is linked to the :ref:`LAMMPS library <lammps_c_api>`
+and thus can run LAMMPS directly using the contents of the editor's text
+buffer as input and without having to launch the LAMMPS executable.
+
+It *differs* from other known interfaces to LAMMPS in that it can
+retrieve and display information from LAMMPS *while it is running*,
+display visualizations created with the :doc:`dump image command
+<dump_image>`, can launch the online LAMMPS documentation for known
+LAMMPS commands and styles, and directly integrates with a collection
+of LAMMPS tutorials (:ref:`Gravelle1 <Gravelle1>`).
+
+This document describes **LAMMPS-GUI version 1.7**.
 
 -----
 
-LAMMPS-GUI is a graphical text editor customized for editing LAMMPS
-input files that is linked to the :ref:`LAMMPS library <lammps_c_api>`
-and thus can run LAMMPS directly using the contents of the editor's text
-buffer as input.  It can retrieve and display information from LAMMPS
-while it is running, display visualizations created with the :doc:`dump
-image command <dump_image>`, and is adapted specifically for editing
-LAMMPS input files through text completion and reformatting, and linking
-to the online LAMMPS documentation for known LAMMPS commands and styles.
+.. contents::
 
-.. note::
+----
 
-   Pre-compiled, ready-to-use LAMMPS-GUI executables for Linux x86\_64
-   (Ubuntu 20.04LTS or later and compatible), macOS (version 11 aka Big
-   Sur or later), and Windows (version 10 or later) :ref:`are available
-   <lammps_gui_install>` for download.  Non-MPI LAMMPS executables (as
-   ``lmp``) for running LAMMPS from the command line and :doc:`some
-   LAMMPS tools <Tools>` compiled executables are also included.
+LAMMPS-GUI aims to provide the traditional experience of running LAMMPS
+using a text editor, a command-line window, and launching the LAMMPS
+text-mode executable printing output to the screen, but just integrated
+into a single application:
 
-   The source code for LAMMPS-GUI is included in the LAMMPS source code
-   distribution and can be found in the ``tools/lammps-gui`` folder.  It
-   can be compiled alongside LAMMPS when :doc:`compiling with CMake
-   <Build_cmake>`.
+- Write and edit LAMMPS input files using the built-in text editor.
+- Run LAMMPS on those input file with command-line flags to enable a
+  specific accelerator package (or none).
+- Extract data from the created files (like trajectory files, log files
+  with thermodynamic data, or images) and visualize it using external
+  software.
 
-LAMMPS-GUI tries to provide an experience similar to what people
-traditionally would have running LAMMPS using a command line window and
-the console LAMMPS executable but just rolled into a single executable:
-
-- writing & editing LAMMPS input files with a text editor
-- run LAMMPS on those input file with selected command line flags
-- extract data from the created files and visualize it with and
-  external software
-
-That procedure is quite effective for people proficient in using the
-command line, as that allows them to use tools for the individual steps
+That traditional procedure is effective for people proficient in using the
+command-line, as it allows them to use the tools for the individual steps
 that they are most comfortable with.  In fact, it is often *required* to
 adopt this workflow when running LAMMPS simulations on high-performance
 computing facilities.
@@ -49,32 +50,69 @@ window or using external programs, let alone writing scripts to extract
 data from the generated output.  It also integrates well with graphical
 desktop environments where the `.lmp` filename extension can be
 registered with LAMMPS-GUI as the executable to launch when double
-clicking on such files.  Also, LAMMPS-GUI has support for drag-n-drop,
-i.e.  an input file can be selected and then moved and dropped on the
-LAMMPS-GUI executable, and LAMMPS-GUI will launch and read the file into
-its buffer.  In many cases LAMMPS-GUI will be integrated into the
-graphical desktop environment and can be launched like other
-applications.
+clicking on such files using a file manager.  LAMMPS-GUI also has
+support for 'drag and drop' for opening inputs: an input file can
+be selected and then moved and dropped on the LAMMPS-GUI executable;
+LAMMPS-GUI will launch and read the file into its buffer.  Input files
+also can be dropped into the editor window of the running LAMMPS-GUI
+application, which will close the current file and open the new file.
+In many cases LAMMPS-GUI will be integrated into the graphical desktop
+environment and can be launched just like any other applications from
+the graphical interface.
 
 LAMMPS-GUI thus makes it easier for beginners to get started running
-simple LAMMPS simulations.  It is very suitable for tutorials on LAMMPS
-since you only need to learn how to use a single program for most tasks
-and thus time can be saved and people can focus on learning LAMMPS.
-The tutorials at https://lammpstutorials.github.io/ are specifically
-updated for use with LAMMPS-GUI.
+LAMMPS and is well-suited for LAMMPS tutorials, since you only need to
+work with a single, ready-to-use program for most of the tasks.  Plus it
+is available for download as pre-compiled package for popular operating
+systems (Linux, macOS, Windows).  This saves time and allows users to
+focus on learning LAMMPS itself, without the need to learn how to
+compile LAMMPS, learn how to use the command line, or learn how to use a
+separate text editor.
 
-Another design goal is to keep the barrier low when replacing part of
-the functionality of LAMMPS-GUI with external tools.  That said, LAMMPS-GUI
-has some unique functionality that is not found elsewhere:
+The tutorials at https://lammpstutorials.github.io/ are specifically
+updated for use with LAMMPS-GUI and their tutorial materials can be
+downloaded and edited directly from within the GUI while automatically
+loading the matching tutorial instructions into a webbrowser.
+
+Yet the basic control flow remains similar to running LAMMPS from the
+command line, so the barrier for replacing parts of the functionality of
+LAMMPS-GUI with external tools is low.  That said, LAMMPS-GUI offer some
+unique features that are not easily found elsewhere:
 
 - auto-adapting to features available in the integrated LAMMPS library
-- interactive visualization using the :doc:`dump image <dump_image>`
+- auto-completion for available LAMMPS commands and options only
+- context-sensitive online help for known LAMMPS commands
+- start and stop of simulations via mouse or keyboard
+- monitoring of simulation progress and CPU use
+- interactive visualization using the LAMMPS :doc:`dump image feature <dump_image>`
   command with the option to copy-paste the resulting settings
-- automatic slide show generation from dump image out at runtime
-- automatic plotting of thermodynamics data at runtime
+- automatic slide show generation from dump image output at runtime
+- automatic plotting of thermodynamic data at runtime
 - inspection of binary restart files
+- integration will a set of LAMMPS tutorials
 
-The following text provides a detailed tour of the features and
+.. admonition:: Download LAMMPS-GUI for your platform
+   :class: Hint
+
+   Pre-compiled, ready-to-use LAMMPS-GUI executables for Linux x86\_64
+   (Ubuntu 20.04LTS or later and compatible), macOS (version 11 aka Big
+   Sur or later), and Windows (version 10 or later) :ref:`are available
+   <lammps_gui_install>` for download.  Non-MPI LAMMPS executables (as
+   ``lmp``) for running LAMMPS from the command-line and :doc:`some
+   LAMMPS tools <Tools>` compiled executables are also included.  Also,
+   the pre-compiled LAMMPS-GUI packages include the WHAM executables
+   from http://membrane.urmc.rochester.edu/content/wham/ for use with
+   LAMMPS tutorials documented in this paper (:ref:`Gravelle1
+   <Gravelle1>`).
+
+   The source code for LAMMPS-GUI is included in the LAMMPS source code
+   distribution and can be found in the ``tools/lammps-gui`` folder.  It
+   can be compiled alongside LAMMPS when :doc:`compiling with CMake
+   <Build_cmake>`.
+
+-----
+
+The following text provides a documentation of the features and
 functionality of LAMMPS-GUI.  Suggestions for new features and
 reports of bugs are always welcome.  You can use the :doc:`the same
 channels as for LAMMPS itself <Errors_bugs>` for that purpose.
@@ -84,9 +122,12 @@ channels as for LAMMPS itself <Errors_bugs>` for that purpose.
 Installing Pre-compiled LAMMPS-GUI Packages
 -------------------------------------------
 
-LAMMPS-GUI is available as pre-compiled binary packages for Linux
-x86\_64, macOS 11 and later, and Windows 10 and later.  Alternately, it
-can be compiled from source.
+LAMMPS-GUI is available for download as pre-compiled binary packages for
+Linux x86\_64 (Ubuntu 20.04LTS or later and compatible), macOS (version
+11 aka Big Sur or later), and Windows (version 10 or later) from the
+`LAMMPS release pages on GitHub <https://github.com/lammps/lammps/releases/>`_.
+A backup download location is at https://download.lammps.org/static/
+Alternately, LAMMPS-GUI can be compiled from source when building LAMMPS.
 
 Windows 10 and later
 ^^^^^^^^^^^^^^^^^^^^
@@ -100,10 +141,11 @@ MacOS 11 and later
 ^^^^^^^^^^^^^^^^^^
 
 After downloading the ``LAMMPS-macOS-multiarch-GUI-<version>.dmg``
-installer package, you need to double-click it and then, in the window
-that opens, drag the app bundle as indicated into the "Applications"
-folder.  The follow the instructions in the "README.txt" file to
-get access to the other included executables.
+application bundle disk image, you need to double-click it and then, in
+the window that opens, drag the app bundle as indicated into the
+"Applications" folder.  Afterwards, the disk image can be unmounted.
+Then follow the instructions in the "README.txt" file to get access to
+the other included command-line executables.
 
 Linux on x86\_64
 ^^^^^^^^^^^^^^^^
@@ -117,15 +159,25 @@ into the "LAMMPS_GUI" folder and execute "./lammps-gui" directly.
 
 The second variant uses `flatpak <https://www.flatpak.org>`_ and
 requires the flatpak management and runtime software to be installed.
-After downloading the ``LAMMPS-GUI-Linux-x86_64-GUI-<version>.tar.gz``
+After downloading the ``LAMMPS-GUI-Linux-x86_64-GUI-<version>.flatpak``
 flatpak bundle, you can install it with ``flatpak install --user
-LAMMPS-GUI-Linux-x86_64-GUI-<version>.tar.gz``.  After installation,
+LAMMPS-GUI-Linux-x86_64-GUI-<version>.flatpak``.  After installation,
 LAMMPS-GUI should be integrated into your desktop environment under
 "Applications > Science" but also can be launched from the console with
 ``flatpak run org.lammps.lammps-gui``.  The flatpak bundle also includes
 the console LAMMPS executable ``lmp`` which can be launched to run
-simulations with, for example: ``flatpak run --command=lmp
-org.lammps.lammps-gui -in in.melt``.
+simulations with, for example with:
+
+.. code-block:: sh
+
+   flatpak run --command=lmp org.lammps.lammps-gui -in in.melt
+
+Other bundled command-line executables are run the same way and can be
+listed with:
+
+.. code-block:: sh
+
+   ls $(flatpak info --show-location org.lammps.lammps-gui )/files/bin
 
 
 Compiling from Source
@@ -165,9 +217,9 @@ window is stored when exiting and restored when starting again.
 Opening Files
 ^^^^^^^^^^^^^
 
-The LAMMPS-GUI application can be launched without command line arguments
+The LAMMPS-GUI application can be launched without command-line arguments
 and then starts with an empty buffer in the *Editor* window.  If arguments
-are given LAMMPS will use first command line argument as the file name for
+are given LAMMPS will use first command-line argument as the file name for
 the *Editor* buffer and reads its contents into the buffer, if the file
 exists.  All further arguments are ignored.  Files can also be opened via
 the *File* menu, the `Ctrl-O` (`Command-O` on macOS) keyboard shortcut
@@ -197,8 +249,8 @@ editor buffer, which may contain multiple :doc:`run <run>` or
 
 LAMMPS runs in a separate thread, so the GUI stays responsive and is
 able to interact with the running calculation and access data it
-produces.  It is important to note that running LAMMPS this way is
-using the contents of the input buffer for the run (via the
+produces.  It is important to note that running LAMMPS this way is using
+the contents of the input buffer for the run (via the
 :cpp:func:`lammps_commands_string()` function of the LAMMPS C-library
 interface), and **not** the original file it was read from.  Thus, if
 there are unsaved changes in the buffer, they *will* be used.  As an
@@ -207,28 +259,55 @@ of a file from the *Run LAMMPS from File* menu entry or with
 `Ctrl-Shift-Enter`.  This option may be required in some rare cases
 where the input uses some functionality that is not compatible with
 running LAMMPS from a string buffer.  For consistency, any unsaved
-changes in the buffer must be either saved to the file or undone
-before LAMMPS can be run from a file.
+changes in the buffer must be either saved to the file or undone before
+LAMMPS can be run from a file.
+
+The line number of the currently executed command is highlighted in
+green in the line number display for the *Editor* Window.
 
 .. image:: JPG/lammps-gui-running.png
    :align: center
    :scale: 75%
 
-While LAMMPS is running, the contents of the status bar change.  On
-the left side there is a text indicating that LAMMPS is running, which
-also indicates the number of active threads, when thread-parallel
-acceleration was selected in the *Preferences* dialog.  On the right
+While LAMMPS is running, the contents of the status bar change.  The
+text fields that normally show "Ready." and the current working
+directory, change into an area showing the CPU utilization in percent.
+Nest to it is a text indicating that LAMMPS is running, which also
+indicates the number of active threads (in case thread-parallel
+acceleration was selected in the *Preferences* dialog).  On the right
 side, a progress bar is shown that displays the estimated progress for
 the current :doc:`run <run>` or :doc:`minimize <minimize>` command.
 
-Also, the line number of the currently executed command is highlighted
-in green.
+.. admonition:: CPU Utilization
+   :class: note
+
+   The CPU Utilization should ideally be close to 100% times the number
+   of threads like in the screenshot image above.  Since the GUI is
+   running as a separate thread, the CPU utilization can be higher, for
+   example when the GUI needs to work hard to keep up with the
+   simulation.  This can be caused by having frequent thermo output or
+   running a simulation of a small system.  In the *Preferences* dialog,
+   the polling interval for updating the the *Output* and *Charts*
+   windows can be set. The intervals may need to be lowered to not miss
+   data between *Charts* data updates or to avoid stalling when the
+   thermo output is not transferred to the *Output* window fast enough.
+   It is also possible to reduce the amount of data by increasing the
+   :doc:`thermo interval <thermo>`.  LAMMPS-GUI detects, if the
+   associated I/O buffer is by a significant percentage and will print a
+   warning after the run with suggested adjustments.  The utilization
+   can also be lower, e.g.  when the simulation is slowed down by the
+   GUI or other processes also running on the host computer and
+   competing with LAMMPS-GUI for GPU resources.
+
+   .. image:: JPG/lammps-gui-buffer-warn.png
+      :align: center
+      :scale: 75%
 
 If an error occurs (in the example below the command :doc:`label
 <label>` was incorrectly capitalized as "Label"), an error message
 dialog is shown and the line of the input which triggered the error is
-highlighted.  The state of LAMMPS in the status bar is set to "Failed."
-instead of "Ready."
+highlighted in red.  The state of LAMMPS in the status bar is set to
+"Failed."  instead of "Ready."
 
 .. image:: JPG/lammps-gui-run-error.png
    :align: center
@@ -261,14 +340,21 @@ Output Window
 
 By default, when starting a run, an *Output* window opens that displays
 the screen output of the running LAMMPS calculation, as shown below.
-This text would normally be seen in the command line window.
+This text would normally be seen in the command-line window.
 
 .. image:: JPG/lammps-gui-log.png
    :align: center
    :scale: 50%
 
 LAMMPS-GUI captures the screen output from LAMMPS as it is generated and
-updates the *Output* window regularly during a run.
+updates the *Output* window regularly during a run.  If there are any
+warnings or errors in the LAMMPS output, they are highlighted by using
+bold text colored in red.  There is a small panel at the bottom center
+of the *Output* window showing how many warnings and errors were
+detected and how many lines the entire output has.  By clicking on the
+button on the right with the warning symbol or by using the keyboard
+shortcut `Ctrl-N` (`Command-N` on macOS), you can jump to the next
+line with a warning or error.
 
 By default, the *Output* window is replaced each time a run is started.
 The runs are counted and the run number for the current run is displayed
@@ -308,27 +394,28 @@ plot of thermodynamic output of the LAMMPS calculation as shown below.
    :align: center
    :scale: 33%
 
-The drop down menu on the top right allows selection of different
-properties that are computed and written to thermo output.  Only one
-property can be shown at a time.  The plots are updated regularly with
-new data as the run progresses, so they can be used to visually monitor
-the evolution of available properties.  The update interval can be set
-in the *Preferences* dialog.  By default, the raw data for the selected
-property is plotted as a blue graph. As soon as there are a sufficient
-number of data points, there will be a second graph shown in red with a
-smoothed version of the data.  From the drop down menu on the top left,
-you can select whether to plot only the raw data, only the smoothed
-data or both.  The smoothing uses a `Savitzky-Golay convolution filter
-<https://en.wikipedia.org/wiki/Savitzky%E2%80%93Golay_filter>`_ The
-window width (left) and order (right) parameters can be set in the boxes
-next to the drop down menu.  Default settings are 10 and 4 which means
-that the smoothing window includes 10 points each to the left and the
-right of the current data point and a fourth order polynomial is fit to
-the data in the window.
+The "Data:" drop down menu on the top right allows selection of
+different properties that are computed and written as thermodynamic
+output to the output window.  Only one property can be shown at a time.
+The plots are updated regularly with new data as the run progresses, so
+they can be used to visually monitor the evolution of available
+properties.  The update interval can be set in the *Preferences* dialog.
+By default, the raw data for the selected property is plotted as a blue
+graph.  From the "Plot:" drop menu on the second row and on the left,
+you can select whether to plot only raw data graph, only a smoothed data
+graph, or both graphs on top of each other.  The smoothing process uses
+a `Savitzky-Golay convolution filter
+<https://en.wikipedia.org/wiki/Savitzky%E2%80%93Golay_filter>`_.  The
+convolution window width (left) and order (right) parameters can be set
+in the boxes next to the drop down menu.  Default settings are 10 and 4
+which means that the smoothing window includes 10 points each to the
+left and the right of the current data point for a total of 21 points
+and a fourth order polynomial is fitted to the data in the window.
 
-You can use the mouse to zoom into the graph (hold the left button and
-drag to mark an area) or zoom out (right click) and you can reset the
-view with a click to the "lens" button next to the data drop down menu.
+The "Title:" and "Y:" input boxes allow to edit the text shown as the
+plot title and the y-axis label, respectively.  The text entered in the
+"Title:" box is applied to *all* charts, while the "Y:" text changes
+only the y-axis label of the currently *selected* plot.
 
 The window title shows the current run number that this chart window
 corresponds to.  Same as for the *Output* window, the chart window is
@@ -356,6 +443,40 @@ here you get the compounded data set starting with the last change of
 output fields or timestep setting, while the export from the log will
 contain *all* YAML output but *segmented* into individual runs.
 
+The *Preferences* dialog has a *Charts* tab, where you can configure
+multiple chart-related settings, like the default title, colors for the
+graphs, default choice of the raw / smooth graph selection, and the
+default chart graph size.
+
+
+
+.. admonition:: Slowdown of Simulations from Charts Data Processing
+   :class: warning
+
+   Using frequent thermo output during long simulations can result in a
+   significant slowdown of that simulation since it is accumulating many
+   data points for each of the thermo properties in the chart window to
+   be redrawn with every update.  The updates are consuming additional
+   CPU time when smoothing enabled.  This slowdown can be confirmed when
+   an increasing percentage of the total run time is spent in the
+   "Output" or "Other" sections of the :doc:`MPI task timing breakdown
+   <Run_output>`.  It is thus recommended to use a large enough value as
+   argument `N` for the :doc:`thermo command <thermo>` and to select
+   plotting only the "Raw" data in the *Charts Window* during such
+   simulations.  It is always possible to switch between the different
+   display styles for charts during the simulation and after it has
+   finished.
+
+   .. versionchanged:: 1.7
+
+      As of LAMMPS-GUI version 1.7 the chart data processing is
+      significantly optimized compared to older versions of LAMMPS-GUI.
+      The general problem of accumulating excessive amounts of data
+      and the overhead of too frequently polling LAMMPS for new data
+      cannot be optimized away, though.  If necessary, the command
+      line LAMMPS executable needs to be used and the output accumulated
+      of a very fast disk (e.g. a high-performance SSD).
+
 Image Slide Show
 ----------------
 
@@ -398,7 +519,7 @@ below.
 Like for the *Output* and *Charts* windows, its content is continuously
 updated during a run.  It will show "(none)" if there are no variables
 defined.  Note that it is also possible to *set* :doc:`index style
-variables <variable>`, that would normally be set via command line
+variables <variable>`, that would normally be set via command-line
 flags, via the "Set Variables..." dialog from the *Run* menu.
 LAMMPS-GUI automatically defines the variable "gui_run" to the current
 value of the run counter.  That way it is possible to automatically
@@ -435,11 +556,11 @@ correspond to (via their mass) and then colorize them in the image and
 set their atom diameters accordingly.  If this is not possible, for
 instance when using reduced (= 'lj') :doc:`units <units>`, then
 LAMMPS-GUI will check the current pair style and if it is a
-Lennard-Jones type potential, it will extract the *sigma* parameter
-for each atom type and assign atom diameters from those numbers.
-For cases where atom diameters are not auto-detected, the *Atom size* field
-can be edited and a suitable value set manually. The default value
-is inferred from the x-direction lattice spacing.
+Lennard-Jones type potential, it will extract the *sigma* parameter for
+each atom type and assign atom diameters from those numbers.  For cases
+where atom diameters are not auto-detected, the *Atom size* field can be
+edited and a suitable value set manually. The default value is inferred
+from the x-direction lattice spacing.
 
 If elements cannot be detected the default sequence of colors of the
 :doc:`dump image <dump_image>` command is assigned to the different atom
@@ -454,22 +575,31 @@ types.
 |gui-image1|  |gui-image2|
 
 The default image size, some default image quality settings, the view
-style and some colors can be changed in the *Preferences* dialog
-window.  From the image viewer window further adjustments can be made:
-actual image size, high-quality (SSAO) rendering, anti-aliasing, view
-style, display of box or axes, zoom factor.  The view of the system can
-be rotated horizontally and vertically.  It is also possible to only
-display the atoms within a group defined in the input script (default is
-"all").  The image can also be re-centered on the center of mass of the
-selected group.  After each change, the image is rendered again and the
-display updated.  The small palette icon on the top left is colored
-while LAMMPS is running to render the new image; it is grayed out when
-LAMMPS is finished.  When there are many atoms to render and high
-quality images with anti-aliasing are requested, re-rendering may take
-several seconds.  From the *File* menu of the image window, the
-current image can be saved to a file (keyboard shortcut `Ctrl-S`) or
-copied to the clipboard (keyboard shortcut `Ctrl-C`) for pasting the
-image into another application.
+style and some colors can be changed in the *Preferences* dialog window.
+From the image viewer window further adjustments can be made: actual
+image size, high-quality (SSAO) rendering, anti-aliasing, view style,
+display of box or axes, zoom factor.  The view of the system can be
+rotated horizontally and vertically.
+
+It is also possible to display only the atoms within a :doc:`group
+defined in the input script <group>` (default is "all").  The available
+groups can be selected from the drop down list next to the "Group:"
+label.  Similarly, if there are :doc:`molecules defined in the input
+<molecule>`, it is possible to select one of them (default is "none")
+and visualize it (it will be shown at the center of the simulation box).
+While a molecule is selected, the group selection is disabled.  It can
+be restored by selecting the molecule "none".
+
+The image can also be re-centered on the center of mass of the selected
+group.  After each change, the image is rendered again and the display
+updated.  The small palette icon on the top left is colored while LAMMPS
+is running to render the new image; it is grayed out when LAMMPS is
+finished.  When there are many atoms to render and high quality images
+with anti-aliasing are requested, re-rendering may take several seconds.
+From the *File* menu of the image window, the current image can be saved
+to a file (keyboard shortcut `Ctrl-S`) or copied to the clipboard
+(keyboard shortcut `Ctrl-C`) for pasting the image into another
+application.
 
 From the *File* menu it is also possible to copy the current
 :doc:`dump image <dump_image>` and :doc:`dump_modify <dump_image>`
@@ -578,13 +708,27 @@ generated with a :doc:`write_data command <write_data>`.  The third
 window is a :ref:`Snapshot Image Viewer <snapshot_viewer>` containing a
 visualization of the system in the restart.
 
-If the restart file is larger than 250 MBytes, a dialog will ask
-for confirmation before continuing, since large restart files
-may require large amounts of RAM since the entire system must
-be read into RAM.  Thus restart file for large simulations that
-have been run on an HPC cluster may overload a laptop or local
-workstation. The *Show Details...* button will display a rough
-estimate of the additional memory required.
+.. |inspect1| image:: JPG/lammps-gui-inspect-data.png
+   :width: 32%
+
+.. |inspect2| image:: JPG/lammps-gui-inspect-info.png
+   :width: 32%
+
+.. |inspect3| image:: JPG/lammps-gui-inspect-image.png
+   :width: 32%
+
+|inspect1|  |inspect2|  |inspect3|
+
+.. admonition:: Large Restart Files
+   :class: warning
+
+   If the restart file is larger than 250 MBytes, a dialog will ask for
+   confirmation before continuing, since large restart files may require
+   large amounts of RAM since the entire system must be read into RAM.
+   Thus restart file for large simulations that have been run on an HPC
+   cluster may overload a laptop or local workstation. The *Show
+   Details...* button will display a rough estimate of the additional
+   memory required.
 
 Menu
 ----
@@ -656,6 +800,12 @@ timestep.  The *Stop LAMMPS* entry will do this by calling the
 :cpp:func:`lammps_force_timeout` library function, which is equivalent
 to a :doc:`timer timeout 0 <timer>` command.
 
+The *Relaunch LAMMPS Instance* will destroy the current LAMMPS thread
+and free its data and then create a new thread with a new LAMMPS
+instance.  This is usually not needed, since LAMMPS-GUI tries to detect
+when this is needed and does it automatically.  This is available
+in case it missed something and LAMMPS behaves in unexpected ways.
+
 The *Set Variables...* entry opens a dialog box where
 :doc:`index style variables <variable>` can be set. Those variables
 are passed to the LAMMPS instance when it is created and are thus
@@ -694,6 +844,26 @@ output, charts, slide show, variables, or snapshot images.  The
 default settings for their visibility can be changed in the
 *Preferences* dialog.
 
+Tutorials
+^^^^^^^^^
+
+The *Tutorials* menu is to support the set of LAMMPS tutorials for
+beginners and intermediate LAMMPS users documented in (:ref:`Gravelle1
+<Gravelle1>`).  From the drop down menu you can select which of the
+eight currently available tutorial sessions you want to begin.  This
+opens a 'wizard' dialog where you can choose in which folder you want to
+work, whether you want that folder to be wiped from *any* files, whether
+you want to download the solutions files (which can be large) to a
+``solution`` sub-folder, and whether you want the corresponding
+tutorial's online version opened in your web browser.  The dialog will
+then start downloading the files requested (download progress is
+reported in the status line) and load the first input file for the
+selected session into LAMMPS-GUI.
+
+.. image:: JPG/lammps-gui-tutorials.png
+   :align: center
+   :scale: 50%
+
 About
 ^^^^^
 
@@ -757,29 +927,32 @@ look of LAMMPS-GUI.  The settings are grouped and each group is
 displayed within a tab.
 
 .. |guiprefs1| image:: JPG/lammps-gui-prefs-general.png
-   :width: 24%
+   :width: 19%
 
 .. |guiprefs2| image:: JPG/lammps-gui-prefs-accel.png
-   :width: 24%
+   :width: 19%
 
 .. |guiprefs3| image:: JPG/lammps-gui-prefs-image.png
-   :width: 24%
+   :width: 19%
 
 .. |guiprefs4| image:: JPG/lammps-gui-prefs-editor.png
-   :width: 24%
+   :width: 19%
 
-|guiprefs1|  |guiprefs2|  |guiprefs3|  |guiprefs4|
+.. |guiprefs5| image:: JPG/lammps-gui-prefs-charts.png
+   :width: 19%
+
+|guiprefs1|  |guiprefs2|  |guiprefs3|  |guiprefs4|  |guiprefs5|
 
 General Settings:
 ^^^^^^^^^^^^^^^^^
 
 - *Echo input to log:* when checked, all input commands, including
   variable expansions, are echoed to the *Output* window. This is
-  equivalent to using `-echo screen` at the command line.  There is no
+  equivalent to using `-echo screen` at the command-line.  There is no
   log *file* produced by default, since LAMMPS-GUI uses `-log none`.
 - *Include citation details:* when checked full citation info will be
   included to the log window.  This is equivalent to using `-cite
-  screen` on the command line.
+  screen` on the command-line.
 - *Show log window by default:* when checked, the screen output of a
   LAMMPS run will be collected in a log window during the run
 - *Show chart window by default:* when checked, the thermodynamic
@@ -797,13 +970,12 @@ General Settings:
 - *Replace image window on new render:* when checked, an existing
   chart window will be replaced when a new snapshot image is requested,
   otherwise each command will create a new image window.
-- *Path to LAMMPS Shared Library File:* this option is only visible
-  when LAMMPS-GUI was compiled to load the LAMMPS library at run time
-  instead of being linked to it directly.  With the *Browse..* button
-  or by changing the text, a different shared library file with a
-  different compilation of LAMMPS with different settings or from a
-  different version can be loaded.  After this setting was changed,
-  LAMMPS-GUI needs to be re-launched.
+- *Download tutorial solutions enabled* this controls whether the
+  "Download solutions" option is enabled by default when setting up
+  a tutorial.
+- *Open tutorial webpage enabled* this controls whether the "Open
+  tutorial webpage in web browser" option is enabled by default when
+  setting up a tutorial.
 - *Select Default Font:* Opens a font selection dialog where the type
   and size for the default font (used for everything but the editor and
   log) of the application can be set.
@@ -822,16 +994,36 @@ General Settings:
   the plots in the *Charts* window in milliseconds.  The default is to
   redraw the plots every 500 milliseconds.  This is just for the drawing,
   data collection is managed with the previous setting.
+- *HTTPS proxy setting:* Allows to enter a URL for an HTTPS proxy.  This
+  may be needed when the LAMMPS input contains :doc:`geturl commands <geturl>`
+  or for downloading tutorial files from the *Tutorials* menu.  If the
+  ``https_proxy`` environment variable was set externally, its value is
+  displayed but cannot be changed.
+- *Path to LAMMPS Shared Library File:* this option is only visible
+  when LAMMPS-GUI was compiled to load the LAMMPS library at run time
+  instead of being linked to it directly.  With the *Browse..* button
+  or by changing the text, a different shared library file with a
+  different compilation of LAMMPS with different settings or from a
+  different version can be loaded.  After this setting was changed,
+  LAMMPS-GUI needs to be re-launched.
 
 Accelerators:
 ^^^^^^^^^^^^^
 
-This tab enables selection of an accelerator package for LAMMPS to use
-and is equivalent to using the `-suffix` and `-package` flags on the
-command line.  Only settings supported by the LAMMPS library and local
-hardware are available.  The `Number of threads` field allows setting
-the maximum number of threads for the accelerator packages that use
-threads.
+This tab enables selection of an accelerator package and modify some of
+its settings to use for running LAMMPS and is equivalent to using the
+:doc:`-sf <suffix>` and :doc:`-pk <package>` flags :doc:`on the
+command-line <Run_options>`.  Only settings supported by the LAMMPS
+library and local hardware are available.  The `Number of threads` field
+allows setting the number of threads for the accelerator packages that
+support using threads (OPENMP, INTEL, KOKKOS, and GPU).  Furthermore,
+the choice of precision mode (double, mixed, or single) for the INTEL
+package can be selected and for the GPU package, whether the neighbor
+lists are built on the GPU or the host (required for :doc:`pair style
+hybrid <pair_hybrid>`) and whether only pair styles should be
+accelerated (i.e. run PPPM entirely on the CPU, which sometimes leads
+to better overall performance).  Whether settings can be changed depends
+on which accelerator package is chosen (or "None").
 
 Snapshot Image:
 ^^^^^^^^^^^^^^^
@@ -858,7 +1050,7 @@ lists to select the background and box colors.
 Editor Settings:
 ^^^^^^^^^^^^^^^^
 
-This tab allows tweaking settings of the editor window.  Specifically
+This tab allows tweaking settings of the editor window.  Specifically,
 the amount of padding to be added to LAMMPS commands, types or type
 ranges, IDs (e.g. for fixes), and names (e.g. for groups).  The value
 set is the minimum width for the text element and it can be chosen in
@@ -870,6 +1062,16 @@ the completion pop-up window, and whether auto-save mode is enabled.
 In auto-save mode the editor buffer is saved before a run or before
 exiting LAMMPS-GUI.
 
+Charts Settings:
+----------------
+
+This tab allows tweaking settings of the *Charts* window.  Specifically,
+one can set the default chart title (if the title contains '%f' it will
+be replaced with the name of the current input file), one can select
+whether by default the raw data, the smoothed data or both will be
+plotted, one can set the colors for the two lines, the default smoothing
+parameters, and the default size of the chart graph in pixels.
+
 -----------
 
 Keyboard Shortcuts
@@ -950,10 +1152,21 @@ available (On macOS use the Command key instead of Ctrl/Control).
      - Ctrl+Shift+T
      - LAMMPS Tutorial
 
-Further editing keybindings `are documented with the Qt documentation
+Further keybindings of the editor window `are documented with the Qt
+documentation
 <https://doc.qt.io/qt-5/qplaintextedit.html#editing-key-bindings>`_.  In
 case of conflicts the list above takes precedence.
 
 All other windows only support a subset of keyboard shortcuts listed
 above.  Typically, the shortcuts `Ctrl-/` (Stop Run), `Ctrl-W` (Close
 Window), and `Ctrl-Q` (Quit Application) are supported.
+
+-------------
+
+.. _Gravelle1:
+
+**(Gravelle1)** Gravelle, Gissinger, Kohlmeyer, `arXiv:2503.14020 \[physics.comp-ph\] <https://doi.org/10.48550/arXiv.2503.14020>`_ (2025)
+
+.. _Gravelle2:
+
+**(Gravelle2)** Gravelle https://lammpstutorials.github.io/

doc/src/Run_windows.rst

@@ -3,71 +3,70 @@ Running LAMMPS on Windows
 
 To run a serial (non-MPI) executable, follow these steps:
 
-* Get a command prompt by going to Start->Run... ,
-  then typing "cmd".
-* Move to the directory where you have your input script,
+* Install a LAMMPS installer package from https://packages.lammps.org/windows.html
+* Open the "Command Prompt" or "Terminal" app.
+* Change to the directory where you have your input script,
   (e.g. by typing: cd "Documents").
-* At the command prompt, type "lmp -in in.file", where
-  in.file is the name of your LAMMPS input script.
+* At the command prompt, type "lmp -in in.file.lmp", where
+  ``in.file.lmp`` is the name of your LAMMPS input script.
 
 Note that the serial executable includes support for multi-threading
-parallelization from the styles in the OPENMP packages.  To run with
-4 threads, you can type this:
+parallelization from the styles in the OPENMP and KOKKOS packages.
+To run with 4 threads, you can type this:
 
 .. code-block:: bash
 
-   lmp -in in.lj -pk omp 4 -sf omp
+   lmp -in in.lj.lmp -pk omp 4 -sf omp
+   lmp -in in.lj.lmp -k on t 4 -sf kk
+
+Alternately, you can also install a package with LAMMPS-GUI included and
+open the LAMMPS-GUI app (the package includes the command line version
+of LAMMPS as well) and open the input file in the GUI and run it from
+there.  For details on LAMMPS-GUI, see :doc:`Howto_lammps_gui`.
 
 ----------
 
-For the MPI executable, which allows you to run LAMMPS under Windows
-in parallel, follow these steps.
+For the MS-MPI executables, which allow you to run LAMMPS under Windows
+in parallel using MPI rather than multi-threading, follow these steps.
 
-Download and install a compatible MPI library binary package:
-
-* for 32-bit Windows: `mpich2-1.4.1p1-win-ia32.msi <https://download.lammps.org/thirdparty/mpich2-1.4.1p1-win-ia32.msi>`_
-* for 64-bit Windows: `mpich2-1.4.1p1-win-x86-64.msi <https://download.lammps.org/thirdparty/mpich2-1.4.1p1-win-x86-64.msi>`_
-
-The LAMMPS Windows installer packages will automatically adjust your
-path for the default location of this MPI package. After the
-installation of the MPICH2 software, it needs to be integrated into
-the system.  For this you need to start a Command Prompt in
-*Administrator Mode* (right click on the icon and select it). Change
-into the MPICH2 installation directory, then into the subdirectory
-**bin** and execute **smpd.exe -install**\ . Exit the command window.
-
-* Get a new, regular command prompt by going to Start->Run... ,
-  then typing "cmd".
-* Move to the directory where you have your input file
-  (e.g. by typing: cd "Documents").
+Download and install the MS-MPI runtime package ``msmpisetup.exe`` from
+https://www.microsoft.com/en-us/download/details.aspx?id=105289 (Note
+that the ``msmpisdk.msi`` is **only** required for **compilation** of
+LAMMPS from source on Windows using Microsoft Visual Studio). After
+installation of MS-MPI perform a reboot.
 
 Then you can run the executable in serial like in the example above
 or in parallel using MPI with one of the following commands:
 
 .. code-block:: bash
 
-   mpiexec -localonly 4 lmp -in in.file
-   mpiexec -np 4 lmp -in in.file
+   mpiexec -localonly 4 lmp -in in.file.lmp
+   mpiexec -np 4 lmp -in in.file.lmp
 
-where in.file is the name of your LAMMPS input script. For the latter
-case, you may be prompted to enter the password that you set during
-installation of the MPI library software.
+where ``in.file.lmp`` is the name of your LAMMPS input script. For the
+latter case, you may be prompted to enter the password that you set
+during installation of the MPI library software.
 
 In this mode, output may not immediately show up on the screen, so if
 your input script takes a long time to execute, you may need to be
 patient before the output shows up.
 
-The parallel executable can also run on a single processor by typing
-something like this:
+Note that the parallel executable also includes OpenMP multi-threading
+through both the OPENMP and the KOKKOS package, which can be combined
+with MPI using something like:
 
 .. code-block:: bash
 
-   lmp -in in.lj
+   mpiexec -localonly 2 lmp -in in.lj.lmp -pk omp 2 -sf omp
+   mpiexec -localonly 2 lmp -in in.lj.lmp -kokkos on t 2 -sf kk
 
-Note that the parallel executable also includes OpenMP
-multi-threading, which can be combined with MPI using something like:
-
-.. code-block:: bash
-
-   mpiexec -localonly 2 lmp -in in.lj -pk omp 2 -sf omp
+-------------
 
+MPI parallelization will work for *all* functionality in LAMMPS and in
+many cases the MPI parallelization is more efficient than
+multi-threading since LAMMPS was designed from ground up for MPI
+parallelization using domain decomposition.  Multi-threading is only
+available for selected styles and implemented on top of the MPI
+parallelization.  Multi-threading is most useful for systems with large
+load imbalances when using domain decomposition and a smaller number
+of threads (<= 8).

doc/src/compute_msd.rst

@@ -111,7 +111,10 @@ distance\ :math:`^2` :doc:`units <units>`.
 Restrictions
 """"""""""""
 
-Compute *msd* cannot be used with a dynamic group.
+Compute *msd* cannot be used with a dynamic group and the number of
+atoms in the compute group must not be changed by some fixes like,
+for example, :doc:`fix deposit <fix_deposit>` or
+:doc:`fix evaporate <fix_evaporate>`.
 
 Related commands
 """"""""""""""""

doc/src/compute_reduce.rst

@@ -87,7 +87,7 @@ values in the vector.  The *sumsq* option sums the square of the
 values in the vector into a global total.  The *avesq* setting does
 the same as *sumsq*, then divides the sum of squares by the number of
 values.  The last two options can be useful for calculating the
-variance of some quantity (e.g., variance = sumsq :math:`-` ave\
+variance of some quantity (e.g., variance = *avesq* :math:`-` *ave*\
 :math:`^2`).  The *sumabs* option sums the absolute values in the
 vector into a global total.  The *aveabs* setting does the same as
 *sumabs*, then divides the sum of absolute values by the number of

doc/src/fix_ave_time.rst

@@ -345,9 +345,7 @@ Restart, fix_modify, output, run start/stop, minimize info
 .. versionadded:: 4May2022
 
 No information about this fix is written to :doc:`binary restart files
-<restart>`.  The :doc:`fix_modify colname <fix_modify>` option can be
-used to change the name of the column in the output file.  When writing
-a YAML format file this name will be in the list of keywords.
+<restart>`.
 
 This fix produces a global scalar or global vector or global array
 which can be accessed by various :doc:`output commands <Howto_output>`.

doc/src/fix_modify.rst

@@ -12,16 +12,12 @@ Syntax
 
 * fix-ID = ID of the fix to modify
 * one or more keyword/value pairs may be appended
-* keyword = *bodyforces* or *colname* or *dynamic/dof* or *energy* or *press* or *respa* or *temp* or *virial*
+* keyword = *bodyforces* or *dynamic/dof* or *energy* or *press* or *respa* or *temp* or *virial*
 
   .. parsed-literal::
 
        *bodyforces* value = *early* or *late*
          early/late = compute rigid-body forces/torques early or late in the timestep
-       *colname* values =  ID string
-         string = new column header name
-         ID = integer from 1 to N, or integer from -1 to -N, where N = # of quantities being output
-              *or* a fix output property keyword or reference to compute, fix, property or variable.
        *dynamic/dof* value = *yes* or *no*
          yes/no = do or do not re-compute the number of degrees of freedom (DOF) contributing to the temperature
        *energy* value = *yes* or *no*
@@ -38,7 +34,6 @@ Examples
    fix_modify 3 temp myTemp press myPress
    fix_modify 1 energy yes
    fix_modify tether respa 2
-   fix_modify ave colname c_thermo_press Pressure colname 1 Temperature
 
 Description
 """""""""""
@@ -171,20 +166,6 @@ will have no effect on the motion of the rigid bodies if they are
 specified in the input script after the fix rigid command.  LAMMPS
 will give a warning if that is the case.
 
-
-The *colname* keyword can be used to change the default header keywords
-in output files of fix styles that support it: currently only :doc:`fix
-ave/time <fix_ave_time>` is supported.  The setting for *ID string*
-replaces the default text with the provided string.  *ID* can be a
-positive integer when it represents the column number counting from the
-left, a negative integer when it represents the column number from the
-right (i.e. -1 is the last column/keyword), or a custom fix output
-keyword (or compute, fix, property, or variable reference) and then it
-replaces the string for that specific keyword. The *colname* keyword can
-be used multiple times. If multiple *colname* settings refer to the same
-keyword, the last setting has precedence.
-
-
 Restrictions
 """"""""""""
 none

doc/src/thermo_style.rst

@@ -20,7 +20,7 @@ Syntax
        *yaml* args = none
        *custom* args = list of keywords
          possible keywords = step, elapsed, elaplong, dt, time,
-                             cpu, tpcpu, spcpu, cpuremain, part, timeremain,
+                             cpu, tpcpu, spcpu, cpuuse, cpuremain, part, timeremain,
                              atoms, temp, press, pe, ke, etotal,
                              evdwl, ecoul, epair, ebond, eangle, edihed, eimp,
                              emol, elong, etail,
@@ -48,6 +48,7 @@ Syntax
            cpu = elapsed CPU time in seconds since start of this run
            tpcpu = time per CPU second
            spcpu = timesteps per CPU second
+           cpuuse = CPU utilization in percent (can be > 100% with multi-threading)
            cpuremain = estimated CPU time remaining in run
            part = which partition (0 to Npartition-1) this is
            timeremain = remaining time in seconds on timer timeout.
@@ -292,6 +293,16 @@ steps.  The *tpcpu* keyword does not attempt to track any changes in
 timestep size, e.g. due to using the :doc:`fix dt/reset <fix_dt_reset>`
 command.
 
+The *cpuuse* keyword represents the CPU utilization in percent on
+MPI rank 0 for the current run.  This should typically be around 100%
+for single-threaded runs.  Smaller values indicate that LAMMPS may be
+stalling on file I/O, or some other process is competing with LAMMPS
+for the same CPU.  When using multi-threading through the KOKKOS,
+INTEL, or OPENMP packages the value can be larger than 100% and
+ideally should be close to *nthreads* x 100%.  How close depends
+on how much of the execution time is spent in multi-threaded parts
+of the code versus the non-accelerated parts.
+
 The *cpuremain* keyword estimates the CPU time remaining in the
 current run, based on the time elapsed thus far.  It will only be a
 good estimate if the CPU time/timestep for the rest of the run is

doc/utils/sphinx-config/conf.py.in

@@ -386,8 +386,8 @@ latex_elements = {
       \vfill
       {\LARGE \lammpsversion \par}
       \vfill
-      {\LARGE The LAMMPS Developers \par}
-      {\Large developers@lammps.org $^*$ \par}
+      {\LARGE The LAMMPS Developers$^*$ \par}
+      {\Large developers@lammps.org \par}
       \vfill\vfill\vfill
       {\normalsize ${}^*$ see
         \sphinxhref{https://www.lammps.org/authors.html}{https://www.lammps.org/authors.html}

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/data.dpd_coul_slater_long

@@ -15,12 +15,12 @@ Masses
 
 PairIJ Coeffs # dpd/coul/slater/long
 
-1 1 78 4.5 yes 1
-1 2 78 4.5 yes 1
-1 3 78 4.5 yes 1
-2 2 78 4.5 no 1
-2 3 78 4.5 no 1
-3 3 78 4.5 no 1
+1 1 78 4.5 no  1
+1 2 78 4.5 no  1
+1 3 78 4.5 no  1
+2 2 78 4.5 yes 1
+2 3 78 4.5 yes 1
+3 3 78 4.5 yes 1
 
 Atoms # full
 

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/in.dpd_coul_slater_long

@@ -10,49 +10,47 @@ variable    cut_coul    equal 2.0
 # Initialize LAMMPS run for 3-d periodic
 #-------------------------------------------------------------------------------
 
-units                   lj
-boundary                p p p # periodic at all axes
-atom_style              full
-dimension    3
+units           lj
+boundary        p p p # periodic at all axes
+atom_style      full
+dimension       3
 
-bond_style              none
-angle_style             none
-dihedral_style          none
-improper_style          none
+bond_style      none
+angle_style     none
+dihedral_style  none
+improper_style  none
 
-newton on
-comm_modify vel yes # store info of ghost atoms btw processors
+newton          on
+comm_modify     vel yes # store info of ghost atoms btw processors
 
 #-------------------------------------------------------------------------------
 # Box creation and configuration
 #-------------------------------------------------------------------------------
 
 # Define pair style and coefficients
-pair_style dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
-
-read_data data.dpd_coul_slater_long
+pair_style      dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
 
 # Enable long range electrostatics solver
-kspace_style    pppm       1e-04
+kspace_style    pppm 1e-04
+
+read_data       data.dpd_coul_slater_long
 
 # Construct neighbors every steps
-neighbor 1.0 bin
-neigh_modify every 1 delay 0 check yes
+neighbor        1.0 bin
+neigh_modify    every 1 delay 0 check yes
 
 #-------------------------------------------------------------------------------
 # Run the simulation
 #-------------------------------------------------------------------------------
 
-thermo_style            custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
-thermo_modify norm no
-thermo                  100
+thermo_style    custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
+thermo_modify   norm no
+thermo          100
 
-timestep     0.01
-run_style    verlet
+timestep        0.01
+run_style       verlet
 
-fix                     1 all nve
+fix             1        all      nve
 
-run                     1000
-
-unfix           1
+run             1000
 

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/log.19Jun24.dpd_coul_slater.g++.1

@@ -1,147 +0,0 @@
-LAMMPS (17 Apr 2024 - Development - patch_17Apr2024-262-g0aff26705c-modified)
-OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:98)
-  using 1 OpenMP thread(s) per MPI task
-# DPD Ionic Fluid
-
-variable    T           equal 1.0
-variable    cut_DPD     equal 1.0
-variable    seed        equal 165412
-variable    lambda      equal 0.25
-variable    cut_coul    equal 2.0
-
-#-------------------------------------------------------------------------------
-# Initialize LAMMPS run for 3-d periodic
-#-------------------------------------------------------------------------------
-
-units                   lj
-boundary                p p p # periodic at all axes
-atom_style              full
-dimension    3
-
-bond_style              none
-angle_style             none
-dihedral_style          none
-improper_style          none
-
-newton on
-comm_modify vel yes # store info of ghost atoms btw processors
-
-#-------------------------------------------------------------------------------
-# Box creation and configuration
-#-------------------------------------------------------------------------------
-
-# Define pair style and coefficients
-pair_style dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 ${cut_DPD} ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 0.25 ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 0.25 2
-
-read_data data.dpd_coul_slater_long
-Reading data file ...
-  orthogonal box = (0 0 0) to (5 5 5)
-  1 by 1 by 1 MPI processor grid
-  reading atoms ...
-  375 atoms
-  reading velocities ...
-  375 velocities
-Finding 1-2 1-3 1-4 neighbors ...
-  special bond factors lj:    0        0        0       
-  special bond factors coul:  0        0        0       
-     0 = max # of 1-2 neighbors
-     0 = max # of 1-3 neighbors
-     0 = max # of 1-4 neighbors
-     1 = max # of special neighbors
-  special bonds CPU = 0.000 seconds
-  read_data CPU = 0.003 seconds
-
-# Enable long range electrostatics solver
-kspace_style    pppm       1e-04
-
-# Construct neighbors every steps
-neighbor 1.0 bin
-neigh_modify every 1 delay 0 check yes
-
-#-------------------------------------------------------------------------------
-# Run the simulation
-#-------------------------------------------------------------------------------
-
-thermo_style            custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
-thermo_modify norm no
-thermo                  100
-
-timestep     0.01
-run_style    verlet
-
-fix                     1 all nve
-
-run                     1000
-PPPM initialization ...
-  using 12-bit tables for long-range coulomb (src/kspace.cpp:342)
-  G vector (1/distance) = 1.4828454
-  grid = 20 20 20
-  stencil order = 5
-  estimated absolute RMS force accuracy = 7.7240141e-05
-  estimated relative force accuracy = 7.7240141e-05
-  using double precision FFTW3
-  3d grid and FFT values/proc = 24389 8000
-Generated 0 of 3 mixed pair_coeff terms from geometric mixing rule
-Neighbor list info ...
-  update: every = 1 steps, delay = 0 steps, check = yes
-  max neighbors/atom: 2000, page size: 100000
-  master list distance cutoff = 3
-  ghost atom cutoff = 3
-  binsize = 1.5, bins = 4 4 4
-  1 neighbor lists, perpetual/occasional/extra = 1 0 0
-  (1) pair dpd/coul/slater/long, perpetual
-      attributes: half, newton on
-      pair build: half/bin/newton
-      stencil: half/bin/3d
-      bin: standard
-Per MPI rank memory allocation (min/avg/max) = 8.359 | 8.359 | 8.359 Mbytes
-   Step          Temp          Press          Volume         E_vdwl         E_coul         E_long         PotEng         KinEng         Fnorm           Fmax     
-         0   0.9849949      69.271905      125            4673.0443      0             -30.365103      4642.6792      552.58214      646.76798      65.851035    
-       100   1.0614027      69.794624      125            4659.0139      0             -31.906319      4627.1075      595.44692      612.94396      60.338653    
-       200   0.9422517      68.721098      125            4687.8862      0             -33.81531       4654.0709      528.6032       620.25627      62.726994    
-       300   0.8956649      69.323482      125            4721.0824      0             -33.854275      4687.2281      502.46801      670.22699      73.087908    
-       400   0.99584547     69.670416      125            4713.9086      0             -30.783633      4683.125       558.66931      607.65881      59.224652    
-       500   1.0565931      69.497816      125            4701.2584      0             -26.80545       4674.4529      592.74873      646.18907      71.398122    
-       600   1.0071523      70.26222       125            4659.2061      0             -29.98909       4629.217       565.01243      630.00244      58.264115    
-       700   1.0507355      67.920078      125            4695.255       0             -32.649209      4662.6058      589.46259      651.80459      70.573524    
-       800   0.98561942     68.279591      125            4745.7603      0             -28.98491       4716.7754      552.9325       627.14371      67.196483    
-       900   0.96470105     70.742864      125            4706.3605      0             -30.271633      4676.0889      541.19729      644.43036      79.474998    
-      1000   1.0204819      70.164419      125            4654.6077      0             -27.797433      4626.8103      572.49035      624.19728      71.825307    
-Loop time of 2.10153 on 1 procs for 1000 steps with 375 atoms
-
-Performance: 411128.483 tau/day, 475.843 timesteps/s, 178.441 katom-step/s
-99.7% CPU use with 1 MPI tasks x 1 OpenMP threads
-
-MPI task timing breakdown:
-Section |  min time  |  avg time  |  max time  |%varavg| %total
----------------------------------------------------------------
-Pair    | 1.1779     | 1.1779     | 1.1779     |   0.0 | 56.05
-Bond    | 6.507e-05  | 6.507e-05  | 6.507e-05  |   0.0 |  0.00
-Kspace  | 0.74636    | 0.74636    | 0.74636    |   0.0 | 35.51
-Neigh   | 0.12903    | 0.12903    | 0.12903    |   0.0 |  6.14
-Comm    | 0.039726   | 0.039726   | 0.039726   |   0.0 |  1.89
-Output  | 0.00027587 | 0.00027587 | 0.00027587 |   0.0 |  0.01
-Modify  | 0.0037596  | 0.0037596  | 0.0037596  |   0.0 |  0.18
-Other   |            | 0.004451   |            |       |  0.21
-
-Nlocal:            375 ave         375 max         375 min
-Histogram: 1 0 0 0 0 0 0 0 0 0
-Nghost:           3613 ave        3613 max        3613 min
-Histogram: 1 0 0 0 0 0 0 0 0 0
-Neighs:          62354 ave       62354 max       62354 min
-Histogram: 1 0 0 0 0 0 0 0 0 0
-
-Total # of neighbors = 62354
-Ave neighs/atom = 166.27733
-Ave special neighs/atom = 0
-Neighbor list builds = 65
-Dangerous builds = 0
-
-unfix           1
-
-Total wall time: 0:00:02

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/log.19Jun24.dpd_coul_slater.g++.4

@@ -1,147 +0,0 @@
-LAMMPS (17 Apr 2024 - Development - patch_17Apr2024-262-g0aff26705c-modified)
-OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:98)
-  using 1 OpenMP thread(s) per MPI task
-# DPD Ionic Fluid
-
-variable    T           equal 1.0
-variable    cut_DPD     equal 1.0
-variable    seed        equal 165412
-variable    lambda      equal 0.25
-variable    cut_coul    equal 2.0
-
-#-------------------------------------------------------------------------------
-# Initialize LAMMPS run for 3-d periodic
-#-------------------------------------------------------------------------------
-
-units                   lj
-boundary                p p p # periodic at all axes
-atom_style              full
-dimension    3
-
-bond_style              none
-angle_style             none
-dihedral_style          none
-improper_style          none
-
-newton on
-comm_modify vel yes # store info of ghost atoms btw processors
-
-#-------------------------------------------------------------------------------
-# Box creation and configuration
-#-------------------------------------------------------------------------------
-
-# Define pair style and coefficients
-pair_style dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 ${cut_DPD} ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 ${seed} ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 ${lambda} ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 0.25 ${cut_coul}
-pair_style dpd/coul/slater/long 1 1 165412 0.25 2
-
-read_data data.dpd_coul_slater_long
-Reading data file ...
-  orthogonal box = (0 0 0) to (5 5 5)
-  1 by 2 by 2 MPI processor grid
-  reading atoms ...
-  375 atoms
-  reading velocities ...
-  375 velocities
-Finding 1-2 1-3 1-4 neighbors ...
-  special bond factors lj:    0        0        0       
-  special bond factors coul:  0        0        0       
-     0 = max # of 1-2 neighbors
-     0 = max # of 1-3 neighbors
-     0 = max # of 1-4 neighbors
-     1 = max # of special neighbors
-  special bonds CPU = 0.000 seconds
-  read_data CPU = 0.003 seconds
-
-# Enable long range electrostatics solver
-kspace_style    pppm       1e-04
-
-# Construct neighbors every steps
-neighbor 1.0 bin
-neigh_modify every 1 delay 0 check yes
-
-#-------------------------------------------------------------------------------
-# Run the simulation
-#-------------------------------------------------------------------------------
-
-thermo_style            custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
-thermo_modify norm no
-thermo                  100
-
-timestep     0.01
-run_style    verlet
-
-fix                     1 all nve
-
-run                     1000
-PPPM initialization ...
-  using 12-bit tables for long-range coulomb (src/kspace.cpp:342)
-  G vector (1/distance) = 1.4828454
-  grid = 20 20 20
-  stencil order = 5
-  estimated absolute RMS force accuracy = 7.7240141e-05
-  estimated relative force accuracy = 7.7240141e-05
-  using double precision FFTW3
-  3d grid and FFT values/proc = 10469 2000
-Generated 0 of 3 mixed pair_coeff terms from geometric mixing rule
-Neighbor list info ...
-  update: every = 1 steps, delay = 0 steps, check = yes
-  max neighbors/atom: 2000, page size: 100000
-  master list distance cutoff = 3
-  ghost atom cutoff = 3
-  binsize = 1.5, bins = 4 4 4
-  1 neighbor lists, perpetual/occasional/extra = 1 0 0
-  (1) pair dpd/coul/slater/long, perpetual
-      attributes: half, newton on
-      pair build: half/bin/newton
-      stencil: half/bin/3d
-      bin: standard
-Per MPI rank memory allocation (min/avg/max) = 7.208 | 7.208 | 7.209 Mbytes
-   Step          Temp          Press          Volume         E_vdwl         E_coul         E_long         PotEng         KinEng         Fnorm           Fmax     
-         0   0.9849949      69.076433      125            4673.0443      0             -30.365103      4642.6792      552.58214      613.18374      70.700582    
-       100   0.95374867     69.110009      125            4681.1097      0             -31.260804      4649.8489      535.053        629.95109      62.05418     
-       200   1.0076152      69.824904      125            4670.7458      0             -28.382203      4642.3636      565.27213      656.8501       72.049813    
-       300   1.0014752      69.666331      125            4696.454       0             -26.943577      4669.5105      561.8276       631.49861      74.737274    
-       400   0.98863876     69.731774      125            4700.7552      0             -23.816077      4676.9391      554.62634      637.74742      68.928573    
-       500   0.95782852     68.588075      125            4698.588       0             -29.249543      4669.3385      537.3418       646.31897      68.800569    
-       600   0.97443232     70.864079      125            4674.8821      0             -26.415644      4648.4664      546.65653      606.50755      78.664429    
-       700   0.98783988     68.908299      125            4692.5536      0             -28.092022      4664.4616      554.17817      638.98401      69.691814    
-       800   0.98000145     69.83977       125            4706.6365      0             -29.648365      4676.9881      549.78082      626.84362      73.133934    
-       900   1.0526251      69.466078      125            4671.9648      0             -30.941117      4641.0237      590.52269      618.1049       62.333546    
-      1000   0.98340746     69.527121      125            4728.2894      0             -31.869907      4696.4195      551.69159      630.14208      61.392611    
-Loop time of 0.928543 on 4 procs for 1000 steps with 375 atoms
-
-Performance: 930490.137 tau/day, 1076.956 timesteps/s, 403.859 katom-step/s
-98.9% CPU use with 4 MPI tasks x 1 OpenMP threads
-
-MPI task timing breakdown:
-Section |  min time  |  avg time  |  max time  |%varavg| %total
----------------------------------------------------------------
-Pair    | 0.30761    | 0.34974    | 0.38864    |   4.9 | 37.67
-Bond    | 8.4633e-05 | 9.0539e-05 | 9.9184e-05 |   0.0 |  0.01
-Kspace  | 0.39038    | 0.42976    | 0.47215    |   4.4 | 46.28
-Neigh   | 0.033986   | 0.035576   | 0.036791   |   0.5 |  3.83
-Comm    | 0.10247    | 0.10324    | 0.10481    |   0.3 | 11.12
-Output  | 0.00024145 | 0.00027404 | 0.00036867 |   0.0 |  0.03
-Modify  | 0.0022402  | 0.0025068  | 0.0026343  |   0.3 |  0.27
-Other   |            | 0.007356   |            |       |  0.79
-
-Nlocal:          93.75 ave          96 max          93 min
-Histogram: 3 0 0 0 0 0 0 0 0 1
-Nghost:        2289.75 ave        2317 max        2271 min
-Histogram: 1 1 0 0 1 0 0 0 0 1
-Neighs:        15590.2 ave       16765 max       14540 min
-Histogram: 1 0 1 0 0 1 0 0 0 1
-
-Total # of neighbors = 62361
-Ave neighs/atom = 166.296
-Ave special neighs/atom = 0
-Neighbor list builds = 64
-Dangerous builds = 0
-
-unfix           1
-
-Total wall time: 0:00:00

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/log.25Mar25.dpd_coul_slater.g++.1

@@ -0,0 +1,145 @@
+LAMMPS (4 Feb 2025 - Development - patch_4Feb2025-468-gd830412228-modified)
+OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:99)
+  using 1 OpenMP thread(s) per MPI task
+# DPD Ionic Fluid
+
+variable    T           equal 1.0
+variable    cut_DPD     equal 1.0
+variable    seed        equal 165412
+variable    lambda      equal 0.25
+variable    cut_coul    equal 2.0
+
+#-------------------------------------------------------------------------------
+# Initialize LAMMPS run for 3-d periodic
+#-------------------------------------------------------------------------------
+
+units           lj
+boundary        p p p # periodic at all axes
+atom_style      full
+dimension       3
+
+bond_style      none
+angle_style     none
+dihedral_style  none
+improper_style  none
+
+newton          on
+comm_modify     vel yes # store info of ghost atoms btw processors
+
+#-------------------------------------------------------------------------------
+# Box creation and configuration
+#-------------------------------------------------------------------------------
+
+# Define pair style and coefficients
+pair_style      dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 ${cut_DPD} ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 0.25 ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 0.25 2
+
+# Enable long range electrostatics solver
+kspace_style    pppm 1e-04
+
+read_data       data.dpd_coul_slater_long
+Reading data file ...
+  orthogonal box = (0 0 0) to (5 5 5)
+  1 by 1 by 1 MPI processor grid
+  reading atoms ...
+  375 atoms
+  reading velocities ...
+  375 velocities
+Finding 1-2 1-3 1-4 neighbors ...
+  special bond factors lj:    0        0        0       
+  special bond factors coul:  0        0        0       
+     0 = max # of 1-2 neighbors
+     0 = max # of 1-3 neighbors
+     0 = max # of 1-4 neighbors
+     1 = max # of special neighbors
+  special bonds CPU = 0.001 seconds
+  read_data CPU = 0.004 seconds
+
+# Construct neighbors every steps
+neighbor        1.0 bin
+neigh_modify    every 1 delay 0 check yes
+
+#-------------------------------------------------------------------------------
+# Run the simulation
+#-------------------------------------------------------------------------------
+
+thermo_style    custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
+thermo_modify   norm no
+thermo          100
+
+timestep        0.01
+run_style       verlet
+
+fix             1        all      nve
+
+run             1000
+PPPM initialization ...
+  using 12-bit tables for long-range coulomb (src/kspace.cpp:342)
+  G vector (1/distance) = 1.4828454
+  grid = 20 20 20
+  stencil order = 5
+  estimated absolute RMS force accuracy = 7.7240141e-05
+  estimated relative force accuracy = 7.7240141e-05
+  using double precision KISS FFT
+  3d grid and FFT values/proc = 24389 8000
+Generated 0 of 3 mixed pair_coeff terms from geometric mixing rule
+Neighbor list info ...
+  update: every = 1 steps, delay = 0 steps, check = yes
+  max neighbors/atom: 2000, page size: 100000
+  master list distance cutoff = 3
+  ghost atom cutoff = 3
+  binsize = 1.5, bins = 4 4 4
+  1 neighbor lists, perpetual/occasional/extra = 1 0 0
+  (1) pair dpd/coul/slater/long, perpetual
+      attributes: half, newton on
+      pair build: half/bin/newton
+      stencil: half/bin/3d
+      bin: standard
+Per MPI rank memory allocation (min/avg/max) = 8.359 | 8.359 | 8.359 Mbytes
+   Step          Temp          Press          Volume         E_vdwl         E_coul         E_long         PotEng         KinEng         Fnorm           Fmax     
+         0   0.9849949      69.242343      125            4673.0443     -3.2653869     -30.365103      4639.4138      552.58214      646.89929      65.851035    
+       100   1.023885       69.716134      125            4676.9465     -4.9878506     -34.092864      4637.8658      574.39949      663.35845      94.350026    
+       200   1.0286646      69.674249      125            4636.201      -4.6314926     -33.406897      4598.1626      577.08087      614.52805      62.295431    
+       300   0.9745797      69.689534      125            4679.9157     -4.3964184     -30.560567      4644.9588      546.73921      603.46282      60.56253     
+       400   0.99487931     69.17085       125            4678.0362     -4.9518269     -34.446596      4638.6378      558.12729      656.99738      88.090014    
+       500   0.97732377     69.551562      125            4684.3709     -5.0851581     -33.863212      4645.4226      548.27864      647.12533      75.851935    
+       600   0.95396337     68.358297      125            4706.824      -4.269168      -33.634096      4668.9207      535.17345      604.31276      63.41042     
+       700   0.99397324     68.365109      125            4669.1062     -4.700146      -35.014001      4629.3921      557.61899      633.29262      74.300913    
+       800   1.0157864      69.263686      125            4664.1398     -4.0142381     -34.372669      4625.7529      569.85616      595.81462      67.046561    
+       900   0.9925779      70.008922      125            4652.3023     -2.7845751     -33.095293      4616.4224      556.8362       620.13154      82.785317    
+      1000   0.97336501     68.973657      125            4688.8002     -5.5239266     -36.42345       4646.8529      546.05777      625.66451      64.948859    
+Loop time of 0.755094 on 1 procs for 1000 steps with 375 atoms
+
+Performance: 1144228.093 tau/day, 1324.338 timesteps/s, 496.627 katom-step/s
+99.5% CPU use with 1 MPI tasks x 1 OpenMP threads
+
+MPI task timing breakdown:
+Section |  min time  |  avg time  |  max time  |%varavg| %total
+---------------------------------------------------------------
+Pair    | 0.14421    | 0.14421    | 0.14421    |   0.0 | 19.10
+Bond    | 3.8885e-05 | 3.8885e-05 | 3.8885e-05 |   0.0 |  0.01
+Kspace  | 0.53292    | 0.53292    | 0.53292    |   0.0 | 70.58
+Neigh   | 0.056741   | 0.056741   | 0.056741   |   0.0 |  7.51
+Comm    | 0.017676   | 0.017676   | 0.017676   |   0.0 |  2.34
+Output  | 0.00024925 | 0.00024925 | 0.00024925 |   0.0 |  0.03
+Modify  | 0.0016688  | 0.0016688  | 0.0016688  |   0.0 |  0.22
+Other   |            | 0.001588   |            |       |  0.21
+
+Nlocal:            375 ave         375 max         375 min
+Histogram: 1 0 0 0 0 0 0 0 0 0
+Nghost:           3570 ave        3570 max        3570 min
+Histogram: 1 0 0 0 0 0 0 0 0 0
+Neighs:          19729 ave       19729 max       19729 min
+Histogram: 1 0 0 0 0 0 0 0 0 0
+
+Total # of neighbors = 19729
+Ave neighs/atom = 52.610667
+Ave special neighs/atom = 0
+Neighbor list builds = 66
+Dangerous builds = 0
+
+Total wall time: 0:00:00

examples/PACKAGES/dpd-basic/dpd_coul_slater_long/log.25Mar25.dpd_coul_slater.g++.4

@@ -0,0 +1,145 @@
+LAMMPS (4 Feb 2025 - Development - patch_4Feb2025-468-gd830412228-modified)
+OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:99)
+  using 1 OpenMP thread(s) per MPI task
+# DPD Ionic Fluid
+
+variable    T           equal 1.0
+variable    cut_DPD     equal 1.0
+variable    seed        equal 165412
+variable    lambda      equal 0.25
+variable    cut_coul    equal 2.0
+
+#-------------------------------------------------------------------------------
+# Initialize LAMMPS run for 3-d periodic
+#-------------------------------------------------------------------------------
+
+units           lj
+boundary        p p p # periodic at all axes
+atom_style      full
+dimension       3
+
+bond_style      none
+angle_style     none
+dihedral_style  none
+improper_style  none
+
+newton          on
+comm_modify     vel yes # store info of ghost atoms btw processors
+
+#-------------------------------------------------------------------------------
+# Box creation and configuration
+#-------------------------------------------------------------------------------
+
+# Define pair style and coefficients
+pair_style      dpd/coul/slater/long ${T} ${cut_DPD} ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 ${cut_DPD} ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 ${seed} ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 ${lambda} ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 0.25 ${cut_coul}
+pair_style      dpd/coul/slater/long 1 1 165412 0.25 2
+
+# Enable long range electrostatics solver
+kspace_style    pppm 1e-04
+
+read_data       data.dpd_coul_slater_long
+Reading data file ...
+  orthogonal box = (0 0 0) to (5 5 5)
+  1 by 2 by 2 MPI processor grid
+  reading atoms ...
+  375 atoms
+  reading velocities ...
+  375 velocities
+Finding 1-2 1-3 1-4 neighbors ...
+  special bond factors lj:    0        0        0       
+  special bond factors coul:  0        0        0       
+     0 = max # of 1-2 neighbors
+     0 = max # of 1-3 neighbors
+     0 = max # of 1-4 neighbors
+     1 = max # of special neighbors
+  special bonds CPU = 0.000 seconds
+  read_data CPU = 0.004 seconds
+
+# Construct neighbors every steps
+neighbor        1.0 bin
+neigh_modify    every 1 delay 0 check yes
+
+#-------------------------------------------------------------------------------
+# Run the simulation
+#-------------------------------------------------------------------------------
+
+thermo_style    custom step temp press vol evdwl ecoul elong pe ke fnorm fmax
+thermo_modify   norm no
+thermo          100
+
+timestep        0.01
+run_style       verlet
+
+fix             1        all      nve
+
+run             1000
+PPPM initialization ...
+  using 12-bit tables for long-range coulomb (src/kspace.cpp:342)
+  G vector (1/distance) = 1.4828454
+  grid = 20 20 20
+  stencil order = 5
+  estimated absolute RMS force accuracy = 7.7240141e-05
+  estimated relative force accuracy = 7.7240141e-05
+  using double precision KISS FFT
+  3d grid and FFT values/proc = 10469 2000
+Generated 0 of 3 mixed pair_coeff terms from geometric mixing rule
+Neighbor list info ...
+  update: every = 1 steps, delay = 0 steps, check = yes
+  max neighbors/atom: 2000, page size: 100000
+  master list distance cutoff = 3
+  ghost atom cutoff = 3
+  binsize = 1.5, bins = 4 4 4
+  1 neighbor lists, perpetual/occasional/extra = 1 0 0
+  (1) pair dpd/coul/slater/long, perpetual
+      attributes: half, newton on
+      pair build: half/bin/newton
+      stencil: half/bin/3d
+      bin: standard
+Per MPI rank memory allocation (min/avg/max) = 7.208 | 7.208 | 7.209 Mbytes
+   Step          Temp          Press          Volume         E_vdwl         E_coul         E_long         PotEng         KinEng         Fnorm           Fmax     
+         0   0.9849949      69.04687       125            4673.0443     -3.2653869     -30.365103      4639.4138      552.58214      613.14254      70.700582    
+       100   1.0206537      69.308834      125            4676.3153     -4.5693306     -33.647673      4638.0983      572.58672      630.70953      76.020236    
+       200   0.99990746     68.572978      125            4707.1556     -3.4977853     -33.275671      4670.3821      560.94809      633.00167      77.040049    
+       300   0.91055241     69.390592      125            4685.5268     -2.9764038     -29.986737      4652.5637      510.8199       614.61006      62.799933    
+       400   1.0080135      69.442971      125            4677.3078     -4.8740989     -32.908722      4639.525       565.49557      649.20121      61.033612    
+       500   0.99500653     68.275189      125            4718.6774     -4.2475783     -35.206868      4679.223       558.19867      657.3073       74.738502    
+       600   1.052925       70.601712      125            4703.6749     -2.8511316     -34.085418      4666.7383      590.69094      641.70441      59.043346    
+       700   0.96467445     69.502018      125            4720.4257     -4.3345734     -34.310005      4681.7811      541.18237      656.24965      72.433637    
+       800   1.0657358      70.960958      125            4685.5637     -5.8903418     -35.207202      4644.4661      597.87781      595.54446      61.462159    
+       900   1.0273388      68.735518      125            4693.5106     -2.4175829     -28.602387      4662.4906      576.33707      598.80294      71.747886    
+      1000   0.9702835      69.885576      125            4701.4385     -3.6513555     -29.487331      4668.2999      544.32904      666.55262      73.231425    
+Loop time of 0.270344 on 4 procs for 1000 steps with 375 atoms
+
+Performance: 3195929.791 tau/day, 3698.993 timesteps/s, 1.387 Matom-step/s
+99.3% CPU use with 4 MPI tasks x 1 OpenMP threads
+
+MPI task timing breakdown:
+Section |  min time  |  avg time  |  max time  |%varavg| %total
+---------------------------------------------------------------
+Pair    | 0.031268   | 0.035485   | 0.039491   |   1.6 | 13.13
+Bond    | 3.3378e-05 | 3.4848e-05 | 3.5667e-05 |   0.0 |  0.01
+Kspace  | 0.18632    | 0.19083    | 0.19556    |   0.8 | 70.59
+Neigh   | 0.012413   | 0.012991   | 0.013598   |   0.4 |  4.81
+Comm    | 0.028195   | 0.028407   | 0.028626   |   0.1 | 10.51
+Output  | 0.00013369 | 0.00015738 | 0.00022498 |   0.0 |  0.06
+Modify  | 0.00055373 | 0.00059062 | 0.00068807 |   0.0 |  0.22
+Other   |            | 0.001846   |            |       |  0.68
+
+Nlocal:          93.75 ave          95 max          92 min
+Histogram: 1 0 0 0 0 0 2 0 0 1
+Nghost:           2286 ave        2307 max        2269 min
+Histogram: 1 0 1 0 0 1 0 0 0 1
+Neighs:           4945 ave        5443 max        4513 min
+Histogram: 1 0 1 0 0 1 0 0 0 1
+
+Total # of neighbors = 19780
+Ave neighs/atom = 52.746667
+Ave special neighs/atom = 0
+Neighbor list builds = 66
+Dangerous builds = 0
+
+Total wall time: 0:00:00

examples/meam/msmeam/log.27Sep2024.msmeam.g++.1

@@ -1,4 +1,4 @@
-LAMMPS (7 Feb 2024 - Development - patch_7Feb2024_update1-182-g93942f2013-modified)
+LAMMPS (29 Aug 2024 - Development - patch_29Aug2024-372-g51d104975a)
 OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:98)
   using 1 OpenMP thread(s) per MPI task
 # Test of MEAM potential for HGa
@@ -67,7 +67,7 @@ Created 1 atoms
 variable        teng equal "c_eatoms"
 compute pot_energy all pe/atom
 compute stress all stress/atom NULL
-# dump 1 all custom 1 dump.msmeam id x y z fx fy fz c_pot_energy c_stress[1] c_stress[2] c_stress[3] c_stress[4] c_stress[5] c_stress[6]
+dump 1 all custom 1 dump.msmeam id x y z fx fy fz c_pot_energy c_stress[1] c_stress[2] c_stress[3] c_stress[4] c_stress[5] c_stress[6]
 run     1
 WARNING: No fixes with time integration, atoms won't move (src/verlet.cpp:60)
 Neighbor list info ...
@@ -89,22 +89,22 @@ Neighbor list info ...
       bin: none
 Per MPI rank memory allocation (min/avg/max) = 8.587 | 8.587 | 8.587 Mbytes
    Step          Temp          TotEng         Press           Pxx            Pyy            Pzz            Pxy            Pxz            Pyz             Lx             Ly             Lz           Volume        c_eatoms   
-         0   0              15.433079      491354.7       838670.96      635393.15      0              80195.797      0              0              8              8              8              512            15.433079    
-         1   0              15.433079      491354.7       838670.96      635393.15      0              80195.797      0              0              8              8              8              512            15.433079    
-Loop time of 4.4446e-05 on 1 procs for 1 steps with 3 atoms
+         0   0              15.438614      491542.52      839006.02      635621.55      0              80225.587      0              0              8              8              8              512            15.438614    
+         1   0              15.438614      491542.52      839006.02      635621.55      0              80225.587      0              0              8              8              8              512            15.438614    
+Loop time of 0.000144827 on 1 procs for 1 steps with 3 atoms
 
-Performance: 1943.932 ns/day, 0.012 hours/ns, 22499.213 timesteps/s, 67.498 katom-step/s
-31.5% CPU use with 1 MPI tasks x 1 OpenMP threads
+Performance: 596.574 ns/day, 0.040 hours/ns, 6904.790 timesteps/s, 20.714 katom-step/s
+21.4% CPU use with 1 MPI tasks x 1 OpenMP threads
 
 MPI task timing breakdown:
 Section |  min time  |  avg time  |  max time  |%varavg| %total
 ---------------------------------------------------------------
-Pair    | 2.9908e-05 | 2.9908e-05 | 2.9908e-05 |   0.0 | 67.29
+Pair    | 9.2136e-05 | 9.2136e-05 | 9.2136e-05 |   0.0 | 63.62
 Neigh   | 0          | 0          | 0          |   0.0 |  0.00
-Comm    | 1.033e-06  | 1.033e-06  | 1.033e-06  |   0.0 |  2.32
-Output  | 9.347e-06  | 9.347e-06  | 9.347e-06  |   0.0 | 21.03
-Modify  | 2.02e-07   | 2.02e-07   | 2.02e-07   |   0.0 |  0.45
-Other   |            | 3.956e-06  |            |       |  8.90
+Comm    | 4.389e-06  | 4.389e-06  | 4.389e-06  |   0.0 |  3.03
+Output  | 3.9556e-05 | 3.9556e-05 | 3.9556e-05 |   0.0 | 27.31
+Modify  | 9.92e-07   | 9.92e-07   | 9.92e-07   |   0.0 |  0.68
+Other   |            | 7.754e-06  |            |       |  5.35
 
 Nlocal:              3 ave           3 max           3 min
 Histogram: 1 0 0 0 0 0 0 0 0 0

examples/meam/msmeam/log.27Sep2024.msmeam.g++.4

@@ -1,4 +1,4 @@
-LAMMPS (7 Feb 2024 - Development - patch_7Feb2024_update1-182-g93942f2013-modified)
+LAMMPS (29 Aug 2024 - Development - patch_29Aug2024-372-g51d104975a)
 OMP_NUM_THREADS environment is not set. Defaulting to 1 thread. (src/comm.cpp:98)
   using 1 OpenMP thread(s) per MPI task
 # Test of MEAM potential for HGa
@@ -67,7 +67,7 @@ Created 1 atoms
 variable        teng equal "c_eatoms"
 compute pot_energy all pe/atom
 compute stress all stress/atom NULL
-# dump 1 all custom 1 dump.msmeam id x y z fx fy fz c_pot_energy c_stress[1] c_stress[2] c_stress[3] c_stress[4] c_stress[5] c_stress[6]
+dump 1 all custom 1 dump.msmeam id x y z fx fy fz c_pot_energy c_stress[1] c_stress[2] c_stress[3] c_stress[4] c_stress[5] c_stress[6]
 run     1
 WARNING: No fixes with time integration, atoms won't move (src/verlet.cpp:60)
 Neighbor list info ...
@@ -89,22 +89,22 @@ Neighbor list info ...
       bin: none
 Per MPI rank memory allocation (min/avg/max) = 7.965 | 8.123 | 8.594 Mbytes
    Step          Temp          TotEng         Press           Pxx            Pyy            Pzz            Pxy            Pxz            Pyz             Lx             Ly             Lz           Volume        c_eatoms   
-         0   0              15.433079      491354.7       838670.96      635393.15      0              80195.797      0              0              8              8              8              512            15.433079    
-         1   0              15.433079      491354.7       838670.96      635393.15      0              80195.797      0              0              8              8              8              512            15.433079    
-Loop time of 8.70645e-05 on 4 procs for 1 steps with 3 atoms
+         0   0              15.438614      491542.52      839006.02      635621.55      0              80225.587      0              0              8              8              8              512            15.438614    
+         1   0              15.438614      491542.52      839006.02      635621.55      0              80225.587      0              0              8              8              8              512            15.438614    
+Loop time of 0.000328503 on 4 procs for 1 steps with 3 atoms
 
-Performance: 992.368 ns/day, 0.024 hours/ns, 11485.738 timesteps/s, 34.457 katom-step/s
-29.0% CPU use with 4 MPI tasks x 1 OpenMP threads
+Performance: 263.011 ns/day, 0.091 hours/ns, 3044.110 timesteps/s, 9.132 katom-step/s
+75.3% CPU use with 4 MPI tasks x 1 OpenMP threads
 
 MPI task timing breakdown:
 Section |  min time  |  avg time  |  max time  |%varavg| %total
 ---------------------------------------------------------------
-Pair    | 4.3957e-05 | 4.67e-05   | 5.1056e-05 |   0.0 | 53.64
+Pair    | 0.0001419  | 0.0001471  | 0.00015891 |   0.0 | 44.78
 Neigh   | 0          | 0          | 0          |   0.0 |  0.00
-Comm    | 1.105e-05  | 1.3822e-05 | 1.7033e-05 |   0.0 | 15.88
-Output  | 1.5765e-05 | 1.9045e-05 | 2.5216e-05 |   0.0 | 21.87
-Modify  | 2.58e-07   | 3.465e-07  | 3.81e-07   |   0.0 |  0.40
-Other   |            | 7.151e-06  |            |       |  8.21
+Comm    | 2.2092e-05 | 2.8424e-05 | 3.667e-05  |   0.0 |  8.65
+Output  | 8.6275e-05 | 0.00010558 | 0.0001422  |   0.0 | 32.14
+Modify  | 1.093e-06  | 2.4148e-06 | 5.651e-06  |   0.0 |  0.74
+Other   |            | 4.498e-05  |            |       | 13.69
 
 Nlocal:           0.75 ave           3 max           0 min
 Histogram: 3 0 0 0 0 0 0 0 0 1

fortran/lammps.f90

@@ -3224,6 +3224,7 @@ CONTAINS
     TYPE(c_ptr) :: c_id, c_caller
     TYPE(c_funptr) :: c_callback
     INTEGER :: i, this_fix
+    TYPE(fix_external_data), DIMENSION(:), ALLOCATABLE :: tmp_ext_data
 
     c_id = f2c_string(id)
     IF (ALLOCATED(ext_data)) THEN
@@ -3235,9 +3236,13 @@ CONTAINS
         END IF
       END DO
       IF (this_fix > SIZE(ext_data)) THEN
-        ! reallocates ext_data; this requires us to re-bind "caller" on the C
+        ! reallocate ext_data in a pre-fortran 2008 compatible way.
+        ALLOCATE(tmp_ext_data(this_fix))
+        tmp_ext_data(1:this_fix-1) = ext_data(1:this_fix-1)
+        tmp_ext_data(this_fix) = fix_external_data()
+        CALL move_alloc(tmp_ext_data, ext_data)
+        ! this requires us to re-bind "caller" on the C
         ! side to the new data structure, which likely moved to a new address
-        ext_data = [ext_data, fix_external_data()] ! extends ext_data by 1
         CALL rebind_external_callback_data()
       END IF
     ELSE

lib/colvars/colvaratoms.cpp

@@ -1217,23 +1217,30 @@ void cvm::atom_group::calc_fit_gradients()
   if (cvm::debug())
     cvm::log("Calculating fit gradients.\n");
 
+  cvm::atom_group *group_for_fit = fitting_group ? fitting_group : this;
+
+  auto accessor_main = [this](size_t i){return atoms[i].grad;};
+  auto accessor_fitting = [&group_for_fit](size_t j, const cvm::rvector& grad){group_for_fit->fit_gradients[j] = grad;};
   if (is_enabled(f_ag_center) && is_enabled(f_ag_rotate))
-    calc_fit_gradients_impl<true, true>();
+    calc_fit_forces_impl<true, true>(accessor_main, accessor_fitting);
   if (is_enabled(f_ag_center) && !is_enabled(f_ag_rotate))
-    calc_fit_gradients_impl<true, false>();
+    calc_fit_forces_impl<true, false>(accessor_main, accessor_fitting);
   if (!is_enabled(f_ag_center) && is_enabled(f_ag_rotate))
-    calc_fit_gradients_impl<false, true>();
+    calc_fit_forces_impl<false, true>(accessor_main, accessor_fitting);
   if (!is_enabled(f_ag_center) && !is_enabled(f_ag_rotate))
-    calc_fit_gradients_impl<false, false>();
+    calc_fit_forces_impl<false, false>(accessor_main, accessor_fitting);
 
   if (cvm::debug())
     cvm::log("Done calculating fit gradients.\n");
 }
 
 
-template <bool B_ag_center, bool B_ag_rotate>
-void cvm::atom_group::calc_fit_gradients_impl() {
-  cvm::atom_group *group_for_fit = fitting_group ? fitting_group : this;
+template <bool B_ag_center, bool B_ag_rotate,
+          typename main_force_accessor_T, typename fitting_force_accessor_T>
+void cvm::atom_group::calc_fit_forces_impl(
+  main_force_accessor_T accessor_main,
+  fitting_force_accessor_T accessor_fitting) const {
+  const cvm::atom_group *group_for_fit = fitting_group ? fitting_group : this;
   // the center of geometry contribution to the gradients
   cvm::rvector atom_grad;
   // the rotation matrix contribution to the gradients
@@ -1245,15 +1252,15 @@ void cvm::atom_group::calc_fit_gradients_impl() {
   for (size_t i = 0; i < size(); i++) {
     cvm::atom_pos pos_orig;
     if (B_ag_center) {
-      atom_grad += atoms[i].grad;
+      atom_grad += accessor_main(i);
       if (B_ag_rotate) pos_orig = rot_inv * (atoms[i].pos - ref_pos_cog);
     } else {
-      if (B_ag_rotate) pos_orig = atoms[i].pos;
+      if (B_ag_rotate) pos_orig = rot_inv * atoms[i].pos;
     }
     if (B_ag_rotate) {
       // calculate \partial(R(q) \vec{x}_i)/\partial q) \cdot \partial\xi/\partial\vec{x}_i
       cvm::quaternion const dxdq =
-        rot.q.position_derivative_inner(pos_orig, atoms[i].grad);
+        rot.q.position_derivative_inner(pos_orig, accessor_main(i));
       sum_dxdq[0] += dxdq[0];
       sum_dxdq[1] += dxdq[1];
       sum_dxdq[2] += dxdq[2];
@@ -1261,26 +1268,45 @@ void cvm::atom_group::calc_fit_gradients_impl() {
     }
   }
   if (B_ag_center) {
-    if (B_ag_rotate) atom_grad = rot.inverse().matrix() * atom_grad;
+    if (B_ag_rotate) atom_grad = rot_inv * atom_grad;
     atom_grad *= (-1.0)/(cvm::real(group_for_fit->size()));
   }
   // loop 2: iterate over the fitting group
   if (B_ag_rotate) rot_deriv->prepare_derivative(rotation_derivative_dldq::use_dq);
   for (size_t j = 0; j < group_for_fit->size(); j++) {
+    cvm::rvector fitting_force_grad{0, 0, 0};
     if (B_ag_center) {
-      group_for_fit->fit_gradients[j] = atom_grad;
+      fitting_force_grad += atom_grad;
     }
     if (B_ag_rotate) {
       rot_deriv->calc_derivative_wrt_group1(j, nullptr, &dq0_1);
       // multiply by {\partial q}/\partial\vec{x}_j and add it to the fit gradients
-      group_for_fit->fit_gradients[j] += sum_dxdq[0] * dq0_1[0] +
-                                          sum_dxdq[1] * dq0_1[1] +
-                                          sum_dxdq[2] * dq0_1[2] +
-                                          sum_dxdq[3] * dq0_1[3];
+      fitting_force_grad += sum_dxdq[0] * dq0_1[0] +
+                            sum_dxdq[1] * dq0_1[1] +
+                            sum_dxdq[2] * dq0_1[2] +
+                            sum_dxdq[3] * dq0_1[3];
     }
+    if (cvm::debug()) {
+      cvm::log(cvm::to_str(fitting_force_grad));
+    }
+    accessor_fitting(j, fitting_force_grad);
   }
 }
 
+template <typename main_force_accessor_T, typename fitting_force_accessor_T>
+void cvm::atom_group::calc_fit_forces(
+  main_force_accessor_T accessor_main,
+    fitting_force_accessor_T accessor_fitting) const {
+  if (is_enabled(f_ag_center) && is_enabled(f_ag_rotate))
+    calc_fit_forces_impl<true, true, main_force_accessor_T, fitting_force_accessor_T>(accessor_main, accessor_fitting);
+  if (is_enabled(f_ag_center) && !is_enabled(f_ag_rotate))
+    calc_fit_forces_impl<true, false, main_force_accessor_T, fitting_force_accessor_T>(accessor_main, accessor_fitting);
+  if (!is_enabled(f_ag_center) && is_enabled(f_ag_rotate))
+    calc_fit_forces_impl<false, true, main_force_accessor_T, fitting_force_accessor_T>(accessor_main, accessor_fitting);
+  if (!is_enabled(f_ag_center) && !is_enabled(f_ag_rotate))
+    calc_fit_forces_impl<false, false, main_force_accessor_T, fitting_force_accessor_T>(accessor_main, accessor_fitting);
+}
+
 
 std::vector<cvm::atom_pos> cvm::atom_group::positions() const
 {
@@ -1452,17 +1478,72 @@ void cvm::atom_group::apply_force(cvm::rvector const &force)
     return;
   }
 
-  if (is_enabled(f_ag_rotate)) {
+  auto ag_force = get_group_force_object();
+  for (size_t i = 0; i < size(); ++i) {
+    ag_force.add_atom_force(i, atoms[i].mass / total_mass * force);
+  }
+}
 
-    const auto rot_inv = rot.inverse().matrix();
-    for (cvm::atom_iter ai = this->begin(); ai != this->end(); ai++) {
-      ai->apply_force(rot_inv * ((ai->mass/total_mass) * force));
+cvm::atom_group::group_force_object cvm::atom_group::get_group_force_object() {
+  return cvm::atom_group::group_force_object(this);
+}
+
+cvm::atom_group::group_force_object::group_force_object(cvm::atom_group* ag):
+m_ag(ag), m_group_for_fit(m_ag->fitting_group ? m_ag->fitting_group : m_ag),
+m_has_fitting_force(m_ag->is_enabled(f_ag_center) || m_ag->is_enabled(f_ag_rotate)) {
+  if (m_has_fitting_force) {
+    if (m_ag->group_forces.size() != m_ag->size()) {
+      m_ag->group_forces.assign(m_ag->size(), 0);
+    } else {
+      std::fill(m_ag->group_forces.begin(),
+                m_ag->group_forces.end(), 0);
     }
+  }
+}
 
+cvm::atom_group::group_force_object::~group_force_object() {
+  if (m_has_fitting_force) {
+    apply_force_with_fitting_group();
+  }
+}
+
+void cvm::atom_group::group_force_object::add_atom_force(size_t i, const cvm::rvector& force) {
+  if (m_has_fitting_force) {
+    m_ag->group_forces[i] += force;
   } else {
+    // Apply the force directly if we don't use fitting
+    (*m_ag)[i].apply_force(force);
+  }
+}
 
-    for (cvm::atom_iter ai = this->begin(); ai != this->end(); ai++) {
-      ai->apply_force((ai->mass/total_mass) * force);
+void cvm::atom_group::group_force_object::apply_force_with_fitting_group() {
+  const cvm::rmatrix rot_inv = m_ag->rot.inverse().matrix();
+  if (cvm::debug()) {
+    cvm::log("Applying force on main group " + m_ag->name + ":\n");
+  }
+  for (size_t ia = 0; ia < m_ag->size(); ++ia) {
+    const cvm::rvector f_ia = rot_inv * m_ag->group_forces[ia];
+    (*m_ag)[ia].apply_force(f_ia);
+    if (cvm::debug()) {
+      cvm::log(cvm::to_str(f_ia));
+    }
+  }
+  // Gradients are only available with scalar components, so for a scalar component,
+  // if f_ag_fit_gradients is disabled, then the forces on the fitting group is not
+  // computed. For a vector component, we can only know the forces on the fitting
+  // group, but checking this flag can mimic results that the users expect (if
+  // "enableFitGradients no" then there is no force on the fitting group).
+  if (m_ag->is_enabled(f_ag_fit_gradients)) {
+    auto accessor_main = [this](size_t i){return m_ag->group_forces[i];};
+    auto accessor_fitting = [this](size_t j, const cvm::rvector& fitting_force){
+      (*(m_group_for_fit))[j].apply_force(fitting_force);
+    };
+    if (cvm::debug()) {
+      cvm::log("Applying force on the fitting group of main group" + m_ag->name + ":\n");
+    }
+    m_ag->calc_fit_forces(accessor_main, accessor_fitting);
+    if (cvm::debug()) {
+      cvm::log("Done applying force on the fitting group of main group" + m_ag->name + ":\n");
     }
   }
 }

lib/colvars/colvaratoms.h

@@ -257,8 +257,27 @@ protected:
   /// \brief Index in the colvarproxy arrays (if the group is scalable)
   int index;
 
+  /// \brief The temporary forces acting on the main group atoms.
+  ///        Currently this is only used for calculating the fitting group forces for
+  ///        non-scalar components.
+  std::vector<cvm::rvector> group_forces;
+
 public:
 
+  class group_force_object {
+  public:
+    group_force_object(cvm::atom_group* ag);
+    ~group_force_object();
+    void add_atom_force(size_t i, const cvm::rvector& force);
+  private:
+    cvm::atom_group* m_ag;
+    cvm::atom_group* m_group_for_fit;
+    bool m_has_fitting_force;
+    void apply_force_with_fitting_group();
+  };
+
+  group_force_object get_group_force_object();
+
   inline cvm::atom & operator [] (size_t const i)
   {
     return atoms[i];
@@ -497,15 +516,47 @@ public:
   /// \brief Calculate the derivatives of the fitting transformation
   void calc_fit_gradients();
 
-/*! @brief  Actual implementation of `calc_fit_gradients`. The template is
+/*! @brief  Actual implementation of `calc_fit_gradients` and
+ *          `calc_fit_forces`. The template is
  *          used to avoid branching inside the loops in case that the CPU
  *          branch prediction is broken (or further migration to GPU code).
  *  @tparam B_ag_center Centered the reference to origin? This should follow
  *          the value of `is_enabled(f_ag_center)`.
  *  @tparam B_ag_rotate Calculate the optimal rotation? This should follow
  *          the value of `is_enabled(f_ag_rotate)`.
+ *  @tparam main_force_accessor_T The type of accessor of the main
+ *          group forces or gradients.
+ *  @tparam fitting_force_accessor_T The type of accessor of the fitting group
+ *          forces or gradients.
+ *  @param accessor_main The accessor of the main group forces or gradients.
+ *         accessor_main(i) should return the i-th force or gradient of the
+ *         main group.
+ *  @param accessor_fitting The accessor of the fitting group forces or gradients.
+ *         accessor_fitting(j, v) should store/apply the j-th atom gradient or
+ *         force in the fitting group.
  */
-  template <bool B_ag_center, bool B_ag_rotate> void calc_fit_gradients_impl();
+  template <bool B_ag_center, bool B_ag_rotate,
+            typename main_force_accessor_T, typename fitting_force_accessor_T>
+  void calc_fit_forces_impl(
+    main_force_accessor_T accessor_main,
+    fitting_force_accessor_T accessor_fitting) const;
+
+/*! @brief  Calculate or apply the fitting group forces from the main group forces.
+ *  @tparam main_force_accessor_T The type of accessor of the main
+ *          group forces or gradients.
+ *  @tparam fitting_force_accessor_T The type of accessor of the fitting group
+ *          forces or gradients.
+ *  @param accessor_main The accessor of the main group forces or gradients.
+ *         accessor_main(i) should return the i-th force or gradient of the
+ *         main group.
+ *  @param accessor_fitting The accessor of the fitting group forces or gradients.
+ *         accessor_fitting(j, v) should store/apply the j-th atom gradient or
+ *         force in the fitting group.
+ */
+  template <typename main_force_accessor_T, typename fitting_force_accessor_T>
+  void calc_fit_forces(
+    main_force_accessor_T accessor_main,
+    fitting_force_accessor_T accessor_fitting) const;
 
   /// \brief Derivatives of the fitting transformation
   std::vector<cvm::atom_pos> fit_gradients;

lib/colvars/colvarbias_meta.cpp

@@ -11,24 +11,6 @@
 #include <iomanip>
 #include <algorithm>
 
-// Define function to get the absolute path of a replica file
-#if defined(_WIN32) && !defined(__CYGWIN__)
-#include <direct.h>
-#define GETCWD(BUF, SIZE) ::_getcwd(BUF, SIZE)
-#define PATHSEP "\\"
-#else
-#include <unistd.h>
-#define GETCWD(BUF, SIZE) ::getcwd(BUF, SIZE)
-#define PATHSEP "/"
-#endif
-
-#ifdef __cpp_lib_filesystem
-// When std::filesystem is available, use it
-#include <filesystem>
-#undef GETCWD
-#define GETCWD(BUF, SIZE) (std::filesystem::current_path().string().c_str())
-#endif
-
 #include "colvarmodule.h"
 #include "colvarproxy.h"
 #include "colvar.h"
@@ -451,8 +433,11 @@ int colvarbias_meta::update()
   error_code |= update_grid_params();
   // add new biasing energy/forces
   error_code |= update_bias();
-  // update grid content to reflect new bias
-  error_code |= update_grid_data();
+
+  if (use_grids) {
+    // update grid content to reflect new bias
+    error_code |= update_grid_data();
+  }
 
   if (comm != single_replica &&
       (cvm::step_absolute() % replica_update_freq) == 0) {
@@ -670,11 +655,20 @@ int colvarbias_meta::calc_energy(std::vector<colvarvalue> const *values)
     replicas[ir]->bias_energy = 0.0;
   }
 
-  std::vector<int> const curr_bin = values ?
-    hills_energy->get_colvars_index(*values) :
-    hills_energy->get_colvars_index();
+  bool index_ok = false;
+  std::vector<int> curr_bin;
 
-  if (hills_energy->index_ok(curr_bin)) {
+  if (use_grids) {
+
+    curr_bin = values ?
+      hills_energy->get_colvars_index(*values) :
+      hills_energy->get_colvars_index();
+
+    index_ok = hills_energy->index_ok(curr_bin);
+
+  }
+
+  if ( index_ok ) {
     // index is within the grid: get the energy from there
     for (ir = 0; ir < replicas.size(); ir++) {
 
@@ -723,11 +717,20 @@ int colvarbias_meta::calc_forces(std::vector<colvarvalue> const *values)
     }
   }
 
-  std::vector<int> const curr_bin = values ?
-    hills_energy->get_colvars_index(*values) :
-    hills_energy->get_colvars_index();
+  bool index_ok = false;
+  std::vector<int> curr_bin;
 
-  if (hills_energy->index_ok(curr_bin)) {
+  if (use_grids) {
+
+    curr_bin = values ?
+      hills_energy->get_colvars_index(*values) :
+      hills_energy->get_colvars_index();
+
+    index_ok = hills_energy->index_ok(curr_bin);
+
+  }
+
+  if ( index_ok ) {
     for (ir = 0; ir < replicas.size(); ir++) {
       cvm::real const *f = &(replicas[ir]->hills_energy_gradients->value(curr_bin));
       for (ic = 0; ic < num_variables(); ic++) {
@@ -1718,29 +1721,17 @@ int colvarbias_meta::setup_output()
 
   if (comm == multiple_replicas) {
 
-    // TODO: one may want to specify the path manually for intricated filesystems?
-    char *pwd = new char[3001];
-    if (GETCWD(pwd, 3000) == nullptr) {
-      if (pwd != nullptr) { //
-        delete[] pwd;
-      }
-      return cvm::error("Error: cannot get the path of the current working directory.\n",
-                        COLVARS_BUG_ERROR);
-    }
-
+    auto const pwd = cvm::main()->proxy->get_current_work_dir();
     replica_list_file =
-      (std::string(pwd)+std::string(PATHSEP)+
-       this->name+"."+replica_id+".files.txt");
+        cvm::main()->proxy->join_paths(pwd, this->name + "." + replica_id + ".files.txt");
     // replica_hills_file and replica_state_file are those written
     // by the current replica; within the mirror biases, they are
     // those by another replica
-    replica_hills_file =
-      (std::string(pwd)+std::string(PATHSEP)+
-       cvm::output_prefix()+".colvars."+this->name+"."+replica_id+".hills");
-    replica_state_file =
-      (std::string(pwd)+std::string(PATHSEP)+
-       cvm::output_prefix()+".colvars."+this->name+"."+replica_id+".state");
-    delete[] pwd;
+    replica_hills_file = cvm::main()->proxy->join_paths(
+        pwd, cvm::output_prefix() + ".colvars." + this->name + "." + replica_id + ".hills");
+
+    replica_state_file = cvm::main()->proxy->join_paths(
+        pwd, cvm::output_prefix() + ".colvars." + this->name + "." + replica_id + ".state");
 
     // now register this replica
 

lib/colvars/colvarcomp_distances.cpp

@@ -384,32 +384,30 @@ void colvar::distance_dir::apply_force(colvarvalue const &force)
   cvm::real const iprod = force.rvector_value * x.rvector_value;
   cvm::rvector const force_tang = force.rvector_value - iprod * x.rvector_value;
 
-  if (!group1->noforce)
-    group1->apply_force(-1.0 * force_tang);
-
-  if (!group2->noforce)
-    group2->apply_force(       force_tang);
+  if (!group1->noforce) {
+    group1->apply_force(-1.0 / dist_v.norm() * force_tang);
+  }
+  if (!group2->noforce) {
+    group2->apply_force( 1.0 / dist_v.norm() * force_tang);
+  }
 }
 
 
-cvm::real colvar::distance_dir::dist2(colvarvalue const &x1,
-                                      colvarvalue const &x2) const
+cvm::real colvar::distance_dir::dist2(colvarvalue const &x1, colvarvalue const &x2) const
 {
-  return (x1.rvector_value - x2.rvector_value).norm2();
+  return x1.dist2(x2);
 }
 
 
-colvarvalue colvar::distance_dir::dist2_lgrad(colvarvalue const &x1,
-                                              colvarvalue const &x2) const
+colvarvalue colvar::distance_dir::dist2_lgrad(colvarvalue const &x1, colvarvalue const &x2) const
 {
-  return colvarvalue((x1.rvector_value - x2.rvector_value), colvarvalue::type_unit3vectorderiv);
+  return x1.dist2_grad(x2);
 }
 
 
-colvarvalue colvar::distance_dir::dist2_rgrad(colvarvalue const &x1,
-                                              colvarvalue const &x2) const
+colvarvalue colvar::distance_dir::dist2_rgrad(colvarvalue const &x1, colvarvalue const &x2) const
 {
-  return colvarvalue((x2.rvector_value - x1.rvector_value), colvarvalue::type_unit3vectorderiv);
+  return x2.dist2_grad(x1);
 }
 
 
@@ -1403,11 +1401,12 @@ void colvar::cartesian::apply_force(colvarvalue const &force)
   size_t ia, j;
   if (!atoms->noforce) {
     cvm::rvector f;
+    auto ag_force = atoms->get_group_force_object();
     for (ia = 0; ia < atoms->size(); ia++) {
       for (j = 0; j < dim; j++) {
         f[axes[j]] = force.vector1d_value[dim*ia + j];
       }
-      (*atoms)[ia].apply_force(f);
+      ag_force.add_atom_force(ia, f);
     }
   }
 }

lib/colvars/colvarcomp_rotations.cpp

@@ -137,11 +137,14 @@ void colvar::orientation::apply_force(colvarvalue const &force)
   if (!atoms->noforce) {
     rot_deriv_impl->prepare_derivative(rotation_derivative_dldq::use_dq);
     cvm::vector1d<cvm::rvector> dq0_2;
+    auto ag_force = atoms->get_group_force_object();
     for (size_t ia = 0; ia < atoms->size(); ia++) {
       rot_deriv_impl->calc_derivative_wrt_group2(ia, nullptr, &dq0_2);
-      for (size_t i = 0; i < 4; i++) {
-        (*atoms)[ia].apply_force(FQ[i] * dq0_2[i]);
-      }
+      const auto f_ia = FQ[0] * dq0_2[0] +
+                        FQ[1] * dq0_2[1] +
+                        FQ[2] * dq0_2[2] +
+                        FQ[3] * dq0_2[3];
+      ag_force.add_atom_force(ia, f_ia);
     }
   }
 }

lib/colvars/colvargrid.cpp

@@ -617,7 +617,7 @@ integrate_potential::integrate_potential(std::vector<colvar *> &colvars, std::sh
 }
 
 
-integrate_potential::integrate_potential(std::shared_ptr<colvar_grid_gradient> gradients)
+integrate_potential::integrate_potential(colvar_grid_gradient * gradients)
   : b_smoothed(false),
     gradients(gradients)
 {

lib/colvars/colvargrid.h

@@ -1832,7 +1832,7 @@ class integrate_potential : public colvar_grid_scalar
   integrate_potential(std::vector<colvar *> &colvars, std::shared_ptr<colvar_grid_gradient> gradients);
 
   /// Constructor from a gradient grid (for processing grid files without a Colvars config)
-  integrate_potential(std::shared_ptr<colvar_grid_gradient> gradients);
+  integrate_potential(colvar_grid_gradient * gradients);
 
   /// \brief Calculate potential from divergence (in 2D); return number of steps
   int integrate(const int itmax, const cvm::real & tol, cvm::real & err, bool verbose = true);

lib/colvars/colvarmodule.h

@@ -84,7 +84,7 @@ private:
   int version_int = 0;
 
   /// Patch version number (non-zero in patch releases of other packages)
-  int patch_version_int = 0;
+  int patch_version_int = 2;
 
 public:
 

lib/colvars/colvarproxy_io.cpp

@@ -8,13 +8,20 @@
 // Colvars repository at GitHub.
 
 // Using access() to check if a file exists (until we can assume C++14/17)
-#if !defined(_WIN32) || defined(__CYGWIN__)
+#if defined(_WIN32) && !defined(__CYGWIN__)
+#include <direct.h>
+#else
 #include <unistd.h>
 #endif
+
 #if defined(_WIN32)
 #include <io.h>
 #endif
 
+#ifdef __cpp_lib_filesystem
+#include <filesystem>
+#endif
+
 #include <cerrno>
 #include <cstdio>
 
@@ -64,6 +71,53 @@ int colvarproxy_io::set_frame(long int)
 }
 
 
+std::string colvarproxy_io::get_current_work_dir() const
+{
+#ifdef __cpp_lib_filesystem
+
+  return std::filesystem::current_path().string();
+
+#else
+
+  // Legacy code
+  size_t constexpr buf_size = 3001;
+  char buf[buf_size];
+
+#if defined(_WIN32) && !defined(__CYGWIN__)
+  char *getcwd_result = ::_getcwd(buf, buf_size);
+#else
+  char *getcwd_result = ::getcwd(buf, buf_size);
+#endif
+
+  if (getcwd_result == nullptr) {
+    cvm::error("Error: cannot read the current working directory.\n", COLVARS_INPUT_ERROR);
+    return std::string("");
+  }
+
+  return std::string(getcwd_result);
+#endif
+}
+
+
+std::string colvarproxy_io::join_paths(std::string const &path1, std::string const &path2) const
+{
+#ifdef __cpp_lib_filesystem
+
+  return (std::filesystem::path(path1) / std::filesystem::path(path2)).string();
+
+#else
+
+  // Legacy code
+#if defined(_WIN32) && !defined(__CYGWIN__)
+  return (path1 + "\\" + path2);
+#else
+  return (path1 + "/" + path2);
+#endif
+
+#endif
+}
+
+
 int colvarproxy_io::backup_file(char const *filename)
 {
   // Simplified version of NAMD_file_exists()

lib/colvars/colvarproxy_io.h

@@ -38,6 +38,12 @@ public:
   // Returns error code
   virtual int set_frame(long int);
 
+  /// Get the current working directory of this process
+  std::string get_current_work_dir() const;
+
+  /// Join two paths using the operating system's path separation
+  std::string join_paths(std::string const &path1, std::string const &path2) const;
+
   /// \brief Rename the given file, before overwriting it
   virtual int backup_file(char const *filename);
 

lib/colvars/colvarproxy_system.h

@@ -94,6 +94,7 @@ public:
   virtual bool total_forces_enabled() const;
 
   /// Are total forces from the current step available?
+  /// in which case they are really system forces
   virtual bool total_forces_same_step() const;
 
   /// Get the molecule ID when called in VMD; raise error otherwise

lib/colvars/colvarvalue.cpp

@@ -153,29 +153,6 @@ std::string const colvarvalue::type_keyword(Type t)
 }
 
 
-size_t colvarvalue::num_df(Type t)
-{
-  switch (t) {
-  case colvarvalue::type_notset:
-  default:
-    return 0; break;
-  case colvarvalue::type_scalar:
-    return 1; break;
-  case colvarvalue::type_3vector:
-    return 3; break;
-  case colvarvalue::type_unit3vector:
-  case colvarvalue::type_unit3vectorderiv:
-    return 2; break;
-  case colvarvalue::type_quaternion:
-  case colvarvalue::type_quaternionderiv:
-    return 3; break;
-  case colvarvalue::type_vector:
-    // the size of a vector is unknown without its object
-    return 0; break;
-  }
-}
-
-
 size_t colvarvalue::num_dimensions(Type t)
 {
   switch (t) {
@@ -591,6 +568,97 @@ cvm::real operator * (colvarvalue const &x1,
 }
 
 
+cvm::real colvarvalue::norm2() const
+{
+  switch (value_type) {
+  case colvarvalue::type_scalar:
+    return (this->real_value)*(this->real_value);
+  case colvarvalue::type_3vector:
+  case colvarvalue::type_unit3vector:
+  case colvarvalue::type_unit3vectorderiv:
+    return (this->rvector_value).norm2();
+  case colvarvalue::type_quaternion:
+  case colvarvalue::type_quaternionderiv:
+    return (this->quaternion_value).norm2();
+  case colvarvalue::type_vector:
+    if (elem_types.size() > 0) {
+      // if we have information about non-scalar types, use it
+      cvm::real result = 0.0;
+      size_t i;
+      for (i = 0; i < elem_types.size(); i++) {
+        result += (this->get_elem(i)).norm2();
+      }
+      return result;
+    } else {
+      return vector1d_value.norm2();
+    }
+    break;
+  case colvarvalue::type_notset:
+  default:
+    return 0.0;
+  }
+}
+
+
+cvm::real colvarvalue::sum() const
+{
+  switch (value_type) {
+  case colvarvalue::type_scalar:
+    return (this->real_value);
+  case colvarvalue::type_3vector:
+  case colvarvalue::type_unit3vector:
+  case colvarvalue::type_unit3vectorderiv:
+    return (this->rvector_value).x + (this->rvector_value).y +
+      (this->rvector_value).z;
+  case colvarvalue::type_quaternion:
+  case colvarvalue::type_quaternionderiv:
+    return (this->quaternion_value).q0 + (this->quaternion_value).q1 +
+      (this->quaternion_value).q2 + (this->quaternion_value).q3;
+  case colvarvalue::type_vector:
+    return (this->vector1d_value).sum();
+  case colvarvalue::type_notset:
+  default:
+    return 0.0;
+  }
+}
+
+
+cvm::real colvarvalue::dist2(colvarvalue const &x2) const
+{
+  colvarvalue::check_types(*this, x2);
+
+  switch (this->type()) {
+  case colvarvalue::type_scalar:
+    return (this->real_value - x2.real_value) * (this->real_value - x2.real_value);
+  case colvarvalue::type_3vector:
+    return (this->rvector_value - x2.rvector_value).norm2();
+  case colvarvalue::type_unit3vector: {
+    cvm::rvector const &v1 = this->rvector_value;
+    cvm::rvector const &v2 = x2.rvector_value;
+    cvm::real const theta = cvm::acos(v1 * v2);
+    return theta * theta;
+  }
+  case colvarvalue::type_quaternion:
+    // angle between (*this) and x2 is the distance, the quaternion
+    // object has it implemented internally
+    return this->quaternion_value.dist2(x2.quaternion_value);
+  case colvarvalue::type_vector:
+    return (this->vector1d_value - x2.vector1d_value).norm2();
+  case colvarvalue::type_unit3vectorderiv:
+  case colvarvalue::type_quaternionderiv:
+    cvm::error("Error: computing a squared-distance between two variables of type \"" +
+                   type_desc(this->type()) + "\", for which it is not defined.\n",
+               COLVARS_BUG_ERROR);
+  case colvarvalue::type_notset:
+  default:
+    this->undef_op();
+    return 0.0;
+  };
+
+  return 0.0;
+}
+
+
 colvarvalue colvarvalue::dist2_grad(colvarvalue const &x2) const
 {
   colvarvalue::check_types(*this, x2);
@@ -600,25 +668,30 @@ colvarvalue colvarvalue::dist2_grad(colvarvalue const &x2) const
     return 2.0 * (this->real_value - x2.real_value);
   case colvarvalue::type_3vector:
     return 2.0 * (this->rvector_value - x2.rvector_value);
-  case colvarvalue::type_unit3vector:
-  case colvarvalue::type_unit3vectorderiv:
-    {
-      cvm::rvector const &v1 = this->rvector_value;
-      cvm::rvector const &v2 = x2.rvector_value;
-      cvm::real const cos_t = v1 * v2;
-      return colvarvalue(2.0 * (cos_t * v1 - v2), colvarvalue::type_unit3vectorderiv);
-    }
+  case colvarvalue::type_unit3vector: {
+    cvm::rvector const &v1 = this->rvector_value;
+    cvm::rvector const &v2 = x2.rvector_value;
+    cvm::real const cos_t = v1 * v2;
+    return colvarvalue(2.0 * std::acos(cos_t) * -1.0 / cvm::sqrt(1.0 - cos_t * cos_t) * v2,
+                       colvarvalue::type_unit3vectorderiv);
+  }
   case colvarvalue::type_quaternion:
-  case colvarvalue::type_quaternionderiv:
     return this->quaternion_value.dist2_grad(x2.quaternion_value);
   case colvarvalue::type_vector:
     return colvarvalue(2.0 * (this->vector1d_value - x2.vector1d_value), colvarvalue::type_vector);
     break;
+  case colvarvalue::type_unit3vectorderiv:
+  case colvarvalue::type_quaternionderiv:
+    cvm::error("Error: computing a squared-distance gradient between two variables of type \"" +
+                   type_desc(this->type()) + "\", for which it is not defined.\n",
+               COLVARS_BUG_ERROR);
   case colvarvalue::type_notset:
   default:
     this->undef_op();
     return colvarvalue(colvarvalue::type_notset);
   };
+
+  return colvarvalue(colvarvalue::type_notset);
 }
 
 

lib/colvars/colvarvalue.h

@@ -109,9 +109,6 @@ public:
   /// User keywords for specifying value types in the configuration
   static std::string const type_keyword(Type t);
 
-  /// Number of degrees of freedom for each supported type
-  static size_t num_df(Type t);
-
   /// Number of dimensions for each supported type (used to allocate vector1d_value)
   static size_t num_dimensions(Type t);
 
@@ -671,87 +668,4 @@ inline cvm::vector1d<cvm::real> const colvarvalue::as_vector() const
 }
 
 
-inline cvm::real colvarvalue::norm2() const
-{
-  switch (value_type) {
-  case colvarvalue::type_scalar:
-    return (this->real_value)*(this->real_value);
-  case colvarvalue::type_3vector:
-  case colvarvalue::type_unit3vector:
-  case colvarvalue::type_unit3vectorderiv:
-    return (this->rvector_value).norm2();
-  case colvarvalue::type_quaternion:
-  case colvarvalue::type_quaternionderiv:
-    return (this->quaternion_value).norm2();
-  case colvarvalue::type_vector:
-    if (elem_types.size() > 0) {
-      // if we have information about non-scalar types, use it
-      cvm::real result = 0.0;
-      size_t i;
-      for (i = 0; i < elem_types.size(); i++) {
-        result += (this->get_elem(i)).norm2();
-      }
-      return result;
-    } else {
-      return vector1d_value.norm2();
-    }
-    break;
-  case colvarvalue::type_notset:
-  default:
-    return 0.0;
-  }
-}
-
-
-inline cvm::real colvarvalue::sum() const
-{
-  switch (value_type) {
-  case colvarvalue::type_scalar:
-    return (this->real_value);
-  case colvarvalue::type_3vector:
-  case colvarvalue::type_unit3vector:
-  case colvarvalue::type_unit3vectorderiv:
-    return (this->rvector_value).x + (this->rvector_value).y +
-      (this->rvector_value).z;
-  case colvarvalue::type_quaternion:
-  case colvarvalue::type_quaternionderiv:
-    return (this->quaternion_value).q0 + (this->quaternion_value).q1 +
-      (this->quaternion_value).q2 + (this->quaternion_value).q3;
-  case colvarvalue::type_vector:
-    return (this->vector1d_value).sum();
-  case colvarvalue::type_notset:
-  default:
-    return 0.0;
-  }
-}
-
-
-inline cvm::real colvarvalue::dist2(colvarvalue const &x2) const
-{
-  colvarvalue::check_types(*this, x2);
-
-  switch (this->type()) {
-  case colvarvalue::type_scalar:
-    return (this->real_value - x2.real_value)*(this->real_value - x2.real_value);
-  case colvarvalue::type_3vector:
-    return (this->rvector_value - x2.rvector_value).norm2();
-  case colvarvalue::type_unit3vector:
-  case colvarvalue::type_unit3vectorderiv:
-    // angle between (*this) and x2 is the distance
-    return cvm::acos(this->rvector_value * x2.rvector_value) * cvm::acos(this->rvector_value * x2.rvector_value);
-  case colvarvalue::type_quaternion:
-  case colvarvalue::type_quaternionderiv:
-    // angle between (*this) and x2 is the distance, the quaternion
-    // object has it implemented internally
-    return this->quaternion_value.dist2(x2.quaternion_value);
-  case colvarvalue::type_vector:
-    return (this->vector1d_value - x2.vector1d_value).norm2();
-  case colvarvalue::type_notset:
-  default:
-    this->undef_op();
-    return 0.0;
-  };
-}
-
-
 #endif

lib/gpu/lal_dpd_coul_slater_long.cu

@@ -287,16 +287,16 @@ __kernel void k_dpd_coul_slater_long(const __global numtyp4 *restrict x_,
       
         // apply Slater electrostatic force if distance below Slater cutoff 
         // and the two species have a slater coeff
-        // cutsq[mtype].z -> Coulombic squared cutoff
-        if ( cutsq[mtype].z != 0.0 && rsq < cutsq[mtype].z){
+        // cutsq[mtype].z -> Slater cutoff
+        // extra[j].x -> q[j] ; particle j charge
+        if ( rsq < cutsq[mtype].z ){
           numtyp r2inv=ucl_recip(rsq);
           numtyp _erfc;
           numtyp grij = g_ewald * r;
           numtyp expm2 = ucl_exp(-grij*grij);
           numtyp t = ucl_recip((numtyp)1.0 + EWALD_P*grij);
           _erfc = t * (A1+t*(A2+t*(A3+t*(A4+t*A5)))) * expm2;
-          numtyp prefactor = extra[j].x;
-          prefactor *= qqrd2e * cutsq[mtype].z * qtmp/r;
+          numtyp prefactor = qqrd2e * extra[j].x * qtmp / r;
           numtyp rlamdainv = r * lamdainv;
           numtyp exprlmdainv = ucl_exp((numtyp)-2.0*rlamdainv);
           numtyp slater_term = exprlmdainv*((numtyp)1.0 + ((numtyp)2.0*rlamdainv*((numtyp)1.0+rlamdainv)));
@@ -306,9 +306,9 @@ __kernel void k_dpd_coul_slater_long(const __global numtyp4 *restrict x_,
 
           if (EVFLAG && eflag) {
             numtyp e_slater = ((numtyp)1.0 + rlamdainv)*exprlmdainv;
-            numtyp e = prefactor*(_erfc-e_slater);
-            if (factor_coul > (numtyp)0) e -= factor_coul*prefactor*((numtyp)1.0 - e_slater);
-            e_coul += e;
+            numtyp e_sf = prefactor*(_erfc-e_slater);
+            if (factor_coul > (numtyp)0) e_sf -= factor_coul*prefactor*((numtyp)1.0 - e_slater);
+            e_coul += e_sf;
           }
         } // if cut_coulsq
 
@@ -471,16 +471,16 @@ __kernel void k_dpd_coul_slater_long_fast(const __global numtyp4 *restrict x_,
       
         // apply Slater electrostatic force if distance below Slater cutoff 
         // and the two species have a slater coeff
-        // cutsq[mtype].z -> Coulombic squared cutoff
-        if ( cutsq[mtype].z != 0.0 && rsq < cutsq[mtype].z){
+        // cutsq[mtype].z -> Slater cutoff
+        // extra[j].x -> q[j] ; particle j charge
+        if ( rsq < cutsq[mtype].z ){
           numtyp r2inv=ucl_recip(rsq);
           numtyp _erfc;
           numtyp grij = g_ewald * r;
           numtyp expm2 = ucl_exp(-grij*grij);
           numtyp t = ucl_recip((numtyp)1.0 + EWALD_P*grij);
           _erfc = t * (A1+t*(A2+t*(A3+t*(A4+t*A5)))) * expm2;
-          numtyp prefactor = extra[j].x;
-          prefactor *= qqrd2e * cutsq[mtype].z * qtmp/r;
+          numtyp prefactor = qqrd2e * extra[j].x * qtmp / r;
           numtyp rlamdainv = r * lamdainv;
           numtyp exprlmdainv = ucl_exp((numtyp)-2.0*rlamdainv);
           numtyp slater_term = exprlmdainv*((numtyp)1.0 + ((numtyp)2.0*rlamdainv*((numtyp)1.0+rlamdainv)));

lib/gpu/lal_dpd_coul_slater_long.h

@@ -65,7 +65,7 @@ class DPDCoulSlaterLong : public BaseDPD<numtyp, acctyp> {
   /// coeff.x = a0, coeff.y = gamma, coeff.z = sigma, coeff.w = cut_dpd
   UCL_D_Vec<numtyp4> coeff;
 
-  /// cutsq.x = cutsq, cutsq.y = cut_dpdsq, cutsq.w = cut_slatersq
+  /// cutsq.x = cutsq, cutsq.y = cut_dpdsq, cutsq.z = cut_slatersq
   UCL_D_Vec<numtyp4> cutsq;
 
   /// Special LJ values

lib/gpu/lal_eam.cpp

@@ -61,7 +61,7 @@ int EAMT::init(const int ntypes, double host_cutforcesq, int **host_type2rhor,
       if (onetype>0)
         onetype=-1;
       else if (onetype==0)
-        onetype=i*max_shared_types+i;
+        onetype=i;
     }
   if (onetype<0) onetype=0;
   #endif
@@ -109,7 +109,7 @@ int EAMT::init(const int ntypes, double host_cutforcesq, int **host_type2rhor,
   int lj_types=ntypes;
   shared_types=false;
 
-  if (lj_types<=max_shared_types && this->_block_size>=max_shared_types) {
+  if (lj_types<=max_shared_types && this->_block_size>=max_shared_types*max_shared_types) {
     lj_types=max_shared_types;
     shared_types=true;
   }

lib/gpu/lal_neighbor.cpp

@@ -365,7 +365,9 @@ void Neighbor::get_host(const int inum, int *ilist, int *numj,
       int i=ilist[ii];
       three_ilist[i] = ii;
     }
-    three_ilist.update_device(inum,true);
+    // needs to transfer _max_atoms because three_ilist indexes all the atoms (local and ghost)
+    // not just inum (number of neighbor list items)
+    three_ilist.update_device(_max_atoms,true);
   }
 
   time_nbor.stop();

lib/h5md/Makefile.h5cc

@@ -4,7 +4,8 @@ CC=h5cc
 
 # -DH5_NO_DEPRECATED_SYMBOLS is required here to ensure we are using
 # the v1.8 API when HDF5 is configured to default to using the v1.6 API.
-CFLAGS=-D_DEFAULT_SOURCE -O2 -DH5_NO_DEPRECATED_SYMBOLS  -Wall -fPIC
+#CFLAGS=-D_DEFAULT_SOURCE -O2 -DH5_NO_DEPRECATED_SYMBOLS  -Wall -fPIC
+CFLAGS=-D_DEFAULT_SOURCE -O2  -Wall -fPIC
 HDF5_PATH=/usr
 INC=-I include
 AR=ar

lib/linalg/dbdsdc.cpp

@@ -0,0 +1,282 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__9 = 9;
+static integer c__0 = 0;
+static doublereal c_b15 = 1.;
+static integer c__1 = 1;
+static doublereal c_b29 = 0.;
+int dbdsdc_(char *uplo, char *compq, integer *n, doublereal *d__, doublereal *e, doublereal *u,
+            integer *ldu, doublereal *vt, integer *ldvt, doublereal *q, integer *iq,
+            doublereal *work, integer *iwork, integer *info, ftnlen uplo_len, ftnlen compq_len)
+{
+    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
+    doublereal d__1;
+    double d_lmp_sign(doublereal *, doublereal *), log(doublereal);
+    integer i__, j, k;
+    doublereal p, r__;
+    integer z__, ic, ii, kk;
+    doublereal cs;
+    integer is, iu;
+    doublereal sn;
+    integer nm1;
+    doublereal eps;
+    integer ivt, difl, difr, ierr, perm, mlvl, sqre;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dlasr_(char *, char *, char *, integer *, integer *, doublereal *, doublereal *,
+                      doublereal *, integer *, ftnlen, ftnlen, ftnlen),
+        dcopy_(integer *, doublereal *, integer *, doublereal *, integer *),
+        dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer poles, iuplo, nsize, start;
+    extern int dlasd0_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                       doublereal *, integer *, integer *, integer *, doublereal *, integer *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dlasda_(integer *, integer *, integer *, integer *, doublereal *, doublereal *,
+                       doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, integer *, integer *, integer *, integer *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, integer *,
+                       integer *),
+        dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
+                doublereal *, integer *, integer *, ftnlen),
+        dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *,
+                doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                integer *, doublereal *, integer *, ftnlen),
+        dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                ftnlen),
+        dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int xerbla_(char *, integer *, ftnlen);
+    integer givcol;
+    extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *, ftnlen);
+    integer icompq;
+    doublereal orgnrm;
+    integer givnum, givptr, qstart, smlsiz, wstart, smlszp;
+    --d__;
+    --e;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    --q;
+    --iq;
+    --work;
+    --iwork;
+    *info = 0;
+    iuplo = 0;
+    if (lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1)) {
+        iuplo = 1;
+    }
+    if (lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        iuplo = 2;
+    }
+    if (lsame_(compq, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        icompq = 0;
+    } else if (lsame_(compq, (char *)"P", (ftnlen)1, (ftnlen)1)) {
+        icompq = 1;
+    } else if (lsame_(compq, (char *)"I", (ftnlen)1, (ftnlen)1)) {
+        icompq = 2;
+    } else {
+        icompq = -1;
+    }
+    if (iuplo == 0) {
+        *info = -1;
+    } else if (icompq < 0) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*ldu < 1 || icompq == 2 && *ldu < *n) {
+        *info = -7;
+    } else if (*ldvt < 1 || icompq == 2 && *ldvt < *n) {
+        *info = -9;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DBDSDC", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    smlsiz = ilaenv_(&c__9, (char *)"DBDSDC", (char *)" ", &c__0, &c__0, &c__0, &c__0, (ftnlen)6, (ftnlen)1);
+    if (*n == 1) {
+        if (icompq == 1) {
+            q[1] = d_lmp_sign(&c_b15, &d__[1]);
+            q[smlsiz * *n + 1] = 1.;
+        } else if (icompq == 2) {
+            u[u_dim1 + 1] = d_lmp_sign(&c_b15, &d__[1]);
+            vt[vt_dim1 + 1] = 1.;
+        }
+        d__[1] = abs(d__[1]);
+        return 0;
+    }
+    nm1 = *n - 1;
+    wstart = 1;
+    qstart = 3;
+    if (icompq == 1) {
+        dcopy_(n, &d__[1], &c__1, &q[1], &c__1);
+        i__1 = *n - 1;
+        dcopy_(&i__1, &e[1], &c__1, &q[*n + 1], &c__1);
+    }
+    if (iuplo == 2) {
+        qstart = 5;
+        if (icompq == 2) {
+            wstart = (*n << 1) - 1;
+        }
+        i__1 = *n - 1;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            dlartg_(&d__[i__], &e[i__], &cs, &sn, &r__);
+            d__[i__] = r__;
+            e[i__] = sn * d__[i__ + 1];
+            d__[i__ + 1] = cs * d__[i__ + 1];
+            if (icompq == 1) {
+                q[i__ + (*n << 1)] = cs;
+                q[i__ + *n * 3] = sn;
+            } else if (icompq == 2) {
+                work[i__] = cs;
+                work[nm1 + i__] = -sn;
+            }
+        }
+    }
+    if (icompq == 0) {
+        dlasdq_((char *)"U", &c__0, n, &c__0, &c__0, &c__0, &d__[1], &e[1], &vt[vt_offset], ldvt,
+                &u[u_offset], ldu, &u[u_offset], ldu, &work[1], info, (ftnlen)1);
+        goto L40;
+    }
+    if (*n <= smlsiz) {
+        if (icompq == 2) {
+            dlaset_((char *)"A", n, n, &c_b29, &c_b15, &u[u_offset], ldu, (ftnlen)1);
+            dlaset_((char *)"A", n, n, &c_b29, &c_b15, &vt[vt_offset], ldvt, (ftnlen)1);
+            dlasdq_((char *)"U", &c__0, n, n, n, &c__0, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[u_offset],
+                    ldu, &u[u_offset], ldu, &work[wstart], info, (ftnlen)1);
+        } else if (icompq == 1) {
+            iu = 1;
+            ivt = iu + *n;
+            dlaset_((char *)"A", n, n, &c_b29, &c_b15, &q[iu + (qstart - 1) * *n], n, (ftnlen)1);
+            dlaset_((char *)"A", n, n, &c_b29, &c_b15, &q[ivt + (qstart - 1) * *n], n, (ftnlen)1);
+            dlasdq_((char *)"U", &c__0, n, n, n, &c__0, &d__[1], &e[1], &q[ivt + (qstart - 1) * *n], n,
+                    &q[iu + (qstart - 1) * *n], n, &q[iu + (qstart - 1) * *n], n, &work[wstart],
+                    info, (ftnlen)1);
+        }
+        goto L40;
+    }
+    if (icompq == 2) {
+        dlaset_((char *)"A", n, n, &c_b29, &c_b15, &u[u_offset], ldu, (ftnlen)1);
+        dlaset_((char *)"A", n, n, &c_b29, &c_b15, &vt[vt_offset], ldvt, (ftnlen)1);
+    }
+    orgnrm = dlanst_((char *)"M", n, &d__[1], &e[1], (ftnlen)1);
+    if (orgnrm == 0.) {
+        return 0;
+    }
+    dlascl_((char *)"G", &c__0, &c__0, &orgnrm, &c_b15, n, &c__1, &d__[1], n, &ierr, (ftnlen)1);
+    dlascl_((char *)"G", &c__0, &c__0, &orgnrm, &c_b15, &nm1, &c__1, &e[1], &nm1, &ierr, (ftnlen)1);
+    eps = dlamch_((char *)"Epsilon", (ftnlen)7) * .9;
+    mlvl = (integer)(log((doublereal)(*n) / (doublereal)(smlsiz + 1)) / log(2.)) + 1;
+    smlszp = smlsiz + 1;
+    if (icompq == 1) {
+        iu = 1;
+        ivt = smlsiz + 1;
+        difl = ivt + smlszp;
+        difr = difl + mlvl;
+        z__ = difr + (mlvl << 1);
+        ic = z__ + mlvl;
+        is = ic + 1;
+        poles = is + 1;
+        givnum = poles + (mlvl << 1);
+        k = 1;
+        givptr = 2;
+        perm = 3;
+        givcol = perm + mlvl;
+    }
+    i__1 = *n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        if ((d__1 = d__[i__], abs(d__1)) < eps) {
+            d__[i__] = d_lmp_sign(&eps, &d__[i__]);
+        }
+    }
+    start = 1;
+    sqre = 0;
+    i__1 = nm1;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        if ((d__1 = e[i__], abs(d__1)) < eps || i__ == nm1) {
+            if (i__ < nm1) {
+                nsize = i__ - start + 1;
+            } else if ((d__1 = e[i__], abs(d__1)) >= eps) {
+                nsize = *n - start + 1;
+            } else {
+                nsize = i__ - start + 1;
+                if (icompq == 2) {
+                    u[*n + *n * u_dim1] = d_lmp_sign(&c_b15, &d__[*n]);
+                    vt[*n + *n * vt_dim1] = 1.;
+                } else if (icompq == 1) {
+                    q[*n + (qstart - 1) * *n] = d_lmp_sign(&c_b15, &d__[*n]);
+                    q[*n + (smlsiz + qstart - 1) * *n] = 1.;
+                }
+                d__[*n] = (d__1 = d__[*n], abs(d__1));
+            }
+            if (icompq == 2) {
+                dlasd0_(&nsize, &sqre, &d__[start], &e[start], &u[start + start * u_dim1], ldu,
+                        &vt[start + start * vt_dim1], ldvt, &smlsiz, &iwork[1], &work[wstart],
+                        info);
+            } else {
+                dlasda_(&icompq, &smlsiz, &nsize, &sqre, &d__[start], &e[start],
+                        &q[start + (iu + qstart - 2) * *n], n, &q[start + (ivt + qstart - 2) * *n],
+                        &iq[start + k * *n], &q[start + (difl + qstart - 2) * *n],
+                        &q[start + (difr + qstart - 2) * *n], &q[start + (z__ + qstart - 2) * *n],
+                        &q[start + (poles + qstart - 2) * *n], &iq[start + givptr * *n],
+                        &iq[start + givcol * *n], n, &iq[start + perm * *n],
+                        &q[start + (givnum + qstart - 2) * *n], &q[start + (ic + qstart - 2) * *n],
+                        &q[start + (is + qstart - 2) * *n], &work[wstart], &iwork[1], info);
+            }
+            if (*info != 0) {
+                return 0;
+            }
+            start = i__ + 1;
+        }
+    }
+    dlascl_((char *)"G", &c__0, &c__0, &c_b15, &orgnrm, n, &c__1, &d__[1], n, &ierr, (ftnlen)1);
+L40:
+    i__1 = *n;
+    for (ii = 2; ii <= i__1; ++ii) {
+        i__ = ii - 1;
+        kk = i__;
+        p = d__[i__];
+        i__2 = *n;
+        for (j = ii; j <= i__2; ++j) {
+            if (d__[j] > p) {
+                kk = j;
+                p = d__[j];
+            }
+        }
+        if (kk != i__) {
+            d__[kk] = d__[i__];
+            d__[i__] = p;
+            if (icompq == 1) {
+                iq[i__] = kk;
+            } else if (icompq == 2) {
+                dswap_(n, &u[i__ * u_dim1 + 1], &c__1, &u[kk * u_dim1 + 1], &c__1);
+                dswap_(n, &vt[i__ + vt_dim1], ldvt, &vt[kk + vt_dim1], ldvt);
+            }
+        } else if (icompq == 1) {
+            iq[i__] = i__;
+        }
+    }
+    if (icompq == 1) {
+        if (iuplo == 1) {
+            iq[*n] = 1;
+        } else {
+            iq[*n] = 0;
+        }
+    }
+    if (iuplo == 2 && icompq == 2) {
+        dlasr_((char *)"L", (char *)"V", (char *)"B", n, n, &work[1], &work[*n], &u[u_offset], ldu, (ftnlen)1, (ftnlen)1,
+               (ftnlen)1);
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dcombssq.cpp

@@ -0,0 +1,26 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dcombssq_(doublereal *v1, doublereal *v2)
+{
+    doublereal d__1;
+    --v2;
+    --v1;
+    if (v1[1] >= v2[1]) {
+        if (v1[1] != 0.) {
+            d__1 = v2[1] / v1[1];
+            v1[2] += d__1 * d__1 * v2[2];
+        } else {
+            v1[2] += v2[2];
+        }
+    } else {
+        d__1 = v1[1] / v2[1];
+        v1[2] = v2[2] + d__1 * d__1 * v1[2];
+        v1[1] = v2[1];
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dgebak.cpp

@@ -0,0 +1,117 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dgebak_(char *job, char *side, integer *n, integer *ilo, integer *ihi, doublereal *scale,
+            integer *m, doublereal *v, integer *ldv, integer *info, ftnlen job_len, ftnlen side_len)
+{
+    integer v_dim1, v_offset, i__1;
+    integer i__, k;
+    doublereal s;
+    integer ii;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    logical leftv;
+    extern int xerbla_(char *, integer *, ftnlen);
+    logical rightv;
+    --scale;
+    v_dim1 = *ldv;
+    v_offset = 1 + v_dim1;
+    v -= v_offset;
+    rightv = lsame_(side, (char *)"R", (ftnlen)1, (ftnlen)1);
+    leftv = lsame_(side, (char *)"L", (ftnlen)1, (ftnlen)1);
+    *info = 0;
+    if (!lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1) && !lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1) &&
+        !lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1) && !lsame_(job, (char *)"B", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (!rightv && !leftv) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*ilo < 1 || *ilo > max(1, *n)) {
+        *info = -4;
+    } else if (*ihi < min(*ilo, *n) || *ihi > *n) {
+        *info = -5;
+    } else if (*m < 0) {
+        *info = -7;
+    } else if (*ldv < max(1, *n)) {
+        *info = -9;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGEBAK", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    if (*m == 0) {
+        return 0;
+    }
+    if (lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        return 0;
+    }
+    if (*ilo == *ihi) {
+        goto L30;
+    }
+    if (lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1) || lsame_(job, (char *)"B", (ftnlen)1, (ftnlen)1)) {
+        if (rightv) {
+            i__1 = *ihi;
+            for (i__ = *ilo; i__ <= i__1; ++i__) {
+                s = scale[i__];
+                dscal_(m, &s, &v[i__ + v_dim1], ldv);
+            }
+        }
+        if (leftv) {
+            i__1 = *ihi;
+            for (i__ = *ilo; i__ <= i__1; ++i__) {
+                s = 1. / scale[i__];
+                dscal_(m, &s, &v[i__ + v_dim1], ldv);
+            }
+        }
+    }
+L30:
+    if (lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1) || lsame_(job, (char *)"B", (ftnlen)1, (ftnlen)1)) {
+        if (rightv) {
+            i__1 = *n;
+            for (ii = 1; ii <= i__1; ++ii) {
+                i__ = ii;
+                if (i__ >= *ilo && i__ <= *ihi) {
+                    goto L40;
+                }
+                if (i__ < *ilo) {
+                    i__ = *ilo - ii;
+                }
+                k = (integer)scale[i__];
+                if (k == i__) {
+                    goto L40;
+                }
+                dswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+            L40:;
+            }
+        }
+        if (leftv) {
+            i__1 = *n;
+            for (ii = 1; ii <= i__1; ++ii) {
+                i__ = ii;
+                if (i__ >= *ilo && i__ <= *ihi) {
+                    goto L50;
+                }
+                if (i__ < *ilo) {
+                    i__ = *ilo - ii;
+                }
+                k = (integer)scale[i__];
+                if (k == i__) {
+                    goto L50;
+                }
+                dswap_(m, &v[i__ + v_dim1], ldv, &v[k + v_dim1], ldv);
+            L50:;
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dgebal.cpp

@@ -0,0 +1,513 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c__0 = 0;
+static integer c_n1 = -1;
+int dgebal_(char *job, integer *n, doublereal *a, integer *lda, integer *ilo, integer *ihi,
+            doublereal *scale, integer *info, ftnlen job_len)
+{
+    integer a_dim1, a_offset, i__1, i__2;
+    doublereal d__1, d__2;
+    doublereal c__, f, g;
+    integer i__, j, k, l, m;
+    doublereal r__, s, ca, ra;
+    integer ica, ira, iexc;
+    extern doublereal dnrm2_(integer *, doublereal *, integer *);
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    doublereal sfmin1, sfmin2, sfmax1, sfmax2;
+    extern doublereal dlamch_(char *, ftnlen);
+    extern integer idamax_(integer *, doublereal *, integer *);
+    extern logical disnan_(doublereal *);
+    extern int xerbla_(char *, integer *, ftnlen);
+    logical noconv;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --scale;
+    *info = 0;
+    if (!lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1) && !lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1) &&
+        !lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1) && !lsame_(job, (char *)"B", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGEBAL", &i__1, (ftnlen)6);
+        return 0;
+    }
+    k = 1;
+    l = *n;
+    if (*n == 0) {
+        goto L210;
+    }
+    if (lsame_(job, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            scale[i__] = 1.;
+        }
+        goto L210;
+    }
+    if (lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1)) {
+        goto L120;
+    }
+    goto L50;
+L20:
+    scale[m] = (doublereal)j;
+    if (j == m) {
+        goto L30;
+    }
+    dswap_(&l, &a[j * a_dim1 + 1], &c__1, &a[m * a_dim1 + 1], &c__1);
+    i__1 = *n - k + 1;
+    dswap_(&i__1, &a[j + k * a_dim1], lda, &a[m + k * a_dim1], lda);
+L30:
+    switch (iexc) {
+        case 1:
+            goto L40;
+        case 2:
+            goto L80;
+    }
+L40:
+    if (l == 1) {
+        goto L210;
+    }
+    --l;
+L50:
+    for (j = l; j >= 1; --j) {
+        i__1 = l;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            if (i__ == j) {
+                goto L60;
+            }
+            if (a[j + i__ * a_dim1] != 0.) {
+                goto L70;
+            }
+        L60:;
+        }
+        m = l;
+        iexc = 1;
+        goto L20;
+    L70:;
+    }
+    goto L90;
+L80:
+    ++k;
+L90:
+    i__1 = l;
+    for (j = k; j <= i__1; ++j) {
+        i__2 = l;
+        for (i__ = k; i__ <= i__2; ++i__) {
+            if (i__ == j) {
+                goto L100;
+            }
+            if (a[i__ + j * a_dim1] != 0.) {
+                goto L110;
+            }
+        L100:;
+        }
+        m = k;
+        iexc = 2;
+        goto L20;
+    L110:;
+    }
+L120:
+    i__1 = l;
+    for (i__ = k; i__ <= i__1; ++i__) {
+        scale[i__] = 1.;
+    }
+    if (lsame_(job, (char *)"P", (ftnlen)1, (ftnlen)1)) {
+        goto L210;
+    }
+    sfmin1 = dlamch_((char *)"S", (ftnlen)1) / dlamch_((char *)"P", (ftnlen)1);
+    sfmax1 = 1. / sfmin1;
+    sfmin2 = sfmin1 * 2.;
+    sfmax2 = 1. / sfmin2;
+L140:
+    noconv = FALSE_;
+    i__1 = l;
+    for (i__ = k; i__ <= i__1; ++i__) {
+        i__2 = l - k + 1;
+        c__ = dnrm2_(&i__2, &a[k + i__ * a_dim1], &c__1);
+        i__2 = l - k + 1;
+        r__ = dnrm2_(&i__2, &a[i__ + k * a_dim1], lda);
+        ica = idamax_(&l, &a[i__ * a_dim1 + 1], &c__1);
+        ca = (d__1 = a[ica + i__ * a_dim1], abs(d__1));
+        i__2 = *n - k + 1;
+        ira = idamax_(&i__2, &a[i__ + k * a_dim1], lda);
+        ra = (d__1 = a[i__ + (ira + k - 1) * a_dim1], abs(d__1));
+        if (c__ == 0. || r__ == 0.) {
+            goto L200;
+        }
+        g = r__ / 2.;
+        f = 1.;
+        s = c__ + r__;
+    L160:
+        d__1 = max(f, c__);
+        d__2 = min(r__, g);
+        if (c__ >= g || max(d__1, ca) >= sfmax2 || min(d__2, ra) <= sfmin2) {
+            goto L170;
+        }
+        d__1 = c__ + f + ca + r__ + g + ra;
+        if (disnan_(&d__1)) {
+            *info = -3;
+            i__2 = -(*info);
+            xerbla_((char *)"DGEBAL", &i__2, (ftnlen)6);
+            return 0;
+        }
+        f *= 2.;
+        c__ *= 2.;
+        ca *= 2.;
+        r__ /= 2.;
+        g /= 2.;
+        ra /= 2.;
+        goto L160;
+    L170:
+        g = c__ / 2.;
+    L180:
+        d__1 = min(f, c__), d__1 = min(d__1, g);
+        if (g < r__ || max(r__, ra) >= sfmax2 || min(d__1, ca) <= sfmin2) {
+            goto L190;
+        }
+        f /= 2.;
+        c__ /= 2.;
+        g /= 2.;
+        ca /= 2.;
+        r__ *= 2.;
+        ra *= 2.;
+        goto L180;
+    L190:
+        if (c__ + r__ >= s * .95) {
+            goto L200;
+        }
+        if (f < 1. && scale[i__] < 1.) {
+            if (f * scale[i__] <= sfmin1) {
+                goto L200;
+            }
+        }
+        if (f > 1. && scale[i__] > 1.) {
+            if (scale[i__] >= sfmax1 / f) {
+                goto L200;
+            }
+        }
+        g = 1. / f;
+        scale[i__] *= f;
+        noconv = TRUE_;
+        i__2 = *n - k + 1;
+        dscal_(&i__2, &g, &a[i__ + k * a_dim1], lda);
+        dscal_(&l, &f, &a[i__ * a_dim1 + 1], &c__1);
+    L200:;
+    }
+    if (noconv) {
+        goto L140;
+    }
+L210:
+    *ilo = k;
+    *ihi = l;
+    return 0;
+}
+int dgeev_(char *jobvl, char *jobvr, integer *n, doublereal *a, integer *lda, doublereal *wr,
+           doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
+           doublereal *work, integer *lwork, integer *info, ftnlen jobvl_len, ftnlen jobvr_len)
+{
+    integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3;
+    doublereal d__1, d__2;
+    double sqrt(doublereal);
+    integer i__, k;
+    doublereal r__, cs, sn;
+    integer ihi;
+    doublereal scl;
+    integer ilo;
+    doublereal dum[1], eps;
+    integer lwork_trevc__, ibal;
+    char side[1];
+    doublereal anrm;
+    integer ierr, itau;
+    extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                     doublereal *);
+    integer iwrk, nout;
+    extern doublereal dnrm2_(integer *, doublereal *, integer *);
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern doublereal dlapy2_(doublereal *, doublereal *);
+    extern int dlabad_(doublereal *, doublereal *),
+        dgebak_(char *, char *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, integer *, integer *, ftnlen, ftnlen),
+        dgebal_(char *, integer *, doublereal *, integer *, integer *, integer *, doublereal *,
+                integer *, ftnlen);
+    logical scalea;
+    extern doublereal dlamch_(char *, ftnlen);
+    doublereal cscale;
+    extern doublereal dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                              ftnlen);
+    extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       doublereal *, integer *, integer *),
+        dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
+                doublereal *, integer *, integer *, ftnlen);
+    extern integer idamax_(integer *, doublereal *, integer *);
+    extern int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       integer *, ftnlen),
+        dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        xerbla_(char *, integer *, ftnlen);
+    logical select[1];
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    doublereal bignum;
+    extern int dorghr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       doublereal *, integer *, integer *),
+        dhseqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *,
+                integer *, ftnlen, ftnlen);
+    integer minwrk, maxwrk;
+    logical wantvl;
+    doublereal smlnum;
+    integer hswork;
+    logical lquery, wantvr;
+    extern int dtrevc3_(char *, char *, logical *, integer *, doublereal *, integer *, doublereal *,
+                        integer *, doublereal *, integer *, integer *, integer *, doublereal *,
+                        integer *, integer *, ftnlen, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --wr;
+    --wi;
+    vl_dim1 = *ldvl;
+    vl_offset = 1 + vl_dim1;
+    vl -= vl_offset;
+    vr_dim1 = *ldvr;
+    vr_offset = 1 + vr_dim1;
+    vr -= vr_offset;
+    --work;
+    *info = 0;
+    lquery = *lwork == -1;
+    wantvl = lsame_(jobvl, (char *)"V", (ftnlen)1, (ftnlen)1);
+    wantvr = lsame_(jobvr, (char *)"V", (ftnlen)1, (ftnlen)1);
+    if (!wantvl && !lsame_(jobvl, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (!wantvr && !lsame_(jobvr, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*ldvl < 1 || wantvl && *ldvl < *n) {
+        *info = -9;
+    } else if (*ldvr < 1 || wantvr && *ldvr < *n) {
+        *info = -11;
+    }
+    if (*info == 0) {
+        if (*n == 0) {
+            minwrk = 1;
+            maxwrk = 1;
+        } else {
+            maxwrk = (*n << 1) +
+                     *n * ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, &c__1, n, &c__0, (ftnlen)6, (ftnlen)1);
+            if (wantvl) {
+                minwrk = *n << 2;
+                i__1 = maxwrk,
+                i__2 = (*n << 1) + (*n - 1) * ilaenv_(&c__1, (char *)"DORGHR", (char *)" ", n, &c__1, n, &c_n1,
+                                                      (ftnlen)6, (ftnlen)1);
+                maxwrk = max(i__1, i__2);
+                dhseqr_((char *)"S", (char *)"V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vl[vl_offset],
+                        ldvl, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
+                hswork = (integer)work[1];
+                i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
+                maxwrk = max(i__1, i__2);
+                dtrevc3_((char *)"L", (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
+                         &vr[vr_offset], ldvr, n, &nout, &work[1], &c_n1, &ierr, (ftnlen)1,
+                         (ftnlen)1);
+                lwork_trevc__ = (integer)work[1];
+                i__1 = maxwrk, i__2 = *n + lwork_trevc__;
+                maxwrk = max(i__1, i__2);
+                i__1 = maxwrk, i__2 = *n << 2;
+                maxwrk = max(i__1, i__2);
+            } else if (wantvr) {
+                minwrk = *n << 2;
+                i__1 = maxwrk,
+                i__2 = (*n << 1) + (*n - 1) * ilaenv_(&c__1, (char *)"DORGHR", (char *)" ", n, &c__1, n, &c_n1,
+                                                      (ftnlen)6, (ftnlen)1);
+                maxwrk = max(i__1, i__2);
+                dhseqr_((char *)"S", (char *)"V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset],
+                        ldvr, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
+                hswork = (integer)work[1];
+                i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
+                maxwrk = max(i__1, i__2);
+                dtrevc3_((char *)"R", (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
+                         &vr[vr_offset], ldvr, n, &nout, &work[1], &c_n1, &ierr, (ftnlen)1,
+                         (ftnlen)1);
+                lwork_trevc__ = (integer)work[1];
+                i__1 = maxwrk, i__2 = *n + lwork_trevc__;
+                maxwrk = max(i__1, i__2);
+                i__1 = maxwrk, i__2 = *n << 2;
+                maxwrk = max(i__1, i__2);
+            } else {
+                minwrk = *n * 3;
+                dhseqr_((char *)"E", (char *)"N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset],
+                        ldvr, &work[1], &c_n1, info, (ftnlen)1, (ftnlen)1);
+                hswork = (integer)work[1];
+                i__1 = maxwrk, i__2 = *n + 1, i__1 = max(i__1, i__2), i__2 = *n + hswork;
+                maxwrk = max(i__1, i__2);
+            }
+            maxwrk = max(maxwrk, minwrk);
+        }
+        work[1] = (doublereal)maxwrk;
+        if (*lwork < minwrk && !lquery) {
+            *info = -13;
+        }
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGEEV ", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    eps = dlamch_((char *)"P", (ftnlen)1);
+    smlnum = dlamch_((char *)"S", (ftnlen)1);
+    bignum = 1. / smlnum;
+    dlabad_(&smlnum, &bignum);
+    smlnum = sqrt(smlnum) / eps;
+    bignum = 1. / smlnum;
+    anrm = dlange_((char *)"M", n, n, &a[a_offset], lda, dum, (ftnlen)1);
+    scalea = FALSE_;
+    if (anrm > 0. && anrm < smlnum) {
+        scalea = TRUE_;
+        cscale = smlnum;
+    } else if (anrm > bignum) {
+        scalea = TRUE_;
+        cscale = bignum;
+    }
+    if (scalea) {
+        dlascl_((char *)"G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &ierr, (ftnlen)1);
+    }
+    ibal = 1;
+    dgebal_((char *)"B", n, &a[a_offset], lda, &ilo, &ihi, &work[ibal], &ierr, (ftnlen)1);
+    itau = ibal + *n;
+    iwrk = itau + *n;
+    i__1 = *lwork - iwrk + 1;
+    dgehrd_(n, &ilo, &ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, &ierr);
+    if (wantvl) {
+        *(unsigned char *)side = 'L';
+        dlacpy_((char *)"L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl, (ftnlen)1);
+        i__1 = *lwork - iwrk + 1;
+        dorghr_(n, &ilo, &ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], &i__1, &ierr);
+        iwrk = itau;
+        i__1 = *lwork - iwrk + 1;
+        dhseqr_((char *)"S", (char *)"V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vl[vl_offset], ldvl,
+                &work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
+        if (wantvr) {
+            *(unsigned char *)side = 'B';
+            dlacpy_((char *)"F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, (ftnlen)1);
+        }
+    } else if (wantvr) {
+        *(unsigned char *)side = 'R';
+        dlacpy_((char *)"L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr, (ftnlen)1);
+        i__1 = *lwork - iwrk + 1;
+        dorghr_(n, &ilo, &ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], &i__1, &ierr);
+        iwrk = itau;
+        i__1 = *lwork - iwrk + 1;
+        dhseqr_((char *)"S", (char *)"V", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
+                &work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
+    } else {
+        iwrk = itau;
+        i__1 = *lwork - iwrk + 1;
+        dhseqr_((char *)"E", (char *)"N", n, &ilo, &ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr,
+                &work[iwrk], &i__1, info, (ftnlen)1, (ftnlen)1);
+    }
+    if (*info != 0) {
+        goto L50;
+    }
+    if (wantvl || wantvr) {
+        i__1 = *lwork - iwrk + 1;
+        dtrevc3_(side, (char *)"B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset],
+                 ldvr, n, &nout, &work[iwrk], &i__1, &ierr, (ftnlen)1, (ftnlen)1);
+    }
+    if (wantvl) {
+        dgebak_((char *)"B", (char *)"L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl, &ierr, (ftnlen)1,
+                (ftnlen)1);
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            if (wi[i__] == 0.) {
+                scl = 1. / dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
+                dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
+            } else if (wi[i__] > 0.) {
+                d__1 = dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
+                d__2 = dnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
+                scl = 1. / dlapy2_(&d__1, &d__2);
+                dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
+                dscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
+                i__2 = *n;
+                for (k = 1; k <= i__2; ++k) {
+                    d__1 = vl[k + i__ * vl_dim1];
+                    d__2 = vl[k + (i__ + 1) * vl_dim1];
+                    work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
+                }
+                k = idamax_(n, &work[iwrk], &c__1);
+                dlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__);
+                drot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) * vl_dim1 + 1], &c__1, &cs,
+                      &sn);
+                vl[k + (i__ + 1) * vl_dim1] = 0.;
+            }
+        }
+    }
+    if (wantvr) {
+        dgebak_((char *)"B", (char *)"R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr, &ierr, (ftnlen)1,
+                (ftnlen)1);
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            if (wi[i__] == 0.) {
+                scl = 1. / dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
+                dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
+            } else if (wi[i__] > 0.) {
+                d__1 = dnrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1);
+                d__2 = dnrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
+                scl = 1. / dlapy2_(&d__1, &d__2);
+                dscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1);
+                dscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1);
+                i__2 = *n;
+                for (k = 1; k <= i__2; ++k) {
+                    d__1 = vr[k + i__ * vr_dim1];
+                    d__2 = vr[k + (i__ + 1) * vr_dim1];
+                    work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
+                }
+                k = idamax_(n, &work[iwrk], &c__1);
+                dlartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], &cs, &sn, &r__);
+                drot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) * vr_dim1 + 1], &c__1, &cs,
+                      &sn);
+                vr[k + (i__ + 1) * vr_dim1] = 0.;
+            }
+        }
+    }
+L50:
+    if (scalea) {
+        i__1 = *n - *info;
+        i__3 = *n - *info;
+        i__2 = max(i__3, 1);
+        dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr,
+                (ftnlen)1);
+        i__1 = *n - *info;
+        i__3 = *n - *info;
+        i__2 = max(i__3, 1);
+        dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr,
+                (ftnlen)1);
+        if (*info > 0) {
+            i__1 = ilo - 1;
+            dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr, (ftnlen)1);
+            i__1 = ilo - 1;
+            dlascl_((char *)"G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr, (ftnlen)1);
+        }
+    }
+    work[1] = (doublereal)maxwrk;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dgehd2.cpp

@@ -0,0 +1,57 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+int dgehd2_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau,
+            doublereal *work, integer *info)
+{
+    integer a_dim1, a_offset, i__1, i__2, i__3;
+    integer i__;
+    doublereal aii;
+    extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, ftnlen),
+        dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        xerbla_(char *, integer *, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --tau;
+    --work;
+    *info = 0;
+    if (*n < 0) {
+        *info = -1;
+    } else if (*ilo < 1 || *ilo > max(1, *n)) {
+        *info = -2;
+    } else if (*ihi < min(*ilo, *n) || *ihi > *n) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGEHD2", &i__1, (ftnlen)6);
+        return 0;
+    }
+    i__1 = *ihi - 1;
+    for (i__ = *ilo; i__ <= i__1; ++i__) {
+        i__2 = *ihi - i__;
+        i__3 = i__ + 2;
+        dlarfg_(&i__2, &a[i__ + 1 + i__ * a_dim1], &a[min(i__3, *n) + i__ * a_dim1], &c__1,
+                &tau[i__]);
+        aii = a[i__ + 1 + i__ * a_dim1];
+        a[i__ + 1 + i__ * a_dim1] = 1.;
+        i__2 = *ihi - i__;
+        dlarf_((char *)"Right", ihi, &i__2, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__],
+               &a[(i__ + 1) * a_dim1 + 1], lda, &work[1], (ftnlen)5);
+        i__2 = *ihi - i__;
+        i__3 = *n - i__;
+        dlarf_((char *)"Left", &i__2, &i__3, &a[i__ + 1 + i__ * a_dim1], &c__1, &tau[i__],
+               &a[i__ + 1 + (i__ + 1) * a_dim1], lda, &work[1], (ftnlen)4);
+        a[i__ + 1 + i__ * a_dim1] = aii;
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dgehrd.cpp

@@ -0,0 +1,144 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+static integer c__65 = 65;
+static doublereal c_b25 = -1.;
+static doublereal c_b26 = 1.;
+int dgehrd_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau,
+            doublereal *work, integer *lwork, integer *info)
+{
+    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+    integer i__, j, ib;
+    doublereal ei;
+    integer nb, nh, nx, iwt;
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    integer nbmin, iinfo;
+    extern int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen,
+                      ftnlen),
+        daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *),
+        dgehd2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                doublereal *, integer *),
+        dlahr2_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                doublereal *, integer *, doublereal *, integer *),
+        dlarfb_(char *, char *, char *, char *, integer *, integer *, integer *, doublereal *,
+                integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                integer *, ftnlen, ftnlen, ftnlen, ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    integer ldwork, lwkopt;
+    logical lquery;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --tau;
+    --work;
+    *info = 0;
+    lquery = *lwork == -1;
+    if (*n < 0) {
+        *info = -1;
+    } else if (*ilo < 1 || *ilo > max(1, *n)) {
+        *info = -2;
+    } else if (*ihi < min(*ilo, *n) || *ihi > *n) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*lwork < max(1, *n) && !lquery) {
+        *info = -8;
+    }
+    if (*info == 0) {
+        i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
+        nb = min(i__1, i__2);
+        lwkopt = *n * nb + 4160;
+        work[1] = (doublereal)lwkopt;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGEHRD", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    i__1 = *ilo - 1;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        tau[i__] = 0.;
+    }
+    i__1 = *n - 1;
+    for (i__ = max(1, *ihi); i__ <= i__1; ++i__) {
+        tau[i__] = 0.;
+    }
+    nh = *ihi - *ilo + 1;
+    if (nh <= 1) {
+        work[1] = 1.;
+        return 0;
+    }
+    i__1 = 64, i__2 = ilaenv_(&c__1, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
+    nb = min(i__1, i__2);
+    nbmin = 2;
+    if (nb > 1 && nb < nh) {
+        i__1 = nb, i__2 = ilaenv_(&c__3, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
+        nx = max(i__1, i__2);
+        if (nx < nh) {
+            if (*lwork < *n * nb + 4160) {
+                i__1 = 2,
+                i__2 = ilaenv_(&c__2, (char *)"DGEHRD", (char *)" ", n, ilo, ihi, &c_n1, (ftnlen)6, (ftnlen)1);
+                nbmin = max(i__1, i__2);
+                if (*lwork >= *n * nbmin + 4160) {
+                    nb = (*lwork - 4160) / *n;
+                } else {
+                    nb = 1;
+                }
+            }
+        }
+    }
+    ldwork = *n;
+    if (nb < nbmin || nb >= nh) {
+        i__ = *ilo;
+    } else {
+        iwt = *n * nb + 1;
+        i__1 = *ihi - 1 - nx;
+        i__2 = nb;
+        for (i__ = *ilo; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+            i__3 = nb, i__4 = *ihi - i__;
+            ib = min(i__3, i__4);
+            dlahr2_(ihi, &i__, &ib, &a[i__ * a_dim1 + 1], lda, &tau[i__], &work[iwt], &c__65,
+                    &work[1], &ldwork);
+            ei = a[i__ + ib + (i__ + ib - 1) * a_dim1];
+            a[i__ + ib + (i__ + ib - 1) * a_dim1] = 1.;
+            i__3 = *ihi - i__ - ib + 1;
+            dgemm_((char *)"No transpose", (char *)"Transpose", ihi, &i__3, &ib, &c_b25, &work[1], &ldwork,
+                   &a[i__ + ib + i__ * a_dim1], lda, &c_b26, &a[(i__ + ib) * a_dim1 + 1], lda,
+                   (ftnlen)12, (ftnlen)9);
+            a[i__ + ib + (i__ + ib - 1) * a_dim1] = ei;
+            i__3 = ib - 1;
+            dtrmm_((char *)"Right", (char *)"Lower", (char *)"Transpose", (char *)"Unit", &i__, &i__3, &c_b26,
+                   &a[i__ + 1 + i__ * a_dim1], lda, &work[1], &ldwork, (ftnlen)5, (ftnlen)5,
+                   (ftnlen)9, (ftnlen)4);
+            i__3 = ib - 2;
+            for (j = 0; j <= i__3; ++j) {
+                daxpy_(&i__, &c_b25, &work[ldwork * j + 1], &c__1, &a[(i__ + j + 1) * a_dim1 + 1],
+                       &c__1);
+            }
+            i__3 = *ihi - i__;
+            i__4 = *n - i__ - ib + 1;
+            dlarfb_((char *)"Left", (char *)"Transpose", (char *)"Forward", (char *)"Columnwise", &i__3, &i__4, &ib,
+                    &a[i__ + 1 + i__ * a_dim1], lda, &work[iwt], &c__65,
+                    &a[i__ + 1 + (i__ + ib) * a_dim1], lda, &work[1], &ldwork, (ftnlen)4, (ftnlen)9,
+                    (ftnlen)7, (ftnlen)10);
+        }
+    }
+    dgehd2_(n, &i__, ihi, &a[a_offset], lda, &tau[1], &work[1], &iinfo);
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dgesdd.cpp

@@ -0,0 +1,788 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c_n1 = -1;
+static integer c__0 = 0;
+static doublereal c_b63 = 0.;
+static integer c__1 = 1;
+static doublereal c_b84 = 1.;
+int dgesdd_(char *jobz, integer *m, integer *n, doublereal *a, integer *lda, doublereal *s,
+            doublereal *u, integer *ldu, doublereal *vt, integer *ldvt, doublereal *work,
+            integer *lwork, integer *iwork, integer *info, ftnlen jobz_len)
+{
+    integer a_dim1, a_offset, u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2, i__3;
+    double sqrt(doublereal);
+    integer lwork_dorglq_mn__, lwork_dorglq_nn__, lwork_dorgqr_mm__, lwork_dorgqr_mn__, i__, ie,
+        lwork_dorgbr_p_mm__, il, lwork_dorgbr_q_nn__, ir, iu, blk;
+    doublereal dum[1], eps;
+    integer ivt, iscl;
+    doublereal anrm;
+    integer idum[1], ierr, itau, lwork_dormbr_qln_mm__, lwork_dormbr_qln_mn__,
+        lwork_dormbr_qln_nn__, lwork_dormbr_prt_mm__, lwork_dormbr_prt_mn__, lwork_dormbr_prt_nn__;
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    integer chunk, minmn, wrkbl, itaup, itauq, mnthr;
+    logical wntqa;
+    integer nwork;
+    logical wntqn, wntqo, wntqs;
+    extern int dbdsdc_(char *, char *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                       integer *, integer *, ftnlen, ftnlen),
+        dgebrd_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
+                doublereal *, doublereal *, doublereal *, integer *, integer *);
+    extern doublereal dlamch_(char *, ftnlen),
+        dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *, ftnlen);
+    integer bdspac;
+    extern int dgelqf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
+                       integer *, integer *),
+        dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
+                doublereal *, integer *, integer *, ftnlen),
+        dgeqrf_(integer *, integer *, doublereal *, integer *, doublereal *, doublereal *,
+                integer *, integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen),
+        dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                ftnlen),
+        xerbla_(char *, integer *, ftnlen),
+        dorgbr_(char *, integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                doublereal *, integer *, integer *, ftnlen);
+    doublereal bignum;
+    extern int dormbr_(char *, char *, char *, integer *, integer *, integer *, doublereal *,
+                       integer *, doublereal *, doublereal *, integer *, doublereal *, integer *,
+                       integer *, ftnlen, ftnlen, ftnlen),
+        dorglq_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                doublereal *, integer *, integer *),
+        dorgqr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                doublereal *, integer *, integer *);
+    integer ldwrkl, ldwrkr, minwrk, ldwrku, maxwrk, ldwkvt;
+    doublereal smlnum;
+    logical wntqas, lquery;
+    integer lwork_dgebrd_mm__, lwork_dgebrd_mn__, lwork_dgebrd_nn__, lwork_dgelqf_mn__,
+        lwork_dgeqrf_mn__;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --s;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    --work;
+    --iwork;
+    *info = 0;
+    minmn = min(*m, *n);
+    wntqa = lsame_(jobz, (char *)"A", (ftnlen)1, (ftnlen)1);
+    wntqs = lsame_(jobz, (char *)"S", (ftnlen)1, (ftnlen)1);
+    wntqas = wntqa || wntqs;
+    wntqo = lsame_(jobz, (char *)"O", (ftnlen)1, (ftnlen)1);
+    wntqn = lsame_(jobz, (char *)"N", (ftnlen)1, (ftnlen)1);
+    lquery = *lwork == -1;
+    if (!(wntqa || wntqs || wntqo || wntqn)) {
+        *info = -1;
+    } else if (*m < 0) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *m)) {
+        *info = -5;
+    } else if (*ldu < 1 || wntqas && *ldu < *m || wntqo && *m < *n && *ldu < *m) {
+        *info = -8;
+    } else if (*ldvt < 1 || wntqa && *ldvt < *n || wntqs && *ldvt < minmn ||
+               wntqo && *m >= *n && *ldvt < *n) {
+        *info = -10;
+    }
+    if (*info == 0) {
+        minwrk = 1;
+        maxwrk = 1;
+        bdspac = 0;
+        mnthr = (integer)(minmn * 11. / 6.);
+        if (*m >= *n && minmn > 0) {
+            if (wntqn) {
+                bdspac = *n * 7;
+            } else {
+                bdspac = *n * 3 * *n + (*n << 2);
+            }
+            dgebrd_(m, n, dum, m, dum, dum, dum, dum, dum, &c_n1, &ierr);
+            lwork_dgebrd_mn__ = (integer)dum[0];
+            dgebrd_(n, n, dum, n, dum, dum, dum, dum, dum, &c_n1, &ierr);
+            lwork_dgebrd_nn__ = (integer)dum[0];
+            dgeqrf_(m, n, dum, m, dum, dum, &c_n1, &ierr);
+            lwork_dgeqrf_mn__ = (integer)dum[0];
+            dorgbr_((char *)"Q", n, n, n, dum, n, dum, dum, &c_n1, &ierr, (ftnlen)1);
+            lwork_dorgbr_q_nn__ = (integer)dum[0];
+            dorgqr_(m, m, n, dum, m, dum, dum, &c_n1, &ierr);
+            lwork_dorgqr_mm__ = (integer)dum[0];
+            dorgqr_(m, n, n, dum, m, dum, dum, &c_n1, &ierr);
+            lwork_dorgqr_mn__ = (integer)dum[0];
+            dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, dum, n, dum, dum, n, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_prt_nn__ = (integer)dum[0];
+            dormbr_((char *)"Q", (char *)"L", (char *)"N", n, n, n, dum, n, dum, dum, n, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_qln_nn__ = (integer)dum[0];
+            dormbr_((char *)"Q", (char *)"L", (char *)"N", m, n, n, dum, m, dum, dum, m, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_qln_mn__ = (integer)dum[0];
+            dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, n, dum, m, dum, dum, m, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_qln_mm__ = (integer)dum[0];
+            if (*m >= mnthr) {
+                if (wntqn) {
+                    wrkbl = *n + lwork_dgeqrf_mn__;
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dgebrd_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = bdspac + *n;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = bdspac + *n;
+                } else if (wntqo) {
+                    wrkbl = *n + lwork_dgeqrf_mn__;
+                    i__1 = wrkbl, i__2 = *n + lwork_dorgqr_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dgebrd_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + (*n << 1) * *n;
+                    minwrk = bdspac + (*n << 1) * *n + *n * 3;
+                } else if (wntqs) {
+                    wrkbl = *n + lwork_dgeqrf_mn__;
+                    i__1 = wrkbl, i__2 = *n + lwork_dorgqr_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dgebrd_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *n * *n;
+                    minwrk = bdspac + *n * *n + *n * 3;
+                } else if (wntqa) {
+                    wrkbl = *n + lwork_dgeqrf_mn__;
+                    i__1 = wrkbl, i__2 = *n + lwork_dorgqr_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dgebrd_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *n * *n;
+                    i__1 = *n * 3 + bdspac, i__2 = *n + *m;
+                    minwrk = *n * *n + max(i__1, i__2);
+                }
+            } else {
+                wrkbl = *n * 3 + lwork_dgebrd_mn__;
+                if (wntqn) {
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *n * 3 + max(*m, bdspac);
+                } else if (wntqo) {
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *m * *n;
+                    i__1 = *m, i__2 = *n * *n + bdspac;
+                    minwrk = *n * 3 + max(i__1, i__2);
+                } else if (wntqs) {
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *n * 3 + max(*m, bdspac);
+                } else if (wntqa) {
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *n * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *n * 3 + max(*m, bdspac);
+                }
+            }
+        } else if (minmn > 0) {
+            if (wntqn) {
+                bdspac = *m * 7;
+            } else {
+                bdspac = *m * 3 * *m + (*m << 2);
+            }
+            dgebrd_(m, n, dum, m, dum, dum, dum, dum, dum, &c_n1, &ierr);
+            lwork_dgebrd_mn__ = (integer)dum[0];
+            dgebrd_(m, m, &a[a_offset], m, &s[1], dum, dum, dum, dum, &c_n1, &ierr);
+            lwork_dgebrd_mm__ = (integer)dum[0];
+            dgelqf_(m, n, &a[a_offset], m, dum, dum, &c_n1, &ierr);
+            lwork_dgelqf_mn__ = (integer)dum[0];
+            dorglq_(n, n, m, dum, n, dum, dum, &c_n1, &ierr);
+            lwork_dorglq_nn__ = (integer)dum[0];
+            dorglq_(m, n, m, &a[a_offset], m, dum, dum, &c_n1, &ierr);
+            lwork_dorglq_mn__ = (integer)dum[0];
+            dorgbr_((char *)"P", m, m, m, &a[a_offset], n, dum, dum, &c_n1, &ierr, (ftnlen)1);
+            lwork_dorgbr_p_mm__ = (integer)dum[0];
+            dormbr_((char *)"P", (char *)"R", (char *)"T", m, m, m, dum, m, dum, dum, m, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_prt_mm__ = (integer)dum[0];
+            dormbr_((char *)"P", (char *)"R", (char *)"T", m, n, m, dum, m, dum, dum, m, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_prt_mn__ = (integer)dum[0];
+            dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, m, dum, n, dum, dum, n, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_prt_nn__ = (integer)dum[0];
+            dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, m, dum, m, dum, dum, m, dum, &c_n1, &ierr, (ftnlen)1,
+                    (ftnlen)1, (ftnlen)1);
+            lwork_dormbr_qln_mm__ = (integer)dum[0];
+            if (*n >= mnthr) {
+                if (wntqn) {
+                    wrkbl = *m + lwork_dgelqf_mn__;
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dgebrd_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = bdspac + *m;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = bdspac + *m;
+                } else if (wntqo) {
+                    wrkbl = *m + lwork_dgelqf_mn__;
+                    i__1 = wrkbl, i__2 = *m + lwork_dorglq_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dgebrd_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + (*m << 1) * *m;
+                    minwrk = bdspac + (*m << 1) * *m + *m * 3;
+                } else if (wntqs) {
+                    wrkbl = *m + lwork_dgelqf_mn__;
+                    i__1 = wrkbl, i__2 = *m + lwork_dorglq_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dgebrd_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *m * *m;
+                    minwrk = bdspac + *m * *m + *m * 3;
+                } else if (wntqa) {
+                    wrkbl = *m + lwork_dgelqf_mn__;
+                    i__1 = wrkbl, i__2 = *m + lwork_dorglq_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dgebrd_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *m * *m;
+                    i__1 = *m * 3 + bdspac, i__2 = *m + *n;
+                    minwrk = *m * *m + max(i__1, i__2);
+                }
+            } else {
+                wrkbl = *m * 3 + lwork_dgebrd_mn__;
+                if (wntqn) {
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *m * 3 + max(*n, bdspac);
+                } else if (wntqo) {
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    wrkbl = max(i__1, i__2);
+                    maxwrk = wrkbl + *m * *n;
+                    i__1 = *n, i__2 = *m * *m + bdspac;
+                    minwrk = *m * 3 + max(i__1, i__2);
+                } else if (wntqs) {
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_mn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *m * 3 + max(*n, bdspac);
+                } else if (wntqa) {
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_qln_mm__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + lwork_dormbr_prt_nn__;
+                    wrkbl = max(i__1, i__2);
+                    i__1 = wrkbl, i__2 = *m * 3 + bdspac;
+                    maxwrk = max(i__1, i__2);
+                    minwrk = *m * 3 + max(*n, bdspac);
+                }
+            }
+        }
+        maxwrk = max(maxwrk, minwrk);
+        work[1] = (doublereal)maxwrk;
+        if (*lwork < minwrk && !lquery) {
+            *info = -12;
+        }
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DGESDD", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    if (*m == 0 || *n == 0) {
+        return 0;
+    }
+    eps = dlamch_((char *)"P", (ftnlen)1);
+    smlnum = sqrt(dlamch_((char *)"S", (ftnlen)1)) / eps;
+    bignum = 1. / smlnum;
+    anrm = dlange_((char *)"M", m, n, &a[a_offset], lda, dum, (ftnlen)1);
+    iscl = 0;
+    if (anrm > 0. && anrm < smlnum) {
+        iscl = 1;
+        dlascl_((char *)"G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda, &ierr, (ftnlen)1);
+    } else if (anrm > bignum) {
+        iscl = 1;
+        dlascl_((char *)"G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda, &ierr, (ftnlen)1);
+    }
+    if (*m >= *n) {
+        if (*m >= mnthr) {
+            if (wntqn) {
+                itau = 1;
+                nwork = itau + *n;
+                i__1 = *lwork - nwork + 1;
+                dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                i__1 = *n - 1;
+                i__2 = *n - 1;
+                dlaset_((char *)"L", &i__1, &i__2, &c_b63, &c_b63, &a[a_dim1 + 2], lda, (ftnlen)1);
+                ie = 1;
+                itauq = ie + *n;
+                itaup = itauq + *n;
+                nwork = itaup + *n;
+                i__1 = *lwork - nwork + 1;
+                dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__1, &ierr);
+                nwork = ie + *n;
+                dbdsdc_((char *)"U", (char *)"N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1, dum, idum,
+                        &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+            } else if (wntqo) {
+                ir = 1;
+                if (*lwork >= *lda * *n + *n * *n + *n * 3 + bdspac) {
+                    ldwrkr = *lda;
+                } else {
+                    ldwrkr = (*lwork - *n * *n - *n * 3 - bdspac) / *n;
+                }
+                itau = ir + ldwrkr * *n;
+                nwork = itau + *n;
+                i__1 = *lwork - nwork + 1;
+                dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                dlacpy_((char *)"U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr, (ftnlen)1);
+                i__1 = *n - 1;
+                i__2 = *n - 1;
+                dlaset_((char *)"L", &i__1, &i__2, &c_b63, &c_b63, &work[ir + 1], &ldwrkr, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                ie = itau;
+                itauq = ie + *n;
+                itaup = itauq + *n;
+                nwork = itaup + *n;
+                i__1 = *lwork - nwork + 1;
+                dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__1, &ierr);
+                iu = nwork;
+                nwork = iu + *n * *n;
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &work[iu], n, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", n, n, n, &work[ir], &ldwrkr, &work[itauq], &work[iu], n,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, &work[ir], &ldwrkr, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *m;
+                i__2 = ldwrkr;
+                for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+                    i__3 = *m - i__ + 1;
+                    chunk = min(i__3, ldwrkr);
+                    dgemm_((char *)"N", (char *)"N", &chunk, n, n, &c_b84, &a[i__ + a_dim1], lda, &work[iu], n,
+                           &c_b63, &work[ir], &ldwrkr, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"F", &chunk, n, &work[ir], &ldwrkr, &a[i__ + a_dim1], lda, (ftnlen)1);
+                }
+            } else if (wntqs) {
+                ir = 1;
+                ldwrkr = *n;
+                itau = ir + ldwrkr * *n;
+                nwork = itau + *n;
+                i__2 = *lwork - nwork + 1;
+                dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                dlacpy_((char *)"U", n, n, &a[a_offset], lda, &work[ir], &ldwrkr, (ftnlen)1);
+                i__2 = *n - 1;
+                i__1 = *n - 1;
+                dlaset_((char *)"L", &i__2, &i__1, &c_b63, &c_b63, &work[ir + 1], &ldwrkr, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dorgqr_(m, n, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                ie = itau;
+                itauq = ie + *n;
+                itaup = itauq + *n;
+                nwork = itaup + *n;
+                i__2 = *lwork - nwork + 1;
+                dgebrd_(n, n, &work[ir], &ldwrkr, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__2, &ierr);
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", n, n, n, &work[ir], &ldwrkr, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, &work[ir], &ldwrkr, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"F", n, n, &u[u_offset], ldu, &work[ir], &ldwrkr, (ftnlen)1);
+                dgemm_((char *)"N", (char *)"N", m, n, n, &c_b84, &a[a_offset], lda, &work[ir], &ldwrkr, &c_b63,
+                       &u[u_offset], ldu, (ftnlen)1, (ftnlen)1);
+            } else if (wntqa) {
+                iu = 1;
+                ldwrku = *n;
+                itau = iu + ldwrku * *n;
+                nwork = itau + *n;
+                i__2 = *lwork - nwork + 1;
+                dgeqrf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                dlacpy_((char *)"L", m, n, &a[a_offset], lda, &u[u_offset], ldu, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dorgqr_(m, m, n, &u[u_offset], ldu, &work[itau], &work[nwork], &i__2, &ierr);
+                i__2 = *n - 1;
+                i__1 = *n - 1;
+                dlaset_((char *)"L", &i__2, &i__1, &c_b63, &c_b63, &a[a_dim1 + 2], lda, (ftnlen)1);
+                ie = itau;
+                itauq = ie + *n;
+                itaup = itauq + *n;
+                nwork = itaup + *n;
+                i__2 = *lwork - nwork + 1;
+                dgebrd_(n, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__2, &ierr);
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &work[iu], n, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", n, n, n, &a[a_offset], lda, &work[itauq], &work[iu], &ldwrku,
+                        &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                dgemm_((char *)"N", (char *)"N", m, n, n, &c_b84, &u[u_offset], ldu, &work[iu], &ldwrku, &c_b63,
+                       &a[a_offset], lda, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"F", m, n, &a[a_offset], lda, &u[u_offset], ldu, (ftnlen)1);
+            }
+        } else {
+            ie = 1;
+            itauq = ie + *n;
+            itaup = itauq + *n;
+            nwork = itaup + *n;
+            i__2 = *lwork - nwork + 1;
+            dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                    &work[nwork], &i__2, &ierr);
+            if (wntqn) {
+                dbdsdc_((char *)"U", (char *)"N", n, &s[1], &work[ie], dum, &c__1, dum, &c__1, dum, idum,
+                        &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+            } else if (wntqo) {
+                iu = nwork;
+                if (*lwork >= *m * *n + *n * 3 + bdspac) {
+                    ldwrku = *m;
+                    nwork = iu + ldwrku * *n;
+                    dlaset_((char *)"F", m, n, &c_b63, &c_b63, &work[iu], &ldwrku, (ftnlen)1);
+                    ir = -1;
+                } else {
+                    ldwrku = *n;
+                    nwork = iu + ldwrku * *n;
+                    ir = nwork;
+                    ldwrkr = (*lwork - *n * *n - *n * 3) / *n;
+                }
+                nwork = iu + ldwrku * *n;
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &work[iu], &ldwrku, &vt[vt_offset], ldvt,
+                        dum, idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                if (*lwork >= *m * *n + *n * 3 + bdspac) {
+                    i__2 = *lwork - nwork + 1;
+                    dormbr_((char *)"Q", (char *)"L", (char *)"N", m, n, n, &a[a_offset], lda, &work[itauq], &work[iu],
+                            &ldwrku, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"F", m, n, &work[iu], &ldwrku, &a[a_offset], lda, (ftnlen)1);
+                } else {
+                    i__2 = *lwork - nwork + 1;
+                    dorgbr_((char *)"Q", m, n, n, &a[a_offset], lda, &work[itauq], &work[nwork], &i__2,
+                            &ierr, (ftnlen)1);
+                    i__2 = *m;
+                    i__1 = ldwrkr;
+                    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+                        i__3 = *m - i__ + 1;
+                        chunk = min(i__3, ldwrkr);
+                        dgemm_((char *)"N", (char *)"N", &chunk, n, n, &c_b84, &a[i__ + a_dim1], lda, &work[iu],
+                               &ldwrku, &c_b63, &work[ir], &ldwrkr, (ftnlen)1, (ftnlen)1);
+                        dlacpy_((char *)"F", &chunk, n, &work[ir], &ldwrkr, &a[i__ + a_dim1], lda,
+                                (ftnlen)1);
+                    }
+                }
+            } else if (wntqs) {
+                dlaset_((char *)"F", m, n, &c_b63, &c_b63, &u[u_offset], ldu, (ftnlen)1);
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, n, n, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, n, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+            } else if (wntqa) {
+                dlaset_((char *)"F", m, m, &c_b63, &c_b63, &u[u_offset], ldu, (ftnlen)1);
+                dbdsdc_((char *)"U", (char *)"I", n, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                if (*m > *n) {
+                    i__1 = *m - *n;
+                    i__2 = *m - *n;
+                    dlaset_((char *)"F", &i__1, &i__2, &c_b63, &c_b84, &u[*n + 1 + (*n + 1) * u_dim1], ldu,
+                            (ftnlen)1);
+                }
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, n, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, m, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+            }
+        }
+    } else {
+        if (*n >= mnthr) {
+            if (wntqn) {
+                itau = 1;
+                nwork = itau + *m;
+                i__1 = *lwork - nwork + 1;
+                dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                i__1 = *m - 1;
+                i__2 = *m - 1;
+                dlaset_((char *)"U", &i__1, &i__2, &c_b63, &c_b63, &a[(a_dim1 << 1) + 1], lda, (ftnlen)1);
+                ie = 1;
+                itauq = ie + *m;
+                itaup = itauq + *m;
+                nwork = itaup + *m;
+                i__1 = *lwork - nwork + 1;
+                dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__1, &ierr);
+                nwork = ie + *m;
+                dbdsdc_((char *)"U", (char *)"N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1, dum, idum,
+                        &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+            } else if (wntqo) {
+                ivt = 1;
+                il = ivt + *m * *m;
+                if (*lwork >= *m * *n + *m * *m + *m * 3 + bdspac) {
+                    ldwrkl = *m;
+                    chunk = *n;
+                } else {
+                    ldwrkl = *m;
+                    chunk = (*lwork - *m * *m) / *m;
+                }
+                itau = il + ldwrkl * *m;
+                nwork = itau + *m;
+                i__1 = *lwork - nwork + 1;
+                dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                dlacpy_((char *)"L", m, m, &a[a_offset], lda, &work[il], &ldwrkl, (ftnlen)1);
+                i__1 = *m - 1;
+                i__2 = *m - 1;
+                dlaset_((char *)"U", &i__1, &i__2, &c_b63, &c_b63, &work[il + ldwrkl], &ldwrkl, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], &i__1, &ierr);
+                ie = itau;
+                itauq = ie + *m;
+                itaup = itauq + *m;
+                nwork = itaup + *m;
+                i__1 = *lwork - nwork + 1;
+                dgebrd_(m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__1, &ierr);
+                dbdsdc_((char *)"U", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &work[ivt], m, dum, idum,
+                        &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, m, &work[il], &ldwrkl, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", m, m, m, &work[il], &ldwrkl, &work[itaup], &work[ivt], m,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *n;
+                i__2 = chunk;
+                for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+                    i__3 = *n - i__ + 1;
+                    blk = min(i__3, chunk);
+                    dgemm_((char *)"N", (char *)"N", m, &blk, m, &c_b84, &work[ivt], m, &a[i__ * a_dim1 + 1], lda,
+                           &c_b63, &work[il], &ldwrkl, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"F", m, &blk, &work[il], &ldwrkl, &a[i__ * a_dim1 + 1], lda, (ftnlen)1);
+                }
+            } else if (wntqs) {
+                il = 1;
+                ldwrkl = *m;
+                itau = il + ldwrkl * *m;
+                nwork = itau + *m;
+                i__2 = *lwork - nwork + 1;
+                dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                dlacpy_((char *)"L", m, m, &a[a_offset], lda, &work[il], &ldwrkl, (ftnlen)1);
+                i__2 = *m - 1;
+                i__1 = *m - 1;
+                dlaset_((char *)"U", &i__2, &i__1, &c_b63, &c_b63, &work[il + ldwrkl], &ldwrkl, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dorglq_(m, n, m, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                ie = itau;
+                itauq = ie + *m;
+                itaup = itauq + *m;
+                nwork = itaup + *m;
+                i__2 = *lwork - nwork + 1;
+                dgebrd_(m, m, &work[il], &ldwrkl, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__2, &ierr);
+                dbdsdc_((char *)"U", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, m, &work[il], &ldwrkl, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", m, m, m, &work[il], &ldwrkl, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"F", m, m, &vt[vt_offset], ldvt, &work[il], &ldwrkl, (ftnlen)1);
+                dgemm_((char *)"N", (char *)"N", m, n, m, &c_b84, &work[il], &ldwrkl, &a[a_offset], lda, &c_b63,
+                       &vt[vt_offset], ldvt, (ftnlen)1, (ftnlen)1);
+            } else if (wntqa) {
+                ivt = 1;
+                ldwkvt = *m;
+                itau = ivt + ldwkvt * *m;
+                nwork = itau + *m;
+                i__2 = *lwork - nwork + 1;
+                dgelqf_(m, n, &a[a_offset], lda, &work[itau], &work[nwork], &i__2, &ierr);
+                dlacpy_((char *)"U", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dorglq_(n, n, m, &vt[vt_offset], ldvt, &work[itau], &work[nwork], &i__2, &ierr);
+                i__2 = *m - 1;
+                i__1 = *m - 1;
+                dlaset_((char *)"U", &i__2, &i__1, &c_b63, &c_b63, &a[(a_dim1 << 1) + 1], lda, (ftnlen)1);
+                ie = itau;
+                itauq = ie + *m;
+                itaup = itauq + *m;
+                nwork = itaup + *m;
+                i__2 = *lwork - nwork + 1;
+                dgebrd_(m, m, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                        &work[nwork], &i__2, &ierr);
+                dbdsdc_((char *)"U", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &work[ivt], &ldwkvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, m, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", m, m, m, &a[a_offset], lda, &work[itaup], &work[ivt],
+                        &ldwkvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                dgemm_((char *)"N", (char *)"N", m, n, m, &c_b84, &work[ivt], &ldwkvt, &vt[vt_offset], ldvt, &c_b63,
+                       &a[a_offset], lda, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"F", m, n, &a[a_offset], lda, &vt[vt_offset], ldvt, (ftnlen)1);
+            }
+        } else {
+            ie = 1;
+            itauq = ie + *m;
+            itaup = itauq + *m;
+            nwork = itaup + *m;
+            i__2 = *lwork - nwork + 1;
+            dgebrd_(m, n, &a[a_offset], lda, &s[1], &work[ie], &work[itauq], &work[itaup],
+                    &work[nwork], &i__2, &ierr);
+            if (wntqn) {
+                dbdsdc_((char *)"L", (char *)"N", m, &s[1], &work[ie], dum, &c__1, dum, &c__1, dum, idum,
+                        &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+            } else if (wntqo) {
+                ldwkvt = *m;
+                ivt = nwork;
+                if (*lwork >= *m * *n + *m * 3 + bdspac) {
+                    dlaset_((char *)"F", m, n, &c_b63, &c_b63, &work[ivt], &ldwkvt, (ftnlen)1);
+                    nwork = ivt + ldwkvt * *n;
+                    il = -1;
+                } else {
+                    nwork = ivt + ldwkvt * *m;
+                    il = nwork;
+                    chunk = (*lwork - *m * *m - *m * 3) / *m;
+                }
+                dbdsdc_((char *)"L", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &work[ivt], &ldwkvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__2 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, n, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                if (*lwork >= *m * *n + *m * 3 + bdspac) {
+                    i__2 = *lwork - nwork + 1;
+                    dormbr_((char *)"P", (char *)"R", (char *)"T", m, n, m, &a[a_offset], lda, &work[itaup], &work[ivt],
+                            &ldwkvt, &work[nwork], &i__2, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"F", m, n, &work[ivt], &ldwkvt, &a[a_offset], lda, (ftnlen)1);
+                } else {
+                    i__2 = *lwork - nwork + 1;
+                    dorgbr_((char *)"P", m, n, m, &a[a_offset], lda, &work[itaup], &work[nwork], &i__2,
+                            &ierr, (ftnlen)1);
+                    i__2 = *n;
+                    i__1 = chunk;
+                    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+                        i__3 = *n - i__ + 1;
+                        blk = min(i__3, chunk);
+                        dgemm_((char *)"N", (char *)"N", m, &blk, m, &c_b84, &work[ivt], &ldwkvt,
+                               &a[i__ * a_dim1 + 1], lda, &c_b63, &work[il], m, (ftnlen)1,
+                               (ftnlen)1);
+                        dlacpy_((char *)"F", m, &blk, &work[il], m, &a[i__ * a_dim1 + 1], lda, (ftnlen)1);
+                    }
+                }
+            } else if (wntqs) {
+                dlaset_((char *)"F", m, n, &c_b63, &c_b63, &vt[vt_offset], ldvt, (ftnlen)1);
+                dbdsdc_((char *)"L", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, n, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", m, n, m, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+            } else if (wntqa) {
+                dlaset_((char *)"F", n, n, &c_b63, &c_b63, &vt[vt_offset], ldvt, (ftnlen)1);
+                dbdsdc_((char *)"L", (char *)"I", m, &s[1], &work[ie], &u[u_offset], ldu, &vt[vt_offset], ldvt, dum,
+                        idum, &work[nwork], &iwork[1], info, (ftnlen)1, (ftnlen)1);
+                if (*n > *m) {
+                    i__1 = *n - *m;
+                    i__2 = *n - *m;
+                    dlaset_((char *)"F", &i__1, &i__2, &c_b63, &c_b84, &vt[*m + 1 + (*m + 1) * vt_dim1],
+                            ldvt, (ftnlen)1);
+                }
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"Q", (char *)"L", (char *)"N", m, m, n, &a[a_offset], lda, &work[itauq], &u[u_offset], ldu,
+                        &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                i__1 = *lwork - nwork + 1;
+                dormbr_((char *)"P", (char *)"R", (char *)"T", n, n, m, &a[a_offset], lda, &work[itaup], &vt[vt_offset],
+                        ldvt, &work[nwork], &i__1, &ierr, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+            }
+        }
+    }
+    if (iscl == 1) {
+        if (anrm > bignum) {
+            dlascl_((char *)"G", &c__0, &c__0, &bignum, &anrm, &minmn, &c__1, &s[1], &minmn, &ierr,
+                    (ftnlen)1);
+        }
+        if (anrm < smlnum) {
+            dlascl_((char *)"G", &c__0, &c__0, &smlnum, &anrm, &minmn, &c__1, &s[1], &minmn, &ierr,
+                    (ftnlen)1);
+        }
+    }
+    work[1] = (doublereal)maxwrk;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dhseqr.cpp

@@ -0,0 +1,145 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b11 = 0.;
+static doublereal c_b12 = 1.;
+static integer c__12 = 12;
+static integer c__2 = 2;
+static integer c__49 = 49;
+int dhseqr_(char *job, char *compz, integer *n, integer *ilo, integer *ihi, doublereal *h__,
+            integer *ldh, doublereal *wr, doublereal *wi, doublereal *z__, integer *ldz,
+            doublereal *work, integer *lwork, integer *info, ftnlen job_len, ftnlen compz_len)
+{
+    address a__1[2];
+    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2[2], i__3;
+    doublereal d__1;
+    char ch__1[2];
+    int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
+    integer i__;
+    doublereal hl[2401];
+    integer kbot, nmin;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    logical initz;
+    doublereal workl[49];
+    logical wantt, wantz;
+    extern int dlaqr0_(logical *, logical *, integer *, integer *, integer *, doublereal *,
+                       integer *, doublereal *, doublereal *, integer *, integer *, doublereal *,
+                       integer *, doublereal *, integer *, integer *),
+        dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
+                integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen),
+        dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int xerbla_(char *, integer *, ftnlen);
+    logical lquery;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    --wr;
+    --wi;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    --work;
+    wantt = lsame_(job, (char *)"S", (ftnlen)1, (ftnlen)1);
+    initz = lsame_(compz, (char *)"I", (ftnlen)1, (ftnlen)1);
+    wantz = initz || lsame_(compz, (char *)"V", (ftnlen)1, (ftnlen)1);
+    work[1] = (doublereal)max(1, *n);
+    lquery = *lwork == -1;
+    *info = 0;
+    if (!lsame_(job, (char *)"E", (ftnlen)1, (ftnlen)1) && !wantt) {
+        *info = -1;
+    } else if (!lsame_(compz, (char *)"N", (ftnlen)1, (ftnlen)1) && !wantz) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*ilo < 1 || *ilo > max(1, *n)) {
+        *info = -4;
+    } else if (*ihi < min(*ilo, *n) || *ihi > *n) {
+        *info = -5;
+    } else if (*ldh < max(1, *n)) {
+        *info = -7;
+    } else if (*ldz < 1 || wantz && *ldz < max(1, *n)) {
+        *info = -11;
+    } else if (*lwork < max(1, *n) && !lquery) {
+        *info = -13;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DHSEQR", &i__1, (ftnlen)6);
+        return 0;
+    } else if (*n == 0) {
+        return 0;
+    } else if (lquery) {
+        dlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
+                &z__[z_offset], ldz, &work[1], lwork, info);
+        d__1 = (doublereal)max(1, *n);
+        work[1] = max(d__1, work[1]);
+        return 0;
+    } else {
+        i__1 = *ilo - 1;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            wr[i__] = h__[i__ + i__ * h_dim1];
+            wi[i__] = 0.;
+        }
+        i__1 = *n;
+        for (i__ = *ihi + 1; i__ <= i__1; ++i__) {
+            wr[i__] = h__[i__ + i__ * h_dim1];
+            wi[i__] = 0.;
+        }
+        if (initz) {
+            dlaset_((char *)"A", n, n, &c_b11, &c_b12, &z__[z_offset], ldz, (ftnlen)1);
+        }
+        if (*ilo == *ihi) {
+            wr[*ilo] = h__[*ilo + *ilo * h_dim1];
+            wi[*ilo] = 0.;
+            return 0;
+        }
+        i__2[0] = 1, a__1[0] = job;
+        i__2[1] = 1, a__1[1] = compz;
+        s_lmp_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
+        nmin = ilaenv_(&c__12, (char *)"DHSEQR", ch__1, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nmin = max(11, nmin);
+        if (*n > nmin) {
+            dlaqr0_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
+                    &z__[z_offset], ldz, &work[1], lwork, info);
+        } else {
+            dlahqr_(&wantt, &wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], ilo, ihi,
+                    &z__[z_offset], ldz, info);
+            if (*info > 0) {
+                kbot = *info;
+                if (*n >= 49) {
+                    dlaqr0_(&wantt, &wantz, n, ilo, &kbot, &h__[h_offset], ldh, &wr[1], &wi[1], ilo,
+                            ihi, &z__[z_offset], ldz, &work[1], lwork, info);
+                } else {
+                    dlacpy_((char *)"A", n, n, &h__[h_offset], ldh, hl, &c__49, (ftnlen)1);
+                    hl[*n + 1 + *n * 49 - 50] = 0.;
+                    i__1 = 49 - *n;
+                    dlaset_((char *)"A", &c__49, &i__1, &c_b11, &c_b11, &hl[(*n + 1) * 49 - 49], &c__49,
+                            (ftnlen)1);
+                    dlaqr0_(&wantt, &wantz, &c__49, ilo, &kbot, hl, &c__49, &wr[1], &wi[1], ilo,
+                            ihi, &z__[z_offset], ldz, workl, &c__49, info);
+                    if (wantt || *info != 0) {
+                        dlacpy_((char *)"A", n, n, hl, &c__49, &h__[h_offset], ldh, (ftnlen)1);
+                    }
+                }
+            }
+        }
+        if ((wantt || *info != 0) && *n > 2) {
+            i__1 = *n - 2;
+            i__3 = *n - 2;
+            dlaset_((char *)"L", &i__1, &i__3, &c_b11, &c_b11, &h__[h_dim1 + 3], ldh, (ftnlen)1);
+        }
+        d__1 = (doublereal)max(1, *n);
+        work[1] = max(d__1, work[1]);
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaexc.cpp

@@ -0,0 +1,214 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c__4 = 4;
+static logical c_false = FALSE_;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static integer c__3 = 3;
+int dlaexc_(logical *wantq, integer *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq,
+            integer *j1, integer *n1, integer *n2, doublereal *work, integer *info)
+{
+    integer q_dim1, q_offset, t_dim1, t_offset, i__1;
+    doublereal d__1, d__2, d__3;
+    doublereal d__[16];
+    integer k;
+    doublereal u[3], x[4];
+    integer j2, j3, j4;
+    doublereal u1[3], u2[3];
+    integer nd;
+    doublereal cs, t11, t22, t33, sn, wi1, wi2, wr1, wr2, eps, tau, tau1, tau2;
+    integer ierr;
+    doublereal temp;
+    extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                     doublereal *);
+    doublereal scale, dnorm, xnorm;
+    extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlasy2_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *,
+                integer *, doublereal *, integer *);
+    extern doublereal dlamch_(char *, ftnlen),
+        dlange_(char *, integer *, integer *, doublereal *, integer *, doublereal *, ftnlen);
+    extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen),
+        dlartg_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlarfx_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                doublereal *, ftnlen);
+    doublereal thresh, smlnum;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    q_dim1 = *ldq;
+    q_offset = 1 + q_dim1;
+    q -= q_offset;
+    --work;
+    *info = 0;
+    if (*n == 0 || *n1 == 0 || *n2 == 0) {
+        return 0;
+    }
+    if (*j1 + *n1 > *n) {
+        return 0;
+    }
+    j2 = *j1 + 1;
+    j3 = *j1 + 2;
+    j4 = *j1 + 3;
+    if (*n1 == 1 && *n2 == 1) {
+        t11 = t[*j1 + *j1 * t_dim1];
+        t22 = t[j2 + j2 * t_dim1];
+        d__1 = t22 - t11;
+        dlartg_(&t[*j1 + j2 * t_dim1], &d__1, &cs, &sn, &temp);
+        if (j3 <= *n) {
+            i__1 = *n - *j1 - 1;
+            drot_(&i__1, &t[*j1 + j3 * t_dim1], ldt, &t[j2 + j3 * t_dim1], ldt, &cs, &sn);
+        }
+        i__1 = *j1 - 1;
+        drot_(&i__1, &t[*j1 * t_dim1 + 1], &c__1, &t[j2 * t_dim1 + 1], &c__1, &cs, &sn);
+        t[*j1 + *j1 * t_dim1] = t22;
+        t[j2 + j2 * t_dim1] = t11;
+        if (*wantq) {
+            drot_(n, &q[*j1 * q_dim1 + 1], &c__1, &q[j2 * q_dim1 + 1], &c__1, &cs, &sn);
+        }
+    } else {
+        nd = *n1 + *n2;
+        dlacpy_((char *)"Full", &nd, &nd, &t[*j1 + *j1 * t_dim1], ldt, d__, &c__4, (ftnlen)4);
+        dnorm = dlange_((char *)"Max", &nd, &nd, d__, &c__4, &work[1], (ftnlen)3);
+        eps = dlamch_((char *)"P", (ftnlen)1);
+        smlnum = dlamch_((char *)"S", (ftnlen)1) / eps;
+        d__1 = eps * 10. * dnorm;
+        thresh = max(d__1, smlnum);
+        dlasy2_(&c_false, &c_false, &c_n1, n1, n2, d__, &c__4, &d__[*n1 + 1 + (*n1 + 1 << 2) - 5],
+                &c__4, &d__[(*n1 + 1 << 2) - 4], &c__4, &scale, x, &c__2, &xnorm, &ierr);
+        k = *n1 + *n1 + *n2 - 3;
+        switch (k) {
+            case 1:
+                goto L10;
+            case 2:
+                goto L20;
+            case 3:
+                goto L30;
+        }
+    L10:
+        u[0] = scale;
+        u[1] = x[0];
+        u[2] = x[2];
+        dlarfg_(&c__3, &u[2], u, &c__1, &tau);
+        u[2] = 1.;
+        t11 = t[*j1 + *j1 * t_dim1];
+        dlarfx_((char *)"L", &c__3, &c__3, u, &tau, d__, &c__4, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &c__3, &c__3, u, &tau, d__, &c__4, &work[1], (ftnlen)1);
+        d__2 = abs(d__[2]), d__3 = abs(d__[6]), d__2 = max(d__2, d__3),
+        d__3 = (d__1 = d__[10] - t11, abs(d__1));
+        if (max(d__2, d__3) > thresh) {
+            goto L50;
+        }
+        i__1 = *n - *j1 + 1;
+        dlarfx_((char *)"L", &c__3, &i__1, u, &tau, &t[*j1 + *j1 * t_dim1], ldt, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &j2, &c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1], (ftnlen)1);
+        t[j3 + *j1 * t_dim1] = 0.;
+        t[j3 + j2 * t_dim1] = 0.;
+        t[j3 + j3 * t_dim1] = t11;
+        if (*wantq) {
+            dlarfx_((char *)"R", n, &c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[1], (ftnlen)1);
+        }
+        goto L40;
+    L20:
+        u[0] = -x[0];
+        u[1] = -x[1];
+        u[2] = scale;
+        dlarfg_(&c__3, u, &u[1], &c__1, &tau);
+        u[0] = 1.;
+        t33 = t[j3 + j3 * t_dim1];
+        dlarfx_((char *)"L", &c__3, &c__3, u, &tau, d__, &c__4, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &c__3, &c__3, u, &tau, d__, &c__4, &work[1], (ftnlen)1);
+        d__2 = abs(d__[1]), d__3 = abs(d__[2]), d__2 = max(d__2, d__3),
+        d__3 = (d__1 = d__[0] - t33, abs(d__1));
+        if (max(d__2, d__3) > thresh) {
+            goto L50;
+        }
+        dlarfx_((char *)"R", &j3, &c__3, u, &tau, &t[*j1 * t_dim1 + 1], ldt, &work[1], (ftnlen)1);
+        i__1 = *n - *j1;
+        dlarfx_((char *)"L", &c__3, &i__1, u, &tau, &t[*j1 + j2 * t_dim1], ldt, &work[1], (ftnlen)1);
+        t[*j1 + *j1 * t_dim1] = t33;
+        t[j2 + *j1 * t_dim1] = 0.;
+        t[j3 + *j1 * t_dim1] = 0.;
+        if (*wantq) {
+            dlarfx_((char *)"R", n, &c__3, u, &tau, &q[*j1 * q_dim1 + 1], ldq, &work[1], (ftnlen)1);
+        }
+        goto L40;
+    L30:
+        u1[0] = -x[0];
+        u1[1] = -x[1];
+        u1[2] = scale;
+        dlarfg_(&c__3, u1, &u1[1], &c__1, &tau1);
+        u1[0] = 1.;
+        temp = -tau1 * (x[2] + u1[1] * x[3]);
+        u2[0] = -temp * u1[1] - x[3];
+        u2[1] = -temp * u1[2];
+        u2[2] = scale;
+        dlarfg_(&c__3, u2, &u2[1], &c__1, &tau2);
+        u2[0] = 1.;
+        dlarfx_((char *)"L", &c__3, &c__4, u1, &tau1, d__, &c__4, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &c__4, &c__3, u1, &tau1, d__, &c__4, &work[1], (ftnlen)1);
+        dlarfx_((char *)"L", &c__3, &c__4, u2, &tau2, &d__[1], &c__4, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &c__4, &c__3, u2, &tau2, &d__[4], &c__4, &work[1], (ftnlen)1);
+        d__1 = abs(d__[2]), d__2 = abs(d__[6]), d__1 = max(d__1, d__2), d__2 = abs(d__[3]),
+        d__1 = max(d__1, d__2), d__2 = abs(d__[7]);
+        if (max(d__1, d__2) > thresh) {
+            goto L50;
+        }
+        i__1 = *n - *j1 + 1;
+        dlarfx_((char *)"L", &c__3, &i__1, u1, &tau1, &t[*j1 + *j1 * t_dim1], ldt, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &j4, &c__3, u1, &tau1, &t[*j1 * t_dim1 + 1], ldt, &work[1], (ftnlen)1);
+        i__1 = *n - *j1 + 1;
+        dlarfx_((char *)"L", &c__3, &i__1, u2, &tau2, &t[j2 + *j1 * t_dim1], ldt, &work[1], (ftnlen)1);
+        dlarfx_((char *)"R", &j4, &c__3, u2, &tau2, &t[j2 * t_dim1 + 1], ldt, &work[1], (ftnlen)1);
+        t[j3 + *j1 * t_dim1] = 0.;
+        t[j3 + j2 * t_dim1] = 0.;
+        t[j4 + *j1 * t_dim1] = 0.;
+        t[j4 + j2 * t_dim1] = 0.;
+        if (*wantq) {
+            dlarfx_((char *)"R", n, &c__3, u1, &tau1, &q[*j1 * q_dim1 + 1], ldq, &work[1], (ftnlen)1);
+            dlarfx_((char *)"R", n, &c__3, u2, &tau2, &q[j2 * q_dim1 + 1], ldq, &work[1], (ftnlen)1);
+        }
+    L40:
+        if (*n2 == 2) {
+            dlanv2_(&t[*j1 + *j1 * t_dim1], &t[*j1 + j2 * t_dim1], &t[j2 + *j1 * t_dim1],
+                    &t[j2 + j2 * t_dim1], &wr1, &wi1, &wr2, &wi2, &cs, &sn);
+            i__1 = *n - *j1 - 1;
+            drot_(&i__1, &t[*j1 + (*j1 + 2) * t_dim1], ldt, &t[j2 + (*j1 + 2) * t_dim1], ldt, &cs,
+                  &sn);
+            i__1 = *j1 - 1;
+            drot_(&i__1, &t[*j1 * t_dim1 + 1], &c__1, &t[j2 * t_dim1 + 1], &c__1, &cs, &sn);
+            if (*wantq) {
+                drot_(n, &q[*j1 * q_dim1 + 1], &c__1, &q[j2 * q_dim1 + 1], &c__1, &cs, &sn);
+            }
+        }
+        if (*n1 == 2) {
+            j3 = *j1 + *n2;
+            j4 = j3 + 1;
+            dlanv2_(&t[j3 + j3 * t_dim1], &t[j3 + j4 * t_dim1], &t[j4 + j3 * t_dim1],
+                    &t[j4 + j4 * t_dim1], &wr1, &wi1, &wr2, &wi2, &cs, &sn);
+            if (j3 + 2 <= *n) {
+                i__1 = *n - j3 - 1;
+                drot_(&i__1, &t[j3 + (j3 + 2) * t_dim1], ldt, &t[j4 + (j3 + 2) * t_dim1], ldt, &cs,
+                      &sn);
+            }
+            i__1 = j3 - 1;
+            drot_(&i__1, &t[j3 * t_dim1 + 1], &c__1, &t[j4 * t_dim1 + 1], &c__1, &cs, &sn);
+            if (*wantq) {
+                drot_(n, &q[j3 * q_dim1 + 1], &c__1, &q[j4 * q_dim1 + 1], &c__1, &cs, &sn);
+            }
+        }
+    }
+    return 0;
+L50:
+    *info = 1;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlahqr.cpp

@@ -0,0 +1,311 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+int dlahqr_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__,
+            integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz,
+            doublereal *z__, integer *ldz, integer *info)
+{
+    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4;
+    doublereal d__1, d__2, d__3, d__4;
+    double sqrt(doublereal);
+    integer i__, j, k, l, m;
+    doublereal s, v[3];
+    integer i1, i2;
+    doublereal t1, t2, t3, v2, v3, aa, ab, ba, bb, h11, h12, h21, h22, cs;
+    integer nh;
+    doublereal sn;
+    integer nr;
+    doublereal tr;
+    integer nz;
+    doublereal det, h21s;
+    integer its;
+    doublereal ulp, sum, tst, rt1i, rt2i, rt1r, rt2r;
+    extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                     doublereal *),
+        dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer itmax;
+    extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlabad_(doublereal *, doublereal *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *);
+    doublereal safmin, safmax, rtdisc, smlnum;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    --wr;
+    --wi;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    *info = 0;
+    if (*n == 0) {
+        return 0;
+    }
+    if (*ilo == *ihi) {
+        wr[*ilo] = h__[*ilo + *ilo * h_dim1];
+        wi[*ilo] = 0.;
+        return 0;
+    }
+    i__1 = *ihi - 3;
+    for (j = *ilo; j <= i__1; ++j) {
+        h__[j + 2 + j * h_dim1] = 0.;
+        h__[j + 3 + j * h_dim1] = 0.;
+    }
+    if (*ilo <= *ihi - 2) {
+        h__[*ihi + (*ihi - 2) * h_dim1] = 0.;
+    }
+    nh = *ihi - *ilo + 1;
+    nz = *ihiz - *iloz + 1;
+    safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
+    safmax = 1. / safmin;
+    dlabad_(&safmin, &safmax);
+    ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
+    smlnum = safmin * ((doublereal)nh / ulp);
+    if (*wantt) {
+        i1 = 1;
+        i2 = *n;
+    }
+    itmax = max(10, nh) * 30;
+    i__ = *ihi;
+L20:
+    l = *ilo;
+    if (i__ < *ilo) {
+        goto L160;
+    }
+    i__1 = itmax;
+    for (its = 0; its <= i__1; ++its) {
+        i__2 = l + 1;
+        for (k = i__; k >= i__2; --k) {
+            if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= smlnum) {
+                goto L40;
+            }
+            tst = (d__1 = h__[k - 1 + (k - 1) * h_dim1], abs(d__1)) +
+                  (d__2 = h__[k + k * h_dim1], abs(d__2));
+            if (tst == 0.) {
+                if (k - 2 >= *ilo) {
+                    tst += (d__1 = h__[k - 1 + (k - 2) * h_dim1], abs(d__1));
+                }
+                if (k + 1 <= *ihi) {
+                    tst += (d__1 = h__[k + 1 + k * h_dim1], abs(d__1));
+                }
+            }
+            if ((d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)) <= ulp * tst) {
+                d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)),
+                d__4 = (d__2 = h__[k - 1 + k * h_dim1], abs(d__2));
+                ab = max(d__3, d__4);
+                d__3 = (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1)),
+                d__4 = (d__2 = h__[k - 1 + k * h_dim1], abs(d__2));
+                ba = min(d__3, d__4);
+                d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)),
+                d__4 = (d__2 = h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], abs(d__2));
+                aa = max(d__3, d__4);
+                d__3 = (d__1 = h__[k + k * h_dim1], abs(d__1)),
+                d__4 = (d__2 = h__[k - 1 + (k - 1) * h_dim1] - h__[k + k * h_dim1], abs(d__2));
+                bb = min(d__3, d__4);
+                s = aa + ab;
+                d__1 = smlnum, d__2 = ulp * (bb * (aa / s));
+                if (ba * (ab / s) <= max(d__1, d__2)) {
+                    goto L40;
+                }
+            }
+        }
+    L40:
+        l = k;
+        if (l > *ilo) {
+            h__[l + (l - 1) * h_dim1] = 0.;
+        }
+        if (l >= i__ - 1) {
+            goto L150;
+        }
+        if (!(*wantt)) {
+            i1 = l;
+            i2 = i__;
+        }
+        if (its == 10) {
+            s = (d__1 = h__[l + 1 + l * h_dim1], abs(d__1)) +
+                (d__2 = h__[l + 2 + (l + 1) * h_dim1], abs(d__2));
+            h11 = s * .75 + h__[l + l * h_dim1];
+            h12 = s * -.4375;
+            h21 = s;
+            h22 = h11;
+        } else if (its == 20) {
+            s = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) +
+                (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
+            h11 = s * .75 + h__[i__ + i__ * h_dim1];
+            h12 = s * -.4375;
+            h21 = s;
+            h22 = h11;
+        } else {
+            h11 = h__[i__ - 1 + (i__ - 1) * h_dim1];
+            h21 = h__[i__ + (i__ - 1) * h_dim1];
+            h12 = h__[i__ - 1 + i__ * h_dim1];
+            h22 = h__[i__ + i__ * h_dim1];
+        }
+        s = abs(h11) + abs(h12) + abs(h21) + abs(h22);
+        if (s == 0.) {
+            rt1r = 0.;
+            rt1i = 0.;
+            rt2r = 0.;
+            rt2i = 0.;
+        } else {
+            h11 /= s;
+            h21 /= s;
+            h12 /= s;
+            h22 /= s;
+            tr = (h11 + h22) / 2.;
+            det = (h11 - tr) * (h22 - tr) - h12 * h21;
+            rtdisc = sqrt((abs(det)));
+            if (det >= 0.) {
+                rt1r = tr * s;
+                rt2r = rt1r;
+                rt1i = rtdisc * s;
+                rt2i = -rt1i;
+            } else {
+                rt1r = tr + rtdisc;
+                rt2r = tr - rtdisc;
+                if ((d__1 = rt1r - h22, abs(d__1)) <= (d__2 = rt2r - h22, abs(d__2))) {
+                    rt1r *= s;
+                    rt2r = rt1r;
+                } else {
+                    rt2r *= s;
+                    rt1r = rt2r;
+                }
+                rt1i = 0.;
+                rt2i = 0.;
+            }
+        }
+        i__2 = l;
+        for (m = i__ - 2; m >= i__2; --m) {
+            h21s = h__[m + 1 + m * h_dim1];
+            s = (d__1 = h__[m + m * h_dim1] - rt2r, abs(d__1)) + abs(rt2i) + abs(h21s);
+            h21s = h__[m + 1 + m * h_dim1] / s;
+            v[0] = h21s * h__[m + (m + 1) * h_dim1] +
+                   (h__[m + m * h_dim1] - rt1r) * ((h__[m + m * h_dim1] - rt2r) / s) -
+                   rt1i * (rt2i / s);
+            v[1] = h21s * (h__[m + m * h_dim1] + h__[m + 1 + (m + 1) * h_dim1] - rt1r - rt2r);
+            v[2] = h21s * h__[m + 2 + (m + 1) * h_dim1];
+            s = abs(v[0]) + abs(v[1]) + abs(v[2]);
+            v[0] /= s;
+            v[1] /= s;
+            v[2] /= s;
+            if (m == l) {
+                goto L60;
+            }
+            if ((d__1 = h__[m + (m - 1) * h_dim1], abs(d__1)) * (abs(v[1]) + abs(v[2])) <=
+                ulp * abs(v[0]) *
+                    ((d__2 = h__[m - 1 + (m - 1) * h_dim1], abs(d__2)) +
+                     (d__3 = h__[m + m * h_dim1], abs(d__3)) +
+                     (d__4 = h__[m + 1 + (m + 1) * h_dim1], abs(d__4)))) {
+                goto L60;
+            }
+        }
+    L60:
+        i__2 = i__ - 1;
+        for (k = m; k <= i__2; ++k) {
+            i__3 = 3, i__4 = i__ - k + 1;
+            nr = min(i__3, i__4);
+            if (k > m) {
+                dcopy_(&nr, &h__[k + (k - 1) * h_dim1], &c__1, v, &c__1);
+            }
+            dlarfg_(&nr, v, &v[1], &c__1, &t1);
+            if (k > m) {
+                h__[k + (k - 1) * h_dim1] = v[0];
+                h__[k + 1 + (k - 1) * h_dim1] = 0.;
+                if (k < i__ - 1) {
+                    h__[k + 2 + (k - 1) * h_dim1] = 0.;
+                }
+            } else if (m > l) {
+                h__[k + (k - 1) * h_dim1] *= 1. - t1;
+            }
+            v2 = v[1];
+            t2 = t1 * v2;
+            if (nr == 3) {
+                v3 = v[2];
+                t3 = t1 * v3;
+                i__3 = i2;
+                for (j = k; j <= i__3; ++j) {
+                    sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1] +
+                          v3 * h__[k + 2 + j * h_dim1];
+                    h__[k + j * h_dim1] -= sum * t1;
+                    h__[k + 1 + j * h_dim1] -= sum * t2;
+                    h__[k + 2 + j * h_dim1] -= sum * t3;
+                }
+                i__4 = k + 3;
+                i__3 = min(i__4, i__);
+                for (j = i1; j <= i__3; ++j) {
+                    sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1] +
+                          v3 * h__[j + (k + 2) * h_dim1];
+                    h__[j + k * h_dim1] -= sum * t1;
+                    h__[j + (k + 1) * h_dim1] -= sum * t2;
+                    h__[j + (k + 2) * h_dim1] -= sum * t3;
+                }
+                if (*wantz) {
+                    i__3 = *ihiz;
+                    for (j = *iloz; j <= i__3; ++j) {
+                        sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * z_dim1] +
+                              v3 * z__[j + (k + 2) * z_dim1];
+                        z__[j + k * z_dim1] -= sum * t1;
+                        z__[j + (k + 1) * z_dim1] -= sum * t2;
+                        z__[j + (k + 2) * z_dim1] -= sum * t3;
+                    }
+                }
+            } else if (nr == 2) {
+                i__3 = i2;
+                for (j = k; j <= i__3; ++j) {
+                    sum = h__[k + j * h_dim1] + v2 * h__[k + 1 + j * h_dim1];
+                    h__[k + j * h_dim1] -= sum * t1;
+                    h__[k + 1 + j * h_dim1] -= sum * t2;
+                }
+                i__3 = i__;
+                for (j = i1; j <= i__3; ++j) {
+                    sum = h__[j + k * h_dim1] + v2 * h__[j + (k + 1) * h_dim1];
+                    h__[j + k * h_dim1] -= sum * t1;
+                    h__[j + (k + 1) * h_dim1] -= sum * t2;
+                }
+                if (*wantz) {
+                    i__3 = *ihiz;
+                    for (j = *iloz; j <= i__3; ++j) {
+                        sum = z__[j + k * z_dim1] + v2 * z__[j + (k + 1) * z_dim1];
+                        z__[j + k * z_dim1] -= sum * t1;
+                        z__[j + (k + 1) * z_dim1] -= sum * t2;
+                    }
+                }
+            }
+        }
+    }
+    *info = i__;
+    return 0;
+L150:
+    if (l == i__) {
+        wr[i__] = h__[i__ + i__ * h_dim1];
+        wi[i__] = 0.;
+    } else if (l == i__ - 1) {
+        dlanv2_(&h__[i__ - 1 + (i__ - 1) * h_dim1], &h__[i__ - 1 + i__ * h_dim1],
+                &h__[i__ + (i__ - 1) * h_dim1], &h__[i__ + i__ * h_dim1], &wr[i__ - 1],
+                &wi[i__ - 1], &wr[i__], &wi[i__], &cs, &sn);
+        if (*wantt) {
+            if (i2 > i__) {
+                i__1 = i2 - i__;
+                drot_(&i__1, &h__[i__ - 1 + (i__ + 1) * h_dim1], ldh,
+                      &h__[i__ + (i__ + 1) * h_dim1], ldh, &cs, &sn);
+            }
+            i__1 = i__ - i1 - 1;
+            drot_(&i__1, &h__[i1 + (i__ - 1) * h_dim1], &c__1, &h__[i1 + i__ * h_dim1], &c__1, &cs,
+                  &sn);
+        }
+        if (*wantz) {
+            drot_(&nz, &z__[*iloz + (i__ - 1) * z_dim1], &c__1, &z__[*iloz + i__ * z_dim1], &c__1,
+                  &cs, &sn);
+        }
+    }
+    i__ = l - 1;
+    goto L20;
+L160:
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlahr2.cpp

@@ -0,0 +1,121 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b4 = -1.;
+static doublereal c_b5 = 1.;
+static integer c__1 = 1;
+static doublereal c_b38 = 0.;
+int dlahr2_(integer *n, integer *k, integer *nb, doublereal *a, integer *lda, doublereal *tau,
+            doublereal *t, integer *ldt, doublereal *y, integer *ldy)
+{
+    integer a_dim1, a_offset, t_dim1, t_offset, y_dim1, y_offset, i__1, i__2, i__3;
+    doublereal d__1;
+    integer i__;
+    doublereal ei;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *),
+        dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
+               ftnlen),
+        dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *,
+               integer *, doublereal *, doublereal *, integer *, ftnlen),
+        dcopy_(integer *, doublereal *, integer *, doublereal *, integer *),
+        dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen, ftnlen),
+        daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *),
+        dtrmv_(char *, char *, char *, integer *, doublereal *, integer *, doublereal *, integer *,
+               ftnlen, ftnlen, ftnlen),
+        dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    --tau;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    y_dim1 = *ldy;
+    y_offset = 1 + y_dim1;
+    y -= y_offset;
+    if (*n <= 1) {
+        return 0;
+    }
+    i__1 = *nb;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        if (i__ > 1) {
+            i__2 = *n - *k;
+            i__3 = i__ - 1;
+            dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy,
+                   &a[*k + i__ - 1 + a_dim1], lda, &c_b5, &a[*k + 1 + i__ * a_dim1], &c__1,
+                   (ftnlen)12);
+            i__2 = i__ - 1;
+            dcopy_(&i__2, &a[*k + 1 + i__ * a_dim1], &c__1, &t[*nb * t_dim1 + 1], &c__1);
+            i__2 = i__ - 1;
+            dtrmv_((char *)"Lower", (char *)"Transpose", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda,
+                   &t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)9, (ftnlen)4);
+            i__2 = *n - *k - i__ + 1;
+            i__3 = i__ - 1;
+            dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda,
+                   &a[*k + i__ + i__ * a_dim1], &c__1, &c_b5, &t[*nb * t_dim1 + 1], &c__1,
+                   (ftnlen)9);
+            i__2 = i__ - 1;
+            dtrmv_((char *)"Upper", (char *)"Transpose", (char *)"NON-UNIT", &i__2, &t[t_offset], ldt, &t[*nb * t_dim1 + 1],
+                   &c__1, (ftnlen)5, (ftnlen)9, (ftnlen)8);
+            i__2 = *n - *k - i__ + 1;
+            i__3 = i__ - 1;
+            dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &a[*k + i__ + a_dim1], lda,
+                   &t[*nb * t_dim1 + 1], &c__1, &c_b5, &a[*k + i__ + i__ * a_dim1], &c__1,
+                   (ftnlen)12);
+            i__2 = i__ - 1;
+            dtrmv_((char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", &i__2, &a[*k + 1 + a_dim1], lda,
+                   &t[*nb * t_dim1 + 1], &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)4);
+            i__2 = i__ - 1;
+            daxpy_(&i__2, &c_b4, &t[*nb * t_dim1 + 1], &c__1, &a[*k + 1 + i__ * a_dim1], &c__1);
+            a[*k + i__ - 1 + (i__ - 1) * a_dim1] = ei;
+        }
+        i__2 = *n - *k - i__ + 1;
+        i__3 = *k + i__ + 1;
+        dlarfg_(&i__2, &a[*k + i__ + i__ * a_dim1], &a[min(i__3, *n) + i__ * a_dim1], &c__1,
+                &tau[i__]);
+        ei = a[*k + i__ + i__ * a_dim1];
+        a[*k + i__ + i__ * a_dim1] = 1.;
+        i__2 = *n - *k;
+        i__3 = *n - *k - i__ + 1;
+        dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b5, &a[*k + 1 + (i__ + 1) * a_dim1], lda,
+               &a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &y[*k + 1 + i__ * y_dim1], &c__1,
+               (ftnlen)12);
+        i__2 = *n - *k - i__ + 1;
+        i__3 = i__ - 1;
+        dgemv_((char *)"Transpose", &i__2, &i__3, &c_b5, &a[*k + i__ + a_dim1], lda,
+               &a[*k + i__ + i__ * a_dim1], &c__1, &c_b38, &t[i__ * t_dim1 + 1], &c__1, (ftnlen)9);
+        i__2 = *n - *k;
+        i__3 = i__ - 1;
+        dgemv_((char *)"NO TRANSPOSE", &i__2, &i__3, &c_b4, &y[*k + 1 + y_dim1], ldy, &t[i__ * t_dim1 + 1],
+               &c__1, &c_b5, &y[*k + 1 + i__ * y_dim1], &c__1, (ftnlen)12);
+        i__2 = *n - *k;
+        dscal_(&i__2, &tau[i__], &y[*k + 1 + i__ * y_dim1], &c__1);
+        i__2 = i__ - 1;
+        d__1 = -tau[i__];
+        dscal_(&i__2, &d__1, &t[i__ * t_dim1 + 1], &c__1);
+        i__2 = i__ - 1;
+        dtrmv_((char *)"Upper", (char *)"No Transpose", (char *)"NON-UNIT", &i__2, &t[t_offset], ldt, &t[i__ * t_dim1 + 1],
+               &c__1, (ftnlen)5, (ftnlen)12, (ftnlen)8);
+        t[i__ + i__ * t_dim1] = tau[i__];
+    }
+    a[*k + *nb + *nb * a_dim1] = ei;
+    dlacpy_((char *)"ALL", k, nb, &a[(a_dim1 << 1) + 1], lda, &y[y_offset], ldy, (ftnlen)3);
+    dtrmm_((char *)"RIGHT", (char *)"Lower", (char *)"NO TRANSPOSE", (char *)"UNIT", k, nb, &c_b5, &a[*k + 1 + a_dim1], lda,
+           &y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)4);
+    if (*n > *k + *nb) {
+        i__1 = *n - *k - *nb;
+        dgemm_((char *)"NO TRANSPOSE", (char *)"NO TRANSPOSE", k, nb, &i__1, &c_b5, &a[(*nb + 2) * a_dim1 + 1], lda,
+               &a[*k + 1 + *nb + a_dim1], lda, &c_b5, &y[y_offset], ldy, (ftnlen)12, (ftnlen)12);
+    }
+    dtrmm_((char *)"RIGHT", (char *)"Upper", (char *)"NO TRANSPOSE", (char *)"NON-UNIT", k, nb, &c_b5, &t[t_offset], ldt,
+           &y[y_offset], ldy, (ftnlen)5, (ftnlen)5, (ftnlen)12, (ftnlen)8);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaln2.cpp

@@ -0,0 +1,298 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dlaln2_(logical *ltrans, integer *na, integer *nw, doublereal *smin, doublereal *ca,
+            doublereal *a, integer *lda, doublereal *d1, doublereal *d2, doublereal *b,
+            integer *ldb, doublereal *wr, doublereal *wi, doublereal *x, integer *ldx,
+            doublereal *scale, doublereal *xnorm, integer *info)
+{
+    static logical zswap[4] = {FALSE_, FALSE_, TRUE_, TRUE_};
+    static logical rswap[4] = {FALSE_, TRUE_, FALSE_, TRUE_};
+    static integer ipivot[16] = {1, 2, 3, 4, 2, 1, 4, 3, 3, 4, 1, 2, 4, 3, 2, 1};
+    integer a_dim1, a_offset, b_dim1, b_offset, x_dim1, x_offset;
+    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
+    static doublereal equiv_0[4], equiv_1[4];
+    integer j;
+#define ci (equiv_0)
+#define cr (equiv_1)
+    doublereal bi1, bi2, br1, br2, xi1, xi2, xr1, xr2, ci21, ci22, cr21, cr22, li21, csi, ui11,
+        lr21, ui12, ui22;
+#define civ (equiv_0)
+    doublereal csr, ur11, ur12, ur22;
+#define crv (equiv_1)
+    doublereal bbnd, cmax, ui11r, ui12s, temp, ur11r, ur12s, u22abs;
+    integer icmax;
+    doublereal bnorm, cnorm, smini;
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dladiv_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *);
+    doublereal bignum, smlnum;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    x_dim1 = *ldx;
+    x_offset = 1 + x_dim1;
+    x -= x_offset;
+    smlnum = 2. * dlamch_((char *)"Safe minimum", (ftnlen)12);
+    bignum = 1. / smlnum;
+    smini = max(*smin, smlnum);
+    *info = 0;
+    *scale = 1.;
+    if (*na == 1) {
+        if (*nw == 1) {
+            csr = *ca * a[a_dim1 + 1] - *wr * *d1;
+            cnorm = abs(csr);
+            if (cnorm < smini) {
+                csr = smini;
+                cnorm = smini;
+                *info = 1;
+            }
+            bnorm = (d__1 = b[b_dim1 + 1], abs(d__1));
+            if (cnorm < 1. && bnorm > 1.) {
+                if (bnorm > bignum * cnorm) {
+                    *scale = 1. / bnorm;
+                }
+            }
+            x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / csr;
+            *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1));
+        } else {
+            csr = *ca * a[a_dim1 + 1] - *wr * *d1;
+            csi = -(*wi) * *d1;
+            cnorm = abs(csr) + abs(csi);
+            if (cnorm < smini) {
+                csr = smini;
+                csi = 0.;
+                cnorm = smini;
+                *info = 1;
+            }
+            bnorm = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 << 1) + 1], abs(d__2));
+            if (cnorm < 1. && bnorm > 1.) {
+                if (bnorm > bignum * cnorm) {
+                    *scale = 1. / bnorm;
+                }
+            }
+            d__1 = *scale * b[b_dim1 + 1];
+            d__2 = *scale * b[(b_dim1 << 1) + 1];
+            dladiv_(&d__1, &d__2, &csr, &csi, &x[x_dim1 + 1], &x[(x_dim1 << 1) + 1]);
+            *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 1) + 1], abs(d__2));
+        }
+    } else {
+        cr[0] = *ca * a[a_dim1 + 1] - *wr * *d1;
+        cr[3] = *ca * a[(a_dim1 << 1) + 2] - *wr * *d2;
+        if (*ltrans) {
+            cr[2] = *ca * a[a_dim1 + 2];
+            cr[1] = *ca * a[(a_dim1 << 1) + 1];
+        } else {
+            cr[1] = *ca * a[a_dim1 + 2];
+            cr[2] = *ca * a[(a_dim1 << 1) + 1];
+        }
+        if (*nw == 1) {
+            cmax = 0.;
+            icmax = 0;
+            for (j = 1; j <= 4; ++j) {
+                if ((d__1 = crv[j - 1], abs(d__1)) > cmax) {
+                    cmax = (d__1 = crv[j - 1], abs(d__1));
+                    icmax = j;
+                }
+            }
+            if (cmax < smini) {
+                d__3 = (d__1 = b[b_dim1 + 1], abs(d__1)), d__4 = (d__2 = b[b_dim1 + 2], abs(d__2));
+                bnorm = max(d__3, d__4);
+                if (smini < 1. && bnorm > 1.) {
+                    if (bnorm > bignum * smini) {
+                        *scale = 1. / bnorm;
+                    }
+                }
+                temp = *scale / smini;
+                x[x_dim1 + 1] = temp * b[b_dim1 + 1];
+                x[x_dim1 + 2] = temp * b[b_dim1 + 2];
+                *xnorm = temp * bnorm;
+                *info = 1;
+                return 0;
+            }
+            ur11 = crv[icmax - 1];
+            cr21 = crv[ipivot[(icmax << 2) - 3] - 1];
+            ur12 = crv[ipivot[(icmax << 2) - 2] - 1];
+            cr22 = crv[ipivot[(icmax << 2) - 1] - 1];
+            ur11r = 1. / ur11;
+            lr21 = ur11r * cr21;
+            ur22 = cr22 - ur12 * lr21;
+            if (abs(ur22) < smini) {
+                ur22 = smini;
+                *info = 1;
+            }
+            if (rswap[icmax - 1]) {
+                br1 = b[b_dim1 + 2];
+                br2 = b[b_dim1 + 1];
+            } else {
+                br1 = b[b_dim1 + 1];
+                br2 = b[b_dim1 + 2];
+            }
+            br2 -= lr21 * br1;
+            d__2 = (d__1 = br1 * (ur22 * ur11r), abs(d__1)), d__3 = abs(br2);
+            bbnd = max(d__2, d__3);
+            if (bbnd > 1. && abs(ur22) < 1.) {
+                if (bbnd >= bignum * abs(ur22)) {
+                    *scale = 1. / bbnd;
+                }
+            }
+            xr2 = br2 * *scale / ur22;
+            xr1 = *scale * br1 * ur11r - xr2 * (ur11r * ur12);
+            if (zswap[icmax - 1]) {
+                x[x_dim1 + 1] = xr2;
+                x[x_dim1 + 2] = xr1;
+            } else {
+                x[x_dim1 + 1] = xr1;
+                x[x_dim1 + 2] = xr2;
+            }
+            d__1 = abs(xr1), d__2 = abs(xr2);
+            *xnorm = max(d__1, d__2);
+            if (*xnorm > 1. && cmax > 1.) {
+                if (*xnorm > bignum / cmax) {
+                    temp = cmax / bignum;
+                    x[x_dim1 + 1] = temp * x[x_dim1 + 1];
+                    x[x_dim1 + 2] = temp * x[x_dim1 + 2];
+                    *xnorm = temp * *xnorm;
+                    *scale = temp * *scale;
+                }
+            }
+        } else {
+            ci[0] = -(*wi) * *d1;
+            ci[1] = 0.;
+            ci[2] = 0.;
+            ci[3] = -(*wi) * *d2;
+            cmax = 0.;
+            icmax = 0;
+            for (j = 1; j <= 4; ++j) {
+                if ((d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1], abs(d__2)) > cmax) {
+                    cmax = (d__1 = crv[j - 1], abs(d__1)) + (d__2 = civ[j - 1], abs(d__2));
+                    icmax = j;
+                }
+            }
+            if (cmax < smini) {
+                d__5 = (d__1 = b[b_dim1 + 1], abs(d__1)) + (d__2 = b[(b_dim1 << 1) + 1], abs(d__2)),
+                d__6 = (d__3 = b[b_dim1 + 2], abs(d__3)) + (d__4 = b[(b_dim1 << 1) + 2], abs(d__4));
+                bnorm = max(d__5, d__6);
+                if (smini < 1. && bnorm > 1.) {
+                    if (bnorm > bignum * smini) {
+                        *scale = 1. / bnorm;
+                    }
+                }
+                temp = *scale / smini;
+                x[x_dim1 + 1] = temp * b[b_dim1 + 1];
+                x[x_dim1 + 2] = temp * b[b_dim1 + 2];
+                x[(x_dim1 << 1) + 1] = temp * b[(b_dim1 << 1) + 1];
+                x[(x_dim1 << 1) + 2] = temp * b[(b_dim1 << 1) + 2];
+                *xnorm = temp * bnorm;
+                *info = 1;
+                return 0;
+            }
+            ur11 = crv[icmax - 1];
+            ui11 = civ[icmax - 1];
+            cr21 = crv[ipivot[(icmax << 2) - 3] - 1];
+            ci21 = civ[ipivot[(icmax << 2) - 3] - 1];
+            ur12 = crv[ipivot[(icmax << 2) - 2] - 1];
+            ui12 = civ[ipivot[(icmax << 2) - 2] - 1];
+            cr22 = crv[ipivot[(icmax << 2) - 1] - 1];
+            ci22 = civ[ipivot[(icmax << 2) - 1] - 1];
+            if (icmax == 1 || icmax == 4) {
+                if (abs(ur11) > abs(ui11)) {
+                    temp = ui11 / ur11;
+                    d__1 = temp;
+                    ur11r = 1. / (ur11 * (d__1 * d__1 + 1.));
+                    ui11r = -temp * ur11r;
+                } else {
+                    temp = ur11 / ui11;
+                    d__1 = temp;
+                    ui11r = -1. / (ui11 * (d__1 * d__1 + 1.));
+                    ur11r = -temp * ui11r;
+                }
+                lr21 = cr21 * ur11r;
+                li21 = cr21 * ui11r;
+                ur12s = ur12 * ur11r;
+                ui12s = ur12 * ui11r;
+                ur22 = cr22 - ur12 * lr21;
+                ui22 = ci22 - ur12 * li21;
+            } else {
+                ur11r = 1. / ur11;
+                ui11r = 0.;
+                lr21 = cr21 * ur11r;
+                li21 = ci21 * ur11r;
+                ur12s = ur12 * ur11r;
+                ui12s = ui12 * ur11r;
+                ur22 = cr22 - ur12 * lr21 + ui12 * li21;
+                ui22 = -ur12 * li21 - ui12 * lr21;
+            }
+            u22abs = abs(ur22) + abs(ui22);
+            if (u22abs < smini) {
+                ur22 = smini;
+                ui22 = 0.;
+                *info = 1;
+            }
+            if (rswap[icmax - 1]) {
+                br2 = b[b_dim1 + 1];
+                br1 = b[b_dim1 + 2];
+                bi2 = b[(b_dim1 << 1) + 1];
+                bi1 = b[(b_dim1 << 1) + 2];
+            } else {
+                br1 = b[b_dim1 + 1];
+                br2 = b[b_dim1 + 2];
+                bi1 = b[(b_dim1 << 1) + 1];
+                bi2 = b[(b_dim1 << 1) + 2];
+            }
+            br2 = br2 - lr21 * br1 + li21 * bi1;
+            bi2 = bi2 - li21 * br1 - lr21 * bi1;
+            d__1 = (abs(br1) + abs(bi1)) * (u22abs * (abs(ur11r) + abs(ui11r))),
+            d__2 = abs(br2) + abs(bi2);
+            bbnd = max(d__1, d__2);
+            if (bbnd > 1. && u22abs < 1.) {
+                if (bbnd >= bignum * u22abs) {
+                    *scale = 1. / bbnd;
+                    br1 = *scale * br1;
+                    bi1 = *scale * bi1;
+                    br2 = *scale * br2;
+                    bi2 = *scale * bi2;
+                }
+            }
+            dladiv_(&br2, &bi2, &ur22, &ui22, &xr2, &xi2);
+            xr1 = ur11r * br1 - ui11r * bi1 - ur12s * xr2 + ui12s * xi2;
+            xi1 = ui11r * br1 + ur11r * bi1 - ui12s * xr2 - ur12s * xi2;
+            if (zswap[icmax - 1]) {
+                x[x_dim1 + 1] = xr2;
+                x[x_dim1 + 2] = xr1;
+                x[(x_dim1 << 1) + 1] = xi2;
+                x[(x_dim1 << 1) + 2] = xi1;
+            } else {
+                x[x_dim1 + 1] = xr1;
+                x[x_dim1 + 2] = xr2;
+                x[(x_dim1 << 1) + 1] = xi1;
+                x[(x_dim1 << 1) + 2] = xi2;
+            }
+            d__1 = abs(xr1) + abs(xi1), d__2 = abs(xr2) + abs(xi2);
+            *xnorm = max(d__1, d__2);
+            if (*xnorm > 1. && cmax > 1.) {
+                if (*xnorm > bignum / cmax) {
+                    temp = cmax / bignum;
+                    x[x_dim1 + 1] = temp * x[x_dim1 + 1];
+                    x[x_dim1 + 2] = temp * x[x_dim1 + 2];
+                    x[(x_dim1 << 1) + 1] = temp * x[(x_dim1 << 1) + 1];
+                    x[(x_dim1 << 1) + 2] = temp * x[(x_dim1 << 1) + 2];
+                    *xnorm = temp * *xnorm;
+                    *scale = temp * *scale;
+                }
+            }
+        }
+    }
+    return 0;
+}
+#undef crv
+#undef civ
+#undef cr
+#undef ci
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlanv2.cpp

@@ -0,0 +1,106 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b3 = 1.;
+int dlanv2_(doublereal *a, doublereal *b, doublereal *c__, doublereal *d__, doublereal *rt1r,
+            doublereal *rt1i, doublereal *rt2r, doublereal *rt2i, doublereal *cs, doublereal *sn)
+{
+    doublereal d__1, d__2;
+    double d_lmp_sign(doublereal *, doublereal *), sqrt(doublereal);
+    doublereal p, z__, aa, bb, cc, dd, cs1, sn1, sab, sac, eps, tau, temp, scale, bcmax, bcmis,
+        sigma;
+    extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *, ftnlen);
+    eps = dlamch_((char *)"P", (ftnlen)1);
+    if (*c__ == 0.) {
+        *cs = 1.;
+        *sn = 0.;
+    } else if (*b == 0.) {
+        *cs = 0.;
+        *sn = 1.;
+        temp = *d__;
+        *d__ = *a;
+        *a = temp;
+        *b = -(*c__);
+        *c__ = 0.;
+    } else if (*a - *d__ == 0. && d_lmp_sign(&c_b3, b) != d_lmp_sign(&c_b3, c__)) {
+        *cs = 1.;
+        *sn = 0.;
+    } else {
+        temp = *a - *d__;
+        p = temp * .5;
+        d__1 = abs(*b), d__2 = abs(*c__);
+        bcmax = max(d__1, d__2);
+        d__1 = abs(*b), d__2 = abs(*c__);
+        bcmis = min(d__1, d__2) * d_lmp_sign(&c_b3, b) * d_lmp_sign(&c_b3, c__);
+        d__1 = abs(p);
+        scale = max(d__1, bcmax);
+        z__ = p / scale * p + bcmax / scale * bcmis;
+        if (z__ >= eps * 4.) {
+            d__1 = sqrt(scale) * sqrt(z__);
+            z__ = p + d_lmp_sign(&d__1, &p);
+            *a = *d__ + z__;
+            *d__ -= bcmax / z__ * bcmis;
+            tau = dlapy2_(c__, &z__);
+            *cs = z__ / tau;
+            *sn = *c__ / tau;
+            *b -= *c__;
+            *c__ = 0.;
+        } else {
+            sigma = *b + *c__;
+            tau = dlapy2_(&sigma, &temp);
+            *cs = sqrt((abs(sigma) / tau + 1.) * .5);
+            *sn = -(p / (tau * *cs)) * d_lmp_sign(&c_b3, &sigma);
+            aa = *a * *cs + *b * *sn;
+            bb = -(*a) * *sn + *b * *cs;
+            cc = *c__ * *cs + *d__ * *sn;
+            dd = -(*c__) * *sn + *d__ * *cs;
+            *a = aa * *cs + cc * *sn;
+            *b = bb * *cs + dd * *sn;
+            *c__ = -aa * *sn + cc * *cs;
+            *d__ = -bb * *sn + dd * *cs;
+            temp = (*a + *d__) * .5;
+            *a = temp;
+            *d__ = temp;
+            if (*c__ != 0.) {
+                if (*b != 0.) {
+                    if (d_lmp_sign(&c_b3, b) == d_lmp_sign(&c_b3, c__)) {
+                        sab = sqrt((abs(*b)));
+                        sac = sqrt((abs(*c__)));
+                        d__1 = sab * sac;
+                        p = d_lmp_sign(&d__1, c__);
+                        tau = 1. / sqrt((d__1 = *b + *c__, abs(d__1)));
+                        *a = temp + p;
+                        *d__ = temp - p;
+                        *b -= *c__;
+                        *c__ = 0.;
+                        cs1 = sab * tau;
+                        sn1 = sac * tau;
+                        temp = *cs * cs1 - *sn * sn1;
+                        *sn = *cs * sn1 + *sn * cs1;
+                        *cs = temp;
+                    }
+                } else {
+                    *b = -(*c__);
+                    *c__ = 0.;
+                    temp = *cs;
+                    *cs = -(*sn);
+                    *sn = temp;
+                }
+            }
+        }
+    }
+    *rt1r = *a;
+    *rt2r = *d__;
+    if (*c__ == 0.) {
+        *rt1i = 0.;
+        *rt2i = 0.;
+    } else {
+        *rt1i = sqrt((abs(*b))) * sqrt((abs(*c__)));
+        *rt2i = -(*rt1i);
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr0.cpp

@@ -0,0 +1,306 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__13 = 13;
+static integer c__15 = 15;
+static integer c_n1 = -1;
+static integer c__12 = 12;
+static integer c__14 = 14;
+static integer c__16 = 16;
+static logical c_false = FALSE_;
+static integer c__1 = 1;
+static integer c__3 = 3;
+int dlaqr0_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__,
+            integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz,
+            doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info)
+{
+    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
+    doublereal d__1, d__2, d__3, d__4;
+    integer i__, k;
+    doublereal aa, bb, cc, dd;
+    integer ld;
+    doublereal cs;
+    integer nh, it, ks, kt;
+    doublereal sn;
+    integer ku, kv, ls, ns;
+    doublereal ss;
+    integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin;
+    doublereal swap;
+    integer ktop;
+    doublereal zdum[1];
+    integer kacc22, itmax, nsmax, nwmax, kwtop;
+    extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlaqr3_(logical *, logical *, integer *, integer *, integer *, integer *, doublereal *,
+                integer *, integer *, integer *, doublereal *, integer *, integer *, integer *,
+                doublereal *, doublereal *, doublereal *, integer *, integer *, doublereal *,
+                integer *, integer *, doublereal *, integer *, doublereal *, integer *),
+        dlaqr4_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
+                doublereal *, integer *, integer *),
+        dlaqr5_(logical *, logical *, integer *, integer *, integer *, integer *, integer *,
+                doublereal *, doublereal *, doublereal *, integer *, integer *, integer *,
+                doublereal *, integer *, doublereal *, integer *, doublereal *, integer *,
+                integer *, doublereal *, integer *, integer *, doublereal *, integer *);
+    integer nibble;
+    extern int dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *,
+                       integer *, doublereal *, doublereal *, integer *, integer *, doublereal *,
+                       integer *, integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    char jbcmpz[2];
+    integer nwupbd;
+    logical sorted;
+    integer lwkopt;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    --wr;
+    --wi;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    --work;
+    *info = 0;
+    if (*n == 0) {
+        work[1] = 1.;
+        return 0;
+    }
+    if (*n <= 11) {
+        lwkopt = 1;
+        if (*lwork != -1) {
+            dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz,
+                    &z__[z_offset], ldz, info);
+        }
+    } else {
+        *info = 0;
+        if (*wantt) {
+            *(unsigned char *)jbcmpz = 'S';
+        } else {
+            *(unsigned char *)jbcmpz = 'E';
+        }
+        if (*wantz) {
+            *(unsigned char *)&jbcmpz[1] = 'V';
+        } else {
+            *(unsigned char *)&jbcmpz[1] = 'N';
+        }
+        nwr = ilaenv_(&c__13, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nwr = max(2, nwr);
+        i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2);
+        nwr = min(i__1, nwr);
+        nsr = ilaenv_(&c__15, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo;
+        nsr = min(i__1, i__2);
+        i__1 = 2, i__2 = nsr - nsr % 2;
+        nsr = max(i__1, i__2);
+        i__1 = nwr + 1;
+        dlaqr3_(wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset],
+                ldz, &ls, &ld, &wr[1], &wi[1], &h__[h_offset], ldh, n, &h__[h_offset], ldh, n,
+                &h__[h_offset], ldh, &work[1], &c_n1);
+        i__1 = nsr * 3 / 2, i__2 = (integer)work[1];
+        lwkopt = max(i__1, i__2);
+        if (*lwork == -1) {
+            work[1] = (doublereal)lwkopt;
+            return 0;
+        }
+        nmin = ilaenv_(&c__12, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nmin = max(11, nmin);
+        nibble = ilaenv_(&c__14, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nibble = max(0, nibble);
+        kacc22 = ilaenv_(&c__16, (char *)"DLAQR0", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        kacc22 = max(0, kacc22);
+        kacc22 = min(2, kacc22);
+        i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
+        nwmax = min(i__1, i__2);
+        nw = nwmax;
+        i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
+        nsmax = min(i__1, i__2);
+        nsmax -= nsmax % 2;
+        ndfl = 1;
+        i__1 = 10, i__2 = *ihi - *ilo + 1;
+        itmax = max(i__1, i__2) * 30;
+        kbot = *ihi;
+        i__1 = itmax;
+        for (it = 1; it <= i__1; ++it) {
+            if (kbot < *ilo) {
+                goto L90;
+            }
+            i__2 = *ilo + 1;
+            for (k = kbot; k >= i__2; --k) {
+                if (h__[k + (k - 1) * h_dim1] == 0.) {
+                    goto L20;
+                }
+            }
+            k = *ilo;
+        L20:
+            ktop = k;
+            nh = kbot - ktop + 1;
+            nwupbd = min(nh, nwmax);
+            if (ndfl < 5) {
+                nw = min(nwupbd, nwr);
+            } else {
+                i__2 = nwupbd, i__3 = nw << 1;
+                nw = min(i__2, i__3);
+            }
+            if (nw < nwmax) {
+                if (nw >= nh - 1) {
+                    nw = nh;
+                } else {
+                    kwtop = kbot - nw + 1;
+                    if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) >
+                        (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], abs(d__2))) {
+                        ++nw;
+                    }
+                }
+            }
+            if (ndfl < 5) {
+                ndec = -1;
+            } else if (ndec >= 0 || nw >= nwupbd) {
+                ++ndec;
+                if (nw - ndec < 2) {
+                    ndec = 0;
+                }
+                nw -= ndec;
+            }
+            kv = *n - nw + 1;
+            kt = nw + 1;
+            nho = *n - nw - 1 - kt + 1;
+            kwv = nw + 2;
+            nve = *n - nw - kwv + 1;
+            dlaqr3_(wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, iloz, ihiz,
+                    &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[kv + h_dim1], ldh, &nho,
+                    &h__[kv + kt * h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork);
+            kbot -= ld;
+            ks = kbot - ls + 1;
+            if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(nmin, nwmax)) {
+                i__4 = 2, i__5 = kbot - ktop;
+                i__2 = min(nsmax, nsr), i__3 = max(i__4, i__5);
+                ns = min(i__2, i__3);
+                ns -= ns % 2;
+                if (ndfl % 6 == 0) {
+                    ks = kbot - ns + 1;
+                    i__3 = ks + 1, i__4 = ktop + 2;
+                    i__2 = max(i__3, i__4);
+                    for (i__ = kbot; i__ >= i__2; i__ += -2) {
+                        ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) +
+                             (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
+                        aa = ss * .75 + h__[i__ + i__ * h_dim1];
+                        bb = ss;
+                        cc = ss * -.4375;
+                        dd = aa;
+                        dlanv2_(&aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__],
+                                &cs, &sn);
+                    }
+                    if (ks == ktop) {
+                        wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1];
+                        wi[ks + 1] = 0.;
+                        wr[ks] = wr[ks + 1];
+                        wi[ks] = wi[ks + 1];
+                    }
+                } else {
+                    if (kbot - ks + 1 <= ns / 2) {
+                        ks = kbot - ns + 1;
+                        kt = *n - ns + 1;
+                        dlacpy_((char *)"A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &h__[kt + h_dim1], ldh,
+                                (ftnlen)1);
+                        if (ns > nmin) {
+                            dlaqr4_(&c_false, &c_false, &ns, &c__1, &ns, &h__[kt + h_dim1], ldh,
+                                    &wr[ks], &wi[ks], &c__1, &c__1, zdum, &c__1, &work[1], lwork,
+                                    &inf);
+                        } else {
+                            dlahqr_(&c_false, &c_false, &ns, &c__1, &ns, &h__[kt + h_dim1], ldh,
+                                    &wr[ks], &wi[ks], &c__1, &c__1, zdum, &c__1, &inf);
+                        }
+                        ks += inf;
+                        if (ks >= kbot) {
+                            aa = h__[kbot - 1 + (kbot - 1) * h_dim1];
+                            cc = h__[kbot + (kbot - 1) * h_dim1];
+                            bb = h__[kbot - 1 + kbot * h_dim1];
+                            dd = h__[kbot + kbot * h_dim1];
+                            dlanv2_(&aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[kbot - 1], &wr[kbot],
+                                    &wi[kbot], &cs, &sn);
+                            ks = kbot - 1;
+                        }
+                    }
+                    if (kbot - ks + 1 > ns) {
+                        sorted = FALSE_;
+                        i__2 = ks + 1;
+                        for (k = kbot; k >= i__2; --k) {
+                            if (sorted) {
+                                goto L60;
+                            }
+                            sorted = TRUE_;
+                            i__3 = k - 1;
+                            for (i__ = ks; i__ <= i__3; ++i__) {
+                                if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[i__], abs(d__2)) <
+                                    (d__3 = wr[i__ + 1], abs(d__3)) +
+                                        (d__4 = wi[i__ + 1], abs(d__4))) {
+                                    sorted = FALSE_;
+                                    swap = wr[i__];
+                                    wr[i__] = wr[i__ + 1];
+                                    wr[i__ + 1] = swap;
+                                    swap = wi[i__];
+                                    wi[i__] = wi[i__ + 1];
+                                    wi[i__ + 1] = swap;
+                                }
+                            }
+                        }
+                    L60:;
+                    }
+                    i__2 = ks + 2;
+                    for (i__ = kbot; i__ >= i__2; i__ += -2) {
+                        if (wi[i__] != -wi[i__ - 1]) {
+                            swap = wr[i__];
+                            wr[i__] = wr[i__ - 1];
+                            wr[i__ - 1] = wr[i__ - 2];
+                            wr[i__ - 2] = swap;
+                            swap = wi[i__];
+                            wi[i__] = wi[i__ - 1];
+                            wi[i__ - 1] = wi[i__ - 2];
+                            wi[i__ - 2] = swap;
+                        }
+                    }
+                }
+                if (kbot - ks + 1 == 2) {
+                    if (wi[kbot] == 0.) {
+                        if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs(d__1)) <
+                            (d__2 = wr[kbot - 1] - h__[kbot + kbot * h_dim1], abs(d__2))) {
+                            wr[kbot - 1] = wr[kbot];
+                        } else {
+                            wr[kbot] = wr[kbot - 1];
+                        }
+                    }
+                }
+                i__2 = ns, i__3 = kbot - ks + 1;
+                ns = min(i__2, i__3);
+                ns -= ns % 2;
+                ks = kbot - ns + 1;
+                kdu = ns * 3 - 3;
+                ku = *n - kdu + 1;
+                kwh = kdu + 1;
+                nho = *n - kdu - 3 - (kdu + 1) + 1;
+                kwv = kdu + 4;
+                nve = *n - kdu - kwv + 1;
+                dlaqr5_(wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], &wi[ks],
+                        &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &work[1], &c__3,
+                        &h__[ku + h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &nho,
+                        &h__[ku + kwh * h_dim1], ldh);
+            }
+            if (ld > 0) {
+                ndfl = 1;
+            } else {
+                ++ndfl;
+            }
+        }
+        *info = kbot;
+    L90:;
+    }
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr1.cpp

@@ -0,0 +1,52 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dlaqr1_(integer *n, doublereal *h__, integer *ldh, doublereal *sr1, doublereal *si1,
+            doublereal *sr2, doublereal *si2, doublereal *v)
+{
+    integer h_dim1, h_offset;
+    doublereal d__1, d__2, d__3;
+    doublereal s, h21s, h31s;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    --v;
+    if (*n != 2 && *n != 3) {
+        return 0;
+    }
+    if (*n == 2) {
+        s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) +
+            (d__2 = h__[h_dim1 + 2], abs(d__2));
+        if (s == 0.) {
+            v[1] = 0.;
+            v[2] = 0.;
+        } else {
+            h21s = h__[h_dim1 + 2] / s;
+            v[1] = h21s * h__[(h_dim1 << 1) + 1] +
+                   (h__[h_dim1 + 1] - *sr1) * ((h__[h_dim1 + 1] - *sr2) / s) - *si1 * (*si2 / s);
+            v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - *sr2);
+        }
+    } else {
+        s = (d__1 = h__[h_dim1 + 1] - *sr2, abs(d__1)) + abs(*si2) +
+            (d__2 = h__[h_dim1 + 2], abs(d__2)) + (d__3 = h__[h_dim1 + 3], abs(d__3));
+        if (s == 0.) {
+            v[1] = 0.;
+            v[2] = 0.;
+            v[3] = 0.;
+        } else {
+            h21s = h__[h_dim1 + 2] / s;
+            h31s = h__[h_dim1 + 3] / s;
+            v[1] = (h__[h_dim1 + 1] - *sr1) * ((h__[h_dim1 + 1] - *sr2) / s) - *si1 * (*si2 / s) +
+                   h__[(h_dim1 << 1) + 1] * h21s + h__[h_dim1 * 3 + 1] * h31s;
+            v[2] = h21s * (h__[h_dim1 + 1] + h__[(h_dim1 << 1) + 2] - *sr1 - *sr2) +
+                   h__[h_dim1 * 3 + 2] * h31s;
+            v[3] = h31s * (h__[h_dim1 + 1] + h__[h_dim1 * 3 + 3] - *sr1 - *sr2) +
+                   h21s * h__[(h_dim1 << 1) + 3];
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr2.cpp

@@ -0,0 +1,359 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static doublereal c_b12 = 0.;
+static doublereal c_b13 = 1.;
+static logical c_true = TRUE_;
+int dlaqr2_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *kbot, integer *nw,
+            doublereal *h__, integer *ldh, integer *iloz, integer *ihiz, doublereal *z__,
+            integer *ldz, integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *v,
+            integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *nv, doublereal *wv,
+            integer *ldwv, doublereal *work, integer *lwork)
+{
+    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1,
+        z_offset, i__1, i__2, i__3, i__4;
+    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
+    double sqrt(doublereal);
+    integer i__, j, k;
+    doublereal s, aa, bb, cc, dd, cs, sn;
+    integer jw;
+    doublereal evi, evk, foo;
+    integer kln;
+    doublereal tau, ulp;
+    integer lwk1, lwk2;
+    doublereal beta;
+    integer kend, kcol, info, ifst, ilst, ltop, krow;
+    extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, ftnlen),
+        dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
+               ftnlen);
+    logical bulge;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer infqr, kwtop;
+    extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlabad_(doublereal *, doublereal *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       doublereal *, integer *, integer *),
+        dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
+                integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    doublereal safmin;
+    extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, ftnlen);
+    doublereal safmax;
+    extern int dtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *,
+                       integer *, integer *, doublereal *, integer *, ftnlen),
+        dormhr_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, ftnlen,
+                ftnlen);
+    logical sorted;
+    doublereal smlnum;
+    integer lwkopt;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    --sr;
+    --si;
+    v_dim1 = *ldv;
+    v_offset = 1 + v_dim1;
+    v -= v_offset;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    wv_dim1 = *ldwv;
+    wv_offset = 1 + wv_dim1;
+    wv -= wv_offset;
+    --work;
+    i__1 = *nw, i__2 = *kbot - *ktop + 1;
+    jw = min(i__1, i__2);
+    if (jw <= 2) {
+        lwkopt = 1;
+    } else {
+        i__1 = jw - 1;
+        dgehrd_(&jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &c_n1, &info);
+        lwk1 = (integer)work[1];
+        i__1 = jw - 1;
+        dormhr_((char *)"R", (char *)"N", &jw, &jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &v[v_offset], ldv,
+                &work[1], &c_n1, &info, (ftnlen)1, (ftnlen)1);
+        lwk2 = (integer)work[1];
+        lwkopt = jw + max(lwk1, lwk2);
+    }
+    if (*lwork == -1) {
+        work[1] = (doublereal)lwkopt;
+        return 0;
+    }
+    *ns = 0;
+    *nd = 0;
+    work[1] = 1.;
+    if (*ktop > *kbot) {
+        return 0;
+    }
+    if (*nw < 1) {
+        return 0;
+    }
+    safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
+    safmax = 1. / safmin;
+    dlabad_(&safmin, &safmax);
+    ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
+    smlnum = safmin * ((doublereal)(*n) / ulp);
+    i__1 = *nw, i__2 = *kbot - *ktop + 1;
+    jw = min(i__1, i__2);
+    kwtop = *kbot - jw + 1;
+    if (kwtop == *ktop) {
+        s = 0.;
+    } else {
+        s = h__[kwtop + (kwtop - 1) * h_dim1];
+    }
+    if (*kbot == kwtop) {
+        sr[kwtop] = h__[kwtop + kwtop * h_dim1];
+        si[kwtop] = 0.;
+        *ns = 1;
+        *nd = 0;
+        d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs(d__1));
+        if (abs(s) <= max(d__2, d__3)) {
+            *ns = 0;
+            *nd = 1;
+            if (kwtop > *ktop) {
+                h__[kwtop + (kwtop - 1) * h_dim1] = 0.;
+            }
+        }
+        work[1] = 1.;
+        return 0;
+    }
+    dlacpy_((char *)"U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], ldt, (ftnlen)1);
+    i__1 = jw - 1;
+    i__2 = *ldh + 1;
+    i__3 = *ldt + 1;
+    dcopy_(&i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &i__3);
+    dlaset_((char *)"A", &jw, &jw, &c_b12, &c_b13, &v[v_offset], ldv, (ftnlen)1);
+    dlahqr_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[kwtop], &si[kwtop], &c__1,
+            &jw, &v[v_offset], ldv, &infqr);
+    i__1 = jw - 3;
+    for (j = 1; j <= i__1; ++j) {
+        t[j + 2 + j * t_dim1] = 0.;
+        t[j + 3 + j * t_dim1] = 0.;
+    }
+    if (jw > 2) {
+        t[jw + (jw - 2) * t_dim1] = 0.;
+    }
+    *ns = jw;
+    ilst = infqr + 1;
+L20:
+    if (ilst <= *ns) {
+        if (*ns == 1) {
+            bulge = FALSE_;
+        } else {
+            bulge = t[*ns + (*ns - 1) * t_dim1] != 0.;
+        }
+        if (!bulge) {
+            foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1));
+            if (foo == 0.) {
+                foo = abs(s);
+            }
+            d__2 = smlnum, d__3 = ulp * foo;
+            if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2, d__3)) {
+                --(*ns);
+            } else {
+                ifst = *ns;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                ++ilst;
+            }
+        } else {
+            foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) +
+                  sqrt((d__1 = t[*ns + (*ns - 1) * t_dim1], abs(d__1))) *
+                      sqrt((d__2 = t[*ns - 1 + *ns * t_dim1], abs(d__2)));
+            if (foo == 0.) {
+                foo = abs(s);
+            }
+            d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)),
+            d__4 = (d__2 = s * v[(*ns - 1) * v_dim1 + 1], abs(d__2));
+            d__5 = smlnum, d__6 = ulp * foo;
+            if (max(d__3, d__4) <= max(d__5, d__6)) {
+                *ns += -2;
+            } else {
+                ifst = *ns;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                ilst += 2;
+            }
+        }
+        goto L20;
+    }
+    if (*ns == 0) {
+        s = 0.;
+    }
+    if (*ns < jw) {
+        sorted = FALSE_;
+        i__ = *ns + 1;
+    L30:
+        if (sorted) {
+            goto L50;
+        }
+        sorted = TRUE_;
+        kend = i__ - 1;
+        i__ = infqr + 1;
+        if (i__ == *ns) {
+            k = i__ + 1;
+        } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
+            k = i__ + 1;
+        } else {
+            k = i__ + 2;
+        }
+    L40:
+        if (k <= kend) {
+            if (k == i__ + 1) {
+                evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1));
+            } else {
+                evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) +
+                      sqrt((d__1 = t[i__ + 1 + i__ * t_dim1], abs(d__1))) *
+                          sqrt((d__2 = t[i__ + (i__ + 1) * t_dim1], abs(d__2)));
+            }
+            if (k == kend) {
+                evk = (d__1 = t[k + k * t_dim1], abs(d__1));
+            } else if (t[k + 1 + k * t_dim1] == 0.) {
+                evk = (d__1 = t[k + k * t_dim1], abs(d__1));
+            } else {
+                evk = (d__3 = t[k + k * t_dim1], abs(d__3)) +
+                      sqrt((d__1 = t[k + 1 + k * t_dim1], abs(d__1))) *
+                          sqrt((d__2 = t[k + (k + 1) * t_dim1], abs(d__2)));
+            }
+            if (evi >= evk) {
+                i__ = k;
+            } else {
+                sorted = FALSE_;
+                ifst = i__;
+                ilst = k;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                if (info == 0) {
+                    i__ = ilst;
+                } else {
+                    i__ = k;
+                }
+            }
+            if (i__ == kend) {
+                k = i__ + 1;
+            } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
+                k = i__ + 1;
+            } else {
+                k = i__ + 2;
+            }
+            goto L40;
+        }
+        goto L30;
+    L50:;
+    }
+    i__ = jw;
+L60:
+    if (i__ >= infqr + 1) {
+        if (i__ == infqr + 1) {
+            sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
+            si[kwtop + i__ - 1] = 0.;
+            --i__;
+        } else if (t[i__ + (i__ - 1) * t_dim1] == 0.) {
+            sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
+            si[kwtop + i__ - 1] = 0.;
+            --i__;
+        } else {
+            aa = t[i__ - 1 + (i__ - 1) * t_dim1];
+            cc = t[i__ + (i__ - 1) * t_dim1];
+            bb = t[i__ - 1 + i__ * t_dim1];
+            dd = t[i__ + i__ * t_dim1];
+            dlanv2_(&aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ - 2],
+                    &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, &sn);
+            i__ += -2;
+        }
+        goto L60;
+    }
+    if (*ns < jw || s == 0.) {
+        if (*ns > 1 && s != 0.) {
+            dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1);
+            beta = work[1];
+            dlarfg_(ns, &beta, &work[2], &c__1, &tau);
+            work[1] = 1.;
+            i__1 = jw - 2;
+            i__2 = jw - 2;
+            dlaset_((char *)"L", &i__1, &i__2, &c_b12, &c_b12, &t[t_dim1 + 3], ldt, (ftnlen)1);
+            dlarf_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
+                   (ftnlen)1);
+            dlarf_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], (ftnlen)1);
+            dlarf_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1],
+                   (ftnlen)1);
+            i__1 = *lwork - jw;
+            dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info);
+        }
+        if (kwtop > 1) {
+            h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1];
+        }
+        dlacpy_((char *)"U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh, (ftnlen)1);
+        i__1 = jw - 1;
+        i__2 = *ldt + 1;
+        i__3 = *ldh + 1;
+        dcopy_(&i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], &i__3);
+        if (*ns > 1 && s != 0.) {
+            i__1 = *lwork - jw;
+            dormhr_((char *)"R", (char *)"N", &jw, ns, &c__1, ns, &t[t_offset], ldt, &work[1], &v[v_offset], ldv,
+                    &work[jw + 1], &i__1, &info, (ftnlen)1, (ftnlen)1);
+        }
+        if (*wantt) {
+            ltop = 1;
+        } else {
+            ltop = *ktop;
+        }
+        i__1 = kwtop - 1;
+        i__2 = *nv;
+        for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) {
+            i__3 = *nv, i__4 = kwtop - krow;
+            kln = min(i__3, i__4);
+            dgemm_((char *)"N", (char *)"N", &kln, &jw, &jw, &c_b13, &h__[krow + kwtop * h_dim1], ldh, &v[v_offset],
+                   ldv, &c_b12, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
+            dlacpy_((char *)"A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * h_dim1], ldh,
+                    (ftnlen)1);
+        }
+        if (*wantt) {
+            i__2 = *n;
+            i__1 = *nh;
+            for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; kcol += i__1) {
+                i__3 = *nh, i__4 = *n - kcol + 1;
+                kln = min(i__3, i__4);
+                dgemm_((char *)"C", (char *)"N", &jw, &kln, &jw, &c_b13, &v[v_offset], ldv,
+                       &h__[kwtop + kcol * h_dim1], ldh, &c_b12, &t[t_offset], ldt, (ftnlen)1,
+                       (ftnlen)1);
+                dlacpy_((char *)"A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol * h_dim1], ldh,
+                        (ftnlen)1);
+            }
+        }
+        if (*wantz) {
+            i__1 = *ihiz;
+            i__2 = *nv;
+            for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) {
+                i__3 = *nv, i__4 = *ihiz - krow + 1;
+                kln = min(i__3, i__4);
+                dgemm_((char *)"N", (char *)"N", &kln, &jw, &jw, &c_b13, &z__[krow + kwtop * z_dim1], ldz,
+                       &v[v_offset], ldv, &c_b12, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + kwtop * z_dim1], ldz,
+                        (ftnlen)1);
+            }
+        }
+    }
+    *nd = jw - *ns;
+    *ns -= infqr;
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr3.cpp

@@ -0,0 +1,375 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static logical c_true = TRUE_;
+static doublereal c_b17 = 0.;
+static doublereal c_b18 = 1.;
+static integer c__12 = 12;
+int dlaqr3_(logical *wantt, logical *wantz, integer *n, integer *ktop, integer *kbot, integer *nw,
+            doublereal *h__, integer *ldh, integer *iloz, integer *ihiz, doublereal *z__,
+            integer *ldz, integer *ns, integer *nd, doublereal *sr, doublereal *si, doublereal *v,
+            integer *ldv, integer *nh, doublereal *t, integer *ldt, integer *nv, doublereal *wv,
+            integer *ldwv, doublereal *work, integer *lwork)
+{
+    integer h_dim1, h_offset, t_dim1, t_offset, v_dim1, v_offset, wv_dim1, wv_offset, z_dim1,
+        z_offset, i__1, i__2, i__3, i__4;
+    doublereal d__1, d__2, d__3, d__4, d__5, d__6;
+    double sqrt(doublereal);
+    integer i__, j, k;
+    doublereal s, aa, bb, cc, dd, cs, sn;
+    integer jw;
+    doublereal evi, evk, foo;
+    integer kln;
+    doublereal tau, ulp;
+    integer lwk1, lwk2, lwk3;
+    doublereal beta;
+    integer kend, kcol, info, nmin, ifst, ilst, ltop, krow;
+    extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, ftnlen),
+        dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
+               ftnlen);
+    logical bulge;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer infqr, kwtop;
+    extern int dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, doublereal *, doublereal *),
+        dlaqr4_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
+                doublereal *, integer *, integer *),
+        dlabad_(doublereal *, doublereal *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dgehrd_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       doublereal *, integer *, integer *),
+        dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, integer *, doublereal *, integer *,
+                integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    doublereal safmin;
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    doublereal safmax;
+    extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, ftnlen),
+        dtrexc_(char *, integer *, doublereal *, integer *, doublereal *, integer *, integer *,
+                integer *, doublereal *, integer *, ftnlen),
+        dormhr_(char *, char *, integer *, integer *, integer *, integer *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, doublereal *, integer *, integer *, ftnlen,
+                ftnlen);
+    logical sorted;
+    doublereal smlnum;
+    integer lwkopt;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    --sr;
+    --si;
+    v_dim1 = *ldv;
+    v_offset = 1 + v_dim1;
+    v -= v_offset;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    wv_dim1 = *ldwv;
+    wv_offset = 1 + wv_dim1;
+    wv -= wv_offset;
+    --work;
+    i__1 = *nw, i__2 = *kbot - *ktop + 1;
+    jw = min(i__1, i__2);
+    if (jw <= 2) {
+        lwkopt = 1;
+    } else {
+        i__1 = jw - 1;
+        dgehrd_(&jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &work[1], &c_n1, &info);
+        lwk1 = (integer)work[1];
+        i__1 = jw - 1;
+        dormhr_((char *)"R", (char *)"N", &jw, &jw, &c__1, &i__1, &t[t_offset], ldt, &work[1], &v[v_offset], ldv,
+                &work[1], &c_n1, &info, (ftnlen)1, (ftnlen)1);
+        lwk2 = (integer)work[1];
+        dlaqr4_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[1], &si[1], &c__1, &jw,
+                &v[v_offset], ldv, &work[1], &c_n1, &infqr);
+        lwk3 = (integer)work[1];
+        i__1 = jw + max(lwk1, lwk2);
+        lwkopt = max(i__1, lwk3);
+    }
+    if (*lwork == -1) {
+        work[1] = (doublereal)lwkopt;
+        return 0;
+    }
+    *ns = 0;
+    *nd = 0;
+    work[1] = 1.;
+    if (*ktop > *kbot) {
+        return 0;
+    }
+    if (*nw < 1) {
+        return 0;
+    }
+    safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
+    safmax = 1. / safmin;
+    dlabad_(&safmin, &safmax);
+    ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
+    smlnum = safmin * ((doublereal)(*n) / ulp);
+    i__1 = *nw, i__2 = *kbot - *ktop + 1;
+    jw = min(i__1, i__2);
+    kwtop = *kbot - jw + 1;
+    if (kwtop == *ktop) {
+        s = 0.;
+    } else {
+        s = h__[kwtop + (kwtop - 1) * h_dim1];
+    }
+    if (*kbot == kwtop) {
+        sr[kwtop] = h__[kwtop + kwtop * h_dim1];
+        si[kwtop] = 0.;
+        *ns = 1;
+        *nd = 0;
+        d__2 = smlnum, d__3 = ulp * (d__1 = h__[kwtop + kwtop * h_dim1], abs(d__1));
+        if (abs(s) <= max(d__2, d__3)) {
+            *ns = 0;
+            *nd = 1;
+            if (kwtop > *ktop) {
+                h__[kwtop + (kwtop - 1) * h_dim1] = 0.;
+            }
+        }
+        work[1] = 1.;
+        return 0;
+    }
+    dlacpy_((char *)"U", &jw, &jw, &h__[kwtop + kwtop * h_dim1], ldh, &t[t_offset], ldt, (ftnlen)1);
+    i__1 = jw - 1;
+    i__2 = *ldh + 1;
+    i__3 = *ldt + 1;
+    dcopy_(&i__1, &h__[kwtop + 1 + kwtop * h_dim1], &i__2, &t[t_dim1 + 2], &i__3);
+    dlaset_((char *)"A", &jw, &jw, &c_b17, &c_b18, &v[v_offset], ldv, (ftnlen)1);
+    nmin = ilaenv_(&c__12, (char *)"DLAQR3", (char *)"SV", &jw, &c__1, &jw, lwork, (ftnlen)6, (ftnlen)2);
+    if (jw > nmin) {
+        dlaqr4_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[kwtop], &si[kwtop], &c__1,
+                &jw, &v[v_offset], ldv, &work[1], lwork, &infqr);
+    } else {
+        dlahqr_(&c_true, &c_true, &jw, &c__1, &jw, &t[t_offset], ldt, &sr[kwtop], &si[kwtop], &c__1,
+                &jw, &v[v_offset], ldv, &infqr);
+    }
+    i__1 = jw - 3;
+    for (j = 1; j <= i__1; ++j) {
+        t[j + 2 + j * t_dim1] = 0.;
+        t[j + 3 + j * t_dim1] = 0.;
+    }
+    if (jw > 2) {
+        t[jw + (jw - 2) * t_dim1] = 0.;
+    }
+    *ns = jw;
+    ilst = infqr + 1;
+L20:
+    if (ilst <= *ns) {
+        if (*ns == 1) {
+            bulge = FALSE_;
+        } else {
+            bulge = t[*ns + (*ns - 1) * t_dim1] != 0.;
+        }
+        if (!bulge) {
+            foo = (d__1 = t[*ns + *ns * t_dim1], abs(d__1));
+            if (foo == 0.) {
+                foo = abs(s);
+            }
+            d__2 = smlnum, d__3 = ulp * foo;
+            if ((d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)) <= max(d__2, d__3)) {
+                --(*ns);
+            } else {
+                ifst = *ns;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                ++ilst;
+            }
+        } else {
+            foo = (d__3 = t[*ns + *ns * t_dim1], abs(d__3)) +
+                  sqrt((d__1 = t[*ns + (*ns - 1) * t_dim1], abs(d__1))) *
+                      sqrt((d__2 = t[*ns - 1 + *ns * t_dim1], abs(d__2)));
+            if (foo == 0.) {
+                foo = abs(s);
+            }
+            d__3 = (d__1 = s * v[*ns * v_dim1 + 1], abs(d__1)),
+            d__4 = (d__2 = s * v[(*ns - 1) * v_dim1 + 1], abs(d__2));
+            d__5 = smlnum, d__6 = ulp * foo;
+            if (max(d__3, d__4) <= max(d__5, d__6)) {
+                *ns += -2;
+            } else {
+                ifst = *ns;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                ilst += 2;
+            }
+        }
+        goto L20;
+    }
+    if (*ns == 0) {
+        s = 0.;
+    }
+    if (*ns < jw) {
+        sorted = FALSE_;
+        i__ = *ns + 1;
+    L30:
+        if (sorted) {
+            goto L50;
+        }
+        sorted = TRUE_;
+        kend = i__ - 1;
+        i__ = infqr + 1;
+        if (i__ == *ns) {
+            k = i__ + 1;
+        } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
+            k = i__ + 1;
+        } else {
+            k = i__ + 2;
+        }
+    L40:
+        if (k <= kend) {
+            if (k == i__ + 1) {
+                evi = (d__1 = t[i__ + i__ * t_dim1], abs(d__1));
+            } else {
+                evi = (d__3 = t[i__ + i__ * t_dim1], abs(d__3)) +
+                      sqrt((d__1 = t[i__ + 1 + i__ * t_dim1], abs(d__1))) *
+                          sqrt((d__2 = t[i__ + (i__ + 1) * t_dim1], abs(d__2)));
+            }
+            if (k == kend) {
+                evk = (d__1 = t[k + k * t_dim1], abs(d__1));
+            } else if (t[k + 1 + k * t_dim1] == 0.) {
+                evk = (d__1 = t[k + k * t_dim1], abs(d__1));
+            } else {
+                evk = (d__3 = t[k + k * t_dim1], abs(d__3)) +
+                      sqrt((d__1 = t[k + 1 + k * t_dim1], abs(d__1))) *
+                          sqrt((d__2 = t[k + (k + 1) * t_dim1], abs(d__2)));
+            }
+            if (evi >= evk) {
+                i__ = k;
+            } else {
+                sorted = FALSE_;
+                ifst = i__;
+                ilst = k;
+                dtrexc_((char *)"V", &jw, &t[t_offset], ldt, &v[v_offset], ldv, &ifst, &ilst, &work[1],
+                        &info, (ftnlen)1);
+                if (info == 0) {
+                    i__ = ilst;
+                } else {
+                    i__ = k;
+                }
+            }
+            if (i__ == kend) {
+                k = i__ + 1;
+            } else if (t[i__ + 1 + i__ * t_dim1] == 0.) {
+                k = i__ + 1;
+            } else {
+                k = i__ + 2;
+            }
+            goto L40;
+        }
+        goto L30;
+    L50:;
+    }
+    i__ = jw;
+L60:
+    if (i__ >= infqr + 1) {
+        if (i__ == infqr + 1) {
+            sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
+            si[kwtop + i__ - 1] = 0.;
+            --i__;
+        } else if (t[i__ + (i__ - 1) * t_dim1] == 0.) {
+            sr[kwtop + i__ - 1] = t[i__ + i__ * t_dim1];
+            si[kwtop + i__ - 1] = 0.;
+            --i__;
+        } else {
+            aa = t[i__ - 1 + (i__ - 1) * t_dim1];
+            cc = t[i__ + (i__ - 1) * t_dim1];
+            bb = t[i__ - 1 + i__ * t_dim1];
+            dd = t[i__ + i__ * t_dim1];
+            dlanv2_(&aa, &bb, &cc, &dd, &sr[kwtop + i__ - 2], &si[kwtop + i__ - 2],
+                    &sr[kwtop + i__ - 1], &si[kwtop + i__ - 1], &cs, &sn);
+            i__ += -2;
+        }
+        goto L60;
+    }
+    if (*ns < jw || s == 0.) {
+        if (*ns > 1 && s != 0.) {
+            dcopy_(ns, &v[v_offset], ldv, &work[1], &c__1);
+            beta = work[1];
+            dlarfg_(ns, &beta, &work[2], &c__1, &tau);
+            work[1] = 1.;
+            i__1 = jw - 2;
+            i__2 = jw - 2;
+            dlaset_((char *)"L", &i__1, &i__2, &c_b17, &c_b17, &t[t_dim1 + 3], ldt, (ftnlen)1);
+            dlarf_((char *)"L", ns, &jw, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1],
+                   (ftnlen)1);
+            dlarf_((char *)"R", ns, ns, &work[1], &c__1, &tau, &t[t_offset], ldt, &work[jw + 1], (ftnlen)1);
+            dlarf_((char *)"R", &jw, ns, &work[1], &c__1, &tau, &v[v_offset], ldv, &work[jw + 1],
+                   (ftnlen)1);
+            i__1 = *lwork - jw;
+            dgehrd_(&jw, &c__1, ns, &t[t_offset], ldt, &work[1], &work[jw + 1], &i__1, &info);
+        }
+        if (kwtop > 1) {
+            h__[kwtop + (kwtop - 1) * h_dim1] = s * v[v_dim1 + 1];
+        }
+        dlacpy_((char *)"U", &jw, &jw, &t[t_offset], ldt, &h__[kwtop + kwtop * h_dim1], ldh, (ftnlen)1);
+        i__1 = jw - 1;
+        i__2 = *ldt + 1;
+        i__3 = *ldh + 1;
+        dcopy_(&i__1, &t[t_dim1 + 2], &i__2, &h__[kwtop + 1 + kwtop * h_dim1], &i__3);
+        if (*ns > 1 && s != 0.) {
+            i__1 = *lwork - jw;
+            dormhr_((char *)"R", (char *)"N", &jw, ns, &c__1, ns, &t[t_offset], ldt, &work[1], &v[v_offset], ldv,
+                    &work[jw + 1], &i__1, &info, (ftnlen)1, (ftnlen)1);
+        }
+        if (*wantt) {
+            ltop = 1;
+        } else {
+            ltop = *ktop;
+        }
+        i__1 = kwtop - 1;
+        i__2 = *nv;
+        for (krow = ltop; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) {
+            i__3 = *nv, i__4 = kwtop - krow;
+            kln = min(i__3, i__4);
+            dgemm_((char *)"N", (char *)"N", &kln, &jw, &jw, &c_b18, &h__[krow + kwtop * h_dim1], ldh, &v[v_offset],
+                   ldv, &c_b17, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
+            dlacpy_((char *)"A", &kln, &jw, &wv[wv_offset], ldwv, &h__[krow + kwtop * h_dim1], ldh,
+                    (ftnlen)1);
+        }
+        if (*wantt) {
+            i__2 = *n;
+            i__1 = *nh;
+            for (kcol = *kbot + 1; i__1 < 0 ? kcol >= i__2 : kcol <= i__2; kcol += i__1) {
+                i__3 = *nh, i__4 = *n - kcol + 1;
+                kln = min(i__3, i__4);
+                dgemm_((char *)"C", (char *)"N", &jw, &kln, &jw, &c_b18, &v[v_offset], ldv,
+                       &h__[kwtop + kcol * h_dim1], ldh, &c_b17, &t[t_offset], ldt, (ftnlen)1,
+                       (ftnlen)1);
+                dlacpy_((char *)"A", &jw, &kln, &t[t_offset], ldt, &h__[kwtop + kcol * h_dim1], ldh,
+                        (ftnlen)1);
+            }
+        }
+        if (*wantz) {
+            i__1 = *ihiz;
+            i__2 = *nv;
+            for (krow = *iloz; i__2 < 0 ? krow >= i__1 : krow <= i__1; krow += i__2) {
+                i__3 = *nv, i__4 = *ihiz - krow + 1;
+                kln = min(i__3, i__4);
+                dgemm_((char *)"N", (char *)"N", &kln, &jw, &jw, &c_b18, &z__[krow + kwtop * z_dim1], ldz,
+                       &v[v_offset], ldv, &c_b17, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
+                dlacpy_((char *)"A", &kln, &jw, &wv[wv_offset], ldwv, &z__[krow + kwtop * z_dim1], ldz,
+                        (ftnlen)1);
+            }
+        }
+    }
+    *nd = jw - *ns;
+    *ns -= infqr;
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr4.cpp

@@ -0,0 +1,298 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__13 = 13;
+static integer c__15 = 15;
+static integer c_n1 = -1;
+static integer c__12 = 12;
+static integer c__14 = 14;
+static integer c__16 = 16;
+static logical c_false = FALSE_;
+static integer c__1 = 1;
+static integer c__3 = 3;
+int dlaqr4_(logical *wantt, logical *wantz, integer *n, integer *ilo, integer *ihi, doublereal *h__,
+            integer *ldh, doublereal *wr, doublereal *wi, integer *iloz, integer *ihiz,
+            doublereal *z__, integer *ldz, doublereal *work, integer *lwork, integer *info)
+{
+    integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5;
+    doublereal d__1, d__2, d__3, d__4;
+    integer i__, k;
+    doublereal aa, bb, cc, dd;
+    integer ld;
+    doublereal cs;
+    integer nh, it, ks, kt;
+    doublereal sn;
+    integer ku, kv, ls, ns;
+    doublereal ss;
+    integer nw, inf, kdu, nho, nve, kwh, nsr, nwr, kwv, ndec, ndfl, kbot, nmin;
+    doublereal swap;
+    integer ktop;
+    doublereal zdum[1];
+    integer kacc22, itmax, nsmax, nwmax, kwtop;
+    extern int dlaqr2_(logical *, logical *, integer *, integer *, integer *, integer *,
+                       doublereal *, integer *, integer *, integer *, doublereal *, integer *,
+                       integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                       integer *, doublereal *, integer *, integer *, doublereal *, integer *,
+                       doublereal *, integer *),
+        dlanv2_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *,
+                doublereal *, doublereal *, doublereal *, doublereal *),
+        dlaqr5_(logical *, logical *, integer *, integer *, integer *, integer *, integer *,
+                doublereal *, doublereal *, doublereal *, integer *, integer *, integer *,
+                doublereal *, integer *, doublereal *, integer *, doublereal *, integer *,
+                integer *, doublereal *, integer *, integer *, doublereal *, integer *);
+    integer nibble;
+    extern int dlahqr_(logical *, logical *, integer *, integer *, integer *, doublereal *,
+                       integer *, doublereal *, doublereal *, integer *, integer *, doublereal *,
+                       integer *, integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    char jbcmpz[2];
+    integer nwupbd;
+    logical sorted;
+    integer lwkopt;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    --wr;
+    --wi;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    --work;
+    *info = 0;
+    if (*n == 0) {
+        work[1] = 1.;
+        return 0;
+    }
+    if (*n <= 11) {
+        lwkopt = 1;
+        if (*lwork != -1) {
+            dlahqr_(wantt, wantz, n, ilo, ihi, &h__[h_offset], ldh, &wr[1], &wi[1], iloz, ihiz,
+                    &z__[z_offset], ldz, info);
+        }
+    } else {
+        *info = 0;
+        if (*wantt) {
+            *(unsigned char *)jbcmpz = 'S';
+        } else {
+            *(unsigned char *)jbcmpz = 'E';
+        }
+        if (*wantz) {
+            *(unsigned char *)&jbcmpz[1] = 'V';
+        } else {
+            *(unsigned char *)&jbcmpz[1] = 'N';
+        }
+        nwr = ilaenv_(&c__13, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nwr = max(2, nwr);
+        i__1 = *ihi - *ilo + 1, i__2 = (*n - 1) / 3, i__1 = min(i__1, i__2);
+        nwr = min(i__1, nwr);
+        nsr = ilaenv_(&c__15, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        i__1 = nsr, i__2 = (*n + 6) / 9, i__1 = min(i__1, i__2), i__2 = *ihi - *ilo;
+        nsr = min(i__1, i__2);
+        i__1 = 2, i__2 = nsr - nsr % 2;
+        nsr = max(i__1, i__2);
+        i__1 = nwr + 1;
+        dlaqr2_(wantt, wantz, n, ilo, ihi, &i__1, &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset],
+                ldz, &ls, &ld, &wr[1], &wi[1], &h__[h_offset], ldh, n, &h__[h_offset], ldh, n,
+                &h__[h_offset], ldh, &work[1], &c_n1);
+        i__1 = nsr * 3 / 2, i__2 = (integer)work[1];
+        lwkopt = max(i__1, i__2);
+        if (*lwork == -1) {
+            work[1] = (doublereal)lwkopt;
+            return 0;
+        }
+        nmin = ilaenv_(&c__12, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nmin = max(11, nmin);
+        nibble = ilaenv_(&c__14, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        nibble = max(0, nibble);
+        kacc22 = ilaenv_(&c__16, (char *)"DLAQR4", jbcmpz, n, ilo, ihi, lwork, (ftnlen)6, (ftnlen)2);
+        kacc22 = max(0, kacc22);
+        kacc22 = min(2, kacc22);
+        i__1 = (*n - 1) / 3, i__2 = *lwork / 2;
+        nwmax = min(i__1, i__2);
+        nw = nwmax;
+        i__1 = (*n + 6) / 9, i__2 = (*lwork << 1) / 3;
+        nsmax = min(i__1, i__2);
+        nsmax -= nsmax % 2;
+        ndfl = 1;
+        i__1 = 10, i__2 = *ihi - *ilo + 1;
+        itmax = max(i__1, i__2) * 30;
+        kbot = *ihi;
+        i__1 = itmax;
+        for (it = 1; it <= i__1; ++it) {
+            if (kbot < *ilo) {
+                goto L90;
+            }
+            i__2 = *ilo + 1;
+            for (k = kbot; k >= i__2; --k) {
+                if (h__[k + (k - 1) * h_dim1] == 0.) {
+                    goto L20;
+                }
+            }
+            k = *ilo;
+        L20:
+            ktop = k;
+            nh = kbot - ktop + 1;
+            nwupbd = min(nh, nwmax);
+            if (ndfl < 5) {
+                nw = min(nwupbd, nwr);
+            } else {
+                i__2 = nwupbd, i__3 = nw << 1;
+                nw = min(i__2, i__3);
+            }
+            if (nw < nwmax) {
+                if (nw >= nh - 1) {
+                    nw = nh;
+                } else {
+                    kwtop = kbot - nw + 1;
+                    if ((d__1 = h__[kwtop + (kwtop - 1) * h_dim1], abs(d__1)) >
+                        (d__2 = h__[kwtop - 1 + (kwtop - 2) * h_dim1], abs(d__2))) {
+                        ++nw;
+                    }
+                }
+            }
+            if (ndfl < 5) {
+                ndec = -1;
+            } else if (ndec >= 0 || nw >= nwupbd) {
+                ++ndec;
+                if (nw - ndec < 2) {
+                    ndec = 0;
+                }
+                nw -= ndec;
+            }
+            kv = *n - nw + 1;
+            kt = nw + 1;
+            nho = *n - nw - 1 - kt + 1;
+            kwv = nw + 2;
+            nve = *n - nw - kwv + 1;
+            dlaqr2_(wantt, wantz, n, &ktop, &kbot, &nw, &h__[h_offset], ldh, iloz, ihiz,
+                    &z__[z_offset], ldz, &ls, &ld, &wr[1], &wi[1], &h__[kv + h_dim1], ldh, &nho,
+                    &h__[kv + kt * h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &work[1], lwork);
+            kbot -= ld;
+            ks = kbot - ls + 1;
+            if (ld == 0 || ld * 100 <= nw * nibble && kbot - ktop + 1 > min(nmin, nwmax)) {
+                i__4 = 2, i__5 = kbot - ktop;
+                i__2 = min(nsmax, nsr), i__3 = max(i__4, i__5);
+                ns = min(i__2, i__3);
+                ns -= ns % 2;
+                if (ndfl % 6 == 0) {
+                    ks = kbot - ns + 1;
+                    i__3 = ks + 1, i__4 = ktop + 2;
+                    i__2 = max(i__3, i__4);
+                    for (i__ = kbot; i__ >= i__2; i__ += -2) {
+                        ss = (d__1 = h__[i__ + (i__ - 1) * h_dim1], abs(d__1)) +
+                             (d__2 = h__[i__ - 1 + (i__ - 2) * h_dim1], abs(d__2));
+                        aa = ss * .75 + h__[i__ + i__ * h_dim1];
+                        bb = ss;
+                        cc = ss * -.4375;
+                        dd = aa;
+                        dlanv2_(&aa, &bb, &cc, &dd, &wr[i__ - 1], &wi[i__ - 1], &wr[i__], &wi[i__],
+                                &cs, &sn);
+                    }
+                    if (ks == ktop) {
+                        wr[ks + 1] = h__[ks + 1 + (ks + 1) * h_dim1];
+                        wi[ks + 1] = 0.;
+                        wr[ks] = wr[ks + 1];
+                        wi[ks] = wi[ks + 1];
+                    }
+                } else {
+                    if (kbot - ks + 1 <= ns / 2) {
+                        ks = kbot - ns + 1;
+                        kt = *n - ns + 1;
+                        dlacpy_((char *)"A", &ns, &ns, &h__[ks + ks * h_dim1], ldh, &h__[kt + h_dim1], ldh,
+                                (ftnlen)1);
+                        dlahqr_(&c_false, &c_false, &ns, &c__1, &ns, &h__[kt + h_dim1], ldh,
+                                &wr[ks], &wi[ks], &c__1, &c__1, zdum, &c__1, &inf);
+                        ks += inf;
+                        if (ks >= kbot) {
+                            aa = h__[kbot - 1 + (kbot - 1) * h_dim1];
+                            cc = h__[kbot + (kbot - 1) * h_dim1];
+                            bb = h__[kbot - 1 + kbot * h_dim1];
+                            dd = h__[kbot + kbot * h_dim1];
+                            dlanv2_(&aa, &bb, &cc, &dd, &wr[kbot - 1], &wi[kbot - 1], &wr[kbot],
+                                    &wi[kbot], &cs, &sn);
+                            ks = kbot - 1;
+                        }
+                    }
+                    if (kbot - ks + 1 > ns) {
+                        sorted = FALSE_;
+                        i__2 = ks + 1;
+                        for (k = kbot; k >= i__2; --k) {
+                            if (sorted) {
+                                goto L60;
+                            }
+                            sorted = TRUE_;
+                            i__3 = k - 1;
+                            for (i__ = ks; i__ <= i__3; ++i__) {
+                                if ((d__1 = wr[i__], abs(d__1)) + (d__2 = wi[i__], abs(d__2)) <
+                                    (d__3 = wr[i__ + 1], abs(d__3)) +
+                                        (d__4 = wi[i__ + 1], abs(d__4))) {
+                                    sorted = FALSE_;
+                                    swap = wr[i__];
+                                    wr[i__] = wr[i__ + 1];
+                                    wr[i__ + 1] = swap;
+                                    swap = wi[i__];
+                                    wi[i__] = wi[i__ + 1];
+                                    wi[i__ + 1] = swap;
+                                }
+                            }
+                        }
+                    L60:;
+                    }
+                    i__2 = ks + 2;
+                    for (i__ = kbot; i__ >= i__2; i__ += -2) {
+                        if (wi[i__] != -wi[i__ - 1]) {
+                            swap = wr[i__];
+                            wr[i__] = wr[i__ - 1];
+                            wr[i__ - 1] = wr[i__ - 2];
+                            wr[i__ - 2] = swap;
+                            swap = wi[i__];
+                            wi[i__] = wi[i__ - 1];
+                            wi[i__ - 1] = wi[i__ - 2];
+                            wi[i__ - 2] = swap;
+                        }
+                    }
+                }
+                if (kbot - ks + 1 == 2) {
+                    if (wi[kbot] == 0.) {
+                        if ((d__1 = wr[kbot] - h__[kbot + kbot * h_dim1], abs(d__1)) <
+                            (d__2 = wr[kbot - 1] - h__[kbot + kbot * h_dim1], abs(d__2))) {
+                            wr[kbot - 1] = wr[kbot];
+                        } else {
+                            wr[kbot] = wr[kbot - 1];
+                        }
+                    }
+                }
+                i__2 = ns, i__3 = kbot - ks + 1;
+                ns = min(i__2, i__3);
+                ns -= ns % 2;
+                ks = kbot - ns + 1;
+                kdu = ns * 3 - 3;
+                ku = *n - kdu + 1;
+                kwh = kdu + 1;
+                nho = *n - kdu - 3 - (kdu + 1) + 1;
+                kwv = kdu + 4;
+                nve = *n - kdu - kwv + 1;
+                dlaqr5_(wantt, wantz, &kacc22, n, &ktop, &kbot, &ns, &wr[ks], &wi[ks],
+                        &h__[h_offset], ldh, iloz, ihiz, &z__[z_offset], ldz, &work[1], &c__3,
+                        &h__[ku + h_dim1], ldh, &nve, &h__[kwv + h_dim1], ldh, &nho,
+                        &h__[ku + kwh * h_dim1], ldh);
+            }
+            if (ld > 0) {
+                ndfl = 1;
+            } else {
+                ++ndfl;
+            }
+        }
+        *info = kbot;
+    L90:;
+    }
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlaqr5.cpp

@@ -0,0 +1,521 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b7 = 0.;
+static doublereal c_b8 = 1.;
+static integer c__3 = 3;
+static integer c__1 = 1;
+static integer c__2 = 2;
+int dlaqr5_(logical *wantt, logical *wantz, integer *kacc22, integer *n, integer *ktop,
+            integer *kbot, integer *nshfts, doublereal *sr, doublereal *si, doublereal *h__,
+            integer *ldh, integer *iloz, integer *ihiz, doublereal *z__, integer *ldz,
+            doublereal *v, integer *ldv, doublereal *u, integer *ldu, integer *nv, doublereal *wv,
+            integer *ldwv, integer *nh, doublereal *wh, integer *ldwh)
+{
+    integer h_dim1, h_offset, u_dim1, u_offset, v_dim1, v_offset, wh_dim1, wh_offset, wv_dim1,
+        wv_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
+    doublereal d__1, d__2, d__3, d__4, d__5;
+    integer i__, j, k, m, i2, j2, i4, j4, k1;
+    doublereal h11, h12, h21, h22;
+    integer m22, ns, nu;
+    doublereal vt[3], scl;
+    integer kdu, kms;
+    doublereal ulp;
+    integer knz, kzs;
+    doublereal tst1, tst2, beta;
+    logical blk22, bmp22;
+    integer mend, jcol, jlen, jbot, mbot;
+    doublereal swap;
+    integer jtop, jrow, mtop;
+    doublereal alpha;
+    logical accum;
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    integer ndcol, incol, krcol, nbmps;
+    extern int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen,
+                      ftnlen),
+        dlaqr1_(integer *, doublereal *, integer *, doublereal *, doublereal *, doublereal *,
+                doublereal *, doublereal *),
+        dlabad_(doublereal *, doublereal *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern int dlarfg_(integer *, doublereal *, doublereal *, integer *, doublereal *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen);
+    doublereal safmin;
+    extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, ftnlen);
+    doublereal safmax, refsum;
+    integer mstart;
+    doublereal smlnum;
+    --sr;
+    --si;
+    h_dim1 = *ldh;
+    h_offset = 1 + h_dim1;
+    h__ -= h_offset;
+    z_dim1 = *ldz;
+    z_offset = 1 + z_dim1;
+    z__ -= z_offset;
+    v_dim1 = *ldv;
+    v_offset = 1 + v_dim1;
+    v -= v_offset;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    wv_dim1 = *ldwv;
+    wv_offset = 1 + wv_dim1;
+    wv -= wv_offset;
+    wh_dim1 = *ldwh;
+    wh_offset = 1 + wh_dim1;
+    wh -= wh_offset;
+    if (*nshfts < 2) {
+        return 0;
+    }
+    if (*ktop >= *kbot) {
+        return 0;
+    }
+    i__1 = *nshfts - 2;
+    for (i__ = 1; i__ <= i__1; i__ += 2) {
+        if (si[i__] != -si[i__ + 1]) {
+            swap = sr[i__];
+            sr[i__] = sr[i__ + 1];
+            sr[i__ + 1] = sr[i__ + 2];
+            sr[i__ + 2] = swap;
+            swap = si[i__];
+            si[i__] = si[i__ + 1];
+            si[i__ + 1] = si[i__ + 2];
+            si[i__ + 2] = swap;
+        }
+    }
+    ns = *nshfts - *nshfts % 2;
+    safmin = dlamch_((char *)"SAFE MINIMUM", (ftnlen)12);
+    safmax = 1. / safmin;
+    dlabad_(&safmin, &safmax);
+    ulp = dlamch_((char *)"PRECISION", (ftnlen)9);
+    smlnum = safmin * ((doublereal)(*n) / ulp);
+    accum = *kacc22 == 1 || *kacc22 == 2;
+    blk22 = ns > 2 && *kacc22 == 2;
+    if (*ktop + 2 <= *kbot) {
+        h__[*ktop + 2 + *ktop * h_dim1] = 0.;
+    }
+    nbmps = ns / 2;
+    kdu = nbmps * 6 - 3;
+    i__1 = *kbot - 2;
+    i__2 = nbmps * 3 - 2;
+    for (incol = (1 - nbmps) * 3 + *ktop - 1; i__2 < 0 ? incol >= i__1 : incol <= i__1;
+         incol += i__2) {
+        ndcol = incol + kdu;
+        if (accum) {
+            dlaset_((char *)"ALL", &kdu, &kdu, &c_b7, &c_b8, &u[u_offset], ldu, (ftnlen)3);
+        }
+        i__4 = incol + nbmps * 3 - 3, i__5 = *kbot - 2;
+        i__3 = min(i__4, i__5);
+        for (krcol = incol; krcol <= i__3; ++krcol) {
+            i__4 = 1, i__5 = (*ktop - 1 - krcol + 2) / 3 + 1;
+            mtop = max(i__4, i__5);
+            i__4 = nbmps, i__5 = (*kbot - krcol) / 3;
+            mbot = min(i__4, i__5);
+            m22 = mbot + 1;
+            bmp22 = mbot < nbmps && krcol + (m22 - 1) * 3 == *kbot - 2;
+            i__4 = mbot;
+            for (m = mtop; m <= i__4; ++m) {
+                k = krcol + (m - 1) * 3;
+                if (k == *ktop - 1) {
+                    dlaqr1_(&c__3, &h__[*ktop + *ktop * h_dim1], ldh, &sr[(m << 1) - 1],
+                            &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], &v[m * v_dim1 + 1]);
+                    alpha = v[m * v_dim1 + 1];
+                    dlarfg_(&c__3, &alpha, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]);
+                } else {
+                    beta = h__[k + 1 + k * h_dim1];
+                    v[m * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
+                    v[m * v_dim1 + 3] = h__[k + 3 + k * h_dim1];
+                    dlarfg_(&c__3, &beta, &v[m * v_dim1 + 2], &c__1, &v[m * v_dim1 + 1]);
+                    if (h__[k + 3 + k * h_dim1] != 0. || h__[k + 3 + (k + 1) * h_dim1] != 0. ||
+                        h__[k + 3 + (k + 2) * h_dim1] == 0.) {
+                        h__[k + 1 + k * h_dim1] = beta;
+                        h__[k + 2 + k * h_dim1] = 0.;
+                        h__[k + 3 + k * h_dim1] = 0.;
+                    } else {
+                        dlaqr1_(&c__3, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[(m << 1) - 1],
+                                &si[(m << 1) - 1], &sr[m * 2], &si[m * 2], vt);
+                        alpha = vt[0];
+                        dlarfg_(&c__3, &alpha, &vt[1], &c__1, vt);
+                        refsum =
+                            vt[0] * (h__[k + 1 + k * h_dim1] + vt[1] * h__[k + 2 + k * h_dim1]);
+                        if ((d__1 = h__[k + 2 + k * h_dim1] - refsum * vt[1], abs(d__1)) +
+                                (d__2 = refsum * vt[2], abs(d__2)) >
+                            ulp * ((d__3 = h__[k + k * h_dim1], abs(d__3)) +
+                                   (d__4 = h__[k + 1 + (k + 1) * h_dim1], abs(d__4)) +
+                                   (d__5 = h__[k + 2 + (k + 2) * h_dim1], abs(d__5)))) {
+                            h__[k + 1 + k * h_dim1] = beta;
+                            h__[k + 2 + k * h_dim1] = 0.;
+                            h__[k + 3 + k * h_dim1] = 0.;
+                        } else {
+                            h__[k + 1 + k * h_dim1] -= refsum;
+                            h__[k + 2 + k * h_dim1] = 0.;
+                            h__[k + 3 + k * h_dim1] = 0.;
+                            v[m * v_dim1 + 1] = vt[0];
+                            v[m * v_dim1 + 2] = vt[1];
+                            v[m * v_dim1 + 3] = vt[2];
+                        }
+                    }
+                }
+            }
+            k = krcol + (m22 - 1) * 3;
+            if (bmp22) {
+                if (k == *ktop - 1) {
+                    dlaqr1_(&c__2, &h__[k + 1 + (k + 1) * h_dim1], ldh, &sr[(m22 << 1) - 1],
+                            &si[(m22 << 1) - 1], &sr[m22 * 2], &si[m22 * 2], &v[m22 * v_dim1 + 1]);
+                    beta = v[m22 * v_dim1 + 1];
+                    dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
+                } else {
+                    beta = h__[k + 1 + k * h_dim1];
+                    v[m22 * v_dim1 + 2] = h__[k + 2 + k * h_dim1];
+                    dlarfg_(&c__2, &beta, &v[m22 * v_dim1 + 2], &c__1, &v[m22 * v_dim1 + 1]);
+                    h__[k + 1 + k * h_dim1] = beta;
+                    h__[k + 2 + k * h_dim1] = 0.;
+                }
+            }
+            if (accum) {
+                jbot = min(ndcol, *kbot);
+            } else if (*wantt) {
+                jbot = *n;
+            } else {
+                jbot = *kbot;
+            }
+            i__4 = jbot;
+            for (j = max(*ktop, krcol); j <= i__4; ++j) {
+                i__5 = mbot, i__6 = (j - krcol + 2) / 3;
+                mend = min(i__5, i__6);
+                i__5 = mend;
+                for (m = mtop; m <= i__5; ++m) {
+                    k = krcol + (m - 1) * 3;
+                    refsum = v[m * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] +
+                                                  v[m * v_dim1 + 2] * h__[k + 2 + j * h_dim1] +
+                                                  v[m * v_dim1 + 3] * h__[k + 3 + j * h_dim1]);
+                    h__[k + 1 + j * h_dim1] -= refsum;
+                    h__[k + 2 + j * h_dim1] -= refsum * v[m * v_dim1 + 2];
+                    h__[k + 3 + j * h_dim1] -= refsum * v[m * v_dim1 + 3];
+                }
+            }
+            if (bmp22) {
+                k = krcol + (m22 - 1) * 3;
+                i__4 = k + 1;
+                i__5 = jbot;
+                for (j = max(i__4, *ktop); j <= i__5; ++j) {
+                    refsum = v[m22 * v_dim1 + 1] * (h__[k + 1 + j * h_dim1] +
+                                                    v[m22 * v_dim1 + 2] * h__[k + 2 + j * h_dim1]);
+                    h__[k + 1 + j * h_dim1] -= refsum;
+                    h__[k + 2 + j * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
+                }
+            }
+            if (accum) {
+                jtop = max(*ktop, incol);
+            } else if (*wantt) {
+                jtop = 1;
+            } else {
+                jtop = *ktop;
+            }
+            i__5 = mbot;
+            for (m = mtop; m <= i__5; ++m) {
+                if (v[m * v_dim1 + 1] != 0.) {
+                    k = krcol + (m - 1) * 3;
+                    i__6 = *kbot, i__7 = k + 3;
+                    i__4 = min(i__6, i__7);
+                    for (j = jtop; j <= i__4; ++j) {
+                        refsum =
+                            v[m * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] +
+                                                 v[m * v_dim1 + 2] * h__[j + (k + 2) * h_dim1] +
+                                                 v[m * v_dim1 + 3] * h__[j + (k + 3) * h_dim1]);
+                        h__[j + (k + 1) * h_dim1] -= refsum;
+                        h__[j + (k + 2) * h_dim1] -= refsum * v[m * v_dim1 + 2];
+                        h__[j + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3];
+                    }
+                    if (accum) {
+                        kms = k - incol;
+                        i__4 = 1, i__6 = *ktop - incol;
+                        i__7 = kdu;
+                        for (j = max(i__4, i__6); j <= i__7; ++j) {
+                            refsum =
+                                v[m * v_dim1 + 1] * (u[j + (kms + 1) * u_dim1] +
+                                                     v[m * v_dim1 + 2] * u[j + (kms + 2) * u_dim1] +
+                                                     v[m * v_dim1 + 3] * u[j + (kms + 3) * u_dim1]);
+                            u[j + (kms + 1) * u_dim1] -= refsum;
+                            u[j + (kms + 2) * u_dim1] -= refsum * v[m * v_dim1 + 2];
+                            u[j + (kms + 3) * u_dim1] -= refsum * v[m * v_dim1 + 3];
+                        }
+                    } else if (*wantz) {
+                        i__7 = *ihiz;
+                        for (j = *iloz; j <= i__7; ++j) {
+                            refsum =
+                                v[m * v_dim1 + 1] * (z__[j + (k + 1) * z_dim1] +
+                                                     v[m * v_dim1 + 2] * z__[j + (k + 2) * z_dim1] +
+                                                     v[m * v_dim1 + 3] * z__[j + (k + 3) * z_dim1]);
+                            z__[j + (k + 1) * z_dim1] -= refsum;
+                            z__[j + (k + 2) * z_dim1] -= refsum * v[m * v_dim1 + 2];
+                            z__[j + (k + 3) * z_dim1] -= refsum * v[m * v_dim1 + 3];
+                        }
+                    }
+                }
+            }
+            k = krcol + (m22 - 1) * 3;
+            if (bmp22) {
+                if (v[m22 * v_dim1 + 1] != 0.) {
+                    i__7 = *kbot, i__4 = k + 3;
+                    i__5 = min(i__7, i__4);
+                    for (j = jtop; j <= i__5; ++j) {
+                        refsum =
+                            v[m22 * v_dim1 + 1] * (h__[j + (k + 1) * h_dim1] +
+                                                   v[m22 * v_dim1 + 2] * h__[j + (k + 2) * h_dim1]);
+                        h__[j + (k + 1) * h_dim1] -= refsum;
+                        h__[j + (k + 2) * h_dim1] -= refsum * v[m22 * v_dim1 + 2];
+                    }
+                    if (accum) {
+                        kms = k - incol;
+                        i__5 = 1, i__7 = *ktop - incol;
+                        i__4 = kdu;
+                        for (j = max(i__5, i__7); j <= i__4; ++j) {
+                            refsum = v[m22 * v_dim1 + 1] *
+                                     (u[j + (kms + 1) * u_dim1] +
+                                      v[m22 * v_dim1 + 2] * u[j + (kms + 2) * u_dim1]);
+                            u[j + (kms + 1) * u_dim1] -= refsum;
+                            u[j + (kms + 2) * u_dim1] -= refsum * v[m22 * v_dim1 + 2];
+                        }
+                    } else if (*wantz) {
+                        i__4 = *ihiz;
+                        for (j = *iloz; j <= i__4; ++j) {
+                            refsum = v[m22 * v_dim1 + 1] *
+                                     (z__[j + (k + 1) * z_dim1] +
+                                      v[m22 * v_dim1 + 2] * z__[j + (k + 2) * z_dim1]);
+                            z__[j + (k + 1) * z_dim1] -= refsum;
+                            z__[j + (k + 2) * z_dim1] -= refsum * v[m22 * v_dim1 + 2];
+                        }
+                    }
+                }
+            }
+            mstart = mtop;
+            if (krcol + (mstart - 1) * 3 < *ktop) {
+                ++mstart;
+            }
+            mend = mbot;
+            if (bmp22) {
+                ++mend;
+            }
+            if (krcol == *kbot - 2) {
+                ++mend;
+            }
+            i__4 = mend;
+            for (m = mstart; m <= i__4; ++m) {
+                i__5 = *kbot - 1, i__7 = krcol + (m - 1) * 3;
+                k = min(i__5, i__7);
+                if (h__[k + 1 + k * h_dim1] != 0.) {
+                    tst1 = (d__1 = h__[k + k * h_dim1], abs(d__1)) +
+                           (d__2 = h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
+                    if (tst1 == 0.) {
+                        if (k >= *ktop + 1) {
+                            tst1 += (d__1 = h__[k + (k - 1) * h_dim1], abs(d__1));
+                        }
+                        if (k >= *ktop + 2) {
+                            tst1 += (d__1 = h__[k + (k - 2) * h_dim1], abs(d__1));
+                        }
+                        if (k >= *ktop + 3) {
+                            tst1 += (d__1 = h__[k + (k - 3) * h_dim1], abs(d__1));
+                        }
+                        if (k <= *kbot - 2) {
+                            tst1 += (d__1 = h__[k + 2 + (k + 1) * h_dim1], abs(d__1));
+                        }
+                        if (k <= *kbot - 3) {
+                            tst1 += (d__1 = h__[k + 3 + (k + 1) * h_dim1], abs(d__1));
+                        }
+                        if (k <= *kbot - 4) {
+                            tst1 += (d__1 = h__[k + 4 + (k + 1) * h_dim1], abs(d__1));
+                        }
+                    }
+                    d__2 = smlnum, d__3 = ulp * tst1;
+                    if ((d__1 = h__[k + 1 + k * h_dim1], abs(d__1)) <= max(d__2, d__3)) {
+                        d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)),
+                        d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(d__2));
+                        h12 = max(d__3, d__4);
+                        d__3 = (d__1 = h__[k + 1 + k * h_dim1], abs(d__1)),
+                        d__4 = (d__2 = h__[k + (k + 1) * h_dim1], abs(d__2));
+                        h21 = min(d__3, d__4);
+                        d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(d__1)),
+                        d__4 =
+                            (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
+                        h11 = max(d__3, d__4);
+                        d__3 = (d__1 = h__[k + 1 + (k + 1) * h_dim1], abs(d__1)),
+                        d__4 =
+                            (d__2 = h__[k + k * h_dim1] - h__[k + 1 + (k + 1) * h_dim1], abs(d__2));
+                        h22 = min(d__3, d__4);
+                        scl = h11 + h12;
+                        tst2 = h22 * (h11 / scl);
+                        d__1 = smlnum, d__2 = ulp * tst2;
+                        if (tst2 == 0. || h21 * (h12 / scl) <= max(d__1, d__2)) {
+                            h__[k + 1 + k * h_dim1] = 0.;
+                        }
+                    }
+                }
+            }
+            i__4 = nbmps, i__5 = (*kbot - krcol - 1) / 3;
+            mend = min(i__4, i__5);
+            i__4 = mend;
+            for (m = mtop; m <= i__4; ++m) {
+                k = krcol + (m - 1) * 3;
+                refsum = v[m * v_dim1 + 1] * v[m * v_dim1 + 3] * h__[k + 4 + (k + 3) * h_dim1];
+                h__[k + 4 + (k + 1) * h_dim1] = -refsum;
+                h__[k + 4 + (k + 2) * h_dim1] = -refsum * v[m * v_dim1 + 2];
+                h__[k + 4 + (k + 3) * h_dim1] -= refsum * v[m * v_dim1 + 3];
+            }
+        }
+        if (accum) {
+            if (*wantt) {
+                jtop = 1;
+                jbot = *n;
+            } else {
+                jtop = *ktop;
+                jbot = *kbot;
+            }
+            if (!blk22 || incol < *ktop || ndcol > *kbot || ns <= 2) {
+                i__3 = 1, i__4 = *ktop - incol;
+                k1 = max(i__3, i__4);
+                i__3 = 0, i__4 = ndcol - *kbot;
+                nu = kdu - max(i__3, i__4) - k1 + 1;
+                i__3 = jbot;
+                i__4 = *nh;
+                for (jcol = min(ndcol, *kbot) + 1; i__4 < 0 ? jcol >= i__3 : jcol <= i__3;
+                     jcol += i__4) {
+                    i__5 = *nh, i__7 = jbot - jcol + 1;
+                    jlen = min(i__5, i__7);
+                    dgemm_((char *)"C", (char *)"N", &nu, &jlen, &nu, &c_b8, &u[k1 + k1 * u_dim1], ldu,
+                           &h__[incol + k1 + jcol * h_dim1], ldh, &c_b7, &wh[wh_offset], ldwh,
+                           (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"ALL", &nu, &jlen, &wh[wh_offset], ldwh,
+                            &h__[incol + k1 + jcol * h_dim1], ldh, (ftnlen)3);
+                }
+                i__4 = max(*ktop, incol) - 1;
+                i__3 = *nv;
+                for (jrow = jtop; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) {
+                    i__5 = *nv, i__7 = max(*ktop, incol) - jrow;
+                    jlen = min(i__5, i__7);
+                    dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &h__[jrow + (incol + k1) * h_dim1],
+                           ldh, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv, (ftnlen)1,
+                           (ftnlen)1);
+                    dlacpy_((char *)"ALL", &jlen, &nu, &wv[wv_offset], ldwv,
+                            &h__[jrow + (incol + k1) * h_dim1], ldh, (ftnlen)3);
+                }
+                if (*wantz) {
+                    i__3 = *ihiz;
+                    i__4 = *nv;
+                    for (jrow = *iloz; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) {
+                        i__5 = *nv, i__7 = *ihiz - jrow + 1;
+                        jlen = min(i__5, i__7);
+                        dgemm_((char *)"N", (char *)"N", &jlen, &nu, &nu, &c_b8, &z__[jrow + (incol + k1) * z_dim1],
+                               ldz, &u[k1 + k1 * u_dim1], ldu, &c_b7, &wv[wv_offset], ldwv,
+                               (ftnlen)1, (ftnlen)1);
+                        dlacpy_((char *)"ALL", &jlen, &nu, &wv[wv_offset], ldwv,
+                                &z__[jrow + (incol + k1) * z_dim1], ldz, (ftnlen)3);
+                    }
+                }
+            } else {
+                i2 = (kdu + 1) / 2;
+                i4 = kdu;
+                j2 = i4 - i2;
+                j4 = kdu;
+                kzs = j4 - j2 - (ns + 1);
+                knz = ns + 1;
+                i__4 = jbot;
+                i__3 = *nh;
+                for (jcol = min(ndcol, *kbot) + 1; i__3 < 0 ? jcol >= i__4 : jcol <= i__4;
+                     jcol += i__3) {
+                    i__5 = *nh, i__7 = jbot - jcol + 1;
+                    jlen = min(i__5, i__7);
+                    dlacpy_((char *)"ALL", &knz, &jlen, &h__[incol + 1 + j2 + jcol * h_dim1], ldh,
+                            &wh[kzs + 1 + wh_dim1], ldwh, (ftnlen)3);
+                    dlaset_((char *)"ALL", &kzs, &jlen, &c_b7, &c_b7, &wh[wh_offset], ldwh, (ftnlen)3);
+                    dtrmm_((char *)"L", (char *)"U", (char *)"C", (char *)"N", &knz, &jlen, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1],
+                           ldu, &wh[kzs + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1, (ftnlen)1,
+                           (ftnlen)1);
+                    dgemm_((char *)"C", (char *)"N", &i2, &jlen, &j2, &c_b8, &u[u_offset], ldu,
+                           &h__[incol + 1 + jcol * h_dim1], ldh, &c_b8, &wh[wh_offset], ldwh,
+                           (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"ALL", &j2, &jlen, &h__[incol + 1 + jcol * h_dim1], ldh,
+                            &wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)3);
+                    dtrmm_((char *)"L", (char *)"L", (char *)"C", (char *)"N", &j2, &jlen, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu,
+                           &wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                    i__5 = i4 - i2;
+                    i__7 = j4 - j2;
+                    dgemm_((char *)"C", (char *)"N", &i__5, &jlen, &i__7, &c_b8, &u[j2 + 1 + (i2 + 1) * u_dim1],
+                           ldu, &h__[incol + 1 + j2 + jcol * h_dim1], ldh, &c_b8,
+                           &wh[i2 + 1 + wh_dim1], ldwh, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"ALL", &kdu, &jlen, &wh[wh_offset], ldwh,
+                            &h__[incol + 1 + jcol * h_dim1], ldh, (ftnlen)3);
+                }
+                i__3 = max(incol, *ktop) - 1;
+                i__4 = *nv;
+                for (jrow = jtop; i__4 < 0 ? jrow >= i__3 : jrow <= i__3; jrow += i__4) {
+                    i__5 = *nv, i__7 = max(incol, *ktop) - jrow;
+                    jlen = min(i__5, i__7);
+                    dlacpy_((char *)"ALL", &jlen, &knz, &h__[jrow + (incol + 1 + j2) * h_dim1], ldh,
+                            &wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
+                    dlaset_((char *)"ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[wv_offset], ldwv, (ftnlen)3);
+                    dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"N", &jlen, &knz, &c_b8, &u[j2 + 1 + (kzs + 1) * u_dim1],
+                           ldu, &wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1,
+                           (ftnlen)1);
+                    dgemm_((char *)"N", (char *)"N", &jlen, &i2, &j2, &c_b8, &h__[jrow + (incol + 1) * h_dim1], ldh,
+                           &u[u_offset], ldu, &c_b8, &wv[wv_offset], ldwv, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"ALL", &jlen, &j2, &h__[jrow + (incol + 1) * h_dim1], ldh,
+                            &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
+                    i__5 = i4 - i2;
+                    dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"N", &jlen, &i__5, &c_b8, &u[(i2 + 1) * u_dim1 + 1], ldu,
+                           &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1,
+                           (ftnlen)1);
+                    i__5 = i4 - i2;
+                    i__7 = j4 - j2;
+                    dgemm_((char *)"N", (char *)"N", &jlen, &i__5, &i__7, &c_b8,
+                           &h__[jrow + (incol + 1 + j2) * h_dim1], ldh,
+                           &u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8, &wv[(i2 + 1) * wv_dim1 + 1],
+                           ldwv, (ftnlen)1, (ftnlen)1);
+                    dlacpy_((char *)"ALL", &jlen, &kdu, &wv[wv_offset], ldwv,
+                            &h__[jrow + (incol + 1) * h_dim1], ldh, (ftnlen)3);
+                }
+                if (*wantz) {
+                    i__4 = *ihiz;
+                    i__3 = *nv;
+                    for (jrow = *iloz; i__3 < 0 ? jrow >= i__4 : jrow <= i__4; jrow += i__3) {
+                        i__5 = *nv, i__7 = *ihiz - jrow + 1;
+                        jlen = min(i__5, i__7);
+                        dlacpy_((char *)"ALL", &jlen, &knz, &z__[jrow + (incol + 1 + j2) * z_dim1], ldz,
+                                &wv[(kzs + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
+                        dlaset_((char *)"ALL", &jlen, &kzs, &c_b7, &c_b7, &wv[wv_offset], ldwv, (ftnlen)3);
+                        dtrmm_((char *)"R", (char *)"U", (char *)"N", (char *)"N", &jlen, &knz, &c_b8,
+                               &u[j2 + 1 + (kzs + 1) * u_dim1], ldu, &wv[(kzs + 1) * wv_dim1 + 1],
+                               ldwv, (ftnlen)1, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+                        dgemm_((char *)"N", (char *)"N", &jlen, &i2, &j2, &c_b8, &z__[jrow + (incol + 1) * z_dim1],
+                               ldz, &u[u_offset], ldu, &c_b8, &wv[wv_offset], ldwv, (ftnlen)1,
+                               (ftnlen)1);
+                        dlacpy_((char *)"ALL", &jlen, &j2, &z__[jrow + (incol + 1) * z_dim1], ldz,
+                                &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)3);
+                        i__5 = i4 - i2;
+                        dtrmm_((char *)"R", (char *)"L", (char *)"N", (char *)"N", &jlen, &i__5, &c_b8, &u[(i2 + 1) * u_dim1 + 1],
+                               ldu, &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1,
+                               (ftnlen)1, (ftnlen)1);
+                        i__5 = i4 - i2;
+                        i__7 = j4 - j2;
+                        dgemm_((char *)"N", (char *)"N", &jlen, &i__5, &i__7, &c_b8,
+                               &z__[jrow + (incol + 1 + j2) * z_dim1], ldz,
+                               &u[j2 + 1 + (i2 + 1) * u_dim1], ldu, &c_b8,
+                               &wv[(i2 + 1) * wv_dim1 + 1], ldwv, (ftnlen)1, (ftnlen)1);
+                        dlacpy_((char *)"ALL", &jlen, &kdu, &wv[wv_offset], ldwv,
+                                &z__[jrow + (incol + 1) * z_dim1], ldz, (ftnlen)3);
+                    }
+                }
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlarfx.cpp

@@ -0,0 +1,552 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+int dlarfx_(char *side, integer *m, integer *n, doublereal *v, doublereal *tau, doublereal *c__,
+            integer *ldc, doublereal *work, ftnlen side_len)
+{
+    integer c_dim1, c_offset, i__1;
+    integer j;
+    doublereal t1, t2, t3, t4, t5, t6, t7, t8, t9, v1, v2, v3, v4, v5, v6, v7, v8, v9, t10, v10,
+        sum;
+    extern int dlarf_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, ftnlen);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    --v;
+    c_dim1 = *ldc;
+    c_offset = 1 + c_dim1;
+    c__ -= c_offset;
+    --work;
+    if (*tau == 0.) {
+        return 0;
+    }
+    if (lsame_(side, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        switch (*m) {
+            case 1:
+                goto L10;
+            case 2:
+                goto L30;
+            case 3:
+                goto L50;
+            case 4:
+                goto L70;
+            case 5:
+                goto L90;
+            case 6:
+                goto L110;
+            case 7:
+                goto L130;
+            case 8:
+                goto L150;
+            case 9:
+                goto L170;
+            case 10:
+                goto L190;
+        }
+        dlarf_(side, m, n, &v[1], &c__1, tau, &c__[c_offset], ldc, &work[1], (ftnlen)1);
+        goto L410;
+    L10:
+        t1 = 1. - *tau * v[1] * v[1];
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            c__[j * c_dim1 + 1] = t1 * c__[j * c_dim1 + 1];
+        }
+        goto L410;
+    L30:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+        }
+        goto L410;
+    L50:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+        }
+        goto L410;
+    L70:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+        }
+        goto L410;
+    L90:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+        }
+        goto L410;
+    L110:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+            c__[j * c_dim1 + 6] -= sum * t6;
+        }
+        goto L410;
+    L130:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] +
+                  v7 * c__[j * c_dim1 + 7];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+            c__[j * c_dim1 + 6] -= sum * t6;
+            c__[j * c_dim1 + 7] -= sum * t7;
+        }
+        goto L410;
+    L150:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] +
+                  v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+            c__[j * c_dim1 + 6] -= sum * t6;
+            c__[j * c_dim1 + 7] -= sum * t7;
+            c__[j * c_dim1 + 8] -= sum * t8;
+        }
+        goto L410;
+    L170:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        v9 = v[9];
+        t9 = *tau * v9;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] +
+                  v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * c_dim1 + 9];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+            c__[j * c_dim1 + 6] -= sum * t6;
+            c__[j * c_dim1 + 7] -= sum * t7;
+            c__[j * c_dim1 + 8] -= sum * t8;
+            c__[j * c_dim1 + 9] -= sum * t9;
+        }
+        goto L410;
+    L190:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        v9 = v[9];
+        t9 = *tau * v9;
+        v10 = v[10];
+        t10 = *tau * v10;
+        i__1 = *n;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j * c_dim1 + 1] + v2 * c__[j * c_dim1 + 2] + v3 * c__[j * c_dim1 + 3] +
+                  v4 * c__[j * c_dim1 + 4] + v5 * c__[j * c_dim1 + 5] + v6 * c__[j * c_dim1 + 6] +
+                  v7 * c__[j * c_dim1 + 7] + v8 * c__[j * c_dim1 + 8] + v9 * c__[j * c_dim1 + 9] +
+                  v10 * c__[j * c_dim1 + 10];
+            c__[j * c_dim1 + 1] -= sum * t1;
+            c__[j * c_dim1 + 2] -= sum * t2;
+            c__[j * c_dim1 + 3] -= sum * t3;
+            c__[j * c_dim1 + 4] -= sum * t4;
+            c__[j * c_dim1 + 5] -= sum * t5;
+            c__[j * c_dim1 + 6] -= sum * t6;
+            c__[j * c_dim1 + 7] -= sum * t7;
+            c__[j * c_dim1 + 8] -= sum * t8;
+            c__[j * c_dim1 + 9] -= sum * t9;
+            c__[j * c_dim1 + 10] -= sum * t10;
+        }
+        goto L410;
+    } else {
+        switch (*n) {
+            case 1:
+                goto L210;
+            case 2:
+                goto L230;
+            case 3:
+                goto L250;
+            case 4:
+                goto L270;
+            case 5:
+                goto L290;
+            case 6:
+                goto L310;
+            case 7:
+                goto L330;
+            case 8:
+                goto L350;
+            case 9:
+                goto L370;
+            case 10:
+                goto L390;
+        }
+        dlarf_(side, m, n, &v[1], &c__1, tau, &c__[c_offset], ldc, &work[1], (ftnlen)1);
+        goto L410;
+    L210:
+        t1 = 1. - *tau * v[1] * v[1];
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            c__[j + c_dim1] = t1 * c__[j + c_dim1];
+        }
+        goto L410;
+    L230:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+        }
+        goto L410;
+    L250:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+        }
+        goto L410;
+    L270:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+        }
+        goto L410;
+    L290:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+        }
+        goto L410;
+    L310:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] + v6 * c__[j + c_dim1 * 6];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+            c__[j + c_dim1 * 6] -= sum * t6;
+        }
+        goto L410;
+    L330:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] +
+                  v6 * c__[j + c_dim1 * 6] + v7 * c__[j + c_dim1 * 7];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+            c__[j + c_dim1 * 6] -= sum * t6;
+            c__[j + c_dim1 * 7] -= sum * t7;
+        }
+        goto L410;
+    L350:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] +
+                  v6 * c__[j + c_dim1 * 6] + v7 * c__[j + c_dim1 * 7] + v8 * c__[j + (c_dim1 << 3)];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+            c__[j + c_dim1 * 6] -= sum * t6;
+            c__[j + c_dim1 * 7] -= sum * t7;
+            c__[j + (c_dim1 << 3)] -= sum * t8;
+        }
+        goto L410;
+    L370:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        v9 = v[9];
+        t9 = *tau * v9;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] +
+                  v6 * c__[j + c_dim1 * 6] + v7 * c__[j + c_dim1 * 7] +
+                  v8 * c__[j + (c_dim1 << 3)] + v9 * c__[j + c_dim1 * 9];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+            c__[j + c_dim1 * 6] -= sum * t6;
+            c__[j + c_dim1 * 7] -= sum * t7;
+            c__[j + (c_dim1 << 3)] -= sum * t8;
+            c__[j + c_dim1 * 9] -= sum * t9;
+        }
+        goto L410;
+    L390:
+        v1 = v[1];
+        t1 = *tau * v1;
+        v2 = v[2];
+        t2 = *tau * v2;
+        v3 = v[3];
+        t3 = *tau * v3;
+        v4 = v[4];
+        t4 = *tau * v4;
+        v5 = v[5];
+        t5 = *tau * v5;
+        v6 = v[6];
+        t6 = *tau * v6;
+        v7 = v[7];
+        t7 = *tau * v7;
+        v8 = v[8];
+        t8 = *tau * v8;
+        v9 = v[9];
+        t9 = *tau * v9;
+        v10 = v[10];
+        t10 = *tau * v10;
+        i__1 = *m;
+        for (j = 1; j <= i__1; ++j) {
+            sum = v1 * c__[j + c_dim1] + v2 * c__[j + (c_dim1 << 1)] + v3 * c__[j + c_dim1 * 3] +
+                  v4 * c__[j + (c_dim1 << 2)] + v5 * c__[j + c_dim1 * 5] +
+                  v6 * c__[j + c_dim1 * 6] + v7 * c__[j + c_dim1 * 7] +
+                  v8 * c__[j + (c_dim1 << 3)] + v9 * c__[j + c_dim1 * 9] +
+                  v10 * c__[j + c_dim1 * 10];
+            c__[j + c_dim1] -= sum * t1;
+            c__[j + (c_dim1 << 1)] -= sum * t2;
+            c__[j + c_dim1 * 3] -= sum * t3;
+            c__[j + (c_dim1 << 2)] -= sum * t4;
+            c__[j + c_dim1 * 5] -= sum * t5;
+            c__[j + c_dim1 * 6] -= sum * t6;
+            c__[j + c_dim1 * 7] -= sum * t7;
+            c__[j + (c_dim1 << 3)] -= sum * t8;
+            c__[j + c_dim1 * 9] -= sum * t9;
+            c__[j + c_dim1 * 10] -= sum * t10;
+        }
+        goto L410;
+    }
+L410:
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasd0.cpp

@@ -0,0 +1,143 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__0 = 0;
+static integer c__2 = 2;
+int dlasd0_(integer *n, integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer *ldu,
+            doublereal *vt, integer *ldvt, integer *smlsiz, integer *iwork, doublereal *work,
+            integer *info)
+{
+    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1, i__2;
+    integer pow_lmp_ii(integer *, integer *);
+    integer i__, j, m, i1, ic, lf, nd, ll, nl, nr, im1, ncc, nlf, nrf, iwk, lvl, ndb1, nlp1, nrp1;
+    doublereal beta;
+    integer idxq, nlvl;
+    doublereal alpha;
+    integer inode, ndiml, idxqc, ndimr, itemp, sqrei;
+    extern int dlasd1_(integer *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, integer *, doublereal *, integer *, integer *, integer *,
+                       doublereal *, integer *),
+        dlasdq_(char *, integer *, integer *, integer *, integer *, integer *, doublereal *,
+                doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                integer *, doublereal *, integer *, ftnlen),
+        dlasdt_(integer *, integer *, integer *, integer *, integer *, integer *, integer *),
+        xerbla_(char *, integer *, ftnlen);
+    --d__;
+    --e;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    --iwork;
+    --work;
+    *info = 0;
+    if (*n < 0) {
+        *info = -1;
+    } else if (*sqre < 0 || *sqre > 1) {
+        *info = -2;
+    }
+    m = *n + *sqre;
+    if (*ldu < *n) {
+        *info = -6;
+    } else if (*ldvt < m) {
+        *info = -8;
+    } else if (*smlsiz < 3) {
+        *info = -9;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLASD0", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n <= *smlsiz) {
+        dlasdq_((char *)"U", sqre, n, &m, n, &c__0, &d__[1], &e[1], &vt[vt_offset], ldvt, &u[u_offset], ldu,
+                &u[u_offset], ldu, &work[1], info, (ftnlen)1);
+        return 0;
+    }
+    inode = 1;
+    ndiml = inode + *n;
+    ndimr = ndiml + *n;
+    idxq = ndimr + *n;
+    iwk = idxq + *n;
+    dlasdt_(n, &nlvl, &nd, &iwork[inode], &iwork[ndiml], &iwork[ndimr], smlsiz);
+    ndb1 = (nd + 1) / 2;
+    ncc = 0;
+    i__1 = nd;
+    for (i__ = ndb1; i__ <= i__1; ++i__) {
+        i1 = i__ - 1;
+        ic = iwork[inode + i1];
+        nl = iwork[ndiml + i1];
+        nlp1 = nl + 1;
+        nr = iwork[ndimr + i1];
+        nrp1 = nr + 1;
+        nlf = ic - nl;
+        nrf = ic + 1;
+        sqrei = 1;
+        dlasdq_((char *)"U", &sqrei, &nl, &nlp1, &nl, &ncc, &d__[nlf], &e[nlf], &vt[nlf + nlf * vt_dim1],
+                ldvt, &u[nlf + nlf * u_dim1], ldu, &u[nlf + nlf * u_dim1], ldu, &work[1], info,
+                (ftnlen)1);
+        if (*info != 0) {
+            return 0;
+        }
+        itemp = idxq + nlf - 2;
+        i__2 = nl;
+        for (j = 1; j <= i__2; ++j) {
+            iwork[itemp + j] = j;
+        }
+        if (i__ == nd) {
+            sqrei = *sqre;
+        } else {
+            sqrei = 1;
+        }
+        nrp1 = nr + sqrei;
+        dlasdq_((char *)"U", &sqrei, &nr, &nrp1, &nr, &ncc, &d__[nrf], &e[nrf], &vt[nrf + nrf * vt_dim1],
+                ldvt, &u[nrf + nrf * u_dim1], ldu, &u[nrf + nrf * u_dim1], ldu, &work[1], info,
+                (ftnlen)1);
+        if (*info != 0) {
+            return 0;
+        }
+        itemp = idxq + ic;
+        i__2 = nr;
+        for (j = 1; j <= i__2; ++j) {
+            iwork[itemp + j - 1] = j;
+        }
+    }
+    for (lvl = nlvl; lvl >= 1; --lvl) {
+        if (lvl == 1) {
+            lf = 1;
+            ll = 1;
+        } else {
+            i__1 = lvl - 1;
+            lf = pow_lmp_ii(&c__2, &i__1);
+            ll = (lf << 1) - 1;
+        }
+        i__1 = ll;
+        for (i__ = lf; i__ <= i__1; ++i__) {
+            im1 = i__ - 1;
+            ic = iwork[inode + im1];
+            nl = iwork[ndiml + im1];
+            nr = iwork[ndimr + im1];
+            nlf = ic - nl;
+            if (*sqre == 0 && i__ == ll) {
+                sqrei = *sqre;
+            } else {
+                sqrei = 1;
+            }
+            idxqc = idxq + nlf - 1;
+            alpha = d__[ic];
+            beta = e[ic];
+            dlasd1_(&nl, &nr, &sqrei, &d__[nlf], &alpha, &beta, &u[nlf + nlf * u_dim1], ldu,
+                    &vt[nlf + nlf * vt_dim1], ldvt, &iwork[idxqc], &iwork[iwk], &work[1], info);
+            if (*info != 0) {
+                return 0;
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasd1.cpp

@@ -0,0 +1,96 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__0 = 0;
+static doublereal c_b7 = 1.;
+static integer c__1 = 1;
+static integer c_n1 = -1;
+int dlasd1_(integer *nl, integer *nr, integer *sqre, doublereal *d__, doublereal *alpha,
+            doublereal *beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt,
+            integer *idxq, integer *iwork, doublereal *work, integer *info)
+{
+    integer u_dim1, u_offset, vt_dim1, vt_offset, i__1;
+    doublereal d__1, d__2;
+    integer i__, k, m, n, n1, n2, iq, iz, iu2, ldq, idx, ldu2, ivt2, idxc, idxp, ldvt2;
+    extern int dlasd2_(integer *, integer *, integer *, integer *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, doublereal *, integer *, doublereal *, integer *,
+                       doublereal *, doublereal *, integer *, doublereal *, integer *, integer *,
+                       integer *, integer *, integer *, integer *, integer *),
+        dlasd3_(integer *, integer *, integer *, integer *, doublereal *, doublereal *, integer *,
+                doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                integer *, doublereal *, integer *, integer *, integer *, doublereal *, integer *),
+        dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
+                doublereal *, integer *, integer *, ftnlen),
+        dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *);
+    integer isigma;
+    extern int xerbla_(char *, integer *, ftnlen);
+    doublereal orgnrm;
+    integer coltyp;
+    --d__;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    --idxq;
+    --iwork;
+    --work;
+    *info = 0;
+    if (*nl < 1) {
+        *info = -1;
+    } else if (*nr < 1) {
+        *info = -2;
+    } else if (*sqre < 0 || *sqre > 1) {
+        *info = -3;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLASD1", &i__1, (ftnlen)6);
+        return 0;
+    }
+    n = *nl + *nr + 1;
+    m = n + *sqre;
+    ldu2 = n;
+    ldvt2 = m;
+    iz = 1;
+    isigma = iz + m;
+    iu2 = isigma + n;
+    ivt2 = iu2 + ldu2 * n;
+    iq = ivt2 + ldvt2 * m;
+    idx = 1;
+    idxc = idx + n;
+    coltyp = idxc + n;
+    idxp = coltyp + n;
+    d__1 = abs(*alpha), d__2 = abs(*beta);
+    orgnrm = max(d__1, d__2);
+    d__[*nl + 1] = 0.;
+    i__1 = n;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        if ((d__1 = d__[i__], abs(d__1)) > orgnrm) {
+            orgnrm = (d__1 = d__[i__], abs(d__1));
+        }
+    }
+    dlascl_((char *)"G", &c__0, &c__0, &orgnrm, &c_b7, &n, &c__1, &d__[1], &n, info, (ftnlen)1);
+    *alpha /= orgnrm;
+    *beta /= orgnrm;
+    dlasd2_(nl, nr, sqre, &k, &d__[1], &work[iz], alpha, beta, &u[u_offset], ldu, &vt[vt_offset],
+            ldvt, &work[isigma], &work[iu2], &ldu2, &work[ivt2], &ldvt2, &iwork[idxp], &iwork[idx],
+            &iwork[idxc], &idxq[1], &iwork[coltyp], info);
+    ldq = k;
+    dlasd3_(nl, nr, sqre, &k, &d__[1], &work[iq], &ldq, &work[isigma], &u[u_offset], ldu,
+            &work[iu2], &ldu2, &vt[vt_offset], ldvt, &work[ivt2], &ldvt2, &iwork[idxc],
+            &iwork[coltyp], &work[iz], info);
+    if (*info != 0) {
+        return 0;
+    }
+    dlascl_((char *)"G", &c__0, &c__0, &c_b7, &orgnrm, &n, &c__1, &d__[1], &n, info, (ftnlen)1);
+    n1 = k;
+    n2 = n - k;
+    dlamrg_(&n1, &n2, &d__[1], &c__1, &c_n1, &idxq[1]);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasd2.cpp

@@ -0,0 +1,282 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static doublereal c_b30 = 0.;
+int dlasd2_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__, doublereal *z__,
+            doublereal *alpha, doublereal *beta, doublereal *u, integer *ldu, doublereal *vt,
+            integer *ldvt, doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2,
+            integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *idxq,
+            integer *coltyp, integer *info)
+{
+    integer u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset, vt2_dim1, vt2_offset, i__1;
+    doublereal d__1, d__2;
+    doublereal c__;
+    integer i__, j, m, n;
+    doublereal s;
+    integer k2;
+    doublereal z1;
+    integer ct, jp;
+    doublereal eps, tau, tol;
+    integer psm[4], nlp1, nlp2, idxi, idxj;
+    extern int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *,
+                     doublereal *);
+    integer ctot[4], idxjp;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer jprev;
+    extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *, ftnlen);
+    extern int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen),
+        dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *,
+                ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    doublereal hlftol;
+    --d__;
+    --z__;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    --dsigma;
+    u2_dim1 = *ldu2;
+    u2_offset = 1 + u2_dim1;
+    u2 -= u2_offset;
+    vt2_dim1 = *ldvt2;
+    vt2_offset = 1 + vt2_dim1;
+    vt2 -= vt2_offset;
+    --idxp;
+    --idx;
+    --idxc;
+    --idxq;
+    --coltyp;
+    *info = 0;
+    if (*nl < 1) {
+        *info = -1;
+    } else if (*nr < 1) {
+        *info = -2;
+    } else if (*sqre != 1 && *sqre != 0) {
+        *info = -3;
+    }
+    n = *nl + *nr + 1;
+    m = n + *sqre;
+    if (*ldu < n) {
+        *info = -10;
+    } else if (*ldvt < m) {
+        *info = -12;
+    } else if (*ldu2 < n) {
+        *info = -15;
+    } else if (*ldvt2 < m) {
+        *info = -17;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLASD2", &i__1, (ftnlen)6);
+        return 0;
+    }
+    nlp1 = *nl + 1;
+    nlp2 = *nl + 2;
+    z1 = *alpha * vt[nlp1 + nlp1 * vt_dim1];
+    z__[1] = z1;
+    for (i__ = *nl; i__ >= 1; --i__) {
+        z__[i__ + 1] = *alpha * vt[i__ + nlp1 * vt_dim1];
+        d__[i__ + 1] = d__[i__];
+        idxq[i__ + 1] = idxq[i__] + 1;
+    }
+    i__1 = m;
+    for (i__ = nlp2; i__ <= i__1; ++i__) {
+        z__[i__] = *beta * vt[i__ + nlp2 * vt_dim1];
+    }
+    i__1 = nlp1;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+        coltyp[i__] = 1;
+    }
+    i__1 = n;
+    for (i__ = nlp2; i__ <= i__1; ++i__) {
+        coltyp[i__] = 2;
+    }
+    i__1 = n;
+    for (i__ = nlp2; i__ <= i__1; ++i__) {
+        idxq[i__] += nlp1;
+    }
+    i__1 = n;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+        dsigma[i__] = d__[idxq[i__]];
+        u2[i__ + u2_dim1] = z__[idxq[i__]];
+        idxc[i__] = coltyp[idxq[i__]];
+    }
+    dlamrg_(nl, nr, &dsigma[2], &c__1, &c__1, &idx[2]);
+    i__1 = n;
+    for (i__ = 2; i__ <= i__1; ++i__) {
+        idxi = idx[i__] + 1;
+        d__[i__] = dsigma[idxi];
+        z__[i__] = u2[idxi + u2_dim1];
+        coltyp[i__] = idxc[idxi];
+    }
+    eps = dlamch_((char *)"Epsilon", (ftnlen)7);
+    d__1 = abs(*alpha), d__2 = abs(*beta);
+    tol = max(d__1, d__2);
+    d__2 = (d__1 = d__[n], abs(d__1));
+    tol = eps * 8. * max(d__2, tol);
+    *k = 1;
+    k2 = n + 1;
+    i__1 = n;
+    for (j = 2; j <= i__1; ++j) {
+        if ((d__1 = z__[j], abs(d__1)) <= tol) {
+            --k2;
+            idxp[k2] = j;
+            coltyp[j] = 4;
+            if (j == n) {
+                goto L120;
+            }
+        } else {
+            jprev = j;
+            goto L90;
+        }
+    }
+L90:
+    j = jprev;
+L100:
+    ++j;
+    if (j > n) {
+        goto L110;
+    }
+    if ((d__1 = z__[j], abs(d__1)) <= tol) {
+        --k2;
+        idxp[k2] = j;
+        coltyp[j] = 4;
+    } else {
+        if ((d__1 = d__[j] - d__[jprev], abs(d__1)) <= tol) {
+            s = z__[jprev];
+            c__ = z__[j];
+            tau = dlapy2_(&c__, &s);
+            c__ /= tau;
+            s = -s / tau;
+            z__[j] = tau;
+            z__[jprev] = 0.;
+            idxjp = idxq[idx[jprev] + 1];
+            idxj = idxq[idx[j] + 1];
+            if (idxjp <= nlp1) {
+                --idxjp;
+            }
+            if (idxj <= nlp1) {
+                --idxj;
+            }
+            drot_(&n, &u[idxjp * u_dim1 + 1], &c__1, &u[idxj * u_dim1 + 1], &c__1, &c__, &s);
+            drot_(&m, &vt[idxjp + vt_dim1], ldvt, &vt[idxj + vt_dim1], ldvt, &c__, &s);
+            if (coltyp[j] != coltyp[jprev]) {
+                coltyp[j] = 3;
+            }
+            coltyp[jprev] = 4;
+            --k2;
+            idxp[k2] = jprev;
+            jprev = j;
+        } else {
+            ++(*k);
+            u2[*k + u2_dim1] = z__[jprev];
+            dsigma[*k] = d__[jprev];
+            idxp[*k] = jprev;
+            jprev = j;
+        }
+    }
+    goto L100;
+L110:
+    ++(*k);
+    u2[*k + u2_dim1] = z__[jprev];
+    dsigma[*k] = d__[jprev];
+    idxp[*k] = jprev;
+L120:
+    for (j = 1; j <= 4; ++j) {
+        ctot[j - 1] = 0;
+    }
+    i__1 = n;
+    for (j = 2; j <= i__1; ++j) {
+        ct = coltyp[j];
+        ++ctot[ct - 1];
+    }
+    psm[0] = 2;
+    psm[1] = ctot[0] + 2;
+    psm[2] = psm[1] + ctot[1];
+    psm[3] = psm[2] + ctot[2];
+    i__1 = n;
+    for (j = 2; j <= i__1; ++j) {
+        jp = idxp[j];
+        ct = coltyp[jp];
+        idxc[psm[ct - 1]] = j;
+        ++psm[ct - 1];
+    }
+    i__1 = n;
+    for (j = 2; j <= i__1; ++j) {
+        jp = idxp[j];
+        dsigma[j] = d__[jp];
+        idxj = idxq[idx[idxp[idxc[j]]] + 1];
+        if (idxj <= nlp1) {
+            --idxj;
+        }
+        dcopy_(&n, &u[idxj * u_dim1 + 1], &c__1, &u2[j * u2_dim1 + 1], &c__1);
+        dcopy_(&m, &vt[idxj + vt_dim1], ldvt, &vt2[j + vt2_dim1], ldvt2);
+    }
+    dsigma[1] = 0.;
+    hlftol = tol / 2.;
+    if (abs(dsigma[2]) <= hlftol) {
+        dsigma[2] = hlftol;
+    }
+    if (m > n) {
+        z__[1] = dlapy2_(&z1, &z__[m]);
+        if (z__[1] <= tol) {
+            c__ = 1.;
+            s = 0.;
+            z__[1] = tol;
+        } else {
+            c__ = z1 / z__[1];
+            s = z__[m] / z__[1];
+        }
+    } else {
+        if (abs(z1) <= tol) {
+            z__[1] = tol;
+        } else {
+            z__[1] = z1;
+        }
+    }
+    i__1 = *k - 1;
+    dcopy_(&i__1, &u2[u2_dim1 + 2], &c__1, &z__[2], &c__1);
+    dlaset_((char *)"A", &n, &c__1, &c_b30, &c_b30, &u2[u2_offset], ldu2, (ftnlen)1);
+    u2[nlp1 + u2_dim1] = 1.;
+    if (m > n) {
+        i__1 = nlp1;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            vt[m + i__ * vt_dim1] = -s * vt[nlp1 + i__ * vt_dim1];
+            vt2[i__ * vt2_dim1 + 1] = c__ * vt[nlp1 + i__ * vt_dim1];
+        }
+        i__1 = m;
+        for (i__ = nlp2; i__ <= i__1; ++i__) {
+            vt2[i__ * vt2_dim1 + 1] = s * vt[m + i__ * vt_dim1];
+            vt[m + i__ * vt_dim1] = c__ * vt[m + i__ * vt_dim1];
+        }
+    } else {
+        dcopy_(&m, &vt[nlp1 + vt_dim1], ldvt, &vt2[vt2_dim1 + 1], ldvt2);
+    }
+    if (m > n) {
+        dcopy_(&m, &vt[m + vt_dim1], ldvt, &vt2[m + vt2_dim1], ldvt2);
+    }
+    if (n > *k) {
+        i__1 = n - *k;
+        dcopy_(&i__1, &dsigma[*k + 1], &c__1, &d__[*k + 1], &c__1);
+        i__1 = n - *k;
+        dlacpy_((char *)"A", &n, &i__1, &u2[(*k + 1) * u2_dim1 + 1], ldu2, &u[(*k + 1) * u_dim1 + 1], ldu,
+                (ftnlen)1);
+        i__1 = n - *k;
+        dlacpy_((char *)"A", &i__1, &m, &vt2[*k + 1 + vt2_dim1], ldvt2, &vt[*k + 1 + vt_dim1], ldvt,
+                (ftnlen)1);
+    }
+    for (j = 1; j <= 4; ++j) {
+        coltyp[j] = ctot[j - 1];
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasd3.cpp

@@ -0,0 +1,218 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c__0 = 0;
+static doublereal c_b13 = 1.;
+static doublereal c_b26 = 0.;
+int dlasd3_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__, doublereal *q,
+            integer *ldq, doublereal *dsigma, doublereal *u, integer *ldu, doublereal *u2,
+            integer *ldu2, doublereal *vt, integer *ldvt, doublereal *vt2, integer *ldvt2,
+            integer *idxc, integer *ctot, doublereal *z__, integer *info)
+{
+    integer q_dim1, q_offset, u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset, vt2_dim1,
+        vt2_offset, i__1, i__2;
+    doublereal d__1, d__2;
+    double sqrt(doublereal), d_lmp_sign(doublereal *, doublereal *);
+    integer i__, j, m, n, jc;
+    doublereal rho;
+    integer nlp1, nlp2, nrp1;
+    doublereal temp;
+    extern doublereal dnrm2_(integer *, doublereal *, integer *);
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    integer ctemp;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer ktemp;
+    extern doublereal dlamc3_(doublereal *, doublereal *);
+    extern int dlasd4_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *,
+                       doublereal *, doublereal *, integer *),
+        dlascl_(char *, integer *, integer *, doublereal *, doublereal *, integer *, integer *,
+                doublereal *, integer *, integer *, ftnlen),
+        dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *,
+                ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    --d__;
+    q_dim1 = *ldq;
+    q_offset = 1 + q_dim1;
+    q -= q_offset;
+    --dsigma;
+    u_dim1 = *ldu;
+    u_offset = 1 + u_dim1;
+    u -= u_offset;
+    u2_dim1 = *ldu2;
+    u2_offset = 1 + u2_dim1;
+    u2 -= u2_offset;
+    vt_dim1 = *ldvt;
+    vt_offset = 1 + vt_dim1;
+    vt -= vt_offset;
+    vt2_dim1 = *ldvt2;
+    vt2_offset = 1 + vt2_dim1;
+    vt2 -= vt2_offset;
+    --idxc;
+    --ctot;
+    --z__;
+    *info = 0;
+    if (*nl < 1) {
+        *info = -1;
+    } else if (*nr < 1) {
+        *info = -2;
+    } else if (*sqre != 1 && *sqre != 0) {
+        *info = -3;
+    }
+    n = *nl + *nr + 1;
+    m = n + *sqre;
+    nlp1 = *nl + 1;
+    nlp2 = *nl + 2;
+    if (*k < 1 || *k > n) {
+        *info = -4;
+    } else if (*ldq < *k) {
+        *info = -7;
+    } else if (*ldu < n) {
+        *info = -10;
+    } else if (*ldu2 < n) {
+        *info = -12;
+    } else if (*ldvt < m) {
+        *info = -14;
+    } else if (*ldvt2 < m) {
+        *info = -16;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLASD3", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*k == 1) {
+        d__[1] = abs(z__[1]);
+        dcopy_(&m, &vt2[vt2_dim1 + 1], ldvt2, &vt[vt_dim1 + 1], ldvt);
+        if (z__[1] > 0.) {
+            dcopy_(&n, &u2[u2_dim1 + 1], &c__1, &u[u_dim1 + 1], &c__1);
+        } else {
+            i__1 = n;
+            for (i__ = 1; i__ <= i__1; ++i__) {
+                u[i__ + u_dim1] = -u2[i__ + u2_dim1];
+            }
+        }
+        return 0;
+    }
+    i__1 = *k;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        dsigma[i__] = dlamc3_(&dsigma[i__], &dsigma[i__]) - dsigma[i__];
+    }
+    dcopy_(k, &z__[1], &c__1, &q[q_offset], &c__1);
+    rho = dnrm2_(k, &z__[1], &c__1);
+    dlascl_((char *)"G", &c__0, &c__0, &rho, &c_b13, k, &c__1, &z__[1], k, info, (ftnlen)1);
+    rho *= rho;
+    i__1 = *k;
+    for (j = 1; j <= i__1; ++j) {
+        dlasd4_(k, &j, &dsigma[1], &z__[1], &u[j * u_dim1 + 1], &rho, &d__[j], &vt[j * vt_dim1 + 1],
+                info);
+        if (*info != 0) {
+            return 0;
+        }
+    }
+    i__1 = *k;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        z__[i__] = u[i__ + *k * u_dim1] * vt[i__ + *k * vt_dim1];
+        i__2 = i__ - 1;
+        for (j = 1; j <= i__2; ++j) {
+            z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] / (dsigma[i__] - dsigma[j]) /
+                        (dsigma[i__] + dsigma[j]);
+        }
+        i__2 = *k - 1;
+        for (j = i__; j <= i__2; ++j) {
+            z__[i__] *= u[i__ + j * u_dim1] * vt[i__ + j * vt_dim1] /
+                        (dsigma[i__] - dsigma[j + 1]) / (dsigma[i__] + dsigma[j + 1]);
+        }
+        d__2 = sqrt((d__1 = z__[i__], abs(d__1)));
+        z__[i__] = d_lmp_sign(&d__2, &q[i__ + q_dim1]);
+    }
+    i__1 = *k;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        vt[i__ * vt_dim1 + 1] = z__[1] / u[i__ * u_dim1 + 1] / vt[i__ * vt_dim1 + 1];
+        u[i__ * u_dim1 + 1] = -1.;
+        i__2 = *k;
+        for (j = 2; j <= i__2; ++j) {
+            vt[j + i__ * vt_dim1] = z__[j] / u[j + i__ * u_dim1] / vt[j + i__ * vt_dim1];
+            u[j + i__ * u_dim1] = dsigma[j] * vt[j + i__ * vt_dim1];
+        }
+        temp = dnrm2_(k, &u[i__ * u_dim1 + 1], &c__1);
+        q[i__ * q_dim1 + 1] = u[i__ * u_dim1 + 1] / temp;
+        i__2 = *k;
+        for (j = 2; j <= i__2; ++j) {
+            jc = idxc[j];
+            q[j + i__ * q_dim1] = u[jc + i__ * u_dim1] / temp;
+        }
+    }
+    if (*k == 2) {
+        dgemm_((char *)"N", (char *)"N", &n, k, k, &c_b13, &u2[u2_offset], ldu2, &q[q_offset], ldq, &c_b26,
+               &u[u_offset], ldu, (ftnlen)1, (ftnlen)1);
+        goto L100;
+    }
+    if (ctot[1] > 0) {
+        dgemm_((char *)"N", (char *)"N", nl, k, &ctot[1], &c_b13, &u2[(u2_dim1 << 1) + 1], ldu2, &q[q_dim1 + 2],
+               ldq, &c_b26, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
+        if (ctot[3] > 0) {
+            ktemp = ctot[1] + 2 + ctot[2];
+            dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b13, &u2[ktemp * u2_dim1 + 1], ldu2,
+                   &q[ktemp + q_dim1], ldq, &c_b13, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
+        }
+    } else if (ctot[3] > 0) {
+        ktemp = ctot[1] + 2 + ctot[2];
+        dgemm_((char *)"N", (char *)"N", nl, k, &ctot[3], &c_b13, &u2[ktemp * u2_dim1 + 1], ldu2,
+               &q[ktemp + q_dim1], ldq, &c_b26, &u[u_dim1 + 1], ldu, (ftnlen)1, (ftnlen)1);
+    } else {
+        dlacpy_((char *)"F", nl, k, &u2[u2_offset], ldu2, &u[u_offset], ldu, (ftnlen)1);
+    }
+    dcopy_(k, &q[q_dim1 + 1], ldq, &u[nlp1 + u_dim1], ldu);
+    ktemp = ctot[1] + 2;
+    ctemp = ctot[2] + ctot[3];
+    dgemm_((char *)"N", (char *)"N", nr, k, &ctemp, &c_b13, &u2[nlp2 + ktemp * u2_dim1], ldu2, &q[ktemp + q_dim1],
+           ldq, &c_b26, &u[nlp2 + u_dim1], ldu, (ftnlen)1, (ftnlen)1);
+L100:
+    i__1 = *k;
+    for (i__ = 1; i__ <= i__1; ++i__) {
+        temp = dnrm2_(k, &vt[i__ * vt_dim1 + 1], &c__1);
+        q[i__ + q_dim1] = vt[i__ * vt_dim1 + 1] / temp;
+        i__2 = *k;
+        for (j = 2; j <= i__2; ++j) {
+            jc = idxc[j];
+            q[i__ + j * q_dim1] = vt[jc + i__ * vt_dim1] / temp;
+        }
+    }
+    if (*k == 2) {
+        dgemm_((char *)"N", (char *)"N", k, &m, k, &c_b13, &q[q_offset], ldq, &vt2[vt2_offset], ldvt2, &c_b26,
+               &vt[vt_offset], ldvt, (ftnlen)1, (ftnlen)1);
+        return 0;
+    }
+    ktemp = ctot[1] + 1;
+    dgemm_((char *)"N", (char *)"N", k, &nlp1, &ktemp, &c_b13, &q[q_dim1 + 1], ldq, &vt2[vt2_dim1 + 1], ldvt2,
+           &c_b26, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1);
+    ktemp = ctot[1] + 2 + ctot[2];
+    if (ktemp <= *ldvt2) {
+        dgemm_((char *)"N", (char *)"N", k, &nlp1, &ctot[3], &c_b13, &q[ktemp * q_dim1 + 1], ldq,
+               &vt2[ktemp + vt2_dim1], ldvt2, &c_b13, &vt[vt_dim1 + 1], ldvt, (ftnlen)1, (ftnlen)1);
+    }
+    ktemp = ctot[1] + 1;
+    nrp1 = *nr + *sqre;
+    if (ktemp > 1) {
+        i__1 = *k;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            q[i__ + ktemp * q_dim1] = q[i__ + q_dim1];
+        }
+        i__1 = m;
+        for (i__ = nlp2; i__ <= i__1; ++i__) {
+            vt2[ktemp + i__ * vt2_dim1] = vt2[i__ * vt2_dim1 + 1];
+        }
+    }
+    ctemp = ctot[2] + 1 + ctot[3];
+    dgemm_((char *)"N", (char *)"N", k, &nrp1, &ctemp, &c_b13, &q[ktemp * q_dim1 + 1], ldq,
+           &vt2[ktemp + nlp2 * vt2_dim1], ldvt2, &c_b26, &vt[nlp2 * vt_dim1 + 1], ldvt, (ftnlen)1,
+           (ftnlen)1);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasy2.cpp

@@ -0,0 +1,284 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__4 = 4;
+static integer c__1 = 1;
+static integer c__16 = 16;
+static integer c__0 = 0;
+int dlasy2_(logical *ltranl, logical *ltranr, integer *isgn, integer *n1, integer *n2,
+            doublereal *tl, integer *ldtl, doublereal *tr, integer *ldtr, doublereal *b,
+            integer *ldb, doublereal *scale, doublereal *x, integer *ldx, doublereal *xnorm,
+            integer *info)
+{
+    static integer locu12[4] = {3, 4, 1, 2};
+    static integer locl21[4] = {2, 1, 4, 3};
+    static integer locu22[4] = {4, 3, 2, 1};
+    static logical xswpiv[4] = {FALSE_, FALSE_, TRUE_, TRUE_};
+    static logical bswpiv[4] = {FALSE_, TRUE_, FALSE_, TRUE_};
+    integer b_dim1, b_offset, tl_dim1, tl_offset, tr_dim1, tr_offset, x_dim1, x_offset;
+    doublereal d__1, d__2, d__3, d__4, d__5, d__6, d__7, d__8;
+    integer i__, j, k;
+    doublereal x2[2], l21, u11, u12;
+    integer ip, jp;
+    doublereal u22, t16[16], gam, bet, eps, sgn, tmp[4], tau1, btmp[4], smin;
+    integer ipiv;
+    doublereal temp;
+    integer jpiv[4];
+    doublereal xmax;
+    integer ipsv, jpsv;
+    logical bswap;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *),
+        dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    logical xswap;
+    extern doublereal dlamch_(char *, ftnlen);
+    extern integer idamax_(integer *, doublereal *, integer *);
+    doublereal smlnum;
+    tl_dim1 = *ldtl;
+    tl_offset = 1 + tl_dim1;
+    tl -= tl_offset;
+    tr_dim1 = *ldtr;
+    tr_offset = 1 + tr_dim1;
+    tr -= tr_offset;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    x_dim1 = *ldx;
+    x_offset = 1 + x_dim1;
+    x -= x_offset;
+    *info = 0;
+    if (*n1 == 0 || *n2 == 0) {
+        return 0;
+    }
+    eps = dlamch_((char *)"P", (ftnlen)1);
+    smlnum = dlamch_((char *)"S", (ftnlen)1) / eps;
+    sgn = (doublereal)(*isgn);
+    k = *n1 + *n1 + *n2 - 2;
+    switch (k) {
+        case 1:
+            goto L10;
+        case 2:
+            goto L20;
+        case 3:
+            goto L30;
+        case 4:
+            goto L50;
+    }
+L10:
+    tau1 = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
+    bet = abs(tau1);
+    if (bet <= smlnum) {
+        tau1 = smlnum;
+        bet = smlnum;
+        *info = 1;
+    }
+    *scale = 1.;
+    gam = (d__1 = b[b_dim1 + 1], abs(d__1));
+    if (smlnum * gam > bet) {
+        *scale = 1. / gam;
+    }
+    x[x_dim1 + 1] = b[b_dim1 + 1] * *scale / tau1;
+    *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1));
+    return 0;
+L20:
+    d__7 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__8 = (d__2 = tr[tr_dim1 + 1], abs(d__2)),
+    d__7 = max(d__7, d__8), d__8 = (d__3 = tr[(tr_dim1 << 1) + 1], abs(d__3)),
+    d__7 = max(d__7, d__8), d__8 = (d__4 = tr[tr_dim1 + 2], abs(d__4)), d__7 = max(d__7, d__8),
+    d__8 = (d__5 = tr[(tr_dim1 << 1) + 2], abs(d__5));
+    d__6 = eps * max(d__7, d__8);
+    smin = max(d__6, smlnum);
+    tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
+    tmp[3] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2];
+    if (*ltranr) {
+        tmp[1] = sgn * tr[tr_dim1 + 2];
+        tmp[2] = sgn * tr[(tr_dim1 << 1) + 1];
+    } else {
+        tmp[1] = sgn * tr[(tr_dim1 << 1) + 1];
+        tmp[2] = sgn * tr[tr_dim1 + 2];
+    }
+    btmp[0] = b[b_dim1 + 1];
+    btmp[1] = b[(b_dim1 << 1) + 1];
+    goto L40;
+L30:
+    d__7 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__8 = (d__2 = tl[tl_dim1 + 1], abs(d__2)),
+    d__7 = max(d__7, d__8), d__8 = (d__3 = tl[(tl_dim1 << 1) + 1], abs(d__3)),
+    d__7 = max(d__7, d__8), d__8 = (d__4 = tl[tl_dim1 + 2], abs(d__4)), d__7 = max(d__7, d__8),
+    d__8 = (d__5 = tl[(tl_dim1 << 1) + 2], abs(d__5));
+    d__6 = eps * max(d__7, d__8);
+    smin = max(d__6, smlnum);
+    tmp[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
+    tmp[3] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1];
+    if (*ltranl) {
+        tmp[1] = tl[(tl_dim1 << 1) + 1];
+        tmp[2] = tl[tl_dim1 + 2];
+    } else {
+        tmp[1] = tl[tl_dim1 + 2];
+        tmp[2] = tl[(tl_dim1 << 1) + 1];
+    }
+    btmp[0] = b[b_dim1 + 1];
+    btmp[1] = b[b_dim1 + 2];
+L40:
+    ipiv = idamax_(&c__4, tmp, &c__1);
+    u11 = tmp[ipiv - 1];
+    if (abs(u11) <= smin) {
+        *info = 1;
+        u11 = smin;
+    }
+    u12 = tmp[locu12[ipiv - 1] - 1];
+    l21 = tmp[locl21[ipiv - 1] - 1] / u11;
+    u22 = tmp[locu22[ipiv - 1] - 1] - u12 * l21;
+    xswap = xswpiv[ipiv - 1];
+    bswap = bswpiv[ipiv - 1];
+    if (abs(u22) <= smin) {
+        *info = 1;
+        u22 = smin;
+    }
+    if (bswap) {
+        temp = btmp[1];
+        btmp[1] = btmp[0] - l21 * temp;
+        btmp[0] = temp;
+    } else {
+        btmp[1] -= l21 * btmp[0];
+    }
+    *scale = 1.;
+    if (smlnum * 2. * abs(btmp[1]) > abs(u22) || smlnum * 2. * abs(btmp[0]) > abs(u11)) {
+        d__1 = abs(btmp[0]), d__2 = abs(btmp[1]);
+        *scale = .5 / max(d__1, d__2);
+        btmp[0] *= *scale;
+        btmp[1] *= *scale;
+    }
+    x2[1] = btmp[1] / u22;
+    x2[0] = btmp[0] / u11 - u12 / u11 * x2[1];
+    if (xswap) {
+        temp = x2[1];
+        x2[1] = x2[0];
+        x2[0] = temp;
+    }
+    x[x_dim1 + 1] = x2[0];
+    if (*n1 == 1) {
+        x[(x_dim1 << 1) + 1] = x2[1];
+        *xnorm = (d__1 = x[x_dim1 + 1], abs(d__1)) + (d__2 = x[(x_dim1 << 1) + 1], abs(d__2));
+    } else {
+        x[x_dim1 + 2] = x2[1];
+        d__3 = (d__1 = x[x_dim1 + 1], abs(d__1)), d__4 = (d__2 = x[x_dim1 + 2], abs(d__2));
+        *xnorm = max(d__3, d__4);
+    }
+    return 0;
+L50:
+    d__5 = (d__1 = tr[tr_dim1 + 1], abs(d__1)), d__6 = (d__2 = tr[(tr_dim1 << 1) + 1], abs(d__2)),
+    d__5 = max(d__5, d__6), d__6 = (d__3 = tr[tr_dim1 + 2], abs(d__3)), d__5 = max(d__5, d__6),
+    d__6 = (d__4 = tr[(tr_dim1 << 1) + 2], abs(d__4));
+    smin = max(d__5, d__6);
+    d__5 = smin, d__6 = (d__1 = tl[tl_dim1 + 1], abs(d__1)), d__5 = max(d__5, d__6),
+    d__6 = (d__2 = tl[(tl_dim1 << 1) + 1], abs(d__2)), d__5 = max(d__5, d__6),
+    d__6 = (d__3 = tl[tl_dim1 + 2], abs(d__3)), d__5 = max(d__5, d__6),
+    d__6 = (d__4 = tl[(tl_dim1 << 1) + 2], abs(d__4));
+    smin = max(d__5, d__6);
+    d__1 = eps * smin;
+    smin = max(d__1, smlnum);
+    btmp[0] = 0.;
+    dcopy_(&c__16, btmp, &c__0, t16, &c__1);
+    t16[0] = tl[tl_dim1 + 1] + sgn * tr[tr_dim1 + 1];
+    t16[5] = tl[(tl_dim1 << 1) + 2] + sgn * tr[tr_dim1 + 1];
+    t16[10] = tl[tl_dim1 + 1] + sgn * tr[(tr_dim1 << 1) + 2];
+    t16[15] = tl[(tl_dim1 << 1) + 2] + sgn * tr[(tr_dim1 << 1) + 2];
+    if (*ltranl) {
+        t16[4] = tl[tl_dim1 + 2];
+        t16[1] = tl[(tl_dim1 << 1) + 1];
+        t16[14] = tl[tl_dim1 + 2];
+        t16[11] = tl[(tl_dim1 << 1) + 1];
+    } else {
+        t16[4] = tl[(tl_dim1 << 1) + 1];
+        t16[1] = tl[tl_dim1 + 2];
+        t16[14] = tl[(tl_dim1 << 1) + 1];
+        t16[11] = tl[tl_dim1 + 2];
+    }
+    if (*ltranr) {
+        t16[8] = sgn * tr[(tr_dim1 << 1) + 1];
+        t16[13] = sgn * tr[(tr_dim1 << 1) + 1];
+        t16[2] = sgn * tr[tr_dim1 + 2];
+        t16[7] = sgn * tr[tr_dim1 + 2];
+    } else {
+        t16[8] = sgn * tr[tr_dim1 + 2];
+        t16[13] = sgn * tr[tr_dim1 + 2];
+        t16[2] = sgn * tr[(tr_dim1 << 1) + 1];
+        t16[7] = sgn * tr[(tr_dim1 << 1) + 1];
+    }
+    btmp[0] = b[b_dim1 + 1];
+    btmp[1] = b[b_dim1 + 2];
+    btmp[2] = b[(b_dim1 << 1) + 1];
+    btmp[3] = b[(b_dim1 << 1) + 2];
+    for (i__ = 1; i__ <= 3; ++i__) {
+        xmax = 0.;
+        for (ip = i__; ip <= 4; ++ip) {
+            for (jp = i__; jp <= 4; ++jp) {
+                if ((d__1 = t16[ip + (jp << 2) - 5], abs(d__1)) >= xmax) {
+                    xmax = (d__1 = t16[ip + (jp << 2) - 5], abs(d__1));
+                    ipsv = ip;
+                    jpsv = jp;
+                }
+            }
+        }
+        if (ipsv != i__) {
+            dswap_(&c__4, &t16[ipsv - 1], &c__4, &t16[i__ - 1], &c__4);
+            temp = btmp[i__ - 1];
+            btmp[i__ - 1] = btmp[ipsv - 1];
+            btmp[ipsv - 1] = temp;
+        }
+        if (jpsv != i__) {
+            dswap_(&c__4, &t16[(jpsv << 2) - 4], &c__1, &t16[(i__ << 2) - 4], &c__1);
+        }
+        jpiv[i__ - 1] = jpsv;
+        if ((d__1 = t16[i__ + (i__ << 2) - 5], abs(d__1)) < smin) {
+            *info = 1;
+            t16[i__ + (i__ << 2) - 5] = smin;
+        }
+        for (j = i__ + 1; j <= 4; ++j) {
+            t16[j + (i__ << 2) - 5] /= t16[i__ + (i__ << 2) - 5];
+            btmp[j - 1] -= t16[j + (i__ << 2) - 5] * btmp[i__ - 1];
+            for (k = i__ + 1; k <= 4; ++k) {
+                t16[j + (k << 2) - 5] -= t16[j + (i__ << 2) - 5] * t16[i__ + (k << 2) - 5];
+            }
+        }
+    }
+    if (abs(t16[15]) < smin) {
+        *info = 1;
+        t16[15] = smin;
+    }
+    *scale = 1.;
+    if (smlnum * 8. * abs(btmp[0]) > abs(t16[0]) || smlnum * 8. * abs(btmp[1]) > abs(t16[5]) ||
+        smlnum * 8. * abs(btmp[2]) > abs(t16[10]) || smlnum * 8. * abs(btmp[3]) > abs(t16[15])) {
+        d__1 = abs(btmp[0]), d__2 = abs(btmp[1]), d__1 = max(d__1, d__2), d__2 = abs(btmp[2]),
+        d__1 = max(d__1, d__2), d__2 = abs(btmp[3]);
+        *scale = .125 / max(d__1, d__2);
+        btmp[0] *= *scale;
+        btmp[1] *= *scale;
+        btmp[2] *= *scale;
+        btmp[3] *= *scale;
+    }
+    for (i__ = 1; i__ <= 4; ++i__) {
+        k = 5 - i__;
+        temp = 1. / t16[k + (k << 2) - 5];
+        tmp[k - 1] = btmp[k - 1] * temp;
+        for (j = k + 1; j <= 4; ++j) {
+            tmp[k - 1] -= temp * t16[k + (j << 2) - 5] * tmp[j - 1];
+        }
+    }
+    for (i__ = 1; i__ <= 3; ++i__) {
+        if (jpiv[4 - i__ - 1] != 4 - i__) {
+            temp = tmp[4 - i__ - 1];
+            tmp[4 - i__ - 1] = tmp[jpiv[4 - i__ - 1] - 1];
+            tmp[jpiv[4 - i__ - 1] - 1] = temp;
+        }
+    }
+    x[x_dim1 + 1] = tmp[0];
+    x[x_dim1 + 2] = tmp[1];
+    x[(x_dim1 << 1) + 1] = tmp[2];
+    x[(x_dim1 << 1) + 2] = tmp[3];
+    d__1 = abs(tmp[0]) + abs(tmp[2]), d__2 = abs(tmp[1]) + abs(tmp[3]);
+    *xnorm = max(d__1, d__2);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlasyf.cpp

@@ -0,0 +1,337 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static doublereal c_b8 = -1.;
+static doublereal c_b9 = 1.;
+int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb, doublereal *a, integer *lda,
+            integer *ipiv, doublereal *w, integer *ldw, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, w_dim1, w_offset, i__1, i__2, i__3, i__4, i__5;
+    doublereal d__1, d__2, d__3;
+    double sqrt(doublereal);
+    integer j, k;
+    doublereal t, r1, d11, d21, d22;
+    integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax;
+    doublereal alpha;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *),
+        dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen,
+               ftnlen);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
+                      doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen),
+        dcopy_(integer *, doublereal *, integer *, doublereal *, integer *),
+        dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer kstep;
+    doublereal absakk;
+    extern integer idamax_(integer *, doublereal *, integer *);
+    doublereal colmax, rowmax;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    w_dim1 = *ldw;
+    w_offset = 1 + w_dim1;
+    w -= w_offset;
+    *info = 0;
+    alpha = (sqrt(17.) + 1.) / 8.;
+    if (lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1)) {
+        k = *n;
+    L10:
+        kw = *nb + k - *n;
+        if (k <= *n - *nb + 1 && *nb < *n || k < 1) {
+            goto L30;
+        }
+        dcopy_(&k, &a[k * a_dim1 + 1], &c__1, &w[kw * w_dim1 + 1], &c__1);
+        if (k < *n) {
+            i__1 = *n - k;
+            dgemv_((char *)"No transpose", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
+                   &w[k + (kw + 1) * w_dim1], ldw, &c_b9, &w[kw * w_dim1 + 1], &c__1, (ftnlen)12);
+        }
+        kstep = 1;
+        absakk = (d__1 = w[k + kw * w_dim1], abs(d__1));
+        if (k > 1) {
+            i__1 = k - 1;
+            imax = idamax_(&i__1, &w[kw * w_dim1 + 1], &c__1);
+            colmax = (d__1 = w[imax + kw * w_dim1], abs(d__1));
+        } else {
+            colmax = 0.;
+        }
+        if (max(absakk, colmax) == 0.) {
+            if (*info == 0) {
+                *info = k;
+            }
+            kp = k;
+        } else {
+            if (absakk >= alpha * colmax) {
+                kp = k;
+            } else {
+                dcopy_(&imax, &a[imax * a_dim1 + 1], &c__1, &w[(kw - 1) * w_dim1 + 1], &c__1);
+                i__1 = k - imax;
+                dcopy_(&i__1, &a[imax + (imax + 1) * a_dim1], lda, &w[imax + 1 + (kw - 1) * w_dim1],
+                       &c__1);
+                if (k < *n) {
+                    i__1 = *n - k;
+                    dgemv_((char *)"No transpose", &k, &i__1, &c_b8, &a[(k + 1) * a_dim1 + 1], lda,
+                           &w[imax + (kw + 1) * w_dim1], ldw, &c_b9, &w[(kw - 1) * w_dim1 + 1],
+                           &c__1, (ftnlen)12);
+                }
+                i__1 = k - imax;
+                jmax = imax + idamax_(&i__1, &w[imax + 1 + (kw - 1) * w_dim1], &c__1);
+                rowmax = (d__1 = w[jmax + (kw - 1) * w_dim1], abs(d__1));
+                if (imax > 1) {
+                    i__1 = imax - 1;
+                    jmax = idamax_(&i__1, &w[(kw - 1) * w_dim1 + 1], &c__1);
+                    d__2 = rowmax, d__3 = (d__1 = w[jmax + (kw - 1) * w_dim1], abs(d__1));
+                    rowmax = max(d__2, d__3);
+                }
+                if (absakk >= alpha * colmax * (colmax / rowmax)) {
+                    kp = k;
+                } else if ((d__1 = w[imax + (kw - 1) * w_dim1], abs(d__1)) >= alpha * rowmax) {
+                    kp = imax;
+                    dcopy_(&k, &w[(kw - 1) * w_dim1 + 1], &c__1, &w[kw * w_dim1 + 1], &c__1);
+                } else {
+                    kp = imax;
+                    kstep = 2;
+                }
+            }
+            kk = k - kstep + 1;
+            kkw = *nb + kk - *n;
+            if (kp != kk) {
+                a[kp + kp * a_dim1] = a[kk + kk * a_dim1];
+                i__1 = kk - 1 - kp;
+                dcopy_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + (kp + 1) * a_dim1], lda);
+                if (kp > 1) {
+                    i__1 = kp - 1;
+                    dcopy_(&i__1, &a[kk * a_dim1 + 1], &c__1, &a[kp * a_dim1 + 1], &c__1);
+                }
+                if (k < *n) {
+                    i__1 = *n - k;
+                    dswap_(&i__1, &a[kk + (k + 1) * a_dim1], lda, &a[kp + (k + 1) * a_dim1], lda);
+                }
+                i__1 = *n - kk + 1;
+                dswap_(&i__1, &w[kk + kkw * w_dim1], ldw, &w[kp + kkw * w_dim1], ldw);
+            }
+            if (kstep == 1) {
+                dcopy_(&k, &w[kw * w_dim1 + 1], &c__1, &a[k * a_dim1 + 1], &c__1);
+                r1 = 1. / a[k + k * a_dim1];
+                i__1 = k - 1;
+                dscal_(&i__1, &r1, &a[k * a_dim1 + 1], &c__1);
+            } else {
+                if (k > 2) {
+                    d21 = w[k - 1 + kw * w_dim1];
+                    d11 = w[k + kw * w_dim1] / d21;
+                    d22 = w[k - 1 + (kw - 1) * w_dim1] / d21;
+                    t = 1. / (d11 * d22 - 1.);
+                    d21 = t / d21;
+                    i__1 = k - 2;
+                    for (j = 1; j <= i__1; ++j) {
+                        a[j + (k - 1) * a_dim1] =
+                            d21 * (d11 * w[j + (kw - 1) * w_dim1] - w[j + kw * w_dim1]);
+                        a[j + k * a_dim1] =
+                            d21 * (d22 * w[j + kw * w_dim1] - w[j + (kw - 1) * w_dim1]);
+                    }
+                }
+                a[k - 1 + (k - 1) * a_dim1] = w[k - 1 + (kw - 1) * w_dim1];
+                a[k - 1 + k * a_dim1] = w[k - 1 + kw * w_dim1];
+                a[k + k * a_dim1] = w[k + kw * w_dim1];
+            }
+        }
+        if (kstep == 1) {
+            ipiv[k] = kp;
+        } else {
+            ipiv[k] = -kp;
+            ipiv[k - 1] = -kp;
+        }
+        k -= kstep;
+        goto L10;
+    L30:
+        i__1 = -(*nb);
+        for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
+            i__2 = *nb, i__3 = k - j + 1;
+            jb = min(i__2, i__3);
+            i__2 = j + jb - 1;
+            for (jj = j; jj <= i__2; ++jj) {
+                i__3 = jj - j + 1;
+                i__4 = *n - k;
+                dgemv_((char *)"No transpose", &i__3, &i__4, &c_b8, &a[j + (k + 1) * a_dim1], lda,
+                       &w[jj + (kw + 1) * w_dim1], ldw, &c_b9, &a[j + jj * a_dim1], &c__1,
+                       (ftnlen)12);
+            }
+            i__2 = j - 1;
+            i__3 = *n - k;
+            dgemm_((char *)"No transpose", (char *)"Transpose", &i__2, &jb, &i__3, &c_b8, &a[(k + 1) * a_dim1 + 1],
+                   lda, &w[j + (kw + 1) * w_dim1], ldw, &c_b9, &a[j * a_dim1 + 1], lda, (ftnlen)12,
+                   (ftnlen)9);
+        }
+        j = k + 1;
+    L60:
+        jj = j;
+        jp = ipiv[j];
+        if (jp < 0) {
+            jp = -jp;
+            ++j;
+        }
+        ++j;
+        if (jp != jj && j <= *n) {
+            i__1 = *n - j + 1;
+            dswap_(&i__1, &a[jp + j * a_dim1], lda, &a[jj + j * a_dim1], lda);
+        }
+        if (j < *n) {
+            goto L60;
+        }
+        *kb = *n - k;
+    } else {
+        k = 1;
+    L70:
+        if (k >= *nb && *nb < *n || k > *n) {
+            goto L90;
+        }
+        i__1 = *n - k + 1;
+        dcopy_(&i__1, &a[k + k * a_dim1], &c__1, &w[k + k * w_dim1], &c__1);
+        i__1 = *n - k + 1;
+        i__2 = k - 1;
+        dgemv_((char *)"No transpose", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[k + w_dim1], ldw, &c_b9,
+               &w[k + k * w_dim1], &c__1, (ftnlen)12);
+        kstep = 1;
+        absakk = (d__1 = w[k + k * w_dim1], abs(d__1));
+        if (k < *n) {
+            i__1 = *n - k;
+            imax = k + idamax_(&i__1, &w[k + 1 + k * w_dim1], &c__1);
+            colmax = (d__1 = w[imax + k * w_dim1], abs(d__1));
+        } else {
+            colmax = 0.;
+        }
+        if (max(absakk, colmax) == 0.) {
+            if (*info == 0) {
+                *info = k;
+            }
+            kp = k;
+        } else {
+            if (absakk >= alpha * colmax) {
+                kp = k;
+            } else {
+                i__1 = imax - k;
+                dcopy_(&i__1, &a[imax + k * a_dim1], lda, &w[k + (k + 1) * w_dim1], &c__1);
+                i__1 = *n - imax + 1;
+                dcopy_(&i__1, &a[imax + imax * a_dim1], &c__1, &w[imax + (k + 1) * w_dim1], &c__1);
+                i__1 = *n - k + 1;
+                i__2 = k - 1;
+                dgemv_((char *)"No transpose", &i__1, &i__2, &c_b8, &a[k + a_dim1], lda, &w[imax + w_dim1],
+                       ldw, &c_b9, &w[k + (k + 1) * w_dim1], &c__1, (ftnlen)12);
+                i__1 = imax - k;
+                jmax = k - 1 + idamax_(&i__1, &w[k + (k + 1) * w_dim1], &c__1);
+                rowmax = (d__1 = w[jmax + (k + 1) * w_dim1], abs(d__1));
+                if (imax < *n) {
+                    i__1 = *n - imax;
+                    jmax = imax + idamax_(&i__1, &w[imax + 1 + (k + 1) * w_dim1], &c__1);
+                    d__2 = rowmax, d__3 = (d__1 = w[jmax + (k + 1) * w_dim1], abs(d__1));
+                    rowmax = max(d__2, d__3);
+                }
+                if (absakk >= alpha * colmax * (colmax / rowmax)) {
+                    kp = k;
+                } else if ((d__1 = w[imax + (k + 1) * w_dim1], abs(d__1)) >= alpha * rowmax) {
+                    kp = imax;
+                    i__1 = *n - k + 1;
+                    dcopy_(&i__1, &w[k + (k + 1) * w_dim1], &c__1, &w[k + k * w_dim1], &c__1);
+                } else {
+                    kp = imax;
+                    kstep = 2;
+                }
+            }
+            kk = k + kstep - 1;
+            if (kp != kk) {
+                a[kp + kp * a_dim1] = a[kk + kk * a_dim1];
+                i__1 = kp - kk - 1;
+                dcopy_(&i__1, &a[kk + 1 + kk * a_dim1], &c__1, &a[kp + (kk + 1) * a_dim1], lda);
+                if (kp < *n) {
+                    i__1 = *n - kp;
+                    dcopy_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + 1 + kp * a_dim1], &c__1);
+                }
+                if (k > 1) {
+                    i__1 = k - 1;
+                    dswap_(&i__1, &a[kk + a_dim1], lda, &a[kp + a_dim1], lda);
+                }
+                dswap_(&kk, &w[kk + w_dim1], ldw, &w[kp + w_dim1], ldw);
+            }
+            if (kstep == 1) {
+                i__1 = *n - k + 1;
+                dcopy_(&i__1, &w[k + k * w_dim1], &c__1, &a[k + k * a_dim1], &c__1);
+                if (k < *n) {
+                    r1 = 1. / a[k + k * a_dim1];
+                    i__1 = *n - k;
+                    dscal_(&i__1, &r1, &a[k + 1 + k * a_dim1], &c__1);
+                }
+            } else {
+                if (k < *n - 1) {
+                    d21 = w[k + 1 + k * w_dim1];
+                    d11 = w[k + 1 + (k + 1) * w_dim1] / d21;
+                    d22 = w[k + k * w_dim1] / d21;
+                    t = 1. / (d11 * d22 - 1.);
+                    d21 = t / d21;
+                    i__1 = *n;
+                    for (j = k + 2; j <= i__1; ++j) {
+                        a[j + k * a_dim1] =
+                            d21 * (d11 * w[j + k * w_dim1] - w[j + (k + 1) * w_dim1]);
+                        a[j + (k + 1) * a_dim1] =
+                            d21 * (d22 * w[j + (k + 1) * w_dim1] - w[j + k * w_dim1]);
+                    }
+                }
+                a[k + k * a_dim1] = w[k + k * w_dim1];
+                a[k + 1 + k * a_dim1] = w[k + 1 + k * w_dim1];
+                a[k + 1 + (k + 1) * a_dim1] = w[k + 1 + (k + 1) * w_dim1];
+            }
+        }
+        if (kstep == 1) {
+            ipiv[k] = kp;
+        } else {
+            ipiv[k] = -kp;
+            ipiv[k + 1] = -kp;
+        }
+        k += kstep;
+        goto L70;
+    L90:
+        i__1 = *n;
+        i__2 = *nb;
+        for (j = k; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+            i__3 = *nb, i__4 = *n - j + 1;
+            jb = min(i__3, i__4);
+            i__3 = j + jb - 1;
+            for (jj = j; jj <= i__3; ++jj) {
+                i__4 = j + jb - jj;
+                i__5 = k - 1;
+                dgemv_((char *)"No transpose", &i__4, &i__5, &c_b8, &a[jj + a_dim1], lda, &w[jj + w_dim1],
+                       ldw, &c_b9, &a[jj + jj * a_dim1], &c__1, (ftnlen)12);
+            }
+            if (j + jb <= *n) {
+                i__3 = *n - j - jb + 1;
+                i__4 = k - 1;
+                dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &jb, &i__4, &c_b8, &a[j + jb + a_dim1],
+                       lda, &w[j + w_dim1], ldw, &c_b9, &a[j + jb + j * a_dim1], lda, (ftnlen)12,
+                       (ftnlen)9);
+            }
+        }
+        j = k - 1;
+    L120:
+        jj = j;
+        jp = ipiv[j];
+        if (jp < 0) {
+            jp = -jp;
+            --j;
+        }
+        --j;
+        if (jp != jj && j >= 1) {
+            dswap_(&j, &a[jp + a_dim1], lda, &a[jj + a_dim1], lda);
+        }
+        if (j > 1) {
+            goto L120;
+        }
+        *kb = k - 1;
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlauu2.cpp

@@ -0,0 +1,77 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b7 = 1.;
+static integer c__1 = 1;
+int dlauu2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1, i__2, i__3;
+    integer i__;
+    doublereal aii;
+    extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *, integer *);
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
+                      doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen);
+    logical upper;
+    extern int xerbla_(char *, integer *, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLAUU2", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    if (upper) {
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            aii = a[i__ + i__ * a_dim1];
+            if (i__ < *n) {
+                i__2 = *n - i__ + 1;
+                a[i__ + i__ * a_dim1] =
+                    ddot_(&i__2, &a[i__ + i__ * a_dim1], lda, &a[i__ + i__ * a_dim1], lda);
+                i__2 = i__ - 1;
+                i__3 = *n - i__;
+                dgemv_((char *)"No transpose", &i__2, &i__3, &c_b7, &a[(i__ + 1) * a_dim1 + 1], lda,
+                       &a[i__ + (i__ + 1) * a_dim1], lda, &aii, &a[i__ * a_dim1 + 1], &c__1,
+                       (ftnlen)12);
+            } else {
+                dscal_(&i__, &aii, &a[i__ * a_dim1 + 1], &c__1);
+            }
+        }
+    } else {
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            aii = a[i__ + i__ * a_dim1];
+            if (i__ < *n) {
+                i__2 = *n - i__ + 1;
+                a[i__ + i__ * a_dim1] =
+                    ddot_(&i__2, &a[i__ + i__ * a_dim1], &c__1, &a[i__ + i__ * a_dim1], &c__1);
+                i__2 = *n - i__;
+                i__3 = i__ - 1;
+                dgemv_((char *)"Transpose", &i__2, &i__3, &c_b7, &a[i__ + 1 + a_dim1], lda,
+                       &a[i__ + 1 + i__ * a_dim1], &c__1, &aii, &a[i__ + a_dim1], lda, (ftnlen)9);
+            } else {
+                dscal_(&i__, &aii, &a[i__ + a_dim1], lda);
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dlauum.cpp

@@ -0,0 +1,101 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static doublereal c_b15 = 1.;
+int dlauum_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+    integer i__, ib, nb;
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dtrmm_(char *, char *, char *, char *, integer *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen,
+                      ftnlen);
+    logical upper;
+    extern int dsyrk_(char *, char *, integer *, integer *, doublereal *, doublereal *, integer *,
+                      doublereal *, doublereal *, integer *, ftnlen, ftnlen),
+        dlauu2_(char *, integer *, doublereal *, integer *, integer *, ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DLAUUM", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    nb = ilaenv_(&c__1, (char *)"DLAUUM", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+    if (nb <= 1 || nb >= *n) {
+        dlauu2_(uplo, n, &a[a_offset], lda, info, (ftnlen)1);
+    } else {
+        if (upper) {
+            i__1 = *n;
+            i__2 = nb;
+            for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+                i__3 = nb, i__4 = *n - i__ + 1;
+                ib = min(i__3, i__4);
+                i__3 = i__ - 1;
+                dtrmm_((char *)"Right", (char *)"Upper", (char *)"Transpose", (char *)"Non-unit", &i__3, &ib, &c_b15,
+                       &a[i__ + i__ * a_dim1], lda, &a[i__ * a_dim1 + 1], lda, (ftnlen)5, (ftnlen)5,
+                       (ftnlen)9, (ftnlen)8);
+                dlauu2_((char *)"Upper", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
+                if (i__ + ib <= *n) {
+                    i__3 = i__ - 1;
+                    i__4 = *n - i__ - ib + 1;
+                    dgemm_((char *)"No transpose", (char *)"Transpose", &i__3, &ib, &i__4, &c_b15,
+                           &a[(i__ + ib) * a_dim1 + 1], lda, &a[i__ + (i__ + ib) * a_dim1], lda,
+                           &c_b15, &a[i__ * a_dim1 + 1], lda, (ftnlen)12, (ftnlen)9);
+                    i__3 = *n - i__ - ib + 1;
+                    dsyrk_((char *)"Upper", (char *)"No transpose", &ib, &i__3, &c_b15,
+                           &a[i__ + (i__ + ib) * a_dim1], lda, &c_b15, &a[i__ + i__ * a_dim1], lda,
+                           (ftnlen)5, (ftnlen)12);
+                }
+            }
+        } else {
+            i__2 = *n;
+            i__1 = nb;
+            for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
+                i__3 = nb, i__4 = *n - i__ + 1;
+                ib = min(i__3, i__4);
+                i__3 = i__ - 1;
+                dtrmm_((char *)"Left", (char *)"Lower", (char *)"Transpose", (char *)"Non-unit", &ib, &i__3, &c_b15,
+                       &a[i__ + i__ * a_dim1], lda, &a[i__ + a_dim1], lda, (ftnlen)4, (ftnlen)5,
+                       (ftnlen)9, (ftnlen)8);
+                dlauu2_((char *)"Lower", &ib, &a[i__ + i__ * a_dim1], lda, info, (ftnlen)5);
+                if (i__ + ib <= *n) {
+                    i__3 = i__ - 1;
+                    i__4 = *n - i__ - ib + 1;
+                    dgemm_((char *)"Transpose", (char *)"No transpose", &ib, &i__3, &i__4, &c_b15,
+                           &a[i__ + ib + i__ * a_dim1], lda, &a[i__ + ib + a_dim1], lda, &c_b15,
+                           &a[i__ + a_dim1], lda, (ftnlen)9, (ftnlen)12);
+                    i__3 = *n - i__ - ib + 1;
+                    dsyrk_((char *)"Lower", (char *)"Transpose", &ib, &i__3, &c_b15, &a[i__ + ib + i__ * a_dim1],
+                           lda, &c_b15, &a[i__ + i__ * a_dim1], lda, (ftnlen)5, (ftnlen)9);
+                }
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dorghr.cpp

@@ -0,0 +1,94 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+int dorghr_(integer *n, integer *ilo, integer *ihi, doublereal *a, integer *lda, doublereal *tau,
+            doublereal *work, integer *lwork, integer *info)
+{
+    integer a_dim1, a_offset, i__1, i__2;
+    integer i__, j, nb, nh, iinfo;
+    extern int xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int dorgqr_(integer *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       doublereal *, integer *, integer *);
+    integer lwkopt;
+    logical lquery;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --tau;
+    --work;
+    *info = 0;
+    nh = *ihi - *ilo;
+    lquery = *lwork == -1;
+    if (*n < 0) {
+        *info = -1;
+    } else if (*ilo < 1 || *ilo > max(1, *n)) {
+        *info = -2;
+    } else if (*ihi < min(*ilo, *n) || *ihi > *n) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*lwork < max(1, nh) && !lquery) {
+        *info = -8;
+    }
+    if (*info == 0) {
+        nb = ilaenv_(&c__1, (char *)"DORGQR", (char *)" ", &nh, &nh, &nh, &c_n1, (ftnlen)6, (ftnlen)1);
+        lwkopt = max(1, nh) * nb;
+        work[1] = (doublereal)lwkopt;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DORGHR", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    if (*n == 0) {
+        work[1] = 1.;
+        return 0;
+    }
+    i__1 = *ilo + 1;
+    for (j = *ihi; j >= i__1; --j) {
+        i__2 = j - 1;
+        for (i__ = 1; i__ <= i__2; ++i__) {
+            a[i__ + j * a_dim1] = 0.;
+        }
+        i__2 = *ihi;
+        for (i__ = j + 1; i__ <= i__2; ++i__) {
+            a[i__ + j * a_dim1] = a[i__ + (j - 1) * a_dim1];
+        }
+        i__2 = *n;
+        for (i__ = *ihi + 1; i__ <= i__2; ++i__) {
+            a[i__ + j * a_dim1] = 0.;
+        }
+    }
+    i__1 = *ilo;
+    for (j = 1; j <= i__1; ++j) {
+        i__2 = *n;
+        for (i__ = 1; i__ <= i__2; ++i__) {
+            a[i__ + j * a_dim1] = 0.;
+        }
+        a[j + j * a_dim1] = 1.;
+    }
+    i__1 = *n;
+    for (j = *ihi + 1; j <= i__1; ++j) {
+        i__2 = *n;
+        for (i__ = 1; i__ <= i__2; ++i__) {
+            a[i__ + j * a_dim1] = 0.;
+        }
+        a[j + j * a_dim1] = 1.;
+    }
+    if (nh > 0) {
+        dorgqr_(&nh, &nh, &nh, &a[*ilo + 1 + (*ilo + 1) * a_dim1], lda, &tau[*ilo], &work[1], lwork,
+                &iinfo);
+    }
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dormhr.cpp

@@ -0,0 +1,111 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+int dormhr_(char *side, char *trans, integer *m, integer *n, integer *ilo, integer *ihi,
+            doublereal *a, integer *lda, doublereal *tau, doublereal *c__, integer *ldc,
+            doublereal *work, integer *lwork, integer *info, ftnlen side_len, ftnlen trans_len)
+{
+    address a__1[2];
+    integer a_dim1, a_offset, c_dim1, c_offset, i__1[2], i__2;
+    char ch__1[2];
+    int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
+    integer i1, i2, nb, mi, nh, ni, nq, nw;
+    logical left;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    integer iinfo;
+    extern int xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int dormqr_(char *, char *, integer *, integer *, integer *, doublereal *, integer *,
+                       doublereal *, doublereal *, integer *, doublereal *, integer *, integer *,
+                       ftnlen, ftnlen);
+    integer lwkopt;
+    logical lquery;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --tau;
+    c_dim1 = *ldc;
+    c_offset = 1 + c_dim1;
+    c__ -= c_offset;
+    --work;
+    *info = 0;
+    nh = *ihi - *ilo;
+    left = lsame_(side, (char *)"L", (ftnlen)1, (ftnlen)1);
+    lquery = *lwork == -1;
+    if (left) {
+        nq = *m;
+        nw = *n;
+    } else {
+        nq = *n;
+        nw = *m;
+    }
+    if (!left && !lsame_(side, (char *)"R", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (!lsame_(trans, (char *)"N", (ftnlen)1, (ftnlen)1) &&
+               !lsame_(trans, (char *)"T", (ftnlen)1, (ftnlen)1)) {
+        *info = -2;
+    } else if (*m < 0) {
+        *info = -3;
+    } else if (*n < 0) {
+        *info = -4;
+    } else if (*ilo < 1 || *ilo > max(1, nq)) {
+        *info = -5;
+    } else if (*ihi < min(*ilo, nq) || *ihi > nq) {
+        *info = -6;
+    } else if (*lda < max(1, nq)) {
+        *info = -8;
+    } else if (*ldc < max(1, *m)) {
+        *info = -11;
+    } else if (*lwork < max(1, nw) && !lquery) {
+        *info = -13;
+    }
+    if (*info == 0) {
+        if (left) {
+            i__1[0] = 1, a__1[0] = side;
+            i__1[1] = 1, a__1[1] = trans;
+            s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+            nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, &nh, n, &nh, &c_n1, (ftnlen)6, (ftnlen)2);
+        } else {
+            i__1[0] = 1, a__1[0] = side;
+            i__1[1] = 1, a__1[1] = trans;
+            s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+            nb = ilaenv_(&c__1, (char *)"DORMQR", ch__1, m, &nh, &nh, &c_n1, (ftnlen)6, (ftnlen)2);
+        }
+        lwkopt = max(1, nw) * nb;
+        work[1] = (doublereal)lwkopt;
+    }
+    if (*info != 0) {
+        i__2 = -(*info);
+        xerbla_((char *)"DORMHR", &i__2, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    if (*m == 0 || *n == 0 || nh == 0) {
+        work[1] = 1.;
+        return 0;
+    }
+    if (left) {
+        mi = nh;
+        ni = *n;
+        i1 = *ilo + 1;
+        i2 = 1;
+    } else {
+        mi = *m;
+        ni = nh;
+        i1 = 1;
+        i2 = *ilo + 1;
+    }
+    dormqr_(side, trans, &mi, &ni, &nh, &a[*ilo + 1 + *ilo * a_dim1], lda, &tau[*ilo],
+            &c__[i1 + i2 * c_dim1], ldc, &work[1], lwork, &iinfo, (ftnlen)1, (ftnlen)1);
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dpotri.cpp

@@ -0,0 +1,40 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dpotri_(char *uplo, integer *n, doublereal *a, integer *lda, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int xerbla_(char *, integer *, ftnlen),
+        dlauum_(char *, integer *, doublereal *, integer *, integer *, ftnlen),
+        dtrtri_(char *, char *, integer *, doublereal *, integer *, integer *, ftnlen, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    *info = 0;
+    if (!lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DPOTRI", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    dtrtri_(uplo, (char *)"Non-unit", n, &a[a_offset], lda, info, (ftnlen)1, (ftnlen)8);
+    if (*info > 0) {
+        return 0;
+    }
+    dlauum_(uplo, n, &a[a_offset], lda, info, (ftnlen)1);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsyconv.cpp

@@ -0,0 +1,199 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int dsyconv_(char *uplo, char *way, integer *n, doublereal *a, integer *lda, integer *ipiv,
+             doublereal *e, integer *info, ftnlen uplo_len, ftnlen way_len)
+{
+    integer a_dim1, a_offset, i__1;
+    integer i__, j, ip;
+    doublereal temp;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    logical upper;
+    extern int xerbla_(char *, integer *, ftnlen);
+    logical convert;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    --e;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    convert = lsame_(way, (char *)"C", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (!convert && !lsame_(way, (char *)"R", (ftnlen)1, (ftnlen)1)) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYCONV", &i__1, (ftnlen)7);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    if (upper) {
+        if (convert) {
+            i__ = *n;
+            e[1] = 0.;
+            while (i__ > 1) {
+                if (ipiv[i__] < 0) {
+                    e[i__] = a[i__ - 1 + i__ * a_dim1];
+                    e[i__ - 1] = 0.;
+                    a[i__ - 1 + i__ * a_dim1] = 0.;
+                    --i__;
+                } else {
+                    e[i__] = 0.;
+                }
+                --i__;
+            }
+            i__ = *n;
+            while (i__ >= 1) {
+                if (ipiv[i__] > 0) {
+                    ip = ipiv[i__];
+                    if (i__ < *n) {
+                        i__1 = *n;
+                        for (j = i__ + 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ + j * a_dim1];
+                            a[i__ + j * a_dim1] = temp;
+                        }
+                    }
+                } else {
+                    ip = -ipiv[i__];
+                    if (i__ < *n) {
+                        i__1 = *n;
+                        for (j = i__ + 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ - 1 + j * a_dim1];
+                            a[i__ - 1 + j * a_dim1] = temp;
+                        }
+                    }
+                    --i__;
+                }
+                --i__;
+            }
+        } else {
+            i__ = 1;
+            while (i__ <= *n) {
+                if (ipiv[i__] > 0) {
+                    ip = ipiv[i__];
+                    if (i__ < *n) {
+                        i__1 = *n;
+                        for (j = i__ + 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ + j * a_dim1];
+                            a[i__ + j * a_dim1] = temp;
+                        }
+                    }
+                } else {
+                    ip = -ipiv[i__];
+                    ++i__;
+                    if (i__ < *n) {
+                        i__1 = *n;
+                        for (j = i__ + 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ - 1 + j * a_dim1];
+                            a[i__ - 1 + j * a_dim1] = temp;
+                        }
+                    }
+                }
+                ++i__;
+            }
+            i__ = *n;
+            while (i__ > 1) {
+                if (ipiv[i__] < 0) {
+                    a[i__ - 1 + i__ * a_dim1] = e[i__];
+                    --i__;
+                }
+                --i__;
+            }
+        }
+    } else {
+        if (convert) {
+            i__ = 1;
+            e[*n] = 0.;
+            while (i__ <= *n) {
+                if (i__ < *n && ipiv[i__] < 0) {
+                    e[i__] = a[i__ + 1 + i__ * a_dim1];
+                    e[i__ + 1] = 0.;
+                    a[i__ + 1 + i__ * a_dim1] = 0.;
+                    ++i__;
+                } else {
+                    e[i__] = 0.;
+                }
+                ++i__;
+            }
+            i__ = 1;
+            while (i__ <= *n) {
+                if (ipiv[i__] > 0) {
+                    ip = ipiv[i__];
+                    if (i__ > 1) {
+                        i__1 = i__ - 1;
+                        for (j = 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ + j * a_dim1];
+                            a[i__ + j * a_dim1] = temp;
+                        }
+                    }
+                } else {
+                    ip = -ipiv[i__];
+                    if (i__ > 1) {
+                        i__1 = i__ - 1;
+                        for (j = 1; j <= i__1; ++j) {
+                            temp = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = a[i__ + 1 + j * a_dim1];
+                            a[i__ + 1 + j * a_dim1] = temp;
+                        }
+                    }
+                    ++i__;
+                }
+                ++i__;
+            }
+        } else {
+            i__ = *n;
+            while (i__ >= 1) {
+                if (ipiv[i__] > 0) {
+                    ip = ipiv[i__];
+                    if (i__ > 1) {
+                        i__1 = i__ - 1;
+                        for (j = 1; j <= i__1; ++j) {
+                            temp = a[i__ + j * a_dim1];
+                            a[i__ + j * a_dim1] = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = temp;
+                        }
+                    }
+                } else {
+                    ip = -ipiv[i__];
+                    --i__;
+                    if (i__ > 1) {
+                        i__1 = i__ - 1;
+                        for (j = 1; j <= i__1; ++j) {
+                            temp = a[i__ + 1 + j * a_dim1];
+                            a[i__ + 1 + j * a_dim1] = a[ip + j * a_dim1];
+                            a[ip + j * a_dim1] = temp;
+                        }
+                    }
+                }
+                --i__;
+            }
+            i__ = 1;
+            while (i__ <= *n - 1) {
+                if (ipiv[i__] < 0) {
+                    a[i__ + 1 + i__ * a_dim1] = e[i__];
+                    ++i__;
+                }
+                ++i__;
+            }
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsyr.cpp

@@ -0,0 +1,167 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c_n1 = -1;
+int dsyr_(char *uplo, integer *n, doublereal *alpha, doublereal *x, integer *incx, doublereal *a,
+          integer *lda, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1, i__2;
+    integer i__, j, ix, jx, kx, info;
+    doublereal temp;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int xerbla_(char *, integer *, ftnlen);
+    --x;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    info = 0;
+    if (!lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        info = 1;
+    } else if (*n < 0) {
+        info = 2;
+    } else if (*incx == 0) {
+        info = 5;
+    } else if (*lda < max(1, *n)) {
+        info = 7;
+    }
+    if (info != 0) {
+        xerbla_((char *)"DSYR  ", &info, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0 || *alpha == 0.) {
+        return 0;
+    }
+    if (*incx <= 0) {
+        kx = 1 - (*n - 1) * *incx;
+    } else if (*incx != 1) {
+        kx = 1;
+    }
+    if (lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1)) {
+        if (*incx == 1) {
+            i__1 = *n;
+            for (j = 1; j <= i__1; ++j) {
+                if (x[j] != 0.) {
+                    temp = *alpha * x[j];
+                    i__2 = j;
+                    for (i__ = 1; i__ <= i__2; ++i__) {
+                        a[i__ + j * a_dim1] += x[i__] * temp;
+                    }
+                }
+            }
+        } else {
+            jx = kx;
+            i__1 = *n;
+            for (j = 1; j <= i__1; ++j) {
+                if (x[jx] != 0.) {
+                    temp = *alpha * x[jx];
+                    ix = kx;
+                    i__2 = j;
+                    for (i__ = 1; i__ <= i__2; ++i__) {
+                        a[i__ + j * a_dim1] += x[ix] * temp;
+                        ix += *incx;
+                    }
+                }
+                jx += *incx;
+            }
+        }
+    } else {
+        if (*incx == 1) {
+            i__1 = *n;
+            for (j = 1; j <= i__1; ++j) {
+                if (x[j] != 0.) {
+                    temp = *alpha * x[j];
+                    i__2 = *n;
+                    for (i__ = j; i__ <= i__2; ++i__) {
+                        a[i__ + j * a_dim1] += x[i__] * temp;
+                    }
+                }
+            }
+        } else {
+            jx = kx;
+            i__1 = *n;
+            for (j = 1; j <= i__1; ++j) {
+                if (x[jx] != 0.) {
+                    temp = *alpha * x[jx];
+                    ix = jx;
+                    i__2 = *n;
+                    for (i__ = j; i__ <= i__2; ++i__) {
+                        a[i__ + j * a_dim1] += x[ix] * temp;
+                        ix += *incx;
+                    }
+                }
+                jx += *incx;
+            }
+        }
+    }
+    return 0;
+}
+int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv,
+           doublereal *b, integer *ldb, doublereal *work, integer *lwork, integer *info,
+           ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int xerbla_(char *, integer *, ftnlen),
+        dsytrf_(char *, integer *, doublereal *, integer *, integer *, doublereal *, integer *,
+                integer *, ftnlen);
+    integer lwkopt;
+    logical lquery;
+    extern int dsytrs_(char *, integer *, integer *, doublereal *, integer *, integer *,
+                       doublereal *, integer *, integer *, ftnlen),
+        dsytrs2_(char *, integer *, integer *, doublereal *, integer *, integer *, doublereal *,
+                 integer *, doublereal *, integer *, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    --work;
+    *info = 0;
+    lquery = *lwork == -1;
+    if (!lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*nrhs < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*ldb < max(1, *n)) {
+        *info = -8;
+    } else if (*lwork < 1 && !lquery) {
+        *info = -10;
+    }
+    if (*info == 0) {
+        if (*n == 0) {
+            lwkopt = 1;
+        } else {
+            dsytrf_(uplo, n, &a[a_offset], lda, &ipiv[1], &work[1], &c_n1, info, (ftnlen)1);
+            lwkopt = (integer)work[1];
+        }
+        work[1] = (doublereal)lwkopt;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYSV ", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    dsytrf_(uplo, n, &a[a_offset], lda, &ipiv[1], &work[1], lwork, info, (ftnlen)1);
+    if (*info == 0) {
+        if (*lwork < *n) {
+            dsytrs_(uplo, n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, info, (ftnlen)1);
+        } else {
+            dsytrs2_(uplo, n, nrhs, &a[a_offset], lda, &ipiv[1], &b[b_offset], ldb, &work[1], info,
+                     (ftnlen)1);
+        }
+    }
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsytf2.cpp

@@ -0,0 +1,246 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+int dsytf2_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipiv, integer *info,
+            ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1, i__2;
+    doublereal d__1, d__2, d__3;
+    double sqrt(doublereal);
+    integer i__, j, k;
+    doublereal t, r1, d11, d12, d21, d22;
+    integer kk, kp;
+    doublereal wk, wkm1, wkp1;
+    integer imax, jmax;
+    extern int dsyr_(char *, integer *, doublereal *, doublereal *, integer *, doublereal *,
+                     integer *, ftnlen);
+    doublereal alpha;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    integer kstep;
+    logical upper;
+    doublereal absakk;
+    extern integer idamax_(integer *, doublereal *, integer *);
+    extern logical disnan_(doublereal *);
+    extern int xerbla_(char *, integer *, ftnlen);
+    doublereal colmax, rowmax;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYTF2", &i__1, (ftnlen)6);
+        return 0;
+    }
+    alpha = (sqrt(17.) + 1.) / 8.;
+    if (upper) {
+        k = *n;
+    L10:
+        if (k < 1) {
+            goto L70;
+        }
+        kstep = 1;
+        absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
+        if (k > 1) {
+            i__1 = k - 1;
+            imax = idamax_(&i__1, &a[k * a_dim1 + 1], &c__1);
+            colmax = (d__1 = a[imax + k * a_dim1], abs(d__1));
+        } else {
+            colmax = 0.;
+        }
+        if (max(absakk, colmax) == 0. || disnan_(&absakk)) {
+            if (*info == 0) {
+                *info = k;
+            }
+            kp = k;
+        } else {
+            if (absakk >= alpha * colmax) {
+                kp = k;
+            } else {
+                i__1 = k - imax;
+                jmax = imax + idamax_(&i__1, &a[imax + (imax + 1) * a_dim1], lda);
+                rowmax = (d__1 = a[imax + jmax * a_dim1], abs(d__1));
+                if (imax > 1) {
+                    i__1 = imax - 1;
+                    jmax = idamax_(&i__1, &a[imax * a_dim1 + 1], &c__1);
+                    d__2 = rowmax, d__3 = (d__1 = a[jmax + imax * a_dim1], abs(d__1));
+                    rowmax = max(d__2, d__3);
+                }
+                if (absakk >= alpha * colmax * (colmax / rowmax)) {
+                    kp = k;
+                } else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >= alpha * rowmax) {
+                    kp = imax;
+                } else {
+                    kp = imax;
+                    kstep = 2;
+                }
+            }
+            kk = k - kstep + 1;
+            if (kp != kk) {
+                i__1 = kp - 1;
+                dswap_(&i__1, &a[kk * a_dim1 + 1], &c__1, &a[kp * a_dim1 + 1], &c__1);
+                i__1 = kk - kp - 1;
+                dswap_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + (kp + 1) * a_dim1], lda);
+                t = a[kk + kk * a_dim1];
+                a[kk + kk * a_dim1] = a[kp + kp * a_dim1];
+                a[kp + kp * a_dim1] = t;
+                if (kstep == 2) {
+                    t = a[k - 1 + k * a_dim1];
+                    a[k - 1 + k * a_dim1] = a[kp + k * a_dim1];
+                    a[kp + k * a_dim1] = t;
+                }
+            }
+            if (kstep == 1) {
+                r1 = 1. / a[k + k * a_dim1];
+                i__1 = k - 1;
+                d__1 = -r1;
+                dsyr_(uplo, &i__1, &d__1, &a[k * a_dim1 + 1], &c__1, &a[a_offset], lda, (ftnlen)1);
+                i__1 = k - 1;
+                dscal_(&i__1, &r1, &a[k * a_dim1 + 1], &c__1);
+            } else {
+                if (k > 2) {
+                    d12 = a[k - 1 + k * a_dim1];
+                    d22 = a[k - 1 + (k - 1) * a_dim1] / d12;
+                    d11 = a[k + k * a_dim1] / d12;
+                    t = 1. / (d11 * d22 - 1.);
+                    d12 = t / d12;
+                    for (j = k - 2; j >= 1; --j) {
+                        wkm1 = d12 * (d11 * a[j + (k - 1) * a_dim1] - a[j + k * a_dim1]);
+                        wk = d12 * (d22 * a[j + k * a_dim1] - a[j + (k - 1) * a_dim1]);
+                        for (i__ = j; i__ >= 1; --i__) {
+                            a[i__ + j * a_dim1] = a[i__ + j * a_dim1] - a[i__ + k * a_dim1] * wk -
+                                                  a[i__ + (k - 1) * a_dim1] * wkm1;
+                        }
+                        a[j + k * a_dim1] = wk;
+                        a[j + (k - 1) * a_dim1] = wkm1;
+                    }
+                }
+            }
+        }
+        if (kstep == 1) {
+            ipiv[k] = kp;
+        } else {
+            ipiv[k] = -kp;
+            ipiv[k - 1] = -kp;
+        }
+        k -= kstep;
+        goto L10;
+    } else {
+        k = 1;
+    L40:
+        if (k > *n) {
+            goto L70;
+        }
+        kstep = 1;
+        absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
+        if (k < *n) {
+            i__1 = *n - k;
+            imax = k + idamax_(&i__1, &a[k + 1 + k * a_dim1], &c__1);
+            colmax = (d__1 = a[imax + k * a_dim1], abs(d__1));
+        } else {
+            colmax = 0.;
+        }
+        if (max(absakk, colmax) == 0. || disnan_(&absakk)) {
+            if (*info == 0) {
+                *info = k;
+            }
+            kp = k;
+        } else {
+            if (absakk >= alpha * colmax) {
+                kp = k;
+            } else {
+                i__1 = imax - k;
+                jmax = k - 1 + idamax_(&i__1, &a[imax + k * a_dim1], lda);
+                rowmax = (d__1 = a[imax + jmax * a_dim1], abs(d__1));
+                if (imax < *n) {
+                    i__1 = *n - imax;
+                    jmax = imax + idamax_(&i__1, &a[imax + 1 + imax * a_dim1], &c__1);
+                    d__2 = rowmax, d__3 = (d__1 = a[jmax + imax * a_dim1], abs(d__1));
+                    rowmax = max(d__2, d__3);
+                }
+                if (absakk >= alpha * colmax * (colmax / rowmax)) {
+                    kp = k;
+                } else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >= alpha * rowmax) {
+                    kp = imax;
+                } else {
+                    kp = imax;
+                    kstep = 2;
+                }
+            }
+            kk = k + kstep - 1;
+            if (kp != kk) {
+                if (kp < *n) {
+                    i__1 = *n - kp;
+                    dswap_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + 1 + kp * a_dim1], &c__1);
+                }
+                i__1 = kp - kk - 1;
+                dswap_(&i__1, &a[kk + 1 + kk * a_dim1], &c__1, &a[kp + (kk + 1) * a_dim1], lda);
+                t = a[kk + kk * a_dim1];
+                a[kk + kk * a_dim1] = a[kp + kp * a_dim1];
+                a[kp + kp * a_dim1] = t;
+                if (kstep == 2) {
+                    t = a[k + 1 + k * a_dim1];
+                    a[k + 1 + k * a_dim1] = a[kp + k * a_dim1];
+                    a[kp + k * a_dim1] = t;
+                }
+            }
+            if (kstep == 1) {
+                if (k < *n) {
+                    d11 = 1. / a[k + k * a_dim1];
+                    i__1 = *n - k;
+                    d__1 = -d11;
+                    dsyr_(uplo, &i__1, &d__1, &a[k + 1 + k * a_dim1], &c__1,
+                          &a[k + 1 + (k + 1) * a_dim1], lda, (ftnlen)1);
+                    i__1 = *n - k;
+                    dscal_(&i__1, &d11, &a[k + 1 + k * a_dim1], &c__1);
+                }
+            } else {
+                if (k < *n - 1) {
+                    d21 = a[k + 1 + k * a_dim1];
+                    d11 = a[k + 1 + (k + 1) * a_dim1] / d21;
+                    d22 = a[k + k * a_dim1] / d21;
+                    t = 1. / (d11 * d22 - 1.);
+                    d21 = t / d21;
+                    i__1 = *n;
+                    for (j = k + 2; j <= i__1; ++j) {
+                        wk = d21 * (d11 * a[j + k * a_dim1] - a[j + (k + 1) * a_dim1]);
+                        wkp1 = d21 * (d22 * a[j + (k + 1) * a_dim1] - a[j + k * a_dim1]);
+                        i__2 = *n;
+                        for (i__ = j; i__ <= i__2; ++i__) {
+                            a[i__ + j * a_dim1] = a[i__ + j * a_dim1] - a[i__ + k * a_dim1] * wk -
+                                                  a[i__ + (k + 1) * a_dim1] * wkp1;
+                        }
+                        a[j + k * a_dim1] = wk;
+                        a[j + (k + 1) * a_dim1] = wkp1;
+                    }
+                }
+            }
+        }
+        if (kstep == 1) {
+            ipiv[k] = kp;
+        } else {
+            ipiv[k] = -kp;
+            ipiv[k + 1] = -kp;
+        }
+        k += kstep;
+        goto L40;
+    }
+L70:
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsytrf.cpp

@@ -0,0 +1,123 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+int dsytrf_(char *uplo, integer *n, doublereal *a, integer *lda, integer *ipiv, doublereal *work,
+            integer *lwork, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, i__1, i__2;
+    integer j, k, kb, nb, iws;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    integer nbmin, iinfo;
+    logical upper;
+    extern int dsytf2_(char *, integer *, doublereal *, integer *, integer *, integer *, ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int dlasyf_(char *, integer *, integer *, integer *, doublereal *, integer *, integer *,
+                       doublereal *, integer *, integer *, ftnlen);
+    integer ldwork, lwkopt;
+    logical lquery;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    --work;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    lquery = *lwork == -1;
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*lda < max(1, *n)) {
+        *info = -4;
+    } else if (*lwork < 1 && !lquery) {
+        *info = -7;
+    }
+    if (*info == 0) {
+        nb = ilaenv_(&c__1, (char *)"DSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+        lwkopt = *n * nb;
+        work[1] = (doublereal)lwkopt;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYTRF", &i__1, (ftnlen)6);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    nbmin = 2;
+    ldwork = *n;
+    if (nb > 1 && nb < *n) {
+        iws = ldwork * nb;
+        if (*lwork < iws) {
+            i__1 = *lwork / ldwork;
+            nb = max(i__1, 1);
+            i__1 = 2,
+            i__2 = ilaenv_(&c__2, (char *)"DSYTRF", uplo, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)1);
+            nbmin = max(i__1, i__2);
+        }
+    } else {
+        iws = 1;
+    }
+    if (nb < nbmin) {
+        nb = *n;
+    }
+    if (upper) {
+        k = *n;
+    L10:
+        if (k < 1) {
+            goto L40;
+        }
+        if (k > nb) {
+            dlasyf_(uplo, &k, &nb, &kb, &a[a_offset], lda, &ipiv[1], &work[1], &ldwork, &iinfo,
+                    (ftnlen)1);
+        } else {
+            dsytf2_(uplo, &k, &a[a_offset], lda, &ipiv[1], &iinfo, (ftnlen)1);
+            kb = k;
+        }
+        if (*info == 0 && iinfo > 0) {
+            *info = iinfo;
+        }
+        k -= kb;
+        goto L10;
+    } else {
+        k = 1;
+    L20:
+        if (k > *n) {
+            goto L40;
+        }
+        if (k <= *n - nb) {
+            i__1 = *n - k + 1;
+            dlasyf_(uplo, &i__1, &nb, &kb, &a[k + k * a_dim1], lda, &ipiv[k], &work[1], &ldwork,
+                    &iinfo, (ftnlen)1);
+        } else {
+            i__1 = *n - k + 1;
+            dsytf2_(uplo, &i__1, &a[k + k * a_dim1], lda, &ipiv[k], &iinfo, (ftnlen)1);
+            kb = *n - k + 1;
+        }
+        if (*info == 0 && iinfo > 0) {
+            *info = iinfo + k - 1;
+        }
+        i__1 = k + kb - 1;
+        for (j = k; j <= i__1; ++j) {
+            if (ipiv[j] > 0) {
+                ipiv[j] = ipiv[j] + k - 1;
+            } else {
+                ipiv[j] = ipiv[j] - k + 1;
+            }
+        }
+        k += kb;
+        goto L20;
+    }
+L40:
+    work[1] = (doublereal)lwkopt;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsytrs.cpp

@@ -0,0 +1,214 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b7 = -1.;
+static integer c__1 = 1;
+static doublereal c_b19 = 1.;
+int dsytrs_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv,
+            doublereal *b, integer *ldb, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+    doublereal d__1;
+    integer j, k;
+    doublereal ak, bk;
+    integer kp;
+    doublereal akm1, bkm1;
+    extern int dger_(integer *, integer *, doublereal *, doublereal *, integer *, doublereal *,
+                     integer *, doublereal *, integer *);
+    doublereal akm1k;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    doublereal denom;
+    extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
+                      doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen),
+        dswap_(integer *, doublereal *, integer *, doublereal *, integer *);
+    logical upper;
+    extern int xerbla_(char *, integer *, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*nrhs < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*ldb < max(1, *n)) {
+        *info = -8;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYTRS", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0 || *nrhs == 0) {
+        return 0;
+    }
+    if (upper) {
+        k = *n;
+    L10:
+        if (k < 1) {
+            goto L30;
+        }
+        if (ipiv[k] > 0) {
+            kp = ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            i__1 = k - 1;
+            dger_(&i__1, nrhs, &c_b7, &a[k * a_dim1 + 1], &c__1, &b[k + b_dim1], ldb,
+                  &b[b_dim1 + 1], ldb);
+            d__1 = 1. / a[k + k * a_dim1];
+            dscal_(nrhs, &d__1, &b[k + b_dim1], ldb);
+            --k;
+        } else {
+            kp = -ipiv[k];
+            if (kp != k - 1) {
+                dswap_(nrhs, &b[k - 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            i__1 = k - 2;
+            dger_(&i__1, nrhs, &c_b7, &a[k * a_dim1 + 1], &c__1, &b[k + b_dim1], ldb,
+                  &b[b_dim1 + 1], ldb);
+            i__1 = k - 2;
+            dger_(&i__1, nrhs, &c_b7, &a[(k - 1) * a_dim1 + 1], &c__1, &b[k - 1 + b_dim1], ldb,
+                  &b[b_dim1 + 1], ldb);
+            akm1k = a[k - 1 + k * a_dim1];
+            akm1 = a[k - 1 + (k - 1) * a_dim1] / akm1k;
+            ak = a[k + k * a_dim1] / akm1k;
+            denom = akm1 * ak - 1.;
+            i__1 = *nrhs;
+            for (j = 1; j <= i__1; ++j) {
+                bkm1 = b[k - 1 + j * b_dim1] / akm1k;
+                bk = b[k + j * b_dim1] / akm1k;
+                b[k - 1 + j * b_dim1] = (ak * bkm1 - bk) / denom;
+                b[k + j * b_dim1] = (akm1 * bk - bkm1) / denom;
+            }
+            k += -2;
+        }
+        goto L10;
+    L30:
+        k = 1;
+    L40:
+        if (k > *n) {
+            goto L50;
+        }
+        if (ipiv[k] > 0) {
+            i__1 = k - 1;
+            dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1,
+                   &c_b19, &b[k + b_dim1], ldb, (ftnlen)9);
+            kp = ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            ++k;
+        } else {
+            i__1 = k - 1;
+            dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[k * a_dim1 + 1], &c__1,
+                   &c_b19, &b[k + b_dim1], ldb, (ftnlen)9);
+            i__1 = k - 1;
+            dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[b_offset], ldb, &a[(k + 1) * a_dim1 + 1],
+                   &c__1, &c_b19, &b[k + 1 + b_dim1], ldb, (ftnlen)9);
+            kp = -ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            k += 2;
+        }
+        goto L40;
+    L50:;
+    } else {
+        k = 1;
+    L60:
+        if (k > *n) {
+            goto L80;
+        }
+        if (ipiv[k] > 0) {
+            kp = ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            if (k < *n) {
+                i__1 = *n - k;
+                dger_(&i__1, nrhs, &c_b7, &a[k + 1 + k * a_dim1], &c__1, &b[k + b_dim1], ldb,
+                      &b[k + 1 + b_dim1], ldb);
+            }
+            d__1 = 1. / a[k + k * a_dim1];
+            dscal_(nrhs, &d__1, &b[k + b_dim1], ldb);
+            ++k;
+        } else {
+            kp = -ipiv[k];
+            if (kp != k + 1) {
+                dswap_(nrhs, &b[k + 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            if (k < *n - 1) {
+                i__1 = *n - k - 1;
+                dger_(&i__1, nrhs, &c_b7, &a[k + 2 + k * a_dim1], &c__1, &b[k + b_dim1], ldb,
+                      &b[k + 2 + b_dim1], ldb);
+                i__1 = *n - k - 1;
+                dger_(&i__1, nrhs, &c_b7, &a[k + 2 + (k + 1) * a_dim1], &c__1, &b[k + 1 + b_dim1],
+                      ldb, &b[k + 2 + b_dim1], ldb);
+            }
+            akm1k = a[k + 1 + k * a_dim1];
+            akm1 = a[k + k * a_dim1] / akm1k;
+            ak = a[k + 1 + (k + 1) * a_dim1] / akm1k;
+            denom = akm1 * ak - 1.;
+            i__1 = *nrhs;
+            for (j = 1; j <= i__1; ++j) {
+                bkm1 = b[k + j * b_dim1] / akm1k;
+                bk = b[k + 1 + j * b_dim1] / akm1k;
+                b[k + j * b_dim1] = (ak * bkm1 - bk) / denom;
+                b[k + 1 + j * b_dim1] = (akm1 * bk - bkm1) / denom;
+            }
+            k += 2;
+        }
+        goto L60;
+    L80:
+        k = *n;
+    L90:
+        if (k < 1) {
+            goto L100;
+        }
+        if (ipiv[k] > 0) {
+            if (k < *n) {
+                i__1 = *n - k;
+                dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb,
+                       &a[k + 1 + k * a_dim1], &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)9);
+            }
+            kp = ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            --k;
+        } else {
+            if (k < *n) {
+                i__1 = *n - k;
+                dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb,
+                       &a[k + 1 + k * a_dim1], &c__1, &c_b19, &b[k + b_dim1], ldb, (ftnlen)9);
+                i__1 = *n - k;
+                dgemv_((char *)"Transpose", &i__1, nrhs, &c_b7, &b[k + 1 + b_dim1], ldb,
+                       &a[k + 1 + (k - 1) * a_dim1], &c__1, &c_b19, &b[k - 1 + b_dim1], ldb,
+                       (ftnlen)9);
+            }
+            kp = -ipiv[k];
+            if (kp != k) {
+                dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+            }
+            k += -2;
+        }
+        goto L90;
+    L100:;
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dsytrs2.cpp

@@ -0,0 +1,180 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b10 = 1.;
+int dsytrs2_(char *uplo, integer *n, integer *nrhs, doublereal *a, integer *lda, integer *ipiv,
+             doublereal *b, integer *ldb, doublereal *work, integer *info, ftnlen uplo_len)
+{
+    integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+    doublereal d__1;
+    integer i__, j, k;
+    doublereal ak, bk;
+    integer kp;
+    doublereal akm1, bkm1, akm1k;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    doublereal denom;
+    integer iinfo;
+    extern int dswap_(integer *, doublereal *, integer *, doublereal *, integer *),
+        dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *, doublereal *,
+               integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen, ftnlen);
+    logical upper;
+    extern int xerbla_(char *, integer *, ftnlen),
+        dsyconv_(char *, char *, integer *, doublereal *, integer *, integer *, doublereal *,
+                 integer *, ftnlen, ftnlen);
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    --ipiv;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    --work;
+    *info = 0;
+    upper = lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1);
+    if (!upper && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*nrhs < 0) {
+        *info = -3;
+    } else if (*lda < max(1, *n)) {
+        *info = -5;
+    } else if (*ldb < max(1, *n)) {
+        *info = -8;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DSYTRS2", &i__1, (ftnlen)7);
+        return 0;
+    }
+    if (*n == 0 || *nrhs == 0) {
+        return 0;
+    }
+    dsyconv_(uplo, (char *)"C", n, &a[a_offset], lda, &ipiv[1], &work[1], &iinfo, (ftnlen)1, (ftnlen)1);
+    if (upper) {
+        k = *n;
+        while (k >= 1) {
+            if (ipiv[k] > 0) {
+                kp = ipiv[k];
+                if (kp != k) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                --k;
+            } else {
+                kp = -ipiv[k];
+                if (kp == -ipiv[k - 1]) {
+                    dswap_(nrhs, &b[k - 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                k += -2;
+            }
+        }
+        dtrsm_((char *)"L", (char *)"U", (char *)"N", (char *)"U", n, nrhs, &c_b10, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
+               (ftnlen)1, (ftnlen)1, (ftnlen)1);
+        i__ = *n;
+        while (i__ >= 1) {
+            if (ipiv[i__] > 0) {
+                d__1 = 1. / a[i__ + i__ * a_dim1];
+                dscal_(nrhs, &d__1, &b[i__ + b_dim1], ldb);
+            } else if (i__ > 1) {
+                if (ipiv[i__ - 1] == ipiv[i__]) {
+                    akm1k = work[i__];
+                    akm1 = a[i__ - 1 + (i__ - 1) * a_dim1] / akm1k;
+                    ak = a[i__ + i__ * a_dim1] / akm1k;
+                    denom = akm1 * ak - 1.;
+                    i__1 = *nrhs;
+                    for (j = 1; j <= i__1; ++j) {
+                        bkm1 = b[i__ - 1 + j * b_dim1] / akm1k;
+                        bk = b[i__ + j * b_dim1] / akm1k;
+                        b[i__ - 1 + j * b_dim1] = (ak * bkm1 - bk) / denom;
+                        b[i__ + j * b_dim1] = (akm1 * bk - bkm1) / denom;
+                    }
+                    --i__;
+                }
+            }
+            --i__;
+        }
+        dtrsm_((char *)"L", (char *)"U", (char *)"T", (char *)"U", n, nrhs, &c_b10, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
+               (ftnlen)1, (ftnlen)1, (ftnlen)1);
+        k = 1;
+        while (k <= *n) {
+            if (ipiv[k] > 0) {
+                kp = ipiv[k];
+                if (kp != k) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                ++k;
+            } else {
+                kp = -ipiv[k];
+                if (k < *n && kp == -ipiv[k + 1]) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                k += 2;
+            }
+        }
+    } else {
+        k = 1;
+        while (k <= *n) {
+            if (ipiv[k] > 0) {
+                kp = ipiv[k];
+                if (kp != k) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                ++k;
+            } else {
+                kp = -ipiv[k + 1];
+                if (kp == -ipiv[k]) {
+                    dswap_(nrhs, &b[k + 1 + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                k += 2;
+            }
+        }
+        dtrsm_((char *)"L", (char *)"L", (char *)"N", (char *)"U", n, nrhs, &c_b10, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
+               (ftnlen)1, (ftnlen)1, (ftnlen)1);
+        i__ = 1;
+        while (i__ <= *n) {
+            if (ipiv[i__] > 0) {
+                d__1 = 1. / a[i__ + i__ * a_dim1];
+                dscal_(nrhs, &d__1, &b[i__ + b_dim1], ldb);
+            } else {
+                akm1k = work[i__];
+                akm1 = a[i__ + i__ * a_dim1] / akm1k;
+                ak = a[i__ + 1 + (i__ + 1) * a_dim1] / akm1k;
+                denom = akm1 * ak - 1.;
+                i__1 = *nrhs;
+                for (j = 1; j <= i__1; ++j) {
+                    bkm1 = b[i__ + j * b_dim1] / akm1k;
+                    bk = b[i__ + 1 + j * b_dim1] / akm1k;
+                    b[i__ + j * b_dim1] = (ak * bkm1 - bk) / denom;
+                    b[i__ + 1 + j * b_dim1] = (akm1 * bk - bkm1) / denom;
+                }
+                ++i__;
+            }
+            ++i__;
+        }
+        dtrsm_((char *)"L", (char *)"L", (char *)"T", (char *)"U", n, nrhs, &c_b10, &a[a_offset], lda, &b[b_offset], ldb, (ftnlen)1,
+               (ftnlen)1, (ftnlen)1, (ftnlen)1);
+        k = *n;
+        while (k >= 1) {
+            if (ipiv[k] > 0) {
+                kp = ipiv[k];
+                if (kp != k) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                --k;
+            } else {
+                kp = -ipiv[k];
+                if (k > 1 && kp == -ipiv[k - 1]) {
+                    dswap_(nrhs, &b[k + b_dim1], ldb, &b[kp + b_dim1], ldb);
+                }
+                k += -2;
+            }
+        }
+    }
+    dsyconv_(uplo, (char *)"R", n, &a[a_offset], lda, &ipiv[1], &work[1], &iinfo, (ftnlen)1, (ftnlen)1);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dtrevc3.cpp

@@ -0,0 +1,858 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static doublereal c_b17 = 0.;
+static logical c_false = FALSE_;
+static doublereal c_b29 = 1.;
+static logical c_true = TRUE_;
+int dtrevc3_(char *side, char *howmny, logical *select, integer *n, doublereal *t, integer *ldt,
+             doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, integer *mm, integer *m,
+             doublereal *work, integer *lwork, integer *info, ftnlen side_len, ftnlen howmny_len)
+{
+    address a__1[2];
+    integer t_dim1, t_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1[2], i__2, i__3, i__4;
+    doublereal d__1, d__2, d__3, d__4;
+    char ch__1[2];
+    int s_lmp_cat(char *, char **, integer *, integer *, ftnlen);
+    double sqrt(doublereal);
+    integer i__, j, k;
+    doublereal x[4];
+    integer j1, j2, iscomplex[128], nb, ii, ki, ip, is, iv;
+    doublereal wi, wr;
+    integer ki2;
+    doublereal rec, ulp, beta, emax;
+    logical pair;
+    extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *, integer *);
+    logical allv;
+    integer ierr;
+    doublereal unfl, ovfl, smin;
+    logical over;
+    doublereal vmax;
+    integer jnxt;
+    extern int dscal_(integer *, doublereal *, doublereal *, integer *);
+    doublereal scale;
+    extern int dgemm_(char *, char *, integer *, integer *, integer *, doublereal *, doublereal *,
+                      integer *, doublereal *, integer *, doublereal *, doublereal *, integer *,
+                      ftnlen, ftnlen);
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *,
+                      doublereal *, integer *, doublereal *, doublereal *, integer *, ftnlen);
+    doublereal remax;
+    extern int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
+    logical leftv, bothv;
+    extern int daxpy_(integer *, doublereal *, doublereal *, integer *, doublereal *, integer *);
+    doublereal vcrit;
+    logical somev;
+    doublereal xnorm;
+    extern int dlaln2_(logical *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *,
+                       doublereal *, doublereal *, integer *, doublereal *, doublereal *,
+                       integer *),
+        dlabad_(doublereal *, doublereal *);
+    extern doublereal dlamch_(char *, ftnlen);
+    extern integer idamax_(integer *, doublereal *, integer *);
+    extern int dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *,
+                       integer *, ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *,
+                           ftnlen, ftnlen);
+    extern int dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *,
+                       integer *, ftnlen);
+    doublereal bignum;
+    logical rightv;
+    integer maxwrk;
+    doublereal smlnum;
+    logical lquery;
+    --select;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    vl_dim1 = *ldvl;
+    vl_offset = 1 + vl_dim1;
+    vl -= vl_offset;
+    vr_dim1 = *ldvr;
+    vr_offset = 1 + vr_dim1;
+    vr -= vr_offset;
+    --work;
+    bothv = lsame_(side, (char *)"B", (ftnlen)1, (ftnlen)1);
+    rightv = lsame_(side, (char *)"R", (ftnlen)1, (ftnlen)1) || bothv;
+    leftv = lsame_(side, (char *)"L", (ftnlen)1, (ftnlen)1) || bothv;
+    allv = lsame_(howmny, (char *)"A", (ftnlen)1, (ftnlen)1);
+    over = lsame_(howmny, (char *)"B", (ftnlen)1, (ftnlen)1);
+    somev = lsame_(howmny, (char *)"S", (ftnlen)1, (ftnlen)1);
+    *info = 0;
+    i__1[0] = 1, a__1[0] = side;
+    i__1[1] = 1, a__1[1] = howmny;
+    s_lmp_cat(ch__1, a__1, i__1, &c__2, (ftnlen)2);
+    nb = ilaenv_(&c__1, (char *)"DTREVC", ch__1, n, &c_n1, &c_n1, &c_n1, (ftnlen)6, (ftnlen)2);
+    maxwrk = *n + (*n << 1) * nb;
+    work[1] = (doublereal)maxwrk;
+    lquery = *lwork == -1;
+    if (!rightv && !leftv) {
+        *info = -1;
+    } else if (!allv && !over && !somev) {
+        *info = -2;
+    } else if (*n < 0) {
+        *info = -4;
+    } else if (*ldt < max(1, *n)) {
+        *info = -6;
+    } else if (*ldvl < 1 || leftv && *ldvl < *n) {
+        *info = -8;
+    } else if (*ldvr < 1 || rightv && *ldvr < *n) {
+        *info = -10;
+    } else {
+        i__2 = 1, i__3 = *n * 3;
+        if (*lwork < max(i__2, i__3) && !lquery) {
+            *info = -14;
+        } else {
+            if (somev) {
+                *m = 0;
+                pair = FALSE_;
+                i__2 = *n;
+                for (j = 1; j <= i__2; ++j) {
+                    if (pair) {
+                        pair = FALSE_;
+                        select[j] = FALSE_;
+                    } else {
+                        if (j < *n) {
+                            if (t[j + 1 + j * t_dim1] == 0.) {
+                                if (select[j]) {
+                                    ++(*m);
+                                }
+                            } else {
+                                pair = TRUE_;
+                                if (select[j] || select[j + 1]) {
+                                    select[j] = TRUE_;
+                                    *m += 2;
+                                }
+                            }
+                        } else {
+                            if (select[*n]) {
+                                ++(*m);
+                            }
+                        }
+                    }
+                }
+            } else {
+                *m = *n;
+            }
+            if (*mm < *m) {
+                *info = -11;
+            }
+        }
+    }
+    if (*info != 0) {
+        i__2 = -(*info);
+        xerbla_((char *)"DTREVC3", &i__2, (ftnlen)7);
+        return 0;
+    } else if (lquery) {
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    if (over && *lwork >= *n + (*n << 4)) {
+        nb = (*lwork - *n) / (*n << 1);
+        nb = min(nb, 128);
+        i__2 = (nb << 1) + 1;
+        dlaset_((char *)"F", n, &i__2, &c_b17, &c_b17, &work[1], n, (ftnlen)1);
+    } else {
+        nb = 1;
+    }
+    unfl = dlamch_((char *)"Safe minimum", (ftnlen)12);
+    ovfl = 1. / unfl;
+    dlabad_(&unfl, &ovfl);
+    ulp = dlamch_((char *)"Precision", (ftnlen)9);
+    smlnum = unfl * (*n / ulp);
+    bignum = (1. - ulp) / smlnum;
+    work[1] = 0.;
+    i__2 = *n;
+    for (j = 2; j <= i__2; ++j) {
+        work[j] = 0.;
+        i__3 = j - 1;
+        for (i__ = 1; i__ <= i__3; ++i__) {
+            work[j] += (d__1 = t[i__ + j * t_dim1], abs(d__1));
+        }
+    }
+    if (rightv) {
+        iv = 2;
+        if (nb > 2) {
+            iv = nb;
+        }
+        ip = 0;
+        is = *m;
+        for (ki = *n; ki >= 1; --ki) {
+            if (ip == -1) {
+                ip = 1;
+                goto L140;
+            } else if (ki == 1) {
+                ip = 0;
+            } else if (t[ki + (ki - 1) * t_dim1] == 0.) {
+                ip = 0;
+            } else {
+                ip = -1;
+            }
+            if (somev) {
+                if (ip == 0) {
+                    if (!select[ki]) {
+                        goto L140;
+                    }
+                } else {
+                    if (!select[ki - 1]) {
+                        goto L140;
+                    }
+                }
+            }
+            wr = t[ki + ki * t_dim1];
+            wi = 0.;
+            if (ip != 0) {
+                wi = sqrt((d__1 = t[ki + (ki - 1) * t_dim1], abs(d__1))) *
+                     sqrt((d__2 = t[ki - 1 + ki * t_dim1], abs(d__2)));
+            }
+            d__1 = ulp * (abs(wr) + abs(wi));
+            smin = max(d__1, smlnum);
+            if (ip == 0) {
+                work[ki + iv * *n] = 1.;
+                i__2 = ki - 1;
+                for (k = 1; k <= i__2; ++k) {
+                    work[k + iv * *n] = -t[k + ki * t_dim1];
+                }
+                jnxt = ki - 1;
+                for (j = ki - 1; j >= 1; --j) {
+                    if (j > jnxt) {
+                        goto L60;
+                    }
+                    j1 = j;
+                    j2 = j;
+                    jnxt = j - 1;
+                    if (j > 1) {
+                        if (t[j + (j - 1) * t_dim1] != 0.) {
+                            j1 = j - 1;
+                            jnxt = j - 2;
+                        }
+                    }
+                    if (j1 == j2) {
+                        dlaln2_(&c_false, &c__1, &c__1, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + iv * *n], n, &wr, &c_b17, x, &c__2,
+                                &scale, &xnorm, &ierr);
+                        if (xnorm > 1.) {
+                            if (work[j] > bignum / xnorm) {
+                                x[0] /= xnorm;
+                                scale /= xnorm;
+                            }
+                        }
+                        if (scale != 1.) {
+                            dscal_(&ki, &scale, &work[iv * *n + 1], &c__1);
+                        }
+                        work[j + iv * *n] = x[0];
+                        i__2 = j - 1;
+                        d__1 = -x[0];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[iv * *n + 1], &c__1);
+                    } else {
+                        dlaln2_(&c_false, &c__2, &c__1, &smin, &c_b29, &t[j - 1 + (j - 1) * t_dim1],
+                                ldt, &c_b29, &c_b29, &work[j - 1 + iv * *n], n, &wr, &c_b17, x,
+                                &c__2, &scale, &xnorm, &ierr);
+                        if (xnorm > 1.) {
+                            d__1 = work[j - 1], d__2 = work[j];
+                            beta = max(d__1, d__2);
+                            if (beta > bignum / xnorm) {
+                                x[0] /= xnorm;
+                                x[1] /= xnorm;
+                                scale /= xnorm;
+                            }
+                        }
+                        if (scale != 1.) {
+                            dscal_(&ki, &scale, &work[iv * *n + 1], &c__1);
+                        }
+                        work[j - 1 + iv * *n] = x[0];
+                        work[j + iv * *n] = x[1];
+                        i__2 = j - 2;
+                        d__1 = -x[0];
+                        daxpy_(&i__2, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1, &work[iv * *n + 1],
+                               &c__1);
+                        i__2 = j - 2;
+                        d__1 = -x[1];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[iv * *n + 1], &c__1);
+                    }
+                L60:;
+                }
+                if (!over) {
+                    dcopy_(&ki, &work[iv * *n + 1], &c__1, &vr[is * vr_dim1 + 1], &c__1);
+                    ii = idamax_(&ki, &vr[is * vr_dim1 + 1], &c__1);
+                    remax = 1. / (d__1 = vr[ii + is * vr_dim1], abs(d__1));
+                    dscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1);
+                    i__2 = *n;
+                    for (k = ki + 1; k <= i__2; ++k) {
+                        vr[k + is * vr_dim1] = 0.;
+                    }
+                } else if (nb == 1) {
+                    if (ki > 1) {
+                        i__2 = ki - 1;
+                        dgemv_((char *)"N", n, &i__2, &c_b29, &vr[vr_offset], ldvr, &work[iv * *n + 1],
+                               &c__1, &work[ki + iv * *n], &vr[ki * vr_dim1 + 1], &c__1, (ftnlen)1);
+                    }
+                    ii = idamax_(n, &vr[ki * vr_dim1 + 1], &c__1);
+                    remax = 1. / (d__1 = vr[ii + ki * vr_dim1], abs(d__1));
+                    dscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1);
+                } else {
+                    i__2 = *n;
+                    for (k = ki + 1; k <= i__2; ++k) {
+                        work[k + iv * *n] = 0.;
+                    }
+                    iscomplex[iv - 1] = ip;
+                }
+            } else {
+                if ((d__1 = t[ki - 1 + ki * t_dim1], abs(d__1)) >=
+                    (d__2 = t[ki + (ki - 1) * t_dim1], abs(d__2))) {
+                    work[ki - 1 + (iv - 1) * *n] = 1.;
+                    work[ki + iv * *n] = wi / t[ki - 1 + ki * t_dim1];
+                } else {
+                    work[ki - 1 + (iv - 1) * *n] = -wi / t[ki + (ki - 1) * t_dim1];
+                    work[ki + iv * *n] = 1.;
+                }
+                work[ki + (iv - 1) * *n] = 0.;
+                work[ki - 1 + iv * *n] = 0.;
+                i__2 = ki - 2;
+                for (k = 1; k <= i__2; ++k) {
+                    work[k + (iv - 1) * *n] =
+                        -work[ki - 1 + (iv - 1) * *n] * t[k + (ki - 1) * t_dim1];
+                    work[k + iv * *n] = -work[ki + iv * *n] * t[k + ki * t_dim1];
+                }
+                jnxt = ki - 2;
+                for (j = ki - 2; j >= 1; --j) {
+                    if (j > jnxt) {
+                        goto L90;
+                    }
+                    j1 = j;
+                    j2 = j;
+                    jnxt = j - 1;
+                    if (j > 1) {
+                        if (t[j + (j - 1) * t_dim1] != 0.) {
+                            j1 = j - 1;
+                            jnxt = j - 2;
+                        }
+                    }
+                    if (j1 == j2) {
+                        dlaln2_(&c_false, &c__1, &c__2, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + (iv - 1) * *n], n, &wr, &wi, x, &c__2,
+                                &scale, &xnorm, &ierr);
+                        if (xnorm > 1.) {
+                            if (work[j] > bignum / xnorm) {
+                                x[0] /= xnorm;
+                                x[2] /= xnorm;
+                                scale /= xnorm;
+                            }
+                        }
+                        if (scale != 1.) {
+                            dscal_(&ki, &scale, &work[(iv - 1) * *n + 1], &c__1);
+                            dscal_(&ki, &scale, &work[iv * *n + 1], &c__1);
+                        }
+                        work[j + (iv - 1) * *n] = x[0];
+                        work[j + iv * *n] = x[2];
+                        i__2 = j - 1;
+                        d__1 = -x[0];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[(iv - 1) * *n + 1],
+                               &c__1);
+                        i__2 = j - 1;
+                        d__1 = -x[2];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[iv * *n + 1], &c__1);
+                    } else {
+                        dlaln2_(&c_false, &c__2, &c__2, &smin, &c_b29, &t[j - 1 + (j - 1) * t_dim1],
+                                ldt, &c_b29, &c_b29, &work[j - 1 + (iv - 1) * *n], n, &wr, &wi, x,
+                                &c__2, &scale, &xnorm, &ierr);
+                        if (xnorm > 1.) {
+                            d__1 = work[j - 1], d__2 = work[j];
+                            beta = max(d__1, d__2);
+                            if (beta > bignum / xnorm) {
+                                rec = 1. / xnorm;
+                                x[0] *= rec;
+                                x[2] *= rec;
+                                x[1] *= rec;
+                                x[3] *= rec;
+                                scale *= rec;
+                            }
+                        }
+                        if (scale != 1.) {
+                            dscal_(&ki, &scale, &work[(iv - 1) * *n + 1], &c__1);
+                            dscal_(&ki, &scale, &work[iv * *n + 1], &c__1);
+                        }
+                        work[j - 1 + (iv - 1) * *n] = x[0];
+                        work[j + (iv - 1) * *n] = x[1];
+                        work[j - 1 + iv * *n] = x[2];
+                        work[j + iv * *n] = x[3];
+                        i__2 = j - 2;
+                        d__1 = -x[0];
+                        daxpy_(&i__2, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1,
+                               &work[(iv - 1) * *n + 1], &c__1);
+                        i__2 = j - 2;
+                        d__1 = -x[1];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[(iv - 1) * *n + 1],
+                               &c__1);
+                        i__2 = j - 2;
+                        d__1 = -x[2];
+                        daxpy_(&i__2, &d__1, &t[(j - 1) * t_dim1 + 1], &c__1, &work[iv * *n + 1],
+                               &c__1);
+                        i__2 = j - 2;
+                        d__1 = -x[3];
+                        daxpy_(&i__2, &d__1, &t[j * t_dim1 + 1], &c__1, &work[iv * *n + 1], &c__1);
+                    }
+                L90:;
+                }
+                if (!over) {
+                    dcopy_(&ki, &work[(iv - 1) * *n + 1], &c__1, &vr[(is - 1) * vr_dim1 + 1],
+                           &c__1);
+                    dcopy_(&ki, &work[iv * *n + 1], &c__1, &vr[is * vr_dim1 + 1], &c__1);
+                    emax = 0.;
+                    i__2 = ki;
+                    for (k = 1; k <= i__2; ++k) {
+                        d__3 = emax, d__4 = (d__1 = vr[k + (is - 1) * vr_dim1], abs(d__1)) +
+                                            (d__2 = vr[k + is * vr_dim1], abs(d__2));
+                        emax = max(d__3, d__4);
+                    }
+                    remax = 1. / emax;
+                    dscal_(&ki, &remax, &vr[(is - 1) * vr_dim1 + 1], &c__1);
+                    dscal_(&ki, &remax, &vr[is * vr_dim1 + 1], &c__1);
+                    i__2 = *n;
+                    for (k = ki + 1; k <= i__2; ++k) {
+                        vr[k + (is - 1) * vr_dim1] = 0.;
+                        vr[k + is * vr_dim1] = 0.;
+                    }
+                } else if (nb == 1) {
+                    if (ki > 2) {
+                        i__2 = ki - 2;
+                        dgemv_((char *)"N", n, &i__2, &c_b29, &vr[vr_offset], ldvr,
+                               &work[(iv - 1) * *n + 1], &c__1, &work[ki - 1 + (iv - 1) * *n],
+                               &vr[(ki - 1) * vr_dim1 + 1], &c__1, (ftnlen)1);
+                        i__2 = ki - 2;
+                        dgemv_((char *)"N", n, &i__2, &c_b29, &vr[vr_offset], ldvr, &work[iv * *n + 1],
+                               &c__1, &work[ki + iv * *n], &vr[ki * vr_dim1 + 1], &c__1, (ftnlen)1);
+                    } else {
+                        dscal_(n, &work[ki - 1 + (iv - 1) * *n], &vr[(ki - 1) * vr_dim1 + 1],
+                               &c__1);
+                        dscal_(n, &work[ki + iv * *n], &vr[ki * vr_dim1 + 1], &c__1);
+                    }
+                    emax = 0.;
+                    i__2 = *n;
+                    for (k = 1; k <= i__2; ++k) {
+                        d__3 = emax, d__4 = (d__1 = vr[k + (ki - 1) * vr_dim1], abs(d__1)) +
+                                            (d__2 = vr[k + ki * vr_dim1], abs(d__2));
+                        emax = max(d__3, d__4);
+                    }
+                    remax = 1. / emax;
+                    dscal_(n, &remax, &vr[(ki - 1) * vr_dim1 + 1], &c__1);
+                    dscal_(n, &remax, &vr[ki * vr_dim1 + 1], &c__1);
+                } else {
+                    i__2 = *n;
+                    for (k = ki + 1; k <= i__2; ++k) {
+                        work[k + (iv - 1) * *n] = 0.;
+                        work[k + iv * *n] = 0.;
+                    }
+                    iscomplex[iv - 2] = -ip;
+                    iscomplex[iv - 1] = ip;
+                    --iv;
+                }
+            }
+            if (nb > 1) {
+                if (ip == 0) {
+                    ki2 = ki;
+                } else {
+                    ki2 = ki - 1;
+                }
+                if (iv <= 2 || ki2 == 1) {
+                    i__2 = nb - iv + 1;
+                    i__3 = ki2 + nb - iv;
+                    dgemm_((char *)"N", (char *)"N", n, &i__2, &i__3, &c_b29, &vr[vr_offset], ldvr,
+                           &work[iv * *n + 1], n, &c_b17, &work[(nb + iv) * *n + 1], n, (ftnlen)1,
+                           (ftnlen)1);
+                    i__2 = nb;
+                    for (k = iv; k <= i__2; ++k) {
+                        if (iscomplex[k - 1] == 0) {
+                            ii = idamax_(n, &work[(nb + k) * *n + 1], &c__1);
+                            remax = 1. / (d__1 = work[ii + (nb + k) * *n], abs(d__1));
+                        } else if (iscomplex[k - 1] == 1) {
+                            emax = 0.;
+                            i__3 = *n;
+                            for (ii = 1; ii <= i__3; ++ii) {
+                                d__3 = emax,
+                                d__4 = (d__1 = work[ii + (nb + k) * *n], abs(d__1)) +
+                                       (d__2 = work[ii + (nb + k + 1) * *n], abs(d__2));
+                                emax = max(d__3, d__4);
+                            }
+                            remax = 1. / emax;
+                        }
+                        dscal_(n, &remax, &work[(nb + k) * *n + 1], &c__1);
+                    }
+                    i__2 = nb - iv + 1;
+                    dlacpy_((char *)"F", n, &i__2, &work[(nb + iv) * *n + 1], n, &vr[ki2 * vr_dim1 + 1],
+                            ldvr, (ftnlen)1);
+                    iv = nb;
+                } else {
+                    --iv;
+                }
+            }
+            --is;
+            if (ip != 0) {
+                --is;
+            }
+        L140:;
+        }
+    }
+    if (leftv) {
+        iv = 1;
+        ip = 0;
+        is = 1;
+        i__2 = *n;
+        for (ki = 1; ki <= i__2; ++ki) {
+            if (ip == 1) {
+                ip = -1;
+                goto L260;
+            } else if (ki == *n) {
+                ip = 0;
+            } else if (t[ki + 1 + ki * t_dim1] == 0.) {
+                ip = 0;
+            } else {
+                ip = 1;
+            }
+            if (somev) {
+                if (!select[ki]) {
+                    goto L260;
+                }
+            }
+            wr = t[ki + ki * t_dim1];
+            wi = 0.;
+            if (ip != 0) {
+                wi = sqrt((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1))) *
+                     sqrt((d__2 = t[ki + 1 + ki * t_dim1], abs(d__2)));
+            }
+            d__1 = ulp * (abs(wr) + abs(wi));
+            smin = max(d__1, smlnum);
+            if (ip == 0) {
+                work[ki + iv * *n] = 1.;
+                i__3 = *n;
+                for (k = ki + 1; k <= i__3; ++k) {
+                    work[k + iv * *n] = -t[ki + k * t_dim1];
+                }
+                vmax = 1.;
+                vcrit = bignum;
+                jnxt = ki + 1;
+                i__3 = *n;
+                for (j = ki + 1; j <= i__3; ++j) {
+                    if (j < jnxt) {
+                        goto L170;
+                    }
+                    j1 = j;
+                    j2 = j;
+                    jnxt = j + 1;
+                    if (j < *n) {
+                        if (t[j + 1 + j * t_dim1] != 0.) {
+                            j2 = j + 1;
+                            jnxt = j + 2;
+                        }
+                    }
+                    if (j1 == j2) {
+                        if (work[j] > vcrit) {
+                            rec = 1. / vmax;
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + iv * *n], &c__1);
+                            vmax = 1.;
+                            vcrit = bignum;
+                        }
+                        i__4 = j - ki - 1;
+                        work[j + iv * *n] -= ddot_(&i__4, &t[ki + 1 + j * t_dim1], &c__1,
+                                                   &work[ki + 1 + iv * *n], &c__1);
+                        dlaln2_(&c_false, &c__1, &c__1, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + iv * *n], n, &wr, &c_b17, x, &c__2,
+                                &scale, &xnorm, &ierr);
+                        if (scale != 1.) {
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + iv * *n], &c__1);
+                        }
+                        work[j + iv * *n] = x[0];
+                        d__2 = (d__1 = work[j + iv * *n], abs(d__1));
+                        vmax = max(d__2, vmax);
+                        vcrit = bignum / vmax;
+                    } else {
+                        d__1 = work[j], d__2 = work[j + 1];
+                        beta = max(d__1, d__2);
+                        if (beta > vcrit) {
+                            rec = 1. / vmax;
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + iv * *n], &c__1);
+                            vmax = 1.;
+                            vcrit = bignum;
+                        }
+                        i__4 = j - ki - 1;
+                        work[j + iv * *n] -= ddot_(&i__4, &t[ki + 1 + j * t_dim1], &c__1,
+                                                   &work[ki + 1 + iv * *n], &c__1);
+                        i__4 = j - ki - 1;
+                        work[j + 1 + iv * *n] -= ddot_(&i__4, &t[ki + 1 + (j + 1) * t_dim1], &c__1,
+                                                       &work[ki + 1 + iv * *n], &c__1);
+                        dlaln2_(&c_true, &c__2, &c__1, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + iv * *n], n, &wr, &c_b17, x, &c__2,
+                                &scale, &xnorm, &ierr);
+                        if (scale != 1.) {
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + iv * *n], &c__1);
+                        }
+                        work[j + iv * *n] = x[0];
+                        work[j + 1 + iv * *n] = x[1];
+                        d__3 = (d__1 = work[j + iv * *n], abs(d__1)),
+                        d__4 = (d__2 = work[j + 1 + iv * *n], abs(d__2)), d__3 = max(d__3, d__4);
+                        vmax = max(d__3, vmax);
+                        vcrit = bignum / vmax;
+                    }
+                L170:;
+                }
+                if (!over) {
+                    i__3 = *n - ki + 1;
+                    dcopy_(&i__3, &work[ki + iv * *n], &c__1, &vl[ki + is * vl_dim1], &c__1);
+                    i__3 = *n - ki + 1;
+                    ii = idamax_(&i__3, &vl[ki + is * vl_dim1], &c__1) + ki - 1;
+                    remax = 1. / (d__1 = vl[ii + is * vl_dim1], abs(d__1));
+                    i__3 = *n - ki + 1;
+                    dscal_(&i__3, &remax, &vl[ki + is * vl_dim1], &c__1);
+                    i__3 = ki - 1;
+                    for (k = 1; k <= i__3; ++k) {
+                        vl[k + is * vl_dim1] = 0.;
+                    }
+                } else if (nb == 1) {
+                    if (ki < *n) {
+                        i__3 = *n - ki;
+                        dgemv_((char *)"N", n, &i__3, &c_b29, &vl[(ki + 1) * vl_dim1 + 1], ldvl,
+                               &work[ki + 1 + iv * *n], &c__1, &work[ki + iv * *n],
+                               &vl[ki * vl_dim1 + 1], &c__1, (ftnlen)1);
+                    }
+                    ii = idamax_(n, &vl[ki * vl_dim1 + 1], &c__1);
+                    remax = 1. / (d__1 = vl[ii + ki * vl_dim1], abs(d__1));
+                    dscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1);
+                } else {
+                    i__3 = ki - 1;
+                    for (k = 1; k <= i__3; ++k) {
+                        work[k + iv * *n] = 0.;
+                    }
+                    iscomplex[iv - 1] = ip;
+                }
+            } else {
+                if ((d__1 = t[ki + (ki + 1) * t_dim1], abs(d__1)) >=
+                    (d__2 = t[ki + 1 + ki * t_dim1], abs(d__2))) {
+                    work[ki + iv * *n] = wi / t[ki + (ki + 1) * t_dim1];
+                    work[ki + 1 + (iv + 1) * *n] = 1.;
+                } else {
+                    work[ki + iv * *n] = 1.;
+                    work[ki + 1 + (iv + 1) * *n] = -wi / t[ki + 1 + ki * t_dim1];
+                }
+                work[ki + 1 + iv * *n] = 0.;
+                work[ki + (iv + 1) * *n] = 0.;
+                i__3 = *n;
+                for (k = ki + 2; k <= i__3; ++k) {
+                    work[k + iv * *n] = -work[ki + iv * *n] * t[ki + k * t_dim1];
+                    work[k + (iv + 1) * *n] =
+                        -work[ki + 1 + (iv + 1) * *n] * t[ki + 1 + k * t_dim1];
+                }
+                vmax = 1.;
+                vcrit = bignum;
+                jnxt = ki + 2;
+                i__3 = *n;
+                for (j = ki + 2; j <= i__3; ++j) {
+                    if (j < jnxt) {
+                        goto L200;
+                    }
+                    j1 = j;
+                    j2 = j;
+                    jnxt = j + 1;
+                    if (j < *n) {
+                        if (t[j + 1 + j * t_dim1] != 0.) {
+                            j2 = j + 1;
+                            jnxt = j + 2;
+                        }
+                    }
+                    if (j1 == j2) {
+                        if (work[j] > vcrit) {
+                            rec = 1. / vmax;
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + iv * *n], &c__1);
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + (iv + 1) * *n], &c__1);
+                            vmax = 1.;
+                            vcrit = bignum;
+                        }
+                        i__4 = j - ki - 2;
+                        work[j + iv * *n] -= ddot_(&i__4, &t[ki + 2 + j * t_dim1], &c__1,
+                                                   &work[ki + 2 + iv * *n], &c__1);
+                        i__4 = j - ki - 2;
+                        work[j + (iv + 1) * *n] -= ddot_(&i__4, &t[ki + 2 + j * t_dim1], &c__1,
+                                                         &work[ki + 2 + (iv + 1) * *n], &c__1);
+                        d__1 = -wi;
+                        dlaln2_(&c_false, &c__1, &c__2, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + iv * *n], n, &wr, &d__1, x, &c__2, &scale,
+                                &xnorm, &ierr);
+                        if (scale != 1.) {
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + iv * *n], &c__1);
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + (iv + 1) * *n], &c__1);
+                        }
+                        work[j + iv * *n] = x[0];
+                        work[j + (iv + 1) * *n] = x[2];
+                        d__3 = (d__1 = work[j + iv * *n], abs(d__1)),
+                        d__4 = (d__2 = work[j + (iv + 1) * *n], abs(d__2)), d__3 = max(d__3, d__4);
+                        vmax = max(d__3, vmax);
+                        vcrit = bignum / vmax;
+                    } else {
+                        d__1 = work[j], d__2 = work[j + 1];
+                        beta = max(d__1, d__2);
+                        if (beta > vcrit) {
+                            rec = 1. / vmax;
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + iv * *n], &c__1);
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &rec, &work[ki + (iv + 1) * *n], &c__1);
+                            vmax = 1.;
+                            vcrit = bignum;
+                        }
+                        i__4 = j - ki - 2;
+                        work[j + iv * *n] -= ddot_(&i__4, &t[ki + 2 + j * t_dim1], &c__1,
+                                                   &work[ki + 2 + iv * *n], &c__1);
+                        i__4 = j - ki - 2;
+                        work[j + (iv + 1) * *n] -= ddot_(&i__4, &t[ki + 2 + j * t_dim1], &c__1,
+                                                         &work[ki + 2 + (iv + 1) * *n], &c__1);
+                        i__4 = j - ki - 2;
+                        work[j + 1 + iv * *n] -= ddot_(&i__4, &t[ki + 2 + (j + 1) * t_dim1], &c__1,
+                                                       &work[ki + 2 + iv * *n], &c__1);
+                        i__4 = j - ki - 2;
+                        work[j + 1 + (iv + 1) * *n] -=
+                            ddot_(&i__4, &t[ki + 2 + (j + 1) * t_dim1], &c__1,
+                                  &work[ki + 2 + (iv + 1) * *n], &c__1);
+                        d__1 = -wi;
+                        dlaln2_(&c_true, &c__2, &c__2, &smin, &c_b29, &t[j + j * t_dim1], ldt,
+                                &c_b29, &c_b29, &work[j + iv * *n], n, &wr, &d__1, x, &c__2, &scale,
+                                &xnorm, &ierr);
+                        if (scale != 1.) {
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + iv * *n], &c__1);
+                            i__4 = *n - ki + 1;
+                            dscal_(&i__4, &scale, &work[ki + (iv + 1) * *n], &c__1);
+                        }
+                        work[j + iv * *n] = x[0];
+                        work[j + (iv + 1) * *n] = x[2];
+                        work[j + 1 + iv * *n] = x[1];
+                        work[j + 1 + (iv + 1) * *n] = x[3];
+                        d__1 = abs(x[0]), d__2 = abs(x[2]), d__1 = max(d__1, d__2),
+                        d__2 = abs(x[1]), d__1 = max(d__1, d__2), d__2 = abs(x[3]),
+                        d__1 = max(d__1, d__2);
+                        vmax = max(d__1, vmax);
+                        vcrit = bignum / vmax;
+                    }
+                L200:;
+                }
+                if (!over) {
+                    i__3 = *n - ki + 1;
+                    dcopy_(&i__3, &work[ki + iv * *n], &c__1, &vl[ki + is * vl_dim1], &c__1);
+                    i__3 = *n - ki + 1;
+                    dcopy_(&i__3, &work[ki + (iv + 1) * *n], &c__1, &vl[ki + (is + 1) * vl_dim1],
+                           &c__1);
+                    emax = 0.;
+                    i__3 = *n;
+                    for (k = ki; k <= i__3; ++k) {
+                        d__3 = emax, d__4 = (d__1 = vl[k + is * vl_dim1], abs(d__1)) +
+                                            (d__2 = vl[k + (is + 1) * vl_dim1], abs(d__2));
+                        emax = max(d__3, d__4);
+                    }
+                    remax = 1. / emax;
+                    i__3 = *n - ki + 1;
+                    dscal_(&i__3, &remax, &vl[ki + is * vl_dim1], &c__1);
+                    i__3 = *n - ki + 1;
+                    dscal_(&i__3, &remax, &vl[ki + (is + 1) * vl_dim1], &c__1);
+                    i__3 = ki - 1;
+                    for (k = 1; k <= i__3; ++k) {
+                        vl[k + is * vl_dim1] = 0.;
+                        vl[k + (is + 1) * vl_dim1] = 0.;
+                    }
+                } else if (nb == 1) {
+                    if (ki < *n - 1) {
+                        i__3 = *n - ki - 1;
+                        dgemv_((char *)"N", n, &i__3, &c_b29, &vl[(ki + 2) * vl_dim1 + 1], ldvl,
+                               &work[ki + 2 + iv * *n], &c__1, &work[ki + iv * *n],
+                               &vl[ki * vl_dim1 + 1], &c__1, (ftnlen)1);
+                        i__3 = *n - ki - 1;
+                        dgemv_((char *)"N", n, &i__3, &c_b29, &vl[(ki + 2) * vl_dim1 + 1], ldvl,
+                               &work[ki + 2 + (iv + 1) * *n], &c__1, &work[ki + 1 + (iv + 1) * *n],
+                               &vl[(ki + 1) * vl_dim1 + 1], &c__1, (ftnlen)1);
+                    } else {
+                        dscal_(n, &work[ki + iv * *n], &vl[ki * vl_dim1 + 1], &c__1);
+                        dscal_(n, &work[ki + 1 + (iv + 1) * *n], &vl[(ki + 1) * vl_dim1 + 1],
+                               &c__1);
+                    }
+                    emax = 0.;
+                    i__3 = *n;
+                    for (k = 1; k <= i__3; ++k) {
+                        d__3 = emax, d__4 = (d__1 = vl[k + ki * vl_dim1], abs(d__1)) +
+                                            (d__2 = vl[k + (ki + 1) * vl_dim1], abs(d__2));
+                        emax = max(d__3, d__4);
+                    }
+                    remax = 1. / emax;
+                    dscal_(n, &remax, &vl[ki * vl_dim1 + 1], &c__1);
+                    dscal_(n, &remax, &vl[(ki + 1) * vl_dim1 + 1], &c__1);
+                } else {
+                    i__3 = ki - 1;
+                    for (k = 1; k <= i__3; ++k) {
+                        work[k + iv * *n] = 0.;
+                        work[k + (iv + 1) * *n] = 0.;
+                    }
+                    iscomplex[iv - 1] = ip;
+                    iscomplex[iv] = -ip;
+                    ++iv;
+                }
+            }
+            if (nb > 1) {
+                if (ip == 0) {
+                    ki2 = ki;
+                } else {
+                    ki2 = ki + 1;
+                }
+                if (iv >= nb - 1 || ki2 == *n) {
+                    i__3 = *n - ki2 + iv;
+                    dgemm_((char *)"N", (char *)"N", n, &iv, &i__3, &c_b29, &vl[(ki2 - iv + 1) * vl_dim1 + 1], ldvl,
+                           &work[ki2 - iv + 1 + *n], n, &c_b17, &work[(nb + 1) * *n + 1], n,
+                           (ftnlen)1, (ftnlen)1);
+                    i__3 = iv;
+                    for (k = 1; k <= i__3; ++k) {
+                        if (iscomplex[k - 1] == 0) {
+                            ii = idamax_(n, &work[(nb + k) * *n + 1], &c__1);
+                            remax = 1. / (d__1 = work[ii + (nb + k) * *n], abs(d__1));
+                        } else if (iscomplex[k - 1] == 1) {
+                            emax = 0.;
+                            i__4 = *n;
+                            for (ii = 1; ii <= i__4; ++ii) {
+                                d__3 = emax,
+                                d__4 = (d__1 = work[ii + (nb + k) * *n], abs(d__1)) +
+                                       (d__2 = work[ii + (nb + k + 1) * *n], abs(d__2));
+                                emax = max(d__3, d__4);
+                            }
+                            remax = 1. / emax;
+                        }
+                        dscal_(n, &remax, &work[(nb + k) * *n + 1], &c__1);
+                    }
+                    dlacpy_((char *)"F", n, &iv, &work[(nb + 1) * *n + 1], n,
+                            &vl[(ki2 - iv + 1) * vl_dim1 + 1], ldvl, (ftnlen)1);
+                    iv = 1;
+                } else {
+                    ++iv;
+                }
+            }
+            ++is;
+            if (ip != 0) {
+                ++is;
+            }
+        L260:;
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dtrexc.cpp

@@ -0,0 +1,217 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static integer c__1 = 1;
+static integer c__2 = 2;
+int dtrexc_(char *compq, integer *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq,
+            integer *ifst, integer *ilst, doublereal *work, integer *info, ftnlen compq_len)
+{
+    integer q_dim1, q_offset, t_dim1, t_offset, i__1;
+    integer nbf, nbl, here;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    logical wantq;
+    extern int dlaexc_(logical *, integer *, doublereal *, integer *, doublereal *, integer *,
+                       integer *, integer *, integer *, doublereal *, integer *),
+        xerbla_(char *, integer *, ftnlen);
+    integer nbnext;
+    t_dim1 = *ldt;
+    t_offset = 1 + t_dim1;
+    t -= t_offset;
+    q_dim1 = *ldq;
+    q_offset = 1 + q_dim1;
+    q -= q_offset;
+    --work;
+    *info = 0;
+    wantq = lsame_(compq, (char *)"V", (ftnlen)1, (ftnlen)1);
+    if (!wantq && !lsame_(compq, (char *)"N", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (*n < 0) {
+        *info = -2;
+    } else if (*ldt < max(1, *n)) {
+        *info = -4;
+    } else if (*ldq < 1 || wantq && *ldq < max(1, *n)) {
+        *info = -6;
+    } else if ((*ifst < 1 || *ifst > *n) && *n > 0) {
+        *info = -7;
+    } else if ((*ilst < 1 || *ilst > *n) && *n > 0) {
+        *info = -8;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DTREXC", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n <= 1) {
+        return 0;
+    }
+    if (*ifst > 1) {
+        if (t[*ifst + (*ifst - 1) * t_dim1] != 0.) {
+            --(*ifst);
+        }
+    }
+    nbf = 1;
+    if (*ifst < *n) {
+        if (t[*ifst + 1 + *ifst * t_dim1] != 0.) {
+            nbf = 2;
+        }
+    }
+    if (*ilst > 1) {
+        if (t[*ilst + (*ilst - 1) * t_dim1] != 0.) {
+            --(*ilst);
+        }
+    }
+    nbl = 1;
+    if (*ilst < *n) {
+        if (t[*ilst + 1 + *ilst * t_dim1] != 0.) {
+            nbl = 2;
+        }
+    }
+    if (*ifst == *ilst) {
+        return 0;
+    }
+    if (*ifst < *ilst) {
+        if (nbf == 2 && nbl == 1) {
+            --(*ilst);
+        }
+        if (nbf == 1 && nbl == 2) {
+            ++(*ilst);
+        }
+        here = *ifst;
+    L10:
+        if (nbf == 1 || nbf == 2) {
+            nbnext = 1;
+            if (here + nbf + 1 <= *n) {
+                if (t[here + nbf + 1 + (here + nbf) * t_dim1] != 0.) {
+                    nbnext = 2;
+                }
+            }
+            dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &nbf, &nbnext, &work[1],
+                    info);
+            if (*info != 0) {
+                *ilst = here;
+                return 0;
+            }
+            here += nbnext;
+            if (nbf == 2) {
+                if (t[here + 1 + here * t_dim1] == 0.) {
+                    nbf = 3;
+                }
+            }
+        } else {
+            nbnext = 1;
+            if (here + 3 <= *n) {
+                if (t[here + 3 + (here + 2) * t_dim1] != 0.) {
+                    nbnext = 2;
+                }
+            }
+            i__1 = here + 1;
+            dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &c__1, &nbnext,
+                    &work[1], info);
+            if (*info != 0) {
+                *ilst = here;
+                return 0;
+            }
+            if (nbnext == 1) {
+                dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &c__1, &nbnext,
+                        &work[1], info);
+                ++here;
+            } else {
+                if (t[here + 2 + (here + 1) * t_dim1] == 0.) {
+                    nbnext = 1;
+                }
+                if (nbnext == 2) {
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &c__1, &nbnext,
+                            &work[1], info);
+                    if (*info != 0) {
+                        *ilst = here;
+                        return 0;
+                    }
+                    here += 2;
+                } else {
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &c__1, &c__1,
+                            &work[1], info);
+                    i__1 = here + 1;
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &c__1, &c__1,
+                            &work[1], info);
+                    here += 2;
+                }
+            }
+        }
+        if (here < *ilst) {
+            goto L10;
+        }
+    } else {
+        here = *ifst;
+    L20:
+        if (nbf == 1 || nbf == 2) {
+            nbnext = 1;
+            if (here >= 3) {
+                if (t[here - 1 + (here - 2) * t_dim1] != 0.) {
+                    nbnext = 2;
+                }
+            }
+            i__1 = here - nbnext;
+            dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &nbnext, &nbf, &work[1],
+                    info);
+            if (*info != 0) {
+                *ilst = here;
+                return 0;
+            }
+            here -= nbnext;
+            if (nbf == 2) {
+                if (t[here + 1 + here * t_dim1] == 0.) {
+                    nbf = 3;
+                }
+            }
+        } else {
+            nbnext = 1;
+            if (here >= 3) {
+                if (t[here - 1 + (here - 2) * t_dim1] != 0.) {
+                    nbnext = 2;
+                }
+            }
+            i__1 = here - nbnext;
+            dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &nbnext, &c__1,
+                    &work[1], info);
+            if (*info != 0) {
+                *ilst = here;
+                return 0;
+            }
+            if (nbnext == 1) {
+                dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &nbnext, &c__1,
+                        &work[1], info);
+                --here;
+            } else {
+                if (t[here + (here - 1) * t_dim1] == 0.) {
+                    nbnext = 1;
+                }
+                if (nbnext == 2) {
+                    i__1 = here - 1;
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &c__2, &c__1,
+                            &work[1], info);
+                    if (*info != 0) {
+                        *ilst = here;
+                        return 0;
+                    }
+                    here += -2;
+                } else {
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &here, &c__1, &c__1,
+                            &work[1], info);
+                    i__1 = here - 1;
+                    dlaexc_(&wantq, n, &t[t_offset], ldt, &q[q_offset], ldq, &i__1, &c__1, &c__1,
+                            &work[1], info);
+                    here += -2;
+                }
+            }
+        }
+        if (here > *ilst) {
+            goto L20;
+        }
+    }
+    *ilst = here;
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/dtrtrs.cpp

@@ -0,0 +1,65 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+static doublereal c_b12 = 1.;
+int dtrtrs_(char *uplo, char *trans, char *diag, integer *n, integer *nrhs, doublereal *a,
+            integer *lda, doublereal *b, integer *ldb, integer *info, ftnlen uplo_len,
+            ftnlen trans_len, ftnlen diag_len)
+{
+    integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+    extern logical lsame_(char *, char *, ftnlen, ftnlen);
+    extern int dtrsm_(char *, char *, char *, char *, integer *, integer *, doublereal *,
+                      doublereal *, integer *, doublereal *, integer *, ftnlen, ftnlen, ftnlen,
+                      ftnlen),
+        xerbla_(char *, integer *, ftnlen);
+    logical nounit;
+    a_dim1 = *lda;
+    a_offset = 1 + a_dim1;
+    a -= a_offset;
+    b_dim1 = *ldb;
+    b_offset = 1 + b_dim1;
+    b -= b_offset;
+    *info = 0;
+    nounit = lsame_(diag, (char *)"N", (ftnlen)1, (ftnlen)1);
+    if (!lsame_(uplo, (char *)"U", (ftnlen)1, (ftnlen)1) && !lsame_(uplo, (char *)"L", (ftnlen)1, (ftnlen)1)) {
+        *info = -1;
+    } else if (!lsame_(trans, (char *)"N", (ftnlen)1, (ftnlen)1) &&
+               !lsame_(trans, (char *)"T", (ftnlen)1, (ftnlen)1) &&
+               !lsame_(trans, (char *)"C", (ftnlen)1, (ftnlen)1)) {
+        *info = -2;
+    } else if (!nounit && !lsame_(diag, (char *)"U", (ftnlen)1, (ftnlen)1)) {
+        *info = -3;
+    } else if (*n < 0) {
+        *info = -4;
+    } else if (*nrhs < 0) {
+        *info = -5;
+    } else if (*lda < max(1, *n)) {
+        *info = -7;
+    } else if (*ldb < max(1, *n)) {
+        *info = -9;
+    }
+    if (*info != 0) {
+        i__1 = -(*info);
+        xerbla_((char *)"DTRTRS", &i__1, (ftnlen)6);
+        return 0;
+    }
+    if (*n == 0) {
+        return 0;
+    }
+    if (nounit) {
+        i__1 = *n;
+        for (*info = 1; *info <= i__1; ++(*info)) {
+            if (a[*info + *info * a_dim1] == 0.) {
+                return 0;
+            }
+        }
+    }
+    *info = 0;
+    dtrsm_((char *)"Left", uplo, trans, diag, n, nrhs, &c_b12, &a[a_offset], lda, &b[b_offset], ldb,
+           (ftnlen)4, (ftnlen)1, (ftnlen)1, (ftnlen)1);
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/izamax.cpp

@@ -0,0 +1,46 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+integer izamax_(integer *n, doublecomplex *zx, integer *incx)
+{
+    integer ret_val, i__1;
+    integer i__, ix;
+    doublereal dmax__;
+    extern doublereal dcabs1_(doublecomplex *);
+    --zx;
+    ret_val = 0;
+    if (*n < 1 || *incx <= 0) {
+        return ret_val;
+    }
+    ret_val = 1;
+    if (*n == 1) {
+        return ret_val;
+    }
+    if (*incx == 1) {
+        dmax__ = dcabs1_(&zx[1]);
+        i__1 = *n;
+        for (i__ = 2; i__ <= i__1; ++i__) {
+            if (dcabs1_(&zx[i__]) > dmax__) {
+                ret_val = i__;
+                dmax__ = dcabs1_(&zx[i__]);
+            }
+        }
+    } else {
+        ix = 1;
+        dmax__ = dcabs1_(&zx[1]);
+        ix += *incx;
+        i__1 = *n;
+        for (i__ = 2; i__ <= i__1; ++i__) {
+            if (dcabs1_(&zx[ix]) > dmax__) {
+                ret_val = i__;
+                dmax__ = dcabs1_(&zx[ix]);
+            }
+            ix += *incx;
+        }
+    }
+    return ret_val;
+}
+#ifdef __cplusplus
+}
+#endif

lib/linalg/zcop.cpp

@@ -0,0 +1,43 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "lmp_f2c.h"
+int zcopy_(integer *n, doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
+{
+    integer i__1, i__2, i__3;
+    integer i__, ix, iy;
+    --zy;
+    --zx;
+    if (*n <= 0) {
+        return 0;
+    }
+    if (*incx == 1 && *incy == 1) {
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            i__2 = i__;
+            i__3 = i__;
+            zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
+        }
+    } else {
+        ix = 1;
+        iy = 1;
+        if (*incx < 0) {
+            ix = (-(*n) + 1) * *incx + 1;
+        }
+        if (*incy < 0) {
+            iy = (-(*n) + 1) * *incy + 1;
+        }
+        i__1 = *n;
+        for (i__ = 1; i__ <= i__1; ++i__) {
+            i__2 = iy;
+            i__3 = ix;
+            zy[i__2].r = zx[i__3].r, zy[i__2].i = zx[i__3].i;
+            ix += *incx;
+            iy += *incy;
+        }
+    }
+    return 0;
+}
+#ifdef __cplusplus
+}
+#endif