From 39d0e8d5f27d6a5d8b1d969fff54a43c1776f6a5 Mon Sep 17 00:00:00 2001
From: Uwe Schulzweida <uwe.schulzweida@mpimet.mpg.de>
Date: Sat, 15 Feb 2025 11:11:06 +0100
Subject: [PATCH 1/5] Using YAC version 3.4.0
---
ChangeLog | 1 +
src/lib/yac/basic_grid.h | 12 ++
src/lib/yac/basic_grid_data.h | 9 +
src/lib/yac/sphere_part.c | 302 +++++++++++++++++++++++++++-------
src/lib/yac/sphere_part.h | 21 ++-
src/lib/yac/utils_core.h | 28 ++++
src/lib/yac/yac_version.h | 2 +-
7 files changed, 313 insertions(+), 62 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 143cd96e9..4962c08b7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,7 @@
2025-02-28 Uwe Schulzweida
* Using CDI library version 2.5.1
+ * Using YAC version 3.4.0
* Version 2.5.1 release
2025-02-02 Uwe Schulzweida
diff --git a/src/lib/yac/basic_grid.h b/src/lib/yac/basic_grid.h
index ac921dd33..2efef9fa9 100644
--- a/src/lib/yac/basic_grid.h
+++ b/src/lib/yac/basic_grid.h
@@ -91,6 +91,18 @@ struct yac_basic_grid * yac_basic_grid_unstruct_ll_deg_new(
int *num_vertices_per_cell, double *x_vertices, double *y_vertices,
int *cell_to_vertex);
+struct yac_basic_grid * yac_basic_grid_cloud_new(
+ char const * name, size_t nbr_points, double *x_points, double *y_points);
+
+struct yac_basic_grid * yac_basic_grid_cloud_deg_new(
+ char const * name, size_t nbr_points, double *x_points, double *y_points);
+/*
+void yac_basic_grid_to_file_parallel(
+ struct yac_basic_grid * grid, char const * filename, MPI_Comm comm);
+*/
+void yac_basic_grid_compute_cell_areas(
+ struct yac_basic_grid * grid, double * cell_areas);
+
// YAC PUBLIC HEADER STOP
#endif // BASIC_GRID_H
diff --git a/src/lib/yac/basic_grid_data.h b/src/lib/yac/basic_grid_data.h
index d8d8880a1..3f9b2b815 100644
--- a/src/lib/yac/basic_grid_data.h
+++ b/src/lib/yac/basic_grid_data.h
@@ -71,6 +71,15 @@ struct yac_basic_grid_data yac_generate_basic_grid_data_unstruct_ll_deg(
size_t nbr_vertices, size_t nbr_cells, int *num_vertices_per_cell,
double *x_vertices, double *y_vertices, int *cell_to_vertex);
+struct yac_basic_grid_data yac_generate_basic_grid_data_cloud(
+ size_t nbr_points, double * x_points, double * y_points);
+
+struct yac_basic_grid_data yac_generate_basic_grid_data_cloud_deg(
+ size_t nbr_points, double * x_points, double * y_points);
+
+void yac_basic_grid_data_compute_cell_areas(
+ struct yac_basic_grid_data grid, double * cell_areas);
+
void yac_basic_grid_data_free(struct yac_basic_grid_data grid);
// YAC PUBLIC HEADER STOP
diff --git a/src/lib/yac/sphere_part.c b/src/lib/yac/sphere_part.c
index bad6c17ad..1350419a3 100644
--- a/src/lib/yac/sphere_part.c
+++ b/src/lib/yac/sphere_part.c
@@ -256,7 +256,7 @@ static void partition_data (
prev_gc_norm_vector, parent_node->gc_norm_vector);
// partition data into cells that overlap with the great circle and cells
- // that are on side of the circle
+ // that are one side of the circle
size_t I_FULL_size = 0;
size_t I_size = 0;
@@ -284,7 +284,8 @@ static void partition_data (
if (compare_angles(diff_angle_gc, curr_bnd_circle.inc_angle) <= 0) {
// if gc_norm_vector or -gc_norm_vector is in the bounding circle
- if (angle.sin < curr_bnd_circle.inc_angle.sin) {
+ if ((angle.sin < curr_bnd_circle.inc_angle.sin) ||
+ (0.0 >= curr_bnd_circle.inc_angle.cos)) {
// set node type for current cell
part_data[i].node_type = I_NODE_FULL;
@@ -1095,57 +1096,6 @@ static void point_search_NN(
bnd_circle->inc_angle = best_angle;
}
-static int point_check_bnd_circle(
- struct point_sphere_part_node * node, struct bounding_circle bnd_circle) {
-
- double dot = node->gc_norm_vector[0]*bnd_circle.base_vector[0] +
- node->gc_norm_vector[1]*bnd_circle.base_vector[1] +
- node->gc_norm_vector[2]*bnd_circle.base_vector[2];
-
- int ret = 0;
-
- // angle + inc_angle >= M_PI_2
- if (dot <= bnd_circle.inc_angle.sin) {
-
- if (node->flags & U_IS_LEAF) {
-
- struct point_id_xyz * U = (struct point_id_xyz *)(node->U);
- size_t U_size = node->U_size;
- for (size_t i = 0; i < U_size; ++i) {
- double cos_angle =
- U[i].coordinates_xyz[0] * bnd_circle.base_vector[0] +
- U[i].coordinates_xyz[1] * bnd_circle.base_vector[1] +
- U[i].coordinates_xyz[2] * bnd_circle.base_vector[2];
- if (cos_angle > bnd_circle.inc_angle.cos) return 1;
- }
-
- } else {
- ret = point_check_bnd_circle(node->U, bnd_circle);
- }
- }
-
- // angle - inc_angle < M_PI_2
- if ((!ret) && (dot > - bnd_circle.inc_angle.sin)) {
-
- if (node->flags & T_IS_LEAF) {
-
- struct point_id_xyz * T = (struct point_id_xyz *)(node->T);
- size_t T_size = node->T_size;
- for (size_t i = 0; i < T_size; ++i) {
- double cos_angle =
- T[i].coordinates_xyz[0] * bnd_circle.base_vector[0] +
- T[i].coordinates_xyz[1] * bnd_circle.base_vector[1] +
- T[i].coordinates_xyz[2] * bnd_circle.base_vector[2];
- if (cos_angle > bnd_circle.inc_angle.cos) return 1;
- }
-
- } else {
- ret = point_check_bnd_circle(node->T, bnd_circle);
- }
- }
-
- return ret;
-}
static inline int leaf_contains_matching_point(
struct point_id_xyz * points, size_t num_points, double coordinate_xyz[3],
@@ -1710,12 +1660,250 @@ void yac_point_sphere_part_search_NNN(struct point_sphere_part_search * search,
free(dot_stack);
}
-int yac_point_sphere_part_search_bnd_circle_contains_points(
- struct point_sphere_part_search * search, struct bounding_circle circle) {
+void yac_point_sphere_part_search_NNN_bnd_circle(
+ struct point_sphere_part_search * search,
+ size_t num_bnd_circles, struct bounding_circle * bnd_circles,
+ size_t n, size_t ** local_point_ids, size_t * local_point_ids_array_size,
+ size_t * num_local_point_ids) {
+
+ if (num_bnd_circles == 0) return;
+
+ if (search == NULL) {
+ memset(
+ num_local_point_ids, 0, num_bnd_circles * sizeof(*num_local_point_ids));
+ return;
+ }
+
+ struct point_sphere_part_node * base_node = &(search->base_node);
+
+ size_t total_num_local_point_ids = 0;
+
+ double * dot_stack = xmalloc(search->max_tree_depth * sizeof(*dot_stack));
+ struct point_sphere_part_node ** node_stack =
+ xmalloc(search->max_tree_depth * sizeof(*node_stack));
+ int * flags = xmalloc(search->max_tree_depth * sizeof(*flags));
+
+ struct point_id_xyz_angle * results = NULL;
+ size_t results_array_size = 0;
+
+ for (size_t i = 0; i < num_bnd_circles; ++i) {
+
+ struct point_sphere_part_node * curr_node = base_node;
- if (search == NULL) return 0;
+ double * curr_coordinates_xyz = bnd_circles[i].base_vector;
+
+ size_t curr_tree_depth = 0;
+ struct point_id_xyz * points = search->points;
+ size_t curr_num_points = 0;
+
+ // get the matching leaf for the current point
+ do {
+
+ double dot = curr_node->gc_norm_vector[0]*curr_coordinates_xyz[0] +
+ curr_node->gc_norm_vector[1]*curr_coordinates_xyz[1] +
+ curr_node->gc_norm_vector[2]*curr_coordinates_xyz[2];
+
+ dot_stack[curr_tree_depth] = dot;
+ node_stack[curr_tree_depth] = curr_node;
+ flags[curr_tree_depth] = 0;
+
+ // angle >= M_PI_2
+ if (dot <= 0.0) {
+
+ if (curr_node->U_size < n) {
+
+ flags[curr_tree_depth] = U_FLAG + T_FLAG;
+ curr_num_points = curr_node->U_size + curr_node->T_size;
+ break;
+ } else if (curr_node->flags & U_IS_LEAF) {
+
+ flags[curr_tree_depth] = U_FLAG;
+ curr_num_points = curr_node->U_size;
+ break;
+ } else {
+
+ flags[curr_tree_depth] = U_FLAG;
+ curr_node = curr_node->U;
+ }
+
+ } else {
+
+ if (curr_node->T_size < n) {
+
+ flags[curr_tree_depth] = U_FLAG + T_FLAG;
+ curr_num_points = curr_node->U_size + curr_node->T_size;
+ break;
+ } else if (curr_node->flags & T_IS_LEAF) {
+
+ points += curr_node->U_size;
+ flags[curr_tree_depth] = T_FLAG;
+ curr_num_points = curr_node->T_size;
+ break;
+ } else {
+
+ points += curr_node->U_size;
+ flags[curr_tree_depth] = T_FLAG;
+ curr_node = curr_node->T;
+ }
+ }
+
+ curr_tree_depth++;
+ } while (1);
+
+ YAC_ASSERT(
+ curr_num_points > 0,
+ "ERROR(yac_point_sphere_part_search_NNN_bnd_circle): "
+ "insufficient number of points");
+
+ size_t num_results =
+ initial_point_bnd_search_NNN(
+ n, points, curr_num_points, curr_coordinates_xyz,
+ &results, &results_array_size);
+
+ // do a detailed search
+ point_search_NNN(
+ n, curr_coordinates_xyz, &results, &results_array_size, &num_results,
+ dot_stack, node_stack, flags, curr_tree_depth);
+
+ for (; num_results > 0; --num_results)
+ if (results[num_results-1].cos_angle >= bnd_circles[i].inc_angle.cos)
+ break;
+
+ // extract the results
+ ENSURE_ARRAY_SIZE(*local_point_ids, *local_point_ids_array_size,
+ total_num_local_point_ids + num_results);
+ size_t * local_point_ids_ =
+ (*local_point_ids) + total_num_local_point_ids;
+
+ for (size_t j = 0; j < num_results; ++j)
+ local_point_ids_[j] = results[j].point.idx;
+
+ num_local_point_ids[i] = num_results;
+ total_num_local_point_ids += num_results;
+ }
+
+ free(results);
+ free(flags);
+ free(node_stack);
+ free(dot_stack);
+}
+
+static int compare_angles_(void const * a, void const * b) {
+ struct sin_cos_angle * a_ = (struct sin_cos_angle *)a;
+ struct sin_cos_angle * b_ = (struct sin_cos_angle *)b;
+ return compare_angles(*a_, *b_);
+}
+
+void yac_point_sphere_part_search_NNN_ubound(
+ struct point_sphere_part_search * search,
+ size_t num_points, yac_coordinate_pointer coordinates_xyz,
+ size_t n, struct sin_cos_angle * angles) {
+
+ YAC_ASSERT(
+ search != NULL,
+ "ERRROR(yac_point_sphere_part_search_NNN_ubound): "
+ "invalid point sphere part search (has to be != NULL)");
+ YAC_ASSERT(
+ n > 0, "ERROR(yac_point_sphere_part_search_NNN_ubound): "
+ "invalid n (has to be > 0)")
+
+ struct sin_cos_angle * temp_angles = NULL;
+ size_t temp_angles_array_size = 0;
+
+ struct point_sphere_part_node * base_node = &(search->base_node);
+
+ for (size_t i = 0; i < num_points; ++i) {
+
+ struct point_sphere_part_node * curr_node = base_node;
+
+ double * curr_coordinates_xyz = coordinates_xyz[i];
+
+ struct point_id_xyz * points = search->points;
+ size_t curr_num_points = 0;
+
+ // get the matching leaf for the current point
+ do {
+
+ double dot = curr_node->gc_norm_vector[0]*curr_coordinates_xyz[0] +
+ curr_node->gc_norm_vector[1]*curr_coordinates_xyz[1] +
+ curr_node->gc_norm_vector[2]*curr_coordinates_xyz[2];
+
+ // angle >= M_PI_2
+ if (dot <= 0.0) {
+
+ if (curr_node->U_size < n) {
+
+ curr_num_points = curr_node->U_size + curr_node->T_size;
+ break;
+ } else if (curr_node->flags & U_IS_LEAF) {
+
+ curr_num_points = curr_node->U_size;
+ break;
+ } else {
+
+ curr_node = curr_node->U;
+ }
+
+ } else {
+
+ if (curr_node->T_size < n) {
+
+ curr_num_points = curr_node->U_size + curr_node->T_size;
+ break;
+ } else if (curr_node->flags & T_IS_LEAF) {
+
+ points += curr_node->U_size;
+ curr_num_points = curr_node->T_size;
+ break;
+ } else {
+
+ points += curr_node->U_size;
+ curr_node = curr_node->T;
+ }
+ }
+ } while (1);
+
+ YAC_ASSERT(
+ curr_num_points >= n,
+ "ERROR(yac_point_sphere_part_search_NNN_ubound): "
+ "failed to find a sufficient number of points");
+
+ // search of the closest "n" points in the current
+ // list of points
+
+ if (n == 1) {
+
+ struct sin_cos_angle best_angle =
+ get_vector_angle_2(
+ curr_coordinates_xyz, points[0].coordinates_xyz);
+ for (size_t j = 1; j < curr_num_points; ++j) {
+ struct sin_cos_angle curr_angle =
+ get_vector_angle_2(
+ curr_coordinates_xyz, points[j].coordinates_xyz);
+ if (compare_angles(best_angle, curr_angle) > 0)
+ best_angle = curr_angle;
+ }
+ angles[i] = best_angle;
+
+ } else {
+
+ // compute the angles for all current points
+ ENSURE_ARRAY_SIZE(
+ temp_angles, temp_angles_array_size, curr_num_points);
+ for (size_t j = 0; j < curr_num_points; ++j)
+ temp_angles[j] =
+ get_vector_angle_2(
+ curr_coordinates_xyz, points[j].coordinates_xyz);
+
+ qsort(
+ temp_angles, curr_num_points, sizeof(*temp_angles),
+ compare_angles_);
+
+ angles[i] = temp_angles[n-1];
+ }
+ }
- return point_check_bnd_circle(&(search->base_node), circle);
+ free(temp_angles);
}
static void search_point(struct sphere_part_node * node,
diff --git a/src/lib/yac/sphere_part.h b/src/lib/yac/sphere_part.h
index a4b1f8a4f..c5eee4b80 100644
--- a/src/lib/yac/sphere_part.h
+++ b/src/lib/yac/sphere_part.h
@@ -114,11 +114,24 @@ void yac_point_sphere_part_search_NNN(struct point_sphere_part_search * search,
size_t * num_local_point_ids);
/**
- * This routine returns true if the provided point_sphere_part_search contains
- * a point that is within the provided bounding circle.
+ * This routine does a n nearest neighbour search between the points provided to
+ * this routine and the matching yac_point_sphere_part_search_new call. The search
+ * for each provided point is limited for each point, by the bounding circle.
+ */
+void yac_point_sphere_part_search_NNN_bnd_circle(
+ struct point_sphere_part_search * search,
+ size_t num_bnd_circles, struct bounding_circle * bnd_circles,
+ size_t n, size_t ** local_point_ids, size_t * local_point_ids_array_size,
+ size_t * num_local_point_ids);
+
+/**
+ * This routine does a n nearest neighbour search and returns the
+ * angle for the furthest point.
*/
-int yac_point_sphere_part_search_bnd_circle_contains_points(
- struct point_sphere_part_search * search, struct bounding_circle circle);
+void yac_point_sphere_part_search_NNN_ubound(
+ struct point_sphere_part_search * search,
+ size_t num_points, yac_coordinate_pointer coordinates_xyz,
+ size_t n, struct sin_cos_angle * angles);
struct bnd_sphere_part_search;
struct bnd_sphere_part_search * yac_bnd_sphere_part_search_new(
diff --git a/src/lib/yac/utils_core.h b/src/lib/yac/utils_core.h
index b4879b120..6aeecb667 100644
--- a/src/lib/yac/utils_core.h
+++ b/src/lib/yac/utils_core.h
@@ -199,6 +199,34 @@ static inline void yac_remove_duplicates_size_t_3(
*n = pos + 1;
}
+/**
+ * remove duplicated entries from a list of integers
+ * @param[in,out] array array containing a sorted (ascending) list of integers
+ * @param[in,out] n number of entries in array
+ */
+static inline void yac_remove_duplicates_yac_int(
+ yac_int * array, size_t * n) {
+
+ size_t const N = *n;
+ size_t pos = 0;
+
+ if (N == 0) return;
+
+ yac_int prev = array[0];
+
+ for (size_t i = 1; i < N; ++i) {
+
+ if (array[i] == prev) continue;
+
+ prev = array[i];
+ ++pos;
+
+ if (pos != i) array[pos] = array[i];
+ }
+
+ *n = pos + 1;
+}
+
#define ASSERT(c) \
if (!(c)) {\
fprintf(stderr, "### Assertion violation: %s in %s:%d\n",\
diff --git a/src/lib/yac/yac_version.h b/src/lib/yac/yac_version.h
index 95501afd7..268ee98b2 100644
--- a/src/lib/yac/yac_version.h
+++ b/src/lib/yac/yac_version.h
@@ -1,6 +1,6 @@
#ifndef YAC_VERSION_H
#define YAC_VERSION_H
-#define YAC_VERSION "3.1.0"
+#define YAC_VERSION "3.4.0"
#endif
--
GitLab
From d47d6600b525f675cb1da0b7726f751c7f965d60 Mon Sep 17 00:00:00 2001
From: Uwe Schulzweida <uwe.schulzweida@mpimet.mpg.de>
Date: Sun, 16 Feb 2025 18:56:18 +0100
Subject: [PATCH 2/5] Added clapack
---
Makefile.am | 2 +-
configure.ac | 3 +-
src/Fillmiss.cc | 6 +-
src/Intgrid.cc | 2 +-
src/Makefile.am | 5 +-
src/Remapgrid.cc | 2 +-
src/Remapstat.cc | 2 +-
src/Samplegridicon.cc | 6 +-
src/Smooth.cc | 2 +-
src/cdo_features.cc | 2 +-
src/cellsearch_spherepart.h | 4 +-
src/cellsearch_utils.h | 2 +-
src/knndata.cc | 22 +-
src/knndata.h | 28 +
src/lib/yac/clapack/BLAS/SRC/dcopy.c | 112 +
src/lib/yac/clapack/BLAS/SRC/ddot.c | 115 +
src/lib/yac/clapack/BLAS/SRC/dgemm.c | 394 +
src/lib/yac/clapack/BLAS/SRC/dgemv.c | 317 +
src/lib/yac/clapack/BLAS/SRC/dger.c | 199 +
src/lib/yac/clapack/BLAS/SRC/dnrm2.c | 100 +
src/lib/yac/clapack/BLAS/SRC/dscal.c | 101 +
src/lib/yac/clapack/BLAS/SRC/dswap.c | 119 +
src/lib/yac/clapack/BLAS/SRC/dsymv.c | 318 +
src/lib/yac/clapack/BLAS/SRC/dsyr.c | 243 +
src/lib/yac/clapack/BLAS/SRC/dtrmm.c | 458 ++
src/lib/yac/clapack/BLAS/SRC/dtrmv.c | 350 +
src/lib/yac/clapack/BLAS/SRC/dtrsm.c | 495 ++
src/lib/yac/clapack/BLAS/SRC/idamax.c | 98 +
src/lib/yac/clapack/F2CLIBS/libf2c/close.c | 106 +
src/lib/yac/clapack/F2CLIBS/libf2c/d_lg10.c | 26 +
src/lib/yac/clapack/F2CLIBS/libf2c/d_sign.c | 23 +
src/lib/yac/clapack/F2CLIBS/libf2c/endfile.c | 165 +
src/lib/yac/clapack/F2CLIBS/libf2c/err.c | 298 +
src/lib/yac/clapack/F2CLIBS/libf2c/exit_.c | 48 +
src/lib/yac/clapack/F2CLIBS/libf2c/f77_aloc.c | 49 +
src/lib/yac/clapack/F2CLIBS/libf2c/fio.h | 146 +
src/lib/yac/clapack/F2CLIBS/libf2c/fmt.c | 535 ++
src/lib/yac/clapack/F2CLIBS/libf2c/fmt.h | 110 +
src/lib/yac/clapack/F2CLIBS/libf2c/fmtlib.c | 56 +
src/lib/yac/clapack/F2CLIBS/libf2c/fp.h | 33 +
src/lib/yac/clapack/F2CLIBS/libf2c/i_nint.c | 24 +
src/lib/yac/clapack/F2CLIBS/libf2c/open.c | 306 +
src/lib/yac/clapack/F2CLIBS/libf2c/pow_di.c | 46 +
src/lib/yac/clapack/F2CLIBS/libf2c/s_cat.c | 91 +
src/lib/yac/clapack/F2CLIBS/libf2c/s_cmp.c | 55 +
src/lib/yac/clapack/F2CLIBS/libf2c/s_copy.c | 62 +
src/lib/yac/clapack/F2CLIBS/libf2c/sfe.c | 52 +
src/lib/yac/clapack/F2CLIBS/libf2c/sig_die.c | 56 +
src/lib/yac/clapack/F2CLIBS/libf2c/sysdep1.h0 | 70 +
src/lib/yac/clapack/F2CLIBS/libf2c/util.c | 62 +
src/lib/yac/clapack/F2CLIBS/libf2c/wref.c | 299 +
src/lib/yac/clapack/F2CLIBS/libf2c/wrtfmt.c | 382 +
src/lib/yac/clapack/F2CLIBS/libf2c/wsfe.c | 83 +
src/lib/yac/clapack/INCLUDE/blaswrap.h | 165 +
src/lib/yac/clapack/INCLUDE/clapack.h | 7267 +++++++++++++++++
src/lib/yac/clapack/INCLUDE/f2c.h | 228 +
src/lib/yac/clapack/INSTALL/dlamch.c | 1006 +++
src/lib/yac/clapack/INSTALL/lsame.c | 122 +
src/lib/yac/clapack/Makefile.am | 100 +
src/lib/yac/clapack/README | 8 +
src/lib/yac/clapack/SRC/dgelq2.c | 162 +
src/lib/yac/clapack/SRC/dgelqf.c | 256 +
src/lib/yac/clapack/SRC/dgels.c | 520 ++
src/lib/yac/clapack/SRC/dgeqr2.c | 166 +
src/lib/yac/clapack/SRC/dgeqrf.c | 257 +
src/lib/yac/clapack/SRC/dgesv.c | 143 +
src/lib/yac/clapack/SRC/dgetf2.c | 198 +
src/lib/yac/clapack/SRC/dgetrf.c | 224 +
src/lib/yac/clapack/SRC/dgetri.c | 269 +
src/lib/yac/clapack/SRC/dgetrs.c | 191 +
src/lib/yac/clapack/SRC/disnan.c | 57 +
src/lib/yac/clapack/SRC/dlabad.c | 77 +
src/lib/yac/clapack/SRC/dlaisnan.c | 63 +
src/lib/yac/clapack/SRC/dlange.c | 204 +
src/lib/yac/clapack/SRC/dlapy2.c | 78 +
src/lib/yac/clapack/SRC/dlarf.c | 198 +
src/lib/yac/clapack/SRC/dlarfb.c | 779 ++
src/lib/yac/clapack/SRC/dlarfp.c | 197 +
src/lib/yac/clapack/SRC/dlarft.c | 330 +
src/lib/yac/clapack/SRC/dlascl.c | 359 +
src/lib/yac/clapack/SRC/dlaset.c | 157 +
src/lib/yac/clapack/SRC/dlassq.c | 121 +
src/lib/yac/clapack/SRC/dlaswp.c | 163 +
src/lib/yac/clapack/SRC/dlasyf.c | 726 ++
src/lib/yac/clapack/SRC/dorm2r.c | 240 +
src/lib/yac/clapack/SRC/dorml2.c | 236 +
src/lib/yac/clapack/SRC/dormlq.c | 339 +
src/lib/yac/clapack/SRC/dormqr.c | 332 +
src/lib/yac/clapack/SRC/dsytf2.c | 613 ++
src/lib/yac/clapack/SRC/dsytrf.c | 346 +
src/lib/yac/clapack/SRC/dsytri.c | 401 +
src/lib/yac/clapack/SRC/dtrti2.c | 188 +
src/lib/yac/clapack/SRC/dtrtri.c | 247 +
src/lib/yac/clapack/SRC/dtrtrs.c | 188 +
src/lib/yac/clapack/SRC/ieeeck.c | 171 +
src/lib/yac/clapack/SRC/iladlc.c | 93 +
src/lib/yac/clapack/SRC/iladlr.c | 95 +
src/lib/yac/clapack/SRC/ilaenv.c | 659 ++
src/lib/yac/clapack/SRC/iparmq.c | 287 +
src/lib/yac/clapack/SRC/xerbla.c | 70 +
src/lib/yac/{ => src}/CMakeLists.txt | 0
src/lib/yac/{ => src}/Makefile.am | 4 +
src/lib/yac/{ => src}/area.c | 0
src/lib/yac/{ => src}/area.h | 0
src/lib/yac/{ => src}/basic_grid.h | 0
src/lib/yac/{ => src}/basic_grid_data.h | 0
src/lib/yac/{ => src}/bnd_circle.c | 0
src/lib/yac/{ => src}/check_overlap.c | 0
src/lib/yac/{ => src}/clipping.c | 0
src/lib/yac/{ => src}/clipping.h | 0
src/lib/yac/{ => src}/compare_files | 0
src/lib/yac/src/compute_weights.c | 102 +
src/lib/yac/src/compute_weights.h | 10 +
src/lib/yac/{ => src}/ensure_array_size.c | 0
src/lib/yac/{ => src}/ensure_array_size.h | 0
src/lib/yac/{ => src}/field_data.h | 0
src/lib/yac/{ => src}/geometry.h | 0
src/lib/yac/{ => src}/grid_cell.c | 0
src/lib/yac/{ => src}/grid_cell.h | 0
src/lib/yac/{ => src}/intersection.c | 0
src/lib/yac/{ => src}/interval_tree.c | 0
src/lib/yac/{ => src}/interval_tree.h | 0
src/lib/yac/{ => src}/location.h | 0
src/lib/yac/{ => src}/sphere_part.c | 0
src/lib/yac/{ => src}/sphere_part.h | 0
src/lib/yac/{ => src}/utils_common.h | 0
src/lib/yac/{ => src}/utils_core.c | 0
src/lib/yac/{ => src}/utils_core.h | 0
src/lib/yac/src/yac_lapack_interface.c | 362 +
src/lib/yac/src/yac_lapack_interface.h | 125 +
src/lib/yac/{ => src}/yac_types.h | 0
src/lib/yac/{ => src}/yac_version.h | 0
src/pointsearch_spherepart.h | 4 +-
src/remap_knn.cc | 6 +-
src/remap_method_conserv.h | 6 +-
135 files changed, 26578 insertions(+), 27 deletions(-)
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dcopy.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/ddot.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dgemm.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dgemv.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dger.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dnrm2.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dscal.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dswap.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dsymv.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dsyr.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dtrmm.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dtrmv.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/dtrsm.c
create mode 100644 src/lib/yac/clapack/BLAS/SRC/idamax.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/close.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/d_lg10.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/d_sign.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/endfile.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/err.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/exit_.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/f77_aloc.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/fio.h
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/fmt.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/fmt.h
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/fmtlib.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/fp.h
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/i_nint.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/open.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/pow_di.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/s_cat.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/s_cmp.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/s_copy.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/sfe.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/sig_die.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/sysdep1.h0
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/util.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/wref.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/wrtfmt.c
create mode 100644 src/lib/yac/clapack/F2CLIBS/libf2c/wsfe.c
create mode 100644 src/lib/yac/clapack/INCLUDE/blaswrap.h
create mode 100644 src/lib/yac/clapack/INCLUDE/clapack.h
create mode 100644 src/lib/yac/clapack/INCLUDE/f2c.h
create mode 100644 src/lib/yac/clapack/INSTALL/dlamch.c
create mode 100644 src/lib/yac/clapack/INSTALL/lsame.c
create mode 100644 src/lib/yac/clapack/Makefile.am
create mode 100644 src/lib/yac/clapack/README
create mode 100644 src/lib/yac/clapack/SRC/dgelq2.c
create mode 100644 src/lib/yac/clapack/SRC/dgelqf.c
create mode 100644 src/lib/yac/clapack/SRC/dgels.c
create mode 100644 src/lib/yac/clapack/SRC/dgeqr2.c
create mode 100644 src/lib/yac/clapack/SRC/dgeqrf.c
create mode 100644 src/lib/yac/clapack/SRC/dgesv.c
create mode 100644 src/lib/yac/clapack/SRC/dgetf2.c
create mode 100644 src/lib/yac/clapack/SRC/dgetrf.c
create mode 100644 src/lib/yac/clapack/SRC/dgetri.c
create mode 100644 src/lib/yac/clapack/SRC/dgetrs.c
create mode 100644 src/lib/yac/clapack/SRC/disnan.c
create mode 100644 src/lib/yac/clapack/SRC/dlabad.c
create mode 100644 src/lib/yac/clapack/SRC/dlaisnan.c
create mode 100644 src/lib/yac/clapack/SRC/dlange.c
create mode 100644 src/lib/yac/clapack/SRC/dlapy2.c
create mode 100644 src/lib/yac/clapack/SRC/dlarf.c
create mode 100644 src/lib/yac/clapack/SRC/dlarfb.c
create mode 100644 src/lib/yac/clapack/SRC/dlarfp.c
create mode 100644 src/lib/yac/clapack/SRC/dlarft.c
create mode 100644 src/lib/yac/clapack/SRC/dlascl.c
create mode 100644 src/lib/yac/clapack/SRC/dlaset.c
create mode 100644 src/lib/yac/clapack/SRC/dlassq.c
create mode 100644 src/lib/yac/clapack/SRC/dlaswp.c
create mode 100644 src/lib/yac/clapack/SRC/dlasyf.c
create mode 100644 src/lib/yac/clapack/SRC/dorm2r.c
create mode 100644 src/lib/yac/clapack/SRC/dorml2.c
create mode 100644 src/lib/yac/clapack/SRC/dormlq.c
create mode 100644 src/lib/yac/clapack/SRC/dormqr.c
create mode 100644 src/lib/yac/clapack/SRC/dsytf2.c
create mode 100644 src/lib/yac/clapack/SRC/dsytrf.c
create mode 100644 src/lib/yac/clapack/SRC/dsytri.c
create mode 100644 src/lib/yac/clapack/SRC/dtrti2.c
create mode 100644 src/lib/yac/clapack/SRC/dtrtri.c
create mode 100644 src/lib/yac/clapack/SRC/dtrtrs.c
create mode 100644 src/lib/yac/clapack/SRC/ieeeck.c
create mode 100644 src/lib/yac/clapack/SRC/iladlc.c
create mode 100644 src/lib/yac/clapack/SRC/iladlr.c
create mode 100644 src/lib/yac/clapack/SRC/ilaenv.c
create mode 100644 src/lib/yac/clapack/SRC/iparmq.c
create mode 100644 src/lib/yac/clapack/SRC/xerbla.c
rename src/lib/yac/{ => src}/CMakeLists.txt (100%)
rename src/lib/yac/{ => src}/Makefile.am (87%)
rename src/lib/yac/{ => src}/area.c (100%)
rename src/lib/yac/{ => src}/area.h (100%)
rename src/lib/yac/{ => src}/basic_grid.h (100%)
rename src/lib/yac/{ => src}/basic_grid_data.h (100%)
rename src/lib/yac/{ => src}/bnd_circle.c (100%)
rename src/lib/yac/{ => src}/check_overlap.c (100%)
rename src/lib/yac/{ => src}/clipping.c (100%)
rename src/lib/yac/{ => src}/clipping.h (100%)
rename src/lib/yac/{ => src}/compare_files (100%)
create mode 100644 src/lib/yac/src/compute_weights.c
create mode 100644 src/lib/yac/src/compute_weights.h
rename src/lib/yac/{ => src}/ensure_array_size.c (100%)
rename src/lib/yac/{ => src}/ensure_array_size.h (100%)
rename src/lib/yac/{ => src}/field_data.h (100%)
rename src/lib/yac/{ => src}/geometry.h (100%)
rename src/lib/yac/{ => src}/grid_cell.c (100%)
rename src/lib/yac/{ => src}/grid_cell.h (100%)
rename src/lib/yac/{ => src}/intersection.c (100%)
rename src/lib/yac/{ => src}/interval_tree.c (100%)
rename src/lib/yac/{ => src}/interval_tree.h (100%)
rename src/lib/yac/{ => src}/location.h (100%)
rename src/lib/yac/{ => src}/sphere_part.c (100%)
rename src/lib/yac/{ => src}/sphere_part.h (100%)
rename src/lib/yac/{ => src}/utils_common.h (100%)
rename src/lib/yac/{ => src}/utils_core.c (100%)
rename src/lib/yac/{ => src}/utils_core.h (100%)
create mode 100644 src/lib/yac/src/yac_lapack_interface.c
create mode 100644 src/lib/yac/src/yac_lapack_interface.h
rename src/lib/yac/{ => src}/yac_types.h (100%)
rename src/lib/yac/{ => src}/yac_version.h (100%)
diff --git a/Makefile.am b/Makefile.am
index a8e271456..de1faf5bf 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -1,6 +1,6 @@
# Process this file with automake to produce Makefile.in
-SUBDIRS = libcdi src/lib/ncl src/lib/yac src/lib/gradsdes src/lib/healpix src contrib test/data test/pytest
+SUBDIRS = libcdi src/lib/ncl src/lib/yac/clapack src/lib/yac/src src/lib/gradsdes src/lib/healpix src contrib test/data test/pytest
if MAINTAINER_MODE
SUBDIRS += test/bandit_tests test/executeOnly
endif
diff --git a/configure.ac b/configure.ac
index 3996b7fd2..075839b1f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -295,7 +295,8 @@ AC_CONFIG_FILES([test/executeOnly/Splitsel.test], [chmod a+x "$ac_file"])
#Cdo Options
AC_CONFIG_FILES([contrib/Makefile cdo.spec cdo.settings])
#Makefiles
-AC_CONFIG_FILES([Makefile src/lib/ncl/Makefile src/lib/yac/Makefile src/lib/gradsdes/Makefile src/lib/healpix/Makefile src/Makefile])
+AC_CONFIG_FILES([Makefile src/lib/ncl/Makefile src/lib/yac/src/Makefile src/lib/gradsdes/Makefile src/lib/healpix/Makefile src/Makefile])
+AC_CONFIG_FILES([src/lib/yac/clapack/Makefile])
#Test Makefiles
AC_CONFIG_FILES([test/data/Makefile test/executeOnly/Makefile test/bandit_tests/Makefile test/pytest/Makefile])
AC_OUTPUT
diff --git a/src/Fillmiss.cc b/src/Fillmiss.cc
index 457566362..2996ba59c 100644
--- a/src/Fillmiss.cc
+++ b/src/Fillmiss.cc
@@ -311,8 +311,8 @@ setmisstodis(Varray<T1> &vIn, Varray<T2> &vOut, int gridID, size_t numMissVals,
if (nv != nvals) cdo_abort("Internal problem, number of valid values differ!");
- std::vector<KnnData> knnDataMem;
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataMem.push_back(KnnData(numNeighbors));
+ std::vector<KnnData> knnDataList;
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(numNeighbors);
cdo::timer timer;
@@ -341,7 +341,7 @@ setmisstodis(Varray<T1> &vIn, Varray<T2> &vOut, int gridID, size_t numMissVals,
auto ompthID = cdo_omp_get_thread_num();
if (ompthID == 0 && numMissVals > progressMinSize) progress.update((double) atomicCount / numMissVals);
- auto &knnData = knnDataMem[ompthID];
+ auto &knnData = knnDataList[ompthID];
grid_search_point_unstruct(gps, PointLonLat{ xvals[mindex[i]], yvals[mindex[i]] }, knnData);
diff --git a/src/Intgrid.cc b/src/Intgrid.cc
index af6a138c7..aa8a770bb 100644
--- a/src/Intgrid.cc
+++ b/src/Intgrid.cc
@@ -307,7 +307,7 @@ public:
{
auto remapParams = remapknn_get_parameter();
if (Options::cdoVerbose) remapknn_print_parameter(remapParams);
- if (remapParams.gridString.empty()) cdo_abort("grid parameter missing!");
+ if (remapParams.gridString.empty()) cdo_abort("target grid parameter missing!");
gridID2 = cdo_define_grid(remapParams.gridString);
knnParams = remapParams.knnParams;
if (knnParams.kMin == 0) knnParams.kMin = knnParams.k;
diff --git a/src/Makefile.am b/src/Makefile.am
index 969e99c42..d4ce11d01 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -552,10 +552,11 @@ cdo_SOURCES += Maggraph.cc \
cdo_magics_mapper.cc
#endif
-cdo_CPPFLAGS = -I$(top_srcdir)/libcdi/src -I$(top_srcdir)/src/mpim_grid
+cdo_CPPFLAGS = -I$(top_srcdir)/libcdi/src -I$(top_srcdir)/src/mpim_grid -I$(top_srcdir)/src/lib/yac/clapack/INCLUDE
cdo_CPPFLAGS += -DYAC_FOR_CDO
cdo_LDADD = libcdo.la $(top_builddir)/libcdi/src/libcdi.la
-cdo_LDADD += $(top_builddir)/src/lib/yac/libyac.la
+cdo_LDADD += $(top_builddir)/src/lib/yac/src/libyac.la
+cdo_LDADD += $(top_builddir)/src/lib/yac/clapack/libyac_clapack.la
cdo_LDADD += $(top_builddir)/src/lib/gradsdes/libgradsdes.la
cdo_LDADD += $(top_builddir)/src/lib/healpix/libhealpix.la
if USE_F77
diff --git a/src/Remapgrid.cc b/src/Remapgrid.cc
index 0cfc74045..3f06af9cc 100644
--- a/src/Remapgrid.cc
+++ b/src/Remapgrid.cc
@@ -462,7 +462,7 @@ public:
{
auto remapParams = remapknn_get_parameter();
if (Options::cdoVerbose) remapknn_print_parameter(remapParams);
- if (remapParams.gridString.empty()) cdo_abort("grid parameter missing!");
+ if (remapParams.gridString.empty()) cdo_abort("target grid parameter missing!");
targetGridName = remapParams.gridString;
knnParams = remapParams.knnParams;
if (knnParams.kMin == 0) knnParams.kMin = knnParams.k;
diff --git a/src/Remapstat.cc b/src/Remapstat.cc
index 08cb3e07a..1925c61be 100644
--- a/src/Remapstat.cc
+++ b/src/Remapstat.cc
@@ -28,7 +28,7 @@
#ifdef USE_YAC
extern "C"
{
-#include "lib/yac/geometry.h"
+#include "lib/yac/src/geometry.h"
}
#endif
#endif
diff --git a/src/Samplegridicon.cc b/src/Samplegridicon.cc
index 555a222ba..2d9f26229 100644
--- a/src/Samplegridicon.cc
+++ b/src/Samplegridicon.cc
@@ -310,8 +310,8 @@ compute_child_from_bounds(CellIndex &cellindex2, Varray<double> &grid_center_lon
int ncorner = 3;
constexpr int MaxSearch = 128;
- std::vector<KnnData> knnDataMem;
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataMem.push_back(KnnData(MaxSearch));
+ std::vector<KnnData> knnDataList;
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(MaxSearch);
cellindex2.child.resize(MAX_CHILDS * ncells2);
auto &child2 = cellindex2.child;
@@ -342,7 +342,7 @@ compute_child_from_bounds(CellIndex &cellindex2, Varray<double> &grid_center_lon
if (isClockwise) continue;
auto ompthID = cdo_omp_get_thread_num();
- auto &knnData = knnDataMem[ompthID];
+ auto &knnData = knnDataList[ompthID];
grid_search_point_unstruct(gps, PointLonLat{ grid_center_lon2[cellNo2], grid_center_lat2[cellNo2] }, knnData);
diff --git a/src/Smooth.cc b/src/Smooth.cc
index 43536cb6a..90bc4af42 100644
--- a/src/Smooth.cc
+++ b/src/Smooth.cc
@@ -72,7 +72,7 @@ smooth(int gridID, double mv, const Varray<T1> &array1, Varray<T2> &array2, cons
knnParams.weightR = spoint.weightR;
std::vector<KnnData> knnDataList;
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.push_back(KnnData(knnParams));
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(knnParams);
cdo::timer timer;
diff --git a/src/cdo_features.cc b/src/cdo_features.cc
index 0623e69d9..d0885fa0b 100644
--- a/src/cdo_features.cc
+++ b/src/cdo_features.cc
@@ -65,7 +65,7 @@ extern "C"
#include "mpmo_color.h"
#include "util_string.h"
#include "cpp_lib.h"
-#include "lib/yac/yac_version.h"
+#include "lib/yac/src/yac_version.h"
#include <thread> // std::thread::hardware_concurrency()
diff --git a/src/cellsearch_spherepart.h b/src/cellsearch_spherepart.h
index b5669b995..9315937e4 100644
--- a/src/cellsearch_spherepart.h
+++ b/src/cellsearch_spherepart.h
@@ -16,8 +16,8 @@
#include "grid_convert.h"
extern "C"
{
-#include "lib/yac/grid_cell.h"
-#include "lib/yac/sphere_part.h"
+#include "lib/yac/src/grid_cell.h"
+#include "lib/yac/src/sphere_part.h"
}
class CellsearchSpherepart : public CellsearchStrategy
diff --git a/src/cellsearch_utils.h b/src/cellsearch_utils.h
index 3f12ea62b..e667a83cf 100644
--- a/src/cellsearch_utils.h
+++ b/src/cellsearch_utils.h
@@ -12,7 +12,7 @@
extern "C"
{
-#include "lib/yac/grid_cell.h"
+#include "lib/yac/src/grid_cell.h"
}
struct GridCell
diff --git a/src/knndata.cc b/src/knndata.cc
index 580210f23..cbb4a43c3 100644
--- a/src/knndata.cc
+++ b/src/knndata.cc
@@ -1,3 +1,5 @@
+#include <cassert>
+#include <cstddef>
#include "knndata.h"
#include "cdo_output.h"
#include "interpol.h"
@@ -9,6 +11,7 @@ weightingMethod_to_string(WeightingMethod method)
if (method == WeightingMethod::distanceWeighted) return "dist";
if (method == WeightingMethod::linear) return "linear";
if (method == WeightingMethod::gaussWeighted) return "gauss";
+ if (method == WeightingMethod::rbf) return "rbf";
return "";
}
@@ -20,6 +23,7 @@ string_to_weightingMethod(const std::string &methodStr)
if (methodStr == "dist") return WeightingMethod::distanceWeighted;
if (methodStr == "linear") return WeightingMethod::linear;
if (methodStr == "gauss") return WeightingMethod::gaussWeighted;
+ if (methodStr == "rbf") return WeightingMethod::rbf;
cdo_abort("method=%s unsupported (available: avg|dist|linear|gauss)", methodStr);
@@ -153,7 +157,7 @@ KnnData::compute_weights_gauss()
double weights_sum = 0.0;
for (size_t i = 0; i < n; ++i)
{
- weights[i] = exp(scale * weights[i]);
+ weights[i] = std::exp(scale * weights[i]);
weights_sum += weights[i];
}
@@ -174,3 +178,19 @@ KnnData::compute_weights_gauss()
return n;
}
+
+extern "C"
+{
+#include "lib/yac/src/compute_weights.h"
+}
+
+size_t
+KnnData::compute_weights_rbf()
+{
+ size_t n = m_numNeighbors;
+ double tgt_coord[3];
+ yac_coordinate_pointer src_coords = nullptr;
+ double *weights = nullptr;
+ yac_compute_weights_rbf(tgt_coord, src_coords, n, weights, m_rbfScale);
+ return n;
+}
diff --git a/src/knndata.h b/src/knndata.h
index b3f8f3bd0..8000c0a09 100644
--- a/src/knndata.h
+++ b/src/knndata.h
@@ -14,6 +14,7 @@
#include <cstddef>
#include <cstdint>
#include <vector>
+#include <memory>
#include "cdo_math.h"
#include "varray.h"
@@ -24,6 +25,7 @@ enum struct WeightingMethod
arithmeticAverage,
distanceWeighted,
gaussWeighted,
+ rbf,
linear,
};
@@ -36,6 +38,7 @@ struct KnnParams
size_t kMin{ 0 };
double maxSearchDistance{ 0.0 };
double gaussScale{ 1.0 };
+ double rbfScale{ 1.0 };
WeightingMethod weighted{ WeightingMethod::distanceWeighted };
bool extrapolate{ false };
// linear
@@ -48,8 +51,10 @@ class KnnData
{
private:
size_t m_kMin{ 0 };
+ size_t m_maxPoints{ 0 };
size_t m_maxNeighbors{ 0 };
double m_gaussScale{ 1.0 };
+ double m_rbfScale{ 1.0 };
// linear
double m_searchRadius{ 0.0 };
double m_weight0{ 1.0 };
@@ -61,6 +66,7 @@ private:
size_t compute_weights_dist();
size_t compute_weights_linear();
size_t compute_weights_gauss();
+ size_t compute_weights_rbf();
public:
WeightingMethod m_weighted{ WeightingMethod::distanceWeighted };
@@ -70,12 +76,16 @@ public:
std::vector<size_t> m_tmpIndices;
std::vector<double> m_tmpDist;
std::vector<std::array<double, 3>> m_srcCoords;
+ std::unique_ptr<double[][3]> xm_srcCoords;
inline void
init()
{
m_indices.resize(m_maxNeighbors);
m_dist.resize(m_maxNeighbors);
+ // check some more points if distance is the same use the smaller index
+ m_maxPoints = (m_maxNeighbors > 8) ? m_maxNeighbors + 8 : m_maxNeighbors * 2;
+ if (m_weighted == WeightingMethod::gaussWeighted) { xm_srcCoords = std::make_unique<double[][3]>(m_maxPoints); }
}
explicit KnnData(KnnParams knnParams)
@@ -84,6 +94,7 @@ public:
m_kMin = knnParams.kMin;
m_weighted = knnParams.weighted;
m_gaussScale = knnParams.gaussScale;
+ m_rbfScale = knnParams.rbfScale;
m_searchRadius = knnParams.searchRadius;
m_weight0 = knnParams.weight0;
m_weightR = knnParams.weightR;
@@ -91,6 +102,22 @@ public:
init();
}
explicit KnnData(size_t maxNeighbors) : m_maxNeighbors(maxNeighbors) { init(); }
+ explicit KnnData(KnnData &&other)
+ {
+ m_maxNeighbors = other.m_maxNeighbors;
+ m_kMin = other.m_kMin;
+ m_weighted = other.m_weighted;
+ m_gaussScale = other.m_gaussScale;
+ m_rbfScale = other.m_rbfScale;
+ m_searchRadius = other.m_searchRadius;
+ m_weight0 = other.m_weight0;
+ m_weightR = other.m_weightR;
+
+ m_maxPoints = other.m_maxPoints;
+ m_indices = std::move(other.m_indices);
+ m_dist = std::move(other.m_dist);
+ xm_srcCoords = std::move(other.xm_srcCoords);
+ }
~KnnData() {}
inline size_t
@@ -148,6 +175,7 @@ public:
if (m_weighted == WeightingMethod::distanceWeighted) return compute_weights_dist();
if (m_weighted == WeightingMethod::linear) return compute_weights_linear();
if (m_weighted == WeightingMethod::gaussWeighted) return compute_weights_gauss();
+ if (m_weighted == WeightingMethod::rbf) return compute_weights_rbf();
return 0;
}
diff --git a/src/lib/yac/clapack/BLAS/SRC/dcopy.c b/src/lib/yac/clapack/BLAS/SRC/dcopy.c
new file mode 100644
index 000000000..3a06af9cd
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dcopy.c
@@ -0,0 +1,112 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dcopy.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ integer i__, m, ix, iy, mp1;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* copies a vector, x, to a vector, y. */
+/* uses unrolled loops for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if (*incx == 1 && *incy == 1) {
+ goto L20;
+ }
+
+/* code for unequal increments or equal increments */
+/* not equal to 1 */
+
+ 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__) {
+ dy[iy] = dx[ix];
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+
+/* clean-up loop */
+
+L20:
+ m = *n % 7;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dy[i__] = dx[i__];
+/* L30: */
+ }
+ if (*n < 7) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 7) {
+ dy[i__] = dx[i__];
+ dy[i__ + 1] = dx[i__ + 1];
+ dy[i__ + 2] = dx[i__ + 2];
+ dy[i__ + 3] = dx[i__ + 3];
+ dy[i__ + 4] = dx[i__ + 4];
+ dy[i__ + 5] = dx[i__ + 5];
+ dy[i__ + 6] = dx[i__ + 6];
+/* L50: */
+ }
+ return 0;
+} /* dcopy_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/ddot.c b/src/lib/yac/clapack/BLAS/SRC/ddot.c
new file mode 100644
index 000000000..e4cdb2010
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/ddot.c
@@ -0,0 +1,115 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* ddot.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
+ integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val;
+
+ /* Local variables */
+ integer i__, m, ix, iy, mp1;
+ doublereal dtemp;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* forms the dot product of two vectors. */
+/* uses unrolled loops for increments equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ ret_val = 0.;
+ dtemp = 0.;
+ if (*n <= 0) {
+ return ret_val;
+ }
+ if (*incx == 1 && *incy == 1) {
+ goto L20;
+ }
+
+/* code for unequal increments or equal increments */
+/* not equal to 1 */
+
+ 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__) {
+ dtemp += dx[ix] * dy[iy];
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ ret_val = dtemp;
+ return ret_val;
+
+/* code for both increments equal to 1 */
+
+
+/* clean-up loop */
+
+L20:
+ m = *n % 5;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp += dx[i__] * dy[i__];
+/* L30: */
+ }
+ if (*n < 5) {
+ goto L60;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 5) {
+ dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
+ i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +
+ 4] * dy[i__ + 4];
+/* L50: */
+ }
+L60:
+ ret_val = dtemp;
+ return ret_val;
+} /* ddot_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dgemm.c b/src/lib/yac/clapack/BLAS/SRC/dgemm.c
new file mode 100644
index 000000000..d4717be47
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dgemm.c
@@ -0,0 +1,394 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgemm.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,
+ integer *ldc)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
+ i__3;
+
+ /* Local variables */
+ integer i__, j, l, info;
+ logical nota, notb;
+ doublereal temp;
+ integer ncola;
+ extern logical lsame_(char *, char *);
+ integer nrowa, nrowb;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGEMM performs one of the matrix-matrix operations */
+
+/* C := alpha*op( A )*op( B ) + beta*C, */
+
+/* where op( X ) is one of */
+
+/* op( X ) = X or op( X ) = X', */
+
+/* alpha and beta are scalars, and A, B and C are matrices, with op( A ) */
+/* an m by k matrix, op( B ) a k by n matrix and C an m by n matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+
+/* TRANSA = 'N' or 'n', op( A ) = A. */
+
+/* TRANSA = 'T' or 't', op( A ) = A'. */
+
+/* TRANSA = 'C' or 'c', op( A ) = A'. */
+
+/* Unchanged on exit. */
+
+/* TRANSB - CHARACTER*1. */
+/* On entry, TRANSB specifies the form of op( B ) to be used in */
+/* the matrix multiplication as follows: */
+
+/* TRANSB = 'N' or 'n', op( B ) = B. */
+
+/* TRANSB = 'T' or 't', op( B ) = B'. */
+
+/* TRANSB = 'C' or 'c', op( B ) = B'. */
+
+/* Unchanged on exit. */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix */
+/* op( A ) and of the matrix C. M must be at least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix */
+/* op( B ) and the number of columns of the matrix C. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+
+/* K - INTEGER. */
+/* On entry, K specifies the number of columns of the matrix */
+/* op( A ) and the number of rows of the matrix op( B ). K must */
+/* be at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, ka ), where ka is */
+/* k when TRANSA = 'N' or 'n', and is m otherwise. */
+/* Before entry with TRANSA = 'N' or 'n', the leading m by k */
+/* part of the array A must contain the matrix A, otherwise */
+/* the leading k by m part of the array A must contain the */
+/* matrix A. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When TRANSA = 'N' or 'n' then */
+/* LDA must be at least max( 1, m ), otherwise LDA must be at */
+/* least max( 1, k ). */
+/* Unchanged on exit. */
+
+/* B - DOUBLE PRECISION array of DIMENSION ( LDB, kb ), where kb is */
+/* n when TRANSB = 'N' or 'n', and is k otherwise. */
+/* Before entry with TRANSB = 'N' or 'n', the leading k by n */
+/* part of the array B must contain the matrix B, otherwise */
+/* the leading n by k part of the array B must contain the */
+/* matrix B. */
+/* Unchanged on exit. */
+
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. When TRANSB = 'N' or 'n' then */
+/* LDB must be at least max( 1, k ), otherwise LDB must be at */
+/* least max( 1, n ). */
+/* Unchanged on exit. */
+
+/* BETA - DOUBLE PRECISION. */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then C need not be set on input. */
+/* Unchanged on exit. */
+
+/* C - DOUBLE PRECISION array of DIMENSION ( LDC, n ). */
+/* Before entry, the leading m by n part of the array C must */
+/* contain the matrix C, except when beta is zero, in which */
+/* case C need not be set on entry. */
+/* On exit, the array C is overwritten by the m by n matrix */
+/* ( alpha*op( A )*op( B ) + beta*C ). */
+
+/* LDC - INTEGER. */
+/* On entry, LDC specifies the first dimension of C as declared */
+/* in the calling (sub) program. LDC must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Parameters .. */
+/* .. */
+
+/* Set NOTA and NOTB as true if A and B respectively are not */
+/* transposed and set NROWA, NCOLA and NROWB as the number of rows */
+/* and columns of A and the number of rows of B respectively. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+
+ /* Function Body */
+ nota = lsame_(transa, "N");
+ notb = lsame_(transb, "N");
+ if (nota) {
+ nrowa = *m;
+ ncola = *k;
+ } else {
+ nrowa = *k;
+ ncola = *m;
+ }
+ if (notb) {
+ nrowb = *k;
+ } else {
+ nrowb = *n;
+ }
+
+/* Test the input parameters. */
+
+ info = 0;
+ if (! nota && ! lsame_(transa, "C") && ! lsame_(
+ transa, "T")) {
+ info = 1;
+ } else if (! notb && ! lsame_(transb, "C") && !
+ lsame_(transb, "T")) {
+ info = 2;
+ } else if (*m < 0) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*k < 0) {
+ info = 5;
+ } else if (*lda < max(1,nrowa)) {
+ info = 8;
+ } else if (*ldb < max(1,nrowb)) {
+ info = 10;
+ } else if (*ldc < max(1,*m)) {
+ info = 13;
+ }
+ if (info != 0) {
+ xerbla_("DGEMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || (*alpha == 0. || *k == 0) && *beta == 1.) {
+ return 0;
+ }
+
+/* And if alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L30: */
+ }
+/* L40: */
+ }
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (notb) {
+ if (nota) {
+
+/* Form C := alpha*A*B + beta*C. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L50: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L60: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[l + j * b_dim1] != 0.) {
+ temp = *alpha * b[l + j * b_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L70: */
+ }
+ }
+/* L80: */
+ }
+/* L90: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * b[l + j * b_dim1];
+/* L100: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L110: */
+ }
+/* L120: */
+ }
+ }
+ } else {
+ if (nota) {
+
+/* Form C := alpha*A*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*beta == 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = 0.;
+/* L130: */
+ }
+ } else if (*beta != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] = *beta * c__[i__ + j * c_dim1];
+/* L140: */
+ }
+ }
+ i__2 = *k;
+ for (l = 1; l <= i__2; ++l) {
+ if (b[j + l * b_dim1] != 0.) {
+ temp = *alpha * b[j + l * b_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ c__[i__ + j * c_dim1] += temp * a[i__ + l *
+ a_dim1];
+/* L150: */
+ }
+ }
+/* L160: */
+ }
+/* L170: */
+ }
+ } else {
+
+/* Form C := alpha*A'*B' + beta*C */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = 0.;
+ i__3 = *k;
+ for (l = 1; l <= i__3; ++l) {
+ temp += a[l + i__ * a_dim1] * b[j + l * b_dim1];
+/* L180: */
+ }
+ if (*beta == 0.) {
+ c__[i__ + j * c_dim1] = *alpha * temp;
+ } else {
+ c__[i__ + j * c_dim1] = *alpha * temp + *beta * c__[
+ i__ + j * c_dim1];
+ }
+/* L190: */
+ }
+/* L200: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DGEMM . */
+
+} /* dgemm_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dgemv.c b/src/lib/yac/clapack/BLAS/SRC/dgemv.c
new file mode 100644
index 000000000..c5ee6dba7
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dgemv.c
@@ -0,0 +1,317 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgemv.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
+ alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ doublereal temp;
+ integer lenx, leny;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGEMV performs one of the matrix-vector operations */
+
+/* y := alpha*A*x + beta*y, or y := alpha*A'*x + beta*y, */
+
+/* where alpha and beta are scalars, x and y are vectors and A is an */
+/* m by n matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the operation to be performed as */
+/* follows: */
+
+/* TRANS = 'N' or 'n' y := alpha*A*x + beta*y. */
+
+/* TRANS = 'T' or 't' y := alpha*A'*x + beta*y. */
+
+/* TRANS = 'C' or 'c' y := alpha*A'*x + beta*y. */
+
+/* Unchanged on exit. */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix A. */
+/* M must be at least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry, the leading m by n part of the array A must */
+/* contain the matrix of coefficients. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of DIMENSION at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ) when TRANS = 'N' or 'n' */
+/* and at least */
+/* ( 1 + ( m - 1 )*abs( INCX ) ) otherwise. */
+/* Before entry, the incremented array X must contain the */
+/* vector x. */
+/* Unchanged on exit. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+/* BETA - DOUBLE PRECISION. */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then Y need not be set on input. */
+/* Unchanged on exit. */
+
+/* Y - DOUBLE PRECISION array of DIMENSION at least */
+/* ( 1 + ( m - 1 )*abs( INCY ) ) when TRANS = 'N' or 'n' */
+/* and at least */
+/* ( 1 + ( n - 1 )*abs( INCY ) ) otherwise. */
+/* Before entry with BETA non-zero, the incremented array Y */
+/* must contain the vector y. On exit, Y is overwritten by the */
+/* updated vector y. */
+
+/* INCY - INTEGER. */
+/* On entry, INCY specifies the increment for the elements of */
+/* Y. INCY must not be zero. */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if (! lsame_(trans, "N") && ! lsame_(trans, "T") && ! lsame_(trans, "C")
+ ) {
+ info = 1;
+ } else if (*m < 0) {
+ info = 2;
+ } else if (*n < 0) {
+ info = 3;
+ } else if (*lda < max(1,*m)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ } else if (*incy == 0) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DGEMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || *alpha == 0. && *beta == 1.) {
+ return 0;
+ }
+
+/* Set LENX and LENY, the lengths of the vectors x and y, and set */
+/* up the start points in X and Y. */
+
+ if (lsame_(trans, "N")) {
+ lenx = *n;
+ leny = *m;
+ } else {
+ lenx = *m;
+ leny = *n;
+ }
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (lenx - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (leny - 1) * *incy;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+/* First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = leny;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ if (lsame_(trans, "N")) {
+
+/* Form y := alpha*A*x + y. */
+
+ jx = kx;
+ if (*incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp * a[i__ + j * a_dim1];
+/* L50: */
+ }
+ }
+ jx += *incx;
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = *alpha * x[jx];
+ iy = ky;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[iy] += temp * a[i__ + j * a_dim1];
+ iy += *incy;
+/* L70: */
+ }
+ }
+ jx += *incx;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y := alpha*A'*x + y. */
+
+ jy = ky;
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = 0.;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+/* L100: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = 0.;
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+/* L110: */
+ }
+ y[jy] += *alpha * temp;
+ jy += *incy;
+/* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DGEMV . */
+
+} /* dgemv_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dger.c b/src/lib/yac/clapack/BLAS/SRC/dger.c
new file mode 100644
index 000000000..2335187be
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dger.c
@@ -0,0 +1,199 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dger.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, ix, jy, kx, info;
+ doublereal temp;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGER performs the rank 1 operation */
+
+/* A := alpha*x*y' + A, */
+
+/* where alpha is a scalar, x is an m element vector, y is an n element */
+/* vector and A is an m by n matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of the matrix A. */
+/* M must be at least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( m - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the m */
+/* element vector x. */
+/* Unchanged on exit. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+/* Y - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCY ) ). */
+/* Before entry, the incremented array Y must contain the n */
+/* element vector y. */
+/* Unchanged on exit. */
+
+/* INCY - INTEGER. */
+/* On entry, INCY specifies the increment for the elements of */
+/* Y. INCY must not be zero. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry, the leading m by n part of the array A must */
+/* contain the matrix of coefficients. On exit, A is */
+/* overwritten by the updated matrix. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ --x;
+ --y;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (*m < 0) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*incx == 0) {
+ info = 5;
+ } else if (*incy == 0) {
+ info = 7;
+ } else if (*lda < max(1,*m)) {
+ info = 9;
+ }
+ if (info != 0) {
+ xerbla_("DGER ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0 || *alpha == 0.) {
+ return 0;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (*incy > 0) {
+ jy = 1;
+ } else {
+ jy = 1 - (*n - 1) * *incy;
+ }
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] += x[i__] * temp;
+/* L10: */
+ }
+ }
+ jy += *incy;
+/* L20: */
+ }
+ } else {
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*m - 1) * *incx;
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (y[jy] != 0.) {
+ temp = *alpha * y[jy];
+ ix = kx;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] += x[ix] * temp;
+ ix += *incx;
+/* L30: */
+ }
+ }
+ jy += *incy;
+/* L40: */
+ }
+ }
+
+ return 0;
+
+/* End of DGER . */
+
+} /* dger_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dnrm2.c b/src/lib/yac/clapack/BLAS/SRC/dnrm2.c
new file mode 100644
index 000000000..4119b52b1
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dnrm2.c
@@ -0,0 +1,100 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dnrm2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+doublereal dnrm2_(integer *n, doublereal *x, integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal ret_val, d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ integer ix;
+ doublereal ssq, norm, scale, absxi;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DNRM2 returns the euclidean norm of a vector via the function */
+/* name, so that */
+
+/* DNRM2 := sqrt( x'*x ) */
+
+
+/* -- This version written on 25-October-1982. */
+/* Modified on 14-October-1993 to inline the call to DLASSQ. */
+/* Sven Hammarling, Nag Ltd. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n < 1 || *incx < 1) {
+ norm = 0.;
+ } else if (*n == 1) {
+ norm = abs(x[1]);
+ } else {
+ scale = 0.;
+ ssq = 1.;
+/* The following loop is equivalent to this call to the LAPACK */
+/* auxiliary routine: */
+/* CALL DLASSQ( N, X, INCX, SCALE, SSQ ) */
+
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ if (x[ix] != 0.) {
+ absxi = (d__1 = x[ix], abs(d__1));
+ if (scale < absxi) {
+/* Computing 2nd power */
+ d__1 = scale / absxi;
+ ssq = ssq * (d__1 * d__1) + 1.;
+ scale = absxi;
+ } else {
+/* Computing 2nd power */
+ d__1 = absxi / scale;
+ ssq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ norm = scale * sqrt(ssq);
+ }
+
+ ret_val = norm;
+ return ret_val;
+
+/* End of DNRM2. */
+
+} /* dnrm2_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dscal.c b/src/lib/yac/clapack/BLAS/SRC/dscal.c
new file mode 100644
index 000000000..4c3e6c47a
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dscal.c
@@ -0,0 +1,101 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dscal.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,
+ integer *incx)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+
+ /* Local variables */
+ integer i__, m, mp1, nincx;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+/* * */
+/* scales a vector by a constant. */
+/* uses unrolled loops for increment equal to one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0 || *incx <= 0) {
+ return 0;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ nincx = *n * *incx;
+ i__1 = nincx;
+ i__2 = *incx;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ dx[i__] = *da * dx[i__];
+/* L10: */
+ }
+ return 0;
+
+/* code for increment equal to 1 */
+
+
+/* clean-up loop */
+
+L20:
+ m = *n % 5;
+ if (m == 0) {
+ goto L40;
+ }
+ i__2 = m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ dx[i__] = *da * dx[i__];
+/* L30: */
+ }
+ if (*n < 5) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__2 = *n;
+ for (i__ = mp1; i__ <= i__2; i__ += 5) {
+ dx[i__] = *da * dx[i__];
+ dx[i__ + 1] = *da * dx[i__ + 1];
+ dx[i__ + 2] = *da * dx[i__ + 2];
+ dx[i__ + 3] = *da * dx[i__ + 3];
+ dx[i__ + 4] = *da * dx[i__ + 4];
+/* L50: */
+ }
+ return 0;
+} /* dscal_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dswap.c b/src/lib/yac/clapack/BLAS/SRC/dswap.c
new file mode 100644
index 000000000..73fb68787
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dswap.c
@@ -0,0 +1,119 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dswap.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dswap_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy)
+{
+ /* System generated locals */
+ integer i__1;
+
+ /* Local variables */
+ integer i__, m, ix, iy, mp1;
+ doublereal dtemp;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* interchanges two vectors. */
+/* uses unrolled loops for increments equal one. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --dy;
+ --dx;
+
+ /* Function Body */
+ if (*n <= 0) {
+ return 0;
+ }
+ if (*incx == 1 && *incy == 1) {
+ goto L20;
+ }
+
+/* code for unequal increments or equal increments not equal */
+/* to 1 */
+
+ 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__) {
+ dtemp = dx[ix];
+ dx[ix] = dy[iy];
+ dy[iy] = dtemp;
+ ix += *incx;
+ iy += *incy;
+/* L10: */
+ }
+ return 0;
+
+/* code for both increments equal to 1 */
+
+
+/* clean-up loop */
+
+L20:
+ m = *n % 3;
+ if (m == 0) {
+ goto L40;
+ }
+ i__1 = m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ dtemp = dx[i__];
+ dx[i__] = dy[i__];
+ dy[i__] = dtemp;
+/* L30: */
+ }
+ if (*n < 3) {
+ return 0;
+ }
+L40:
+ mp1 = m + 1;
+ i__1 = *n;
+ for (i__ = mp1; i__ <= i__1; i__ += 3) {
+ dtemp = dx[i__];
+ dx[i__] = dy[i__];
+ dy[i__] = dtemp;
+ dtemp = dx[i__ + 1];
+ dx[i__ + 1] = dy[i__ + 1];
+ dy[i__ + 1] = dtemp;
+ dtemp = dx[i__ + 2];
+ dx[i__ + 2] = dy[i__ + 2];
+ dy[i__ + 2] = dtemp;
+/* L50: */
+ }
+ return 0;
+} /* dswap_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dsymv.c b/src/lib/yac/clapack/BLAS/SRC/dsymv.c
new file mode 100644
index 000000000..7e5cca6ea
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dsymv.c
@@ -0,0 +1,318 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dsymv.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dsymv_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal
+ *beta, doublereal *y, integer *incy)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, ix, iy, jx, jy, kx, ky, info;
+ doublereal temp1, temp2;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DSYMV performs the matrix-vector operation */
+
+/* y := alpha*A*x + beta*y, */
+
+/* where alpha and beta are scalars, x and y are n element vectors and */
+/* A is an n by n symmetric matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the upper or lower */
+/* triangular part of the array A is to be referenced as */
+/* follows: */
+
+/* UPLO = 'U' or 'u' Only the upper triangular part of A */
+/* is to be referenced. */
+
+/* UPLO = 'L' or 'l' Only the lower triangular part of A */
+/* is to be referenced. */
+
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper */
+/* triangular part of the symmetric matrix and the strictly */
+/* lower triangular part of A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower */
+/* triangular part of the symmetric matrix and the strictly */
+/* upper triangular part of A is not referenced. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, n ). */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element vector x. */
+/* Unchanged on exit. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+/* BETA - DOUBLE PRECISION. */
+/* On entry, BETA specifies the scalar beta. When BETA is */
+/* supplied as zero then Y need not be set on input. */
+/* Unchanged on exit. */
+
+/* Y - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCY ) ). */
+/* Before entry, the incremented array Y must contain the n */
+/* element vector y. On exit, Y is overwritten by the updated */
+/* vector y. */
+
+/* INCY - INTEGER. */
+/* On entry, INCY specifies the increment for the elements of */
+/* Y. INCY must not be zero. */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+ --y;
+
+ /* Function Body */
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (*n < 0) {
+ info = 2;
+ } else if (*lda < max(1,*n)) {
+ info = 5;
+ } else if (*incx == 0) {
+ info = 7;
+ } else if (*incy == 0) {
+ info = 10;
+ }
+ if (info != 0) {
+ xerbla_("DSYMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || *alpha == 0. && *beta == 1.) {
+ return 0;
+ }
+
+/* Set up the start points in X and Y. */
+
+ if (*incx > 0) {
+ kx = 1;
+ } else {
+ kx = 1 - (*n - 1) * *incx;
+ }
+ if (*incy > 0) {
+ ky = 1;
+ } else {
+ ky = 1 - (*n - 1) * *incy;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through the triangular part */
+/* of A. */
+
+/* First form y := beta*y. */
+
+ if (*beta != 1.) {
+ if (*incy == 1) {
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = 0.;
+/* L10: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[i__] = *beta * y[i__];
+/* L20: */
+ }
+ }
+ } else {
+ iy = ky;
+ if (*beta == 0.) {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = 0.;
+ iy += *incy;
+/* L30: */
+ }
+ } else {
+ i__1 = *n;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ y[iy] = *beta * y[iy];
+ iy += *incy;
+/* L40: */
+ }
+ }
+ }
+ }
+ if (*alpha == 0.) {
+ return 0;
+ }
+ if (lsame_(uplo, "U")) {
+
+/* Form y when A is stored in upper triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[i__];
+/* L50: */
+ }
+ y[j] = y[j] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
+/* L60: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ ix = kx;
+ iy = ky;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ y[iy] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[ix];
+ ix += *incx;
+ iy += *incy;
+/* L70: */
+ }
+ y[jy] = y[jy] + temp1 * a[j + j * a_dim1] + *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form y when A is stored in lower triangle. */
+
+ if (*incx == 1 && *incy == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[j];
+ temp2 = 0.;
+ y[j] += temp1 * a[j + j * a_dim1];
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ y[i__] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ y[j] += *alpha * temp2;
+/* L100: */
+ }
+ } else {
+ jx = kx;
+ jy = ky;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp1 = *alpha * x[jx];
+ temp2 = 0.;
+ y[jy] += temp1 * a[j + j * a_dim1];
+ ix = jx;
+ iy = jy;
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ iy += *incy;
+ y[iy] += temp1 * a[i__ + j * a_dim1];
+ temp2 += a[i__ + j * a_dim1] * x[ix];
+/* L110: */
+ }
+ y[jy] += *alpha * temp2;
+ jx += *incx;
+ jy += *incy;
+/* L120: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYMV . */
+
+} /* dsymv_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dsyr.c b/src/lib/yac/clapack/BLAS/SRC/dsyr.c
new file mode 100644
index 000000000..1b2e15414
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dsyr.c
@@ -0,0 +1,243 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dsyr.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dsyr_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, ix, jx, kx, info;
+ doublereal temp;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DSYR performs the symmetric rank 1 operation */
+
+/* A := alpha*x*x' + A, */
+
+/* where alpha is a real scalar, x is an n element vector and A is an */
+/* n by n symmetric matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the upper or lower */
+/* triangular part of the array A is to be referenced as */
+/* follows: */
+
+/* UPLO = 'U' or 'u' Only the upper triangular part of A */
+/* is to be referenced. */
+
+/* UPLO = 'L' or 'l' Only the lower triangular part of A */
+/* is to be referenced. */
+
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element vector x. */
+/* Unchanged on exit. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper */
+/* triangular part of the symmetric matrix and the strictly */
+/* lower triangular part of A is not referenced. On exit, the */
+/* upper triangular part of the array A is overwritten by the */
+/* upper triangular part of the updated matrix. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower */
+/* triangular part of the symmetric matrix and the strictly */
+/* upper triangular part of A is not referenced. On exit, the */
+/* lower triangular part of the array A is overwritten by the */
+/* lower triangular part of the updated matrix. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, n ). */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ --x;
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ 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_("DSYR ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0 || *alpha == 0.) {
+ return 0;
+ }
+
+/* Set the start point in X if the increment is not unity. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through the triangular part */
+/* of A. */
+
+ if (lsame_(uplo, "U")) {
+
+/* Form A when A is stored in upper triangle. */
+
+ 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;
+/* L10: */
+ }
+ }
+/* L20: */
+ }
+ } 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;
+/* L30: */
+ }
+ }
+ jx += *incx;
+/* L40: */
+ }
+ }
+ } else {
+
+/* Form A when A is stored in lower triangle. */
+
+ 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;
+/* L50: */
+ }
+ }
+/* L60: */
+ }
+ } 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;
+/* L70: */
+ }
+ }
+ jx += *incx;
+/* L80: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DSYR . */
+
+} /* dsyr_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dtrmm.c b/src/lib/yac/clapack/BLAS/SRC/dtrmm.c
new file mode 100644
index 000000000..79a801d9b
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dtrmm.c
@@ -0,0 +1,458 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrmm.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dtrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, j, k, info;
+ doublereal temp;
+ logical lside;
+ extern logical lsame_(char *, char *);
+ integer nrowa;
+ logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ logical nounit;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRMM performs one of the matrix-matrix operations */
+
+/* B := alpha*op( A )*B, or B := alpha*B*op( A ), */
+
+/* where alpha is a scalar, B is an m by n matrix, A is a unit, or */
+/* non-unit, upper or lower triangular matrix and op( A ) is one of */
+
+/* op( A ) = A or op( A ) = A'. */
+
+/* Arguments */
+/* ========== */
+
+/* SIDE - CHARACTER*1. */
+/* On entry, SIDE specifies whether op( A ) multiplies B from */
+/* the left or right as follows: */
+
+/* SIDE = 'L' or 'l' B := alpha*op( A )*B. */
+
+/* SIDE = 'R' or 'r' B := alpha*B*op( A ). */
+
+/* Unchanged on exit. */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix A is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+
+/* TRANSA = 'N' or 'n' op( A ) = A. */
+
+/* TRANSA = 'T' or 't' op( A ) = A'. */
+
+/* TRANSA = 'C' or 'c' op( A ) = A'. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit triangular */
+/* as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of B. M must be at */
+/* least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of B. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. When alpha is */
+/* zero then A is not referenced and B need not be set before */
+/* entry. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m */
+/* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. */
+/* Before entry with UPLO = 'U' or 'u', the leading k by k */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading k by k */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When SIDE = 'L' or 'l' then */
+/* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' */
+/* then LDA must be at least max( 1, n ). */
+/* Unchanged on exit. */
+
+/* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). */
+/* Before entry, the leading m by n part of the array B must */
+/* contain the matrix B, and on exit is overwritten by the */
+/* transformed matrix. */
+
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. LDB must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 3 Blas routine. */
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Parameters .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if (! lside && ! lsame_(side, "R")) {
+ info = 1;
+ } else if (! upper && ! lsame_(uplo, "L")) {
+ info = 2;
+ } else if (! lsame_(transa, "N") && ! lsame_(transa,
+ "T") && ! lsame_(transa, "C")) {
+ info = 3;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag,
+ "N")) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DTRMM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*A*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ i__3 = k - 1;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * a[i__ + k *
+ a_dim1];
+/* L30: */
+ }
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ b[k + j * b_dim1] = temp;
+ }
+/* L40: */
+ }
+/* L50: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (k = *m; k >= 1; --k) {
+ if (b[k + j * b_dim1] != 0.) {
+ temp = *alpha * b[k + j * b_dim1];
+ b[k + j * b_dim1] = temp;
+ if (nounit) {
+ b[k + j * b_dim1] *= a[k + k * a_dim1];
+ }
+ i__2 = *m;
+ for (i__ = k + 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * a[i__ + k *
+ a_dim1];
+/* L60: */
+ }
+ }
+/* L70: */
+ }
+/* L80: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*A'*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ temp = b[i__ + j * b_dim1];
+ if (nounit) {
+ temp *= a[i__ + i__ * a_dim1];
+ }
+ i__2 = i__ - 1;
+ for (k = 1; k <= i__2; ++k) {
+ temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L90: */
+ }
+ b[i__ + j * b_dim1] = *alpha * temp;
+/* L100: */
+ }
+/* L110: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = b[i__ + j * b_dim1];
+ if (nounit) {
+ temp *= a[i__ + i__ * a_dim1];
+ }
+ i__3 = *m;
+ for (k = i__ + 1; k <= i__3; ++k) {
+ temp += a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L120: */
+ }
+ b[i__ + j * b_dim1] = *alpha * temp;
+/* L130: */
+ }
+/* L140: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*A. */
+
+ if (upper) {
+ for (j = *n; j >= 1; --j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L150: */
+ }
+ i__1 = j - 1;
+ for (k = 1; k <= i__1; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L160: */
+ }
+ }
+/* L170: */
+ }
+/* L180: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L190: */
+ }
+ i__2 = *n;
+ for (k = j + 1; k <= i__2; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ temp = *alpha * a[k + j * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L200: */
+ }
+ }
+/* L210: */
+ }
+/* L220: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*A'. */
+
+ if (upper) {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ i__2 = k - 1;
+ for (j = 1; j <= i__2; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ } else {
+ for (k = *n; k >= 1; --k) {
+ i__1 = *n;
+ for (j = k + 1; j <= i__1; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = *alpha * a[j + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] += temp * b[i__ + k *
+ b_dim1];
+/* L270: */
+ }
+ }
+/* L280: */
+ }
+ temp = *alpha;
+ if (nounit) {
+ temp *= a[k + k * a_dim1];
+ }
+ if (temp != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L290: */
+ }
+ }
+/* L300: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRMM . */
+
+} /* dtrmm_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dtrmv.c b/src/lib/yac/clapack/BLAS/SRC/dtrmv.c
new file mode 100644
index 000000000..4415303c9
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dtrmv.c
@@ -0,0 +1,350 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrmv.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dtrmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *x, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, ix, jx, kx, info;
+ doublereal temp;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ logical nounit;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRMV performs one of the matrix-vector operations */
+
+/* x := A*x, or x := A'*x, */
+
+/* where x is an n element vector and A is an n by n unit, or non-unit, */
+/* upper or lower triangular matrix. */
+
+/* Arguments */
+/* ========== */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANS - CHARACTER*1. */
+/* On entry, TRANS specifies the operation to be performed as */
+/* follows: */
+
+/* TRANS = 'N' or 'n' x := A*x. */
+
+/* TRANS = 'T' or 't' x := A'*x. */
+
+/* TRANS = 'C' or 'c' x := A'*x. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit */
+/* triangular as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the order of the matrix A. */
+/* N must be at least zero. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, n ). */
+/* Before entry with UPLO = 'U' or 'u', the leading n by n */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading n by n */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. LDA must be at least */
+/* max( 1, n ). */
+/* Unchanged on exit. */
+
+/* X - DOUBLE PRECISION array of dimension at least */
+/* ( 1 + ( n - 1 )*abs( INCX ) ). */
+/* Before entry, the incremented array X must contain the n */
+/* element vector x. On exit, X is overwritten with the */
+/* tranformed vector x. */
+
+/* INCX - INTEGER. */
+/* On entry, INCX specifies the increment for the elements of */
+/* X. INCX must not be zero. */
+/* Unchanged on exit. */
+
+
+/* Level 2 Blas routine. */
+
+/* -- Written on 22-October-1986. */
+/* Jack Dongarra, Argonne National Lab. */
+/* Jeremy Du Croz, Nag Central Office. */
+/* Sven Hammarling, Nag Central Office. */
+/* Richard Hanson, Sandia National Labs. */
+
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --x;
+
+ /* Function Body */
+ info = 0;
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ info = 1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans,
+ "T") && ! lsame_(trans, "C")) {
+ info = 2;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag,
+ "N")) {
+ info = 3;
+ } else if (*n < 0) {
+ info = 4;
+ } else if (*lda < max(1,*n)) {
+ info = 6;
+ } else if (*incx == 0) {
+ info = 8;
+ }
+ if (info != 0) {
+ xerbla_("DTRMV ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+ nounit = lsame_(diag, "N");
+
+/* Set up the start point in X if the increment is not unity. This */
+/* will be ( N - 1 )*INCX too small for descending loops. */
+
+ if (*incx <= 0) {
+ kx = 1 - (*n - 1) * *incx;
+ } else if (*incx != 1) {
+ kx = 1;
+ }
+
+/* Start the operations. In this version the elements of A are */
+/* accessed sequentially with one pass through A. */
+
+ if (lsame_(trans, "N")) {
+
+/* Form x := A*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ x[i__] += temp * a[i__ + j * a_dim1];
+/* L10: */
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+/* L20: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__2 = j - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ x[ix] += temp * a[i__ + j * a_dim1];
+ ix += *incx;
+/* L30: */
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx += *incx;
+/* L40: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ if (x[j] != 0.) {
+ temp = x[j];
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ x[i__] += temp * a[i__ + j * a_dim1];
+/* L50: */
+ }
+ if (nounit) {
+ x[j] *= a[j + j * a_dim1];
+ }
+ }
+/* L60: */
+ }
+ } else {
+ kx += (*n - 1) * *incx;
+ jx = kx;
+ for (j = *n; j >= 1; --j) {
+ if (x[jx] != 0.) {
+ temp = x[jx];
+ ix = kx;
+ i__1 = j + 1;
+ for (i__ = *n; i__ >= i__1; --i__) {
+ x[ix] += temp * a[i__ + j * a_dim1];
+ ix -= *incx;
+/* L70: */
+ }
+ if (nounit) {
+ x[jx] *= a[j + j * a_dim1];
+ }
+ }
+ jx -= *incx;
+/* L80: */
+ }
+ }
+ }
+ } else {
+
+/* Form x := A'*x. */
+
+ if (lsame_(uplo, "U")) {
+ if (*incx == 1) {
+ for (j = *n; j >= 1; --j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L90: */
+ }
+ x[j] = temp;
+/* L100: */
+ }
+ } else {
+ jx = kx + (*n - 1) * *incx;
+ for (j = *n; j >= 1; --j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ for (i__ = j - 1; i__ >= 1; --i__) {
+ ix -= *incx;
+ temp += a[i__ + j * a_dim1] * x[ix];
+/* L110: */
+ }
+ x[jx] = temp;
+ jx -= *incx;
+/* L120: */
+ }
+ }
+ } else {
+ if (*incx == 1) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[j];
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ temp += a[i__ + j * a_dim1] * x[i__];
+/* L130: */
+ }
+ x[j] = temp;
+/* L140: */
+ }
+ } else {
+ jx = kx;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ temp = x[jx];
+ ix = jx;
+ if (nounit) {
+ temp *= a[j + j * a_dim1];
+ }
+ i__2 = *n;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ ix += *incx;
+ temp += a[i__ + j * a_dim1] * x[ix];
+/* L150: */
+ }
+ x[jx] = temp;
+ jx += *incx;
+/* L160: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRMV . */
+
+} /* dtrmv_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/dtrsm.c b/src/lib/yac/clapack/BLAS/SRC/dtrsm.c
new file mode 100644
index 000000000..10eeae6eb
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/dtrsm.c
@@ -0,0 +1,495 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrsm.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, j, k, info;
+ doublereal temp;
+ logical lside;
+ extern logical lsame_(char *, char *);
+ integer nrowa;
+ logical upper;
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ logical nounit;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRSM solves one of the matrix equations */
+
+/* op( A )*X = alpha*B, or X*op( A ) = alpha*B, */
+
+/* where alpha is a scalar, X and B are m by n matrices, A is a unit, or */
+/* non-unit, upper or lower triangular matrix and op( A ) is one of */
+
+/* op( A ) = A or op( A ) = A'. */
+
+/* The matrix X is overwritten on B. */
+
+/* Arguments */
+/* ========== */
+
+/* SIDE - CHARACTER*1. */
+/* On entry, SIDE specifies whether op( A ) appears on the left */
+/* or right of X as follows: */
+
+/* SIDE = 'L' or 'l' op( A )*X = alpha*B. */
+
+/* SIDE = 'R' or 'r' X*op( A ) = alpha*B. */
+
+/* Unchanged on exit. */
+
+/* UPLO - CHARACTER*1. */
+/* On entry, UPLO specifies whether the matrix A is an upper or */
+/* lower triangular matrix as follows: */
+
+/* UPLO = 'U' or 'u' A is an upper triangular matrix. */
+
+/* UPLO = 'L' or 'l' A is a lower triangular matrix. */
+
+/* Unchanged on exit. */
+
+/* TRANSA - CHARACTER*1. */
+/* On entry, TRANSA specifies the form of op( A ) to be used in */
+/* the matrix multiplication as follows: */
+
+/* TRANSA = 'N' or 'n' op( A ) = A. */
+
+/* TRANSA = 'T' or 't' op( A ) = A'. */
+
+/* TRANSA = 'C' or 'c' op( A ) = A'. */
+
+/* Unchanged on exit. */
+
+/* DIAG - CHARACTER*1. */
+/* On entry, DIAG specifies whether or not A is unit triangular */
+/* as follows: */
+
+/* DIAG = 'U' or 'u' A is assumed to be unit triangular. */
+
+/* DIAG = 'N' or 'n' A is not assumed to be unit */
+/* triangular. */
+
+/* Unchanged on exit. */
+
+/* M - INTEGER. */
+/* On entry, M specifies the number of rows of B. M must be at */
+/* least zero. */
+/* Unchanged on exit. */
+
+/* N - INTEGER. */
+/* On entry, N specifies the number of columns of B. N must be */
+/* at least zero. */
+/* Unchanged on exit. */
+
+/* ALPHA - DOUBLE PRECISION. */
+/* On entry, ALPHA specifies the scalar alpha. When alpha is */
+/* zero then A is not referenced and B need not be set before */
+/* entry. */
+/* Unchanged on exit. */
+
+/* A - DOUBLE PRECISION array of DIMENSION ( LDA, k ), where k is m */
+/* when SIDE = 'L' or 'l' and is n when SIDE = 'R' or 'r'. */
+/* Before entry with UPLO = 'U' or 'u', the leading k by k */
+/* upper triangular part of the array A must contain the upper */
+/* triangular matrix and the strictly lower triangular part of */
+/* A is not referenced. */
+/* Before entry with UPLO = 'L' or 'l', the leading k by k */
+/* lower triangular part of the array A must contain the lower */
+/* triangular matrix and the strictly upper triangular part of */
+/* A is not referenced. */
+/* Note that when DIAG = 'U' or 'u', the diagonal elements of */
+/* A are not referenced either, but are assumed to be unity. */
+/* Unchanged on exit. */
+
+/* LDA - INTEGER. */
+/* On entry, LDA specifies the first dimension of A as declared */
+/* in the calling (sub) program. When SIDE = 'L' or 'l' then */
+/* LDA must be at least max( 1, m ), when SIDE = 'R' or 'r' */
+/* then LDA must be at least max( 1, n ). */
+/* Unchanged on exit. */
+
+/* B - DOUBLE PRECISION array of DIMENSION ( LDB, n ). */
+/* Before entry, the leading m by n part of the array B must */
+/* contain the right-hand side matrix B, and on exit is */
+/* overwritten by the solution matrix X. */
+
+/* LDB - INTEGER. */
+/* On entry, LDB specifies the first dimension of B as declared */
+/* in the calling (sub) program. LDB must be at least */
+/* max( 1, m ). */
+/* Unchanged on exit. */
+
+
+/* Level 3 Blas routine. */
+
+
+/* -- Written on 8-February-1989. */
+/* Jack Dongarra, Argonne National Laboratory. */
+/* Iain Duff, AERE Harwell. */
+/* Jeremy Du Croz, Numerical Algorithms Group Ltd. */
+/* Sven Hammarling, Numerical Algorithms Group Ltd. */
+
+
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Parameters .. */
+/* .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+
+ /* Function Body */
+ lside = lsame_(side, "L");
+ if (lside) {
+ nrowa = *m;
+ } else {
+ nrowa = *n;
+ }
+ nounit = lsame_(diag, "N");
+ upper = lsame_(uplo, "U");
+
+ info = 0;
+ if (! lside && ! lsame_(side, "R")) {
+ info = 1;
+ } else if (! upper && ! lsame_(uplo, "L")) {
+ info = 2;
+ } else if (! lsame_(transa, "N") && ! lsame_(transa,
+ "T") && ! lsame_(transa, "C")) {
+ info = 3;
+ } else if (! lsame_(diag, "U") && ! lsame_(diag,
+ "N")) {
+ info = 4;
+ } else if (*m < 0) {
+ info = 5;
+ } else if (*n < 0) {
+ info = 6;
+ } else if (*lda < max(1,nrowa)) {
+ info = 9;
+ } else if (*ldb < max(1,*m)) {
+ info = 11;
+ }
+ if (info != 0) {
+ xerbla_("DTRSM ", &info);
+ return 0;
+ }
+
+/* Quick return if possible. */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* And when alpha.eq.zero. */
+
+ if (*alpha == 0.) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+ return 0;
+ }
+
+/* Start the operations. */
+
+ if (lside) {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*inv( A )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L30: */
+ }
+ }
+ for (k = *m; k >= 1; --k) {
+ if (b[k + j * b_dim1] != 0.) {
+ if (nounit) {
+ b[k + j * b_dim1] /= a[k + k * a_dim1];
+ }
+ i__2 = k - 1;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
+ i__ + k * a_dim1];
+/* L40: */
+ }
+ }
+/* L50: */
+ }
+/* L60: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L70: */
+ }
+ }
+ i__2 = *m;
+ for (k = 1; k <= i__2; ++k) {
+ if (b[k + j * b_dim1] != 0.) {
+ if (nounit) {
+ b[k + j * b_dim1] /= a[k + k * a_dim1];
+ }
+ i__3 = *m;
+ for (i__ = k + 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= b[k + j * b_dim1] * a[
+ i__ + k * a_dim1];
+/* L80: */
+ }
+ }
+/* L90: */
+ }
+/* L100: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*inv( A' )*B. */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ temp = *alpha * b[i__ + j * b_dim1];
+ i__3 = i__ - 1;
+ for (k = 1; k <= i__3; ++k) {
+ temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L110: */
+ }
+ if (nounit) {
+ temp /= a[i__ + i__ * a_dim1];
+ }
+ b[i__ + j * b_dim1] = temp;
+/* L120: */
+ }
+/* L130: */
+ }
+ } else {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ temp = *alpha * b[i__ + j * b_dim1];
+ i__2 = *m;
+ for (k = i__ + 1; k <= i__2; ++k) {
+ temp -= a[k + i__ * a_dim1] * b[k + j * b_dim1];
+/* L140: */
+ }
+ if (nounit) {
+ temp /= a[i__ + i__ * a_dim1];
+ }
+ b[i__ + j * b_dim1] = temp;
+/* L150: */
+ }
+/* L160: */
+ }
+ }
+ }
+ } else {
+ if (lsame_(transa, "N")) {
+
+/* Form B := alpha*B*inv( A ). */
+
+ if (upper) {
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L170: */
+ }
+ }
+ i__2 = j - 1;
+ for (k = 1; k <= i__2; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
+ i__ + k * b_dim1];
+/* L180: */
+ }
+ }
+/* L190: */
+ }
+ if (nounit) {
+ temp = 1. / a[j + j * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L200: */
+ }
+ }
+/* L210: */
+ }
+ } else {
+ for (j = *n; j >= 1; --j) {
+ if (*alpha != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = *alpha * b[i__ + j * b_dim1]
+ ;
+/* L220: */
+ }
+ }
+ i__1 = *n;
+ for (k = j + 1; k <= i__1; ++k) {
+ if (a[k + j * a_dim1] != 0.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= a[k + j * a_dim1] * b[
+ i__ + k * b_dim1];
+/* L230: */
+ }
+ }
+/* L240: */
+ }
+ if (nounit) {
+ temp = 1. / a[j + j * a_dim1];
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + j * b_dim1] = temp * b[i__ + j * b_dim1];
+/* L250: */
+ }
+ }
+/* L260: */
+ }
+ }
+ } else {
+
+/* Form B := alpha*B*inv( A' ). */
+
+ if (upper) {
+ for (k = *n; k >= 1; --k) {
+ if (nounit) {
+ temp = 1. / a[k + k * a_dim1];
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L270: */
+ }
+ }
+ i__1 = k - 1;
+ for (j = 1; j <= i__1; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = a[j + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] -= temp * b[i__ + k *
+ b_dim1];
+/* L280: */
+ }
+ }
+/* L290: */
+ }
+ if (*alpha != 1.) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
+ ;
+/* L300: */
+ }
+ }
+/* L310: */
+ }
+ } else {
+ i__1 = *n;
+ for (k = 1; k <= i__1; ++k) {
+ if (nounit) {
+ temp = 1. / a[k + k * a_dim1];
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = temp * b[i__ + k * b_dim1];
+/* L320: */
+ }
+ }
+ i__2 = *n;
+ for (j = k + 1; j <= i__2; ++j) {
+ if (a[j + k * a_dim1] != 0.) {
+ temp = a[j + k * a_dim1];
+ i__3 = *m;
+ for (i__ = 1; i__ <= i__3; ++i__) {
+ b[i__ + j * b_dim1] -= temp * b[i__ + k *
+ b_dim1];
+/* L330: */
+ }
+ }
+/* L340: */
+ }
+ if (*alpha != 1.) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ b[i__ + k * b_dim1] = *alpha * b[i__ + k * b_dim1]
+ ;
+/* L350: */
+ }
+ }
+/* L360: */
+ }
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRSM . */
+
+} /* dtrsm_ */
+
diff --git a/src/lib/yac/clapack/BLAS/SRC/idamax.c b/src/lib/yac/clapack/BLAS/SRC/idamax.c
new file mode 100644
index 000000000..b5fc44d80
--- /dev/null
+++ b/src/lib/yac/clapack/BLAS/SRC/idamax.c
@@ -0,0 +1,98 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* idamax.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+integer idamax_(integer *n, doublereal *dx, integer *incx)
+{
+ /* System generated locals */
+ integer ret_val, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ integer i__, ix;
+ doublereal dmax__;
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* finds the index of element having max. absolute value. */
+/* jack dongarra, linpack, 3/11/78. */
+/* modified 3/93 to return if incx .le. 0. */
+/* modified 12/3/93, array(1) declarations changed to array(*) */
+
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+ /* Parameter adjustments */
+ --dx;
+
+ /* Function Body */
+ ret_val = 0;
+ if (*n < 1 || *incx <= 0) {
+ return ret_val;
+ }
+ ret_val = 1;
+ if (*n == 1) {
+ return ret_val;
+ }
+ if (*incx == 1) {
+ goto L20;
+ }
+
+/* code for increment not equal to 1 */
+
+ ix = 1;
+ dmax__ = abs(dx[1]);
+ ix += *incx;
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if ((d__1 = dx[ix], abs(d__1)) <= dmax__) {
+ goto L5;
+ }
+ ret_val = i__;
+ dmax__ = (d__1 = dx[ix], abs(d__1));
+L5:
+ ix += *incx;
+/* L10: */
+ }
+ return ret_val;
+
+/* code for increment equal to 1 */
+
+L20:
+ dmax__ = abs(dx[1]);
+ i__1 = *n;
+ for (i__ = 2; i__ <= i__1; ++i__) {
+ if ((d__1 = dx[i__], abs(d__1)) <= dmax__) {
+ goto L30;
+ }
+ ret_val = i__;
+ dmax__ = (d__1 = dx[i__], abs(d__1));
+L30:
+ ;
+ }
+ return ret_val;
+} /* idamax_ */
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/close.c b/src/lib/yac/clapack/F2CLIBS/libf2c/close.c
new file mode 100644
index 000000000..350734c0b
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/close.c
@@ -0,0 +1,106 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+#ifdef KR_headers
+integer f_clos(a) cllist *a;
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#ifdef NON_UNIX_STDIO
+#ifndef unlink
+#define unlink remove
+#endif
+#else
+#ifdef MSDOS
+#include "io.h"
+#else
+#ifdef __cplusplus
+extern "C" int unlink(const char*);
+#else
+extern int unlink(const char*);
+#endif
+#endif
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+integer f_clos(cllist *a)
+#endif
+{ unit *b;
+
+ if(a->cunit >= MXUNIT) return(0);
+ b= &f__units[a->cunit];
+ if(b->ufd==NULL)
+ goto done;
+ if (b->uscrtch == 1)
+ goto Delete;
+ if (!a->csta)
+ goto Keep;
+ switch(*a->csta) {
+ default:
+ Keep:
+ case 'k':
+ case 'K':
+ if(b->uwrt == 1)
+ t_runc((alist *)a);
+ if(b->ufnm) {
+ fclose(b->ufd);
+ free(b->ufnm);
+ }
+ break;
+ case 'd':
+ case 'D':
+ Delete:
+ fclose(b->ufd);
+ if(b->ufnm) {
+ unlink(b->ufnm); /*SYSDEP*/
+ free(b->ufnm);
+ }
+ }
+ b->ufd=NULL;
+ done:
+ b->uend=0;
+ b->ufnm=NULL;
+ return(0);
+ }
+ void
+#ifdef KR_headers
+f_exit()
+#else
+f_exit(void)
+#endif
+{ int i;
+ static cllist xx;
+ if (!xx.cerr) {
+ xx.cerr=1;
+ xx.csta=NULL;
+ for(i=0;i<MXUNIT;i++)
+ {
+ xx.cunit=i;
+ (void) f_clos(&xx);
+ }
+ }
+}
+ int
+#ifdef KR_headers
+flush_()
+#else
+flush_(void)
+#endif
+{ int i;
+ for(i=0;i<MXUNIT;i++)
+ if(f__units[i].ufd != NULL && f__units[i].uwrt)
+ fflush(f__units[i].ufd);
+return 0;
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/d_lg10.c b/src/lib/yac/clapack/F2CLIBS/libf2c/d_lg10.c
new file mode 100644
index 000000000..4d379dbe0
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/d_lg10.c
@@ -0,0 +1,26 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+
+#define log10e 0.43429448190325182765
+
+#ifdef KR_headers
+double log();
+double d_lg10(x) doublereal *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+double d_lg10(doublereal *x)
+#endif
+{
+return( log10e * log(*x) );
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/d_sign.c b/src/lib/yac/clapack/F2CLIBS/libf2c/d_sign.c
new file mode 100644
index 000000000..29a81f5af
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/d_sign.c
@@ -0,0 +1,23 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double d_sign(a,b) doublereal *a, *b;
+#else
+double d_sign(doublereal *a, doublereal *b)
+#endif
+{
+double x;
+x = (*a >= 0 ? *a : - *a);
+return( *b >= 0 ? x : -x);
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/endfile.c b/src/lib/yac/clapack/F2CLIBS/libf2c/endfile.c
new file mode 100644
index 000000000..b84638bcc
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/endfile.c
@@ -0,0 +1,165 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+
+/* Compile this with -DNO_TRUNCATE if unistd.h does not exist or */
+/* if it does not define int truncate(const char *name, off_t). */
+
+#ifdef MSDOS
+#undef NO_TRUNCATE
+#define NO_TRUNCATE
+#endif
+
+#ifndef NO_TRUNCATE
+#include "unistd.h"
+#endif
+
+#ifdef KR_headers
+extern char *strcpy();
+extern FILE *tmpfile();
+#else
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#include "string.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+extern char *f__r_mode[], *f__w_mode[];
+
+#ifdef KR_headers
+integer f_end(a) alist *a;
+#else
+integer f_end(alist *a)
+#endif
+{
+ unit *b;
+ FILE *tf;
+
+ if(a->aunit>=MXUNIT || a->aunit<0) err(a->aerr,101,"endfile");
+ b = &f__units[a->aunit];
+ if(b->ufd==NULL) {
+ char nbuf[10];
+ sprintf(nbuf,"fort.%ld",(long)a->aunit);
+ if (tf = FOPEN(nbuf, f__w_mode[0]))
+ fclose(tf);
+ return(0);
+ }
+ b->uend=1;
+ return(b->useek ? t_runc(a) : 0);
+}
+
+#ifdef NO_TRUNCATE
+ static int
+#ifdef KR_headers
+copy(from, len, to) FILE *from, *to; register long len;
+#else
+copy(FILE *from, register long len, FILE *to)
+#endif
+{
+ int len1;
+ char buf[BUFSIZ];
+
+ while(fread(buf, len1 = len > BUFSIZ ? BUFSIZ : (int)len, 1, from)) {
+ if (!fwrite(buf, len1, 1, to))
+ return 1;
+ if ((len -= len1) <= 0)
+ break;
+ }
+ return 0;
+ }
+#endif /* NO_TRUNCATE */
+
+ int
+#ifdef KR_headers
+t_runc(a) alist *a;
+#else
+t_runc(alist *a)
+#endif
+{
+ OFF_T loc, len;
+ unit *b;
+ int rc;
+ FILE *bf;
+#ifdef NO_TRUNCATE
+ FILE *tf;
+#endif
+
+ b = &f__units[a->aunit];
+ if(b->url)
+ return(0); /*don't truncate direct files*/
+ loc=FTELL(bf = b->ufd);
+ FSEEK(bf,(OFF_T)0,SEEK_END);
+ len=FTELL(bf);
+ if (loc >= len || b->useek == 0)
+ return(0);
+#ifdef NO_TRUNCATE
+ if (b->ufnm == NULL)
+ return 0;
+ rc = 0;
+ fclose(b->ufd);
+ if (!loc) {
+ if (!(bf = FOPEN(b->ufnm, f__w_mode[b->ufmt])))
+ rc = 1;
+ if (b->uwrt)
+ b->uwrt = 1;
+ goto done;
+ }
+ if (!(bf = FOPEN(b->ufnm, f__r_mode[0]))
+ || !(tf = tmpfile())) {
+#ifdef NON_UNIX_STDIO
+ bad:
+#endif
+ rc = 1;
+ goto done;
+ }
+ if (copy(bf, (long)loc, tf)) {
+ bad1:
+ rc = 1;
+ goto done1;
+ }
+ if (!(bf = FREOPEN(b->ufnm, f__w_mode[0], bf)))
+ goto bad1;
+ rewind(tf);
+ if (copy(tf, (long)loc, bf))
+ goto bad1;
+ b->uwrt = 1;
+ b->urw = 2;
+#ifdef NON_UNIX_STDIO
+ if (b->ufmt) {
+ fclose(bf);
+ if (!(bf = FOPEN(b->ufnm, f__w_mode[3])))
+ goto bad;
+ FSEEK(bf,(OFF_T)0,SEEK_END);
+ b->urw = 3;
+ }
+#endif
+done1:
+ fclose(tf);
+done:
+ f__cf = b->ufd = bf;
+#else /* NO_TRUNCATE */
+ if (b->urw & 2)
+ fflush(b->ufd); /* necessary on some Linux systems */
+#ifndef FTRUNCATE
+#define FTRUNCATE ftruncate
+#endif
+ rc = FTRUNCATE(fileno(b->ufd), loc);
+ /* The following FSEEK is unnecessary on some systems, */
+ /* but should be harmless. */
+ FSEEK(b->ufd, (OFF_T)0, SEEK_END);
+#endif /* NO_TRUNCATE */
+ if (rc)
+ err(a->aerr,111,"endfile");
+ return 0;
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/err.c b/src/lib/yac/clapack/F2CLIBS/libf2c/err.c
new file mode 100644
index 000000000..4be56b06b
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/err.c
@@ -0,0 +1,298 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "sysdep1.h" /* here to get stat64 on some badly designed Linux systems */
+#include "f2c.h"
+#ifdef KR_headers
+#define Const /*nothing*/
+extern char *malloc();
+#else
+#define Const const
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#endif
+#include "fio.h"
+#include "fmt.h" /* for struct syl */
+
+/* Compile this with -DNO_ISATTY if unistd.h does not exist or */
+/* if it does not define int isatty(int). */
+#ifdef NO_ISATTY
+#define isatty(x) 0
+#else
+#include <unistd.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*global definitions*/
+unit f__units[MXUNIT]; /*unit table*/
+flag f__init; /*0 on entry, 1 after initializations*/
+cilist *f__elist; /*active external io list*/
+icilist *f__svic; /*active internal io list*/
+flag f__reading; /*1 if reading, 0 if writing*/
+flag f__cplus,f__cblank;
+Const char *f__fmtbuf;
+flag f__external; /*1 if external io, 0 if internal */
+#ifdef KR_headers
+int (*f__doed)(),(*f__doned)();
+int (*f__doend)(),(*f__donewrec)(),(*f__dorevert)();
+int (*f__getn)(); /* for formatted input */
+void (*f__putn)(); /* for formatted output */
+#else
+int (*f__getn)(void); /* for formatted input */
+void (*f__putn)(int); /* for formatted output */
+int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+int (*f__dorevert)(void),(*f__donewrec)(void),(*f__doend)(void);
+#endif
+flag f__sequential; /*1 if sequential io, 0 if direct*/
+flag f__formatted; /*1 if formatted io, 0 if unformatted*/
+FILE *f__cf; /*current file*/
+unit *f__curunit; /*current unit*/
+int f__recpos; /*place in current record*/
+OFF_T f__cursor, f__hiwater;
+int f__scale;
+char *f__icptr;
+
+/*error messages*/
+Const char *F_err[] =
+{
+ "error in format", /* 100 */
+ "illegal unit number", /* 101 */
+ "formatted io not allowed", /* 102 */
+ "unformatted io not allowed", /* 103 */
+ "direct io not allowed", /* 104 */
+ "sequential io not allowed", /* 105 */
+ "can't backspace file", /* 106 */
+ "null file name", /* 107 */
+ "can't stat file", /* 108 */
+ "unit not connected", /* 109 */
+ "off end of record", /* 110 */
+ "truncation failed in endfile", /* 111 */
+ "incomprehensible list input", /* 112 */
+ "out of free space", /* 113 */
+ "unit not connected", /* 114 */
+ "read unexpected character", /* 115 */
+ "bad logical input field", /* 116 */
+ "bad variable type", /* 117 */
+ "bad namelist name", /* 118 */
+ "variable not in namelist", /* 119 */
+ "no end record", /* 120 */
+ "variable count incorrect", /* 121 */
+ "subscript for scalar variable", /* 122 */
+ "invalid array section", /* 123 */
+ "substring out of bounds", /* 124 */
+ "subscript out of bounds", /* 125 */
+ "can't read file", /* 126 */
+ "can't write file", /* 127 */
+ "'new' file exists", /* 128 */
+ "can't append to file", /* 129 */
+ "non-positive record number", /* 130 */
+ "nmLbuf overflow" /* 131 */
+};
+#define MAXERR (sizeof(F_err)/sizeof(char *)+100)
+
+ int
+#ifdef KR_headers
+f__canseek(f) FILE *f; /*SYSDEP*/
+#else
+f__canseek(FILE *f) /*SYSDEP*/
+#endif
+{
+#ifdef NON_UNIX_STDIO
+ return !isatty(fileno(f));
+#else
+ struct STAT_ST x;
+
+ if (FSTAT(fileno(f),&x) < 0)
+ return(0);
+#ifdef S_IFMT
+ switch(x.st_mode & S_IFMT) {
+ case S_IFDIR:
+ case S_IFREG:
+ if(x.st_nlink > 0) /* !pipe */
+ return(1);
+ else
+ return(0);
+ case S_IFCHR:
+ if(isatty(fileno(f)))
+ return(0);
+ return(1);
+#ifdef S_IFBLK
+ case S_IFBLK:
+ return(1);
+#endif
+ }
+#else
+#ifdef S_ISDIR
+ /* POSIX version */
+ if (S_ISREG(x.st_mode) || S_ISDIR(x.st_mode)) {
+ if(x.st_nlink > 0) /* !pipe */
+ return(1);
+ else
+ return(0);
+ }
+ if (S_ISCHR(x.st_mode)) {
+ if(isatty(fileno(f)))
+ return(0);
+ return(1);
+ }
+ if (S_ISBLK(x.st_mode))
+ return(1);
+#else
+ Help! How does fstat work on this system?
+#endif
+#endif
+ return(0); /* who knows what it is? */
+#endif
+}
+
+ void
+#ifdef KR_headers
+f__fatal(n,s) char *s;
+#else
+f__fatal(int n, const char *s)
+#endif
+{
+ if(n<100 && n>=0) perror(s); /*SYSDEP*/
+ else if(n >= (int)MAXERR || n < -1)
+ { fprintf(stderr,"%s: illegal error number %d\n",s,n);
+ }
+ else if(n == -1) fprintf(stderr,"%s: end of file\n",s);
+ else
+ fprintf(stderr,"%s: %s\n",s,F_err[n-100]);
+ if (f__curunit) {
+ fprintf(stderr,"apparent state: unit %d ",
+ (int)(f__curunit-f__units));
+ fprintf(stderr, f__curunit->ufnm ? "named %s\n" : "(unnamed)\n",
+ f__curunit->ufnm);
+ }
+ else
+ fprintf(stderr,"apparent state: internal I/O\n");
+ if (f__fmtbuf)
+ fprintf(stderr,"last format: %s\n",f__fmtbuf);
+ fprintf(stderr,"lately %s %s %s %s",f__reading?"reading":"writing",
+ f__sequential?"sequential":"direct",f__formatted?"formatted":"unformatted",
+ f__external?"external":"internal");
+ sig_die(" IO", 1);
+}
+/*initialization routine*/
+ VOID
+f_init(Void)
+{ unit *p;
+
+ f__init=1;
+ p= &f__units[0];
+ p->ufd=stderr;
+ p->useek=f__canseek(stderr);
+ p->ufmt=1;
+ p->uwrt=1;
+ p = &f__units[5];
+ p->ufd=stdin;
+ p->useek=f__canseek(stdin);
+ p->ufmt=1;
+ p->uwrt=0;
+ p= &f__units[6];
+ p->ufd=stdout;
+ p->useek=f__canseek(stdout);
+ p->ufmt=1;
+ p->uwrt=1;
+}
+
+ int
+#ifdef KR_headers
+f__nowreading(x) unit *x;
+#else
+f__nowreading(unit *x)
+#endif
+{
+ OFF_T loc;
+ int ufmt, urw;
+ extern char *f__r_mode[], *f__w_mode[];
+
+ if (x->urw & 1)
+ goto done;
+ if (!x->ufnm)
+ goto cantread;
+ ufmt = x->url ? 0 : x->ufmt;
+ loc = FTELL(x->ufd);
+ urw = 3;
+ if (!FREOPEN(x->ufnm, f__w_mode[ufmt|2], x->ufd)) {
+ urw = 1;
+ if(!FREOPEN(x->ufnm, f__r_mode[ufmt], x->ufd)) {
+ cantread:
+ errno = 126;
+ return 1;
+ }
+ }
+ FSEEK(x->ufd,loc,SEEK_SET);
+ x->urw = urw;
+ done:
+ x->uwrt = 0;
+ return 0;
+}
+
+ int
+#ifdef KR_headers
+f__nowwriting(x) unit *x;
+#else
+f__nowwriting(unit *x)
+#endif
+{
+ OFF_T loc;
+ int ufmt;
+ extern char *f__w_mode[];
+
+ if (x->urw & 2) {
+ if (x->urw & 1)
+ FSEEK(x->ufd, (OFF_T)0, SEEK_CUR);
+ goto done;
+ }
+ if (!x->ufnm)
+ goto cantwrite;
+ ufmt = x->url ? 0 : x->ufmt;
+ if (x->uwrt == 3) { /* just did write, rewind */
+ if (!(f__cf = x->ufd =
+ FREOPEN(x->ufnm,f__w_mode[ufmt],x->ufd)))
+ goto cantwrite;
+ x->urw = 2;
+ }
+ else {
+ loc=FTELL(x->ufd);
+ if (!(f__cf = x->ufd =
+ FREOPEN(x->ufnm, f__w_mode[ufmt | 2], x->ufd)))
+ {
+ x->ufd = NULL;
+ cantwrite:
+ errno = 127;
+ return(1);
+ }
+ x->urw = 3;
+ FSEEK(x->ufd,loc,SEEK_SET);
+ }
+ done:
+ x->uwrt = 1;
+ return 0;
+}
+
+ int
+#ifdef KR_headers
+err__fl(f, m, s) int f, m; char *s;
+#else
+err__fl(int f, int m, const char *s)
+#endif
+{
+ if (!f)
+ f__fatal(m, s);
+ if (f__doend)
+ (*f__doend)();
+ return errno = m;
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/exit_.c b/src/lib/yac/clapack/F2CLIBS/libf2c/exit_.c
new file mode 100644
index 000000000..afc43b744
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/exit_.c
@@ -0,0 +1,48 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* This gives the effect of
+
+ subroutine exit(rc)
+ integer*4 rc
+ stop
+ end
+
+ * with the added side effect of supplying rc as the program's exit code.
+ */
+
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#ifndef KR_headers
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void f_exit(void);
+#endif
+
+ void
+#ifdef KR_headers
+exit_(rc) integer *rc;
+#else
+exit_(integer *rc)
+#endif
+{
+#ifdef NO_ONEXIT
+ f_exit();
+#endif
+ exit(*rc);
+ }
+#ifdef __cplusplus
+}
+#endif
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/f77_aloc.c b/src/lib/yac/clapack/F2CLIBS/libf2c/f77_aloc.c
new file mode 100644
index 000000000..3cb1cdca0
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/f77_aloc.c
@@ -0,0 +1,49 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#undef abs
+#undef min
+#undef max
+#include "stdio.h"
+
+static integer memfailure = 3;
+
+#ifdef KR_headers
+extern char *malloc();
+extern void exit_();
+
+ char *
+F77_aloc(Len, whence) integer Len; char *whence;
+#else
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern void exit_(integer*);
+#ifdef __cplusplus
+ }
+#endif
+
+ char *
+F77_aloc(integer Len, const char *whence)
+#endif
+{
+ char *rv;
+ unsigned int uLen = (unsigned int) Len; /* for K&R C */
+
+ if (!(rv = (char*)malloc(uLen))) {
+ fprintf(stderr, "malloc(%u) failure in %s\n",
+ uLen, whence);
+ exit_(&memfailure);
+ }
+ return rv;
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/fio.h b/src/lib/yac/clapack/F2CLIBS/libf2c/fio.h
new file mode 100644
index 000000000..38b1be086
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/fio.h
@@ -0,0 +1,146 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#ifndef SYSDEP_H_INCLUDED
+#include "sysdep1.h"
+#endif
+#include "stdio.h"
+#include "errno.h"
+#ifndef NULL
+/* ANSI C */
+#include "stddef.h"
+#endif
+
+#ifndef SEEK_SET
+#define SEEK_SET 0
+#define SEEK_CUR 1
+#define SEEK_END 2
+#endif
+
+#ifndef FOPEN
+#define FOPEN fopen
+#endif
+
+#ifndef FREOPEN
+#define FREOPEN freopen
+#endif
+
+#ifndef FSEEK
+#define FSEEK fseek
+#endif
+
+#ifndef FSTAT
+#define FSTAT fstat
+#endif
+
+#ifndef FTELL
+#define FTELL ftell
+#endif
+
+#ifndef OFF_T
+#define OFF_T long
+#endif
+
+#ifndef STAT_ST
+#define STAT_ST stat
+#endif
+
+#ifndef STAT
+#define STAT stat
+#endif
+
+#ifdef MSDOS
+#ifndef NON_UNIX_STDIO
+#define NON_UNIX_STDIO
+#endif
+#endif
+
+#ifdef UIOLEN_int
+typedef int uiolen;
+#else
+typedef long uiolen;
+#endif
+
+/*units*/
+typedef struct
+{ FILE *ufd; /*0=unconnected*/
+ char *ufnm;
+#ifndef MSDOS
+ long uinode;
+ int udev;
+#endif
+ int url; /*0=sequential*/
+ flag useek; /*true=can backspace, use dir, ...*/
+ flag ufmt;
+ flag urw; /* (1 for can read) | (2 for can write) */
+ flag ublnk;
+ flag uend;
+ flag uwrt; /*last io was write*/
+ flag uscrtch;
+} unit;
+
+#undef Void
+#ifdef KR_headers
+#define Void /*void*/
+extern int (*f__getn)(); /* for formatted input */
+extern void (*f__putn)(); /* for formatted output */
+extern void x_putc();
+extern long f__inode();
+extern VOID sig_die();
+extern int (*f__donewrec)(), t_putc(), x_wSL();
+extern int c_sfe(), err__fl(), xrd_SL(), f__putbuf();
+#else
+#define Void void
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int (*f__getn)(void); /* for formatted input */
+extern void (*f__putn)(int); /* for formatted output */
+extern void x_putc(int);
+extern long f__inode(char*,int*);
+extern void sig_die(const char*,int);
+extern void f__fatal(int, const char*);
+extern int t_runc(alist*);
+extern int f__nowreading(unit*), f__nowwriting(unit*);
+extern int fk_open(int,int,ftnint);
+extern int en_fio(void);
+extern void f_init(void);
+extern int (*f__donewrec)(void), t_putc(int), x_wSL(void);
+extern void b_char(const char*,char*,ftnlen), g_char(const char*,ftnlen,char*);
+extern int c_sfe(cilist*), z_rnew(void);
+extern int err__fl(int,int,const char*);
+extern int xrd_SL(void);
+extern int f__putbuf(int);
+#endif
+extern flag f__init;
+extern cilist *f__elist; /*active external io list*/
+extern flag f__reading,f__external,f__sequential,f__formatted;
+extern int (*f__doend)(Void);
+extern FILE *f__cf; /*current file*/
+extern unit *f__curunit; /*current unit*/
+extern unit f__units[];
+#define err(f,m,s) {if(f) errno= m; else f__fatal(m,s); return(m);}
+#define errfl(f,m,s) return err__fl((int)f,m,s)
+
+/*Table sizes*/
+#define MXUNIT 100
+
+extern int f__recpos; /*position in current record*/
+extern OFF_T f__cursor; /* offset to move to */
+extern OFF_T f__hiwater; /* so TL doesn't confuse us */
+#ifdef __cplusplus
+ }
+#endif
+
+#define WRITE 1
+#define READ 2
+#define SEQ 3
+#define DIR 4
+#define FMT 5
+#define UNF 6
+#define EXT 7
+#define INT 8
+
+#define buf_end(x) (x->_flag & _IONBF ? x->_ptr : x->_base + BUFSIZ)
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.c b/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.c
new file mode 100644
index 000000000..9940b62a0
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.c
@@ -0,0 +1,535 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#define skip(s) while(*s==' ') s++
+#ifdef interdata
+#define SYLMX 300
+#endif
+#ifdef pdp11
+#define SYLMX 300
+#endif
+#ifdef vax
+#define SYLMX 300
+#endif
+#ifndef SYLMX
+#define SYLMX 300
+#endif
+#define GLITCH '\2'
+ /* special quote character for stu */
+extern flag f__cblank,f__cplus; /*blanks in I and compulsory plus*/
+static struct syl f__syl[SYLMX];
+int f__parenlvl,f__pc,f__revloc;
+#ifdef KR_headers
+#define Const /*nothing*/
+#else
+#define Const const
+#endif
+
+ static
+#ifdef KR_headers
+char *ap_end(s) char *s;
+#else
+const char *ap_end(const char *s)
+#endif
+{ char quote;
+ quote= *s++;
+ for(;*s;s++)
+ { if(*s!=quote) continue;
+ if(*++s!=quote) return(s);
+ }
+ if(f__elist->cierr) {
+ errno = 100;
+ return(NULL);
+ }
+ f__fatal(100, "bad string");
+ /*NOTREACHED*/ return 0;
+}
+ static int
+#ifdef KR_headers
+op_gen(a,b,c,d)
+#else
+op_gen(int a, int b, int c, int d)
+#endif
+{ struct syl *p= &f__syl[f__pc];
+ if(f__pc>=SYLMX)
+ { fprintf(stderr,"format too complicated:\n");
+ sig_die(f__fmtbuf, 1);
+ }
+ p->op=a;
+ p->p1=b;
+ p->p2.i[0]=c;
+ p->p2.i[1]=d;
+ return(f__pc++);
+}
+#ifdef KR_headers
+static char *f_list();
+static char *gt_num(s,n,n1) char *s; int *n, n1;
+#else
+static const char *f_list(const char*);
+static const char *gt_num(const char *s, int *n, int n1)
+#endif
+{ int m=0,f__cnt=0;
+ char c;
+ for(c= *s;;c = *s)
+ { if(c==' ')
+ { s++;
+ continue;
+ }
+ if(c>'9' || c<'0') break;
+ m=10*m+c-'0';
+ f__cnt++;
+ s++;
+ }
+ if(f__cnt==0) {
+ if (!n1)
+ s = 0;
+ *n=n1;
+ }
+ else *n=m;
+ return(s);
+}
+
+ static
+#ifdef KR_headers
+char *f_s(s,curloc) char *s;
+#else
+const char *f_s(const char *s, int curloc)
+#endif
+{
+ skip(s);
+ if(*s++!='(')
+ {
+ return(NULL);
+ }
+ if(f__parenlvl++ ==1) f__revloc=curloc;
+ if(op_gen(RET1,curloc,0,0)<0 ||
+ (s=f_list(s))==NULL)
+ {
+ return(NULL);
+ }
+ skip(s);
+ return(s);
+}
+
+ static int
+#ifdef KR_headers
+ne_d(s,p) char *s,**p;
+#else
+ne_d(const char *s, const char **p)
+#endif
+{ int n,x,sign=0;
+ struct syl *sp;
+ switch(*s)
+ {
+ default:
+ return(0);
+ case ':': (void) op_gen(COLON,0,0,0); break;
+ case '$':
+ (void) op_gen(NONL, 0, 0, 0); break;
+ case 'B':
+ case 'b':
+ if(*++s=='z' || *s == 'Z') (void) op_gen(BZ,0,0,0);
+ else (void) op_gen(BN,0,0,0);
+ break;
+ case 'S':
+ case 's':
+ if(*(s+1)=='s' || *(s+1) == 'S')
+ { x=SS;
+ s++;
+ }
+ else if(*(s+1)=='p' || *(s+1) == 'P')
+ { x=SP;
+ s++;
+ }
+ else x=S;
+ (void) op_gen(x,0,0,0);
+ break;
+ case '/': (void) op_gen(SLASH,0,0,0); break;
+ case '-': sign=1;
+ case '+': s++; /*OUTRAGEOUS CODING TRICK*/
+ case '0': case '1': case '2': case '3': case '4':
+ case '5': case '6': case '7': case '8': case '9':
+ if (!(s=gt_num(s,&n,0))) {
+ bad: *p = 0;
+ return 1;
+ }
+ switch(*s)
+ {
+ default:
+ return(0);
+ case 'P':
+ case 'p': if(sign) n= -n; (void) op_gen(P,n,0,0); break;
+ case 'X':
+ case 'x': (void) op_gen(X,n,0,0); break;
+ case 'H':
+ case 'h':
+ sp = &f__syl[op_gen(H,n,0,0)];
+ sp->p2.s = (char*)s + 1;
+ s+=n;
+ break;
+ }
+ break;
+ case GLITCH:
+ case '"':
+ case '\'':
+ sp = &f__syl[op_gen(APOS,0,0,0)];
+ sp->p2.s = (char*)s;
+ if((*p = ap_end(s)) == NULL)
+ return(0);
+ return(1);
+ case 'T':
+ case 't':
+ if(*(s+1)=='l' || *(s+1) == 'L')
+ { x=TL;
+ s++;
+ }
+ else if(*(s+1)=='r'|| *(s+1) == 'R')
+ { x=TR;
+ s++;
+ }
+ else x=T;
+ if (!(s=gt_num(s+1,&n,0)))
+ goto bad;
+ s--;
+ (void) op_gen(x,n,0,0);
+ break;
+ case 'X':
+ case 'x': (void) op_gen(X,1,0,0); break;
+ case 'P':
+ case 'p': (void) op_gen(P,1,0,0); break;
+ }
+ s++;
+ *p=s;
+ return(1);
+}
+
+ static int
+#ifdef KR_headers
+e_d(s,p) char *s,**p;
+#else
+e_d(const char *s, const char **p)
+#endif
+{ int i,im,n,w,d,e,found=0,x=0;
+ Const char *sv=s;
+ s=gt_num(s,&n,1);
+ (void) op_gen(STACK,n,0,0);
+ switch(*s++)
+ {
+ default: break;
+ case 'E':
+ case 'e': x=1;
+ case 'G':
+ case 'g':
+ found=1;
+ if (!(s=gt_num(s,&w,0))) {
+ bad:
+ *p = 0;
+ return 1;
+ }
+ if(w==0) break;
+ if(*s=='.') {
+ if (!(s=gt_num(s+1,&d,0)))
+ goto bad;
+ }
+ else d=0;
+ if(*s!='E' && *s != 'e')
+ (void) op_gen(x==1?E:G,w,d,0); /* default is Ew.dE2 */
+ else {
+ if (!(s=gt_num(s+1,&e,0)))
+ goto bad;
+ (void) op_gen(x==1?EE:GE,w,d,e);
+ }
+ break;
+ case 'O':
+ case 'o':
+ i = O;
+ im = OM;
+ goto finish_I;
+ case 'Z':
+ case 'z':
+ i = Z;
+ im = ZM;
+ goto finish_I;
+ case 'L':
+ case 'l':
+ found=1;
+ if (!(s=gt_num(s,&w,0)))
+ goto bad;
+ if(w==0) break;
+ (void) op_gen(L,w,0,0);
+ break;
+ case 'A':
+ case 'a':
+ found=1;
+ skip(s);
+ if(*s>='0' && *s<='9')
+ { s=gt_num(s,&w,1);
+ if(w==0) break;
+ (void) op_gen(AW,w,0,0);
+ break;
+ }
+ (void) op_gen(A,0,0,0);
+ break;
+ case 'F':
+ case 'f':
+ if (!(s=gt_num(s,&w,0)))
+ goto bad;
+ found=1;
+ if(w==0) break;
+ if(*s=='.') {
+ if (!(s=gt_num(s+1,&d,0)))
+ goto bad;
+ }
+ else d=0;
+ (void) op_gen(F,w,d,0);
+ break;
+ case 'D':
+ case 'd':
+ found=1;
+ if (!(s=gt_num(s,&w,0)))
+ goto bad;
+ if(w==0) break;
+ if(*s=='.') {
+ if (!(s=gt_num(s+1,&d,0)))
+ goto bad;
+ }
+ else d=0;
+ (void) op_gen(D,w,d,0);
+ break;
+ case 'I':
+ case 'i':
+ i = I;
+ im = IM;
+ finish_I:
+ if (!(s=gt_num(s,&w,0)))
+ goto bad;
+ found=1;
+ if(w==0) break;
+ if(*s!='.')
+ { (void) op_gen(i,w,0,0);
+ break;
+ }
+ if (!(s=gt_num(s+1,&d,0)))
+ goto bad;
+ (void) op_gen(im,w,d,0);
+ break;
+ }
+ if(found==0)
+ { f__pc--; /*unSTACK*/
+ *p=sv;
+ return(0);
+ }
+ *p=s;
+ return(1);
+}
+ static
+#ifdef KR_headers
+char *i_tem(s) char *s;
+#else
+const char *i_tem(const char *s)
+#endif
+{ const char *t;
+ int n,curloc;
+ if(*s==')') return(s);
+ if(ne_d(s,&t)) return(t);
+ if(e_d(s,&t)) return(t);
+ s=gt_num(s,&n,1);
+ if((curloc=op_gen(STACK,n,0,0))<0) return(NULL);
+ return(f_s(s,curloc));
+}
+
+ static
+#ifdef KR_headers
+char *f_list(s) char *s;
+#else
+const char *f_list(const char *s)
+#endif
+{
+ for(;*s!=0;)
+ { skip(s);
+ if((s=i_tem(s))==NULL) return(NULL);
+ skip(s);
+ if(*s==',') s++;
+ else if(*s==')')
+ { if(--f__parenlvl==0)
+ {
+ (void) op_gen(REVERT,f__revloc,0,0);
+ return(++s);
+ }
+ (void) op_gen(GOTO,0,0,0);
+ return(++s);
+ }
+ }
+ return(NULL);
+}
+
+ int
+#ifdef KR_headers
+pars_f(s) char *s;
+#else
+pars_f(const char *s)
+#endif
+{
+ f__parenlvl=f__revloc=f__pc=0;
+ if(f_s(s,0) == NULL)
+ {
+ return(-1);
+ }
+ return(0);
+}
+#define STKSZ 10
+int f__cnt[STKSZ],f__ret[STKSZ],f__cp,f__rp;
+flag f__workdone, f__nonl;
+
+ static int
+#ifdef KR_headers
+type_f(n)
+#else
+type_f(int n)
+#endif
+{
+ switch(n)
+ {
+ default:
+ return(n);
+ case RET1:
+ return(RET1);
+ case REVERT: return(REVERT);
+ case GOTO: return(GOTO);
+ case STACK: return(STACK);
+ case X:
+ case SLASH:
+ case APOS: case H:
+ case T: case TL: case TR:
+ return(NED);
+ case F:
+ case I:
+ case IM:
+ case A: case AW:
+ case O: case OM:
+ case L:
+ case E: case EE: case D:
+ case G: case GE:
+ case Z: case ZM:
+ return(ED);
+ }
+}
+#ifdef KR_headers
+integer do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
+#else
+integer do_fio(ftnint *number, char *ptr, ftnlen len)
+#endif
+{ struct syl *p;
+ int n,i;
+ for(i=0;i<*number;i++,ptr+=len)
+ {
+loop: switch(type_f((p= &f__syl[f__pc])->op))
+ {
+ default:
+ fprintf(stderr,"unknown code in do_fio: %d\n%s\n",
+ p->op,f__fmtbuf);
+ err(f__elist->cierr,100,"do_fio");
+ case NED:
+ if((*f__doned)(p))
+ { f__pc++;
+ goto loop;
+ }
+ f__pc++;
+ continue;
+ case ED:
+ if(f__cnt[f__cp]<=0)
+ { f__cp--;
+ f__pc++;
+ goto loop;
+ }
+ if(ptr==NULL)
+ return((*f__doend)());
+ f__cnt[f__cp]--;
+ f__workdone=1;
+ if((n=(*f__doed)(p,ptr,len))>0)
+ errfl(f__elist->cierr,errno,"fmt");
+ if(n<0)
+ err(f__elist->ciend,(EOF),"fmt");
+ continue;
+ case STACK:
+ f__cnt[++f__cp]=p->p1;
+ f__pc++;
+ goto loop;
+ case RET1:
+ f__ret[++f__rp]=p->p1;
+ f__pc++;
+ goto loop;
+ case GOTO:
+ if(--f__cnt[f__cp]<=0)
+ { f__cp--;
+ f__rp--;
+ f__pc++;
+ goto loop;
+ }
+ f__pc=1+f__ret[f__rp--];
+ goto loop;
+ case REVERT:
+ f__rp=f__cp=0;
+ f__pc = p->p1;
+ if(ptr==NULL)
+ return((*f__doend)());
+ if(!f__workdone) return(0);
+ if((n=(*f__dorevert)()) != 0) return(n);
+ goto loop;
+ case COLON:
+ if(ptr==NULL)
+ return((*f__doend)());
+ f__pc++;
+ goto loop;
+ case NONL:
+ f__nonl = 1;
+ f__pc++;
+ goto loop;
+ case S:
+ case SS:
+ f__cplus=0;
+ f__pc++;
+ goto loop;
+ case SP:
+ f__cplus = 1;
+ f__pc++;
+ goto loop;
+ case P: f__scale=p->p1;
+ f__pc++;
+ goto loop;
+ case BN:
+ f__cblank=0;
+ f__pc++;
+ goto loop;
+ case BZ:
+ f__cblank=1;
+ f__pc++;
+ goto loop;
+ }
+ }
+ return(0);
+}
+
+ int
+en_fio(Void)
+{ ftnint one=1;
+ return(do_fio(&one,(char *)NULL,(ftnint)0));
+}
+
+ VOID
+fmt_bg(Void)
+{
+ f__workdone=f__cp=f__rp=f__pc=f__cursor=0;
+ f__cnt[0]=f__ret[0]=0;
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.h b/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.h
new file mode 100644
index 000000000..7997a93cb
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/fmt.h
@@ -0,0 +1,110 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+struct syl
+{ int op;
+ int p1;
+ union { int i[2]; char *s;} p2;
+ };
+#define RET1 1
+#define REVERT 2
+#define GOTO 3
+#define X 4
+#define SLASH 5
+#define STACK 6
+#define I 7
+#define ED 8
+#define NED 9
+#define IM 10
+#define APOS 11
+#define H 12
+#define TL 13
+#define TR 14
+#define T 15
+#define COLON 16
+#define S 17
+#define SP 18
+#define SS 19
+#define P 20
+#define BN 21
+#define BZ 22
+#define F 23
+#define E 24
+#define EE 25
+#define D 26
+#define G 27
+#define GE 28
+#define L 29
+#define A 30
+#define AW 31
+#define O 32
+#define NONL 33
+#define OM 34
+#define Z 35
+#define ZM 36
+typedef union
+{ real pf;
+ doublereal pd;
+} ufloat;
+typedef union
+{ short is;
+#ifndef KR_headers
+ signed
+#endif
+ char ic;
+ integer il;
+#ifdef Allow_TYQUAD
+ longint ili;
+#endif
+} Uint;
+#ifdef KR_headers
+extern int (*f__doed)(),(*f__doned)();
+extern int (*f__dorevert)();
+extern int rd_ed(),rd_ned();
+extern int w_ed(),w_ned();
+extern int signbit_f2c();
+extern char *f__fmtbuf;
+#else
+#ifdef __cplusplus
+extern "C" {
+#define Cextern extern "C"
+#else
+#define Cextern extern
+#endif
+extern const char *f__fmtbuf;
+extern int (*f__doed)(struct syl*, char*, ftnlen),(*f__doned)(struct syl*);
+extern int (*f__dorevert)(void);
+extern void fmt_bg(void);
+extern int pars_f(const char*);
+extern int rd_ed(struct syl*, char*, ftnlen),rd_ned(struct syl*);
+extern int signbit_f2c(double*);
+extern int w_ed(struct syl*, char*, ftnlen),w_ned(struct syl*);
+extern int wrt_E(ufloat*, int, int, int, ftnlen);
+extern int wrt_F(ufloat*, int, int, ftnlen);
+extern int wrt_L(Uint*, int, ftnlen);
+#endif
+extern int f__pc,f__parenlvl,f__revloc;
+extern flag f__cblank,f__cplus,f__workdone, f__nonl;
+extern int f__scale;
+#ifdef __cplusplus
+ }
+#endif
+#define GET(x) if((x=(*f__getn)())<0) return(x)
+#define VAL(x) (x!='\n'?x:' ')
+#define PUT(x) (*f__putn)(x)
+
+#undef TYQUAD
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#else
+#define TYQUAD 14
+#endif
+
+#ifdef KR_headers
+extern char *f__icvt();
+#else
+Cextern char *f__icvt(longint, int*, int*, int);
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/fmtlib.c b/src/lib/yac/clapack/F2CLIBS/libf2c/fmtlib.c
new file mode 100644
index 000000000..3cde2006c
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/fmtlib.c
@@ -0,0 +1,56 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* @(#)fmtlib.c 1.2 */
+#define MAXINTLENGTH 23
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifndef Allow_TYQUAD
+#undef longint
+#define longint long
+#undef ulongint
+#define ulongint unsigned long
+#endif
+
+#ifdef KR_headers
+char *f__icvt(value,ndigit,sign, base) longint value; int *ndigit,*sign;
+ register int base;
+#else
+char *f__icvt(longint value, int *ndigit, int *sign, int base)
+#endif
+{
+ static char buf[MAXINTLENGTH+1];
+ register int i;
+ ulongint uvalue;
+
+ if(value > 0) {
+ uvalue = value;
+ *sign = 0;
+ }
+ else if (value < 0) {
+ uvalue = -value;
+ *sign = 1;
+ }
+ else {
+ *sign = 0;
+ *ndigit = 1;
+ buf[MAXINTLENGTH-1] = '0';
+ return &buf[MAXINTLENGTH-1];
+ }
+ i = MAXINTLENGTH;
+ do {
+ buf[--i] = (uvalue%base) + '0';
+ uvalue /= base;
+ }
+ while(uvalue > 0);
+ *ndigit = MAXINTLENGTH - i;
+ return &buf[i];
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/fp.h b/src/lib/yac/clapack/F2CLIBS/libf2c/fp.h
new file mode 100644
index 000000000..091b30477
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/fp.h
@@ -0,0 +1,33 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#define FMAX 40
+#define EXPMAXDIGS 8
+#define EXPMAX 99999999
+/* FMAX = max number of nonzero digits passed to atof() */
+/* EXPMAX = 10^EXPMAXDIGS - 1 = largest allowed exponent absolute value */
+
+#ifdef V10 /* Research Tenth-Edition Unix */
+#include "local.h"
+#endif
+
+/* MAXFRACDIGS and MAXINTDIGS are for wrt_F -- bounds (not necessarily
+ tight) on the maximum number of digits to the right and left of
+ * the decimal point.
+ */
+
+#ifdef VAX
+#define MAXFRACDIGS 56
+#define MAXINTDIGS 38
+#else
+#ifdef CRAY
+#define MAXFRACDIGS 9880
+#define MAXINTDIGS 9864
+#else
+/* values that suffice for IEEE double */
+#define MAXFRACDIGS 344
+#define MAXINTDIGS 308
+#endif
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/i_nint.c b/src/lib/yac/clapack/F2CLIBS/libf2c/i_nint.c
new file mode 100644
index 000000000..dda3e27f5
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/i_nint.c
@@ -0,0 +1,24 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+
+#ifdef KR_headers
+double floor();
+integer i_nint(x) real *x;
+#else
+#undef abs
+#include "math.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+integer i_nint(real *x)
+#endif
+{
+return (integer)(*x >= 0 ? floor(*x + .5) : -floor(.5 - *x));
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/open.c b/src/lib/yac/clapack/F2CLIBS/libf2c/open.c
new file mode 100644
index 000000000..470025c07
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/open.c
@@ -0,0 +1,306 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+#include "string.h"
+#ifndef NON_POSIX_STDIO
+#ifdef MSDOS
+#include "io.h"
+#else
+#include "unistd.h" /* for access */
+#endif
+#endif
+
+#ifdef KR_headers
+extern char *malloc();
+#ifdef NON_ANSI_STDIO
+extern char *mktemp();
+#endif
+extern integer f_clos();
+#define Const /*nothing*/
+#else
+#define Const const
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+extern int f__canseek(FILE*);
+extern integer f_clos(cllist*);
+#endif
+
+#ifdef NON_ANSI_RW_MODES
+Const char *f__r_mode[2] = {"r", "r"};
+Const char *f__w_mode[4] = {"w", "w", "r+w", "r+w"};
+#else
+Const char *f__r_mode[2] = {"rb", "r"};
+Const char *f__w_mode[4] = {"wb", "w", "r+b", "r+"};
+#endif
+
+ static char f__buf0[400], *f__buf = f__buf0;
+ int f__buflen = (int)sizeof(f__buf0);
+
+ static void
+#ifdef KR_headers
+f__bufadj(n, c) int n, c;
+#else
+f__bufadj(int n, int c)
+#endif
+{
+ unsigned int len;
+ char *nbuf, *s, *t, *te;
+
+ if (f__buf == f__buf0)
+ f__buflen = 1024;
+ while(f__buflen <= n)
+ f__buflen <<= 1;
+ len = (unsigned int)f__buflen;
+ if (len != f__buflen || !(nbuf = (char*)malloc(len)))
+ f__fatal(113, "malloc failure");
+ s = nbuf;
+ t = f__buf;
+ te = t + c;
+ while(t < te)
+ *s++ = *t++;
+ if (f__buf != f__buf0)
+ free(f__buf);
+ f__buf = nbuf;
+ }
+
+ int
+#ifdef KR_headers
+f__putbuf(c) int c;
+#else
+f__putbuf(int c)
+#endif
+{
+ char *s, *se;
+ int n;
+
+ if (f__hiwater > f__recpos)
+ f__recpos = f__hiwater;
+ n = f__recpos + 1;
+ if (n >= f__buflen)
+ f__bufadj(n, f__recpos);
+ s = f__buf;
+ se = s + f__recpos;
+ if (c)
+ *se++ = c;
+ *se = 0;
+ for(;;) {
+ fputs(s, f__cf);
+ s += strlen(s);
+ if (s >= se)
+ break; /* normally happens the first time */
+ putc(*s++, f__cf);
+ }
+ return 0;
+ }
+
+ void
+#ifdef KR_headers
+x_putc(c)
+#else
+x_putc(int c)
+#endif
+{
+ if (f__recpos >= f__buflen)
+ f__bufadj(f__recpos, f__buflen);
+ f__buf[f__recpos++] = c;
+ }
+
+#define opnerr(f,m,s) {if(f) errno= m; else opn_err(m,s,a); return(m);}
+
+ static void
+#ifdef KR_headers
+opn_err(m, s, a) int m; char *s; olist *a;
+#else
+opn_err(int m, const char *s, olist *a)
+#endif
+{
+ if (a->ofnm) {
+ /* supply file name to error message */
+ if (a->ofnmlen >= f__buflen)
+ f__bufadj((int)a->ofnmlen, 0);
+ g_char(a->ofnm, a->ofnmlen, f__curunit->ufnm = f__buf);
+ }
+ f__fatal(m, s);
+ }
+
+#ifdef KR_headers
+integer f_open(a) olist *a;
+#else
+integer f_open(olist *a)
+#endif
+{ unit *b;
+ integer rv;
+ char buf[256], *s;
+ cllist x;
+ int ufmt;
+ FILE *tf;
+#ifndef NON_UNIX_STDIO
+ int n;
+#endif
+ f__external = 1;
+ if(a->ounit>=MXUNIT || a->ounit<0)
+ err(a->oerr,101,"open")
+ if (!f__init)
+ f_init();
+ f__curunit = b = &f__units[a->ounit];
+ if(b->ufd) {
+ if(a->ofnm==0)
+ {
+ same: if (a->oblnk)
+ b->ublnk = *a->oblnk == 'z' || *a->oblnk == 'Z';
+ return(0);
+ }
+#ifdef NON_UNIX_STDIO
+ if (b->ufnm
+ && strlen(b->ufnm) == a->ofnmlen
+ && !strncmp(b->ufnm, a->ofnm, (unsigned)a->ofnmlen))
+ goto same;
+#else
+ g_char(a->ofnm,a->ofnmlen,buf);
+ if (f__inode(buf,&n) == b->uinode && n == b->udev)
+ goto same;
+#endif
+ x.cunit=a->ounit;
+ x.csta=0;
+ x.cerr=a->oerr;
+ if ((rv = f_clos(&x)) != 0)
+ return rv;
+ }
+ b->url = (int)a->orl;
+ b->ublnk = a->oblnk && (*a->oblnk == 'z' || *a->oblnk == 'Z');
+ if(a->ofm==0)
+ { if(b->url>0) b->ufmt=0;
+ else b->ufmt=1;
+ }
+ else if(*a->ofm=='f' || *a->ofm == 'F') b->ufmt=1;
+ else b->ufmt=0;
+ ufmt = b->ufmt;
+#ifdef url_Adjust
+ if (b->url && !ufmt)
+ url_Adjust(b->url);
+#endif
+ if (a->ofnm) {
+ g_char(a->ofnm,a->ofnmlen,buf);
+ if (!buf[0])
+ opnerr(a->oerr,107,"open")
+ }
+ else
+ sprintf(buf, "fort.%ld", (long)a->ounit);
+ b->uscrtch = 0;
+ b->uend=0;
+ b->uwrt = 0;
+ b->ufd = 0;
+ b->urw = 3;
+ switch(a->osta ? *a->osta : 'u')
+ {
+ case 'o':
+ case 'O':
+#ifdef NON_POSIX_STDIO
+ if (!(tf = FOPEN(buf,"r")))
+ opnerr(a->oerr,errno,"open")
+ fclose(tf);
+#else
+ if (access(buf,0))
+ opnerr(a->oerr,errno,"open")
+#endif
+ break;
+ case 's':
+ case 'S':
+ b->uscrtch=1;
+#ifdef NON_ANSI_STDIO
+ (void) strcpy(buf,"tmp.FXXXXXX");
+ (void) mktemp(buf);
+ goto replace;
+#else
+ if (!(b->ufd = tmpfile()))
+ opnerr(a->oerr,errno,"open")
+ b->ufnm = 0;
+#ifndef NON_UNIX_STDIO
+ b->uinode = b->udev = -1;
+#endif
+ b->useek = 1;
+ return 0;
+#endif
+
+ case 'n':
+ case 'N':
+#ifdef NON_POSIX_STDIO
+ if ((tf = FOPEN(buf,"r")) || (tf = FOPEN(buf,"a"))) {
+ fclose(tf);
+ opnerr(a->oerr,128,"open")
+ }
+#else
+ if (!access(buf,0))
+ opnerr(a->oerr,128,"open")
+#endif
+ /* no break */
+ case 'r': /* Fortran 90 replace option */
+ case 'R':
+#ifdef NON_ANSI_STDIO
+ replace:
+#endif
+ if (tf = FOPEN(buf,f__w_mode[0]))
+ fclose(tf);
+ }
+
+ b->ufnm=(char *) malloc((unsigned int)(strlen(buf)+1));
+ if(b->ufnm==NULL) opnerr(a->oerr,113,"no space");
+ (void) strcpy(b->ufnm,buf);
+ if ((s = a->oacc) && b->url)
+ ufmt = 0;
+ if(!(tf = FOPEN(buf, f__w_mode[ufmt|2]))) {
+ if (tf = FOPEN(buf, f__r_mode[ufmt]))
+ b->urw = 1;
+ else if (tf = FOPEN(buf, f__w_mode[ufmt])) {
+ b->uwrt = 1;
+ b->urw = 2;
+ }
+ else
+ err(a->oerr, errno, "open");
+ }
+ b->useek = f__canseek(b->ufd = tf);
+#ifndef NON_UNIX_STDIO
+ if((b->uinode = f__inode(buf,&b->udev)) == -1)
+ opnerr(a->oerr,108,"open")
+#endif
+ if(b->useek)
+ if (a->orl)
+ rewind(b->ufd);
+ else if ((s = a->oacc) && (*s == 'a' || *s == 'A')
+ && FSEEK(b->ufd, 0L, SEEK_END))
+ opnerr(a->oerr,129,"open");
+ return(0);
+}
+
+ int
+#ifdef KR_headers
+fk_open(seq,fmt,n) ftnint n;
+#else
+fk_open(int seq, int fmt, ftnint n)
+#endif
+{ char nbuf[10];
+ olist a;
+ (void) sprintf(nbuf,"fort.%ld",(long)n);
+ a.oerr=1;
+ a.ounit=n;
+ a.ofnm=nbuf;
+ a.ofnmlen=strlen(nbuf);
+ a.osta=NULL;
+ a.oacc= (char*)(seq==SEQ?"s":"d");
+ a.ofm = (char*)(fmt==FMT?"f":"u");
+ a.orl = seq==DIR?1:0;
+ a.oblnk=NULL;
+ return(f_open(&a));
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/pow_di.c b/src/lib/yac/clapack/F2CLIBS/libf2c/pow_di.c
new file mode 100644
index 000000000..640d6dc47
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/pow_di.c
@@ -0,0 +1,46 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+double pow_di(ap, bp) doublereal *ap; integer *bp;
+#else
+double pow_di(doublereal *ap, integer *bp)
+#endif
+{
+double pow, x;
+integer n;
+unsigned long u;
+
+pow = 1;
+x = *ap;
+n = *bp;
+
+if(n != 0)
+ {
+ if(n < 0)
+ {
+ n = -n;
+ x = 1/x;
+ }
+ for(u = n; ; )
+ {
+ if(u & 01)
+ pow *= x;
+ if(u >>= 1)
+ x *= x;
+ else
+ break;
+ }
+ }
+return(pow);
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/s_cat.c b/src/lib/yac/clapack/F2CLIBS/libf2c/s_cat.c
new file mode 100644
index 000000000..6430e58c4
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/s_cat.c
@@ -0,0 +1,91 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_cat allows the
+ * target of a concatenation to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90).
+ */
+
+#include "f2c.h"
+#ifndef NO_OVERWRITE
+#include "stdio.h"
+#undef abs
+#ifdef KR_headers
+ extern char *F77_aloc();
+ extern void free();
+ extern void exit_();
+#else
+#undef min
+#undef max
+#include "stdlib.h"
+extern
+#ifdef __cplusplus
+ "C"
+#endif
+ char *F77_aloc(ftnlen, const char*);
+#endif
+#include "string.h"
+#endif /* NO_OVERWRITE */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ VOID
+#ifdef KR_headers
+s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll;
+#else
+s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll)
+#endif
+{
+ ftnlen i, nc;
+ char *rp;
+ ftnlen n = *np;
+#ifndef NO_OVERWRITE
+ ftnlen L, m;
+ char *lp0, *lp1;
+
+ lp0 = 0;
+ lp1 = lp;
+ L = ll;
+ i = 0;
+ while(i < n) {
+ rp = rpp[i];
+ m = rnp[i++];
+ if (rp >= lp1 || rp + m <= lp) {
+ if ((L -= m) <= 0) {
+ n = i;
+ break;
+ }
+ lp1 += m;
+ continue;
+ }
+ lp0 = lp;
+ lp = lp1 = F77_aloc(L = ll, "s_cat");
+ break;
+ }
+ lp1 = lp;
+#endif /* NO_OVERWRITE */
+ for(i = 0 ; i < n ; ++i) {
+ nc = ll;
+ if(rnp[i] < nc)
+ nc = rnp[i];
+ ll -= nc;
+ rp = rpp[i];
+ while(--nc >= 0)
+ *lp++ = *rp++;
+ }
+ while(--ll >= 0)
+ *lp++ = ' ';
+#ifndef NO_OVERWRITE
+ if (lp0) {
+ memcpy(lp0, lp1, L);
+ free(lp1);
+ }
+#endif
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/s_cmp.c b/src/lib/yac/clapack/F2CLIBS/libf2c/s_cmp.c
new file mode 100644
index 000000000..8dd749f8c
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/s_cmp.c
@@ -0,0 +1,55 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* compare two strings */
+
+#ifdef KR_headers
+integer s_cmp(a0, b0, la, lb) char *a0, *b0; ftnlen la, lb;
+#else
+integer s_cmp(char *a0, char *b0, ftnlen la, ftnlen lb)
+#endif
+{
+register unsigned char *a, *aend, *b, *bend;
+a = (unsigned char *)a0;
+b = (unsigned char *)b0;
+aend = a + la;
+bend = b + lb;
+
+if(la <= lb)
+ {
+ while(a < aend)
+ if(*a != *b)
+ return( *a - *b );
+ else
+ { ++a; ++b; }
+
+ while(b < bend)
+ if(*b != ' ')
+ return( ' ' - *b );
+ else ++b;
+ }
+
+else
+ {
+ while(b < bend)
+ if(*a == *b)
+ { ++a; ++b; }
+ else
+ return( *a - *b );
+ while(a < aend)
+ if(*a != ' ')
+ return(*a - ' ');
+ else ++a;
+ }
+return(0);
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/s_copy.c b/src/lib/yac/clapack/F2CLIBS/libf2c/s_copy.c
new file mode 100644
index 000000000..0725f3a0b
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/s_copy.c
@@ -0,0 +1,62 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* Unless compiled with -DNO_OVERWRITE, this variant of s_copy allows the
+ * target of an assignment to appear on its right-hand side (contrary
+ * to the Fortran 77 Standard, but in accordance with Fortran 90),
+ * as in a(2:5) = a(4:7) .
+ */
+
+#include "f2c.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* assign strings: a = b */
+
+#ifdef KR_headers
+VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb;
+#else
+void s_copy(register char *a, register char *b, ftnlen la, ftnlen lb)
+#endif
+{
+ register char *aend, *bend;
+
+ aend = a + la;
+
+ if(la <= lb)
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= b + la)
+#endif
+ while(a < aend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else
+ for(b += la; a < aend; )
+ *--aend = *--b;
+#endif
+
+ else {
+ bend = b + lb;
+#ifndef NO_OVERWRITE
+ if (a <= b || a >= bend)
+#endif
+ while(b < bend)
+ *a++ = *b++;
+#ifndef NO_OVERWRITE
+ else {
+ a += lb;
+ while(b < bend)
+ *--a = *--bend;
+ a += lb;
+ }
+#endif
+ while(a < aend)
+ *a++ = ' ';
+ }
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/sfe.c b/src/lib/yac/clapack/F2CLIBS/libf2c/sfe.c
new file mode 100644
index 000000000..a9c227f10
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/sfe.c
@@ -0,0 +1,52 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* sequential formatted external common routines*/
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#ifdef KR_headers
+extern char *f__fmtbuf;
+#else
+extern const char *f__fmtbuf;
+#endif
+
+integer e_rsfe(Void)
+{ int n;
+ n=en_fio();
+ f__fmtbuf=NULL;
+ return(n);
+}
+
+ int
+#ifdef KR_headers
+c_sfe(a) cilist *a; /* check */
+#else
+c_sfe(cilist *a) /* check */
+#endif
+{ unit *p;
+ f__curunit = p = &f__units[a->ciunit];
+ if(a->ciunit >= MXUNIT || a->ciunit<0)
+ err(a->cierr,101,"startio");
+ if(p->ufd==NULL && fk_open(SEQ,FMT,a->ciunit)) err(a->cierr,114,"sfe")
+ if(!p->ufmt) err(a->cierr,102,"sfe")
+ return(0);
+}
+integer e_wsfe(Void)
+{
+ int n = en_fio();
+ f__fmtbuf = NULL;
+#ifdef ALWAYS_FLUSH
+ if (!n && fflush(f__cf))
+ err(f__elist->cierr, errno, "write end");
+#endif
+ return n;
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/sig_die.c b/src/lib/yac/clapack/F2CLIBS/libf2c/sig_die.c
new file mode 100644
index 000000000..3ffa95e95
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/sig_die.c
@@ -0,0 +1,56 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "stdio.h"
+#include "signal.h"
+
+#ifndef SIGIOT
+#ifdef SIGABRT
+#define SIGIOT SIGABRT
+#endif
+#endif
+
+#ifdef KR_headers
+void sig_die(s, kill) char *s; int kill;
+#else
+#include "stdlib.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#ifdef __cplusplus
+extern "C" {
+#endif
+ extern void f_exit(void);
+
+void sig_die(const char *s, int kill)
+#endif
+{
+ /* print error message, then clear buffers */
+ fprintf(stderr, "%s\n", s);
+
+ if(kill)
+ {
+ fflush(stderr);
+ f_exit();
+ fflush(stderr);
+ /* now get a core */
+#ifdef SIGIOT
+ signal(SIGIOT, SIG_DFL);
+#endif
+ abort();
+ }
+ else {
+#ifdef NO_ONEXIT
+ f_exit();
+#endif
+ exit(1);
+ }
+ }
+#ifdef __cplusplus
+}
+#endif
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/sysdep1.h0 b/src/lib/yac/clapack/F2CLIBS/libf2c/sysdep1.h0
new file mode 100644
index 000000000..36861f467
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/sysdep1.h0
@@ -0,0 +1,70 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#ifndef SYSDEP_H_INCLUDED
+#define SYSDEP_H_INCLUDED
+#undef USE_LARGEFILE
+#ifndef NO_LONG_LONG
+
+#ifdef __sun__
+#define USE_LARGEFILE
+#define OFF_T off64_t
+#endif
+
+#ifdef __linux__
+#define USE_LARGEFILE
+#define OFF_T __off64_t
+#endif
+
+#ifdef _AIX43
+#define _LARGE_FILES
+#define _LARGE_FILE_API
+#define USE_LARGEFILE
+#endif /*_AIX43*/
+
+#ifdef __hpux
+#define _FILE64
+#define _LARGEFILE64_SOURCE
+#define USE_LARGEFILE
+#endif /*__hpux*/
+
+#ifdef __sgi
+#define USE_LARGEFILE
+#endif /*__sgi*/
+
+#ifdef __FreeBSD__
+#define OFF_T off_t
+#define FSEEK fseeko
+#define FTELL ftello
+#endif
+
+#ifdef USE_LARGEFILE
+#ifndef OFF_T
+#define OFF_T off64_t
+#endif
+#define _LARGEFILE_SOURCE
+#define _LARGEFILE64_SOURCE
+#include <sys/types.h>
+#include <sys/stat.h>
+#define FOPEN fopen64
+#define FREOPEN freopen64
+#define FSEEK fseeko64
+#define FSTAT fstat64
+#define FTELL ftello64
+#define FTRUNCATE ftruncate64
+#define STAT stat64
+#define STAT_ST stat64
+#endif /*USE_LARGEFILE*/
+#endif /*NO_LONG_LONG*/
+
+#ifndef NON_UNIX_STDIO
+#ifndef USE_LARGEFILE
+#define _INCLUDE_POSIX_SOURCE /* for HP-UX */
+#define _INCLUDE_XOPEN_SOURCE /* for HP-UX */
+#include "sys/types.h"
+#include "sys/stat.h"
+#endif
+#endif
+
+#endif /*SYSDEP_H_INCLUDED*/
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/util.c b/src/lib/yac/clapack/F2CLIBS/libf2c/util.c
new file mode 100644
index 000000000..c4e5a4169
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/util.c
@@ -0,0 +1,62 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "sysdep1.h" /* here to get stat64 on some badly designed Linux systems */
+#include "f2c.h"
+#include "fio.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ VOID
+#ifdef KR_headers
+#define Const /*nothing*/
+g_char(a,alen,b) char *a,*b; ftnlen alen;
+#else
+#define Const const
+g_char(const char *a, ftnlen alen, char *b)
+#endif
+{
+ Const char *x = a + alen;
+ char *y = b + alen;
+
+ for(;; y--) {
+ if (x <= a) {
+ *b = 0;
+ return;
+ }
+ if (*--x != ' ')
+ break;
+ }
+ *y-- = 0;
+ do *y-- = *x;
+ while(x-- > a);
+ }
+
+ VOID
+#ifdef KR_headers
+b_char(a,b,blen) char *a,*b; ftnlen blen;
+#else
+b_char(const char *a, char *b, ftnlen blen)
+#endif
+{ int i;
+ for(i=0;i<blen && *a!=0;i++) *b++= *a++;
+ for(;i<blen;i++) *b++=' ';
+}
+#ifndef NON_UNIX_STDIO
+#ifdef KR_headers
+long f__inode(a, dev) char *a; int *dev;
+#else
+long f__inode(char *a, int *dev)
+#endif
+{ struct STAT_ST x;
+ if(STAT(a,&x)<0) return(-1);
+ *dev = x.st_dev;
+ return(x.st_ino);
+}
+#endif
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/wref.c b/src/lib/yac/clapack/F2CLIBS/libf2c/wref.c
new file mode 100644
index 000000000..6fea4f898
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/wref.c
@@ -0,0 +1,299 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+
+#ifndef KR_headers
+#undef abs
+#undef min
+#undef max
+#include "stdlib.h"
+#include "string.h"
+#endif
+
+#include "fmt.h"
+#include "fp.h"
+#ifndef VAX
+#include "ctype.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+#endif
+
+ int
+#ifdef KR_headers
+wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
+#else
+wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
+#endif
+{
+ char buf[FMAX+EXPMAXDIGS+4], *s, *se;
+ int d1, delta, e1, i, sign, signspace;
+ double dd;
+#ifdef WANT_LEAD_0
+ int insert0 = 0;
+#endif
+#ifndef VAX
+ int e0 = e;
+#endif
+
+ if(e <= 0)
+ e = 2;
+ if(f__scale) {
+ if(f__scale >= d + 2 || f__scale <= -d)
+ goto nogood;
+ }
+ if(f__scale <= 0)
+ --d;
+ if (len == sizeof(real))
+ dd = p->pf;
+ else
+ dd = p->pd;
+ if (dd < 0.) {
+ signspace = sign = 1;
+ dd = -dd;
+ }
+ else {
+ sign = 0;
+ signspace = (int)f__cplus;
+#ifndef VAX
+ if (!dd) {
+#ifdef SIGNED_ZEROS
+ if (signbit_f2c(&dd))
+ signspace = sign = 1;
+#endif
+ dd = 0.; /* avoid -0 */
+ }
+#endif
+ }
+ delta = w - (2 /* for the . and the d adjustment above */
+ + 2 /* for the E+ */ + signspace + d + e);
+#ifdef WANT_LEAD_0
+ if (f__scale <= 0 && delta > 0) {
+ delta--;
+ insert0 = 1;
+ }
+ else
+#endif
+ if (delta < 0) {
+nogood:
+ while(--w >= 0)
+ PUT('*');
+ return(0);
+ }
+ if (f__scale < 0)
+ d += f__scale;
+ if (d > FMAX) {
+ d1 = d - FMAX;
+ d = FMAX;
+ }
+ else
+ d1 = 0;
+ sprintf(buf,"%#.*E", d, dd);
+#ifndef VAX
+ /* check for NaN, Infinity */
+ if (!isdigit(buf[0])) {
+ switch(buf[0]) {
+ case 'n':
+ case 'N':
+ signspace = 0; /* no sign for NaNs */
+ }
+ delta = w - strlen(buf) - signspace;
+ if (delta < 0)
+ goto nogood;
+ while(--delta >= 0)
+ PUT(' ');
+ if (signspace)
+ PUT(sign ? '-' : '+');
+ for(s = buf; *s; s++)
+ PUT(*s);
+ return 0;
+ }
+#endif
+ se = buf + d + 3;
+#ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
+ if (f__scale != 1 && dd)
+ sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+#else
+ if (dd)
+ sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
+ else
+ strcpy(se, "+00");
+#endif
+ s = ++se;
+ if (e < 2) {
+ if (*s != '0')
+ goto nogood;
+ }
+#ifndef VAX
+ /* accommodate 3 significant digits in exponent */
+ if (s[2]) {
+#ifdef Pedantic
+ if (!e0 && !s[3])
+ for(s -= 2, e1 = 2; s[0] = s[1]; s++);
+
+ /* Pedantic gives the behavior that Fortran 77 specifies, */
+ /* i.e., requires that E be specified for exponent fields */
+ /* of more than 3 digits. With Pedantic undefined, we get */
+ /* the behavior that Cray displays -- you get a bigger */
+ /* exponent field if it fits. */
+#else
+ if (!e0) {
+ for(s -= 2, e1 = 2; s[0] = s[1]; s++)
+#ifdef CRAY
+ delta--;
+ if ((delta += 4) < 0)
+ goto nogood
+#endif
+ ;
+ }
+#endif
+ else if (e0 >= 0)
+ goto shift;
+ else
+ e1 = e;
+ }
+ else
+ shift:
+#endif
+ for(s += 2, e1 = 2; *s; ++e1, ++s)
+ if (e1 >= e)
+ goto nogood;
+ while(--delta >= 0)
+ PUT(' ');
+ if (signspace)
+ PUT(sign ? '-' : '+');
+ s = buf;
+ i = f__scale;
+ if (f__scale <= 0) {
+#ifdef WANT_LEAD_0
+ if (insert0)
+ PUT('0');
+#endif
+ PUT('.');
+ for(; i < 0; ++i)
+ PUT('0');
+ PUT(*s);
+ s += 2;
+ }
+ else if (f__scale > 1) {
+ PUT(*s);
+ s += 2;
+ while(--i > 0)
+ PUT(*s++);
+ PUT('.');
+ }
+ if (d1) {
+ se -= 2;
+ while(s < se) PUT(*s++);
+ se += 2;
+ do PUT('0'); while(--d1 > 0);
+ }
+ while(s < se)
+ PUT(*s++);
+ if (e < 2)
+ PUT(s[1]);
+ else {
+ while(++e1 <= e)
+ PUT('0');
+ while(*s)
+ PUT(*s++);
+ }
+ return 0;
+ }
+
+ int
+#ifdef KR_headers
+wrt_F(p,w,d,len) ufloat *p; ftnlen len;
+#else
+wrt_F(ufloat *p, int w, int d, ftnlen len)
+#endif
+{
+ int d1, sign, n;
+ double x;
+ char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
+
+ x= (len==sizeof(real)?p->pf:p->pd);
+ if (d < MAXFRACDIGS)
+ d1 = 0;
+ else {
+ d1 = d - MAXFRACDIGS;
+ d = MAXFRACDIGS;
+ }
+ if (x < 0.)
+ { x = -x; sign = 1; }
+ else {
+ sign = 0;
+#ifndef VAX
+ if (!x) {
+#ifdef SIGNED_ZEROS
+ if (signbit_f2c(&x))
+ sign = 2;
+#endif
+ x = 0.;
+ }
+#endif
+ }
+
+ if (n = f__scale)
+ if (n > 0)
+ do x *= 10.; while(--n > 0);
+ else
+ do x *= 0.1; while(++n < 0);
+
+#ifdef USE_STRLEN
+ sprintf(b = buf, "%#.*f", d, x);
+ n = strlen(b) + d1;
+#else
+ n = sprintf(b = buf, "%#.*f", d, x) + d1;
+#endif
+
+#ifndef WANT_LEAD_0
+ if (buf[0] == '0' && d)
+ { ++b; --n; }
+#endif
+ if (sign == 1) {
+ /* check for all zeros */
+ for(s = b;;) {
+ while(*s == '0') s++;
+ switch(*s) {
+ case '.':
+ s++; continue;
+ case 0:
+ sign = 0;
+ }
+ break;
+ }
+ }
+ if (sign || f__cplus)
+ ++n;
+ if (n > w) {
+#ifdef WANT_LEAD_0
+ if (buf[0] == '0' && --n == w)
+ ++b;
+ else
+#endif
+ {
+ while(--w >= 0)
+ PUT('*');
+ return 0;
+ }
+ }
+ for(w -= n; --w >= 0; )
+ PUT(' ');
+ if (sign)
+ PUT('-');
+ else if (f__cplus)
+ PUT('+');
+ while(n = *b++)
+ PUT(n);
+ while(--d1 >= 0)
+ PUT('0');
+ return 0;
+ }
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/wrtfmt.c b/src/lib/yac/clapack/F2CLIBS/libf2c/wrtfmt.c
new file mode 100644
index 000000000..653c84f76
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/wrtfmt.c
@@ -0,0 +1,382 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+extern icilist *f__svic;
+extern char *f__icptr;
+
+ static int
+mv_cur(Void) /* shouldn't use fseek because it insists on calling fflush */
+ /* instead we know too much about stdio */
+{
+ int cursor = f__cursor;
+ f__cursor = 0;
+ if(f__external == 0) {
+ if(cursor < 0) {
+ if(f__hiwater < f__recpos)
+ f__hiwater = f__recpos;
+ f__recpos += cursor;
+ f__icptr += cursor;
+ if(f__recpos < 0)
+ err(f__elist->cierr, 110, "left off");
+ }
+ else if(cursor > 0) {
+ if(f__recpos + cursor >= f__svic->icirlen)
+ err(f__elist->cierr, 110, "recend");
+ if(f__hiwater <= f__recpos)
+ for(; cursor > 0; cursor--)
+ (*f__putn)(' ');
+ else if(f__hiwater <= f__recpos + cursor) {
+ cursor -= f__hiwater - f__recpos;
+ f__icptr += f__hiwater - f__recpos;
+ f__recpos = f__hiwater;
+ for(; cursor > 0; cursor--)
+ (*f__putn)(' ');
+ }
+ else {
+ f__icptr += cursor;
+ f__recpos += cursor;
+ }
+ }
+ return(0);
+ }
+ if (cursor > 0) {
+ if(f__hiwater <= f__recpos)
+ for(;cursor>0;cursor--) (*f__putn)(' ');
+ else if(f__hiwater <= f__recpos + cursor) {
+ cursor -= f__hiwater - f__recpos;
+ f__recpos = f__hiwater;
+ for(; cursor > 0; cursor--)
+ (*f__putn)(' ');
+ }
+ else {
+ f__recpos += cursor;
+ }
+ }
+ else if (cursor < 0)
+ {
+ if(cursor + f__recpos < 0)
+ err(f__elist->cierr,110,"left off");
+ if(f__hiwater < f__recpos)
+ f__hiwater = f__recpos;
+ f__recpos += cursor;
+ }
+ return(0);
+}
+
+ static int
+#ifdef KR_headers
+wrt_Z(n,w,minlen,len) Uint *n; int w, minlen; ftnlen len;
+#else
+wrt_Z(Uint *n, int w, int minlen, ftnlen len)
+#endif
+{
+ register char *s, *se;
+ register int i, w1;
+ static int one = 1;
+ static char hex[] = "0123456789ABCDEF";
+ s = (char *)n;
+ --len;
+ if (*(char *)&one) {
+ /* little endian */
+ se = s;
+ s += len;
+ i = -1;
+ }
+ else {
+ se = s + len;
+ i = 1;
+ }
+ for(;; s += i)
+ if (s == se || *s)
+ break;
+ w1 = (i*(se-s) << 1) + 1;
+ if (*s & 0xf0)
+ w1++;
+ if (w1 > w)
+ for(i = 0; i < w; i++)
+ (*f__putn)('*');
+ else {
+ if ((minlen -= w1) > 0)
+ w1 += minlen;
+ while(--w >= w1)
+ (*f__putn)(' ');
+ while(--minlen >= 0)
+ (*f__putn)('0');
+ if (!(*s & 0xf0)) {
+ (*f__putn)(hex[*s & 0xf]);
+ if (s == se)
+ return 0;
+ s += i;
+ }
+ for(;; s += i) {
+ (*f__putn)(hex[*s >> 4 & 0xf]);
+ (*f__putn)(hex[*s & 0xf]);
+ if (s == se)
+ break;
+ }
+ }
+ return 0;
+ }
+
+ static int
+#ifdef KR_headers
+wrt_I(n,w,len, base) Uint *n; ftnlen len; register int base;
+#else
+wrt_I(Uint *n, int w, ftnlen len, register int base)
+#endif
+{ int ndigit,sign,spare,i;
+ longint x;
+ char *ans;
+ if(len==sizeof(integer)) x=n->il;
+ else if(len == sizeof(char)) x = n->ic;
+#ifdef Allow_TYQUAD
+ else if (len == sizeof(longint)) x = n->ili;
+#endif
+ else x=n->is;
+ ans=f__icvt(x,&ndigit,&sign, base);
+ spare=w-ndigit;
+ if(sign || f__cplus) spare--;
+ if(spare<0)
+ for(i=0;i<w;i++) (*f__putn)('*');
+ else
+ { for(i=0;i<spare;i++) (*f__putn)(' ');
+ if(sign) (*f__putn)('-');
+ else if(f__cplus) (*f__putn)('+');
+ for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+ }
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_IM(n,w,m,len,base) Uint *n; ftnlen len; int base;
+#else
+wrt_IM(Uint *n, int w, int m, ftnlen len, int base)
+#endif
+{ int ndigit,sign,spare,i,xsign;
+ longint x;
+ char *ans;
+ if(sizeof(integer)==len) x=n->il;
+ else if(len == sizeof(char)) x = n->ic;
+#ifdef Allow_TYQUAD
+ else if (len == sizeof(longint)) x = n->ili;
+#endif
+ else x=n->is;
+ ans=f__icvt(x,&ndigit,&sign, base);
+ if(sign || f__cplus) xsign=1;
+ else xsign=0;
+ if(ndigit+xsign>w || m+xsign>w)
+ { for(i=0;i<w;i++) (*f__putn)('*');
+ return(0);
+ }
+ if(x==0 && m==0)
+ { for(i=0;i<w;i++) (*f__putn)(' ');
+ return(0);
+ }
+ if(ndigit>=m)
+ spare=w-ndigit-xsign;
+ else
+ spare=w-m-xsign;
+ for(i=0;i<spare;i++) (*f__putn)(' ');
+ if(sign) (*f__putn)('-');
+ else if(f__cplus) (*f__putn)('+');
+ for(i=0;i<m-ndigit;i++) (*f__putn)('0');
+ for(i=0;i<ndigit;i++) (*f__putn)(*ans++);
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_AP(s) char *s;
+#else
+wrt_AP(char *s)
+#endif
+{ char quote;
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ quote = *s++;
+ for(;*s;s++)
+ { if(*s!=quote) (*f__putn)(*s);
+ else if(*++s==quote) (*f__putn)(*s);
+ else return(1);
+ }
+ return(1);
+}
+ static int
+#ifdef KR_headers
+wrt_H(a,s) char *s;
+#else
+wrt_H(int a, char *s)
+#endif
+{
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ while(a--) (*f__putn)(*s++);
+ return(1);
+}
+
+ int
+#ifdef KR_headers
+wrt_L(n,len, sz) Uint *n; ftnlen sz;
+#else
+wrt_L(Uint *n, int len, ftnlen sz)
+#endif
+{ int i;
+ long x;
+ if(sizeof(long)==sz) x=n->il;
+ else if(sz == sizeof(char)) x = n->ic;
+ else x=n->is;
+ for(i=0;i<len-1;i++)
+ (*f__putn)(' ');
+ if(x) (*f__putn)('T');
+ else (*f__putn)('F');
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_A(p,len) char *p; ftnlen len;
+#else
+wrt_A(char *p, ftnlen len)
+#endif
+{
+ while(len-- > 0) (*f__putn)(*p++);
+ return(0);
+}
+ static int
+#ifdef KR_headers
+wrt_AW(p,w,len) char * p; ftnlen len;
+#else
+wrt_AW(char * p, int w, ftnlen len)
+#endif
+{
+ while(w>len)
+ { w--;
+ (*f__putn)(' ');
+ }
+ while(w-- > 0)
+ (*f__putn)(*p++);
+ return(0);
+}
+
+ static int
+#ifdef KR_headers
+wrt_G(p,w,d,e,len) ufloat *p; ftnlen len;
+#else
+wrt_G(ufloat *p, int w, int d, int e, ftnlen len)
+#endif
+{ double up = 1,x;
+ int i=0,oldscale,n,j;
+ x = len==sizeof(real)?p->pf:p->pd;
+ if(x < 0 ) x = -x;
+ if(x<.1) {
+ if (x != 0.)
+ return(wrt_E(p,w,d,e,len));
+ i = 1;
+ goto have_i;
+ }
+ for(;i<=d;i++,up*=10)
+ { if(x>=up) continue;
+ have_i:
+ oldscale = f__scale;
+ f__scale = 0;
+ if(e==0) n=4;
+ else n=e+2;
+ i=wrt_F(p,w-n,d-i,len);
+ for(j=0;j<n;j++) (*f__putn)(' ');
+ f__scale=oldscale;
+ return(i);
+ }
+ return(wrt_E(p,w,d,e,len));
+}
+
+ int
+#ifdef KR_headers
+w_ed(p,ptr,len) struct syl *p; char *ptr; ftnlen len;
+#else
+w_ed(struct syl *p, char *ptr, ftnlen len)
+#endif
+{
+ int i;
+
+ if(f__cursor && (i = mv_cur()))
+ return i;
+ switch(p->op)
+ {
+ default:
+ fprintf(stderr,"w_ed, unexpected code: %d\n", p->op);
+ sig_die(f__fmtbuf, 1);
+ case I: return(wrt_I((Uint *)ptr,p->p1,len, 10));
+ case IM:
+ return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,10));
+
+ /* O and OM don't work right for character, double, complex, */
+ /* or doublecomplex, and they differ from Fortran 90 in */
+ /* showing a minus sign for negative values. */
+
+ case O: return(wrt_I((Uint *)ptr, p->p1, len, 8));
+ case OM:
+ return(wrt_IM((Uint *)ptr,p->p1,p->p2.i[0],len,8));
+ case L: return(wrt_L((Uint *)ptr,p->p1, len));
+ case A: return(wrt_A(ptr,len));
+ case AW:
+ return(wrt_AW(ptr,p->p1,len));
+ case D:
+ case E:
+ case EE:
+ return(wrt_E((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
+ case G:
+ case GE:
+ return(wrt_G((ufloat *)ptr,p->p1,p->p2.i[0],p->p2.i[1],len));
+ case F: return(wrt_F((ufloat *)ptr,p->p1,p->p2.i[0],len));
+
+ /* Z and ZM assume 8-bit bytes. */
+
+ case Z: return(wrt_Z((Uint *)ptr,p->p1,0,len));
+ case ZM:
+ return(wrt_Z((Uint *)ptr,p->p1,p->p2.i[0],len));
+ }
+}
+
+ int
+#ifdef KR_headers
+w_ned(p) struct syl *p;
+#else
+w_ned(struct syl *p)
+#endif
+{
+ switch(p->op)
+ {
+ default: fprintf(stderr,"w_ned, unexpected code: %d\n", p->op);
+ sig_die(f__fmtbuf, 1);
+ case SLASH:
+ return((*f__donewrec)());
+ case T: f__cursor = p->p1-f__recpos - 1;
+ return(1);
+ case TL: f__cursor -= p->p1;
+ if(f__cursor < -f__recpos) /* TL1000, 1X */
+ f__cursor = -f__recpos;
+ return(1);
+ case TR:
+ case X:
+ f__cursor += p->p1;
+ return(1);
+ case APOS:
+ return(wrt_AP(p->p2.s));
+ case H:
+ return(wrt_H(p->p1,p->p2.s));
+ }
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/F2CLIBS/libf2c/wsfe.c b/src/lib/yac/clapack/F2CLIBS/libf2c/wsfe.c
new file mode 100644
index 000000000..7f09cb720
--- /dev/null
+++ b/src/lib/yac/clapack/F2CLIBS/libf2c/wsfe.c
@@ -0,0 +1,83 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/*write sequential formatted external*/
+#include "f2c.h"
+#include "fio.h"
+#include "fmt.h"
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+ int
+x_wSL(Void)
+{
+ int n = f__putbuf('\n');
+ f__hiwater = f__recpos = f__cursor = 0;
+ return(n == 0);
+}
+
+ static int
+xw_end(Void)
+{
+ int n;
+
+ if(f__nonl) {
+ f__putbuf(n = 0);
+ fflush(f__cf);
+ }
+ else
+ n = f__putbuf('\n');
+ f__hiwater = f__recpos = f__cursor = 0;
+ return n;
+}
+
+ static int
+xw_rev(Void)
+{
+ int n = 0;
+ if(f__workdone) {
+ n = f__putbuf('\n');
+ f__workdone = 0;
+ }
+ f__hiwater = f__recpos = f__cursor = 0;
+ return n;
+}
+
+#ifdef KR_headers
+integer s_wsfe(a) cilist *a; /*start*/
+#else
+integer s_wsfe(cilist *a) /*start*/
+#endif
+{ int n;
+ if(!f__init) f_init();
+ f__reading=0;
+ f__sequential=1;
+ f__formatted=1;
+ f__external=1;
+ if(n=c_sfe(a)) return(n);
+ f__elist=a;
+ f__hiwater = f__cursor=f__recpos=0;
+ f__nonl = 0;
+ f__scale=0;
+ f__fmtbuf=a->cifmt;
+ f__cf=f__curunit->ufd;
+ if(pars_f(f__fmtbuf)<0) err(a->cierr,100,"startio");
+ f__putn= x_putc;
+ f__doed= w_ed;
+ f__doned= w_ned;
+ f__doend=xw_end;
+ f__dorevert=xw_rev;
+ f__donewrec=x_wSL;
+ fmt_bg();
+ f__cplus=0;
+ f__cblank=f__curunit->ublnk;
+ if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
+ err(a->cierr,errno,"write start");
+ return(0);
+}
+#ifdef __cplusplus
+}
+#endif
+
diff --git a/src/lib/yac/clapack/INCLUDE/blaswrap.h b/src/lib/yac/clapack/INCLUDE/blaswrap.h
new file mode 100644
index 000000000..656671c71
--- /dev/null
+++ b/src/lib/yac/clapack/INCLUDE/blaswrap.h
@@ -0,0 +1,165 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* CLAPACK 3.0 BLAS wrapper macros
+ * Feb 5, 2000
+ */
+
+#ifndef __BLASWRAP_H
+#define __BLASWRAP_H
+
+#ifndef NO_BLAS_WRAP
+
+/* BLAS1 routines */
+#define srotg_ f2c_srotg
+#define crotg_ f2c_crotg
+#define drotg_ f2c_drotg
+#define zrotg_ f2c_zrotg
+#define srotmg_ f2c_srotmg
+#define drotmg_ f2c_drotmg
+#define srot_ f2c_srot
+#define drot_ f2c_drot
+#define srotm_ f2c_srotm
+#define drotm_ f2c_drotm
+#define sswap_ f2c_sswap
+#define dswap_ f2c_dswap
+#define cswap_ f2c_cswap
+#define zswap_ f2c_zswap
+#define sscal_ f2c_sscal
+#define dscal_ f2c_dscal
+#define cscal_ f2c_cscal
+#define zscal_ f2c_zscal
+#define csscal_ f2c_csscal
+#define zdscal_ f2c_zdscal
+#define scopy_ f2c_scopy
+#define dcopy_ f2c_dcopy
+#define ccopy_ f2c_ccopy
+#define zcopy_ f2c_zcopy
+#define saxpy_ f2c_saxpy
+#define daxpy_ f2c_daxpy
+#define caxpy_ f2c_caxpy
+#define zaxpy_ f2c_zaxpy
+#define sdot_ f2c_sdot
+#define ddot_ f2c_ddot
+#define cdotu_ f2c_cdotu
+#define zdotu_ f2c_zdotu
+#define cdotc_ f2c_cdotc
+#define zdotc_ f2c_zdotc
+#define snrm2_ f2c_snrm2
+#define dnrm2_ f2c_dnrm2
+#define scnrm2_ f2c_scnrm2
+#define dznrm2_ f2c_dznrm2
+#define sasum_ f2c_sasum
+#define dasum_ f2c_dasum
+#define scasum_ f2c_scasum
+#define dzasum_ f2c_dzasum
+#define isamax_ f2c_isamax
+#define idamax_ f2c_idamax
+#define icamax_ f2c_icamax
+#define izamax_ f2c_izamax
+
+/* BLAS2 routines */
+#define sgemv_ f2c_sgemv
+#define dgemv_ f2c_dgemv
+#define cgemv_ f2c_cgemv
+#define zgemv_ f2c_zgemv
+#define sgbmv_ f2c_sgbmv
+#define dgbmv_ f2c_dgbmv
+#define cgbmv_ f2c_cgbmv
+#define zgbmv_ f2c_zgbmv
+#define chemv_ f2c_chemv
+#define zhemv_ f2c_zhemv
+#define chbmv_ f2c_chbmv
+#define zhbmv_ f2c_zhbmv
+#define chpmv_ f2c_chpmv
+#define zhpmv_ f2c_zhpmv
+#define ssymv_ f2c_ssymv
+#define dsymv_ f2c_dsymv
+#define ssbmv_ f2c_ssbmv
+#define dsbmv_ f2c_dsbmv
+#define sspmv_ f2c_sspmv
+#define dspmv_ f2c_dspmv
+#define strmv_ f2c_strmv
+#define dtrmv_ f2c_dtrmv
+#define ctrmv_ f2c_ctrmv
+#define ztrmv_ f2c_ztrmv
+#define stbmv_ f2c_stbmv
+#define dtbmv_ f2c_dtbmv
+#define ctbmv_ f2c_ctbmv
+#define ztbmv_ f2c_ztbmv
+#define stpmv_ f2c_stpmv
+#define dtpmv_ f2c_dtpmv
+#define ctpmv_ f2c_ctpmv
+#define ztpmv_ f2c_ztpmv
+#define strsv_ f2c_strsv
+#define dtrsv_ f2c_dtrsv
+#define ctrsv_ f2c_ctrsv
+#define ztrsv_ f2c_ztrsv
+#define stbsv_ f2c_stbsv
+#define dtbsv_ f2c_dtbsv
+#define ctbsv_ f2c_ctbsv
+#define ztbsv_ f2c_ztbsv
+#define stpsv_ f2c_stpsv
+#define dtpsv_ f2c_dtpsv
+#define ctpsv_ f2c_ctpsv
+#define ztpsv_ f2c_ztpsv
+#define sger_ f2c_sger
+#define dger_ f2c_dger
+#define cgeru_ f2c_cgeru
+#define zgeru_ f2c_zgeru
+#define cgerc_ f2c_cgerc
+#define zgerc_ f2c_zgerc
+#define cher_ f2c_cher
+#define zher_ f2c_zher
+#define chpr_ f2c_chpr
+#define zhpr_ f2c_zhpr
+#define cher2_ f2c_cher2
+#define zher2_ f2c_zher2
+#define chpr2_ f2c_chpr2
+#define zhpr2_ f2c_zhpr2
+#define ssyr_ f2c_ssyr
+#define dsyr_ f2c_dsyr
+#define sspr_ f2c_sspr
+#define dspr_ f2c_dspr
+#define ssyr2_ f2c_ssyr2
+#define dsyr2_ f2c_dsyr2
+#define sspr2_ f2c_sspr2
+#define dspr2_ f2c_dspr2
+
+/* BLAS3 routines */
+#define sgemm_ f2c_sgemm
+#define dgemm_ f2c_dgemm
+#define cgemm_ f2c_cgemm
+#define zgemm_ f2c_zgemm
+#define ssymm_ f2c_ssymm
+#define dsymm_ f2c_dsymm
+#define csymm_ f2c_csymm
+#define zsymm_ f2c_zsymm
+#define chemm_ f2c_chemm
+#define zhemm_ f2c_zhemm
+#define ssyrk_ f2c_ssyrk
+#define dsyrk_ f2c_dsyrk
+#define csyrk_ f2c_csyrk
+#define zsyrk_ f2c_zsyrk
+#define cherk_ f2c_cherk
+#define zherk_ f2c_zherk
+#define ssyr2k_ f2c_ssyr2k
+#define dsyr2k_ f2c_dsyr2k
+#define csyr2k_ f2c_csyr2k
+#define zsyr2k_ f2c_zsyr2k
+#define cher2k_ f2c_cher2k
+#define zher2k_ f2c_zher2k
+#define strmm_ f2c_strmm
+#define dtrmm_ f2c_dtrmm
+#define ctrmm_ f2c_ctrmm
+#define ztrmm_ f2c_ztrmm
+#define strsm_ f2c_strsm
+#define dtrsm_ f2c_dtrsm
+#define ctrsm_ f2c_ctrsm
+#define ztrsm_ f2c_ztrsm
+
+#endif /* NO_BLAS_WRAP */
+
+#endif /* __BLASWRAP_H */
+
diff --git a/src/lib/yac/clapack/INCLUDE/clapack.h b/src/lib/yac/clapack/INCLUDE/clapack.h
new file mode 100644
index 000000000..6a05ec5a6
--- /dev/null
+++ b/src/lib/yac/clapack/INCLUDE/clapack.h
@@ -0,0 +1,7267 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* header file for clapack 3.2.1 */
+
+#ifndef __CLAPACK_H
+#define __CLAPACK_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* Subroutine */ int caxpy_(integer *n, complex *ca, complex *cx, integer *
+ incx, complex *cy, integer *incy);
+
+/* Subroutine */ int ccopy_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy);
+
+/* Complex */ VOID cdotc_(complex * ret_val, integer *n, complex *cx, integer
+ *incx, complex *cy, integer *incy);
+
+/* Complex */ VOID cdotu_(complex * ret_val, integer *n, complex *cx, integer
+ *incx, complex *cy, integer *incy);
+
+/* Subroutine */ int cgbmv_(char *trans, integer *m, integer *n, integer *kl,
+ integer *ku, complex *alpha, complex *a, integer *lda, complex *x,
+ integer *incx, complex *beta, complex *y, integer *incy);
+
+/* Subroutine */ int cgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, complex *alpha, complex *a, integer *lda, complex *b,
+ integer *ldb, complex *beta, complex *c__, integer *ldc);
+
+/* Subroutine */ int cgemv_(char *trans, integer *m, integer *n, complex *
+ alpha, complex *a, integer *lda, complex *x, integer *incx, complex *
+ beta, complex *y, integer *incy);
+
+/* Subroutine */ int cgerc_(integer *m, integer *n, complex *alpha, complex *
+ x, integer *incx, complex *y, integer *incy, complex *a, integer *lda);
+
+/* Subroutine */ int cgeru_(integer *m, integer *n, complex *alpha, complex *
+ x, integer *incx, complex *y, integer *incy, complex *a, integer *lda);
+
+/* Subroutine */ int chbmv_(char *uplo, integer *n, integer *k, complex *
+ alpha, complex *a, integer *lda, complex *x, integer *incx, complex *
+ beta, complex *y, integer *incy);
+
+/* Subroutine */ int chemm_(char *side, char *uplo, integer *m, integer *n,
+ complex *alpha, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *beta, complex *c__, integer *ldc);
+
+/* Subroutine */ int chemv_(char *uplo, integer *n, complex *alpha, complex *
+ a, integer *lda, complex *x, integer *incx, complex *beta, complex *y,
+ integer *incy);
+
+/* Subroutine */ int cher_(char *uplo, integer *n, real *alpha, complex *x,
+ integer *incx, complex *a, integer *lda);
+
+/* Subroutine */ int cher2_(char *uplo, integer *n, complex *alpha, complex *
+ x, integer *incx, complex *y, integer *incy, complex *a, integer *lda);
+
+/* Subroutine */ int cher2k_(char *uplo, char *trans, integer *n, integer *k,
+ complex *alpha, complex *a, integer *lda, complex *b, integer *ldb,
+ real *beta, complex *c__, integer *ldc);
+
+/* Subroutine */ int cherk_(char *uplo, char *trans, integer *n, integer *k,
+ real *alpha, complex *a, integer *lda, real *beta, complex *c__,
+ integer *ldc);
+
+/* Subroutine */ int chpmv_(char *uplo, integer *n, complex *alpha, complex *
+ ap, complex *x, integer *incx, complex *beta, complex *y, integer *
+ incy);
+
+/* Subroutine */ int chpr_(char *uplo, integer *n, real *alpha, complex *x,
+ integer *incx, complex *ap);
+
+/* Subroutine */ int chpr2_(char *uplo, integer *n, complex *alpha, complex *
+ x, integer *incx, complex *y, integer *incy, complex *ap);
+
+/* Subroutine */ int crotg_(complex *ca, complex *cb, real *c__, complex *s);
+
+/* Subroutine */ int cscal_(integer *n, complex *ca, complex *cx, integer *
+ incx);
+
+/* Subroutine */ int csrot_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, real *c__, real *s);
+
+/* Subroutine */ int csscal_(integer *n, real *sa, complex *cx, integer *incx);
+
+/* Subroutine */ int cswap_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy);
+
+/* Subroutine */ int csymm_(char *side, char *uplo, integer *m, integer *n,
+ complex *alpha, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *beta, complex *c__, integer *ldc);
+
+/* Subroutine */ int csyr2k_(char *uplo, char *trans, integer *n, integer *k,
+ complex *alpha, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *beta, complex *c__, integer *ldc);
+
+/* Subroutine */ int csyrk_(char *uplo, char *trans, integer *n, integer *k,
+ complex *alpha, complex *a, integer *lda, complex *beta, complex *c__,
+ integer *ldc);
+
+/* Subroutine */ int ctbmv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, complex *a, integer *lda, complex *x, integer *incx);
+
+/* Subroutine */ int ctbsv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, complex *a, integer *lda, complex *x, integer *incx);
+
+/* Subroutine */ int ctpmv_(char *uplo, char *trans, char *diag, integer *n,
+ complex *ap, complex *x, integer *incx);
+
+/* Subroutine */ int ctpsv_(char *uplo, char *trans, char *diag, integer *n,
+ complex *ap, complex *x, integer *incx);
+
+/* Subroutine */ int ctrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, complex *alpha, complex *a, integer *lda,
+ complex *b, integer *ldb);
+
+/* Subroutine */ int ctrmv_(char *uplo, char *trans, char *diag, integer *n,
+ complex *a, integer *lda, complex *x, integer *incx);
+
+/* Subroutine */ int ctrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, complex *alpha, complex *a, integer *lda,
+ complex *b, integer *ldb);
+
+/* Subroutine */ int ctrsv_(char *uplo, char *trans, char *diag, integer *n,
+ complex *a, integer *lda, complex *x, integer *incx);
+
+doublereal dasum_(integer *n, doublereal *dx, integer *incx);
+
+/* Subroutine */ int daxpy_(integer *n, doublereal *da, doublereal *dx,
+ integer *incx, doublereal *dy, integer *incy);
+
+doublereal dcabs1_(doublecomplex *z__);
+
+/* Subroutine */ int dcopy_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy);
+
+doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
+ integer *incy);
+
+/* Subroutine */ int dgbmv_(char *trans, integer *m, integer *n, integer *kl,
+ integer *ku, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *x, integer *incx, doublereal *beta, doublereal *y,
+ integer *incy);
+
+/* Subroutine */ int dgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, doublereal *beta, doublereal *c__,
+ integer *ldc);
+
+/* Subroutine */ int dgemv_(char *trans, integer *m, integer *n, doublereal *
+ alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy);
+
+/* Subroutine */ int dger_(integer *m, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *a, integer *lda);
+
+doublereal dnrm2_(integer *n, doublereal *x, integer *incx);
+
+/* Subroutine */ int drot_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy, doublereal *c__, doublereal *s);
+
+/* Subroutine */ int drotg_(doublereal *da, doublereal *db, doublereal *c__,
+ doublereal *s);
+
+/* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy, doublereal *dparam);
+
+/* Subroutine */ int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *
+ dx1, doublereal *dy1, doublereal *dparam);
+
+/* Subroutine */ int dsbmv_(char *uplo, integer *n, integer *k, doublereal *
+ alpha, doublereal *a, integer *lda, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy);
+
+/* Subroutine */ int dscal_(integer *n, doublereal *da, doublereal *dx,
+ integer *incx);
+
+doublereal dsdot_(integer *n, real *sx, integer *incx, real *sy, integer *
+ incy);
+
+/* Subroutine */ int dspmv_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *ap, doublereal *x, integer *incx, doublereal *beta,
+ doublereal *y, integer *incy);
+
+/* Subroutine */ int dspr_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *ap);
+
+/* Subroutine */ int dspr2_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *ap);
+
+/* Subroutine */ int dswap_(integer *n, doublereal *dx, integer *incx,
+ doublereal *dy, integer *incy);
+
+/* Subroutine */ int dsymm_(char *side, char *uplo, integer *m, integer *n,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *beta, doublereal *c__, integer *ldc);
+
+/* Subroutine */ int dsymv_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *a, integer *lda, doublereal *x, integer *incx, doublereal
+ *beta, doublereal *y, integer *incy);
+
+/* Subroutine */ int dsyr_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *a, integer *lda);
+
+/* Subroutine */ int dsyr2_(char *uplo, integer *n, doublereal *alpha,
+ doublereal *x, integer *incx, doublereal *y, integer *incy,
+ doublereal *a, integer *lda);
+
+/* Subroutine */ int dsyr2k_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *beta, doublereal *c__, integer *ldc);
+
+/* Subroutine */ int dsyrk_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *beta,
+ doublereal *c__, integer *ldc);
+
+/* Subroutine */ int dtbmv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx);
+
+/* Subroutine */ int dtbsv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *x, integer *incx);
+
+/* Subroutine */ int dtpmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *ap, doublereal *x, integer *incx);
+
+/* Subroutine */ int dtpsv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *ap, doublereal *x, integer *incx);
+
+/* Subroutine */ int dtrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dtrmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *x, integer *incx);
+
+/* Subroutine */ int dtrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublereal *alpha, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dtrsv_(char *uplo, char *trans, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *x, integer *incx);
+
+doublereal dzasum_(integer *n, doublecomplex *zx, integer *incx);
+
+doublereal dznrm2_(integer *n, doublecomplex *x, integer *incx);
+
+integer icamax_(integer *n, complex *cx, integer *incx);
+
+integer idamax_(integer *n, doublereal *dx, integer *incx);
+
+integer isamax_(integer *n, real *sx, integer *incx);
+
+integer izamax_(integer *n, doublecomplex *zx, integer *incx);
+
+logical lsame_(char *ca, char *cb);
+
+doublereal sasum_(integer *n, real *sx, integer *incx);
+
+/* Subroutine */ int saxpy_(integer *n, real *sa, real *sx, integer *incx,
+ real *sy, integer *incy);
+
+doublereal scabs1_(complex *z__);
+
+doublereal scasum_(integer *n, complex *cx, integer *incx);
+
+doublereal scnrm2_(integer *n, complex *x, integer *incx);
+
+/* Subroutine */ int scopy_(integer *n, real *sx, integer *incx, real *sy,
+ integer *incy);
+
+doublereal sdot_(integer *n, real *sx, integer *incx, real *sy, integer *incy);
+
+doublereal sdsdot_(integer *n, real *sb, real *sx, integer *incx, real *sy,
+ integer *incy);
+
+/* Subroutine */ int sgbmv_(char *trans, integer *m, integer *n, integer *kl,
+ integer *ku, real *alpha, real *a, integer *lda, real *x, integer *
+ incx, real *beta, real *y, integer *incy);
+
+/* Subroutine */ int sgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, real *alpha, real *a, integer *lda, real *b, integer *
+ ldb, real *beta, real *c__, integer *ldc);
+
+/* Subroutine */ int sgemv_(char *trans, integer *m, integer *n, real *alpha,
+ real *a, integer *lda, real *x, integer *incx, real *beta, real *y,
+ integer *incy);
+
+/* Subroutine */ int sger_(integer *m, integer *n, real *alpha, real *x,
+ integer *incx, real *y, integer *incy, real *a, integer *lda);
+
+doublereal snrm2_(integer *n, real *x, integer *incx);
+
+/* Subroutine */ int srot_(integer *n, real *sx, integer *incx, real *sy,
+ integer *incy, real *c__, real *s);
+
+/* Subroutine */ int srotg_(real *sa, real *sb, real *c__, real *s);
+
+/* Subroutine */ int srotm_(integer *n, real *sx, integer *incx, real *sy,
+ integer *incy, real *sparam);
+
+/* Subroutine */ int srotmg_(real *sd1, real *sd2, real *sx1, real *sy1, real
+ *sparam);
+
+/* Subroutine */ int ssbmv_(char *uplo, integer *n, integer *k, real *alpha,
+ real *a, integer *lda, real *x, integer *incx, real *beta, real *y,
+ integer *incy);
+
+/* Subroutine */ int sscal_(integer *n, real *sa, real *sx, integer *incx);
+
+/* Subroutine */ int sspmv_(char *uplo, integer *n, real *alpha, real *ap,
+ real *x, integer *incx, real *beta, real *y, integer *incy);
+
+/* Subroutine */ int sspr_(char *uplo, integer *n, real *alpha, real *x,
+ integer *incx, real *ap);
+
+/* Subroutine */ int sspr2_(char *uplo, integer *n, real *alpha, real *x,
+ integer *incx, real *y, integer *incy, real *ap);
+
+/* Subroutine */ int sswap_(integer *n, real *sx, integer *incx, real *sy,
+ integer *incy);
+
+/* Subroutine */ int ssymm_(char *side, char *uplo, integer *m, integer *n,
+ real *alpha, real *a, integer *lda, real *b, integer *ldb, real *beta,
+ real *c__, integer *ldc);
+
+/* Subroutine */ int ssymv_(char *uplo, integer *n, real *alpha, real *a,
+ integer *lda, real *x, integer *incx, real *beta, real *y, integer *
+ incy);
+
+/* Subroutine */ int ssyr_(char *uplo, integer *n, real *alpha, real *x,
+ integer *incx, real *a, integer *lda);
+
+/* Subroutine */ int ssyr2_(char *uplo, integer *n, real *alpha, real *x,
+ integer *incx, real *y, integer *incy, real *a, integer *lda);
+
+/* Subroutine */ int ssyr2k_(char *uplo, char *trans, integer *n, integer *k,
+ real *alpha, real *a, integer *lda, real *b, integer *ldb, real *beta,
+ real *c__, integer *ldc);
+
+/* Subroutine */ int ssyrk_(char *uplo, char *trans, integer *n, integer *k,
+ real *alpha, real *a, integer *lda, real *beta, real *c__, integer *
+ ldc);
+
+/* Subroutine */ int stbmv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, real *a, integer *lda, real *x, integer *incx);
+
+/* Subroutine */ int stbsv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, real *a, integer *lda, real *x, integer *incx);
+
+/* Subroutine */ int stpmv_(char *uplo, char *trans, char *diag, integer *n,
+ real *ap, real *x, integer *incx);
+
+/* Subroutine */ int stpsv_(char *uplo, char *trans, char *diag, integer *n,
+ real *ap, real *x, integer *incx);
+
+/* Subroutine */ int strmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, real *alpha, real *a, integer *lda, real *b,
+ integer *ldb);
+
+/* Subroutine */ int strmv_(char *uplo, char *trans, char *diag, integer *n,
+ real *a, integer *lda, real *x, integer *incx);
+
+/* Subroutine */ int strsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, real *alpha, real *a, integer *lda, real *b,
+ integer *ldb);
+
+/* Subroutine */ int strsv_(char *uplo, char *trans, char *diag, integer *n,
+ real *a, integer *lda, real *x, integer *incx);
+
+/* Subroutine */ int xerbla_(char *srname, integer *info);
+
+/* Subroutine */ int xerbla_array__(char *srname_array__, integer *
+ srname_len__, integer *info, ftnlen srname_array_len);
+
+/* Subroutine */ int zaxpy_(integer *n, doublecomplex *za, doublecomplex *zx,
+ integer *incx, doublecomplex *zy, integer *incy);
+
+/* Subroutine */ int zcopy_(integer *n, doublecomplex *zx, integer *incx,
+ doublecomplex *zy, integer *incy);
+
+/* Double Complex */ VOID zdotc_(doublecomplex * ret_val, integer *n,
+ doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy);
+
+/* Double Complex */ VOID zdotu_(doublecomplex * ret_val, integer *n,
+ doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy);
+
+/* Subroutine */ int zdrot_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s);
+
+/* Subroutine */ int zdscal_(integer *n, doublereal *da, doublecomplex *zx,
+ integer *incx);
+
+/* Subroutine */ int zgbmv_(char *trans, integer *m, integer *n, integer *kl,
+ integer *ku, doublecomplex *alpha, doublecomplex *a, integer *lda,
+ doublecomplex *x, integer *incx, doublecomplex *beta, doublecomplex *
+ y, integer *incy);
+
+/* Subroutine */ int zgemm_(char *transa, char *transb, integer *m, integer *
+ n, integer *k, doublecomplex *alpha, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, doublecomplex *beta, doublecomplex *
+ c__, integer *ldc);
+
+/* Subroutine */ int zgemv_(char *trans, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ x, integer *incx, doublecomplex *beta, doublecomplex *y, integer *
+ incy);
+
+/* Subroutine */ int zgerc_(integer *m, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zgeru_(integer *m, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zhbmv_(char *uplo, integer *n, integer *k, doublecomplex
+ *alpha, doublecomplex *a, integer *lda, doublecomplex *x, integer *
+ incx, doublecomplex *beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zhemm_(char *side, char *uplo, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ b, integer *ldb, doublecomplex *beta, doublecomplex *c__, integer *
+ ldc);
+
+/* Subroutine */ int zhemv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublecomplex *beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zher_(char *uplo, integer *n, doublereal *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zher2_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zher2k_(char *uplo, char *trans, integer *n, integer *k,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ b, integer *ldb, doublereal *beta, doublecomplex *c__, integer *ldc);
+
+/* Subroutine */ int zherk_(char *uplo, char *trans, integer *n, integer *k,
+ doublereal *alpha, doublecomplex *a, integer *lda, doublereal *beta,
+ doublecomplex *c__, integer *ldc);
+
+/* Subroutine */ int zhpmv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *
+ beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zhpr_(char *uplo, integer *n, doublereal *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *ap);
+
+/* Subroutine */ int zhpr2_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *y, integer *incy,
+ doublecomplex *ap);
+
+/* Subroutine */ int zrotg_(doublecomplex *ca, doublecomplex *cb, doublereal *
+ c__, doublecomplex *s);
+
+/* Subroutine */ int zscal_(integer *n, doublecomplex *za, doublecomplex *zx,
+ integer *incx);
+
+/* Subroutine */ int zswap_(integer *n, doublecomplex *zx, integer *incx,
+ doublecomplex *zy, integer *incy);
+
+/* Subroutine */ int zsymm_(char *side, char *uplo, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ b, integer *ldb, doublecomplex *beta, doublecomplex *c__, integer *
+ ldc);
+
+/* Subroutine */ int zsyr2k_(char *uplo, char *trans, integer *n, integer *k,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ b, integer *ldb, doublecomplex *beta, doublecomplex *c__, integer *
+ ldc);
+
+/* Subroutine */ int zsyrk_(char *uplo, char *trans, integer *n, integer *k,
+ doublecomplex *alpha, doublecomplex *a, integer *lda, doublecomplex *
+ beta, doublecomplex *c__, integer *ldc);
+
+/* Subroutine */ int ztbmv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer
+ *incx);
+
+/* Subroutine */ int ztbsv_(char *uplo, char *trans, char *diag, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *x, integer
+ *incx);
+
+/* Subroutine */ int ztpmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *ap, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int ztpsv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *ap, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int ztrmm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int ztrmv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int ztrsm_(char *side, char *uplo, char *transa, char *diag,
+ integer *m, integer *n, doublecomplex *alpha, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int ztrsv_(char *uplo, char *trans, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int cbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, real *d__, real *e, complex *vt, integer *ldvt,
+ complex *u, integer *ldu, complex *c__, integer *ldc, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, complex *ab, integer *ldab, real *d__,
+ real *e, complex *q, integer *ldq, complex *pt, integer *ldpt,
+ complex *c__, integer *ldc, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, real *anorm, real *rcond,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real
+ *colcnd, real *amax, integer *info);
+
+/* Subroutine */ int cgbequb_(integer *m, integer *n, integer *kl, integer *
+ ku, complex *ab, integer *ldab, real *r__, real *c__, real *rowcnd,
+ real *colcnd, real *amax, integer *info);
+
+/* Subroutine */ int cgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, complex *ab, integer *ldab, complex *afb, integer *
+ ldafb, integer *ipiv, complex *b, integer *ldb, complex *x, integer *
+ ldx, real *ferr, real *berr, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgbrfsx_(char *trans, char *equed, integer *n, integer *
+ kl, integer *ku, integer *nrhs, complex *ab, integer *ldab, complex *
+ afb, integer *ldafb, integer *ipiv, real *r__, real *c__, complex *b,
+ integer *ldb, complex *x, integer *ldx, real *rcond, real *berr,
+ integer *n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__,
+ integer *nparams, real *params, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, complex *ab, integer *ldab, integer *ipiv, complex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int cgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, complex *ab, integer *ldab, complex *afb,
+ integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *rcond, real
+ *ferr, real *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbsvxx_(char *fact, char *trans, integer *n, integer *
+ kl, integer *ku, integer *nrhs, complex *ab, integer *ldab, complex *
+ afb, integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *rcond,
+ real *rpvgrw, real *berr, integer *n_err_bnds__, real *
+ err_bnds_norm__, real *err_bnds_comp__, integer *nparams, real *
+ params, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, complex *ab, integer *ldab, integer *ipiv, complex
+ *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *scale, integer *m, complex *v, integer *ldv,
+ integer *info);
+
+/* Subroutine */ int cgebal_(char *job, integer *n, complex *a, integer *lda,
+ integer *ilo, integer *ihi, real *scale, integer *info);
+
+/* Subroutine */ int cgebd2_(integer *m, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tauq, complex *taup, complex *work,
+ integer *info);
+
+/* Subroutine */ int cgebrd_(integer *m, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tauq, complex *taup, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int cgecon_(char *norm, integer *n, complex *a, integer *lda,
+ real *anorm, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgeequ_(integer *m, integer *n, complex *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax,
+ integer *info);
+
+/* Subroutine */ int cgeequb_(integer *m, integer *n, complex *a, integer *
+ lda, real *r__, real *c__, real *rowcnd, real *colcnd, real *amax,
+ integer *info);
+
+/* Subroutine */ int cgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ complex *a, integer *lda, integer *sdim, complex *w, complex *vs,
+ integer *ldvs, complex *work, integer *lwork, real *rwork, logical *
+ bwork, integer *info);
+
+/* Subroutine */ int cgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, complex *a, integer *lda, integer *sdim, complex *
+ w, complex *vs, integer *ldvs, real *rconde, real *rcondv, complex *
+ work, integer *lwork, real *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cgeev_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *w, complex *vl, integer *ldvl, complex *vr,
+ integer *ldvr, complex *work, integer *lwork, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, complex *a, integer *lda, complex *w, complex *vl,
+ integer *ldvl, complex *vr, integer *ldvr, integer *ilo, integer *ihi,
+ real *scale, real *abnrm, real *rconde, real *rcondv, complex *work,
+ integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgegs_(char *jobvsl, char *jobvsr, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, complex *alpha, complex *
+ beta, complex *vsl, integer *ldvsl, complex *vsr, integer *ldvsr,
+ complex *work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgegv_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, complex *
+ work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cgehd2_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgehrd_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int cgelq2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgelqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *b, integer *ldb, complex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgelsd_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, real *s, real *rcond,
+ integer *rank, complex *work, integer *lwork, real *rwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int cgelss_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, real *s, real *rcond,
+ integer *rank, complex *work, integer *lwork, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgelsx_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgelsy_(integer *m, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, complex *work, integer *lwork, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeql2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgeqlf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgeqp3_(integer *m, integer *n, complex *a, integer *lda,
+ integer *jpvt, complex *tau, complex *work, integer *lwork, real *
+ rwork, integer *info);
+
+/* Subroutine */ int cgeqpf_(integer *m, integer *n, complex *a, integer *lda,
+ integer *jpvt, complex *tau, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgeqr2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgeqrf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgerfs_(char *trans, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgerfsx_(char *trans, char *equed, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, real *r__, real *c__, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *rcond, real *berr, integer *n_err_bnds__, real *
+ err_bnds_norm__, real *err_bnds_comp__, integer *nparams, real *
+ params, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgerq2_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cgerqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgesc2_(integer *n, complex *a, integer *lda, complex *
+ rhs, integer *ipiv, integer *jpiv, real *scale);
+
+/* Subroutine */ int cgesdd_(char *jobz, integer *m, integer *n, complex *a,
+ integer *lda, real *s, complex *u, integer *ldu, complex *vt, integer
+ *ldvt, complex *work, integer *lwork, real *rwork, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int cgesv_(integer *n, integer *nrhs, complex *a, integer *
+ lda, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ complex *a, integer *lda, real *s, complex *u, integer *ldu, complex *
+ vt, integer *ldvt, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, char *equed, real *r__, real *c__, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgesvxx_(char *fact, char *trans, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, char *equed, real *r__, real *c__, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *rcond, real *rpvgrw, real *berr,
+ integer *n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__,
+ integer *nparams, real *params, complex *work, real *rwork, integer *
+ info);
+
+/* Subroutine */ int cgetc2_(integer *n, complex *a, integer *lda, integer *
+ ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int cgetf2_(integer *m, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int cgetrf_(integer *m, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int cgetri_(integer *n, complex *a, integer *lda, integer *
+ ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgetrs_(char *trans, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *lscale, real *rscale, integer *m, complex *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int cggbal_(char *job, integer *n, complex *a, integer *lda,
+ complex *b, integer *ldb, integer *ilo, integer *ihi, real *lscale,
+ real *rscale, real *work, integer *info);
+
+/* Subroutine */ int cgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, complex *a, integer *lda, complex *b, integer *
+ ldb, integer *sdim, complex *alpha, complex *beta, complex *vsl,
+ integer *ldvsl, complex *vsr, integer *ldvsr, complex *work, integer *
+ lwork, real *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, complex *a, integer *lda, complex *b,
+ integer *ldb, integer *sdim, complex *alpha, complex *beta, complex *
+ vsl, integer *ldvsl, complex *vsr, integer *ldvsr, real *rconde, real
+ *rcondv, complex *work, integer *lwork, real *rwork, integer *iwork,
+ integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int cggev_(char *jobvl, char *jobvr, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *alpha, complex *beta,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, complex *
+ work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int cggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *alpha, complex *beta, complex *vl, integer *ldvl, complex *
+ vr, integer *ldvr, integer *ilo, integer *ihi, real *lscale, real *
+ rscale, real *abnrm, real *bbnrm, real *rconde, real *rcondv, complex
+ *work, integer *lwork, real *rwork, integer *iwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int cggglm_(integer *n, integer *m, integer *p, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *d__, complex *x,
+ complex *y, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *q, integer *ldq, complex *z__, integer *ldz, integer *info);
+
+/* Subroutine */ int cgglse_(integer *m, integer *n, integer *p, complex *a,
+ integer *lda, complex *b, integer *ldb, complex *c__, complex *d__,
+ complex *x, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggqrf_(integer *n, integer *m, integer *p, complex *a,
+ integer *lda, complex *taua, complex *b, integer *ldb, complex *taub,
+ complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggrqf_(integer *m, integer *p, integer *n, complex *a,
+ integer *lda, complex *taua, complex *b, integer *ldb, complex *taub,
+ complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, complex *a, integer *
+ lda, complex *b, integer *ldb, real *alpha, real *beta, complex *u,
+ integer *ldu, complex *v, integer *ldv, complex *q, integer *ldq,
+ complex *work, real *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int cggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, complex *a, integer *lda, complex *b, integer
+ *ldb, real *tola, real *tolb, integer *k, integer *l, complex *u,
+ integer *ldu, complex *v, integer *ldv, complex *q, integer *ldq,
+ integer *iwork, real *rwork, complex *tau, complex *work, integer *
+ info);
+
+/* Subroutine */ int cgtcon_(char *norm, integer *n, complex *dl, complex *
+ d__, complex *du, complex *du2, integer *ipiv, real *anorm, real *
+ rcond, complex *work, integer *info);
+
+/* Subroutine */ int cgtrfs_(char *trans, integer *n, integer *nrhs, complex *
+ dl, complex *d__, complex *du, complex *dlf, complex *df, complex *
+ duf, complex *du2, integer *ipiv, complex *b, integer *ldb, complex *
+ x, integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cgtsv_(integer *n, integer *nrhs, complex *dl, complex *
+ d__, complex *du, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, complex *dl, complex *d__, complex *du, complex *dlf, complex *
+ df, complex *duf, complex *du2, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cgttrf_(integer *n, complex *dl, complex *d__, complex *
+ du, complex *du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int cgttrs_(char *trans, integer *n, integer *nrhs, complex *
+ dl, complex *d__, complex *du, complex *du2, integer *ipiv, complex *
+ b, integer *ldb, integer *info);
+
+/* Subroutine */ int cgtts2_(integer *itrans, integer *n, integer *nrhs,
+ complex *dl, complex *d__, complex *du, complex *du2, integer *ipiv,
+ complex *b, integer *ldb);
+
+/* Subroutine */ int chbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *w, complex *z__, integer *ldz,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, complex *ab, integer *ldab, complex *q, integer *ldq,
+ real *vl, real *vu, integer *il, integer *iu, real *abstol, integer *
+ m, real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int chbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, complex *ab, integer *ldab, complex *bb, integer *ldbb,
+ complex *x, integer *ldx, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, complex *ab, integer *ldab, complex *bb, integer *ldbb,
+ real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, complex *ab, integer *ldab, complex *bb, integer *ldbb,
+ real *w, complex *z__, integer *ldz, complex *work, integer *lwork,
+ real *rwork, integer *lrwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int chbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, complex *ab, integer *ldab, complex *bb,
+ integer *ldbb, complex *q, integer *ldq, real *vl, real *vu, integer *
+ il, integer *iu, real *abstol, integer *m, real *w, complex *z__,
+ integer *ldz, complex *work, real *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int chbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ complex *ab, integer *ldab, real *d__, real *e, complex *q, integer *
+ ldq, complex *work, integer *info);
+
+/* Subroutine */ int checon_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, complex *work, integer *
+ info);
+
+/* Subroutine */ int cheequb_(char *uplo, integer *n, complex *a, integer *
+ lda, real *s, real *scond, real *amax, complex *work, integer *info);
+
+/* Subroutine */ int cheev_(char *jobz, char *uplo, integer *n, complex *a,
+ integer *lda, real *w, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cheevd_(char *jobz, char *uplo, integer *n, complex *a,
+ integer *lda, real *w, complex *work, integer *lwork, real *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int cheevr_(char *jobz, char *range, char *uplo, integer *n,
+ complex *a, integer *lda, real *vl, real *vu, integer *il, integer *
+ iu, real *abstol, integer *m, real *w, complex *z__, integer *ldz,
+ integer *isuppz, complex *work, integer *lwork, real *rwork, integer *
+ lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int cheevx_(char *jobz, char *range, char *uplo, integer *n,
+ complex *a, integer *lda, real *vl, real *vu, integer *il, integer *
+ iu, real *abstol, integer *m, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int chegs2_(integer *itype, char *uplo, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chegst_(integer *itype, char *uplo, integer *n, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chegv_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, real *w,
+ complex *work, integer *lwork, real *rwork, integer *info);
+
+/* Subroutine */ int chegvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, real *w,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chegvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ real *vl, real *vu, integer *il, integer *iu, real *abstol, integer *
+ m, real *w, complex *z__, integer *ldz, complex *work, integer *lwork,
+ real *rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int cherfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cherfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *rcond, real *berr, integer *n_err_bnds__, real *err_bnds_norm__,
+ real *err_bnds_comp__, integer *nparams, real *params, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int chesv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, integer *ipiv, complex *b, integer *ldb, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int chesvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, complex *b, integer *ldb, complex *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chesvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, char *equed, real *s, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *rcond, real *rpvgrw, real *berr, integer *
+ n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__, integer *
+ nparams, real *params, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chetd2_(char *uplo, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tau, integer *info);
+
+/* Subroutine */ int chetf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int chetrd_(char *uplo, integer *n, complex *a, integer *lda,
+ real *d__, real *e, complex *tau, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int chetrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int chetri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *info);
+
+/* Subroutine */ int chetrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int chfrk_(char *transr, char *uplo, char *trans, integer *n,
+ integer *k, real *alpha, complex *a, integer *lda, real *beta,
+ complex *c__);
+
+/* Subroutine */ int chgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *t,
+ integer *ldt, complex *alpha, complex *beta, complex *q, integer *ldq,
+ complex *z__, integer *ldz, complex *work, integer *lwork, real *
+ rwork, integer *info);
+
+/* Character */ VOID chla_transtype__(char *ret_val, ftnlen ret_val_len,
+ integer *trans);
+
+/* Subroutine */ int chpcon_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, real *anorm, real *rcond, complex *work, integer *info);
+
+/* Subroutine */ int chpev_(char *jobz, char *uplo, integer *n, complex *ap,
+ real *w, complex *z__, integer *ldz, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chpevd_(char *jobz, char *uplo, integer *n, complex *ap,
+ real *w, complex *z__, integer *ldz, complex *work, integer *lwork,
+ real *rwork, integer *lrwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int chpevx_(char *jobz, char *range, char *uplo, integer *n,
+ complex *ap, real *vl, real *vu, integer *il, integer *iu, real *
+ abstol, integer *m, real *w, complex *z__, integer *ldz, complex *
+ work, real *rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int chpgst_(integer *itype, char *uplo, integer *n, complex *
+ ap, complex *bp, integer *info);
+
+/* Subroutine */ int chpgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *ap, complex *bp, real *w, complex *z__, integer *ldz,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chpgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, complex *ap, complex *bp, real *w, complex *z__, integer *ldz,
+ complex *work, integer *lwork, real *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int chpgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, complex *ap, complex *bp, real *vl, real *vu,
+ integer *il, integer *iu, real *abstol, integer *m, real *w, complex *
+ z__, integer *ldz, complex *work, real *rwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int chprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, integer *ipiv, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int chpsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chpsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int chptrd_(char *uplo, integer *n, complex *ap, real *d__,
+ real *e, complex *tau, integer *info);
+
+/* Subroutine */ int chptrf_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int chptri_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, complex *work, integer *info);
+
+/* Subroutine */ int chptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int chsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, complex *h__, integer *ldh, complex *w, complex *
+ vl, integer *ldvl, complex *vr, integer *ldvr, integer *mm, integer *
+ m, complex *work, real *rwork, integer *ifaill, integer *ifailr,
+ integer *info);
+
+/* Subroutine */ int chseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, complex *h__, integer *ldh, complex *w, complex *z__,
+ integer *ldz, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cla_gbamv__(integer *trans, integer *m, integer *n,
+ integer *kl, integer *ku, real *alpha, complex *ab, integer *ldab,
+ complex *x, integer *incx, real *beta, real *y, integer *incy);
+
+doublereal cla_gbrcond_c__(char *trans, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, complex *afb, integer *ldafb, integer *
+ ipiv, real *c__, logical *capply, integer *info, complex *work, real *
+ rwork, ftnlen trans_len);
+
+doublereal cla_gbrcond_x__(char *trans, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, complex *afb, integer *ldafb, integer *
+ ipiv, complex *x, integer *info, complex *work, real *rwork, ftnlen
+ trans_len);
+
+/* Subroutine */ int cla_gbrfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *kl, integer *ku, integer *nrhs,
+ complex *ab, integer *ldab, complex *afb, integer *ldafb, integer *
+ ipiv, logical *colequ, real *c__, complex *b, integer *ldb, complex *
+ y, integer *ldy, real *berr_out__, integer *n_norms__, real *errs_n__,
+ real *errs_c__, complex *res, real *ayb, complex *dy, complex *
+ y_tail__, real *rcond, integer *ithresh, real *rthresh, real *dz_ub__,
+ logical *ignore_cwise__, integer *info);
+
+doublereal cla_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
+ ncols, complex *ab, integer *ldab, complex *afb, integer *ldafb);
+
+/* Subroutine */ int cla_geamv__(integer *trans, integer *m, integer *n, real
+ *alpha, complex *a, integer *lda, complex *x, integer *incx, real *
+ beta, real *y, integer *incy);
+
+doublereal cla_gercond_c__(char *trans, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, real *c__, logical *capply,
+ integer *info, complex *work, real *rwork, ftnlen trans_len);
+
+doublereal cla_gercond_x__(char *trans, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, complex *x, integer *info,
+ complex *work, real *rwork, ftnlen trans_len);
+
+/* Subroutine */ int cla_gerfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *nrhs, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, logical *colequ, real *c__,
+ complex *b, integer *ldb, complex *y, integer *ldy, real *berr_out__,
+ integer *n_norms__, real *errs_n__, real *errs_c__, complex *res,
+ real *ayb, complex *dy, complex *y_tail__, real *rcond, integer *
+ ithresh, real *rthresh, real *dz_ub__, logical *ignore_cwise__,
+ integer *info);
+
+/* Subroutine */ int cla_heamv__(integer *uplo, integer *n, real *alpha,
+ complex *a, integer *lda, complex *x, integer *incx, real *beta, real
+ *y, integer *incy);
+
+doublereal cla_hercond_c__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, real *c__, logical *capply,
+ integer *info, complex *work, real *rwork, ftnlen uplo_len);
+
+doublereal cla_hercond_x__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, complex *x, integer *info,
+ complex *work, real *rwork, ftnlen uplo_len);
+
+/* Subroutine */ int cla_herfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, complex *a, integer *lda, complex *af,
+ integer *ldaf, integer *ipiv, logical *colequ, real *c__, complex *b,
+ integer *ldb, complex *y, integer *ldy, real *berr_out__, integer *
+ n_norms__, real *errs_n__, real *errs_c__, complex *res, real *ayb,
+ complex *dy, complex *y_tail__, real *rcond, integer *ithresh, real *
+ rthresh, real *dz_ub__, logical *ignore_cwise__, integer *info,
+ ftnlen uplo_len);
+
+doublereal cla_herpvgrw__(char *uplo, integer *n, integer *info, complex *a,
+ integer *lda, complex *af, integer *ldaf, integer *ipiv, real *work,
+ ftnlen uplo_len);
+
+/* Subroutine */ int cla_lin_berr__(integer *n, integer *nz, integer *nrhs,
+ complex *res, real *ayb, real *berr);
+
+doublereal cla_porcond_c__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, real *c__, logical *capply, integer *info,
+ complex *work, real *rwork, ftnlen uplo_len);
+
+doublereal cla_porcond_x__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, complex *x, integer *info, complex *work,
+ real *rwork, ftnlen uplo_len);
+
+/* Subroutine */ int cla_porfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, complex *a, integer *lda, complex *af,
+ integer *ldaf, logical *colequ, real *c__, complex *b, integer *ldb,
+ complex *y, integer *ldy, real *berr_out__, integer *n_norms__, real *
+ errs_n__, real *errs_c__, complex *res, real *ayb, complex *dy,
+ complex *y_tail__, real *rcond, integer *ithresh, real *rthresh, real
+ *dz_ub__, logical *ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal cla_porpvgrw__(char *uplo, integer *ncols, complex *a, integer *
+ lda, complex *af, integer *ldaf, real *work, ftnlen uplo_len);
+
+doublereal cla_rpvgrw__(integer *n, integer *ncols, complex *a, integer *lda,
+ complex *af, integer *ldaf);
+
+/* Subroutine */ int cla_syamv__(integer *uplo, integer *n, real *alpha,
+ complex *a, integer *lda, complex *x, integer *incx, real *beta, real
+ *y, integer *incy);
+
+doublereal cla_syrcond_c__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, real *c__, logical *capply,
+ integer *info, complex *work, real *rwork, ftnlen uplo_len);
+
+doublereal cla_syrcond_x__(char *uplo, integer *n, complex *a, integer *lda,
+ complex *af, integer *ldaf, integer *ipiv, complex *x, integer *info,
+ complex *work, real *rwork, ftnlen uplo_len);
+
+/* Subroutine */ int cla_syrfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, complex *a, integer *lda, complex *af,
+ integer *ldaf, integer *ipiv, logical *colequ, real *c__, complex *b,
+ integer *ldb, complex *y, integer *ldy, real *berr_out__, integer *
+ n_norms__, real *errs_n__, real *errs_c__, complex *res, real *ayb,
+ complex *dy, complex *y_tail__, real *rcond, integer *ithresh, real *
+ rthresh, real *dz_ub__, logical *ignore_cwise__, integer *info,
+ ftnlen uplo_len);
+
+doublereal cla_syrpvgrw__(char *uplo, integer *n, integer *info, complex *a,
+ integer *lda, complex *af, integer *ldaf, integer *ipiv, real *work,
+ ftnlen uplo_len);
+
+/* Subroutine */ int cla_wwaddw__(integer *n, complex *x, complex *y, complex
+ *w);
+
+/* Subroutine */ int clabrd_(integer *m, integer *n, integer *nb, complex *a,
+ integer *lda, real *d__, real *e, complex *tauq, complex *taup,
+ complex *x, integer *ldx, complex *y, integer *ldy);
+
+/* Subroutine */ int clacgv_(integer *n, complex *x, integer *incx);
+
+/* Subroutine */ int clacn2_(integer *n, complex *v, complex *x, real *est,
+ integer *kase, integer *isave);
+
+/* Subroutine */ int clacon_(integer *n, complex *v, complex *x, real *est,
+ integer *kase);
+
+/* Subroutine */ int clacp2_(char *uplo, integer *m, integer *n, real *a,
+ integer *lda, complex *b, integer *ldb);
+
+/* Subroutine */ int clacpy_(char *uplo, integer *m, integer *n, complex *a,
+ integer *lda, complex *b, integer *ldb);
+
+/* Subroutine */ int clacrm_(integer *m, integer *n, complex *a, integer *lda,
+ real *b, integer *ldb, complex *c__, integer *ldc, real *rwork);
+
+/* Subroutine */ int clacrt_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, complex *c__, complex *s);
+
+/* Complex */ VOID cladiv_(complex * ret_val, complex *x, complex *y);
+
+/* Subroutine */ int claed0_(integer *qsiz, integer *n, real *d__, real *e,
+ complex *q, integer *ldq, complex *qstore, integer *ldqs, real *rwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int claed7_(integer *n, integer *cutpnt, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, real *d__, complex *
+ q, integer *ldq, real *rho, integer *indxq, real *qstore, integer *
+ qptr, integer *prmptr, integer *perm, integer *givptr, integer *
+ givcol, real *givnum, complex *work, real *rwork, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int claed8_(integer *k, integer *n, integer *qsiz, complex *
+ q, integer *ldq, real *d__, real *rho, integer *cutpnt, real *z__,
+ real *dlamda, complex *q2, integer *ldq2, real *w, integer *indxp,
+ integer *indx, integer *indxq, integer *perm, integer *givptr,
+ integer *givcol, real *givnum, integer *info);
+
+/* Subroutine */ int claein_(logical *rightv, logical *noinit, integer *n,
+ complex *h__, integer *ldh, complex *w, complex *v, complex *b,
+ integer *ldb, real *rwork, real *eps3, real *smlnum, integer *info);
+
+/* Subroutine */ int claesy_(complex *a, complex *b, complex *c__, complex *
+ rt1, complex *rt2, complex *evscal, complex *cs1, complex *sn1);
+
+/* Subroutine */ int claev2_(complex *a, complex *b, complex *c__, real *rt1,
+ real *rt2, real *cs1, complex *sn1);
+
+/* Subroutine */ int clag2z_(integer *m, integer *n, complex *sa, integer *
+ ldsa, doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int clags2_(logical *upper, real *a1, complex *a2, real *a3,
+ real *b1, complex *b2, real *b3, real *csu, complex *snu, real *csv,
+ complex *snv, real *csq, complex *snq);
+
+/* Subroutine */ int clagtm_(char *trans, integer *n, integer *nrhs, real *
+ alpha, complex *dl, complex *d__, complex *du, complex *x, integer *
+ ldx, real *beta, complex *b, integer *ldb);
+
+/* Subroutine */ int clahef_(char *uplo, integer *n, integer *nb, integer *kb,
+ complex *a, integer *lda, integer *ipiv, complex *w, integer *ldw,
+ integer *info);
+
+/* Subroutine */ int clahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer *
+ info);
+
+/* Subroutine */ int clahr2_(integer *n, integer *k, integer *nb, complex *a,
+ integer *lda, complex *tau, complex *t, integer *ldt, complex *y,
+ integer *ldy);
+
+/* Subroutine */ int clahrd_(integer *n, integer *k, integer *nb, complex *a,
+ integer *lda, complex *tau, complex *t, integer *ldt, complex *y,
+ integer *ldy);
+
+/* Subroutine */ int claic1_(integer *job, integer *j, complex *x, real *sest,
+ complex *w, complex *gamma, real *sestpr, complex *s, complex *c__);
+
+/* Subroutine */ int clals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, complex *b, integer *ldb, complex *bx,
+ integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ rwork, integer *info);
+
+/* Subroutine */ int clalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, complex *b, integer *ldb, complex *bx, integer *ldbx,
+ real *u, integer *ldu, real *vt, integer *k, real *difl, real *difr,
+ real *z__, real *poles, integer *givptr, integer *givcol, integer *
+ ldgcol, integer *perm, real *givnum, real *c__, real *s, real *rwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int clalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, real *d__, real *e, complex *b, integer *ldb, real *rcond,
+ integer *rank, complex *work, real *rwork, integer *iwork, integer *
+ info);
+
+doublereal clangb_(char *norm, integer *n, integer *kl, integer *ku, complex *
+ ab, integer *ldab, real *work);
+
+doublereal clange_(char *norm, integer *m, integer *n, complex *a, integer *
+ lda, real *work);
+
+doublereal clangt_(char *norm, integer *n, complex *dl, complex *d__, complex
+ *du);
+
+doublereal clanhb_(char *norm, char *uplo, integer *n, integer *k, complex *
+ ab, integer *ldab, real *work);
+
+doublereal clanhe_(char *norm, char *uplo, integer *n, complex *a, integer *
+ lda, real *work);
+
+doublereal clanhf_(char *norm, char *transr, char *uplo, integer *n, complex *
+ a, real *work);
+
+doublereal clanhp_(char *norm, char *uplo, integer *n, complex *ap, real *
+ work);
+
+doublereal clanhs_(char *norm, integer *n, complex *a, integer *lda, real *
+ work);
+
+doublereal clanht_(char *norm, integer *n, real *d__, complex *e);
+
+doublereal clansb_(char *norm, char *uplo, integer *n, integer *k, complex *
+ ab, integer *ldab, real *work);
+
+doublereal clansp_(char *norm, char *uplo, integer *n, complex *ap, real *
+ work);
+
+doublereal clansy_(char *norm, char *uplo, integer *n, complex *a, integer *
+ lda, real *work);
+
+doublereal clantb_(char *norm, char *uplo, char *diag, integer *n, integer *k,
+ complex *ab, integer *ldab, real *work);
+
+doublereal clantp_(char *norm, char *uplo, char *diag, integer *n, complex *
+ ap, real *work);
+
+doublereal clantr_(char *norm, char *uplo, char *diag, integer *m, integer *n,
+ complex *a, integer *lda, real *work);
+
+/* Subroutine */ int clapll_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *ssmin);
+
+/* Subroutine */ int clapmt_(logical *forwrd, integer *m, integer *n, complex
+ *x, integer *ldx, integer *k);
+
+/* Subroutine */ int claqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ complex *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real
+ *colcnd, real *amax, char *equed);
+
+/* Subroutine */ int claqge_(integer *m, integer *n, complex *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, char *
+ equed);
+
+/* Subroutine */ int claqhb_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqhe_(char *uplo, integer *n, complex *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqhp_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqp2_(integer *m, integer *n, integer *offset, complex
+ *a, integer *lda, integer *jpvt, complex *tau, real *vn1, real *vn2,
+ complex *work);
+
+/* Subroutine */ int claqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, complex *a, integer *lda, integer *jpvt, complex *
+ tau, real *vn1, real *vn2, complex *auxv, complex *f, integer *ldf);
+
+/* Subroutine */ int claqr0_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int claqr1_(integer *n, complex *h__, integer *ldh, complex *
+ s1, complex *s2, complex *v);
+
+/* Subroutine */ int claqr2_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer *
+ ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh,
+ complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv,
+ complex *work, integer *lwork);
+
+/* Subroutine */ int claqr3_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, complex *h__, integer *ldh,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, integer *
+ ns, integer *nd, complex *sh, complex *v, integer *ldv, integer *nh,
+ complex *t, integer *ldt, integer *nv, complex *wv, integer *ldwv,
+ complex *work, integer *lwork);
+
+/* Subroutine */ int claqr4_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, complex *h__, integer *ldh, complex *w,
+ integer *iloz, integer *ihiz, complex *z__, integer *ldz, complex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int claqr5_(logical *wantt, logical *wantz, integer *kacc22,
+ integer *n, integer *ktop, integer *kbot, integer *nshfts, complex *s,
+ complex *h__, integer *ldh, integer *iloz, integer *ihiz, complex *
+ z__, integer *ldz, complex *v, integer *ldv, complex *u, integer *ldu,
+ integer *nv, complex *wv, integer *ldwv, integer *nh, complex *wh,
+ integer *ldwh);
+
+/* Subroutine */ int claqsb_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqsp_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, char *equed);
+
+/* Subroutine */ int claqsy_(char *uplo, integer *n, complex *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int clar1v_(integer *n, integer *b1, integer *bn, real *
+ lambda, real *d__, real *l, real *ld, real *lld, real *pivmin, real *
+ gaptol, complex *z__, logical *wantnc, integer *negcnt, real *ztz,
+ real *mingma, integer *r__, integer *isuppz, real *nrminv, real *
+ resid, real *rqcorr, real *work);
+
+/* Subroutine */ int clar2v_(integer *n, complex *x, complex *y, complex *z__,
+ integer *incx, real *c__, complex *s, integer *incc);
+
+/* Subroutine */ int clarcm_(integer *m, integer *n, real *a, integer *lda,
+ complex *b, integer *ldb, complex *c__, integer *ldc, real *rwork);
+
+/* Subroutine */ int clarf_(char *side, integer *m, integer *n, complex *v,
+ integer *incv, complex *tau, complex *c__, integer *ldc, complex *
+ work);
+
+/* Subroutine */ int clarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, complex *v, integer *ldv,
+ complex *t, integer *ldt, complex *c__, integer *ldc, complex *work,
+ integer *ldwork);
+
+/* Subroutine */ int clarfg_(integer *n, complex *alpha, complex *x, integer *
+ incx, complex *tau);
+
+/* Subroutine */ int clarfp_(integer *n, complex *alpha, complex *x, integer *
+ incx, complex *tau);
+
+/* Subroutine */ int clarft_(char *direct, char *storev, integer *n, integer *
+ k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt);
+
+/* Subroutine */ int clarfx_(char *side, integer *m, integer *n, complex *v,
+ complex *tau, complex *c__, integer *ldc, complex *work);
+
+/* Subroutine */ int clargv_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *c__, integer *incc);
+
+/* Subroutine */ int clarnv_(integer *idist, integer *iseed, integer *n,
+ complex *x);
+
+/* Subroutine */ int clarrv_(integer *n, real *vl, real *vu, real *d__, real *
+ l, real *pivmin, integer *isplit, integer *m, integer *dol, integer *
+ dou, real *minrgp, real *rtol1, real *rtol2, real *w, real *werr,
+ real *wgap, integer *iblock, integer *indexw, real *gers, complex *
+ z__, integer *ldz, integer *isuppz, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int clarscl2_(integer *m, integer *n, real *d__, complex *x,
+ integer *ldx);
+
+/* Subroutine */ int clartg_(complex *f, complex *g, real *cs, complex *sn,
+ complex *r__);
+
+/* Subroutine */ int clartv_(integer *n, complex *x, integer *incx, complex *
+ y, integer *incy, real *c__, complex *s, integer *incc);
+
+/* Subroutine */ int clarz_(char *side, integer *m, integer *n, integer *l,
+ complex *v, integer *incv, complex *tau, complex *c__, integer *ldc,
+ complex *work);
+
+/* Subroutine */ int clarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, complex *v,
+ integer *ldv, complex *t, integer *ldt, complex *c__, integer *ldc,
+ complex *work, integer *ldwork);
+
+/* Subroutine */ int clarzt_(char *direct, char *storev, integer *n, integer *
+ k, complex *v, integer *ldv, complex *tau, complex *t, integer *ldt);
+
+/* Subroutine */ int clascl_(char *type__, integer *kl, integer *ku, real *
+ cfrom, real *cto, integer *m, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int clascl2_(integer *m, integer *n, real *d__, complex *x,
+ integer *ldx);
+
+/* Subroutine */ int claset_(char *uplo, integer *m, integer *n, complex *
+ alpha, complex *beta, complex *a, integer *lda);
+
+/* Subroutine */ int clasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, real *c__, real *s, complex *a, integer *lda);
+
+/* Subroutine */ int classq_(integer *n, complex *x, integer *incx, real *
+ scale, real *sumsq);
+
+/* Subroutine */ int claswp_(integer *n, complex *a, integer *lda, integer *
+ k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int clasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ complex *a, integer *lda, integer *ipiv, complex *w, integer *ldw,
+ integer *info);
+
+/* Subroutine */ int clatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, complex *ab, integer *ldab, complex *
+ x, real *scale, real *cnorm, integer *info);
+
+/* Subroutine */ int clatdf_(integer *ijob, integer *n, complex *z__, integer
+ *ldz, complex *rhs, real *rdsum, real *rdscal, integer *ipiv, integer
+ *jpiv);
+
+/* Subroutine */ int clatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, complex *ap, complex *x, real *scale, real *cnorm,
+ integer *info);
+
+/* Subroutine */ int clatrd_(char *uplo, integer *n, integer *nb, complex *a,
+ integer *lda, real *e, complex *tau, complex *w, integer *ldw);
+
+/* Subroutine */ int clatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, complex *a, integer *lda, complex *x, real *scale,
+ real *cnorm, integer *info);
+
+/* Subroutine */ int clatrz_(integer *m, integer *n, integer *l, complex *a,
+ integer *lda, complex *tau, complex *work);
+
+/* Subroutine */ int clatzm_(char *side, integer *m, integer *n, complex *v,
+ integer *incv, complex *tau, complex *c1, complex *c2, integer *ldc,
+ complex *work);
+
+/* Subroutine */ int clauu2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int clauum_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpbcon_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *anorm, real *rcond, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cpbequ_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, real *s, real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *afb, integer *ldafb,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *ferr, real *
+ berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpbstf_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, complex *ab, integer *ldab, complex *afb, integer *
+ ldafb, char *equed, real *s, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *rcond, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cpbtf2_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbtrf_(char *uplo, integer *n, integer *kd, complex *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int cpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, complex *ab, integer *ldab, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int cpftrf_(char *transr, char *uplo, integer *n, complex *a,
+ integer *info);
+
+/* Subroutine */ int cpftri_(char *transr, char *uplo, integer *n, complex *a,
+ integer *info);
+
+/* Subroutine */ int cpftrs_(char *transr, char *uplo, integer *n, integer *
+ nrhs, complex *a, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cpocon_(char *uplo, integer *n, complex *a, integer *lda,
+ real *anorm, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpoequ_(integer *n, complex *a, integer *lda, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cpoequb_(integer *n, complex *a, integer *lda, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cporfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cporfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, real *s,
+ complex *b, integer *ldb, complex *x, integer *ldx, real *rcond, real
+ *berr, integer *n_err_bnds__, real *err_bnds_norm__, real *
+ err_bnds_comp__, integer *nparams, real *params, complex *work, real *
+ rwork, integer *info);
+
+/* Subroutine */ int cposv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, char *
+ equed, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *rcond, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cposvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, char *
+ equed, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *rcond, real *rpvgrw, real *berr, integer *n_err_bnds__, real *
+ err_bnds_norm__, real *err_bnds_comp__, integer *nparams, real *
+ params, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpotf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int cpotrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cppcon_(char *uplo, integer *n, complex *ap, real *anorm,
+ real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cppequ_(char *uplo, integer *n, complex *ap, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int cpprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *ferr, real *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cppsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, char *equed, real *s, complex *b,
+ integer *ldb, complex *x, integer *ldx, real *rcond, real *ferr, real
+ *berr, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int cpptrf_(char *uplo, integer *n, complex *ap, integer *
+ info);
+
+/* Subroutine */ int cpptri_(char *uplo, integer *n, complex *ap, integer *
+ info);
+
+/* Subroutine */ int cpptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cpstf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *piv, integer *rank, real *tol, real *work, integer *info);
+
+/* Subroutine */ int cpstrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *piv, integer *rank, real *tol, real *work, integer *info);
+
+/* Subroutine */ int cptcon_(integer *n, real *d__, complex *e, real *anorm,
+ real *rcond, real *rwork, integer *info);
+
+/* Subroutine */ int cpteqr_(char *compz, integer *n, real *d__, real *e,
+ complex *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int cptrfs_(char *uplo, integer *n, integer *nrhs, real *d__,
+ complex *e, real *df, complex *ef, complex *b, integer *ldb, complex
+ *x, integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cptsv_(integer *n, integer *nrhs, real *d__, complex *e,
+ complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cptsvx_(char *fact, integer *n, integer *nrhs, real *d__,
+ complex *e, real *df, complex *ef, complex *b, integer *ldb, complex
+ *x, integer *ldx, real *rcond, real *ferr, real *berr, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int cpttrf_(integer *n, real *d__, complex *e, integer *info);
+
+/* Subroutine */ int cpttrs_(char *uplo, integer *n, integer *nrhs, real *d__,
+ complex *e, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cptts2_(integer *iuplo, integer *n, integer *nrhs, real *
+ d__, complex *e, complex *b, integer *ldb);
+
+/* Subroutine */ int crot_(integer *n, complex *cx, integer *incx, complex *
+ cy, integer *incy, real *c__, complex *s);
+
+/* Subroutine */ int cspcon_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, real *anorm, real *rcond, complex *work, integer *info);
+
+/* Subroutine */ int cspmv_(char *uplo, integer *n, complex *alpha, complex *
+ ap, complex *x, integer *incx, complex *beta, complex *y, integer *
+ incy);
+
+/* Subroutine */ int cspr_(char *uplo, integer *n, complex *alpha, complex *x,
+ integer *incx, complex *ap);
+
+/* Subroutine */ int csprfs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, complex *afp, integer *ipiv, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int cspsv_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int cspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *ap, complex *afp, integer *ipiv, complex *b, integer *
+ ldb, complex *x, integer *ldx, real *rcond, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int csptrf_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int csptri_(char *uplo, integer *n, complex *ap, integer *
+ ipiv, complex *work, integer *info);
+
+/* Subroutine */ int csptrs_(char *uplo, integer *n, integer *nrhs, complex *
+ ap, integer *ipiv, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int csrscl_(integer *n, real *sa, complex *sx, integer *incx);
+
+/* Subroutine */ int cstedc_(char *compz, integer *n, real *d__, real *e,
+ complex *z__, integer *ldz, complex *work, integer *lwork, real *
+ rwork, integer *lrwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int cstegr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, complex *z__, integer *ldz, integer *isuppz,
+ real *work, integer *lwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int cstein_(integer *n, real *d__, real *e, integer *m, real
+ *w, integer *iblock, integer *isplit, complex *z__, integer *ldz,
+ real *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int cstemr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, integer *m,
+ real *w, complex *z__, integer *ldz, integer *nzc, integer *isuppz,
+ logical *tryrac, real *work, integer *lwork, integer *iwork, integer *
+ liwork, integer *info);
+
+/* Subroutine */ int csteqr_(char *compz, integer *n, real *d__, real *e,
+ complex *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int csycon_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, complex *work, integer *
+ info);
+
+/* Subroutine */ int csyequb_(char *uplo, integer *n, complex *a, integer *
+ lda, real *s, real *scond, real *amax, complex *work, integer *info);
+
+/* Subroutine */ int csymv_(char *uplo, integer *n, complex *alpha, complex *
+ a, integer *lda, complex *x, integer *incx, complex *beta, complex *y,
+ integer *incy);
+
+/* Subroutine */ int csyr_(char *uplo, integer *n, complex *alpha, complex *x,
+ integer *incx, complex *a, integer *lda);
+
+/* Subroutine */ int csyrfs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, complex *af, integer *ldaf, integer *ipiv, complex *
+ b, integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int csyrfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, real *s, complex *b, integer *ldb, complex *x, integer *ldx,
+ real *rcond, real *berr, integer *n_err_bnds__, real *err_bnds_norm__,
+ real *err_bnds_comp__, integer *nparams, real *params, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int csysv_(char *uplo, integer *n, integer *nrhs, complex *a,
+ integer *lda, integer *ipiv, complex *b, integer *ldb, complex *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int csysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, complex *b, integer *ldb, complex *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, complex *work, integer *lwork, real *rwork,
+ integer *info);
+
+/* Subroutine */ int csysvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, complex *a, integer *lda, complex *af, integer *ldaf, integer *
+ ipiv, char *equed, real *s, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *rcond, real *rpvgrw, real *berr, integer *
+ n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__, integer *
+ nparams, real *params, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int csytf2_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int csytrf_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int csytri_(char *uplo, integer *n, complex *a, integer *lda,
+ integer *ipiv, complex *work, integer *info);
+
+/* Subroutine */ int csytrs_(char *uplo, integer *n, integer *nrhs, complex *
+ a, integer *lda, integer *ipiv, complex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int ctbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, complex *ab, integer *ldab, real *rcond, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int ctbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, complex *ab, integer *ldab, complex *b,
+ integer *ldb, complex *x, integer *ldx, real *ferr, real *berr,
+ complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, complex *ab, integer *ldab, complex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ctfsm_(char *transr, char *side, char *uplo, char *trans,
+ char *diag, integer *m, integer *n, complex *alpha, complex *a,
+ complex *b, integer *ldb);
+
+/* Subroutine */ int ctftri_(char *transr, char *uplo, char *diag, integer *n,
+ complex *a, integer *info);
+
+/* Subroutine */ int ctfttp_(char *transr, char *uplo, integer *n, complex *
+ arf, complex *ap, integer *info);
+
+/* Subroutine */ int ctfttr_(char *transr, char *uplo, integer *n, complex *
+ arf, complex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ctgevc_(char *side, char *howmny, logical *select,
+ integer *n, complex *s, integer *lds, complex *p, integer *ldp,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, integer *mm,
+ integer *m, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctgex2_(logical *wantq, logical *wantz, integer *n,
+ complex *a, integer *lda, complex *b, integer *ldb, complex *q,
+ integer *ldq, complex *z__, integer *ldz, integer *j1, integer *info);
+
+/* Subroutine */ int ctgexc_(logical *wantq, logical *wantz, integer *n,
+ complex *a, integer *lda, complex *b, integer *ldb, complex *q,
+ integer *ldq, complex *z__, integer *ldz, integer *ifst, integer *
+ ilst, integer *info);
+
+/* Subroutine */ int ctgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, complex *a, integer *lda, complex *b,
+ integer *ldb, complex *alpha, complex *beta, complex *q, integer *ldq,
+ complex *z__, integer *ldz, integer *m, real *pl, real *pr, real *
+ dif, complex *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ctgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, complex *a, integer *
+ lda, complex *b, integer *ldb, real *tola, real *tolb, real *alpha,
+ real *beta, complex *u, integer *ldu, complex *v, integer *ldv,
+ complex *q, integer *ldq, complex *work, integer *ncycle, integer *
+ info);
+
+/* Subroutine */ int ctgsna_(char *job, char *howmny, logical *select,
+ integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *vl, integer *ldvl, complex *vr, integer *ldvr, real *s, real
+ *dif, integer *mm, integer *m, complex *work, integer *lwork, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int ctgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, complex *c__,
+ integer *ldc, complex *d__, integer *ldd, complex *e, integer *lde,
+ complex *f, integer *ldf, real *scale, real *rdsum, real *rdscal,
+ integer *info);
+
+/* Subroutine */ int ctgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, complex *a, integer *lda, complex *b, integer *ldb, complex *c__,
+ integer *ldc, complex *d__, integer *ldd, complex *e, integer *lde,
+ complex *f, integer *ldf, real *scale, real *dif, complex *work,
+ integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ctpcon_(char *norm, char *uplo, char *diag, integer *n,
+ complex *ap, real *rcond, complex *work, real *rwork, integer *info);
+
+/* Subroutine */ int ctprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *ap, complex *b, integer *ldb, complex *x,
+ integer *ldx, real *ferr, real *berr, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int ctptri_(char *uplo, char *diag, integer *n, complex *ap,
+ integer *info);
+
+/* Subroutine */ int ctptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *ap, complex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ctpttf_(char *transr, char *uplo, integer *n, complex *
+ ap, complex *arf, integer *info);
+
+/* Subroutine */ int ctpttr_(char *uplo, integer *n, complex *ap, complex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int ctrcon_(char *norm, char *uplo, char *diag, integer *n,
+ complex *a, integer *lda, real *rcond, complex *work, real *rwork,
+ integer *info);
+
+/* Subroutine */ int ctrevc_(char *side, char *howmny, logical *select,
+ integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl,
+ complex *vr, integer *ldvr, integer *mm, integer *m, complex *work,
+ real *rwork, integer *info);
+
+/* Subroutine */ int ctrexc_(char *compq, integer *n, complex *t, integer *
+ ldt, complex *q, integer *ldq, integer *ifst, integer *ilst, integer *
+ info);
+
+/* Subroutine */ int ctrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *x, integer *ldx, real *ferr, real *berr, complex *work, real
+ *rwork, integer *info);
+
+/* Subroutine */ int ctrsen_(char *job, char *compq, logical *select, integer
+ *n, complex *t, integer *ldt, complex *q, integer *ldq, complex *w,
+ integer *m, real *s, real *sep, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int ctrsna_(char *job, char *howmny, logical *select,
+ integer *n, complex *t, integer *ldt, complex *vl, integer *ldvl,
+ complex *vr, integer *ldvr, real *s, real *sep, integer *mm, integer *
+ m, complex *work, integer *ldwork, real *rwork, integer *info);
+
+/* Subroutine */ int ctrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, complex *a, integer *lda, complex *b, integer *ldb,
+ complex *c__, integer *ldc, real *scale, integer *info);
+
+/* Subroutine */ int ctrti2_(char *uplo, char *diag, integer *n, complex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int ctrtri_(char *uplo, char *diag, integer *n, complex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int ctrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, complex *a, integer *lda, complex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int ctrttf_(char *transr, char *uplo, integer *n, complex *a,
+ integer *lda, complex *arf, integer *info);
+
+/* Subroutine */ int ctrttp_(char *uplo, integer *n, complex *a, integer *lda,
+ complex *ap, integer *info);
+
+/* Subroutine */ int ctzrqf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, integer *info);
+
+/* Subroutine */ int ctzrzf_(integer *m, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cung2l_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cung2r_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cungbr_(char *vect, integer *m, integer *n, integer *k,
+ complex *a, integer *lda, complex *tau, complex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int cunghr_(integer *n, integer *ilo, integer *ihi, complex *
+ a, integer *lda, complex *tau, complex *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int cungl2_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cunglq_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungql_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungqr_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungr2_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *info);
+
+/* Subroutine */ int cungrq_(integer *m, integer *n, integer *k, complex *a,
+ integer *lda, complex *tau, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cungtr_(char *uplo, integer *n, complex *a, integer *lda,
+ complex *tau, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunmhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *info);
+
+/* Subroutine */ int cunmrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cunmrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, complex *a, integer *lda, complex *tau,
+ complex *c__, integer *ldc, complex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int cunmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, complex *a, integer *lda, complex *tau, complex *c__,
+ integer *ldc, complex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int cupgtr_(char *uplo, integer *n, complex *ap, complex *
+ tau, complex *q, integer *ldq, complex *work, integer *info);
+
+/* Subroutine */ int cupmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, complex *ap, complex *tau, complex *c__, integer *ldc,
+ complex *work, integer *info);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, doublereal *d__, doublereal *e, doublereal *vt,
+ integer *ldvt, doublereal *u, integer *ldu, doublereal *c__, integer *
+ ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int ddisna_(char *job, integer *m, integer *n, doublereal *
+ d__, doublereal *sep, integer *info);
+
+/* Subroutine */ int dgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, doublereal *ab, integer *ldab, doublereal *
+ d__, doublereal *e, doublereal *q, integer *ldq, doublereal *pt,
+ integer *ldpt, doublereal *c__, integer *ldc, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, doublereal *anorm,
+ doublereal *rcond, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, integer *
+ info);
+
+/* Subroutine */ int dgbequb_(integer *m, integer *n, integer *kl, integer *
+ ku, doublereal *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, integer *
+ info);
+
+/* Subroutine */ int dgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublereal *ab, integer *ldab, doublereal *afb,
+ integer *ldafb, integer *ipiv, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbrfsx_(char *trans, char *equed, integer *n, integer *
+ kl, integer *ku, integer *nrhs, doublereal *ab, integer *ldab,
+ doublereal *afb, integer *ldafb, integer *ipiv, doublereal *r__,
+ doublereal *c__, doublereal *b, integer *ldb, doublereal *x, integer *
+ ldx, doublereal *rcond, doublereal *berr, integer *n_err_bnds__,
+ doublereal *err_bnds_norm__, doublereal *err_bnds_comp__, integer *
+ nparams, doublereal *params, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, doublereal *ab, integer *ldab, integer *ipiv, doublereal *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int dgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, doublereal *ab, integer *ldab,
+ doublereal *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbsvxx_(char *fact, char *trans, integer *n, integer *
+ kl, integer *ku, integer *nrhs, doublereal *ab, integer *ldab,
+ doublereal *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *rcond, doublereal *rpvgrw,
+ doublereal *berr, integer *n_err_bnds__, doublereal *err_bnds_norm__,
+ doublereal *err_bnds_comp__, integer *nparams, doublereal *params,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublereal *ab, integer *ldab, integer *ipiv,
+ doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublereal *v, integer *
+ ldv, integer *info);
+
+/* Subroutine */ int dgebal_(char *job, integer *n, doublereal *a, integer *
+ lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
+
+/* Subroutine */ int dgebd2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *info);
+
+/* Subroutine */ int dgebrd_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tauq, doublereal *
+ taup, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgecon_(char *norm, integer *n, doublereal *a, integer *
+ lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgeequ_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal
+ *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int dgeequb_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal
+ *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int dgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ doublereal *a, integer *lda, integer *sdim, doublereal *wr,
+ doublereal *wi, doublereal *vs, integer *ldvs, doublereal *work,
+ integer *lwork, logical *bwork, integer *info);
+
+/* Subroutine */ int dgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, doublereal *a, integer *lda, integer *sdim,
+ doublereal *wr, doublereal *wi, doublereal *vs, integer *ldvs,
+ doublereal *rconde, doublereal *rcondv, doublereal *work, integer *
+ lwork, integer *iwork, integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublereal *a, integer *lda, doublereal *wr,
+ doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr,
+ integer *ldvr, integer *ilo, integer *ihi, doublereal *scale,
+ doublereal *abnrm, doublereal *rconde, doublereal *rcondv, doublereal
+ *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dgegs_(char *jobvsl, char *jobvsr, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ alphar, doublereal *alphai, doublereal *beta, doublereal *vsl,
+ integer *ldvsl, doublereal *vsr, integer *ldvsr, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dgegv_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vl, integer *ldvl,
+ doublereal *vr, integer *ldvr, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dgejsv_(char *joba, char *jobu, char *jobv, char *jobr,
+ char *jobt, char *jobp, integer *m, integer *n, doublereal *a,
+ integer *lda, doublereal *sva, doublereal *u, integer *ldu,
+ doublereal *v, integer *ldv, doublereal *work, integer *lwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dgelq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgelqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgelsd_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dgelss_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ s, doublereal *rcond, integer *rank, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgelsx_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ jpvt, doublereal *rcond, integer *rank, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dgelsy_(integer *m, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ jpvt, doublereal *rcond, integer *rank, doublereal *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int dgeql2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqlf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgeqp3_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *jpvt, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgeqpf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *jpvt, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgeqrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgerfs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *
+ ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dgerfsx_(char *trans, char *equed, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, doublereal *r__, doublereal *c__, doublereal *b,
+ integer *ldb, doublereal *x, integer *ldx, doublereal *rcond,
+ doublereal *berr, integer *n_err_bnds__, doublereal *err_bnds_norm__,
+ doublereal *err_bnds_comp__, integer *nparams, doublereal *params,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dgerq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dgerqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgesc2_(integer *n, doublereal *a, integer *lda,
+ doublereal *rhs, integer *ipiv, integer *jpiv, doublereal *scale);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
+ *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ doublereal *a, integer *lda, doublereal *s, doublereal *u, integer *
+ ldu, doublereal *vt, integer *ldvt, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgesvj_(char *joba, char *jobu, char *jobv, integer *m,
+ integer *n, doublereal *a, integer *lda, doublereal *sva, integer *mv,
+ doublereal *v, integer *ldv, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgesvxx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *rpvgrw, doublereal *berr, integer *n_err_bnds__,
+ doublereal *err_bnds_norm__, doublereal *err_bnds_comp__, integer *
+ nparams, doublereal *params, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dgetc2_(integer *n, doublereal *a, integer *lda, integer
+ *ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int dgetf2_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgetrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgetri_(integer *n, doublereal *a, integer *lda, integer
+ *ipiv, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dgetrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *lscale, doublereal *rscale, integer *m,
+ doublereal *v, integer *ldv, integer *info);
+
+/* Subroutine */ int dggbal_(char *job, integer *n, doublereal *a, integer *
+ lda, doublereal *b, integer *ldb, integer *ilo, integer *ihi,
+ doublereal *lscale, doublereal *rscale, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, integer *sdim, doublereal *alphar, doublereal *alphai,
+ doublereal *beta, doublereal *vsl, integer *ldvsl, doublereal *vsr,
+ integer *ldvsr, doublereal *work, integer *lwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int dggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, doublereal *a, integer *lda,
+ doublereal *b, integer *ldb, integer *sdim, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vsl, integer *ldvsl,
+ doublereal *vsr, integer *ldvsr, doublereal *rconde, doublereal *
+ rcondv, doublereal *work, integer *lwork, integer *iwork, integer *
+ liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int dggev_(char *jobvl, char *jobvr, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *alphar,
+ doublereal *alphai, doublereal *beta, doublereal *vl, integer *ldvl,
+ doublereal *vr, integer *ldvr, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *lscale, doublereal *rscale,
+ doublereal *abnrm, doublereal *bbnrm, doublereal *rconde, doublereal *
+ rcondv, doublereal *work, integer *lwork, integer *iwork, logical *
+ bwork, integer *info);
+
+/* Subroutine */ int dggglm_(integer *n, integer *m, integer *p, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *d__,
+ doublereal *x, doublereal *y, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *q, integer *ldq, doublereal *z__, integer *
+ ldz, integer *info);
+
+/* Subroutine */ int dgglse_(integer *m, integer *n, integer *p, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb, doublereal *c__,
+ doublereal *d__, doublereal *x, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dggqrf_(integer *n, integer *m, integer *p, doublereal *
+ a, integer *lda, doublereal *taua, doublereal *b, integer *ldb,
+ doublereal *taub, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dggrqf_(integer *m, integer *p, integer *n, doublereal *
+ a, integer *lda, doublereal *taua, doublereal *b, integer *ldb,
+ doublereal *taub, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, doublereal *a,
+ integer *lda, doublereal *b, integer *ldb, doublereal *alpha,
+ doublereal *beta, doublereal *u, integer *ldu, doublereal *v, integer
+ *ldv, doublereal *q, integer *ldq, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *tola, doublereal *tolb, integer *k, integer
+ *l, doublereal *u, integer *ldu, doublereal *v, integer *ldv,
+ doublereal *q, integer *ldq, integer *iwork, doublereal *tau,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dgsvj0_(char *jobv, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *d__, doublereal *sva, integer *mv,
+ doublereal *v, integer *ldv, doublereal *eps, doublereal *sfmin,
+ doublereal *tol, integer *nsweep, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dgsvj1_(char *jobv, integer *m, integer *n, integer *n1,
+ doublereal *a, integer *lda, doublereal *d__, doublereal *sva,
+ integer *mv, doublereal *v, integer *ldv, doublereal *eps, doublereal
+ *sfmin, doublereal *tol, integer *nsweep, doublereal *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int dgtcon_(char *norm, integer *n, doublereal *dl,
+ doublereal *d__, doublereal *du, doublereal *du2, integer *ipiv,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgtrfs_(char *trans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *dlf,
+ doublereal *df, doublereal *duf, doublereal *du2, integer *ipiv,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dgtsv_(integer *n, integer *nrhs, doublereal *dl,
+ doublereal *d__, doublereal *du, doublereal *b, integer *ldb, integer
+ *info);
+
+/* Subroutine */ int dgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublereal *dl, doublereal *d__, doublereal *du, doublereal *
+ dlf, doublereal *df, doublereal *duf, doublereal *du2, integer *ipiv,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dgttrf_(integer *n, doublereal *dl, doublereal *d__,
+ doublereal *du, doublereal *du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int dgttrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
+ integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dgtts2_(integer *itrans, integer *n, integer *nrhs,
+ doublereal *dl, doublereal *d__, doublereal *du, doublereal *du2,
+ integer *ipiv, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dhgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, doublereal *h__, integer *ldh, doublereal
+ *t, integer *ldt, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dhsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, doublereal *h__, integer *ldh, doublereal *wr,
+ doublereal *wi, doublereal *vl, integer *ldvl, doublereal *vr,
+ integer *ldvr, integer *mm, integer *m, doublereal *work, integer *
+ ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ 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);
+
+logical disnan_(doublereal *din);
+
+/* Subroutine */ int dla_gbamv__(integer *trans, integer *m, integer *n,
+ integer *kl, integer *ku, doublereal *alpha, doublereal *ab, integer *
+ ldab, doublereal *x, integer *incx, doublereal *beta, doublereal *y,
+ integer *incy);
+
+doublereal dla_gbrcond__(char *trans, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb,
+ integer *ipiv, integer *cmode, doublereal *c__, integer *info,
+ doublereal *work, integer *iwork, ftnlen trans_len);
+
+/* Subroutine */ int dla_gbrfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *kl, integer *ku, integer *nrhs,
+ doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb,
+ integer *ipiv, logical *colequ, doublereal *c__, doublereal *b,
+ integer *ldb, doublereal *y, integer *ldy, doublereal *berr_out__,
+ integer *n_norms__, doublereal *errs_n__, doublereal *errs_c__,
+ doublereal *res, doublereal *ayb, doublereal *dy, doublereal *
+ y_tail__, doublereal *rcond, integer *ithresh, doublereal *rthresh,
+ doublereal *dz_ub__, logical *ignore_cwise__, integer *info);
+
+doublereal dla_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
+ ncols, doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb);
+
+/* Subroutine */ int dla_geamv__(integer *trans, integer *m, integer *n,
+ doublereal *alpha, doublereal *a, integer *lda, doublereal *x,
+ integer *incx, doublereal *beta, doublereal *y, integer *incy);
+
+doublereal dla_gercond__(char *trans, integer *n, doublereal *a, integer *lda,
+ doublereal *af, integer *ldaf, integer *ipiv, integer *cmode,
+ doublereal *c__, integer *info, doublereal *work, integer *iwork,
+ ftnlen trans_len);
+
+/* Subroutine */ int dla_gerfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *nrhs, doublereal *a, integer *lda,
+ doublereal *af, integer *ldaf, integer *ipiv, logical *colequ,
+ doublereal *c__, doublereal *b, integer *ldb, doublereal *y, integer *
+ ldy, doublereal *berr_out__, integer *n_norms__, doublereal *errs_n__,
+ doublereal *errs_c__, doublereal *res, doublereal *ayb, doublereal *
+ dy, doublereal *y_tail__, doublereal *rcond, integer *ithresh,
+ doublereal *rthresh, doublereal *dz_ub__, logical *ignore_cwise__,
+ integer *info);
+
+/* Subroutine */ int dla_lin_berr__(integer *n, integer *nz, integer *nrhs,
+ doublereal *res, doublereal *ayb, doublereal *berr);
+
+doublereal dla_porcond__(char *uplo, integer *n, doublereal *a, integer *lda,
+ doublereal *af, integer *ldaf, integer *cmode, doublereal *c__,
+ integer *info, doublereal *work, integer *iwork, ftnlen uplo_len);
+
+/* Subroutine */ int dla_porfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *
+ af, integer *ldaf, logical *colequ, doublereal *c__, doublereal *b,
+ integer *ldb, doublereal *y, integer *ldy, doublereal *berr_out__,
+ integer *n_norms__, doublereal *errs_n__, doublereal *errs_c__,
+ doublereal *res, doublereal *ayb, doublereal *dy, doublereal *
+ y_tail__, doublereal *rcond, integer *ithresh, doublereal *rthresh,
+ doublereal *dz_ub__, logical *ignore_cwise__, integer *info, ftnlen
+ uplo_len);
+
+doublereal dla_porpvgrw__(char *uplo, integer *ncols, doublereal *a, integer *
+ lda, doublereal *af, integer *ldaf, doublereal *work, ftnlen uplo_len);
+
+doublereal dla_rpvgrw__(integer *n, integer *ncols, doublereal *a, integer *
+ lda, doublereal *af, integer *ldaf);
+
+/* Subroutine */ int dla_syamv__(integer *uplo, integer *n, doublereal *alpha,
+ doublereal *a, integer *lda, doublereal *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy);
+
+doublereal dla_syrcond__(char *uplo, integer *n, doublereal *a, integer *lda,
+ doublereal *af, integer *ldaf, integer *ipiv, integer *cmode,
+ doublereal *c__, integer *info, doublereal *work, integer *iwork,
+ ftnlen uplo_len);
+
+/* Subroutine */ int dla_syrfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, doublereal *a, integer *lda, doublereal *
+ af, integer *ldaf, integer *ipiv, logical *colequ, doublereal *c__,
+ doublereal *b, integer *ldb, doublereal *y, integer *ldy, doublereal *
+ berr_out__, integer *n_norms__, doublereal *errs_n__, doublereal *
+ errs_c__, doublereal *res, doublereal *ayb, doublereal *dy,
+ doublereal *y_tail__, doublereal *rcond, integer *ithresh, doublereal
+ *rthresh, doublereal *dz_ub__, logical *ignore_cwise__, integer *info,
+ ftnlen uplo_len);
+
+doublereal dla_syrpvgrw__(char *uplo, integer *n, integer *info, doublereal *
+ a, integer *lda, doublereal *af, integer *ldaf, integer *ipiv,
+ doublereal *work, ftnlen uplo_len);
+
+/* Subroutine */ int dla_wwaddw__(integer *n, doublereal *x, doublereal *y,
+ doublereal *w);
+
+/* Subroutine */ int dlabad_(doublereal *small, doublereal *large);
+
+/* Subroutine */ int dlabrd_(integer *m, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *d__, doublereal *e, doublereal *tauq,
+ doublereal *taup, doublereal *x, integer *ldx, doublereal *y, integer
+ *ldy);
+
+/* Subroutine */ int dlacn2_(integer *n, doublereal *v, doublereal *x,
+ integer *isgn, doublereal *est, integer *kase, integer *isave);
+
+/* Subroutine */ int dlacon_(integer *n, doublereal *v, doublereal *x,
+ integer *isgn, doublereal *est, integer *kase);
+
+/* Subroutine */ int dlacpy_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublereal *b, integer *ldb);
+
+/* Subroutine */ int dladiv_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *p, doublereal *q);
+
+/* Subroutine */ int dlae2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2);
+
+/* Subroutine */ int dlaebz_(integer *ijob, integer *nitmax, integer *n,
+ integer *mmax, integer *minp, integer *nbmin, doublereal *abstol,
+ doublereal *reltol, doublereal *pivmin, doublereal *d__, doublereal *
+ e, doublereal *e2, integer *nval, doublereal *ab, doublereal *c__,
+ integer *mout, integer *nab, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlaed0_(integer *icompq, integer *qsiz, integer *n,
+ doublereal *d__, doublereal *e, doublereal *q, integer *ldq,
+ doublereal *qstore, integer *ldqs, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlaed1_(integer *n, doublereal *d__, doublereal *q,
+ integer *ldq, integer *indxq, doublereal *rho, integer *cutpnt,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlaed2_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, integer *indxq, doublereal *rho,
+ doublereal *z__, doublereal *dlamda, doublereal *w, doublereal *q2,
+ integer *indx, integer *indxc, integer *indxp, integer *coltyp,
+ integer *info);
+
+/* Subroutine */ int dlaed3_(integer *k, integer *n, integer *n1, doublereal *
+ d__, doublereal *q, integer *ldq, doublereal *rho, doublereal *dlamda,
+ doublereal *q2, integer *indx, integer *ctot, doublereal *w,
+ doublereal *s, integer *info);
+
+/* Subroutine */ int dlaed4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *dlam,
+ integer *info);
+
+/* Subroutine */ int dlaed5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dlam);
+
+/* Subroutine */ int dlaed6_(integer *kniter, logical *orgati, doublereal *
+ rho, doublereal *d__, doublereal *z__, doublereal *finit, doublereal *
+ tau, integer *info);
+
+/* Subroutine */ int dlaed7_(integer *icompq, integer *n, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublereal *q, integer *ldq, integer *indxq, doublereal *rho, integer
+ *cutpnt, doublereal *qstore, integer *qptr, integer *prmptr, integer *
+ perm, integer *givptr, integer *givcol, doublereal *givnum,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlaed8_(integer *icompq, integer *k, integer *n, integer
+ *qsiz, doublereal *d__, doublereal *q, integer *ldq, integer *indxq,
+ doublereal *rho, integer *cutpnt, doublereal *z__, doublereal *dlamda,
+ doublereal *q2, integer *ldq2, doublereal *w, integer *perm, integer
+ *givptr, integer *givcol, doublereal *givnum, integer *indxp, integer
+ *indx, integer *info);
+
+/* Subroutine */ int dlaed9_(integer *k, integer *kstart, integer *kstop,
+ integer *n, doublereal *d__, doublereal *q, integer *ldq, doublereal *
+ rho, doublereal *dlamda, doublereal *w, doublereal *s, integer *lds,
+ integer *info);
+
+/* Subroutine */ int dlaeda_(integer *n, integer *tlvls, integer *curlvl,
+ integer *curpbm, integer *prmptr, integer *perm, integer *givptr,
+ integer *givcol, doublereal *givnum, doublereal *q, integer *qptr,
+ doublereal *z__, doublereal *ztemp, integer *info);
+
+/* Subroutine */ int dlaein_(logical *rightv, logical *noinit, integer *n,
+ doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi,
+ doublereal *vr, doublereal *vi, doublereal *b, integer *ldb,
+ doublereal *work, doublereal *eps3, doublereal *smlnum, doublereal *
+ bignum, integer *info);
+
+/* Subroutine */ int dlaev2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *rt1, doublereal *rt2, doublereal *cs1, doublereal *sn1);
+
+/* Subroutine */ int dlaexc_(logical *wantq, integer *n, doublereal *t,
+ integer *ldt, doublereal *q, integer *ldq, integer *j1, integer *n1,
+ integer *n2, doublereal *work, integer *info);
+
+/* Subroutine */ int dlag2_(doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *safmin, doublereal *scale1, doublereal *
+ scale2, doublereal *wr1, doublereal *wr2, doublereal *wi);
+
+/* Subroutine */ int dlag2s_(integer *m, integer *n, doublereal *a, integer *
+ lda, real *sa, integer *ldsa, integer *info);
+
+/* Subroutine */ int dlags2_(logical *upper, doublereal *a1, doublereal *a2,
+ doublereal *a3, doublereal *b1, doublereal *b2, doublereal *b3,
+ doublereal *csu, doublereal *snu, doublereal *csv, doublereal *snv,
+ doublereal *csq, doublereal *snq);
+
+/* Subroutine */ int dlagtf_(integer *n, doublereal *a, doublereal *lambda,
+ doublereal *b, doublereal *c__, doublereal *tol, doublereal *d__,
+ integer *in, integer *info);
+
+/* Subroutine */ int dlagtm_(char *trans, integer *n, integer *nrhs,
+ doublereal *alpha, doublereal *dl, doublereal *d__, doublereal *du,
+ doublereal *x, integer *ldx, doublereal *beta, doublereal *b, integer
+ *ldb);
+
+/* Subroutine */ int dlagts_(integer *job, integer *n, doublereal *a,
+ doublereal *b, doublereal *c__, doublereal *d__, integer *in,
+ doublereal *y, doublereal *tol, integer *info);
+
+/* Subroutine */ int dlagv2_(doublereal *a, integer *lda, doublereal *b,
+ integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *csl, doublereal *snl, doublereal *csr, doublereal *
+ snr);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlahr2_(integer *n, integer *k, integer *nb, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *t, integer *ldt,
+ doublereal *y, integer *ldy);
+
+/* Subroutine */ int dlahrd_(integer *n, integer *k, integer *nb, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *t, integer *ldt,
+ doublereal *y, integer *ldy);
+
+/* Subroutine */ int dlaic1_(integer *job, integer *j, doublereal *x,
+ doublereal *sest, doublereal *w, doublereal *gamma, doublereal *
+ sestpr, doublereal *s, doublereal *c__);
+
+logical dlaisnan_(doublereal *din1, doublereal *din2);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublereal *b, integer *ldb, doublereal
+ *bx, integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, doublereal *givnum, integer *ldgnum, doublereal *
+ poles, doublereal *difl, doublereal *difr, doublereal *z__, integer *
+ k, doublereal *c__, doublereal *s, doublereal *work, integer *info);
+
+/* Subroutine */ int dlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublereal *b, integer *ldb, doublereal *bx, integer *
+ ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *k,
+ doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, doublereal *d__, doublereal *e, doublereal *b, integer *ldb,
+ doublereal *rcond, integer *rank, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlamrg_(integer *n1, integer *n2, doublereal *a, integer
+ *dtrd1, integer *dtrd2, integer *index);
+
+integer dlaneg_(integer *n, doublereal *d__, doublereal *lld, doublereal *
+ sigma, doublereal *pivmin, integer *r__);
+
+doublereal dlangb_(char *norm, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *work);
+
+doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer
+ *lda, doublereal *work);
+
+doublereal dlangt_(char *norm, integer *n, doublereal *dl, doublereal *d__,
+ doublereal *du);
+
+doublereal dlanhs_(char *norm, integer *n, doublereal *a, integer *lda,
+ doublereal *work);
+
+doublereal dlansb_(char *norm, char *uplo, integer *n, integer *k, doublereal
+ *ab, integer *ldab, doublereal *work);
+
+doublereal dlansf_(char *norm, char *transr, char *uplo, integer *n,
+ doublereal *a, doublereal *work);
+
+doublereal dlansp_(char *norm, char *uplo, integer *n, doublereal *ap,
+ doublereal *work);
+
+doublereal dlanst_(char *norm, integer *n, doublereal *d__, doublereal *e);
+
+doublereal dlansy_(char *norm, char *uplo, integer *n, doublereal *a, integer
+ *lda, doublereal *work);
+
+doublereal dlantb_(char *norm, char *uplo, char *diag, integer *n, integer *k,
+ doublereal *ab, integer *ldab, doublereal *work);
+
+doublereal dlantp_(char *norm, char *uplo, char *diag, integer *n, doublereal
+ *ap, doublereal *work);
+
+doublereal dlantr_(char *norm, char *uplo, char *diag, integer *m, integer *n,
+ doublereal *a, integer *lda, doublereal *work);
+
+/* Subroutine */ int dlanv2_(doublereal *a, doublereal *b, doublereal *c__,
+ doublereal *d__, doublereal *rt1r, doublereal *rt1i, doublereal *rt2r,
+ doublereal *rt2i, doublereal *cs, doublereal *sn);
+
+/* Subroutine */ int dlapll_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *ssmin);
+
+/* Subroutine */ int dlapmt_(logical *forwrd, integer *m, integer *n,
+ doublereal *x, integer *ldx, integer *k);
+
+doublereal dlapy2_(doublereal *x, doublereal *y);
+
+doublereal dlapy3_(doublereal *x, doublereal *y, doublereal *z__);
+
+/* Subroutine */ int dlaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ doublereal *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqge_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *r__, doublereal *c__, doublereal *rowcnd, doublereal
+ *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqp2_(integer *m, integer *n, integer *offset,
+ doublereal *a, integer *lda, integer *jpvt, doublereal *tau,
+ doublereal *vn1, doublereal *vn2, doublereal *work);
+
+/* Subroutine */ int dlaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, doublereal *a, integer *lda, integer *jpvt,
+ doublereal *tau, doublereal *vn1, doublereal *vn2, doublereal *auxv,
+ doublereal *f, integer *ldf);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlaqr1_(integer *n, doublereal *h__, integer *ldh,
+ doublereal *sr1, doublereal *si1, doublereal *sr2, doublereal *si2,
+ doublereal *v);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlaqsb_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int dlaqsp_(char *uplo, integer *n, doublereal *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqsy_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int dlaqtr_(logical *ltran, logical *lreal, integer *n,
+ doublereal *t, integer *ldt, doublereal *b, doublereal *w, doublereal
+ *scale, doublereal *x, doublereal *work, integer *info);
+
+/* Subroutine */ int dlar1v_(integer *n, integer *b1, integer *bn, doublereal
+ *lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
+ lld, doublereal *pivmin, doublereal *gaptol, doublereal *z__, logical
+ *wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma,
+ integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid,
+ doublereal *rqcorr, doublereal *work);
+
+/* Subroutine */ int dlar2v_(integer *n, doublereal *x, doublereal *y,
+ doublereal *z__, integer *incx, doublereal *c__, doublereal *s,
+ integer *incc);
+
+/* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
+ integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
+ doublereal *work);
+
+/* Subroutine */ int dlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublereal *v, integer *
+ ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc,
+ doublereal *work, integer *ldwork);
+
+/* Subroutine */ int dlarfg_(integer *n, doublereal *alpha, doublereal *x,
+ integer *incx, doublereal *tau);
+
+/* Subroutine */ int dlarfp_(integer *n, doublereal *alpha, doublereal *x,
+ integer *incx, doublereal *tau);
+
+/* Subroutine */ int dlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt);
+
+/* Subroutine */ int dlarfx_(char *side, integer *m, integer *n, doublereal *
+ v, doublereal *tau, doublereal *c__, integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlargv_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *c__, integer *incc);
+
+/* Subroutine */ int dlarnv_(integer *idist, integer *iseed, integer *n,
+ doublereal *x);
+
+/* Subroutine */ int dlarra_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *e2, doublereal *spltol, doublereal *tnrm, integer *nsplit,
+ integer *isplit, integer *info);
+
+/* Subroutine */ int dlarrb_(integer *n, doublereal *d__, doublereal *lld,
+ integer *ifirst, integer *ilast, doublereal *rtol1, doublereal *rtol2,
+ integer *offset, doublereal *w, doublereal *wgap, doublereal *werr,
+ doublereal *work, integer *iwork, doublereal *pivmin, doublereal *
+ spdiam, integer *twist, integer *info);
+
+/* Subroutine */ int dlarrc_(char *jobt, integer *n, doublereal *vl,
+ doublereal *vu, doublereal *d__, doublereal *e, doublereal *pivmin,
+ integer *eigcnt, integer *lcnt, integer *rcnt, integer *info);
+
+/* Subroutine */ int dlarrd_(char *range, char *order, integer *n, doublereal
+ *vl, doublereal *vu, integer *il, integer *iu, doublereal *gers,
+ doublereal *reltol, doublereal *d__, doublereal *e, doublereal *e2,
+ doublereal *pivmin, integer *nsplit, integer *isplit, integer *m,
+ doublereal *w, doublereal *werr, doublereal *wl, doublereal *wu,
+ integer *iblock, integer *indexw, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dlarre_(char *range, integer *n, doublereal *vl,
+ doublereal *vu, integer *il, integer *iu, doublereal *d__, doublereal
+ *e, doublereal *e2, doublereal *rtol1, doublereal *rtol2, doublereal *
+ spltol, integer *nsplit, integer *isplit, integer *m, doublereal *w,
+ doublereal *werr, doublereal *wgap, integer *iblock, integer *indexw,
+ doublereal *gers, doublereal *pivmin, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dlarrf_(integer *n, doublereal *d__, doublereal *l,
+ doublereal *ld, integer *clstrt, integer *clend, doublereal *w,
+ doublereal *wgap, doublereal *werr, doublereal *spdiam, doublereal *
+ clgapl, doublereal *clgapr, doublereal *pivmin, doublereal *sigma,
+ doublereal *dplus, doublereal *lplus, doublereal *work, integer *info);
+
+/* Subroutine */ int dlarrj_(integer *n, doublereal *d__, doublereal *e2,
+ integer *ifirst, integer *ilast, doublereal *rtol, integer *offset,
+ doublereal *w, doublereal *werr, doublereal *work, integer *iwork,
+ doublereal *pivmin, doublereal *spdiam, integer *info);
+
+/* Subroutine */ int dlarrk_(integer *n, integer *iw, doublereal *gl,
+ doublereal *gu, doublereal *d__, doublereal *e2, doublereal *pivmin,
+ doublereal *reltol, doublereal *w, doublereal *werr, integer *info);
+
+/* Subroutine */ int dlarrr_(integer *n, doublereal *d__, doublereal *e,
+ integer *info);
+
+/* Subroutine */ int dlarrv_(integer *n, doublereal *vl, doublereal *vu,
+ doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit,
+ integer *m, integer *dol, integer *dou, doublereal *minrgp,
+ doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr,
+ doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dlarscl2_(integer *m, integer *n, doublereal *d__,
+ doublereal *x, integer *ldx);
+
+/* Subroutine */ int dlartg_(doublereal *f, doublereal *g, doublereal *cs,
+ doublereal *sn, doublereal *r__);
+
+/* Subroutine */ int dlartv_(integer *n, doublereal *x, integer *incx,
+ doublereal *y, integer *incy, doublereal *c__, doublereal *s, integer
+ *incc);
+
+/* Subroutine */ int dlaruv_(integer *iseed, integer *n, doublereal *x);
+
+/* Subroutine */ int dlarz_(char *side, integer *m, integer *n, integer *l,
+ doublereal *v, integer *incv, doublereal *tau, doublereal *c__,
+ integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, doublereal *v,
+ integer *ldv, doublereal *t, integer *ldt, doublereal *c__, integer *
+ ldc, doublereal *work, integer *ldwork);
+
+/* Subroutine */ int dlarzt_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt);
+
+/* Subroutine */ int dlas2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax);
+
+/* Subroutine */ int dlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublereal *a, integer *lda, integer *info);
+
+/* Subroutine */ int dlascl2_(integer *m, integer *n, doublereal *d__,
+ doublereal *x, integer *ldx);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlasd4_(integer *n, integer *i__, doublereal *d__,
+ doublereal *z__, doublereal *delta, doublereal *rho, doublereal *
+ sigma, doublereal *work, integer *info);
+
+/* Subroutine */ int dlasd5_(integer *i__, doublereal *d__, doublereal *z__,
+ doublereal *delta, doublereal *rho, doublereal *dsigma, doublereal *
+ work);
+
+/* Subroutine */ int dlasd6_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, doublereal *d__, doublereal *vf, doublereal *vl,
+ doublereal *alpha, doublereal *beta, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *poles, doublereal *difl, doublereal *
+ difr, doublereal *z__, integer *k, doublereal *c__, doublereal *s,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlasd7_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *k, doublereal *d__, doublereal *z__,
+ doublereal *zw, doublereal *vf, doublereal *vfw, doublereal *vl,
+ doublereal *vlw, doublereal *alpha, doublereal *beta, doublereal *
+ dsigma, integer *idx, integer *idxp, integer *idxq, integer *perm,
+ integer *givptr, integer *givcol, integer *ldgcol, doublereal *givnum,
+ integer *ldgnum, doublereal *c__, doublereal *s, integer *info);
+
+/* Subroutine */ int dlasd8_(integer *icompq, integer *k, doublereal *d__,
+ doublereal *z__, doublereal *vf, doublereal *vl, doublereal *difl,
+ doublereal *difr, integer *lddifr, doublereal *dsigma, doublereal *
+ work, integer *info);
+
+/* Subroutine */ int dlasda_(integer *icompq, integer *smlsiz, integer *n,
+ integer *sqre, doublereal *d__, doublereal *e, doublereal *u, integer
+ *ldu, doublereal *vt, integer *k, doublereal *difl, doublereal *difr,
+ doublereal *z__, doublereal *poles, integer *givptr, integer *givcol,
+ integer *ldgcol, integer *perm, doublereal *givnum, doublereal *c__,
+ doublereal *s, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dlasdq_(char *uplo, integer *sqre, integer *n, integer *
+ ncvt, integer *nru, integer *ncc, doublereal *d__, doublereal *e,
+ doublereal *vt, integer *ldvt, doublereal *u, integer *ldu,
+ doublereal *c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dlasdt_(integer *n, integer *lvl, integer *nd, integer *
+ inode, integer *ndiml, integer *ndimr, integer *msub);
+
+/* Subroutine */ int dlaset_(char *uplo, integer *m, integer *n, doublereal *
+ alpha, doublereal *beta, doublereal *a, integer *lda);
+
+/* Subroutine */ int dlasq1_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dlasq2_(integer *n, doublereal *z__, integer *info);
+
+/* Subroutine */ int dlasq3_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *sigma, doublereal *desig,
+ doublereal *qmax, integer *nfail, integer *iter, integer *ndiv,
+ logical *ieee, integer *ttype, doublereal *dmin1, doublereal *dmin2,
+ doublereal *dn, doublereal *dn1, doublereal *dn2, doublereal *g,
+ doublereal *tau);
+
+/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
+ doublereal *tau, integer *ttype, doublereal *g);
+
+/* Subroutine */ int dlasq5_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *tau, doublereal *dmin__, doublereal *dmin1,
+ doublereal *dmin2, doublereal *dn, doublereal *dnm1, doublereal *dnm2,
+ logical *ieee);
+
+/* Subroutine */ int dlasq6_(integer *i0, integer *n0, doublereal *z__,
+ integer *pp, doublereal *dmin__, doublereal *dmin1, doublereal *dmin2,
+ doublereal *dn, doublereal *dnm1, doublereal *dnm2);
+
+/* Subroutine */ int dlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublereal *a, integer *
+ lda);
+
+/* Subroutine */ int dlasrt_(char *id, integer *n, doublereal *d__, integer *
+ info);
+
+/* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
+ doublereal *scale, doublereal *sumsq);
+
+/* Subroutine */ int dlasv2_(doublereal *f, doublereal *g, doublereal *h__,
+ doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *
+ csr, doublereal *snl, doublereal *csl);
+
+/* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
+ *k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *w, integer *
+ ldw, integer *info);
+
+/* Subroutine */ int dlat2s_(char *uplo, integer *n, doublereal *a, integer *
+ lda, real *sa, integer *ldsa, integer *info);
+
+/* Subroutine */ int dlatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, doublereal *ab, integer *ldab,
+ doublereal *x, doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatdf_(integer *ijob, integer *n, doublereal *z__,
+ integer *ldz, doublereal *rhs, doublereal *rdsum, doublereal *rdscal,
+ integer *ipiv, integer *jpiv);
+
+/* Subroutine */ int dlatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublereal *ap, doublereal *x, doublereal *scale,
+ doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatrd_(char *uplo, integer *n, integer *nb, doublereal *
+ a, integer *lda, doublereal *e, doublereal *tau, doublereal *w,
+ integer *ldw);
+
+/* Subroutine */ int dlatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublereal *a, integer *lda, doublereal *x,
+ doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int dlatrz_(integer *m, integer *n, integer *l, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work);
+
+/* Subroutine */ int dlatzm_(char *side, integer *m, integer *n, doublereal *
+ v, integer *incv, doublereal *tau, doublereal *c1, doublereal *c2,
+ integer *ldc, doublereal *work);
+
+/* Subroutine */ int dlauu2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dlauum_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dopgtr_(char *uplo, integer *n, doublereal *ap,
+ doublereal *tau, doublereal *q, integer *ldq, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dopmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublereal *ap, doublereal *tau, doublereal *c__, integer
+ *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dorg2l_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorg2r_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorgbr_(char *vect, integer *m, integer *n, integer *k,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dorghr_(integer *n, integer *ilo, integer *ihi,
+ doublereal *a, integer *lda, doublereal *tau, doublereal *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int dorgl2_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorglq_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgql_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgqr_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgr2_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *info);
+
+/* Subroutine */ int dorgrq_(integer *m, integer *n, integer *k, doublereal *
+ a, integer *lda, doublereal *tau, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dorgtr_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dorm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ 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);
+
+/* Subroutine */ int dorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *info);
+
+/* Subroutine */ int dormrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dormrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublereal *a, integer *lda, doublereal *tau,
+ doublereal *c__, integer *ldc, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dormtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dpbcon_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *anorm, doublereal *rcond, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpbequ_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, doublereal *s, doublereal *scond, doublereal *amax,
+ integer *info);
+
+/* Subroutine */ int dpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *afb, integer *ldafb,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dpbstf_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int dpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, doublereal *ab, integer *ldab, doublereal *afb,
+ integer *ldafb, char *equed, doublereal *s, doublereal *b, integer *
+ ldb, doublereal *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpbtf2_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbtrf_(char *uplo, integer *n, integer *kd, doublereal *
+ ab, integer *ldab, integer *info);
+
+/* Subroutine */ int dpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublereal *ab, integer *ldab, doublereal *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int dpftrf_(char *transr, char *uplo, integer *n, doublereal
+ *a, integer *info);
+
+/* Subroutine */ int dpftri_(char *transr, char *uplo, integer *n, doublereal
+ *a, integer *info);
+
+/* Subroutine */ int dpftrs_(char *transr, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dpocon_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dpoequ_(integer *n, doublereal *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int dpoequb_(integer *n, doublereal *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int dporfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ ferr, doublereal *berr, doublereal *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int dporfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ doublereal *s, doublereal *b, integer *ldb, doublereal *x, integer *
+ ldx, doublereal *rcond, doublereal *berr, integer *n_err_bnds__,
+ doublereal *err_bnds_norm__, doublereal *err_bnds_comp__, integer *
+ nparams, doublereal *params, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dposv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *a, integer *lda, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ char *equed, doublereal *s, doublereal *b, integer *ldb, doublereal *
+ x, integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *
+ berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dposvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ char *equed, doublereal *s, doublereal *b, integer *ldb, doublereal *
+ x, integer *ldx, doublereal *rcond, doublereal *rpvgrw, doublereal *
+ berr, integer *n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dpotf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotri_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *info);
+
+/* Subroutine */ int dpotrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dppcon_(char *uplo, integer *n, doublereal *ap,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dppequ_(char *uplo, integer *n, doublereal *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int dpprfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *afp, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dppsv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *ap, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *ap, doublereal *afp, char *equed, doublereal *s,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dpptrf_(char *uplo, integer *n, doublereal *ap, integer *
+ info);
+
+/* Subroutine */ int dpptri_(char *uplo, integer *n, doublereal *ap, integer *
+ info);
+
+/* Subroutine */ int dpptrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dpstf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *piv, integer *rank, doublereal *tol, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dpstrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *piv, integer *rank, doublereal *tol, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dptcon_(integer *n, doublereal *d__, doublereal *e,
+ doublereal *anorm, doublereal *rcond, doublereal *work, integer *info);
+
+/* Subroutine */ int dpteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dptrfs_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *df, doublereal *ef, doublereal *b, integer
+ *ldb, doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dptsv_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dptsvx_(char *fact, integer *n, integer *nrhs,
+ doublereal *d__, doublereal *e, doublereal *df, doublereal *ef,
+ doublereal *b, integer *ldb, doublereal *x, integer *ldx, doublereal *
+ rcond, doublereal *ferr, doublereal *berr, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int dpttrf_(integer *n, doublereal *d__, doublereal *e,
+ integer *info);
+
+/* Subroutine */ int dpttrs_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dptts2_(integer *n, integer *nrhs, doublereal *d__,
+ doublereal *e, doublereal *b, integer *ldb);
+
+/* Subroutine */ int drscl_(integer *n, doublereal *sa, doublereal *sx,
+ integer *incx);
+
+/* Subroutine */ int dsbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *info);
+
+/* Subroutine */ int dsbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dsbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, doublereal *ab, integer *ldab, doublereal *q, integer *
+ ldq, doublereal *vl, doublereal *vu, integer *il, integer *iu,
+ doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *iwork, integer *ifail,
+ integer *info);
+
+/* Subroutine */ int dsbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *x, integer *ldx, doublereal *work, integer *info);
+
+/* Subroutine */ int dsbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dsbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublereal *ab, integer *ldab, doublereal *bb, integer *
+ ldbb, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, doublereal *ab, integer *ldab, doublereal *
+ bb, integer *ldbb, doublereal *q, integer *ldq, doublereal *vl,
+ doublereal *vu, integer *il, integer *iu, doublereal *abstol, integer
+ *m, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ doublereal *ab, integer *ldab, doublereal *d__, doublereal *e,
+ doublereal *q, integer *ldq, doublereal *work, integer *info);
+
+/* Subroutine */ int dsfrk_(char *transr, char *uplo, char *trans, integer *n,
+ integer *k, doublereal *alpha, doublereal *a, integer *lda,
+ doublereal *beta, doublereal *c__);
+
+/* Subroutine */ int dsgesv_(integer *n, integer *nrhs, doublereal *a,
+ integer *lda, integer *ipiv, doublereal *b, integer *ldb, doublereal *
+ x, integer *ldx, doublereal *work, real *swork, integer *iter,
+ integer *info);
+
+/* Subroutine */ int dspcon_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, doublereal *anorm, doublereal *rcond, doublereal *work, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int dspev_(char *jobz, char *uplo, integer *n, doublereal *
+ ap, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dspevd_(char *jobz, char *uplo, integer *n, doublereal *
+ ap, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dspevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *ap, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *iwork, integer *ifail,
+ integer *info);
+
+/* Subroutine */ int dspgst_(integer *itype, char *uplo, integer *n,
+ doublereal *ap, doublereal *bp, integer *info);
+
+/* Subroutine */ int dspgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *ap, doublereal *bp, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *info);
+
+/* Subroutine */ int dspgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *ap, doublereal *bp, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dspgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublereal *ap, doublereal *bp, doublereal *vl,
+ doublereal *vu, integer *il, integer *iu, doublereal *abstol, integer
+ *m, doublereal *w, doublereal *z__, integer *ldz, doublereal *work,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsposv_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ x, integer *ldx, doublereal *work, real *swork, integer *iter,
+ integer *info);
+
+/* Subroutine */ int dsprfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, doublereal *afp, integer *ipiv, doublereal *b,
+ integer *ldb, doublereal *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dspsv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *ap, integer *ipiv, doublereal *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *ap, doublereal *afp, integer *ipiv, doublereal *b,
+ integer *ldb, doublereal *x, integer *ldx, doublereal *rcond,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dsptrd_(char *uplo, integer *n, doublereal *ap,
+ doublereal *d__, doublereal *e, doublereal *tau, integer *info);
+
+/* Subroutine */ int dsptrf_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, integer *info);
+
+/* Subroutine */ int dsptri_(char *uplo, integer *n, doublereal *ap, integer *
+ ipiv, doublereal *work, integer *info);
+
+/* Subroutine */ int dsptrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *ap, integer *ipiv, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dstebz_(char *range, char *order, integer *n, doublereal
+ *vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol,
+ doublereal *d__, doublereal *e, integer *m, integer *nsplit,
+ doublereal *w, integer *iblock, integer *isplit, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstegr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstein_(integer *n, doublereal *d__, doublereal *e,
+ integer *m, doublereal *w, integer *iblock, integer *isplit,
+ doublereal *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dstemr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, integer *m, doublereal *w, doublereal *z__, integer *ldz,
+ integer *nzc, integer *isuppz, logical *tryrac, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dsterf_(integer *n, doublereal *d__, doublereal *e,
+ integer *info);
+
+/* Subroutine */ int dstev_(char *jobz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int dstevd_(char *jobz, integer *n, doublereal *d__,
+ doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstevr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dstevx_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dsycon_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *anorm, doublereal *rcond, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dsyequb_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *s, doublereal *scond, doublereal *amax, doublereal *
+ work, integer *info);
+
+/* Subroutine */ int dsyev_(char *jobz, char *uplo, integer *n, doublereal *a,
+ integer *lda, doublereal *w, doublereal *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int dsyevd_(char *jobz, char *uplo, integer *n, doublereal *
+ a, integer *lda, doublereal *w, doublereal *work, integer *lwork,
+ integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsyevr_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer *
+ il, integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int dsyevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *vl, doublereal *vu, integer *
+ il, integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublereal *z__, integer *ldz, doublereal *work, integer *lwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int dsygs2_(integer *itype, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dsygst_(integer *itype, char *uplo, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dsygv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *w, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsygvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *w, doublereal *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int dsygvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublereal *a, integer *lda, doublereal *b, integer
+ *ldb, doublereal *vl, doublereal *vu, integer *il, integer *iu,
+ doublereal *abstol, integer *m, doublereal *w, doublereal *z__,
+ integer *ldz, doublereal *work, integer *lwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int dsyrfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, doublereal *af, integer *ldaf, integer *
+ ipiv, doublereal *b, integer *ldb, doublereal *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dsyrfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, doublereal *s, doublereal *b, integer *ldb, doublereal
+ *x, integer *ldx, doublereal *rcond, doublereal *berr, integer *
+ n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublereal *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int dsysv_(char *uplo, integer *n, integer *nrhs, doublereal
+ *a, integer *lda, integer *ipiv, doublereal *b, integer *ldb,
+ doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, doublereal *b, integer *ldb, doublereal *x, integer *
+ ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dsysvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *af, integer *ldaf,
+ integer *ipiv, char *equed, doublereal *s, doublereal *b, integer *
+ ldb, doublereal *x, integer *ldx, doublereal *rcond, doublereal *
+ rpvgrw, doublereal *berr, integer *n_err_bnds__, doublereal *
+ err_bnds_norm__, doublereal *err_bnds_comp__, integer *nparams,
+ doublereal *params, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dsytd2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, integer *info);
+
+/* Subroutine */ int dsytf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int dsytrd_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *d__, doublereal *e, doublereal *tau, doublereal *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsytrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dsytri_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *info);
+
+/* Subroutine */ int dsytrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dtbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, doublereal *ab, integer *ldab, doublereal *rcond,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublereal *ab, integer *ldab, doublereal
+ *b, integer *ldb, doublereal *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublereal *ab, integer *ldab, doublereal
+ *b, integer *ldb, integer *info);
+
+/* Subroutine */ int dtfsm_(char *transr, char *side, char *uplo, char *trans,
+ char *diag, integer *m, integer *n, doublereal *alpha, doublereal *a,
+ doublereal *b, integer *ldb);
+
+/* Subroutine */ int dtftri_(char *transr, char *uplo, char *diag, integer *n,
+ doublereal *a, integer *info);
+
+/* Subroutine */ int dtfttp_(char *transr, char *uplo, integer *n, doublereal
+ *arf, doublereal *ap, integer *info);
+
+/* Subroutine */ int dtfttr_(char *transr, char *uplo, integer *n, doublereal
+ *arf, doublereal *a, integer *lda, integer *info);
+
+/* Subroutine */ int dtgevc_(char *side, char *howmny, logical *select,
+ integer *n, doublereal *s, integer *lds, doublereal *p, integer *ldp,
+ doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr, integer
+ *mm, integer *m, doublereal *work, integer *info);
+
+/* Subroutine */ int dtgex2_(logical *wantq, logical *wantz, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ q, integer *ldq, doublereal *z__, integer *ldz, integer *j1, integer *
+ n1, integer *n2, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dtgexc_(logical *wantq, logical *wantz, integer *n,
+ doublereal *a, integer *lda, doublereal *b, integer *ldb, doublereal *
+ q, integer *ldq, doublereal *z__, integer *ldz, integer *ifst,
+ integer *ilst, doublereal *work, integer *lwork, integer *info);
+
+/* Subroutine */ int dtgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, doublereal *a, integer *lda, doublereal *
+ b, integer *ldb, doublereal *alphar, doublereal *alphai, doublereal *
+ beta, doublereal *q, integer *ldq, doublereal *z__, integer *ldz,
+ integer *m, doublereal *pl, doublereal *pr, doublereal *dif,
+ doublereal *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int dtgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, doublereal *a,
+ integer *lda, doublereal *b, integer *ldb, doublereal *tola,
+ doublereal *tolb, doublereal *alpha, doublereal *beta, doublereal *u,
+ integer *ldu, doublereal *v, integer *ldv, doublereal *q, integer *
+ ldq, doublereal *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int dtgsna_(char *job, char *howmny, logical *select,
+ integer *n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *vl, integer *ldvl, doublereal *vr, integer *ldvr,
+ doublereal *s, doublereal *dif, integer *mm, integer *m, doublereal *
+ work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int dtgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *c__, integer *ldc, doublereal *d__, integer *ldd,
+ doublereal *e, integer *lde, doublereal *f, integer *ldf, doublereal *
+ scale, doublereal *rdsum, doublereal *rdscal, integer *iwork, integer
+ *pq, integer *info);
+
+/* Subroutine */ int dtgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *c__, integer *ldc, doublereal *d__, integer *ldd,
+ doublereal *e, integer *lde, doublereal *f, integer *ldf, doublereal *
+ scale, doublereal *dif, doublereal *work, integer *lwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dtpcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublereal *ap, doublereal *rcond, doublereal *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int dtprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *ap, doublereal *b, integer *ldb,
+ doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtptri_(char *uplo, char *diag, integer *n, doublereal *
+ ap, integer *info);
+
+/* Subroutine */ int dtptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *ap, doublereal *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int dtpttf_(char *transr, char *uplo, integer *n, doublereal
+ *ap, doublereal *arf, integer *info);
+
+/* Subroutine */ int dtpttr_(char *uplo, integer *n, doublereal *ap,
+ doublereal *a, integer *lda, integer *info);
+
+/* Subroutine */ int dtrcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublereal *a, integer *lda, doublereal *rcond, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int dtrevc_(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 *info);
+
+/* Subroutine */ int dtrexc_(char *compq, integer *n, doublereal *t, integer *
+ ldt, doublereal *q, integer *ldq, integer *ifst, integer *ilst,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int dtrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, doublereal *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublereal *work, integer *iwork, integer *info);
+
+/* Subroutine */ int dtrsen_(char *job, char *compq, logical *select, integer
+ *n, doublereal *t, integer *ldt, doublereal *q, integer *ldq,
+ doublereal *wr, doublereal *wi, integer *m, doublereal *s, doublereal
+ *sep, doublereal *work, integer *lwork, integer *iwork, integer *
+ liwork, integer *info);
+
+/* Subroutine */ int dtrsna_(char *job, char *howmny, logical *select,
+ integer *n, doublereal *t, integer *ldt, doublereal *vl, integer *
+ ldvl, doublereal *vr, integer *ldvr, doublereal *s, doublereal *sep,
+ integer *mm, integer *m, doublereal *work, integer *ldwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int dtrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, doublereal *c__, integer *ldc, doublereal *scale, integer *info);
+
+/* Subroutine */ int dtrti2_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info);
+
+/* Subroutine */ int dtrtri_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info);
+
+/* Subroutine */ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int dtrttf_(char *transr, char *uplo, integer *n, doublereal
+ *a, integer *lda, doublereal *arf, integer *info);
+
+/* Subroutine */ int dtrttp_(char *uplo, integer *n, doublereal *a, integer *
+ lda, doublereal *ap, integer *info);
+
+/* Subroutine */ int dtzrqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, integer *info);
+
+/* Subroutine */ int dtzrzf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info);
+
+doublereal dzsum1_(integer *n, doublecomplex *cx, integer *incx);
+
+integer icmax1_(integer *n, complex *cx, integer *incx);
+
+integer ieeeck_(integer *ispec, real *zero, real *one);
+
+integer ilaclc_(integer *m, integer *n, complex *a, integer *lda);
+
+integer ilaclr_(integer *m, integer *n, complex *a, integer *lda);
+
+integer iladiag_(char *diag);
+
+integer iladlc_(integer *m, integer *n, doublereal *a, integer *lda);
+
+integer iladlr_(integer *m, integer *n, doublereal *a, integer *lda);
+
+integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
+ integer *n2, integer *n3, integer *n4);
+
+integer ilaprec_(char *prec);
+
+integer ilaslc_(integer *m, integer *n, real *a, integer *lda);
+
+integer ilaslr_(integer *m, integer *n, real *a, integer *lda);
+
+integer ilatrans_(char *trans);
+
+integer ilauplo_(char *uplo);
+
+/* Subroutine */ int ilaver_(integer *vers_major__, integer *vers_minor__,
+ integer *vers_patch__);
+
+integer ilazlc_(integer *m, integer *n, doublecomplex *a, integer *lda);
+
+integer ilazlr_(integer *m, integer *n, doublecomplex *a, integer *lda);
+
+integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
+ *ilo, integer *ihi, integer *lwork);
+
+integer izmax1_(integer *n, doublecomplex *cx, integer *incx);
+
+logical lsamen_(integer *n, char *ca, char *cb);
+
+integer smaxloc_(real *a, integer *dimm);
+
+/* Subroutine */ int sbdsdc_(char *uplo, char *compq, integer *n, real *d__,
+ real *e, real *u, integer *ldu, real *vt, integer *ldvt, real *q,
+ integer *iq, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, real *d__, real *e, real *vt, integer *ldvt, real *
+ u, integer *ldu, real *c__, integer *ldc, real *work, integer *info);
+
+doublereal scsum1_(integer *n, complex *cx, integer *incx);
+
+/* Subroutine */ int sdisna_(char *job, integer *m, integer *n, real *d__,
+ real *sep, integer *info);
+
+/* Subroutine */ int sgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, real *ab, integer *ldab, real *d__, real *
+ e, real *q, integer *ldq, real *pt, integer *ldpt, real *c__, integer
+ *ldc, real *work, integer *info);
+
+/* Subroutine */ int sgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, real *anorm, real *rcond,
+ real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real *
+ colcnd, real *amax, integer *info);
+
+/* Subroutine */ int sgbequb_(integer *m, integer *n, integer *kl, integer *
+ ku, real *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real
+ *colcnd, real *amax, integer *info);
+
+/* Subroutine */ int sgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, real *ab, integer *ldab, real *afb, integer *ldafb,
+ integer *ipiv, real *b, integer *ldb, real *x, integer *ldx, real *
+ ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbrfsx_(char *trans, char *equed, integer *n, integer *
+ kl, integer *ku, integer *nrhs, real *ab, integer *ldab, real *afb,
+ integer *ldafb, integer *ipiv, real *r__, real *c__, real *b, integer
+ *ldb, real *x, integer *ldx, real *rcond, real *berr, integer *
+ n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__, integer *
+ nparams, real *params, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, real *ab, integer *ldab, integer *ipiv, real *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int sgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, real *ab, integer *ldab, real *afb,
+ integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *ferr,
+ real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgbsvxx_(char *fact, char *trans, integer *n, integer *
+ kl, integer *ku, integer *nrhs, real *ab, integer *ldab, real *afb,
+ integer *ldafb, integer *ipiv, char *equed, real *r__, real *c__,
+ real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *
+ rpvgrw, real *berr, integer *n_err_bnds__, real *err_bnds_norm__,
+ real *err_bnds_comp__, integer *nparams, real *params, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, real *ab, integer *ldab, integer *ipiv, real *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int sgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *scale, integer *m, real *v, integer *ldv, integer
+ *info);
+
+/* Subroutine */ int sgebal_(char *job, integer *n, real *a, integer *lda,
+ integer *ilo, integer *ihi, real *scale, integer *info);
+
+/* Subroutine */ int sgebd2_(integer *m, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tauq, real *taup, real *work, integer *info);
+
+/* Subroutine */ int sgebrd_(integer *m, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tauq, real *taup, real *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int sgecon_(char *norm, integer *n, real *a, integer *lda,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgeequ_(integer *m, integer *n, real *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, integer
+ *info);
+
+/* Subroutine */ int sgeequb_(integer *m, integer *n, real *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, integer
+ *info);
+
+/* Subroutine */ int sgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ real *a, integer *lda, integer *sdim, real *wr, real *wi, real *vs,
+ integer *ldvs, real *work, integer *lwork, logical *bwork, integer *
+ info);
+
+/* Subroutine */ int sgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, real *a, integer *lda, integer *sdim, real *wr,
+ real *wi, real *vs, integer *ldvs, real *rconde, real *rcondv, real *
+ work, integer *lwork, integer *iwork, integer *liwork, logical *bwork,
+ integer *info);
+
+/* Subroutine */ int sgeev_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *wr, real *wi, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, real *a, integer *lda, real *wr, real *wi, real *
+ vl, integer *ldvl, real *vr, integer *ldvr, integer *ilo, integer *
+ ihi, real *scale, real *abnrm, real *rconde, real *rcondv, real *work,
+ integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgegs_(char *jobvsl, char *jobvsr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgegv_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sgehd2_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgehrd_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgejsv_(char *joba, char *jobu, char *jobv, char *jobr,
+ char *jobt, char *jobp, integer *m, integer *n, real *a, integer *lda,
+ real *sva, real *u, integer *ldu, real *v, integer *ldv, real *work,
+ integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgelq2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgelqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, real *a, integer *lda, real *b, integer *ldb, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sgelsd_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, real *s, real *rcond, integer *
+ rank, real *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgelss_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, real *s, real *rcond, integer *
+ rank, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgelsx_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, real *work, integer *info);
+
+/* Subroutine */ int sgelsy_(integer *m, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *jpvt, real *rcond,
+ integer *rank, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeql2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqlf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeqp3_(integer *m, integer *n, real *a, integer *lda,
+ integer *jpvt, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgeqpf_(integer *m, integer *n, real *a, integer *lda,
+ integer *jpvt, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqr2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgeqrf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgerfs_(char *trans, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, integer *ipiv, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgerfsx_(char *trans, char *equed, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ real *r__, real *c__, real *b, integer *ldb, real *x, integer *ldx,
+ real *rcond, real *berr, integer *n_err_bnds__, real *err_bnds_norm__,
+ real *err_bnds_comp__, integer *nparams, real *params, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sgerq2_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *info);
+
+/* Subroutine */ int sgerqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgesc2_(integer *n, real *a, integer *lda, real *rhs,
+ integer *ipiv, integer *jpiv, real *scale);
+
+/* Subroutine */ int sgesdd_(char *jobz, integer *m, integer *n, real *a,
+ integer *lda, real *s, real *u, integer *ldu, real *vt, integer *ldvt,
+ real *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int sgesv_(integer *n, integer *nrhs, real *a, integer *lda,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ real *a, integer *lda, real *s, real *u, integer *ldu, real *vt,
+ integer *ldvt, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgesvj_(char *joba, char *jobu, char *jobv, integer *m,
+ integer *n, real *a, integer *lda, real *sva, integer *mv, real *v,
+ integer *ldv, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ char *equed, real *r__, real *c__, real *b, integer *ldb, real *x,
+ integer *ldx, real *rcond, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sgesvxx_(char *fact, char *trans, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ char *equed, real *r__, real *c__, real *b, integer *ldb, real *x,
+ integer *ldx, real *rcond, real *rpvgrw, real *berr, integer *
+ n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__, integer *
+ nparams, real *params, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgetc2_(integer *n, real *a, integer *lda, integer *ipiv,
+ integer *jpiv, integer *info);
+
+/* Subroutine */ int sgetf2_(integer *m, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int sgetrf_(integer *m, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int sgetri_(integer *n, real *a, integer *lda, integer *ipiv,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgetrs_(char *trans, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, real *lscale, real *rscale, integer *m, real *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int sggbal_(char *job, integer *n, real *a, integer *lda,
+ real *b, integer *ldb, integer *ilo, integer *ihi, real *lscale, real
+ *rscale, real *work, integer *info);
+
+/* Subroutine */ int sgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, real *a, integer *lda, real *b, integer *ldb,
+ integer *sdim, real *alphar, real *alphai, real *beta, real *vsl,
+ integer *ldvsl, real *vsr, integer *ldvsr, real *work, integer *lwork,
+ logical *bwork, integer *info);
+
+/* Subroutine */ int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, real *a, integer *lda, real *b,
+ integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta,
+ real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *rconde,
+ real *rcondv, real *work, integer *lwork, integer *iwork, integer *
+ liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int sggev_(char *jobvl, char *jobvr, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real
+ *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, real *a, integer *lda, real *b, integer *ldb, real
+ *alphar, real *alphai, real *beta, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, integer *ilo, integer *ihi, real *lscale, real *rscale,
+ real *abnrm, real *bbnrm, real *rconde, real *rcondv, real *work,
+ integer *lwork, integer *iwork, logical *bwork, integer *info);
+
+/* Subroutine */ int sggglm_(integer *n, integer *m, integer *p, real *a,
+ integer *lda, real *b, integer *ldb, real *d__, real *x, real *y,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, real *a, integer *lda, real *b, integer *ldb, real
+ *q, integer *ldq, real *z__, integer *ldz, integer *info);
+
+/* Subroutine */ int sgglse_(integer *m, integer *n, integer *p, real *a,
+ integer *lda, real *b, integer *ldb, real *c__, real *d__, real *x,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggqrf_(integer *n, integer *m, integer *p, real *a,
+ integer *lda, real *taua, real *b, integer *ldb, real *taub, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggrqf_(integer *m, integer *p, integer *n, real *a,
+ integer *lda, real *taua, real *b, integer *ldb, real *taub, real *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int sggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *alpha, real *beta, real *u, integer *
+ ldu, real *v, integer *ldv, real *q, integer *ldq, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int sggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, real *a, integer *lda, real *b, integer *ldb,
+ real *tola, real *tolb, integer *k, integer *l, real *u, integer *ldu,
+ real *v, integer *ldv, real *q, integer *ldq, integer *iwork, real *
+ tau, real *work, integer *info);
+
+/* Subroutine */ int sgsvj0_(char *jobv, integer *m, integer *n, real *a,
+ integer *lda, real *d__, real *sva, integer *mv, real *v, integer *
+ ldv, real *eps, real *sfmin, real *tol, integer *nsweep, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int sgsvj1_(char *jobv, integer *m, integer *n, integer *n1,
+ real *a, integer *lda, real *d__, real *sva, integer *mv, real *v,
+ integer *ldv, real *eps, real *sfmin, real *tol, integer *nsweep,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sgtcon_(char *norm, integer *n, real *dl, real *d__,
+ real *du, real *du2, integer *ipiv, real *anorm, real *rcond, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgtrfs_(char *trans, integer *n, integer *nrhs, real *dl,
+ real *d__, real *du, real *dlf, real *df, real *duf, real *du2,
+ integer *ipiv, real *b, integer *ldb, real *x, integer *ldx, real *
+ ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sgtsv_(integer *n, integer *nrhs, real *dl, real *d__,
+ real *du, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, real *dl, real *d__, real *du, real *dlf, real *df, real *duf,
+ real *du2, integer *ipiv, real *b, integer *ldb, real *x, integer *
+ ldx, real *rcond, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int sgttrf_(integer *n, real *dl, real *d__, real *du, real *
+ du2, integer *ipiv, integer *info);
+
+/* Subroutine */ int sgttrs_(char *trans, integer *n, integer *nrhs, real *dl,
+ real *d__, real *du, real *du2, integer *ipiv, real *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int sgtts2_(integer *itrans, integer *n, integer *nrhs, real
+ *dl, real *d__, real *du, real *du2, integer *ipiv, real *b, integer *
+ ldb);
+
+/* Subroutine */ int shgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, real *h__, integer *ldh, real *t, integer
+ *ldt, real *alphar, real *alphai, real *beta, real *q, integer *ldq,
+ real *z__, integer *ldz, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int shsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, real *h__, integer *ldh, real *wr, real *wi, real
+ *vl, integer *ldvl, real *vr, integer *ldvr, integer *mm, integer *m,
+ real *work, integer *ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ int shseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, real *h__, integer *ldh, real *wr, real *wi, real *z__,
+ integer *ldz, real *work, integer *lwork, integer *info);
+
+logical sisnan_(real *sin__);
+
+/* Subroutine */ int sla_gbamv__(integer *trans, integer *m, integer *n,
+ integer *kl, integer *ku, real *alpha, real *ab, integer *ldab, real *
+ x, integer *incx, real *beta, real *y, integer *incy);
+
+doublereal sla_gbrcond__(char *trans, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, real *afb, integer *ldafb, integer *ipiv,
+ integer *cmode, real *c__, integer *info, real *work, integer *iwork,
+ ftnlen trans_len);
+
+/* Subroutine */ int sla_gbrfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *kl, integer *ku, integer *nrhs,
+ real *ab, integer *ldab, real *afb, integer *ldafb, integer *ipiv,
+ logical *colequ, real *c__, real *b, integer *ldb, real *y, integer *
+ ldy, real *berr_out__, integer *n_norms__, real *errs_n__, real *
+ errs_c__, real *res, real *ayb, real *dy, real *y_tail__, real *rcond,
+ integer *ithresh, real *rthresh, real *dz_ub__, logical *
+ ignore_cwise__, integer *info);
+
+doublereal sla_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
+ ncols, real *ab, integer *ldab, real *afb, integer *ldafb);
+
+/* Subroutine */ int sla_geamv__(integer *trans, integer *m, integer *n, real
+ *alpha, real *a, integer *lda, real *x, integer *incx, real *beta,
+ real *y, integer *incy);
+
+doublereal sla_gercond__(char *trans, integer *n, real *a, integer *lda, real
+ *af, integer *ldaf, integer *ipiv, integer *cmode, real *c__, integer
+ *info, real *work, integer *iwork, ftnlen trans_len);
+
+/* Subroutine */ int sla_gerfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *nrhs, real *a, integer *lda, real *
+ af, integer *ldaf, integer *ipiv, logical *colequ, real *c__, real *b,
+ integer *ldb, real *y, integer *ldy, real *berr_out__, integer *
+ n_norms__, real *errs_n__, real *errs_c__, real *res, real *ayb, real
+ *dy, real *y_tail__, real *rcond, integer *ithresh, real *rthresh,
+ real *dz_ub__, logical *ignore_cwise__, integer *info);
+
+/* Subroutine */ int sla_lin_berr__(integer *n, integer *nz, integer *nrhs,
+ real *res, real *ayb, real *berr);
+
+doublereal sla_porcond__(char *uplo, integer *n, real *a, integer *lda, real *
+ af, integer *ldaf, integer *cmode, real *c__, integer *info, real *
+ work, integer *iwork, ftnlen uplo_len);
+
+/* Subroutine */ int sla_porfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, real *a, integer *lda, real *af, integer *
+ ldaf, logical *colequ, real *c__, real *b, integer *ldb, real *y,
+ integer *ldy, real *berr_out__, integer *n_norms__, real *errs_n__,
+ real *errs_c__, real *res, real *ayb, real *dy, real *y_tail__, real *
+ rcond, integer *ithresh, real *rthresh, real *dz_ub__, logical *
+ ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal sla_porpvgrw__(char *uplo, integer *ncols, real *a, integer *lda,
+ real *af, integer *ldaf, real *work, ftnlen uplo_len);
+
+doublereal sla_rpvgrw__(integer *n, integer *ncols, real *a, integer *lda,
+ real *af, integer *ldaf);
+
+/* Subroutine */ int sla_syamv__(integer *uplo, integer *n, real *alpha, real
+ *a, integer *lda, real *x, integer *incx, real *beta, real *y,
+ integer *incy);
+
+doublereal sla_syrcond__(char *uplo, integer *n, real *a, integer *lda, real *
+ af, integer *ldaf, integer *ipiv, integer *cmode, real *c__, integer *
+ info, real *work, integer *iwork, ftnlen uplo_len);
+
+/* Subroutine */ int sla_syrfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, real *a, integer *lda, real *af, integer *
+ ldaf, integer *ipiv, logical *colequ, real *c__, real *b, integer *
+ ldb, real *y, integer *ldy, real *berr_out__, integer *n_norms__,
+ real *errs_n__, real *errs_c__, real *res, real *ayb, real *dy, real *
+ y_tail__, real *rcond, integer *ithresh, real *rthresh, real *dz_ub__,
+ logical *ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal sla_syrpvgrw__(char *uplo, integer *n, integer *info, real *a,
+ integer *lda, real *af, integer *ldaf, integer *ipiv, real *work,
+ ftnlen uplo_len);
+
+/* Subroutine */ int sla_wwaddw__(integer *n, real *x, real *y, real *w);
+
+/* Subroutine */ int slabad_(real *small, real *large);
+
+/* Subroutine */ int slabrd_(integer *m, integer *n, integer *nb, real *a,
+ integer *lda, real *d__, real *e, real *tauq, real *taup, real *x,
+ integer *ldx, real *y, integer *ldy);
+
+/* Subroutine */ int slacn2_(integer *n, real *v, real *x, integer *isgn,
+ real *est, integer *kase, integer *isave);
+
+/* Subroutine */ int slacon_(integer *n, real *v, real *x, integer *isgn,
+ real *est, integer *kase);
+
+/* Subroutine */ int slacpy_(char *uplo, integer *m, integer *n, real *a,
+ integer *lda, real *b, integer *ldb);
+
+/* Subroutine */ int sladiv_(real *a, real *b, real *c__, real *d__, real *p,
+ real *q);
+
+/* Subroutine */ int slae2_(real *a, real *b, real *c__, real *rt1, real *rt2);
+
+/* Subroutine */ int slaebz_(integer *ijob, integer *nitmax, integer *n,
+ integer *mmax, integer *minp, integer *nbmin, real *abstol, real *
+ reltol, real *pivmin, real *d__, real *e, real *e2, integer *nval,
+ real *ab, real *c__, integer *mout, integer *nab, real *work, integer
+ *iwork, integer *info);
+
+/* Subroutine */ int slaed0_(integer *icompq, integer *qsiz, integer *n, real
+ *d__, real *e, real *q, integer *ldq, real *qstore, integer *ldqs,
+ real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slaed1_(integer *n, real *d__, real *q, integer *ldq,
+ integer *indxq, real *rho, integer *cutpnt, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int slaed2_(integer *k, integer *n, integer *n1, real *d__,
+ real *q, integer *ldq, integer *indxq, real *rho, real *z__, real *
+ dlamda, real *w, real *q2, integer *indx, integer *indxc, integer *
+ indxp, integer *coltyp, integer *info);
+
+/* Subroutine */ int slaed3_(integer *k, integer *n, integer *n1, real *d__,
+ real *q, integer *ldq, real *rho, real *dlamda, real *q2, integer *
+ indx, integer *ctot, real *w, real *s, integer *info);
+
+/* Subroutine */ int slaed4_(integer *n, integer *i__, real *d__, real *z__,
+ real *delta, real *rho, real *dlam, integer *info);
+
+/* Subroutine */ int slaed5_(integer *i__, real *d__, real *z__, real *delta,
+ real *rho, real *dlam);
+
+/* Subroutine */ int slaed6_(integer *kniter, logical *orgati, real *rho,
+ real *d__, real *z__, real *finit, real *tau, integer *info);
+
+/* Subroutine */ int slaed7_(integer *icompq, integer *n, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, real *d__, real *q,
+ integer *ldq, integer *indxq, real *rho, integer *cutpnt, real *
+ qstore, integer *qptr, integer *prmptr, integer *perm, integer *
+ givptr, integer *givcol, real *givnum, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int slaed8_(integer *icompq, integer *k, integer *n, integer
+ *qsiz, real *d__, real *q, integer *ldq, integer *indxq, real *rho,
+ integer *cutpnt, real *z__, real *dlamda, real *q2, integer *ldq2,
+ real *w, integer *perm, integer *givptr, integer *givcol, real *
+ givnum, integer *indxp, integer *indx, integer *info);
+
+/* Subroutine */ int slaed9_(integer *k, integer *kstart, integer *kstop,
+ integer *n, real *d__, real *q, integer *ldq, real *rho, real *dlamda,
+ real *w, real *s, integer *lds, integer *info);
+
+/* Subroutine */ int slaeda_(integer *n, integer *tlvls, integer *curlvl,
+ integer *curpbm, integer *prmptr, integer *perm, integer *givptr,
+ integer *givcol, real *givnum, real *q, integer *qptr, real *z__,
+ real *ztemp, integer *info);
+
+/* Subroutine */ int slaein_(logical *rightv, logical *noinit, integer *n,
+ real *h__, integer *ldh, real *wr, real *wi, real *vr, real *vi, real
+ *b, integer *ldb, real *work, real *eps3, real *smlnum, real *bignum,
+ integer *info);
+
+/* Subroutine */ int slaev2_(real *a, real *b, real *c__, real *rt1, real *
+ rt2, real *cs1, real *sn1);
+
+/* Subroutine */ int slaexc_(logical *wantq, integer *n, real *t, integer *
+ ldt, real *q, integer *ldq, integer *j1, integer *n1, integer *n2,
+ real *work, integer *info);
+
+/* Subroutine */ int slag2_(real *a, integer *lda, real *b, integer *ldb,
+ real *safmin, real *scale1, real *scale2, real *wr1, real *wr2, real *
+ wi);
+
+/* Subroutine */ int slag2d_(integer *m, integer *n, real *sa, integer *ldsa,
+ doublereal *a, integer *lda, integer *info);
+
+/* Subroutine */ int slags2_(logical *upper, real *a1, real *a2, real *a3,
+ real *b1, real *b2, real *b3, real *csu, real *snu, real *csv, real *
+ snv, real *csq, real *snq);
+
+/* Subroutine */ int slagtf_(integer *n, real *a, real *lambda, real *b, real
+ *c__, real *tol, real *d__, integer *in, integer *info);
+
+/* Subroutine */ int slagtm_(char *trans, integer *n, integer *nrhs, real *
+ alpha, real *dl, real *d__, real *du, real *x, integer *ldx, real *
+ beta, real *b, integer *ldb);
+
+/* Subroutine */ int slagts_(integer *job, integer *n, real *a, real *b, real
+ *c__, real *d__, integer *in, real *y, real *tol, integer *info);
+
+/* Subroutine */ int slagv2_(real *a, integer *lda, real *b, integer *ldb,
+ real *alphar, real *alphai, real *beta, real *csl, real *snl, real *
+ csr, real *snr);
+
+/* Subroutine */ int slahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, real *h__, integer *ldh, real *wr, real *
+ wi, integer *iloz, integer *ihiz, real *z__, integer *ldz, integer *
+ info);
+
+/* Subroutine */ int slahr2_(integer *n, integer *k, integer *nb, real *a,
+ integer *lda, real *tau, real *t, integer *ldt, real *y, integer *ldy);
+
+/* Subroutine */ int slahrd_(integer *n, integer *k, integer *nb, real *a,
+ integer *lda, real *tau, real *t, integer *ldt, real *y, integer *ldy);
+
+/* Subroutine */ int slaic1_(integer *job, integer *j, real *x, real *sest,
+ real *w, real *gamma, real *sestpr, real *s, real *c__);
+
+logical slaisnan_(real *sin1, real *sin2);
+
+/* Subroutine */ int slaln2_(logical *ltrans, integer *na, integer *nw, real *
+ smin, real *ca, real *a, integer *lda, real *d1, real *d2, real *b,
+ integer *ldb, real *wr, real *wi, real *x, integer *ldx, real *scale,
+ real *xnorm, integer *info);
+
+/* Subroutine */ int slals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, real *b, integer *ldb, real *bx,
+ integer *ldbx, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ work, integer *info);
+
+/* Subroutine */ int slalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, real *b, integer *ldb, real *bx, integer *ldbx, real *
+ u, integer *ldu, real *vt, integer *k, real *difl, real *difr, real *
+ z__, real *poles, integer *givptr, integer *givcol, integer *ldgcol,
+ integer *perm, real *givnum, real *c__, real *s, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int slalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, real *d__, real *e, real *b, integer *ldb, real *rcond,
+ integer *rank, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slamrg_(integer *n1, integer *n2, real *a, integer *
+ strd1, integer *strd2, integer *index);
+
+integer slaneg_(integer *n, real *d__, real *lld, real *sigma, real *pivmin,
+ integer *r__);
+
+doublereal slangb_(char *norm, integer *n, integer *kl, integer *ku, real *ab,
+ integer *ldab, real *work);
+
+doublereal slange_(char *norm, integer *m, integer *n, real *a, integer *lda,
+ real *work);
+
+doublereal slangt_(char *norm, integer *n, real *dl, real *d__, real *du);
+
+doublereal slanhs_(char *norm, integer *n, real *a, integer *lda, real *work);
+
+doublereal slansb_(char *norm, char *uplo, integer *n, integer *k, real *ab,
+ integer *ldab, real *work);
+
+doublereal slansf_(char *norm, char *transr, char *uplo, integer *n, real *a,
+ real *work);
+
+doublereal slansp_(char *norm, char *uplo, integer *n, real *ap, real *work);
+
+doublereal slanst_(char *norm, integer *n, real *d__, real *e);
+
+doublereal slansy_(char *norm, char *uplo, integer *n, real *a, integer *lda,
+ real *work);
+
+doublereal slantb_(char *norm, char *uplo, char *diag, integer *n, integer *k,
+ real *ab, integer *ldab, real *work);
+
+doublereal slantp_(char *norm, char *uplo, char *diag, integer *n, real *ap,
+ real *work);
+
+doublereal slantr_(char *norm, char *uplo, char *diag, integer *m, integer *n,
+ real *a, integer *lda, real *work);
+
+/* Subroutine */ int slanv2_(real *a, real *b, real *c__, real *d__, real *
+ rt1r, real *rt1i, real *rt2r, real *rt2i, real *cs, real *sn);
+
+/* Subroutine */ int slapll_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *ssmin);
+
+/* Subroutine */ int slapmt_(logical *forwrd, integer *m, integer *n, real *x,
+ integer *ldx, integer *k);
+
+doublereal slapy2_(real *x, real *y);
+
+doublereal slapy3_(real *x, real *y, real *z__);
+
+/* Subroutine */ int slaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ real *ab, integer *ldab, real *r__, real *c__, real *rowcnd, real *
+ colcnd, real *amax, char *equed);
+
+/* Subroutine */ int slaqge_(integer *m, integer *n, real *a, integer *lda,
+ real *r__, real *c__, real *rowcnd, real *colcnd, real *amax, char *
+ equed);
+
+/* Subroutine */ int slaqp2_(integer *m, integer *n, integer *offset, real *a,
+ integer *lda, integer *jpvt, real *tau, real *vn1, real *vn2, real *
+ work);
+
+/* Subroutine */ int slaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, real *a, integer *lda, integer *jpvt, real *tau,
+ real *vn1, real *vn2, real *auxv, real *f, integer *ldf);
+
+/* Subroutine */ int slaqr0_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, real *h__, integer *ldh, real *wr, real *
+ wi, integer *iloz, integer *ihiz, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int slaqr1_(integer *n, real *h__, integer *ldh, real *sr1,
+ real *si1, real *sr2, real *si2, real *v);
+
+/* Subroutine */ int slaqr2_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, real *h__, integer *ldh,
+ integer *iloz, integer *ihiz, real *z__, integer *ldz, integer *ns,
+ integer *nd, real *sr, real *si, real *v, integer *ldv, integer *nh,
+ real *t, integer *ldt, integer *nv, real *wv, integer *ldwv, real *
+ work, integer *lwork);
+
+/* Subroutine */ int slaqr3_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, real *h__, integer *ldh,
+ integer *iloz, integer *ihiz, real *z__, integer *ldz, integer *ns,
+ integer *nd, real *sr, real *si, real *v, integer *ldv, integer *nh,
+ real *t, integer *ldt, integer *nv, real *wv, integer *ldwv, real *
+ work, integer *lwork);
+
+/* Subroutine */ int slaqr4_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, real *h__, integer *ldh, real *wr, real *
+ wi, integer *iloz, integer *ihiz, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int slaqr5_(logical *wantt, logical *wantz, integer *kacc22,
+ integer *n, integer *ktop, integer *kbot, integer *nshfts, real *sr,
+ real *si, real *h__, integer *ldh, integer *iloz, integer *ihiz, real
+ *z__, integer *ldz, real *v, integer *ldv, real *u, integer *ldu,
+ integer *nv, real *wv, integer *ldwv, integer *nh, real *wh, integer *
+ ldwh);
+
+/* Subroutine */ int slaqsb_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqsp_(char *uplo, integer *n, real *ap, real *s, real *
+ scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqsy_(char *uplo, integer *n, real *a, integer *lda,
+ real *s, real *scond, real *amax, char *equed);
+
+/* Subroutine */ int slaqtr_(logical *ltran, logical *lreal, integer *n, real
+ *t, integer *ldt, real *b, real *w, real *scale, real *x, real *work,
+ integer *info);
+
+/* Subroutine */ int slar1v_(integer *n, integer *b1, integer *bn, real *
+ lambda, real *d__, real *l, real *ld, real *lld, real *pivmin, real *
+ gaptol, real *z__, logical *wantnc, integer *negcnt, real *ztz, real *
+ mingma, integer *r__, integer *isuppz, real *nrminv, real *resid,
+ real *rqcorr, real *work);
+
+/* Subroutine */ int slar2v_(integer *n, real *x, real *y, real *z__, integer
+ *incx, real *c__, real *s, integer *incc);
+
+/* Subroutine */ int slarf_(char *side, integer *m, integer *n, real *v,
+ integer *incv, real *tau, real *c__, integer *ldc, real *work);
+
+/* Subroutine */ int slarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, real *v, integer *ldv,
+ real *t, integer *ldt, real *c__, integer *ldc, real *work, integer *
+ ldwork);
+
+/* Subroutine */ int slarfg_(integer *n, real *alpha, real *x, integer *incx,
+ real *tau);
+
+/* Subroutine */ int slarfp_(integer *n, real *alpha, real *x, integer *incx,
+ real *tau);
+
+/* Subroutine */ int slarft_(char *direct, char *storev, integer *n, integer *
+ k, real *v, integer *ldv, real *tau, real *t, integer *ldt);
+
+/* Subroutine */ int slarfx_(char *side, integer *m, integer *n, real *v,
+ real *tau, real *c__, integer *ldc, real *work);
+
+/* Subroutine */ int slargv_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *c__, integer *incc);
+
+/* Subroutine */ int slarnv_(integer *idist, integer *iseed, integer *n, real
+ *x);
+
+/* Subroutine */ int slarra_(integer *n, real *d__, real *e, real *e2, real *
+ spltol, real *tnrm, integer *nsplit, integer *isplit, integer *info);
+
+/* Subroutine */ int slarrb_(integer *n, real *d__, real *lld, integer *
+ ifirst, integer *ilast, real *rtol1, real *rtol2, integer *offset,
+ real *w, real *wgap, real *werr, real *work, integer *iwork, real *
+ pivmin, real *spdiam, integer *twist, integer *info);
+
+/* Subroutine */ int slarrc_(char *jobt, integer *n, real *vl, real *vu, real
+ *d__, real *e, real *pivmin, integer *eigcnt, integer *lcnt, integer *
+ rcnt, integer *info);
+
+/* Subroutine */ int slarrd_(char *range, char *order, integer *n, real *vl,
+ real *vu, integer *il, integer *iu, real *gers, real *reltol, real *
+ d__, real *e, real *e2, real *pivmin, integer *nsplit, integer *
+ isplit, integer *m, real *w, real *werr, real *wl, real *wu, integer *
+ iblock, integer *indexw, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slarre_(char *range, integer *n, real *vl, real *vu,
+ integer *il, integer *iu, real *d__, real *e, real *e2, real *rtol1,
+ real *rtol2, real *spltol, integer *nsplit, integer *isplit, integer *
+ m, real *w, real *werr, real *wgap, integer *iblock, integer *indexw,
+ real *gers, real *pivmin, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slarrf_(integer *n, real *d__, real *l, real *ld,
+ integer *clstrt, integer *clend, real *w, real *wgap, real *werr,
+ real *spdiam, real *clgapl, real *clgapr, real *pivmin, real *sigma,
+ real *dplus, real *lplus, real *work, integer *info);
+
+/* Subroutine */ int slarrj_(integer *n, real *d__, real *e2, integer *ifirst,
+ integer *ilast, real *rtol, integer *offset, real *w, real *werr,
+ real *work, integer *iwork, real *pivmin, real *spdiam, integer *info);
+
+/* Subroutine */ int slarrk_(integer *n, integer *iw, real *gl, real *gu,
+ real *d__, real *e2, real *pivmin, real *reltol, real *w, real *werr,
+ integer *info);
+
+/* Subroutine */ int slarrr_(integer *n, real *d__, real *e, integer *info);
+
+/* Subroutine */ int slarrv_(integer *n, real *vl, real *vu, real *d__, real *
+ l, real *pivmin, integer *isplit, integer *m, integer *dol, integer *
+ dou, real *minrgp, real *rtol1, real *rtol2, real *w, real *werr,
+ real *wgap, integer *iblock, integer *indexw, real *gers, real *z__,
+ integer *ldz, integer *isuppz, real *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int slarscl2_(integer *m, integer *n, real *d__, real *x,
+ integer *ldx);
+
+/* Subroutine */ int slartg_(real *f, real *g, real *cs, real *sn, real *r__);
+
+/* Subroutine */ int slartv_(integer *n, real *x, integer *incx, real *y,
+ integer *incy, real *c__, real *s, integer *incc);
+
+/* Subroutine */ int slaruv_(integer *iseed, integer *n, real *x);
+
+/* Subroutine */ int slarz_(char *side, integer *m, integer *n, integer *l,
+ real *v, integer *incv, real *tau, real *c__, integer *ldc, real *
+ work);
+
+/* Subroutine */ int slarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, real *v,
+ integer *ldv, real *t, integer *ldt, real *c__, integer *ldc, real *
+ work, integer *ldwork);
+
+/* Subroutine */ int slarzt_(char *direct, char *storev, integer *n, integer *
+ k, real *v, integer *ldv, real *tau, real *t, integer *ldt);
+
+/* Subroutine */ int slas2_(real *f, real *g, real *h__, real *ssmin, real *
+ ssmax);
+
+/* Subroutine */ int slascl_(char *type__, integer *kl, integer *ku, real *
+ cfrom, real *cto, integer *m, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int slascl2_(integer *m, integer *n, real *d__, real *x,
+ integer *ldx);
+
+/* Subroutine */ int slasd0_(integer *n, integer *sqre, real *d__, real *e,
+ real *u, integer *ldu, real *vt, integer *ldvt, integer *smlsiz,
+ integer *iwork, real *work, integer *info);
+
+/* Subroutine */ int slasd1_(integer *nl, integer *nr, integer *sqre, real *
+ d__, real *alpha, real *beta, real *u, integer *ldu, real *vt,
+ integer *ldvt, integer *idxq, integer *iwork, real *work, integer *
+ info);
+
+/* Subroutine */ int slasd2_(integer *nl, integer *nr, integer *sqre, integer
+ *k, real *d__, real *z__, real *alpha, real *beta, real *u, integer *
+ ldu, real *vt, integer *ldvt, real *dsigma, real *u2, integer *ldu2,
+ real *vt2, integer *ldvt2, integer *idxp, integer *idx, integer *idxc,
+ integer *idxq, integer *coltyp, integer *info);
+
+/* Subroutine */ int slasd3_(integer *nl, integer *nr, integer *sqre, integer
+ *k, real *d__, real *q, integer *ldq, real *dsigma, real *u, integer *
+ ldu, real *u2, integer *ldu2, real *vt, integer *ldvt, real *vt2,
+ integer *ldvt2, integer *idxc, integer *ctot, real *z__, integer *
+ info);
+
+/* Subroutine */ int slasd4_(integer *n, integer *i__, real *d__, real *z__,
+ real *delta, real *rho, real *sigma, real *work, integer *info);
+
+/* Subroutine */ int slasd5_(integer *i__, real *d__, real *z__, real *delta,
+ real *rho, real *dsigma, real *work);
+
+/* Subroutine */ int slasd6_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, real *d__, real *vf, real *vl, real *alpha, real *beta,
+ integer *idxq, integer *perm, integer *givptr, integer *givcol,
+ integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
+ difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int slasd7_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *k, real *d__, real *z__, real *zw, real *vf,
+ real *vfw, real *vl, real *vlw, real *alpha, real *beta, real *dsigma,
+ integer *idx, integer *idxp, integer *idxq, integer *perm, integer *
+ givptr, integer *givcol, integer *ldgcol, real *givnum, integer *
+ ldgnum, real *c__, real *s, integer *info);
+
+/* Subroutine */ int slasd8_(integer *icompq, integer *k, real *d__, real *
+ z__, real *vf, real *vl, real *difl, real *difr, integer *lddifr,
+ real *dsigma, real *work, integer *info);
+
+/* Subroutine */ int slasda_(integer *icompq, integer *smlsiz, integer *n,
+ integer *sqre, real *d__, real *e, real *u, integer *ldu, real *vt,
+ integer *k, real *difl, real *difr, real *z__, real *poles, integer *
+ givptr, integer *givcol, integer *ldgcol, integer *perm, real *givnum,
+ real *c__, real *s, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int slasdq_(char *uplo, integer *sqre, integer *n, integer *
+ ncvt, integer *nru, integer *ncc, real *d__, real *e, real *vt,
+ integer *ldvt, real *u, integer *ldu, real *c__, integer *ldc, real *
+ work, integer *info);
+
+/* Subroutine */ int slasdt_(integer *n, integer *lvl, integer *nd, integer *
+ inode, integer *ndiml, integer *ndimr, integer *msub);
+
+/* Subroutine */ int slaset_(char *uplo, integer *m, integer *n, real *alpha,
+ real *beta, real *a, integer *lda);
+
+/* Subroutine */ int slasq1_(integer *n, real *d__, real *e, real *work,
+ integer *info);
+
+/* Subroutine */ int slasq2_(integer *n, real *z__, integer *info);
+
+/* Subroutine */ int slasq3_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *dmin__, real *sigma, real *desig, real *qmax, integer *nfail,
+ integer *iter, integer *ndiv, logical *ieee, integer *ttype, real *
+ dmin1, real *dmin2, real *dn, real *dn1, real *dn2, real *g, real *
+ tau);
+
+/* Subroutine */ int slasq4_(integer *i0, integer *n0, real *z__, integer *pp,
+ integer *n0in, real *dmin__, real *dmin1, real *dmin2, real *dn,
+ real *dn1, real *dn2, real *tau, integer *ttype, real *g);
+
+/* Subroutine */ int slasq5_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *tau, real *dmin__, real *dmin1, real *dmin2, real *dn, real *
+ dnm1, real *dnm2, logical *ieee);
+
+/* Subroutine */ int slasq6_(integer *i0, integer *n0, real *z__, integer *pp,
+ real *dmin__, real *dmin1, real *dmin2, real *dn, real *dnm1, real *
+ dnm2);
+
+/* Subroutine */ int slasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, real *c__, real *s, real *a, integer *lda);
+
+/* Subroutine */ int slasrt_(char *id, integer *n, real *d__, integer *info);
+
+/* Subroutine */ int slassq_(integer *n, real *x, integer *incx, real *scale,
+ real *sumsq);
+
+/* Subroutine */ int slasv2_(real *f, real *g, real *h__, real *ssmin, real *
+ ssmax, real *snr, real *csr, real *snl, real *csl);
+
+/* Subroutine */ int slaswp_(integer *n, real *a, integer *lda, integer *k1,
+ integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int slasy2_(logical *ltranl, logical *ltranr, integer *isgn,
+ integer *n1, integer *n2, real *tl, integer *ldtl, real *tr, integer *
+ ldtr, real *b, integer *ldb, real *scale, real *x, integer *ldx, real
+ *xnorm, integer *info);
+
+/* Subroutine */ int slasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ real *a, integer *lda, integer *ipiv, real *w, integer *ldw, integer
+ *info);
+
+/* Subroutine */ int slatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, real *ab, integer *ldab, real *x,
+ real *scale, real *cnorm, integer *info);
+
+/* Subroutine */ int slatdf_(integer *ijob, integer *n, real *z__, integer *
+ ldz, real *rhs, real *rdsum, real *rdscal, integer *ipiv, integer *
+ jpiv);
+
+/* Subroutine */ int slatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, real *ap, real *x, real *scale, real *cnorm,
+ integer *info);
+
+/* Subroutine */ int slatrd_(char *uplo, integer *n, integer *nb, real *a,
+ integer *lda, real *e, real *tau, real *w, integer *ldw);
+
+/* Subroutine */ int slatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, real *a, integer *lda, real *x, real *scale, real
+ *cnorm, integer *info);
+
+/* Subroutine */ int slatrz_(integer *m, integer *n, integer *l, real *a,
+ integer *lda, real *tau, real *work);
+
+/* Subroutine */ int slatzm_(char *side, integer *m, integer *n, real *v,
+ integer *incv, real *tau, real *c1, real *c2, integer *ldc, real *
+ work);
+
+/* Subroutine */ int slauu2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int slauum_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int sopgtr_(char *uplo, integer *n, real *ap, real *tau,
+ real *q, integer *ldq, real *work, integer *info);
+
+/* Subroutine */ int sopmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, real *ap, real *tau, real *c__, integer *ldc, real *work,
+ integer *info);
+
+/* Subroutine */ int sorg2l_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorg2r_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorgbr_(char *vect, integer *m, integer *n, integer *k,
+ real *a, integer *lda, real *tau, real *work, integer *lwork, integer
+ *info);
+
+/* Subroutine */ int sorghr_(integer *n, integer *ilo, integer *ihi, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgl2_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorglq_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgql_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgqr_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgr2_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *info);
+
+/* Subroutine */ int sorgrq_(integer *m, integer *n, integer *k, real *a,
+ integer *lda, real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorgtr_(char *uplo, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, real *a, integer *lda, real *tau, real *
+ c__, integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *info);
+
+/* Subroutine */ int sormr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *info);
+
+/* Subroutine */ int sormrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, real *a, integer *lda, real *tau, real *c__,
+ integer *ldc, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int sormtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, real *a, integer *lda, real *tau, real *c__, integer *ldc,
+ real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int spbcon_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *anorm, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int spbequ_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, real *s, real *scond, real *amax, integer *info);
+
+/* Subroutine */ int spbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *afb, integer *ldafb, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int spbstf_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, real *ab, integer *ldab, real *afb, integer *ldafb,
+ char *equed, real *s, real *b, integer *ldb, real *x, integer *ldx,
+ real *rcond, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int spbtf2_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbtrf_(char *uplo, integer *n, integer *kd, real *ab,
+ integer *ldab, integer *info);
+
+/* Subroutine */ int spbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, real *ab, integer *ldab, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spftrf_(char *transr, char *uplo, integer *n, real *a,
+ integer *info);
+
+/* Subroutine */ int spftri_(char *transr, char *uplo, integer *n, real *a,
+ integer *info);
+
+/* Subroutine */ int spftrs_(char *transr, char *uplo, integer *n, integer *
+ nrhs, real *a, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spocon_(char *uplo, integer *n, real *a, integer *lda,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spoequ_(integer *n, real *a, integer *lda, real *s, real
+ *scond, real *amax, integer *info);
+
+/* Subroutine */ int spoequb_(integer *n, real *a, integer *lda, real *s,
+ real *scond, real *amax, integer *info);
+
+/* Subroutine */ int sporfs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, real *b, integer *ldb, real *x,
+ integer *ldx, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int sporfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, real *s, real *
+ b, integer *ldb, real *x, integer *ldx, real *rcond, real *berr,
+ integer *n_err_bnds__, real *err_bnds_norm__, real *err_bnds_comp__,
+ integer *nparams, real *params, real *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int sposv_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, char *equed,
+ real *s, real *b, integer *ldb, real *x, integer *ldx, real *rcond,
+ real *ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sposvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, char *equed,
+ real *s, real *b, integer *ldb, real *x, integer *ldx, real *rcond,
+ real *rpvgrw, real *berr, integer *n_err_bnds__, real *
+ err_bnds_norm__, real *err_bnds_comp__, integer *nparams, real *
+ params, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spotf2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotrf_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotri_(char *uplo, integer *n, real *a, integer *lda,
+ integer *info);
+
+/* Subroutine */ int spotrs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sppcon_(char *uplo, integer *n, real *ap, real *anorm,
+ real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sppequ_(char *uplo, integer *n, real *ap, real *s, real *
+ scond, real *amax, integer *info);
+
+/* Subroutine */ int spprfs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *afp, real *b, integer *ldb, real *x, integer *ldx, real *ferr,
+ real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sppsv_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *ap, real *afp, char *equed, real *s, real *b, integer *
+ ldb, real *x, integer *ldx, real *rcond, real *ferr, real *berr, real
+ *work, integer *iwork, integer *info);
+
+/* Subroutine */ int spptrf_(char *uplo, integer *n, real *ap, integer *info);
+
+/* Subroutine */ int spptri_(char *uplo, integer *n, real *ap, integer *info);
+
+/* Subroutine */ int spptrs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int spstf2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *piv, integer *rank, real *tol, real *work, integer *info);
+
+/* Subroutine */ int spstrf_(char *uplo, integer *n, real *a, integer *lda,
+ integer *piv, integer *rank, real *tol, real *work, integer *info);
+
+/* Subroutine */ int sptcon_(integer *n, real *d__, real *e, real *anorm,
+ real *rcond, real *work, integer *info);
+
+/* Subroutine */ int spteqr_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sptrfs_(integer *n, integer *nrhs, real *d__, real *e,
+ real *df, real *ef, real *b, integer *ldb, real *x, integer *ldx,
+ real *ferr, real *berr, real *work, integer *info);
+
+/* Subroutine */ int sptsv_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sptsvx_(char *fact, integer *n, integer *nrhs, real *d__,
+ real *e, real *df, real *ef, real *b, integer *ldb, real *x, integer
+ *ldx, real *rcond, real *ferr, real *berr, real *work, integer *info);
+
+/* Subroutine */ int spttrf_(integer *n, real *d__, real *e, integer *info);
+
+/* Subroutine */ int spttrs_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sptts2_(integer *n, integer *nrhs, real *d__, real *e,
+ real *b, integer *ldb);
+
+/* Subroutine */ int srscl_(integer *n, real *sa, real *sx, integer *incx);
+
+/* Subroutine */ int ssbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *w, real *z__, integer *ldz, real *work,
+ integer *info);
+
+/* Subroutine */ int ssbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *w, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, real *ab, integer *ldab, real *q, integer *ldq, real *vl,
+ real *vu, integer *il, integer *iu, real *abstol, integer *m, real *
+ w, real *z__, integer *ldz, real *work, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int ssbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ x, integer *ldx, real *work, integer *info);
+
+/* Subroutine */ int ssbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ w, real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int ssbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, real *ab, integer *ldab, real *bb, integer *ldbb, real *
+ w, real *z__, integer *ldz, real *work, integer *lwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, real *ab, integer *ldab, real *bb, integer *
+ ldbb, real *q, integer *ldq, real *vl, real *vu, integer *il, integer
+ *iu, real *abstol, integer *m, real *w, real *z__, integer *ldz, real
+ *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ real *ab, integer *ldab, real *d__, real *e, real *q, integer *ldq,
+ real *work, integer *info);
+
+/* Subroutine */ int ssfrk_(char *transr, char *uplo, char *trans, integer *n,
+ integer *k, real *alpha, real *a, integer *lda, real *beta, real *
+ c__);
+
+/* Subroutine */ int sspcon_(char *uplo, integer *n, real *ap, integer *ipiv,
+ real *anorm, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sspev_(char *jobz, char *uplo, integer *n, real *ap,
+ real *w, real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sspevd_(char *jobz, char *uplo, integer *n, real *ap,
+ real *w, real *z__, integer *ldz, real *work, integer *lwork, integer
+ *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sspevx_(char *jobz, char *range, char *uplo, integer *n,
+ real *ap, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, real *work, integer *
+ iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int sspgst_(integer *itype, char *uplo, integer *n, real *ap,
+ real *bp, integer *info);
+
+/* Subroutine */ int sspgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *ap, real *bp, real *w, real *z__, integer *ldz, real *work,
+ integer *info);
+
+/* Subroutine */ int sspgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *ap, real *bp, real *w, real *z__, integer *ldz, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sspgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, real *ap, real *bp, real *vl, real *vu, integer *il,
+ integer *iu, real *abstol, integer *m, real *w, real *z__, integer *
+ ldz, real *work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssprfs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ real *afp, integer *ipiv, real *b, integer *ldb, real *x, integer *
+ ldx, real *ferr, real *berr, real *work, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int sspsv_(char *uplo, integer *n, integer *nrhs, real *ap,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *ap, real *afp, integer *ipiv, real *b, integer *ldb, real
+ *x, integer *ldx, real *rcond, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int ssptrd_(char *uplo, integer *n, real *ap, real *d__,
+ real *e, real *tau, integer *info);
+
+/* Subroutine */ int ssptrf_(char *uplo, integer *n, real *ap, integer *ipiv,
+ integer *info);
+
+/* Subroutine */ int ssptri_(char *uplo, integer *n, real *ap, integer *ipiv,
+ real *work, integer *info);
+
+/* Subroutine */ int ssptrs_(char *uplo, integer *n, integer *nrhs, real *ap,
+ integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int sstebz_(char *range, char *order, integer *n, real *vl,
+ real *vu, integer *il, integer *iu, real *abstol, real *d__, real *e,
+ integer *m, integer *nsplit, real *w, integer *iblock, integer *
+ isplit, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int sstedc_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int sstegr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, integer *isuppz, real *
+ work, integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sstein_(integer *n, real *d__, real *e, integer *m, real
+ *w, integer *iblock, integer *isplit, real *z__, integer *ldz, real *
+ work, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int sstemr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, integer *m,
+ real *w, real *z__, integer *ldz, integer *nzc, integer *isuppz,
+ logical *tryrac, real *work, integer *lwork, integer *iwork, integer *
+ liwork, integer *info);
+
+/* Subroutine */ int ssteqr_(char *compz, integer *n, real *d__, real *e,
+ real *z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int ssterf_(integer *n, real *d__, real *e, integer *info);
+
+/* Subroutine */ int sstev_(char *jobz, integer *n, real *d__, real *e, real *
+ z__, integer *ldz, real *work, integer *info);
+
+/* Subroutine */ int sstevd_(char *jobz, integer *n, real *d__, real *e, real
+ *z__, integer *ldz, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int sstevr_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, integer *isuppz, real *
+ work, integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int sstevx_(char *jobz, char *range, integer *n, real *d__,
+ real *e, real *vl, real *vu, integer *il, integer *iu, real *abstol,
+ integer *m, real *w, real *z__, integer *ldz, real *work, integer *
+ iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssycon_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *anorm, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int ssyequb_(char *uplo, integer *n, real *a, integer *lda,
+ real *s, real *scond, real *amax, real *work, integer *info);
+
+/* Subroutine */ int ssyev_(char *jobz, char *uplo, integer *n, real *a,
+ integer *lda, real *w, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ssyevd_(char *jobz, char *uplo, integer *n, real *a,
+ integer *lda, real *w, real *work, integer *lwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int ssyevr_(char *jobz, char *range, char *uplo, integer *n,
+ real *a, integer *lda, real *vl, real *vu, integer *il, integer *iu,
+ real *abstol, integer *m, real *w, real *z__, integer *ldz, integer *
+ isuppz, real *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ssyevx_(char *jobz, char *range, char *uplo, integer *n,
+ real *a, integer *lda, real *vl, real *vu, integer *il, integer *iu,
+ real *abstol, integer *m, real *w, real *z__, integer *ldz, real *
+ work, integer *lwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssygs2_(integer *itype, char *uplo, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ssygst_(integer *itype, char *uplo, integer *n, real *a,
+ integer *lda, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ssygv_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *w, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int ssygvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *w, real *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int ssygvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, real *a, integer *lda, real *b, integer *ldb, real *
+ vl, real *vu, integer *il, integer *iu, real *abstol, integer *m,
+ real *w, real *z__, integer *ldz, real *work, integer *lwork, integer
+ *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int ssyrfs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, real *af, integer *ldaf, integer *ipiv, real *b,
+ integer *ldb, real *x, integer *ldx, real *ferr, real *berr, real *
+ work, integer *iwork, integer *info);
+
+/* Subroutine */ int ssyrfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ real *s, real *b, integer *ldb, real *x, integer *ldx, real *rcond,
+ real *berr, integer *n_err_bnds__, real *err_bnds_norm__, real *
+ err_bnds_comp__, integer *nparams, real *params, real *work, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int ssysv_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int ssysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ real *b, integer *ldb, real *x, integer *ldx, real *rcond, real *ferr,
+ real *berr, real *work, integer *lwork, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int ssysvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, real *a, integer *lda, real *af, integer *ldaf, integer *ipiv,
+ char *equed, real *s, real *b, integer *ldb, real *x, integer *ldx,
+ real *rcond, real *rpvgrw, real *berr, integer *n_err_bnds__, real *
+ err_bnds_norm__, real *err_bnds_comp__, integer *nparams, real *
+ params, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int ssytd2_(char *uplo, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tau, integer *info);
+
+/* Subroutine */ int ssytf2_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int ssytrd_(char *uplo, integer *n, real *a, integer *lda,
+ real *d__, real *e, real *tau, real *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int ssytrf_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ssytri_(char *uplo, integer *n, real *a, integer *lda,
+ integer *ipiv, real *work, integer *info);
+
+/* Subroutine */ int ssytrs_(char *uplo, integer *n, integer *nrhs, real *a,
+ integer *lda, integer *ipiv, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int stbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, real *ab, integer *ldab, real *rcond, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int stbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, real *ab, integer *ldab, real *b, integer
+ *ldb, real *x, integer *ldx, real *ferr, real *berr, real *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int stbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, real *ab, integer *ldab, real *b, integer
+ *ldb, integer *info);
+
+/* Subroutine */ int stfsm_(char *transr, char *side, char *uplo, char *trans,
+ char *diag, integer *m, integer *n, real *alpha, real *a, real *b,
+ integer *ldb);
+
+/* Subroutine */ int stftri_(char *transr, char *uplo, char *diag, integer *n,
+ real *a, integer *info);
+
+/* Subroutine */ int stfttp_(char *transr, char *uplo, integer *n, real *arf,
+ real *ap, integer *info);
+
+/* Subroutine */ int stfttr_(char *transr, char *uplo, integer *n, real *arf,
+ real *a, integer *lda, integer *info);
+
+/* Subroutine */ int stgevc_(char *side, char *howmny, logical *select,
+ integer *n, real *s, integer *lds, real *p, integer *ldp, real *vl,
+ integer *ldvl, real *vr, integer *ldvr, integer *mm, integer *m, real
+ *work, integer *info);
+
+/* Subroutine */ int stgex2_(logical *wantq, logical *wantz, integer *n, real
+ *a, integer *lda, real *b, integer *ldb, real *q, integer *ldq, real *
+ z__, integer *ldz, integer *j1, integer *n1, integer *n2, real *work,
+ integer *lwork, integer *info);
+
+/* Subroutine */ int stgexc_(logical *wantq, logical *wantz, integer *n, real
+ *a, integer *lda, real *b, integer *ldb, real *q, integer *ldq, real *
+ z__, integer *ldz, integer *ifst, integer *ilst, real *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int stgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, real *a, integer *lda, real *b, integer *
+ ldb, real *alphar, real *alphai, real *beta, real *q, integer *ldq,
+ real *z__, integer *ldz, integer *m, real *pl, real *pr, real *dif,
+ real *work, integer *lwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int stgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, real *a, integer *lda,
+ real *b, integer *ldb, real *tola, real *tolb, real *alpha, real *
+ beta, real *u, integer *ldu, real *v, integer *ldv, real *q, integer *
+ ldq, real *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int stgsna_(char *job, char *howmny, logical *select,
+ integer *n, real *a, integer *lda, real *b, integer *ldb, real *vl,
+ integer *ldvl, real *vr, integer *ldvr, real *s, real *dif, integer *
+ mm, integer *m, real *work, integer *lwork, integer *iwork, integer *
+ info);
+
+/* Subroutine */ int stgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *c__, integer *
+ ldc, real *d__, integer *ldd, real *e, integer *lde, real *f, integer
+ *ldf, real *scale, real *rdsum, real *rdscal, integer *iwork, integer
+ *pq, integer *info);
+
+/* Subroutine */ int stgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, real *a, integer *lda, real *b, integer *ldb, real *c__, integer *
+ ldc, real *d__, integer *ldd, real *e, integer *lde, real *f, integer
+ *ldf, real *scale, real *dif, real *work, integer *lwork, integer *
+ iwork, integer *info);
+
+/* Subroutine */ int stpcon_(char *norm, char *uplo, char *diag, integer *n,
+ real *ap, real *rcond, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int stprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *ap, real *b, integer *ldb, real *x, integer *ldx,
+ real *ferr, real *berr, real *work, integer *iwork, integer *info);
+
+/* Subroutine */ int stptri_(char *uplo, char *diag, integer *n, real *ap,
+ integer *info);
+
+/* Subroutine */ int stptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *ap, real *b, integer *ldb, integer *info);
+
+/* Subroutine */ int stpttf_(char *transr, char *uplo, integer *n, real *ap,
+ real *arf, integer *info);
+
+/* Subroutine */ int stpttr_(char *uplo, integer *n, real *ap, real *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int strcon_(char *norm, char *uplo, char *diag, integer *n,
+ real *a, integer *lda, real *rcond, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int strevc_(char *side, char *howmny, logical *select,
+ integer *n, real *t, integer *ldt, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, integer *mm, integer *m, real *work, integer *info);
+
+/* Subroutine */ int strexc_(char *compq, integer *n, real *t, integer *ldt,
+ real *q, integer *ldq, integer *ifst, integer *ilst, real *work,
+ integer *info);
+
+/* Subroutine */ int strrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *a, integer *lda, real *b, integer *ldb, real *x,
+ integer *ldx, real *ferr, real *berr, real *work, integer *iwork,
+ integer *info);
+
+/* Subroutine */ int strsen_(char *job, char *compq, logical *select, integer
+ *n, real *t, integer *ldt, real *q, integer *ldq, real *wr, real *wi,
+ integer *m, real *s, real *sep, real *work, integer *lwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int strsna_(char *job, char *howmny, logical *select,
+ integer *n, real *t, integer *ldt, real *vl, integer *ldvl, real *vr,
+ integer *ldvr, real *s, real *sep, integer *mm, integer *m, real *
+ work, integer *ldwork, integer *iwork, integer *info);
+
+/* Subroutine */ int strsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, real *a, integer *lda, real *b, integer *ldb, real *
+ c__, integer *ldc, real *scale, integer *info);
+
+/* Subroutine */ int strti2_(char *uplo, char *diag, integer *n, real *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int strtri_(char *uplo, char *diag, integer *n, real *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int strtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, real *a, integer *lda, real *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int strttf_(char *transr, char *uplo, integer *n, real *a,
+ integer *lda, real *arf, integer *info);
+
+/* Subroutine */ int strttp_(char *uplo, integer *n, real *a, integer *lda,
+ real *ap, integer *info);
+
+/* Subroutine */ int stzrqf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, integer *info);
+
+/* Subroutine */ int stzrzf_(integer *m, integer *n, real *a, integer *lda,
+ real *tau, real *work, integer *lwork, integer *info);
+
+/* Subroutine */ int xerbla_(char *srname, integer *info);
+
+/* Subroutine */ int xerbla_array__(char *srname_array__, integer *
+ srname_len__, integer *info, ftnlen srname_array_len);
+
+/* Subroutine */ int zbdsqr_(char *uplo, integer *n, integer *ncvt, integer *
+ nru, integer *ncc, doublereal *d__, doublereal *e, doublecomplex *vt,
+ integer *ldvt, doublecomplex *u, integer *ldu, doublecomplex *c__,
+ integer *ldc, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zcgesv_(integer *n, integer *nrhs, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublecomplex *work, complex *swork,
+ doublereal *rwork, integer *iter, integer *info);
+
+/* Subroutine */ int zcposv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublecomplex *work, complex *swork,
+ doublereal *rwork, integer *iter, integer *info);
+
+/* Subroutine */ int zdrscl_(integer *n, doublereal *sa, doublecomplex *sx,
+ integer *incx);
+
+/* Subroutine */ int zgbbrd_(char *vect, integer *m, integer *n, integer *ncc,
+ integer *kl, integer *ku, doublecomplex *ab, integer *ldab,
+ doublereal *d__, doublereal *e, doublecomplex *q, integer *ldq,
+ doublecomplex *pt, integer *ldpt, doublecomplex *c__, integer *ldc,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbcon_(char *norm, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, doublereal *anorm,
+ doublereal *rcond, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgbequ_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, integer *
+ info);
+
+/* Subroutine */ int zgbequb_(integer *m, integer *n, integer *kl, integer *
+ ku, doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *
+ c__, doublereal *rowcnd, doublereal *colcnd, doublereal *amax,
+ integer *info);
+
+/* Subroutine */ int zgbrfs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublecomplex *ab, integer *ldab, doublecomplex *
+ afb, integer *ldafb, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbrfsx_(char *trans, char *equed, integer *n, integer *
+ kl, integer *ku, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *afb, integer *ldafb, integer *ipiv, doublereal *r__,
+ doublereal *c__, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *berr, integer *
+ n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbsv_(integer *n, integer *kl, integer *ku, integer *
+ nrhs, doublecomplex *ab, integer *ldab, integer *ipiv, doublecomplex *
+ b, integer *ldb, integer *info);
+
+/* Subroutine */ int zgbsvx_(char *fact, char *trans, integer *n, integer *kl,
+ integer *ku, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgbsvxx_(char *fact, char *trans, integer *n, integer *
+ kl, integer *ku, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *afb, integer *ldafb, integer *ipiv, char *equed,
+ doublereal *r__, doublereal *c__, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *rpvgrw,
+ doublereal *berr, integer *n_err_bnds__, doublereal *err_bnds_norm__,
+ doublereal *err_bnds_comp__, integer *nparams, doublereal *params,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgbtf2_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgbtrf_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgbtrs_(char *trans, integer *n, integer *kl, integer *
+ ku, integer *nrhs, doublecomplex *ab, integer *ldab, integer *ipiv,
+ doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zgebak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *scale, integer *m, doublecomplex *v,
+ integer *ldv, integer *info);
+
+/* Subroutine */ int zgebal_(char *job, integer *n, doublecomplex *a, integer
+ *lda, integer *ilo, integer *ihi, doublereal *scale, integer *info);
+
+/* Subroutine */ int zgebd2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgebrd_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tauq,
+ doublecomplex *taup, doublecomplex *work, integer *lwork, integer *
+ info);
+
+/* Subroutine */ int zgecon_(char *norm, integer *n, doublecomplex *a,
+ integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeequ_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd,
+ doublereal *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int zgeequb_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd,
+ doublereal *colcnd, doublereal *amax, integer *info);
+
+/* Subroutine */ int zgees_(char *jobvs, char *sort, L_fp select, integer *n,
+ doublecomplex *a, integer *lda, integer *sdim, doublecomplex *w,
+ doublecomplex *vs, integer *ldvs, doublecomplex *work, integer *lwork,
+ doublereal *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zgeesx_(char *jobvs, char *sort, L_fp select, char *
+ sense, integer *n, doublecomplex *a, integer *lda, integer *sdim,
+ doublecomplex *w, doublecomplex *vs, integer *ldvs, doublereal *
+ rconde, doublereal *rcondv, doublecomplex *work, integer *lwork,
+ doublereal *rwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zgeev_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *w, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *w,
+ doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *scale, doublereal *abnrm,
+ doublereal *rconde, doublereal *rcondv, doublecomplex *work, integer *
+ lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgegs_(char *jobvsl, char *jobvsr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vsl,
+ integer *ldvsl, doublecomplex *vsr, integer *ldvsr, doublecomplex *
+ work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgegv_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vl, integer
+ *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work, integer
+ *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgehd2_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zgehrd_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgelq2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgelqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgelsd_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *s, doublereal *rcond, integer *rank, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zgelss_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *s, doublereal *rcond, integer *rank, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgelsx_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *jpvt, doublereal *rcond, integer *rank, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgelsy_(integer *m, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *jpvt, doublereal *rcond, integer *rank, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeql2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgeqlf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgeqp3_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeqpf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *jpvt, doublecomplex *tau, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgeqr2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgeqrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgerfs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgerfsx_(char *trans, char *equed, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublereal *r__, doublereal *c__, doublecomplex *
+ b, integer *ldb, doublecomplex *x, integer *ldx, doublereal *rcond,
+ doublereal *berr, integer *n_err_bnds__, doublereal *err_bnds_norm__,
+ doublereal *err_bnds_comp__, integer *nparams, doublereal *params,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgerq2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgerqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zgesc2_(integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *rhs, integer *ipiv, integer *jpiv, doublereal *scale);
+
+/* Subroutine */ int zgesdd_(char *jobz, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublereal *s, doublecomplex *u,
+ integer *ldu, doublecomplex *vt, integer *ldvt, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zgesv_(integer *n, integer *nrhs, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *b, integer *ldb, integer *
+ info);
+
+/* Subroutine */ int zgesvd_(char *jobu, char *jobvt, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublereal *s, doublecomplex *u,
+ integer *ldu, doublecomplex *vt, integer *ldvt, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgesvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgesvxx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, char *equed, doublereal *r__, doublereal *c__,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *rpvgrw, doublereal *berr, integer *
+ n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgetc2_(integer *n, doublecomplex *a, integer *lda,
+ integer *ipiv, integer *jpiv, integer *info);
+
+/* Subroutine */ int zgetf2_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgetrf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zgetri_(integer *n, doublecomplex *a, integer *lda,
+ integer *ipiv, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgetrs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int zggbak_(char *job, char *side, integer *n, integer *ilo,
+ integer *ihi, doublereal *lscale, doublereal *rscale, integer *m,
+ doublecomplex *v, integer *ldv, integer *info);
+
+/* Subroutine */ int zggbal_(char *job, integer *n, doublecomplex *a, integer
+ *lda, doublecomplex *b, integer *ldb, integer *ilo, integer *ihi,
+ doublereal *lscale, doublereal *rscale, doublereal *work, integer *
+ info);
+
+/* Subroutine */ int zgges_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, integer *sdim, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *vsl, integer *ldvsl, doublecomplex *vsr, integer
+ *ldvsr, doublecomplex *work, integer *lwork, doublereal *rwork,
+ logical *bwork, integer *info);
+
+/* Subroutine */ int zggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
+ selctg, char *sense, integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, integer *sdim, doublecomplex *alpha,
+ doublecomplex *beta, doublecomplex *vsl, integer *ldvsl,
+ doublecomplex *vsr, integer *ldvsr, doublereal *rconde, doublereal *
+ rcondv, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, integer *liwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zggev_(char *jobvl, char *jobvr, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *vl, integer
+ *ldvl, doublecomplex *vr, integer *ldvr, doublecomplex *work, integer
+ *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zggevx_(char *balanc, char *jobvl, char *jobvr, char *
+ sense, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *alpha, doublecomplex *beta,
+ doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *ilo, integer *ihi, doublereal *lscale, doublereal *rscale,
+ doublereal *abnrm, doublereal *bbnrm, doublereal *rconde, doublereal *
+ rcondv, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, logical *bwork, integer *info);
+
+/* Subroutine */ int zggglm_(integer *n, integer *m, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *d__, doublecomplex *x, doublecomplex *y, doublecomplex
+ *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zgghrd_(char *compq, char *compz, integer *n, integer *
+ ilo, integer *ihi, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *q, integer *ldq, doublecomplex *z__,
+ integer *ldz, integer *info);
+
+/* Subroutine */ int zgglse_(integer *m, integer *n, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, doublecomplex *d__, doublecomplex *x,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zggqrf_(integer *n, integer *m, integer *p,
+ doublecomplex *a, integer *lda, doublecomplex *taua, doublecomplex *b,
+ integer *ldb, doublecomplex *taub, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zggrqf_(integer *m, integer *p, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *taua, doublecomplex *b,
+ integer *ldb, doublecomplex *taub, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zggsvd_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *n, integer *p, integer *k, integer *l, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb, doublereal *alpha,
+ doublereal *beta, doublecomplex *u, integer *ldu, doublecomplex *v,
+ integer *ldv, doublecomplex *q, integer *ldq, doublecomplex *work,
+ doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zggsvp_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, doublecomplex *a, integer *lda, doublecomplex
+ *b, integer *ldb, doublereal *tola, doublereal *tolb, integer *k,
+ integer *l, doublecomplex *u, integer *ldu, doublecomplex *v, integer
+ *ldv, doublecomplex *q, integer *ldq, integer *iwork, doublereal *
+ rwork, doublecomplex *tau, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zgtcon_(char *norm, integer *n, doublecomplex *dl,
+ doublecomplex *d__, doublecomplex *du, doublecomplex *du2, integer *
+ ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *work,
+ integer *info);
+
+/* Subroutine */ int zgtrfs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *dlf, doublecomplex *df, doublecomplex *duf,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zgtsv_(integer *n, integer *nrhs, doublecomplex *dl,
+ doublecomplex *d__, doublecomplex *du, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zgtsvx_(char *fact, char *trans, integer *n, integer *
+ nrhs, doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *dlf, doublecomplex *df, doublecomplex *duf,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zgttrf_(integer *n, doublecomplex *dl, doublecomplex *
+ d__, doublecomplex *du, doublecomplex *du2, integer *ipiv, integer *
+ info);
+
+/* Subroutine */ int zgttrs_(char *trans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zgtts2_(integer *itrans, integer *n, integer *nrhs,
+ doublecomplex *dl, doublecomplex *d__, doublecomplex *du,
+ doublecomplex *du2, integer *ipiv, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zhbev_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbevd_(char *jobz, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhbevx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *kd, doublecomplex *ab, integer *ldab, doublecomplex *q,
+ integer *ldq, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, doublereal *rwork, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int zhbgst_(char *vect, char *uplo, integer *n, integer *ka,
+ integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb,
+ integer *ldbb, doublecomplex *x, integer *ldx, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbgv_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb,
+ integer *ldbb, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhbgvd_(char *jobz, char *uplo, integer *n, integer *ka,
+ integer *kb, doublecomplex *ab, integer *ldab, doublecomplex *bb,
+ integer *ldbb, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *
+ lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhbgvx_(char *jobz, char *range, char *uplo, integer *n,
+ integer *ka, integer *kb, doublecomplex *ab, integer *ldab,
+ doublecomplex *bb, integer *ldbb, doublecomplex *q, integer *ldq,
+ doublereal *vl, doublereal *vu, integer *il, integer *iu, doublereal *
+ abstol, integer *m, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int zhbtrd_(char *vect, char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *d__, doublereal *e,
+ doublecomplex *q, integer *ldq, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhecon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublereal *anorm, doublereal *rcond,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zheequb_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zheev_(char *jobz, char *uplo, integer *n, doublecomplex
+ *a, integer *lda, doublereal *w, doublecomplex *work, integer *lwork,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zheevd_(char *jobz, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *w, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int zheevr_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *vl, doublereal *vu,
+ integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *
+ w, doublecomplex *z__, integer *ldz, integer *isuppz, doublecomplex *
+ work, integer *lwork, doublereal *rwork, integer *lrwork, integer *
+ iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zheevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublereal *vl, doublereal *vu,
+ integer *il, integer *iu, doublereal *abstol, integer *m, doublereal *
+ w, doublecomplex *z__, integer *ldz, doublecomplex *work, integer *
+ lwork, doublereal *rwork, integer *iwork, integer *ifail, integer *
+ info);
+
+/* Subroutine */ int zhegs2_(integer *itype, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhegst_(integer *itype, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhegv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *w, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zhegvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublereal *w, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhegvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublereal *vl, doublereal *vu, integer *il, integer *
+ iu, doublereal *abstol, integer *m, doublereal *w, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, doublereal *rwork,
+ integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int zherfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zherfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublereal *s, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *berr,
+ integer *n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhesv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zhesvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhesvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, char *equed, doublereal *s, doublecomplex *b,
+ integer *ldb, doublecomplex *x, integer *ldx, doublereal *rcond,
+ doublereal *rpvgrw, doublereal *berr, integer *n_err_bnds__,
+ doublereal *err_bnds_norm__, doublereal *err_bnds_comp__, integer *
+ nparams, doublereal *params, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zhetd2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau,
+ integer *info);
+
+/* Subroutine */ int zhetf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zhetrd_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *d__, doublereal *e, doublecomplex *tau,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zhetrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zhetri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhetrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int zhfrk_(char *transr, char *uplo, char *trans, integer *n,
+ integer *k, doublereal *alpha, doublecomplex *a, integer *lda,
+ doublereal *beta, doublecomplex *c__);
+
+/* Subroutine */ int zhgeqz_(char *job, char *compq, char *compz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *t, integer *ldt, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *
+ ldz, doublecomplex *work, integer *lwork, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpcon_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zhpev_(char *jobz, char *uplo, integer *n, doublecomplex
+ *ap, doublereal *w, doublecomplex *z__, integer *ldz, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhpevd_(char *jobz, char *uplo, integer *n,
+ doublecomplex *ap, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *
+ lrwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zhpevx_(char *jobz, char *range, char *uplo, integer *n,
+ doublecomplex *ap, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublecomplex *z__, integer *ldz, doublecomplex *work, doublereal *
+ rwork, integer *iwork, integer *ifail, integer *info);
+
+/* Subroutine */ int zhpgst_(integer *itype, char *uplo, integer *n,
+ doublecomplex *ap, doublecomplex *bp, integer *info);
+
+/* Subroutine */ int zhpgv_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *ap, doublecomplex *bp, doublereal *w, doublecomplex
+ *z__, integer *ldz, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpgvd_(integer *itype, char *jobz, char *uplo, integer *
+ n, doublecomplex *ap, doublecomplex *bp, doublereal *w, doublecomplex
+ *z__, integer *ldz, doublecomplex *work, integer *lwork, doublereal *
+ rwork, integer *lrwork, integer *iwork, integer *liwork, integer *
+ info);
+
+/* Subroutine */ int zhpgvx_(integer *itype, char *jobz, char *range, char *
+ uplo, integer *n, doublecomplex *ap, doublecomplex *bp, doublereal *
+ vl, doublereal *vu, integer *il, integer *iu, doublereal *abstol,
+ integer *m, doublereal *w, doublecomplex *z__, integer *ldz,
+ doublecomplex *work, doublereal *rwork, integer *iwork, integer *
+ ifail, integer *info);
+
+/* Subroutine */ int zhprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, integer *ipiv, doublecomplex *
+ b, integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zhpsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhpsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, integer *ipiv,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zhptrd_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *d__, doublereal *e, doublecomplex *tau, integer *info);
+
+/* Subroutine */ int zhptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int zhptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zhptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zhsein_(char *side, char *eigsrc, char *initv, logical *
+ select, integer *n, doublecomplex *h__, integer *ldh, doublecomplex *
+ w, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *ldvr,
+ integer *mm, integer *m, doublecomplex *work, doublereal *rwork,
+ integer *ifaill, integer *ifailr, integer *info);
+
+/* Subroutine */ int zhseqr_(char *job, char *compz, integer *n, integer *ilo,
+ integer *ihi, doublecomplex *h__, integer *ldh, doublecomplex *w,
+ doublecomplex *z__, integer *ldz, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zla_gbamv__(integer *trans, integer *m, integer *n,
+ integer *kl, integer *ku, doublereal *alpha, doublecomplex *ab,
+ integer *ldab, doublecomplex *x, integer *incx, doublereal *beta,
+ doublereal *y, integer *incy);
+
+doublereal zla_gbrcond_c__(char *trans, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *ldafb,
+ integer *ipiv, doublereal *c__, logical *capply, integer *info,
+ doublecomplex *work, doublereal *rwork, ftnlen trans_len);
+
+doublereal zla_gbrcond_x__(char *trans, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *ldafb,
+ integer *ipiv, doublecomplex *x, integer *info, doublecomplex *work,
+ doublereal *rwork, ftnlen trans_len);
+
+/* Subroutine */ int zla_gbrfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *kl, integer *ku, integer *nrhs,
+ doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *ldafb,
+ integer *ipiv, logical *colequ, doublereal *c__, doublecomplex *b,
+ integer *ldb, doublecomplex *y, integer *ldy, doublereal *berr_out__,
+ integer *n_norms__, doublereal *errs_n__, doublereal *errs_c__,
+ doublecomplex *res, doublereal *ayb, doublecomplex *dy, doublecomplex
+ *y_tail__, doublereal *rcond, integer *ithresh, doublereal *rthresh,
+ doublereal *dz_ub__, logical *ignore_cwise__, integer *info);
+
+doublereal zla_gbrpvgrw__(integer *n, integer *kl, integer *ku, integer *
+ ncols, doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *
+ ldafb);
+
+/* Subroutine */ int zla_geamv__(integer *trans, integer *m, integer *n,
+ doublereal *alpha, doublecomplex *a, integer *lda, doublecomplex *x,
+ integer *incx, doublereal *beta, doublereal *y, integer *incy);
+
+doublereal zla_gercond_c__(char *trans, integer *n, doublecomplex *a, integer
+ *lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublereal *
+ c__, logical *capply, integer *info, doublecomplex *work, doublereal *
+ rwork, ftnlen trans_len);
+
+doublereal zla_gercond_x__(char *trans, integer *n, doublecomplex *a, integer
+ *lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublecomplex *
+ x, integer *info, doublecomplex *work, doublereal *rwork, ftnlen
+ trans_len);
+
+/* Subroutine */ int zla_gerfsx_extended__(integer *prec_type__, integer *
+ trans_type__, integer *n, integer *nrhs, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, integer *ipiv, logical *colequ,
+ doublereal *c__, doublecomplex *b, integer *ldb, doublecomplex *y,
+ integer *ldy, doublereal *berr_out__, integer *n_norms__, doublereal *
+ errs_n__, doublereal *errs_c__, doublecomplex *res, doublereal *ayb,
+ doublecomplex *dy, doublecomplex *y_tail__, doublereal *rcond,
+ integer *ithresh, doublereal *rthresh, doublereal *dz_ub__, logical *
+ ignore_cwise__, integer *info);
+
+/* Subroutine */ int zla_heamv__(integer *uplo, integer *n, doublereal *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy);
+
+doublereal zla_hercond_c__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublereal *c__,
+ logical *capply, integer *info, doublecomplex *work, doublereal *
+ rwork, ftnlen uplo_len);
+
+doublereal zla_hercond_x__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublecomplex *
+ x, integer *info, doublecomplex *work, doublereal *rwork, ftnlen
+ uplo_len);
+
+/* Subroutine */ int zla_herfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, doublecomplex *a, integer *lda,
+ doublecomplex *af, integer *ldaf, integer *ipiv, logical *colequ,
+ doublereal *c__, doublecomplex *b, integer *ldb, doublecomplex *y,
+ integer *ldy, doublereal *berr_out__, integer *n_norms__, doublereal *
+ errs_n__, doublereal *errs_c__, doublecomplex *res, doublereal *ayb,
+ doublecomplex *dy, doublecomplex *y_tail__, doublereal *rcond,
+ integer *ithresh, doublereal *rthresh, doublereal *dz_ub__, logical *
+ ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal zla_herpvgrw__(char *uplo, integer *n, integer *info,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublereal *work, ftnlen uplo_len);
+
+/* Subroutine */ int zla_lin_berr__(integer *n, integer *nz, integer *nrhs,
+ doublecomplex *res, doublereal *ayb, doublereal *berr);
+
+doublereal zla_porcond_c__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, doublereal *c__, logical *
+ capply, integer *info, doublecomplex *work, doublereal *rwork, ftnlen
+ uplo_len);
+
+doublereal zla_porcond_x__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, doublecomplex *x, integer *
+ info, doublecomplex *work, doublereal *rwork, ftnlen uplo_len);
+
+/* Subroutine */ int zla_porfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, doublecomplex *a, integer *lda,
+ doublecomplex *af, integer *ldaf, logical *colequ, doublereal *c__,
+ doublecomplex *b, integer *ldb, doublecomplex *y, integer *ldy,
+ doublereal *berr_out__, integer *n_norms__, doublereal *errs_n__,
+ doublereal *errs_c__, doublecomplex *res, doublereal *ayb,
+ doublecomplex *dy, doublecomplex *y_tail__, doublereal *rcond,
+ integer *ithresh, doublereal *rthresh, doublereal *dz_ub__, logical *
+ ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal zla_porpvgrw__(char *uplo, integer *ncols, doublecomplex *a,
+ integer *lda, doublecomplex *af, integer *ldaf, doublereal *work,
+ ftnlen uplo_len);
+
+doublereal zla_rpvgrw__(integer *n, integer *ncols, doublecomplex *a, integer
+ *lda, doublecomplex *af, integer *ldaf);
+
+/* Subroutine */ int zla_syamv__(integer *uplo, integer *n, doublereal *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublereal *beta, doublereal *y, integer *incy);
+
+doublereal zla_syrcond_c__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublereal *c__,
+ logical *capply, integer *info, doublecomplex *work, doublereal *
+ rwork, ftnlen uplo_len);
+
+doublereal zla_syrcond_x__(char *uplo, integer *n, doublecomplex *a, integer *
+ lda, doublecomplex *af, integer *ldaf, integer *ipiv, doublecomplex *
+ x, integer *info, doublecomplex *work, doublereal *rwork, ftnlen
+ uplo_len);
+
+/* Subroutine */ int zla_syrfsx_extended__(integer *prec_type__, char *uplo,
+ integer *n, integer *nrhs, doublecomplex *a, integer *lda,
+ doublecomplex *af, integer *ldaf, integer *ipiv, logical *colequ,
+ doublereal *c__, doublecomplex *b, integer *ldb, doublecomplex *y,
+ integer *ldy, doublereal *berr_out__, integer *n_norms__, doublereal *
+ errs_n__, doublereal *errs_c__, doublecomplex *res, doublereal *ayb,
+ doublecomplex *dy, doublecomplex *y_tail__, doublereal *rcond,
+ integer *ithresh, doublereal *rthresh, doublereal *dz_ub__, logical *
+ ignore_cwise__, integer *info, ftnlen uplo_len);
+
+doublereal zla_syrpvgrw__(char *uplo, integer *n, integer *info,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublereal *work, ftnlen uplo_len);
+
+/* Subroutine */ int zla_wwaddw__(integer *n, doublecomplex *x, doublecomplex
+ *y, doublecomplex *w);
+
+/* Subroutine */ int zlabrd_(integer *m, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *d__, doublereal *e,
+ doublecomplex *tauq, doublecomplex *taup, doublecomplex *x, integer *
+ ldx, doublecomplex *y, integer *ldy);
+
+/* Subroutine */ int zlacgv_(integer *n, doublecomplex *x, integer *incx);
+
+/* Subroutine */ int zlacn2_(integer *n, doublecomplex *v, doublecomplex *x,
+ doublereal *est, integer *kase, integer *isave);
+
+/* Subroutine */ int zlacon_(integer *n, doublecomplex *v, doublecomplex *x,
+ doublereal *est, integer *kase);
+
+/* Subroutine */ int zlacp2_(char *uplo, integer *m, integer *n, doublereal *
+ a, integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlacpy_(char *uplo, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlacrm_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *b, integer *ldb, doublecomplex *c__,
+ integer *ldc, doublereal *rwork);
+
+/* Subroutine */ int zlacrt_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublecomplex *c__, doublecomplex *
+ s);
+
+/* Double Complex */ VOID zladiv_(doublecomplex * ret_val, doublecomplex *x,
+ doublecomplex *y);
+
+/* Subroutine */ int zlaed0_(integer *qsiz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *q, integer *ldq, doublecomplex *qstore,
+ integer *ldqs, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlaed7_(integer *n, integer *cutpnt, integer *qsiz,
+ integer *tlvls, integer *curlvl, integer *curpbm, doublereal *d__,
+ doublecomplex *q, integer *ldq, doublereal *rho, integer *indxq,
+ doublereal *qstore, integer *qptr, integer *prmptr, integer *perm,
+ integer *givptr, integer *givcol, doublereal *givnum, doublecomplex *
+ work, doublereal *rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlaed8_(integer *k, integer *n, integer *qsiz,
+ doublecomplex *q, integer *ldq, doublereal *d__, doublereal *rho,
+ integer *cutpnt, doublereal *z__, doublereal *dlamda, doublecomplex *
+ q2, integer *ldq2, doublereal *w, integer *indxp, integer *indx,
+ integer *indxq, integer *perm, integer *givptr, integer *givcol,
+ doublereal *givnum, integer *info);
+
+/* Subroutine */ int zlaein_(logical *rightv, logical *noinit, integer *n,
+ doublecomplex *h__, integer *ldh, doublecomplex *w, doublecomplex *v,
+ doublecomplex *b, integer *ldb, doublereal *rwork, doublereal *eps3,
+ doublereal *smlnum, integer *info);
+
+/* Subroutine */ int zlaesy_(doublecomplex *a, doublecomplex *b,
+ doublecomplex *c__, doublecomplex *rt1, doublecomplex *rt2,
+ doublecomplex *evscal, doublecomplex *cs1, doublecomplex *sn1);
+
+/* Subroutine */ int zlaev2_(doublecomplex *a, doublecomplex *b,
+ doublecomplex *c__, doublereal *rt1, doublereal *rt2, doublereal *cs1,
+ doublecomplex *sn1);
+
+/* Subroutine */ int zlag2c_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, complex *sa, integer *ldsa, integer *info);
+
+/* Subroutine */ int zlags2_(logical *upper, doublereal *a1, doublecomplex *
+ a2, doublereal *a3, doublereal *b1, doublecomplex *b2, doublereal *b3,
+ doublereal *csu, doublecomplex *snu, doublereal *csv, doublecomplex *
+ snv, doublereal *csq, doublecomplex *snq);
+
+/* Subroutine */ int zlagtm_(char *trans, integer *n, integer *nrhs,
+ doublereal *alpha, doublecomplex *dl, doublecomplex *d__,
+ doublecomplex *du, doublecomplex *x, integer *ldx, doublereal *beta,
+ doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zlahef_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *w,
+ integer *ldw, integer *info);
+
+/* Subroutine */ int zlahqr_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, integer *info);
+
+/* Subroutine */ int zlahr2_(integer *n, integer *k, integer *nb,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t,
+ integer *ldt, doublecomplex *y, integer *ldy);
+
+/* Subroutine */ int zlahrd_(integer *n, integer *k, integer *nb,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *t,
+ integer *ldt, doublecomplex *y, integer *ldy);
+
+/* Subroutine */ int zlaic1_(integer *job, integer *j, doublecomplex *x,
+ doublereal *sest, doublecomplex *w, doublecomplex *gamma, doublereal *
+ sestpr, doublecomplex *s, doublecomplex *c__);
+
+/* Subroutine */ int zlals0_(integer *icompq, integer *nl, integer *nr,
+ integer *sqre, integer *nrhs, doublecomplex *b, integer *ldb,
+ doublecomplex *bx, integer *ldbx, integer *perm, integer *givptr,
+ integer *givcol, integer *ldgcol, doublereal *givnum, integer *ldgnum,
+ doublereal *poles, doublereal *difl, doublereal *difr, doublereal *
+ z__, integer *k, doublereal *c__, doublereal *s, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zlalsa_(integer *icompq, integer *smlsiz, integer *n,
+ integer *nrhs, doublecomplex *b, integer *ldb, doublecomplex *bx,
+ integer *ldbx, doublereal *u, integer *ldu, doublereal *vt, integer *
+ k, doublereal *difl, doublereal *difr, doublereal *z__, doublereal *
+ poles, integer *givptr, integer *givcol, integer *ldgcol, integer *
+ perm, doublereal *givnum, doublereal *c__, doublereal *s, doublereal *
+ rwork, integer *iwork, integer *info);
+
+/* Subroutine */ int zlalsd_(char *uplo, integer *smlsiz, integer *n, integer
+ *nrhs, doublereal *d__, doublereal *e, doublecomplex *b, integer *ldb,
+ doublereal *rcond, integer *rank, doublecomplex *work, doublereal *
+ rwork, integer *iwork, integer *info);
+
+doublereal zlangb_(char *norm, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublereal *work);
+
+doublereal zlange_(char *norm, integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *work);
+
+doublereal zlangt_(char *norm, integer *n, doublecomplex *dl, doublecomplex *
+ d__, doublecomplex *du);
+
+doublereal zlanhb_(char *norm, char *uplo, integer *n, integer *k,
+ doublecomplex *ab, integer *ldab, doublereal *work);
+
+doublereal zlanhe_(char *norm, char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *work);
+
+doublereal zlanhf_(char *norm, char *transr, char *uplo, integer *n,
+ doublecomplex *a, doublereal *work);
+
+doublereal zlanhp_(char *norm, char *uplo, integer *n, doublecomplex *ap,
+ doublereal *work);
+
+doublereal zlanhs_(char *norm, integer *n, doublecomplex *a, integer *lda,
+ doublereal *work);
+
+doublereal zlanht_(char *norm, integer *n, doublereal *d__, doublecomplex *e);
+
+doublereal zlansb_(char *norm, char *uplo, integer *n, integer *k,
+ doublecomplex *ab, integer *ldab, doublereal *work);
+
+doublereal zlansp_(char *norm, char *uplo, integer *n, doublecomplex *ap,
+ doublereal *work);
+
+doublereal zlansy_(char *norm, char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *work);
+
+doublereal zlantb_(char *norm, char *uplo, char *diag, integer *n, integer *k,
+ doublecomplex *ab, integer *ldab, doublereal *work);
+
+doublereal zlantp_(char *norm, char *uplo, char *diag, integer *n,
+ doublecomplex *ap, doublereal *work);
+
+doublereal zlantr_(char *norm, char *uplo, char *diag, integer *m, integer *n,
+ doublecomplex *a, integer *lda, doublereal *work);
+
+/* Subroutine */ int zlapll_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *ssmin);
+
+/* Subroutine */ int zlapmt_(logical *forwrd, integer *m, integer *n,
+ doublecomplex *x, integer *ldx, integer *k);
+
+/* Subroutine */ int zlaqgb_(integer *m, integer *n, integer *kl, integer *ku,
+ doublecomplex *ab, integer *ldab, doublereal *r__, doublereal *c__,
+ doublereal *rowcnd, doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqge_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublereal *r__, doublereal *c__, doublereal *rowcnd,
+ doublereal *colcnd, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqhb_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqhe_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int zlaqhp_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqp2_(integer *m, integer *n, integer *offset,
+ doublecomplex *a, integer *lda, integer *jpvt, doublecomplex *tau,
+ doublereal *vn1, doublereal *vn2, doublecomplex *work);
+
+/* Subroutine */ int zlaqps_(integer *m, integer *n, integer *offset, integer
+ *nb, integer *kb, doublecomplex *a, integer *lda, integer *jpvt,
+ doublecomplex *tau, doublereal *vn1, doublereal *vn2, doublecomplex *
+ auxv, doublecomplex *f, integer *ldf);
+
+/* Subroutine */ int zlaqr0_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zlaqr1_(integer *n, doublecomplex *h__, integer *ldh,
+ doublecomplex *s1, doublecomplex *s2, doublecomplex *v);
+
+/* Subroutine */ int zlaqr2_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, doublecomplex *h__,
+ integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, integer *ns, integer *nd, doublecomplex *sh,
+ doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t,
+ integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv,
+ doublecomplex *work, integer *lwork);
+
+/* Subroutine */ int zlaqr3_(logical *wantt, logical *wantz, integer *n,
+ integer *ktop, integer *kbot, integer *nw, doublecomplex *h__,
+ integer *ldh, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, integer *ns, integer *nd, doublecomplex *sh,
+ doublecomplex *v, integer *ldv, integer *nh, doublecomplex *t,
+ integer *ldt, integer *nv, doublecomplex *wv, integer *ldwv,
+ doublecomplex *work, integer *lwork);
+
+/* Subroutine */ int zlaqr4_(logical *wantt, logical *wantz, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *h__, integer *ldh,
+ doublecomplex *w, integer *iloz, integer *ihiz, doublecomplex *z__,
+ integer *ldz, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zlaqr5_(logical *wantt, logical *wantz, integer *kacc22,
+ integer *n, integer *ktop, integer *kbot, integer *nshfts,
+ doublecomplex *s, doublecomplex *h__, integer *ldh, integer *iloz,
+ integer *ihiz, doublecomplex *z__, integer *ldz, doublecomplex *v,
+ integer *ldv, doublecomplex *u, integer *ldu, integer *nv,
+ doublecomplex *wv, integer *ldwv, integer *nh, doublecomplex *wh,
+ integer *ldwh);
+
+/* Subroutine */ int zlaqsb_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqsp_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, char *equed);
+
+/* Subroutine */ int zlaqsy_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ char *equed);
+
+/* Subroutine */ int zlar1v_(integer *n, integer *b1, integer *bn, doublereal
+ *lambda, doublereal *d__, doublereal *l, doublereal *ld, doublereal *
+ lld, doublereal *pivmin, doublereal *gaptol, doublecomplex *z__,
+ logical *wantnc, integer *negcnt, doublereal *ztz, doublereal *mingma,
+ integer *r__, integer *isuppz, doublereal *nrminv, doublereal *resid,
+ doublereal *rqcorr, doublereal *work);
+
+/* Subroutine */ int zlar2v_(integer *n, doublecomplex *x, doublecomplex *y,
+ doublecomplex *z__, integer *incx, doublereal *c__, doublecomplex *s,
+ integer *incc);
+
+/* Subroutine */ int zlarcm_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublecomplex *b, integer *ldb, doublecomplex *c__, integer *ldc,
+ doublereal *rwork);
+
+/* Subroutine */ int zlarf_(char *side, integer *m, integer *n, doublecomplex
+ *v, integer *incv, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work);
+
+/* Subroutine */ int zlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublecomplex *v, integer
+ *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__, integer *
+ ldc, doublecomplex *work, integer *ldwork);
+
+/* Subroutine */ int zlarfg_(integer *n, doublecomplex *alpha, doublecomplex *
+ x, integer *incx, doublecomplex *tau);
+
+/* Subroutine */ int zlarfp_(integer *n, doublecomplex *alpha, doublecomplex *
+ x, integer *incx, doublecomplex *tau);
+
+/* Subroutine */ int zlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *
+ t, integer *ldt);
+
+/* Subroutine */ int zlarfx_(char *side, integer *m, integer *n,
+ doublecomplex *v, doublecomplex *tau, doublecomplex *c__, integer *
+ ldc, doublecomplex *work);
+
+/* Subroutine */ int zlargv_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *c__, integer *incc);
+
+/* Subroutine */ int zlarnv_(integer *idist, integer *iseed, integer *n,
+ doublecomplex *x);
+
+/* Subroutine */ int zlarrv_(integer *n, doublereal *vl, doublereal *vu,
+ doublereal *d__, doublereal *l, doublereal *pivmin, integer *isplit,
+ integer *m, integer *dol, integer *dou, doublereal *minrgp,
+ doublereal *rtol1, doublereal *rtol2, doublereal *w, doublereal *werr,
+ doublereal *wgap, integer *iblock, integer *indexw, doublereal *gers,
+ doublecomplex *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *iwork, integer *info);
+
+/* Subroutine */ int zlarscl2_(integer *m, integer *n, doublereal *d__,
+ doublecomplex *x, integer *ldx);
+
+/* Subroutine */ int zlartg_(doublecomplex *f, doublecomplex *g, doublereal *
+ cs, doublecomplex *sn, doublecomplex *r__);
+
+/* Subroutine */ int zlartv_(integer *n, doublecomplex *x, integer *incx,
+ doublecomplex *y, integer *incy, doublereal *c__, doublecomplex *s,
+ integer *incc);
+
+/* Subroutine */ int zlarz_(char *side, integer *m, integer *n, integer *l,
+ doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *
+ c__, integer *ldc, doublecomplex *work);
+
+/* Subroutine */ int zlarzb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, integer *l, doublecomplex
+ *v, integer *ldv, doublecomplex *t, integer *ldt, doublecomplex *c__,
+ integer *ldc, doublecomplex *work, integer *ldwork);
+
+/* Subroutine */ int zlarzt_(char *direct, char *storev, integer *n, integer *
+ k, doublecomplex *v, integer *ldv, doublecomplex *tau, doublecomplex *
+ t, integer *ldt);
+
+/* Subroutine */ int zlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int zlascl2_(integer *m, integer *n, doublereal *d__,
+ doublecomplex *x, integer *ldx);
+
+/* Subroutine */ int zlaset_(char *uplo, integer *m, integer *n,
+ doublecomplex *alpha, doublecomplex *beta, doublecomplex *a, integer *
+ lda);
+
+/* Subroutine */ int zlasr_(char *side, char *pivot, char *direct, integer *m,
+ integer *n, doublereal *c__, doublereal *s, doublecomplex *a,
+ integer *lda);
+
+/* Subroutine */ int zlassq_(integer *n, doublecomplex *x, integer *incx,
+ doublereal *scale, doublereal *sumsq);
+
+/* Subroutine */ int zlaswp_(integer *n, doublecomplex *a, integer *lda,
+ integer *k1, integer *k2, integer *ipiv, integer *incx);
+
+/* Subroutine */ int zlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *w,
+ integer *ldw, integer *info);
+
+/* Subroutine */ int zlat2c_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, complex *sa, integer *ldsa, integer *info);
+
+/* Subroutine */ int zlatbs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, integer *kd, doublecomplex *ab, integer *ldab,
+ doublecomplex *x, doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatdf_(integer *ijob, integer *n, doublecomplex *z__,
+ integer *ldz, doublecomplex *rhs, doublereal *rdsum, doublereal *
+ rdscal, integer *ipiv, integer *jpiv);
+
+/* Subroutine */ int zlatps_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublecomplex *ap, doublecomplex *x, doublereal *
+ scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatrd_(char *uplo, integer *n, integer *nb,
+ doublecomplex *a, integer *lda, doublereal *e, doublecomplex *tau,
+ doublecomplex *w, integer *ldw);
+
+/* Subroutine */ int zlatrs_(char *uplo, char *trans, char *diag, char *
+ normin, integer *n, doublecomplex *a, integer *lda, doublecomplex *x,
+ doublereal *scale, doublereal *cnorm, integer *info);
+
+/* Subroutine */ int zlatrz_(integer *m, integer *n, integer *l,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work);
+
+/* Subroutine */ int zlatzm_(char *side, integer *m, integer *n,
+ doublecomplex *v, integer *incv, doublecomplex *tau, doublecomplex *
+ c1, doublecomplex *c2, integer *ldc, doublecomplex *work);
+
+/* Subroutine */ int zlauu2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zlauum_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpbcon_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *anorm, doublereal *
+ rcond, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpbequ_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, doublereal *s, doublereal *scond,
+ doublereal *amax, integer *info);
+
+/* Subroutine */ int zpbrfs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *afb, integer *
+ ldafb, doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zpbstf_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbsv_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int zpbsvx_(char *fact, char *uplo, integer *n, integer *kd,
+ integer *nrhs, doublecomplex *ab, integer *ldab, doublecomplex *afb,
+ integer *ldafb, char *equed, doublereal *s, doublecomplex *b, integer
+ *ldb, doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *
+ ferr, doublereal *berr, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zpbtf2_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbtrf_(char *uplo, integer *n, integer *kd,
+ doublecomplex *ab, integer *ldab, integer *info);
+
+/* Subroutine */ int zpbtrs_(char *uplo, integer *n, integer *kd, integer *
+ nrhs, doublecomplex *ab, integer *ldab, doublecomplex *b, integer *
+ ldb, integer *info);
+
+/* Subroutine */ int zpftrf_(char *transr, char *uplo, integer *n,
+ doublecomplex *a, integer *info);
+
+/* Subroutine */ int zpftri_(char *transr, char *uplo, integer *n,
+ doublecomplex *a, integer *info);
+
+/* Subroutine */ int zpftrs_(char *transr, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zpocon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpoequ_(integer *n, doublecomplex *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int zpoequb_(integer *n, doublecomplex *a, integer *lda,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int zporfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zporfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, doublereal *s, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *berr, integer *
+ n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zposv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zposvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, char *equed, doublereal *s, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zposvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, char *equed, doublereal *s, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *rpvgrw,
+ doublereal *berr, integer *n_err_bnds__, doublereal *err_bnds_norm__,
+ doublereal *err_bnds_comp__, integer *nparams, doublereal *params,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpotf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *info);
+
+/* Subroutine */ int zpotrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zppcon_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *anorm, doublereal *rcond, doublecomplex *work, doublereal
+ *rwork, integer *info);
+
+/* Subroutine */ int zppequ_(char *uplo, integer *n, doublecomplex *ap,
+ doublereal *s, doublereal *scond, doublereal *amax, integer *info);
+
+/* Subroutine */ int zpprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zppsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zppsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, char *equed, doublereal *
+ s, doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *info);
+
+/* Subroutine */ int zpptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *info);
+
+/* Subroutine */ int zpptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zpstf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *piv, integer *rank, doublereal *tol,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int zpstrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *piv, integer *rank, doublereal *tol,
+ doublereal *work, integer *info);
+
+/* Subroutine */ int zptcon_(integer *n, doublereal *d__, doublecomplex *e,
+ doublereal *anorm, doublereal *rcond, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zpteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int zptrfs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublereal *df, doublecomplex *ef,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int zptsv_(integer *n, integer *nrhs, doublereal *d__,
+ doublecomplex *e, doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int zptsvx_(char *fact, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublereal *df, doublecomplex *ef,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zpttrf_(integer *n, doublereal *d__, doublecomplex *e,
+ integer *info);
+
+/* Subroutine */ int zpttrs_(char *uplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zptts2_(integer *iuplo, integer *n, integer *nrhs,
+ doublereal *d__, doublecomplex *e, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int zrot_(integer *n, doublecomplex *cx, integer *incx,
+ doublecomplex *cy, integer *incy, doublereal *c__, doublecomplex *s);
+
+/* Subroutine */ int zspcon_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublereal *anorm, doublereal *rcond, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zspmv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *ap, doublecomplex *x, integer *incx, doublecomplex *
+ beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zspr_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *ap);
+
+/* Subroutine */ int zsprfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, doublecomplex *afp, integer *ipiv, doublecomplex *
+ b, integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int zspsv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zspsvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *ap, doublecomplex *afp, integer *ipiv,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *rcond, doublereal *ferr, doublereal *berr, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsptrf_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, integer *info);
+
+/* Subroutine */ int zsptri_(char *uplo, integer *n, doublecomplex *ap,
+ integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsptrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *ap, integer *ipiv, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int zstedc_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublecomplex *work,
+ integer *lwork, doublereal *rwork, integer *lrwork, integer *iwork,
+ integer *liwork, integer *info);
+
+/* Subroutine */ int zstegr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, doublereal *abstol, integer *m, doublereal *w,
+ doublecomplex *z__, integer *ldz, integer *isuppz, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zstein_(integer *n, doublereal *d__, doublereal *e,
+ integer *m, doublereal *w, integer *iblock, integer *isplit,
+ doublecomplex *z__, integer *ldz, doublereal *work, integer *iwork,
+ integer *ifail, integer *info);
+
+/* Subroutine */ int zstemr_(char *jobz, char *range, integer *n, doublereal *
+ d__, doublereal *e, doublereal *vl, doublereal *vu, integer *il,
+ integer *iu, integer *m, doublereal *w, doublecomplex *z__, integer *
+ ldz, integer *nzc, integer *isuppz, logical *tryrac, doublereal *work,
+ integer *lwork, integer *iwork, integer *liwork, integer *info);
+
+/* Subroutine */ int zsteqr_(char *compz, integer *n, doublereal *d__,
+ doublereal *e, doublecomplex *z__, integer *ldz, doublereal *work,
+ integer *info);
+
+/* Subroutine */ int zsycon_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublereal *anorm, doublereal *rcond,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsyequb_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublereal *s, doublereal *scond, doublereal *amax,
+ doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsymv_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *a, integer *lda, doublecomplex *x, integer *incx,
+ doublecomplex *beta, doublecomplex *y, integer *incy);
+
+/* Subroutine */ int zsyr_(char *uplo, integer *n, doublecomplex *alpha,
+ doublecomplex *x, integer *incx, doublecomplex *a, integer *lda);
+
+/* Subroutine */ int zsyrfs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, doublecomplex *af, integer *ldaf,
+ integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *ferr, doublereal *berr, doublecomplex *work,
+ doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsyrfsx_(char *uplo, char *equed, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublereal *s, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *rcond, doublereal *berr,
+ integer *n_err_bnds__, doublereal *err_bnds_norm__, doublereal *
+ err_bnds_comp__, integer *nparams, doublereal *params, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsysv_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int zsysvx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, doublecomplex *b, integer *ldb, doublecomplex *x,
+ integer *ldx, doublereal *rcond, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, integer *lwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int zsysvxx_(char *fact, char *uplo, integer *n, integer *
+ nrhs, doublecomplex *a, integer *lda, doublecomplex *af, integer *
+ ldaf, integer *ipiv, char *equed, doublereal *s, doublecomplex *b,
+ integer *ldb, doublecomplex *x, integer *ldx, doublereal *rcond,
+ doublereal *rpvgrw, doublereal *berr, integer *n_err_bnds__,
+ doublereal *err_bnds_norm__, doublereal *err_bnds_comp__, integer *
+ nparams, doublereal *params, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int zsytf2_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, integer *info);
+
+/* Subroutine */ int zsytrf_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zsytri_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, integer *ipiv, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zsytrs_(char *uplo, integer *n, integer *nrhs,
+ doublecomplex *a, integer *lda, integer *ipiv, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ztbcon_(char *norm, char *uplo, char *diag, integer *n,
+ integer *kd, doublecomplex *ab, integer *ldab, doublereal *rcond,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztbrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *b, integer *ldb, doublecomplex *x, integer *ldx,
+ doublereal *ferr, doublereal *berr, doublecomplex *work, doublereal *
+ rwork, integer *info);
+
+/* Subroutine */ int ztbtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *kd, integer *nrhs, doublecomplex *ab, integer *ldab,
+ doublecomplex *b, integer *ldb, integer *info);
+
+/* Subroutine */ int ztfsm_(char *transr, char *side, char *uplo, char *trans,
+ char *diag, integer *m, integer *n, doublecomplex *alpha,
+ doublecomplex *a, doublecomplex *b, integer *ldb);
+
+/* Subroutine */ int ztftri_(char *transr, char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *info);
+
+/* Subroutine */ int ztfttp_(char *transr, char *uplo, integer *n,
+ doublecomplex *arf, doublecomplex *ap, integer *info);
+
+/* Subroutine */ int ztfttr_(char *transr, char *uplo, integer *n,
+ doublecomplex *arf, doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztgevc_(char *side, char *howmny, logical *select,
+ integer *n, doublecomplex *s, integer *lds, doublecomplex *p, integer
+ *ldp, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *
+ ldvr, integer *mm, integer *m, doublecomplex *work, doublereal *rwork,
+ integer *info);
+
+/* Subroutine */ int ztgex2_(logical *wantq, logical *wantz, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz,
+ integer *j1, integer *info);
+
+/* Subroutine */ int ztgexc_(logical *wantq, logical *wantz, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *q, integer *ldq, doublecomplex *z__, integer *ldz,
+ integer *ifst, integer *ilst, integer *info);
+
+/* Subroutine */ int ztgsen_(integer *ijob, logical *wantq, logical *wantz,
+ logical *select, integer *n, doublecomplex *a, integer *lda,
+ doublecomplex *b, integer *ldb, doublecomplex *alpha, doublecomplex *
+ beta, doublecomplex *q, integer *ldq, doublecomplex *z__, integer *
+ ldz, integer *m, doublereal *pl, doublereal *pr, doublereal *dif,
+ doublecomplex *work, integer *lwork, integer *iwork, integer *liwork,
+ integer *info);
+
+/* Subroutine */ int ztgsja_(char *jobu, char *jobv, char *jobq, integer *m,
+ integer *p, integer *n, integer *k, integer *l, doublecomplex *a,
+ integer *lda, doublecomplex *b, integer *ldb, doublereal *tola,
+ doublereal *tolb, doublereal *alpha, doublereal *beta, doublecomplex *
+ u, integer *ldu, doublecomplex *v, integer *ldv, doublecomplex *q,
+ integer *ldq, doublecomplex *work, integer *ncycle, integer *info);
+
+/* Subroutine */ int ztgsna_(char *job, char *howmny, logical *select,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *b, integer
+ *ldb, doublecomplex *vl, integer *ldvl, doublecomplex *vr, integer *
+ ldvr, doublereal *s, doublereal *dif, integer *mm, integer *m,
+ doublecomplex *work, integer *lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ztgsy2_(char *trans, integer *ijob, integer *m, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, integer *ldc, doublecomplex *d__, integer *ldd,
+ doublecomplex *e, integer *lde, doublecomplex *f, integer *ldf,
+ doublereal *scale, doublereal *rdsum, doublereal *rdscal, integer *
+ info);
+
+/* Subroutine */ int ztgsyl_(char *trans, integer *ijob, integer *m, integer *
+ n, doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
+ doublecomplex *c__, integer *ldc, doublecomplex *d__, integer *ldd,
+ doublecomplex *e, integer *lde, doublecomplex *f, integer *ldf,
+ doublereal *scale, doublereal *dif, doublecomplex *work, integer *
+ lwork, integer *iwork, integer *info);
+
+/* Subroutine */ int ztpcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublecomplex *ap, doublereal *rcond, doublecomplex *work, doublereal
+ *rwork, integer *info);
+
+/* Subroutine */ int ztprfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *ap, doublecomplex *b, integer *ldb,
+ doublecomplex *x, integer *ldx, doublereal *ferr, doublereal *berr,
+ doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztptri_(char *uplo, char *diag, integer *n,
+ doublecomplex *ap, integer *info);
+
+/* Subroutine */ int ztptrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *ap, doublecomplex *b, integer *ldb,
+ integer *info);
+
+/* Subroutine */ int ztpttf_(char *transr, char *uplo, integer *n,
+ doublecomplex *ap, doublecomplex *arf, integer *info);
+
+/* Subroutine */ int ztpttr_(char *uplo, integer *n, doublecomplex *ap,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztrcon_(char *norm, char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, doublereal *rcond, doublecomplex *
+ work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrevc_(char *side, char *howmny, logical *select,
+ integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, integer *mm, integer
+ *m, doublecomplex *work, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrexc_(char *compq, integer *n, doublecomplex *t,
+ integer *ldt, doublecomplex *q, integer *ldq, integer *ifst, integer *
+ ilst, integer *info);
+
+/* Subroutine */ int ztrrfs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *x, integer *ldx, doublereal *ferr,
+ doublereal *berr, doublecomplex *work, doublereal *rwork, integer *
+ info);
+
+/* Subroutine */ int ztrsen_(char *job, char *compq, logical *select, integer
+ *n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq,
+ doublecomplex *w, integer *m, doublereal *s, doublereal *sep,
+ doublecomplex *work, integer *lwork, integer *info);
+
+/* Subroutine */ int ztrsna_(char *job, char *howmny, logical *select,
+ integer *n, doublecomplex *t, integer *ldt, doublecomplex *vl,
+ integer *ldvl, doublecomplex *vr, integer *ldvr, doublereal *s,
+ doublereal *sep, integer *mm, integer *m, doublecomplex *work,
+ integer *ldwork, doublereal *rwork, integer *info);
+
+/* Subroutine */ int ztrsyl_(char *trana, char *tranb, integer *isgn, integer
+ *m, integer *n, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, doublecomplex *c__, integer *ldc, doublereal *scale,
+ integer *info);
+
+/* Subroutine */ int ztrti2_(char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztrtri_(char *uplo, char *diag, integer *n,
+ doublecomplex *a, integer *lda, integer *info);
+
+/* Subroutine */ int ztrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublecomplex *a, integer *lda, doublecomplex *b,
+ integer *ldb, integer *info);
+
+/* Subroutine */ int ztrttf_(char *transr, char *uplo, integer *n,
+ doublecomplex *a, integer *lda, doublecomplex *arf, integer *info);
+
+/* Subroutine */ int ztrttp_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *ap, integer *info);
+
+/* Subroutine */ int ztzrqf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, integer *info);
+
+/* Subroutine */ int ztzrzf_(integer *m, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zung2l_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zung2r_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zungbr_(char *vect, integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zunghr_(integer *n, integer *ilo, integer *ihi,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungl2_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zunglq_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungql_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungqr_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungr2_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zungrq_(integer *m, integer *n, integer *k,
+ doublecomplex *a, integer *lda, doublecomplex *tau, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zungtr_(char *uplo, integer *n, doublecomplex *a,
+ integer *lda, doublecomplex *tau, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunm2l_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmbr_(char *vect, char *side, char *trans, integer *m,
+ integer *n, integer *k, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zunmhr_(char *side, char *trans, integer *m, integer *n,
+ integer *ilo, integer *ihi, doublecomplex *a, integer *lda,
+ doublecomplex *tau, doublecomplex *c__, integer *ldc, doublecomplex *
+ work, integer *lwork, integer *info);
+
+/* Subroutine */ int zunml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmql_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmr2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int zunmr3_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ info);
+
+/* Subroutine */ int zunmrq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zunmrz_(char *side, char *trans, integer *m, integer *n,
+ integer *k, integer *l, doublecomplex *a, integer *lda, doublecomplex
+ *tau, doublecomplex *c__, integer *ldc, doublecomplex *work, integer *
+ lwork, integer *info);
+
+/* Subroutine */ int zunmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublecomplex *a, integer *lda, doublecomplex *tau,
+ doublecomplex *c__, integer *ldc, doublecomplex *work, integer *lwork,
+ integer *info);
+
+/* Subroutine */ int zupgtr_(char *uplo, integer *n, doublecomplex *ap,
+ doublecomplex *tau, doublecomplex *q, integer *ldq, doublecomplex *
+ work, integer *info);
+
+/* Subroutine */ int zupmtr_(char *side, char *uplo, char *trans, integer *m,
+ integer *n, doublecomplex *ap, doublecomplex *tau, doublecomplex *c__,
+ integer *ldc, doublecomplex *work, integer *info);
+
+/* Subroutine */ int dlamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1);
+
+doublereal dsecnd_();
+
+/* Subroutine */ int ilaver_(integer *vers_major__, integer *vers_minor__,
+ integer *vers_patch__);
+
+logical lsame_(char *ca, char *cb);
+
+doublereal second_();
+
+doublereal slamch_(char *cmach);
+
+/* Subroutine */ int slamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1);
+
+/* Subroutine */ int slamc2_(integer *beta, integer *t, logical *rnd, real *
+ eps, integer *emin, real *rmin, integer *emax, real *rmax);
+
+doublereal slamc3_(real *a, real *b);
+
+/* Subroutine */ int slamc4_(integer *emin, real *start, integer *base);
+
+/* Subroutine */ int slamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, real *rmax);
+
+
+doublereal dlamch_(char *cmach);
+
+/* Subroutine */ int dlamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1);
+
+/* Subroutine */ int dlamc2_(integer *beta, integer *t, logical *rnd,
+ doublereal *eps, integer *emin, doublereal *rmin, integer *emax,
+ doublereal *rmax);
+
+doublereal dlamc3_(doublereal *a, doublereal *b);
+
+/* Subroutine */ int dlamc4_(integer *emin, doublereal *start, integer *base);
+
+/* Subroutine */ int dlamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, doublereal *rmax);
+
+integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
+ integer *n2, integer *n3, integer *n4);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif /* __CLAPACK_H */
+
diff --git a/src/lib/yac/clapack/INCLUDE/f2c.h b/src/lib/yac/clapack/INCLUDE/f2c.h
new file mode 100644
index 000000000..bbcf1cbbf
--- /dev/null
+++ b/src/lib/yac/clapack/INCLUDE/f2c.h
@@ -0,0 +1,228 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* f2c.h -- Standard Fortran to C header file */
+
+/** barf [ba:rf] 2. "He suggested using FORTRAN, and everybody barfed."
+
+ - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) */
+
+#ifndef F2C_INCLUDE
+#define F2C_INCLUDE
+
+typedef int integer;
+typedef unsigned long int uinteger;
+typedef char *address;
+typedef short int shortint;
+typedef float real;
+typedef double doublereal;
+typedef struct { real r, i; } complex;
+typedef struct { doublereal r, i; } doublecomplex;
+typedef long int logical;
+typedef short int shortlogical;
+typedef char logical1;
+typedef char integer1;
+#ifdef INTEGER_STAR_8 /* Adjust for integer*8. */
+typedef long long longint; /* system-dependent */
+typedef unsigned long long ulongint; /* system-dependent */
+#define qbit_clear(a,b) ((a) & ~((ulongint)1 << (b)))
+#define qbit_set(a,b) ((a) | ((ulongint)1 << (b)))
+#endif
+
+#define TRUE_ (1)
+#define FALSE_ (0)
+
+/* Extern is for use with -E */
+#ifndef Extern
+#define Extern extern
+#endif
+
+/* I/O stuff */
+
+#ifdef f2c_i2
+/* for -i2 */
+typedef short flag;
+typedef short ftnlen;
+typedef short ftnint;
+#else
+typedef long int flag;
+typedef long int ftnlen;
+typedef long int ftnint;
+#endif
+
+/*external read, write*/
+typedef struct
+{ flag cierr;
+ ftnint ciunit;
+ flag ciend;
+ char *cifmt;
+ ftnint cirec;
+} cilist;
+
+/*internal read, write*/
+typedef struct
+{ flag icierr;
+ char *iciunit;
+ flag iciend;
+ char *icifmt;
+ ftnint icirlen;
+ ftnint icirnum;
+} icilist;
+
+/*open*/
+typedef struct
+{ flag oerr;
+ ftnint ounit;
+ char *ofnm;
+ ftnlen ofnmlen;
+ char *osta;
+ char *oacc;
+ char *ofm;
+ ftnint orl;
+ char *oblnk;
+} olist;
+
+/*close*/
+typedef struct
+{ flag cerr;
+ ftnint cunit;
+ char *csta;
+} cllist;
+
+/*rewind, backspace, endfile*/
+typedef struct
+{ flag aerr;
+ ftnint aunit;
+} alist;
+
+/* inquire */
+typedef struct
+{ flag inerr;
+ ftnint inunit;
+ char *infile;
+ ftnlen infilen;
+ ftnint *inex; /*parameters in standard's order*/
+ ftnint *inopen;
+ ftnint *innum;
+ ftnint *innamed;
+ char *inname;
+ ftnlen innamlen;
+ char *inacc;
+ ftnlen inacclen;
+ char *inseq;
+ ftnlen inseqlen;
+ char *indir;
+ ftnlen indirlen;
+ char *infmt;
+ ftnlen infmtlen;
+ char *inform;
+ ftnint informlen;
+ char *inunf;
+ ftnlen inunflen;
+ ftnint *inrecl;
+ ftnint *innrec;
+ char *inblank;
+ ftnlen inblanklen;
+} inlist;
+
+#define VOID void
+
+union Multitype { /* for multiple entry points */
+ integer1 g;
+ shortint h;
+ integer i;
+ /* longint j; */
+ real r;
+ doublereal d;
+ complex c;
+ doublecomplex z;
+ };
+
+typedef union Multitype Multitype;
+
+/*typedef long int Long;*/ /* No longer used; formerly in Namelist */
+
+struct Vardesc { /* for Namelist */
+ char *name;
+ char *addr;
+ ftnlen *dims;
+ int type;
+ };
+typedef struct Vardesc Vardesc;
+
+struct Namelist {
+ char *name;
+ Vardesc **vars;
+ int nvars;
+ };
+typedef struct Namelist Namelist;
+
+#define abs(x) ((x) >= 0 ? (x) : -(x))
+#define dabs(x) (doublereal)abs(x)
+#define min(a,b) ((a) <= (b) ? (a) : (b))
+#define max(a,b) ((a) >= (b) ? (a) : (b))
+#define dmin(a,b) (doublereal)min(a,b)
+#define dmax(a,b) (doublereal)max(a,b)
+#define bit_test(a,b) ((a) >> (b) & 1)
+#define bit_clear(a,b) ((a) & ~((uinteger)1 << (b)))
+#define bit_set(a,b) ((a) | ((uinteger)1 << (b)))
+
+/* procedure parameter types for -A and -C++ */
+
+#define F2C_proc_par_types 1
+#ifdef __cplusplus
+typedef int /* Unknown procedure type */ (*U_fp)(...);
+typedef shortint (*J_fp)(...);
+typedef integer (*I_fp)(...);
+typedef real (*R_fp)(...);
+typedef doublereal (*D_fp)(...), (*E_fp)(...);
+typedef /* Complex */ VOID (*C_fp)(...);
+typedef /* Double Complex */ VOID (*Z_fp)(...);
+typedef logical (*L_fp)(...);
+typedef shortlogical (*K_fp)(...);
+typedef /* Character */ VOID (*H_fp)(...);
+typedef /* Subroutine */ int (*S_fp)(...);
+#else
+typedef int /* Unknown procedure type */ (*U_fp)();
+typedef shortint (*J_fp)();
+typedef integer (*I_fp)();
+typedef real (*R_fp)();
+typedef doublereal (*D_fp)(), (*E_fp)();
+typedef /* Complex */ VOID (*C_fp)();
+typedef /* Double Complex */ VOID (*Z_fp)();
+typedef logical (*L_fp)();
+typedef shortlogical (*K_fp)();
+typedef /* Character */ VOID (*H_fp)();
+typedef /* Subroutine */ int (*S_fp)();
+#endif
+/* E_fp is for real functions when -R is not specified */
+typedef VOID C_f; /* complex function */
+typedef VOID H_f; /* character function */
+typedef VOID Z_f; /* double complex function */
+typedef doublereal E_f; /* real function with -R not specified */
+
+/* undef any lower-case symbols that your C compiler predefines, e.g.: */
+
+#ifndef Skip_f2c_Undefs
+#undef cray
+#undef gcos
+#undef mc68010
+#undef mc68020
+#undef mips
+#undef pdp11
+#undef sgi
+#undef sparc
+#undef sun
+#undef sun2
+#undef sun3
+#undef sun4
+#undef u370
+#undef u3b
+#undef u3b2
+#undef u3b5
+#undef unix
+#undef vax
+#endif
+#endif
+
diff --git a/src/lib/yac/clapack/INSTALL/dlamch.c b/src/lib/yac/clapack/INSTALL/dlamch.c
new file mode 100644
index 000000000..596721369
--- /dev/null
+++ b/src/lib/yac/clapack/INSTALL/dlamch.c
@@ -0,0 +1,1006 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlamch.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b32 = 0.;
+
+doublereal dlamch_(char *cmach)
+{
+ /* Initialized data */
+
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ integer i__1;
+ doublereal ret_val;
+
+ /* Builtin functions */
+ double pow_di(doublereal *, integer *);
+
+ /* Local variables */
+ static doublereal t;
+ integer it;
+ static doublereal rnd, eps, base;
+ integer beta;
+ static doublereal emin, prec, emax;
+ integer imin, imax;
+ logical lrnd;
+ static doublereal rmin, rmax;
+ doublereal rmach;
+ extern logical lsame_(char *, char *);
+ doublereal small;
+ static doublereal sfmin;
+ extern /* Subroutine */ int dlamc2_(integer *, integer *, logical *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMCH determines double precision machine parameters. */
+
+/* Arguments */
+/* ========= */
+
+/* CMACH (input) CHARACTER*1 */
+/* Specifies the value to be returned by DLAMCH: */
+/* = 'E' or 'e', DLAMCH := eps */
+/* = 'S' or 's , DLAMCH := sfmin */
+/* = 'B' or 'b', DLAMCH := base */
+/* = 'P' or 'p', DLAMCH := eps*base */
+/* = 'N' or 'n', DLAMCH := t */
+/* = 'R' or 'r', DLAMCH := rnd */
+/* = 'M' or 'm', DLAMCH := emin */
+/* = 'U' or 'u', DLAMCH := rmin */
+/* = 'L' or 'l', DLAMCH := emax */
+/* = 'O' or 'o', DLAMCH := rmax */
+
+/* where */
+
+/* eps = relative machine precision */
+/* sfmin = safe minimum, such that 1/sfmin does not overflow */
+/* base = base of the machine */
+/* prec = eps*base */
+/* t = number of (base) digits in the mantissa */
+/* rnd = 1.0 when rounding occurs in addition, 0.0 otherwise */
+/* emin = minimum exponent before (gradual) underflow */
+/* rmin = underflow threshold - base**(emin-1) */
+/* emax = largest exponent before overflow */
+/* rmax = overflow threshold - (base**emax)*(1-eps) */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Save statement .. */
+/* .. */
+/* .. Data statements .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ if (first) {
+ dlamc2_(&beta, &it, &lrnd, &eps, &imin, &rmin, &imax, &rmax);
+ base = (doublereal) beta;
+ t = (doublereal) it;
+ if (lrnd) {
+ rnd = 1.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1) / 2;
+ } else {
+ rnd = 0.;
+ i__1 = 1 - it;
+ eps = pow_di(&base, &i__1);
+ }
+ prec = eps * base;
+ emin = (doublereal) imin;
+ emax = (doublereal) imax;
+ sfmin = rmin;
+ small = 1. / rmax;
+ if (small >= sfmin) {
+
+/* Use SMALL plus a bit, to avoid the possibility of rounding */
+/* causing overflow when computing 1/sfmin. */
+
+ sfmin = small * (eps + 1.);
+ }
+ }
+
+ if (lsame_(cmach, "E")) {
+ rmach = eps;
+ } else if (lsame_(cmach, "S")) {
+ rmach = sfmin;
+ } else if (lsame_(cmach, "B")) {
+ rmach = base;
+ } else if (lsame_(cmach, "P")) {
+ rmach = prec;
+ } else if (lsame_(cmach, "N")) {
+ rmach = t;
+ } else if (lsame_(cmach, "R")) {
+ rmach = rnd;
+ } else if (lsame_(cmach, "M")) {
+ rmach = emin;
+ } else if (lsame_(cmach, "U")) {
+ rmach = rmin;
+ } else if (lsame_(cmach, "L")) {
+ rmach = emax;
+ } else if (lsame_(cmach, "O")) {
+ rmach = rmax;
+ }
+
+ ret_val = rmach;
+ first = FALSE_;
+ return ret_val;
+
+/* End of DLAMCH */
+
+} /* dlamch_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */ int dlamc1_(integer *beta, integer *t, logical *rnd, logical
+ *ieee1)
+{
+ /* Initialized data */
+
+ static logical first = TRUE_;
+
+ /* System generated locals */
+ doublereal d__1, d__2;
+
+ /* Local variables */
+ doublereal a, b, c__, f, t1, t2;
+ static integer lt;
+ doublereal one, qtr;
+ static logical lrnd;
+ static integer lbeta;
+ doublereal savec;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ static logical lieee1;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMC1 determines the machine parameters given by BETA, T, RND, and */
+/* IEEE1. */
+
+/* Arguments */
+/* ========= */
+
+/* BETA (output) INTEGER */
+/* The base of the machine. */
+
+/* T (output) INTEGER */
+/* The number of ( BETA ) digits in the mantissa. */
+
+/* RND (output) LOGICAL */
+/* Specifies whether proper rounding ( RND = .TRUE. ) or */
+/* chopping ( RND = .FALSE. ) occurs in addition. This may not */
+/* be a reliable guide to the way in which the machine performs */
+/* its arithmetic. */
+
+/* IEEE1 (output) LOGICAL */
+/* Specifies whether rounding appears to be done in the IEEE */
+/* 'round to nearest' style. */
+
+/* Further Details */
+/* =============== */
+
+/* The routine is based on the routine ENVRON by Malcolm and */
+/* incorporates suggestions by Gentleman and Marovich. See */
+
+/* Malcolm M. A. (1972) Algorithms to reveal properties of */
+/* floating-point arithmetic. Comms. of the ACM, 15, 949-951. */
+
+/* Gentleman W. M. and Marovich S. B. (1974) More on algorithms */
+/* that reveal properties of floating point arithmetic units. */
+/* Comms. of the ACM, 17, 276-277. */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Save statement .. */
+/* .. */
+/* .. Data statements .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ if (first) {
+ one = 1.;
+
+/* LBETA, LIEEE1, LT and LRND are the local values of BETA, */
+/* IEEE1, T and RND. */
+
+/* Throughout this routine we use the function DLAMC3 to ensure */
+/* that relevant values are stored and not held in registers, or */
+/* are not affected by optimizers. */
+
+/* Compute a = 2.0**m with the smallest positive integer m such */
+/* that */
+
+/* fl( a + 1.0 ) = a. */
+
+ a = 1.;
+ c__ = 1.;
+
+/* + WHILE( C.EQ.ONE )LOOP */
+L10:
+ if (c__ == one) {
+ a *= 2;
+ c__ = dlamc3_(&a, &one);
+ d__1 = -a;
+ c__ = dlamc3_(&c__, &d__1);
+ goto L10;
+ }
+/* + END WHILE */
+
+/* Now compute b = 2.0**m with the smallest positive integer m */
+/* such that */
+
+/* fl( a + b ) .gt. a. */
+
+ b = 1.;
+ c__ = dlamc3_(&a, &b);
+
+/* + WHILE( C.EQ.A )LOOP */
+L20:
+ if (c__ == a) {
+ b *= 2;
+ c__ = dlamc3_(&a, &b);
+ goto L20;
+ }
+/* + END WHILE */
+
+/* Now compute the base. a and c are neighbouring floating point */
+/* numbers in the interval ( beta**t, beta**( t + 1 ) ) and so */
+/* their difference is beta. Adding 0.25 to c is to ensure that it */
+/* is truncated to beta and not ( beta - 1 ). */
+
+ qtr = one / 4;
+ savec = c__;
+ d__1 = -a;
+ c__ = dlamc3_(&c__, &d__1);
+ lbeta = (integer) (c__ + qtr);
+
+/* Now determine whether rounding or chopping occurs, by adding a */
+/* bit less than beta/2 and a bit more than beta/2 to a. */
+
+ b = (doublereal) lbeta;
+ d__1 = b / 2;
+ d__2 = -b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c__ = dlamc3_(&f, &a);
+ if (c__ == a) {
+ lrnd = TRUE_;
+ } else {
+ lrnd = FALSE_;
+ }
+ d__1 = b / 2;
+ d__2 = b / 100;
+ f = dlamc3_(&d__1, &d__2);
+ c__ = dlamc3_(&f, &a);
+ if (lrnd && c__ == a) {
+ lrnd = FALSE_;
+ }
+
+/* Try and decide whether rounding is done in the IEEE 'round to */
+/* nearest' style. B/2 is half a unit in the last place of the two */
+/* numbers A and SAVEC. Furthermore, A is even, i.e. has last bit */
+/* zero, and SAVEC is odd. Thus adding B/2 to A should not change */
+/* A, but adding B/2 to SAVEC should change SAVEC. */
+
+ d__1 = b / 2;
+ t1 = dlamc3_(&d__1, &a);
+ d__1 = b / 2;
+ t2 = dlamc3_(&d__1, &savec);
+ lieee1 = t1 == a && t2 > savec && lrnd;
+
+/* Now find the mantissa, t. It should be the integer part of */
+/* log to the base beta of a, however it is safer to determine t */
+/* by powering. So we find t as the smallest positive integer for */
+/* which */
+
+/* fl( beta**t + 1.0 ) = 1.0. */
+
+ lt = 0;
+ a = 1.;
+ c__ = 1.;
+
+/* + WHILE( C.EQ.ONE )LOOP */
+L30:
+ if (c__ == one) {
+ ++lt;
+ a *= lbeta;
+ c__ = dlamc3_(&a, &one);
+ d__1 = -a;
+ c__ = dlamc3_(&c__, &d__1);
+ goto L30;
+ }
+/* + END WHILE */
+
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *ieee1 = lieee1;
+ first = FALSE_;
+ return 0;
+
+/* End of DLAMC1 */
+
+} /* dlamc1_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */ int dlamc2_(integer *beta, integer *t, logical *rnd,
+ doublereal *eps, integer *emin, doublereal *rmin, integer *emax,
+ doublereal *rmax)
+{
+ /* Initialized data */
+
+ static logical first = TRUE_;
+ static logical iwarn = FALSE_;
+
+ /* Format strings */
+ static char fmt_9999[] = "(//\002 WARNING. The value EMIN may be incorre"
+ "ct:-\002,\002 EMIN = \002,i8,/\002 If, after inspection, the va"
+ "lue EMIN looks\002,\002 acceptable please comment out \002,/\002"
+ " the IF block as marked within the code of routine\002,\002 DLAM"
+ "C2,\002,/\002 otherwise supply EMIN explicitly.\002,/)";
+
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1, d__2, d__3, d__4, d__5;
+
+ /* Builtin functions */
+ double pow_di(doublereal *, integer *);
+ integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
+
+ /* Local variables */
+ doublereal a, b, c__;
+ integer i__;
+ static integer lt;
+ doublereal one, two;
+ logical ieee;
+ doublereal half;
+ logical lrnd;
+ static doublereal leps;
+ doublereal zero;
+ static integer lbeta;
+ doublereal rbase;
+ static integer lemin, lemax;
+ integer gnmin;
+ doublereal small;
+ integer gpmin;
+ doublereal third;
+ static doublereal lrmin, lrmax;
+ doublereal sixth;
+ extern /* Subroutine */ int dlamc1_(integer *, integer *, logical *,
+ logical *);
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ logical lieee1;
+ extern /* Subroutine */ int dlamc4_(integer *, doublereal *, integer *),
+ dlamc5_(integer *, integer *, integer *, logical *, integer *,
+ doublereal *);
+ integer ngnmin, ngpmin;
+
+ /* Fortran I/O blocks */
+ static cilist io___58 = { 0, 6, 0, fmt_9999, 0 };
+
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMC2 determines the machine parameters specified in its argument */
+/* list. */
+
+/* Arguments */
+/* ========= */
+
+/* BETA (output) INTEGER */
+/* The base of the machine. */
+
+/* T (output) INTEGER */
+/* The number of ( BETA ) digits in the mantissa. */
+
+/* RND (output) LOGICAL */
+/* Specifies whether proper rounding ( RND = .TRUE. ) or */
+/* chopping ( RND = .FALSE. ) occurs in addition. This may not */
+/* be a reliable guide to the way in which the machine performs */
+/* its arithmetic. */
+
+/* EPS (output) DOUBLE PRECISION */
+/* The smallest positive number such that */
+
+/* fl( 1.0 - EPS ) .LT. 1.0, */
+
+/* where fl denotes the computed value. */
+
+/* EMIN (output) INTEGER */
+/* The minimum exponent before (gradual) underflow occurs. */
+
+/* RMIN (output) DOUBLE PRECISION */
+/* The smallest normalized number for the machine, given by */
+/* BASE**( EMIN - 1 ), where BASE is the floating point value */
+/* of BETA. */
+
+/* EMAX (output) INTEGER */
+/* The maximum exponent before overflow occurs. */
+
+/* RMAX (output) DOUBLE PRECISION */
+/* The largest positive number for the machine, given by */
+/* BASE**EMAX * ( 1 - EPS ), where BASE is the floating point */
+/* value of BETA. */
+
+/* Further Details */
+/* =============== */
+
+/* The computation of EPS is based on a routine PARANOIA by */
+/* W. Kahan of the University of California at Berkeley. */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Save statement .. */
+/* .. */
+/* .. Data statements .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ if (first) {
+ zero = 0.;
+ one = 1.;
+ two = 2.;
+
+/* LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of */
+/* BETA, T, RND, EPS, EMIN and RMIN. */
+
+/* Throughout this routine we use the function DLAMC3 to ensure */
+/* that relevant values are stored and not held in registers, or */
+/* are not affected by optimizers. */
+
+/* DLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1. */
+
+ dlamc1_(&lbeta, <, &lrnd, &lieee1);
+
+/* Start to find EPS. */
+
+ b = (doublereal) lbeta;
+ i__1 = -lt;
+ a = pow_di(&b, &i__1);
+ leps = a;
+
+/* Try some tricks to see whether or not this is the correct EPS. */
+
+ b = two / 3;
+ half = one / 2;
+ d__1 = -half;
+ sixth = dlamc3_(&b, &d__1);
+ third = dlamc3_(&sixth, &sixth);
+ d__1 = -half;
+ b = dlamc3_(&third, &d__1);
+ b = dlamc3_(&b, &sixth);
+ b = abs(b);
+ if (b < leps) {
+ b = leps;
+ }
+
+ leps = 1.;
+
+/* + WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP */
+L10:
+ if (leps > b && b > zero) {
+ leps = b;
+ d__1 = half * leps;
+/* Computing 5th power */
+ d__3 = two, d__4 = d__3, d__3 *= d__3;
+/* Computing 2nd power */
+ d__5 = leps;
+ d__2 = d__4 * (d__3 * d__3) * (d__5 * d__5);
+ c__ = dlamc3_(&d__1, &d__2);
+ d__1 = -c__;
+ c__ = dlamc3_(&half, &d__1);
+ b = dlamc3_(&half, &c__);
+ d__1 = -b;
+ c__ = dlamc3_(&half, &d__1);
+ b = dlamc3_(&half, &c__);
+ goto L10;
+ }
+/* + END WHILE */
+
+ if (a < leps) {
+ leps = a;
+ }
+
+/* Computation of EPS complete. */
+
+/* Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)). */
+/* Keep dividing A by BETA until (gradual) underflow occurs. This */
+/* is detected when we cannot recover the previous A. */
+
+ rbase = one / lbeta;
+ small = one;
+ for (i__ = 1; i__ <= 3; ++i__) {
+ d__1 = small * rbase;
+ small = dlamc3_(&d__1, &zero);
+/* L20: */
+ }
+ a = dlamc3_(&one, &small);
+ dlamc4_(&ngpmin, &one, &lbeta);
+ d__1 = -one;
+ dlamc4_(&ngnmin, &d__1, &lbeta);
+ dlamc4_(&gpmin, &a, &lbeta);
+ d__1 = -a;
+ dlamc4_(&gnmin, &d__1, &lbeta);
+ ieee = FALSE_;
+
+ if (ngpmin == ngnmin && gpmin == gnmin) {
+ if (ngpmin == gpmin) {
+ lemin = ngpmin;
+/* ( Non twos-complement machines, no gradual underflow; */
+/* e.g., VAX ) */
+ } else if (gpmin - ngpmin == 3) {
+ lemin = ngpmin - 1 + lt;
+ ieee = TRUE_;
+/* ( Non twos-complement machines, with gradual underflow; */
+/* e.g., IEEE standard followers ) */
+ } else {
+ lemin = min(ngpmin,gpmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else if (ngpmin == gpmin && ngnmin == gnmin) {
+ if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1) {
+ lemin = max(ngpmin,ngnmin);
+/* ( Twos-complement machines, no gradual underflow; */
+/* e.g., CYBER 205 ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else if ((i__1 = ngpmin - ngnmin, abs(i__1)) == 1 && gpmin == gnmin)
+ {
+ if (gpmin - min(ngpmin,ngnmin) == 3) {
+ lemin = max(ngpmin,ngnmin) - 1 + lt;
+/* ( Twos-complement machines with gradual underflow; */
+/* no known machine ) */
+ } else {
+ lemin = min(ngpmin,ngnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+
+ } else {
+/* Computing MIN */
+ i__1 = min(ngpmin,ngnmin), i__1 = min(i__1,gpmin);
+ lemin = min(i__1,gnmin);
+/* ( A guess; no known machine ) */
+ iwarn = TRUE_;
+ }
+ first = FALSE_;
+/* ** */
+/* Comment out this if block if EMIN is ok */
+ if (iwarn) {
+ first = TRUE_;
+ s_wsfe(&io___58);
+ do_fio(&c__1, (char *)&lemin, (ftnlen)sizeof(integer));
+ e_wsfe();
+ }
+/* ** */
+
+/* Assume IEEE arithmetic if we found denormalised numbers above, */
+/* or if arithmetic seems to round in the IEEE style, determined */
+/* in routine DLAMC1. A true IEEE machine should have both things */
+/* true; however, faulty machines may have one or the other. */
+
+ ieee = ieee || lieee1;
+
+/* Compute RMIN by successive division by BETA. We could compute */
+/* RMIN as BASE**( EMIN - 1 ), but some machines underflow during */
+/* this computation. */
+
+ lrmin = 1.;
+ i__1 = 1 - lemin;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__1 = lrmin * rbase;
+ lrmin = dlamc3_(&d__1, &zero);
+/* L30: */
+ }
+
+/* Finally, call DLAMC5 to compute EMAX and RMAX. */
+
+ dlamc5_(&lbeta, <, &lemin, &ieee, &lemax, &lrmax);
+ }
+
+ *beta = lbeta;
+ *t = lt;
+ *rnd = lrnd;
+ *eps = leps;
+ *emin = lemin;
+ *rmin = lrmin;
+ *emax = lemax;
+ *rmax = lrmax;
+
+ return 0;
+
+
+/* End of DLAMC2 */
+
+} /* dlamc2_ */
+
+
+/* *********************************************************************** */
+
+doublereal dlamc3_(doublereal *a, doublereal *b)
+{
+ /* System generated locals */
+ doublereal ret_val;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMC3 is intended to force A and B to be stored prior to doing */
+/* the addition of A and B , for use in situations where optimizers */
+/* might hold one of these in a register. */
+
+/* Arguments */
+/* ========= */
+
+/* A (input) DOUBLE PRECISION */
+/* B (input) DOUBLE PRECISION */
+/* The values A and B. */
+
+/* ===================================================================== */
+
+/* .. Executable Statements .. */
+
+ ret_val = *a + *b;
+
+ return ret_val;
+
+/* End of DLAMC3 */
+
+} /* dlamc3_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */ int dlamc4_(integer *emin, doublereal *start, integer *base)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ doublereal a;
+ integer i__;
+ doublereal b1, b2, c1, c2, d1, d2, one, zero, rbase;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMC4 is a service routine for DLAMC2. */
+
+/* Arguments */
+/* ========= */
+
+/* EMIN (output) INTEGER */
+/* The minimum exponent before (gradual) underflow, computed by */
+/* setting A = START and dividing by BASE until the previous A */
+/* can not be recovered. */
+
+/* START (input) DOUBLE PRECISION */
+/* The starting point for determining EMIN. */
+
+/* BASE (input) INTEGER */
+/* The base of the machine. */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ a = *start;
+ one = 1.;
+ rbase = one / *base;
+ zero = 0.;
+ *emin = 1;
+ d__1 = a * rbase;
+ b1 = dlamc3_(&d__1, &zero);
+ c1 = a;
+ c2 = a;
+ d1 = a;
+ d2 = a;
+/* + WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND. */
+/* $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP */
+L10:
+ if (c1 == a && c2 == a && d1 == a && d2 == a) {
+ --(*emin);
+ a = b1;
+ d__1 = a / *base;
+ b1 = dlamc3_(&d__1, &zero);
+ d__1 = b1 * *base;
+ c1 = dlamc3_(&d__1, &zero);
+ d1 = zero;
+ i__1 = *base;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d1 += b1;
+/* L20: */
+ }
+ d__1 = a * rbase;
+ b2 = dlamc3_(&d__1, &zero);
+ d__1 = b2 / rbase;
+ c2 = dlamc3_(&d__1, &zero);
+ d2 = zero;
+ i__1 = *base;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d2 += b2;
+/* L30: */
+ }
+ goto L10;
+ }
+/* + END WHILE */
+
+ return 0;
+
+/* End of DLAMC4 */
+
+} /* dlamc4_ */
+
+
+/* *********************************************************************** */
+
+/* Subroutine */ int dlamc5_(integer *beta, integer *p, integer *emin,
+ logical *ieee, integer *emax, doublereal *rmax)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ integer i__;
+ doublereal y, z__;
+ integer try__, lexp;
+ doublereal oldy;
+ integer uexp, nbits;
+ extern doublereal dlamc3_(doublereal *, doublereal *);
+ doublereal recbas;
+ integer exbits, expsum;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAMC5 attempts to compute RMAX, the largest machine floating-point */
+/* number, without overflow. It assumes that EMAX + abs(EMIN) sum */
+/* approximately to a power of 2. It will fail on machines where this */
+/* assumption does not hold, for example, the Cyber 205 (EMIN = -28625, */
+/* EMAX = 28718). It will also fail if the value supplied for EMIN is */
+/* too large (i.e. too close to zero), probably with overflow. */
+
+/* Arguments */
+/* ========= */
+
+/* BETA (input) INTEGER */
+/* The base of floating-point arithmetic. */
+
+/* P (input) INTEGER */
+/* The number of base BETA digits in the mantissa of a */
+/* floating-point value. */
+
+/* EMIN (input) INTEGER */
+/* The minimum exponent before (gradual) underflow. */
+
+/* IEEE (input) LOGICAL */
+/* A logical flag specifying whether or not the arithmetic */
+/* system is thought to comply with the IEEE standard. */
+
+/* EMAX (output) INTEGER */
+/* The largest exponent before overflow */
+
+/* RMAX (output) DOUBLE PRECISION */
+/* The largest machine floating-point number. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* First compute LEXP and UEXP, two powers of 2 that bound */
+/* abs(EMIN). We then assume that EMAX + abs(EMIN) will sum */
+/* approximately to the bound that is closest to abs(EMIN). */
+/* (EMAX is the exponent of the required number RMAX). */
+
+ lexp = 1;
+ exbits = 1;
+L10:
+ try__ = lexp << 1;
+ if (try__ <= -(*emin)) {
+ lexp = try__;
+ ++exbits;
+ goto L10;
+ }
+ if (lexp == -(*emin)) {
+ uexp = lexp;
+ } else {
+ uexp = try__;
+ ++exbits;
+ }
+
+/* Now -LEXP is less than or equal to EMIN, and -UEXP is greater */
+/* than or equal to EMIN. EXBITS is the number of bits needed to */
+/* store the exponent. */
+
+ if (uexp + *emin > -lexp - *emin) {
+ expsum = lexp << 1;
+ } else {
+ expsum = uexp << 1;
+ }
+
+/* EXPSUM is the exponent range, approximately equal to */
+/* EMAX - EMIN + 1 . */
+
+ *emax = expsum + *emin - 1;
+ nbits = exbits + 1 + *p;
+
+/* NBITS is the total number of bits needed to store a */
+/* floating-point number. */
+
+ if (nbits % 2 == 1 && *beta == 2) {
+
+/* Either there are an odd number of bits used to store a */
+/* floating-point number, which is unlikely, or some bits are */
+/* not used in the representation of numbers, which is possible, */
+/* (e.g. Cray machines) or the mantissa has an implicit bit, */
+/* (e.g. IEEE machines, Dec Vax machines), which is perhaps the */
+/* most likely. We have to assume the last alternative. */
+/* If this is true, then we need to reduce EMAX by one because */
+/* there must be some way of representing zero in an implicit-bit */
+/* system. On machines like Cray, we are reducing EMAX by one */
+/* unnecessarily. */
+
+ --(*emax);
+ }
+
+ if (*ieee) {
+
+/* Assume we are on an IEEE machine which reserves one exponent */
+/* for infinity and NaN. */
+
+ --(*emax);
+ }
+
+/* Now create RMAX, the largest machine number, which should */
+/* be equal to (1.0 - BETA**(-P)) * BETA**EMAX . */
+
+/* First compute 1.0 - BETA**(-P), being careful that the */
+/* result is less than 1.0 . */
+
+ recbas = 1. / *beta;
+ z__ = *beta - 1.;
+ y = 0.;
+ i__1 = *p;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ z__ *= recbas;
+ if (y < 1.) {
+ oldy = y;
+ }
+ y = dlamc3_(&y, &z__);
+/* L20: */
+ }
+ if (y >= 1.) {
+ y = oldy;
+ }
+
+/* Now multiply by BETA**EMAX to get RMAX. */
+
+ i__1 = *emax;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ d__1 = y * *beta;
+ y = dlamc3_(&d__1, &c_b32);
+/* L30: */
+ }
+
+ *rmax = y;
+ return 0;
+
+/* End of DLAMC5 */
+
+} /* dlamc5_ */
+
diff --git a/src/lib/yac/clapack/INSTALL/lsame.c b/src/lib/yac/clapack/INSTALL/lsame.c
new file mode 100644
index 000000000..172404aaa
--- /dev/null
+++ b/src/lib/yac/clapack/INSTALL/lsame.c
@@ -0,0 +1,122 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* lsame.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+logical lsame_(char *ca, char *cb)
+{
+ /* System generated locals */
+ logical ret_val;
+
+ /* Local variables */
+ integer inta, intb, zcode;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* LSAME returns .TRUE. if CA is the same letter as CB regardless of */
+/* case. */
+
+/* Arguments */
+/* ========= */
+
+/* CA (input) CHARACTER*1 */
+/* CB (input) CHARACTER*1 */
+/* CA and CB specify the single characters to be compared. */
+
+/* ===================================================================== */
+
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test if the characters are equal */
+
+ ret_val = *(unsigned char *)ca == *(unsigned char *)cb;
+ if (ret_val) {
+ return ret_val;
+ }
+
+/* Now test for equivalence if both characters are alphabetic. */
+
+ zcode = 'Z';
+
+/* Use 'Z' rather than 'A' so that ASCII can be detected on Prime */
+/* machines, on which ICHAR returns a value with bit 8 set. */
+/* ICHAR('A') on Prime machines returns 193 which is the same as */
+/* ICHAR('A') on an EBCDIC machine. */
+
+ inta = *(unsigned char *)ca;
+ intb = *(unsigned char *)cb;
+
+ if (zcode == 90 || zcode == 122) {
+
+/* ASCII is assumed - ZCODE is the ASCII code of either lower or */
+/* upper case 'Z'. */
+
+ if (inta >= 97 && inta <= 122) {
+ inta += -32;
+ }
+ if (intb >= 97 && intb <= 122) {
+ intb += -32;
+ }
+
+ } else if (zcode == 233 || zcode == 169) {
+
+/* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or */
+/* upper case 'Z'. */
+
+ if (inta >= 129 && inta <= 137 || inta >= 145 && inta <= 153 || inta
+ >= 162 && inta <= 169) {
+ inta += 64;
+ }
+ if (intb >= 129 && intb <= 137 || intb >= 145 && intb <= 153 || intb
+ >= 162 && intb <= 169) {
+ intb += 64;
+ }
+
+ } else if (zcode == 218 || zcode == 250) {
+
+/* ASCII is assumed, on Prime machines - ZCODE is the ASCII code */
+/* plus 128 of either lower or upper case 'Z'. */
+
+ if (inta >= 225 && inta <= 250) {
+ inta += -32;
+ }
+ if (intb >= 225 && intb <= 250) {
+ intb += -32;
+ }
+ }
+ ret_val = inta == intb;
+
+/* RETURN */
+
+/* End of LSAME */
+
+ return ret_val;
+} /* lsame_ */
+
diff --git a/src/lib/yac/clapack/Makefile.am b/src/lib/yac/clapack/Makefile.am
new file mode 100644
index 000000000..28b7661cb
--- /dev/null
+++ b/src/lib/yac/clapack/Makefile.am
@@ -0,0 +1,100 @@
+# Copyright (c) 2024 The YAC Authors
+#
+# SPDX-License-Identifier: BSD-3-Clause
+
+noinst_LTLIBRARIES = libyac_clapack.la
+
+BUILT_SOURCES = sysdep1.h
+CLEANFILES = sysdep1.h
+EXTRA_DIST = F2CLIBS/libf2c/sysdep1.h0
+
+sysdep1.h: F2CLIBS/libf2c/sysdep1.h0
+ $(AM_V_GEN)cp $< $@
+
+AM_CPPFLAGS = -I$(srcdir)/INCLUDE
+AM_CFLAGS = $(PIC_CFLAGS)
+
+libyac_clapack_la_SOURCES = \
+ BLAS/SRC/dcopy.c \
+ BLAS/SRC/ddot.c \
+ BLAS/SRC/dgemm.c \
+ BLAS/SRC/dgemv.c \
+ BLAS/SRC/dger.c \
+ BLAS/SRC/dnrm2.c \
+ BLAS/SRC/dscal.c \
+ BLAS/SRC/dswap.c \
+ BLAS/SRC/dsymv.c \
+ BLAS/SRC/dsyr.c \
+ BLAS/SRC/dtrmm.c \
+ BLAS/SRC/dtrmv.c \
+ BLAS/SRC/dtrsm.c \
+ BLAS/SRC/idamax.c \
+ F2CLIBS/libf2c/close.c \
+ F2CLIBS/libf2c/d_lg10.c \
+ F2CLIBS/libf2c/d_sign.c \
+ F2CLIBS/libf2c/endfile.c \
+ F2CLIBS/libf2c/err.c \
+ F2CLIBS/libf2c/exit_.c \
+ F2CLIBS/libf2c/f77_aloc.c \
+ F2CLIBS/libf2c/fio.h \
+ F2CLIBS/libf2c/fmt.c \
+ F2CLIBS/libf2c/fmt.h \
+ F2CLIBS/libf2c/fmtlib.c \
+ F2CLIBS/libf2c/fp.h \
+ F2CLIBS/libf2c/i_nint.c \
+ F2CLIBS/libf2c/open.c \
+ F2CLIBS/libf2c/pow_di.c \
+ F2CLIBS/libf2c/s_cat.c \
+ F2CLIBS/libf2c/s_cmp.c \
+ F2CLIBS/libf2c/s_copy.c \
+ F2CLIBS/libf2c/sfe.c \
+ F2CLIBS/libf2c/sig_die.c \
+ F2CLIBS/libf2c/util.c \
+ F2CLIBS/libf2c/wref.c \
+ F2CLIBS/libf2c/wrtfmt.c \
+ F2CLIBS/libf2c/wsfe.c \
+ INCLUDE/blaswrap.h \
+ INCLUDE/clapack.h \
+ INCLUDE/f2c.h \
+ INSTALL/dlamch.c \
+ INSTALL/lsame.c \
+ SRC/dgelq2.c \
+ SRC/dgelqf.c \
+ SRC/dgels.c \
+ SRC/dgeqr2.c \
+ SRC/dgeqrf.c \
+ SRC/dgesv.c \
+ SRC/dgetf2.c \
+ SRC/dgetrf.c \
+ SRC/dgetri.c \
+ SRC/dgetrs.c \
+ SRC/disnan.c \
+ SRC/dlabad.c \
+ SRC/dlaisnan.c \
+ SRC/dlange.c \
+ SRC/dlapy2.c \
+ SRC/dlarfb.c \
+ SRC/dlarf.c \
+ SRC/dlarfp.c \
+ SRC/dlarft.c \
+ SRC/dlascl.c \
+ SRC/dlaset.c \
+ SRC/dlassq.c \
+ SRC/dlaswp.c \
+ SRC/dlasyf.c \
+ SRC/dorm2r.c \
+ SRC/dorml2.c \
+ SRC/dormlq.c \
+ SRC/dormqr.c \
+ SRC/dsytf2.c \
+ SRC/dsytrf.c \
+ SRC/dsytri.c \
+ SRC/dtrti2.c \
+ SRC/dtrtri.c \
+ SRC/dtrtrs.c \
+ SRC/ieeeck.c \
+ SRC/iladlc.c \
+ SRC/iladlr.c \
+ SRC/ilaenv.c \
+ SRC/iparmq.c \
+ SRC/xerbla.c
diff --git a/src/lib/yac/clapack/README b/src/lib/yac/clapack/README
new file mode 100644
index 000000000..c7c5d8bda
--- /dev/null
+++ b/src/lib/yac/clapack/README
@@ -0,0 +1,8 @@
+# Copyright (c) 2024 The YAC Authors
+#
+# SPDX-License-Identifier: CC-BY-4.0
+
+This directory contains the bundled version of LAPACK, which is based on
+Netlib clapack (https://www.netlib.org/clapack/). Contains only those files
+from the original library that implement functions required by YAC and their
+dependencies.
diff --git a/src/lib/yac/clapack/SRC/dgelq2.c b/src/lib/yac/clapack/SRC/dgelq2.c
new file mode 100644
index 000000000..df67136a8
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgelq2.c
@@ -0,0 +1,162 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgelq2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dgelq2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, k;
+ doublereal aii;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfp_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGELQ2 computes an LQ factorization of a real m by n matrix A: */
+/* A = L * Q. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, the elements on and below the diagonal of the array */
+/* contain the m by min(m,n) lower trapezoidal matrix L (L is */
+/* lower triangular if m <= n); the elements above the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of elementary reflectors (see Further Details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension (M) */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* Further Details */
+/* =============== */
+
+/* The matrix Q is represented as a product of elementary reflectors */
+
+/* Q = H(k) . . . H(2) H(1), where k = min(m,n). */
+
+/* Each H(i) has the form */
+
+/* H(i) = I - tau * v * v' */
+
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n), */
+/* and tau in TAU(i). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELQ2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i,i+1:n) */
+
+ i__2 = *n - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfp_(&i__2, &a[i__ + i__ * a_dim1], &a[i__ + min(i__3, *n)* a_dim1]
+, lda, &tau[i__]);
+ if (i__ < *m) {
+
+/* Apply H(i) to A(i+1:m,i:n) from the right */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ i__2 = *m - i__;
+ i__3 = *n - i__ + 1;
+ dlarf_("Right", &i__2, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[
+ i__], &a[i__ + 1 + i__ * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGELQ2 */
+
+} /* dgelq2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgelqf.c b/src/lib/yac/clapack/SRC/dgelqf.c
new file mode 100644
index 000000000..71751308c
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgelqf.c
@@ -0,0 +1,256 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgelqf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+
+/* Subroutine */ int dgelqf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dgelq2_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *), dlarfb_(char *,
+ char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ integer ldwork, lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGELQF computes an LQ factorization of a real M-by-N matrix A: */
+/* A = L * Q. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, the elements on and below the diagonal of the array */
+/* contain the m-by-min(m,n) lower trapezoidal matrix L (L is */
+/* lower triangular if m <= n); the elements above the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of elementary reflectors (see Further Details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,M). */
+/* For optimum performance LWORK >= M*NB, where NB is the */
+/* optimal blocksize. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* Further Details */
+/* =============== */
+
+/* The matrix Q is represented as a product of elementary reflectors */
+
+/* Q = H(k) . . . H(2) H(1), where k = min(m,n). */
+
+/* Each H(i) has the form */
+
+/* H(i) = I - tau * v * v' */
+
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:n) is stored on exit in A(i,i+1:n), */
+/* and tau in TAU(i). */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1);
+ lwkopt = *m * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if (*lwork < max(1,*m) && ! lquery) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELQF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *m;
+ if (nb > 1 && nb < k) {
+
+/* Determine when to cross over from blocked to unblocked code. */
+
+/* Computing MAX */
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DGELQF", " ", m, n, &c_n1, &c_n1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *m;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/* Not enough workspace to use optimal NB: reduce NB and */
+/* determine the minimum value of NB. */
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGELQF", " ", m, n, &c_n1, &
+ c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (nb >= nbmin && nb < k && nx < k) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/* Compute the LQ factorization of the current block */
+/* A(i:i+ib-1,i:n) */
+
+ i__3 = *n - i__ + 1;
+ dgelq2_(&ib, &i__3, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *m) {
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__3 = *n - i__ + 1;
+ dlarft_("Forward", "Rowwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H to A(i+ib:m,i:n) from the right */
+
+ i__3 = *m - i__ - ib + 1;
+ i__4 = *n - i__ + 1;
+ dlarfb_("Right", "No transpose", "Forward", "Rowwise", &i__3,
+ &i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + ib + i__ * a_dim1], lda, &work[ib +
+ 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ dgelq2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+, &iinfo);
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DGELQF */
+
+} /* dgelqf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgels.c b/src/lib/yac/clapack/SRC/dgels.c
new file mode 100644
index 000000000..f263cefd9
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgels.c
@@ -0,0 +1,520 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgels.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static doublereal c_b33 = 0.;
+static integer c__0 = 0;
+
+/* Subroutine */ int dgels_(char *trans, integer *m, integer *n, integer *
+ nrhs, doublereal *a, integer *lda, doublereal *b, integer *ldb,
+ doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j, nb, mn;
+ doublereal anrm, bnrm;
+ integer brow;
+ logical tpsd;
+ integer iascl, ibscl;
+ extern logical lsame_(char *, char *);
+ integer wsize;
+ doublereal rwork[1];
+ extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
+ extern doublereal dlamch_(char *), dlange_(char *, integer *,
+ integer *, doublereal *, integer *, doublereal *);
+ extern /* Subroutine */ int dgelqf_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *, integer *),
+ dlascl_(char *, integer *, integer *, doublereal *, doublereal *,
+ integer *, integer *, doublereal *, integer *, integer *),
+ dgeqrf_(integer *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *, integer *), dlaset_(char *,
+ integer *, integer *, doublereal *, doublereal *, doublereal *,
+ integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ integer scllen;
+ doublereal bignum;
+ extern /* Subroutine */ int dormlq_(char *, char *, integer *, integer *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, integer *),
+ dormqr_(char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *, integer *);
+ doublereal smlnum;
+ logical lquery;
+ extern /* Subroutine */ int dtrtrs_(char *, char *, char *, integer *,
+ integer *, doublereal *, integer *, doublereal *, integer *,
+ integer *);
+
+
+/* -- LAPACK driver routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGELS solves overdetermined or underdetermined real linear systems */
+/* involving an M-by-N matrix A, or its transpose, using a QR or LQ */
+/* factorization of A. It is assumed that A has full rank. */
+
+/* The following options are provided: */
+
+/* 1. If TRANS = 'N' and m >= n: find the least squares solution of */
+/* an overdetermined system, i.e., solve the least squares problem */
+/* minimize || B - A*X ||. */
+
+/* 2. If TRANS = 'N' and m < n: find the minimum norm solution of */
+/* an underdetermined system A * X = B. */
+
+/* 3. If TRANS = 'T' and m >= n: find the minimum norm solution of */
+/* an undetermined system A**T * X = B. */
+
+/* 4. If TRANS = 'T' and m < n: find the least squares solution of */
+/* an overdetermined system, i.e., solve the least squares problem */
+/* minimize || B - A**T * X ||. */
+
+/* Several right hand side vectors b and solution vectors x can be */
+/* handled in a single call; they are stored as the columns of the */
+/* M-by-NRHS right hand side matrix B and the N-by-NRHS solution */
+/* matrix X. */
+
+/* Arguments */
+/* ========= */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': the linear system involves A; */
+/* = 'T': the linear system involves A**T. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* NRHS (input) INTEGER */
+/* The number of right hand sides, i.e., the number of */
+/* columns of the matrices B and X. NRHS >=0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, */
+/* if M >= N, A is overwritten by details of its QR */
+/* factorization as returned by DGEQRF; */
+/* if M < N, A is overwritten by details of its LQ */
+/* factorization as returned by DGELQF. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
+/* On entry, the matrix B of right hand side vectors, stored */
+/* columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS */
+/* if TRANS = 'T'. */
+/* On exit, if INFO = 0, B is overwritten by the solution */
+/* vectors, stored columnwise: */
+/* if TRANS = 'N' and m >= n, rows 1 to n of B contain the least */
+/* squares solution vectors; the residual sum of squares for the */
+/* solution in each column is given by the sum of squares of */
+/* elements N+1 to M in that column; */
+/* if TRANS = 'N' and m < n, rows 1 to N of B contain the */
+/* minimum norm solution vectors; */
+/* if TRANS = 'T' and m >= n, rows 1 to M of B contain the */
+/* minimum norm solution vectors; */
+/* if TRANS = 'T' and m < n, rows 1 to M of B contain the */
+/* least squares solution vectors; the residual sum of squares */
+/* for the solution in each column is given by the sum of */
+/* squares of elements M+1 to N in that column. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= MAX(1,M,N). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. */
+/* LWORK >= max( 1, MN + max( MN, NRHS ) ). */
+/* For optimal performance, */
+/* LWORK >= max( 1, MN + max( MN, NRHS )*NB ). */
+/* where MN = min(M,N) and NB is the optimum block size. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, the i-th diagonal element of the */
+/* triangular factor of A is zero, so that A does not have */
+/* full rank; the least squares solution could not be */
+/* computed. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Local Arrays .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ mn = min(*m,*n);
+ lquery = *lwork == -1;
+ if (! (lsame_(trans, "N") || lsame_(trans, "T"))) {
+ *info = -1;
+ } else if (*m < 0) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*nrhs < 0) {
+ *info = -4;
+ } else if (*lda < max(1,*m)) {
+ *info = -6;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = max(1,*m);
+ if (*ldb < max(i__1,*n)) {
+ *info = -8;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = 1, i__2 = mn + max(mn,*nrhs);
+ if (*lwork < max(i__1,i__2) && ! lquery) {
+ *info = -10;
+ }
+ }
+ }
+
+/* Figure out optimal block size */
+
+ if (*info == 0 || *info == -10) {
+
+ tpsd = TRUE_;
+ if (lsame_(trans, "N")) {
+ tpsd = FALSE_;
+ }
+
+ if (*m >= *n) {
+ nb = ilaenv_(&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ if (tpsd) {
+/* Computing MAX */
+ i__1 = nb, i__2 = ilaenv_(&c__1, "DORMQR", "LN", m, nrhs, n, &
+ c_n1);
+ nb = max(i__1,i__2);
+ } else {
+/* Computing MAX */
+ i__1 = nb, i__2 = ilaenv_(&c__1, "DORMQR", "LT", m, nrhs, n, &
+ c_n1);
+ nb = max(i__1,i__2);
+ }
+ } else {
+ nb = ilaenv_(&c__1, "DGELQF", " ", m, n, &c_n1, &c_n1);
+ if (tpsd) {
+/* Computing MAX */
+ i__1 = nb, i__2 = ilaenv_(&c__1, "DORMLQ", "LT", n, nrhs, m, &
+ c_n1);
+ nb = max(i__1,i__2);
+ } else {
+/* Computing MAX */
+ i__1 = nb, i__2 = ilaenv_(&c__1, "DORMLQ", "LN", n, nrhs, m, &
+ c_n1);
+ nb = max(i__1,i__2);
+ }
+ }
+
+/* Computing MAX */
+ i__1 = 1, i__2 = mn + max(mn,*nrhs) * nb;
+ wsize = max(i__1,i__2);
+ work[1] = (doublereal) wsize;
+
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGELS ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+/* Computing MIN */
+ i__1 = min(*m,*n);
+ if (min(i__1,*nrhs) == 0) {
+ i__1 = max(*m,*n);
+ dlaset_("Full", &i__1, nrhs, &c_b33, &c_b33, &b[b_offset], ldb);
+ return 0;
+ }
+
+/* Get machine parameters */
+
+ smlnum = dlamch_("S") / dlamch_("P");
+ bignum = 1. / smlnum;
+ dlabad_(&smlnum, &bignum);
+
+/* Scale A, B if max element outside range [SMLNUM,BIGNUM] */
+
+ anrm = dlange_("M", m, n, &a[a_offset], lda, rwork);
+ iascl = 0;
+ if (anrm > 0. && anrm < smlnum) {
+
+/* Scale matrix norm up to SMLNUM */
+
+ dlascl_("G", &c__0, &c__0, &anrm, &smlnum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 1;
+ } else if (anrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM */
+
+ dlascl_("G", &c__0, &c__0, &anrm, &bignum, m, n, &a[a_offset], lda,
+ info);
+ iascl = 2;
+ } else if (anrm == 0.) {
+
+/* Matrix all zero. Return zero solution. */
+
+ i__1 = max(*m,*n);
+ dlaset_("F", &i__1, nrhs, &c_b33, &c_b33, &b[b_offset], ldb);
+ goto L50;
+ }
+
+ brow = *m;
+ if (tpsd) {
+ brow = *n;
+ }
+ bnrm = dlange_("M", &brow, nrhs, &b[b_offset], ldb, rwork);
+ ibscl = 0;
+ if (bnrm > 0. && bnrm < smlnum) {
+
+/* Scale matrix norm up to SMLNUM */
+
+ dlascl_("G", &c__0, &c__0, &bnrm, &smlnum, &brow, nrhs, &b[b_offset],
+ ldb, info);
+ ibscl = 1;
+ } else if (bnrm > bignum) {
+
+/* Scale matrix norm down to BIGNUM */
+
+ dlascl_("G", &c__0, &c__0, &bnrm, &bignum, &brow, nrhs, &b[b_offset],
+ ldb, info);
+ ibscl = 2;
+ }
+
+ if (*m >= *n) {
+
+/* compute QR factorization of A */
+
+ i__1 = *lwork - mn;
+ dgeqrf_(m, n, &a[a_offset], lda, &work[1], &work[mn + 1], &i__1, info)
+ ;
+
+/* workspace at least N, optimally N*NB */
+
+ if (! tpsd) {
+
+/* Least-Squares Problem min || A * X - B || */
+
+/* B(1:M,1:NRHS) := Q' * B(1:M,1:NRHS) */
+
+ i__1 = *lwork - mn;
+ dormqr_("Left", "Transpose", m, nrhs, n, &a[a_offset], lda, &work[
+ 1], &b[b_offset], ldb, &work[mn + 1], &i__1, info);
+
+/* workspace at least NRHS, optimally NRHS*NB */
+
+/* B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS) */
+
+ dtrtrs_("Upper", "No transpose", "Non-unit", n, nrhs, &a[a_offset]
+, lda, &b[b_offset], ldb, info);
+
+ if (*info > 0) {
+ return 0;
+ }
+
+ scllen = *n;
+
+ } else {
+
+/* Overdetermined system of equations A' * X = B */
+
+/* B(1:N,1:NRHS) := inv(R') * B(1:N,1:NRHS) */
+
+ dtrtrs_("Upper", "Transpose", "Non-unit", n, nrhs, &a[a_offset],
+ lda, &b[b_offset], ldb, info);
+
+ if (*info > 0) {
+ return 0;
+ }
+
+/* B(N+1:M,1:NRHS) = ZERO */
+
+ i__1 = *nrhs;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = *n + 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L10: */
+ }
+/* L20: */
+ }
+
+/* B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS) */
+
+ i__1 = *lwork - mn;
+ dormqr_("Left", "No transpose", m, nrhs, n, &a[a_offset], lda, &
+ work[1], &b[b_offset], ldb, &work[mn + 1], &i__1, info);
+
+/* workspace at least NRHS, optimally NRHS*NB */
+
+ scllen = *m;
+
+ }
+
+ } else {
+
+/* Compute LQ factorization of A */
+
+ i__1 = *lwork - mn;
+ dgelqf_(m, n, &a[a_offset], lda, &work[1], &work[mn + 1], &i__1, info)
+ ;
+
+/* workspace at least M, optimally M*NB. */
+
+ if (! tpsd) {
+
+/* underdetermined system of equations A * X = B */
+
+/* B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS) */
+
+ dtrtrs_("Lower", "No transpose", "Non-unit", m, nrhs, &a[a_offset]
+, lda, &b[b_offset], ldb, info);
+
+ if (*info > 0) {
+ return 0;
+ }
+
+/* B(M+1:N,1:NRHS) = 0 */
+
+ i__1 = *nrhs;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *n;
+ for (i__ = *m + 1; i__ <= i__2; ++i__) {
+ b[i__ + j * b_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+
+/* B(1:N,1:NRHS) := Q(1:N,:)' * B(1:M,1:NRHS) */
+
+ i__1 = *lwork - mn;
+ dormlq_("Left", "Transpose", n, nrhs, m, &a[a_offset], lda, &work[
+ 1], &b[b_offset], ldb, &work[mn + 1], &i__1, info);
+
+/* workspace at least NRHS, optimally NRHS*NB */
+
+ scllen = *n;
+
+ } else {
+
+/* overdetermined system min || A' * X - B || */
+
+/* B(1:N,1:NRHS) := Q * B(1:N,1:NRHS) */
+
+ i__1 = *lwork - mn;
+ dormlq_("Left", "No transpose", n, nrhs, m, &a[a_offset], lda, &
+ work[1], &b[b_offset], ldb, &work[mn + 1], &i__1, info);
+
+/* workspace at least NRHS, optimally NRHS*NB */
+
+/* B(1:M,1:NRHS) := inv(L') * B(1:M,1:NRHS) */
+
+ dtrtrs_("Lower", "Transpose", "Non-unit", m, nrhs, &a[a_offset],
+ lda, &b[b_offset], ldb, info);
+
+ if (*info > 0) {
+ return 0;
+ }
+
+ scllen = *m;
+
+ }
+
+ }
+
+/* Undo scaling */
+
+ if (iascl == 1) {
+ dlascl_("G", &c__0, &c__0, &anrm, &smlnum, &scllen, nrhs, &b[b_offset]
+, ldb, info);
+ } else if (iascl == 2) {
+ dlascl_("G", &c__0, &c__0, &anrm, &bignum, &scllen, nrhs, &b[b_offset]
+, ldb, info);
+ }
+ if (ibscl == 1) {
+ dlascl_("G", &c__0, &c__0, &smlnum, &bnrm, &scllen, nrhs, &b[b_offset]
+, ldb, info);
+ } else if (ibscl == 2) {
+ dlascl_("G", &c__0, &c__0, &bignum, &bnrm, &scllen, nrhs, &b[b_offset]
+, ldb, info);
+ }
+
+L50:
+ work[1] = (doublereal) wsize;
+
+ return 0;
+
+/* End of DGELS */
+
+} /* dgels_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgeqr2.c b/src/lib/yac/clapack/SRC/dgeqr2.c
new file mode 100644
index 000000000..b176ca4b2
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgeqr2.c
@@ -0,0 +1,166 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgeqr2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int dgeqr2_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, k;
+ doublereal aii;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *), dlarfp_(integer *, doublereal *,
+ doublereal *, integer *, doublereal *), xerbla_(char *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGEQR2 computes a QR factorization of a real m by n matrix A: */
+/* A = Q * R. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the m by n matrix A. */
+/* On exit, the elements on and above the diagonal of the array */
+/* contain the min(m,n) by n upper trapezoidal matrix R (R is */
+/* upper triangular if m >= n); the elements below the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of elementary reflectors (see Further Details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension (N) */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* Further Details */
+/* =============== */
+
+/* The matrix Q is represented as a product of elementary reflectors */
+
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+
+/* Each H(i) has the form */
+
+/* H(i) = I - tau * v * v' */
+
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
+/* and tau in TAU(i). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQR2", &i__1);
+ return 0;
+ }
+
+ k = min(*m,*n);
+
+ i__1 = k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+
+/* Generate elementary reflector H(i) to annihilate A(i+1:m,i) */
+
+ i__2 = *m - i__ + 1;
+/* Computing MIN */
+ i__3 = i__ + 1;
+ dlarfp_(&i__2, &a[i__ + i__ * a_dim1], &a[min(i__3, *m)+ i__ * a_dim1]
+, &c__1, &tau[i__]);
+ if (i__ < *n) {
+
+/* Apply H(i) to A(i:m,i+1:n) from the left */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ i__2 = *m - i__ + 1;
+ i__3 = *n - i__;
+ dlarf_("Left", &i__2, &i__3, &a[i__ + i__ * a_dim1], &c__1, &tau[
+ i__], &a[i__ + (i__ + 1) * a_dim1], lda, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGEQR2 */
+
+} /* dgeqr2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgeqrf.c b/src/lib/yac/clapack/SRC/dgeqrf.c
new file mode 100644
index 000000000..2b9c2a1d1
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgeqrf.c
@@ -0,0 +1,257 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgeqrf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__3 = 3;
+static integer c__2 = 2;
+
+/* Subroutine */ int dgeqrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, doublereal *tau, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ integer i__, k, ib, nb, nx, iws, nbmin, iinfo;
+ extern /* Subroutine */ int dgeqr2_(integer *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *), dlarfb_(char *,
+ char *, char *, char *, integer *, integer *, integer *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, integer *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ integer ldwork, lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGEQRF computes a QR factorization of a real M-by-N matrix A: */
+/* A = Q * R. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix A. */
+/* On exit, the elements on and above the diagonal of the array */
+/* contain the min(M,N)-by-N upper trapezoidal matrix R (R is */
+/* upper triangular if m >= n); the elements below the diagonal, */
+/* with the array TAU, represent the orthogonal matrix Q as a */
+/* product of min(m,n) elementary reflectors (see Further */
+/* Details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) */
+/* The scalar factors of the elementary reflectors (see Further */
+/* Details). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* For optimum performance LWORK >= N*NB, where NB is */
+/* the optimal blocksize. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* Further Details */
+/* =============== */
+
+/* The matrix Q is represented as a product of elementary reflectors */
+
+/* Q = H(1) H(2) . . . H(k), where k = min(m,n). */
+
+/* Each H(i) has the form */
+
+/* H(i) = I - tau * v * v' */
+
+/* where tau is a real scalar, and v is a real vector with */
+/* v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), */
+/* and tau in TAU(i). */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ } else if (*lwork < max(1,*n) && ! lquery) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGEQRF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ k = min(*m,*n);
+ if (k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ nx = 0;
+ iws = *n;
+ if (nb > 1 && nb < k) {
+
+/* Determine when to cross over from blocked to unblocked code. */
+
+/* Computing MAX */
+ i__1 = 0, i__2 = ilaenv_(&c__3, "DGEQRF", " ", m, n, &c_n1, &c_n1);
+ nx = max(i__1,i__2);
+ if (nx < k) {
+
+/* Determine if workspace is large enough for blocked code. */
+
+ ldwork = *n;
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+
+/* Not enough workspace to use optimal NB: reduce NB and */
+/* determine the minimum value of NB. */
+
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGEQRF", " ", m, n, &c_n1, &
+ c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ }
+ }
+
+ if (nb >= nbmin && nb < k && nx < k) {
+
+/* Use blocked code initially */
+
+ i__1 = k - nx;
+ i__2 = nb;
+ for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__3 = k - i__ + 1;
+ ib = min(i__3,nb);
+
+/* Compute the QR factorization of the current block */
+/* A(i:m,i:i+ib-1) */
+
+ i__3 = *m - i__ + 1;
+ dgeqr2_(&i__3, &ib, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[
+ 1], &iinfo);
+ if (i__ + ib <= *n) {
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__3 = *m - i__ + 1;
+ dlarft_("Forward", "Columnwise", &i__3, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], &work[1], &ldwork);
+
+/* Apply H' to A(i:m,i+ib:n) from the left */
+
+ i__3 = *m - i__ + 1;
+ i__4 = *n - i__ - ib + 1;
+ dlarfb_("Left", "Transpose", "Forward", "Columnwise", &i__3, &
+ i__4, &ib, &a[i__ + i__ * a_dim1], lda, &work[1], &
+ ldwork, &a[i__ + (i__ + ib) * a_dim1], lda, &work[ib
+ + 1], &ldwork);
+ }
+/* L10: */
+ }
+ } else {
+ i__ = 1;
+ }
+
+/* Use unblocked code to factor the last or only block. */
+
+ if (i__ <= k) {
+ i__2 = *m - i__ + 1;
+ i__1 = *n - i__ + 1;
+ dgeqr2_(&i__2, &i__1, &a[i__ + i__ * a_dim1], lda, &tau[i__], &work[1]
+, &iinfo);
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DGEQRF */
+
+} /* dgeqrf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgesv.c b/src/lib/yac/clapack/SRC/dgesv.c
new file mode 100644
index 000000000..f1360f4d4
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgesv.c
@@ -0,0 +1,143 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgesv.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dgesv_(integer *n, integer *nrhs, doublereal *a, integer
+ *lda, integer *ipiv, doublereal *b, integer *ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern /* Subroutine */ int dgetrf_(integer *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer *), dgetrs_(char *, integer *, integer *, doublereal *,
+ integer *, integer *, doublereal *, integer *, integer *);
+
+
+/* -- LAPACK driver routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGESV computes the solution to a real system of linear equations */
+/* A * X = B, */
+/* where A is an N-by-N matrix and X and B are N-by-NRHS matrices. */
+
+/* The LU decomposition with partial pivoting and row interchanges is */
+/* used to factor A as */
+/* A = P * L * U, */
+/* where P is a permutation matrix, L is unit lower triangular, and U is */
+/* upper triangular. The factored form of A is then used to solve the */
+/* system of equations A * X = B. */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The number of linear equations, i.e., the order of the */
+/* matrix A. N >= 0. */
+
+/* NRHS (input) INTEGER */
+/* The number of right hand sides, i.e., the number of columns */
+/* of the matrix B. NRHS >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the N-by-N coefficient matrix A. */
+/* On exit, the factors L and U from the factorization */
+/* A = P*L*U; the unit diagonal elements of L are not stored. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (output) INTEGER array, dimension (N) */
+/* The pivot indices that define the permutation matrix P; */
+/* row i of the matrix was interchanged with row IPIV(i). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
+/* On entry, the N-by-NRHS matrix of right hand side matrix B. */
+/* On exit, if INFO = 0, the N-by-NRHS solution matrix X. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, U(i,i) is exactly zero. The factorization */
+/* has been completed, but the factor U is exactly */
+/* singular, so the solution could not be computed. */
+
+/* ===================================================================== */
+
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*nrhs < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ } else if (*ldb < max(1,*n)) {
+ *info = -7;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGESV ", &i__1);
+ return 0;
+ }
+
+/* Compute the LU factorization of A. */
+
+ dgetrf_(n, n, &a[a_offset], lda, &ipiv[1], info);
+ if (*info == 0) {
+
+/* Solve the system A*X = B, overwriting B with X. */
+
+ dgetrs_("No transpose", n, nrhs, &a[a_offset], lda, &ipiv[1], &b[
+ b_offset], ldb, info);
+ }
+ return 0;
+
+/* End of DGESV */
+
+} /* dgesv_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgetf2.c b/src/lib/yac/clapack/SRC/dgetf2.c
new file mode 100644
index 000000000..58b161a7f
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgetf2.c
@@ -0,0 +1,198 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgetf2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b8 = -1.;
+
+/* Subroutine */ int dgetf2_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ integer i__, j, jp;
+ extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *), dscal_(integer *, doublereal *, doublereal *, integer
+ *);
+ doublereal sfmin;
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ extern doublereal dlamch_(char *);
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGETF2 computes an LU factorization of a general m-by-n matrix A */
+/* using partial pivoting with row interchanges. */
+
+/* The factorization has the form */
+/* A = P * L * U */
+/* where P is a permutation matrix, L is lower triangular with unit */
+/* diagonal elements (lower trapezoidal if m > n), and U is upper */
+/* triangular (upper trapezoidal if m < n). */
+
+/* This is the right-looking Level 2 BLAS version of the algorithm. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the m by n matrix to be factored. */
+/* On exit, the factors L and U from the factorization */
+/* A = P*L*U; the unit diagonal elements of L are not stored. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* IPIV (output) INTEGER array, dimension (min(M,N)) */
+/* The pivot indices; for 1 <= i <= min(M,N), row i of the */
+/* matrix was interchanged with row IPIV(i). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -k, the k-th argument had an illegal value */
+/* > 0: if INFO = k, U(k,k) is exactly zero. The factorization */
+/* has been completed, but the factor U is exactly */
+/* singular, and division by zero will occur if it is used */
+/* to solve a system of equations. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETF2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* Compute machine safe minimum */
+
+ sfmin = dlamch_("S");
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+
+/* Find pivot and test for singularity. */
+
+ i__2 = *m - j + 1;
+ jp = j - 1 + idamax_(&i__2, &a[j + j * a_dim1], &c__1);
+ ipiv[j] = jp;
+ if (a[jp + j * a_dim1] != 0.) {
+
+/* Apply the interchange to columns 1:N. */
+
+ if (jp != j) {
+ dswap_(n, &a[j + a_dim1], lda, &a[jp + a_dim1], lda);
+ }
+
+/* Compute elements J+1:M of J-th column. */
+
+ if (j < *m) {
+ if ((d__1 = a[j + j * a_dim1], abs(d__1)) >= sfmin) {
+ i__2 = *m - j;
+ d__1 = 1. / a[j + j * a_dim1];
+ dscal_(&i__2, &d__1, &a[j + 1 + j * a_dim1], &c__1);
+ } else {
+ i__2 = *m - j;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[j + i__ + j * a_dim1] /= a[j + j * a_dim1];
+/* L20: */
+ }
+ }
+ }
+
+ } else if (*info == 0) {
+
+ *info = j;
+ }
+
+ if (j < min(*m,*n)) {
+
+/* Update trailing submatrix. */
+
+ i__2 = *m - j;
+ i__3 = *n - j;
+ dger_(&i__2, &i__3, &c_b8, &a[j + 1 + j * a_dim1], &c__1, &a[j + (
+ j + 1) * a_dim1], lda, &a[j + 1 + (j + 1) * a_dim1], lda);
+ }
+/* L10: */
+ }
+ return 0;
+
+/* End of DGETF2 */
+
+} /* dgetf2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgetrf.c b/src/lib/yac/clapack/SRC/dgetrf.c
new file mode 100644
index 000000000..6f3126989
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgetrf.c
@@ -0,0 +1,224 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgetrf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static doublereal c_b16 = 1.;
+static doublereal c_b19 = -1.;
+
+/* Subroutine */ int dgetrf_(integer *m, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+
+ /* Local variables */
+ integer i__, j, jb, nb;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ integer iinfo;
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), dgetf2_(
+ integer *, integer *, doublereal *, integer *, integer *, integer
+ *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ extern /* Subroutine */ int dlaswp_(integer *, doublereal *, integer *,
+ integer *, integer *, integer *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGETRF computes an LU factorization of a general M-by-N matrix A */
+/* using partial pivoting with row interchanges. */
+
+/* The factorization has the form */
+/* A = P * L * U */
+/* where P is a permutation matrix, L is lower triangular with unit */
+/* diagonal elements (lower trapezoidal if m > n), and U is upper */
+/* triangular (upper trapezoidal if m < n). */
+
+/* This is the right-looking Level 3 BLAS version of the algorithm. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the M-by-N matrix to be factored. */
+/* On exit, the factors L and U from the factorization */
+/* A = P*L*U; the unit diagonal elements of L are not stored. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* IPIV (output) INTEGER array, dimension (min(M,N)) */
+/* The pivot indices; for 1 <= i <= min(M,N), row i of the */
+/* matrix was interchanged with row IPIV(i). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, U(i,i) is exactly zero. The factorization */
+/* has been completed, but the factor U is exactly */
+/* singular, and division by zero will occur if it is used */
+/* to solve a system of equations. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ if (*m < 0) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*m)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETRF", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0) {
+ return 0;
+ }
+
+/* Determine the block size for this environment. */
+
+ nb = ilaenv_(&c__1, "DGETRF", " ", m, n, &c_n1, &c_n1);
+ if (nb <= 1 || nb >= min(*m,*n)) {
+
+/* Use unblocked code. */
+
+ dgetf2_(m, n, &a[a_offset], lda, &ipiv[1], info);
+ } else {
+
+/* Use blocked code. */
+
+ i__1 = min(*m,*n);
+ i__2 = nb;
+ for (j = 1; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+/* Computing MIN */
+ i__3 = min(*m,*n) - j + 1;
+ jb = min(i__3,nb);
+
+/* Factor diagonal and subdiagonal blocks and test for exact */
+/* singularity. */
+
+ i__3 = *m - j + 1;
+ dgetf2_(&i__3, &jb, &a[j + j * a_dim1], lda, &ipiv[j], &iinfo);
+
+/* Adjust INFO and the pivot indices. */
+
+ if (*info == 0 && iinfo > 0) {
+ *info = iinfo + j - 1;
+ }
+/* Computing MIN */
+ i__4 = *m, i__5 = j + jb - 1;
+ i__3 = min(i__4,i__5);
+ for (i__ = j; i__ <= i__3; ++i__) {
+ ipiv[i__] = j - 1 + ipiv[i__];
+/* L10: */
+ }
+
+/* Apply interchanges to columns 1:J-1. */
+
+ i__3 = j - 1;
+ i__4 = j + jb - 1;
+ dlaswp_(&i__3, &a[a_offset], lda, &j, &i__4, &ipiv[1], &c__1);
+
+ if (j + jb <= *n) {
+
+/* Apply interchanges to columns J+JB:N. */
+
+ i__3 = *n - j - jb + 1;
+ i__4 = j + jb - 1;
+ dlaswp_(&i__3, &a[(j + jb) * a_dim1 + 1], lda, &j, &i__4, &
+ ipiv[1], &c__1);
+
+/* Compute block row of U. */
+
+ i__3 = *n - j - jb + 1;
+ dtrsm_("Left", "Lower", "No transpose", "Unit", &jb, &i__3, &
+ c_b16, &a[j + j * a_dim1], lda, &a[j + (j + jb) *
+ a_dim1], lda);
+ if (j + jb <= *m) {
+
+/* Update trailing submatrix. */
+
+ i__3 = *m - j - jb + 1;
+ i__4 = *n - j - jb + 1;
+ dgemm_("No transpose", "No transpose", &i__3, &i__4, &jb,
+ &c_b19, &a[j + jb + j * a_dim1], lda, &a[j + (j +
+ jb) * a_dim1], lda, &c_b16, &a[j + jb + (j + jb) *
+ a_dim1], lda);
+ }
+ }
+/* L20: */
+ }
+ }
+ return 0;
+
+/* End of DGETRF */
+
+} /* dgetrf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgetri.c b/src/lib/yac/clapack/SRC/dgetri.c
new file mode 100644
index 000000000..9da5a9562
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgetri.c
@@ -0,0 +1,269 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgetri.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static doublereal c_b20 = -1.;
+static doublereal c_b22 = 1.;
+
+/* Subroutine */ int dgetri_(integer *n, doublereal *a, integer *lda, integer
+ *ipiv, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, j, jb, nb, jj, jp, nn, iws;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *),
+ dgemv_(char *, integer *, integer *, doublereal *, doublereal *,
+ integer *, doublereal *, integer *, doublereal *, doublereal *,
+ integer *);
+ integer nbmin;
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), xerbla_(
+ char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ integer ldwork;
+ extern /* Subroutine */ int dtrtri_(char *, char *, integer *, doublereal
+ *, integer *, integer *);
+ integer lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGETRI computes the inverse of a matrix using the LU factorization */
+/* computed by DGETRF. */
+
+/* This method inverts U and then computes inv(A) by solving the system */
+/* inv(A)*L = inv(U) for inv(A). */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the factors L and U from the factorization */
+/* A = P*L*U as computed by DGETRF. */
+/* On exit, if INFO = 0, the inverse of the original matrix A. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (input) INTEGER array, dimension (N) */
+/* The pivot indices from DGETRF; for 1<=i<=N, row i of the */
+/* matrix was interchanged with row IPIV(i). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO=0, then WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. LWORK >= max(1,N). */
+/* For optimal performance LWORK >= N*NB, where NB is */
+/* the optimal blocksize returned by ILAENV. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, U(i,i) is exactly zero; the matrix is */
+/* singular and its inverse could not be computed. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ nb = ilaenv_(&c__1, "DGETRI", " ", n, &c_n1, &c_n1, &c_n1);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ lquery = *lwork == -1;
+ if (*n < 0) {
+ *info = -1;
+ } else if (*lda < max(1,*n)) {
+ *info = -3;
+ } else if (*lwork < max(1,*n) && ! lquery) {
+ *info = -6;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DGETRI", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Form inv(U). If INFO > 0 from DTRTRI, then U is singular, */
+/* and the inverse is not computed. */
+
+ dtrtri_("Upper", "Non-unit", n, &a[a_offset], lda, info);
+ if (*info > 0) {
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = *n;
+ if (nb > 1 && nb < *n) {
+/* Computing MAX */
+ i__1 = ldwork * nb;
+ iws = max(i__1,1);
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DGETRI", " ", n, &c_n1, &c_n1, &
+ c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = *n;
+ }
+
+/* Solve the equation inv(A)*L = inv(U) for inv(A). */
+
+ if (nb < nbmin || nb >= *n) {
+
+/* Use unblocked code. */
+
+ for (j = *n; j >= 1; --j) {
+
+/* Copy current column of L to WORK and replace with zeros. */
+
+ i__1 = *n;
+ for (i__ = j + 1; i__ <= i__1; ++i__) {
+ work[i__] = a[i__ + j * a_dim1];
+ a[i__ + j * a_dim1] = 0.;
+/* L10: */
+ }
+
+/* Compute current column of inv(A). */
+
+ if (j < *n) {
+ i__1 = *n - j;
+ dgemv_("No transpose", n, &i__1, &c_b20, &a[(j + 1) * a_dim1
+ + 1], lda, &work[j + 1], &c__1, &c_b22, &a[j * a_dim1
+ + 1], &c__1);
+ }
+/* L20: */
+ }
+ } else {
+
+/* Use blocked code. */
+
+ nn = (*n - 1) / nb * nb + 1;
+ i__1 = -nb;
+ for (j = nn; i__1 < 0 ? j >= 1 : j <= 1; j += i__1) {
+/* Computing MIN */
+ i__2 = nb, i__3 = *n - j + 1;
+ jb = min(i__2,i__3);
+
+/* Copy current block column of L to WORK and replace with */
+/* zeros. */
+
+ i__2 = j + jb - 1;
+ for (jj = j; jj <= i__2; ++jj) {
+ i__3 = *n;
+ for (i__ = jj + 1; i__ <= i__3; ++i__) {
+ work[i__ + (jj - j) * ldwork] = a[i__ + jj * a_dim1];
+ a[i__ + jj * a_dim1] = 0.;
+/* L30: */
+ }
+/* L40: */
+ }
+
+/* Compute current block column of inv(A). */
+
+ if (j + jb <= *n) {
+ i__2 = *n - j - jb + 1;
+ dgemm_("No transpose", "No transpose", n, &jb, &i__2, &c_b20,
+ &a[(j + jb) * a_dim1 + 1], lda, &work[j + jb], &
+ ldwork, &c_b22, &a[j * a_dim1 + 1], lda);
+ }
+ dtrsm_("Right", "Lower", "No transpose", "Unit", n, &jb, &c_b22, &
+ work[j], &ldwork, &a[j * a_dim1 + 1], lda);
+/* L50: */
+ }
+ }
+
+/* Apply column interchanges. */
+
+ for (j = *n - 1; j >= 1; --j) {
+ jp = ipiv[j];
+ if (jp != j) {
+ dswap_(n, &a[j * a_dim1 + 1], &c__1, &a[jp * a_dim1 + 1], &c__1);
+ }
+/* L60: */
+ }
+
+ work[1] = (doublereal) iws;
+ return 0;
+
+/* End of DGETRI */
+
+} /* dgetri_ */
+
diff --git a/src/lib/yac/clapack/SRC/dgetrs.c b/src/lib/yac/clapack/SRC/dgetrs.c
new file mode 100644
index 000000000..1fcbc56ce
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dgetrs.c
@@ -0,0 +1,191 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dgetrs.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b12 = 1.;
+static integer c_n1 = -1;
+
+/* Subroutine */ int dgetrs_(char *trans, integer *n, integer *nrhs,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *b, integer *
+ ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), xerbla_(
+ char *, integer *), dlaswp_(integer *, doublereal *,
+ integer *, integer *, integer *, integer *, integer *);
+ logical notran;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DGETRS solves a system of linear equations */
+/* A * X = B or A' * X = B */
+/* with a general N-by-N matrix A using the LU factorization computed */
+/* by DGETRF. */
+
+/* Arguments */
+/* ========= */
+
+/* TRANS (input) CHARACTER*1 */
+/* Specifies the form of the system of equations: */
+/* = 'N': A * X = B (No transpose) */
+/* = 'T': A'* X = B (Transpose) */
+/* = 'C': A'* X = B (Conjugate transpose = Transpose) */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* NRHS (input) INTEGER */
+/* The number of right hand sides, i.e., the number of columns */
+/* of the matrix B. NRHS >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The factors L and U from the factorization A = P*L*U */
+/* as computed by DGETRF. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (input) INTEGER array, dimension (N) */
+/* The pivot indices from DGETRF; for 1<=i<=N, row i of the */
+/* matrix was interchanged with row IPIV(i). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
+/* On entry, the right hand side matrix B. */
+/* On exit, the solution matrix X. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ notran = lsame_(trans, "N");
+ if (! notran && ! lsame_(trans, "T") && ! lsame_(
+ trans, "C")) {
+ *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_("DGETRS", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *nrhs == 0) {
+ return 0;
+ }
+
+ if (notran) {
+
+/* Solve A * X = B. */
+
+/* Apply row interchanges to the right hand sides. */
+
+ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c__1);
+
+/* Solve L*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Lower", "No transpose", "Unit", n, nrhs, &c_b12, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve U*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Upper", "No transpose", "Non-unit", n, nrhs, &c_b12, &
+ a[a_offset], lda, &b[b_offset], ldb);
+ } else {
+
+/* Solve A' * X = B. */
+
+/* Solve U'*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Upper", "Transpose", "Non-unit", n, nrhs, &c_b12, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Solve L'*X = B, overwriting B with X. */
+
+ dtrsm_("Left", "Lower", "Transpose", "Unit", n, nrhs, &c_b12, &a[
+ a_offset], lda, &b[b_offset], ldb);
+
+/* Apply row interchanges to the solution vectors. */
+
+ dlaswp_(nrhs, &b[b_offset], ldb, &c__1, n, &ipiv[1], &c_n1);
+ }
+
+ return 0;
+
+/* End of DGETRS */
+
+} /* dgetrs_ */
+
diff --git a/src/lib/yac/clapack/SRC/disnan.c b/src/lib/yac/clapack/SRC/disnan.c
new file mode 100644
index 000000000..ccb7c5d8a
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/disnan.c
@@ -0,0 +1,57 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* disnan.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+logical disnan_(doublereal *din)
+{
+ /* System generated locals */
+ logical ret_val;
+
+ /* Local variables */
+ extern logical dlaisnan_(doublereal *, doublereal *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DISNAN returns .TRUE. if its argument is NaN, and .FALSE. */
+/* otherwise. To be replaced by the Fortran 2003 intrinsic in the */
+/* future. */
+
+/* Arguments */
+/* ========= */
+
+/* DIN (input) DOUBLE PRECISION */
+/* Input to test for NaN. */
+
+/* ===================================================================== */
+
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+ ret_val = dlaisnan_(din, din);
+ return ret_val;
+} /* disnan_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlabad.c b/src/lib/yac/clapack/SRC/dlabad.c
new file mode 100644
index 000000000..20c5e6d3f
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlabad.c
@@ -0,0 +1,77 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlabad.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlabad_(doublereal *small, doublereal *large)
+{
+ /* Builtin functions */
+ double d_lg10(doublereal *), sqrt(doublereal);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLABAD takes as input the values computed by DLAMCH for underflow and */
+/* overflow, and returns the square root of each of these values if the */
+/* log of LARGE is sufficiently large. This subroutine is intended to */
+/* identify machines with a large exponent range, such as the Crays, and */
+/* redefine the underflow and overflow limits to be the square roots of */
+/* the values computed by DLAMCH. This subroutine is needed because */
+/* DLAMCH does not compensate for poor arithmetic in the upper half of */
+/* the exponent range, as is found on a Cray. */
+
+/* Arguments */
+/* ========= */
+
+/* SMALL (input/output) DOUBLE PRECISION */
+/* On entry, the underflow threshold as computed by DLAMCH. */
+/* On exit, if LOG10(LARGE) is sufficiently large, the square */
+/* root of SMALL, otherwise unchanged. */
+
+/* LARGE (input/output) DOUBLE PRECISION */
+/* On entry, the overflow threshold as computed by DLAMCH. */
+/* On exit, if LOG10(LARGE) is sufficiently large, the square */
+/* root of LARGE, otherwise unchanged. */
+
+/* ===================================================================== */
+
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* If it looks like we're on a Cray, take the square root of */
+/* SMALL and LARGE to avoid overflow and underflow problems. */
+
+ if (d_lg10(large) > 2e3) {
+ *small = sqrt(*small);
+ *large = sqrt(*large);
+ }
+
+ return 0;
+
+/* End of DLABAD */
+
+} /* dlabad_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlaisnan.c b/src/lib/yac/clapack/SRC/dlaisnan.c
new file mode 100644
index 000000000..706af3003
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlaisnan.c
@@ -0,0 +1,63 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlaisnan.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+logical dlaisnan_(doublereal *din1, doublereal *din2)
+{
+ /* System generated locals */
+ logical ret_val;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* This routine is not for general use. It exists solely to avoid */
+/* over-optimization in DISNAN. */
+
+/* DLAISNAN checks for NaNs by comparing its two arguments for */
+/* inequality. NaN is the only floating-point value where NaN != NaN */
+/* returns .TRUE. To check for NaNs, pass the same variable as both */
+/* arguments. */
+
+/* A compiler must assume that the two arguments are */
+/* not the same variable, and the test will not be optimized away. */
+/* Interprocedural or whole-program optimization may delete this */
+/* test. The ISNAN functions will be replaced by the correct */
+/* Fortran 03 intrinsic once the intrinsic is widely available. */
+
+/* Arguments */
+/* ========= */
+
+/* DIN1 (input) DOUBLE PRECISION */
+/* DIN2 (input) DOUBLE PRECISION */
+/* Two numbers to compare for inequality. */
+
+/* ===================================================================== */
+
+/* .. Executable Statements .. */
+ ret_val = *din1 != *din2;
+ return ret_val;
+} /* dlaisnan_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlange.c b/src/lib/yac/clapack/SRC/dlange.c
new file mode 100644
index 000000000..af24e8119
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlange.c
@@ -0,0 +1,204 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlange.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+doublereal dlange_(char *norm, integer *m, integer *n, doublereal *a, integer
+ *lda, doublereal *work)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal ret_val, d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ integer i__, j;
+ doublereal sum, scale;
+ extern logical lsame_(char *, char *);
+ doublereal value;
+ extern /* Subroutine */ int dlassq_(integer *, doublereal *, integer *,
+ doublereal *, doublereal *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLANGE returns the value of the one norm, or the Frobenius norm, or */
+/* the infinity norm, or the element of largest absolute value of a */
+/* real matrix A. */
+
+/* Description */
+/* =========== */
+
+/* DLANGE returns the value */
+
+/* DLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm' */
+/* ( */
+/* ( norm1(A), NORM = '1', 'O' or 'o' */
+/* ( */
+/* ( normI(A), NORM = 'I' or 'i' */
+/* ( */
+/* ( normF(A), NORM = 'F', 'f', 'E' or 'e' */
+
+/* where norm1 denotes the one norm of a matrix (maximum column sum), */
+/* normI denotes the infinity norm of a matrix (maximum row sum) and */
+/* normF denotes the Frobenius norm of a matrix (square root of sum of */
+/* squares). Note that max(abs(A(i,j))) is not a consistent matrix norm. */
+
+/* Arguments */
+/* ========= */
+
+/* NORM (input) CHARACTER*1 */
+/* Specifies the value to be returned in DLANGE as described */
+/* above. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. When M = 0, */
+/* DLANGE is set to zero. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. When N = 0, */
+/* DLANGE is set to zero. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The m by n matrix A. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(M,1). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK)), */
+/* where LWORK >= M when NORM = 'I'; otherwise, WORK is not */
+/* referenced. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --work;
+
+ /* Function Body */
+ if (min(*m,*n) == 0) {
+ value = 0.;
+ } else if (lsame_(norm, "M")) {
+
+/* Find max(abs(A(i,j))). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+/* Computing MAX */
+ d__2 = value, d__3 = (d__1 = a[i__ + j * a_dim1], abs(d__1));
+ value = max(d__2,d__3);
+/* L10: */
+ }
+/* L20: */
+ }
+ } else if (lsame_(norm, "O") || *(unsigned char *)
+ norm == '1') {
+
+/* Find norm1(A). */
+
+ value = 0.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ sum = 0.;
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ sum += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L30: */
+ }
+ value = max(value,sum);
+/* L40: */
+ }
+ } else if (lsame_(norm, "I")) {
+
+/* Find normI(A). */
+
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ work[i__] = 0.;
+/* L50: */
+ }
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ work[i__] += (d__1 = a[i__ + j * a_dim1], abs(d__1));
+/* L60: */
+ }
+/* L70: */
+ }
+ value = 0.;
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+/* Computing MAX */
+ d__1 = value, d__2 = work[i__];
+ value = max(d__1,d__2);
+/* L80: */
+ }
+ } else if (lsame_(norm, "F") || lsame_(norm, "E")) {
+
+/* Find normF(A). */
+
+ scale = 0.;
+ sum = 1.;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ dlassq_(m, &a[j * a_dim1 + 1], &c__1, &scale, &sum);
+/* L90: */
+ }
+ value = scale * sqrt(sum);
+ }
+
+ ret_val = value;
+ return ret_val;
+
+/* End of DLANGE */
+
+} /* dlange_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlapy2.c b/src/lib/yac/clapack/SRC/dlapy2.c
new file mode 100644
index 000000000..0b894df39
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlapy2.c
@@ -0,0 +1,78 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlapy2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+doublereal dlapy2_(doublereal *x, doublereal *y)
+{
+ /* System generated locals */
+ doublereal ret_val, d__1;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ doublereal w, z__, xabs, yabs;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary */
+/* overflow. */
+
+/* Arguments */
+/* ========= */
+
+/* X (input) DOUBLE PRECISION */
+/* Y (input) DOUBLE PRECISION */
+/* X and Y specify the values x and y. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ xabs = abs(*x);
+ yabs = abs(*y);
+ w = max(xabs,yabs);
+ z__ = min(xabs,yabs);
+ if (z__ == 0.) {
+ ret_val = w;
+ } else {
+/* Computing 2nd power */
+ d__1 = z__ / w;
+ ret_val = w * sqrt(d__1 * d__1 + 1.);
+ }
+ return ret_val;
+
+/* End of DLAPY2 */
+
+} /* dlapy2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlarf.c b/src/lib/yac/clapack/SRC/dlarf.c
new file mode 100644
index 000000000..2abd7670e
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlarf.c
@@ -0,0 +1,198 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlarf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static doublereal c_b4 = 1.;
+static doublereal c_b5 = 0.;
+static integer c__1 = 1;
+
+/* Subroutine */ int dlarf_(char *side, integer *m, integer *n, doublereal *v,
+ integer *incv, doublereal *tau, doublereal *c__, integer *ldc,
+ doublereal *work)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset;
+ doublereal d__1;
+
+ /* Local variables */
+ integer i__;
+ logical applyleft;
+ extern /* Subroutine */ int dger_(integer *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ integer lastc, lastv;
+ extern integer iladlc_(integer *, integer *, doublereal *, integer *),
+ iladlr_(integer *, integer *, doublereal *, integer *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLARF applies a real elementary reflector H to a real m by n matrix */
+/* C, from either the left or the right. H is represented in the form */
+
+/* H = I - tau * v * v' */
+
+/* where tau is a real scalar and v is a real vector. */
+
+/* If tau = 0, then H is taken to be the unit matrix. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': form H * C */
+/* = 'R': form C * H */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+
+/* V (input) DOUBLE PRECISION array, dimension */
+/* (1 + (M-1)*abs(INCV)) if SIDE = 'L' */
+/* or (1 + (N-1)*abs(INCV)) if SIDE = 'R' */
+/* The vector v in the representation of H. V is not used if */
+/* TAU = 0. */
+
+/* INCV (input) INTEGER */
+/* The increment between elements of v. INCV <> 0. */
+
+/* TAU (input) DOUBLE PRECISION */
+/* The value tau in the representation of H. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by the matrix H * C if SIDE = 'L', */
+/* or C * H if SIDE = 'R'. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L' */
+/* or (M) if SIDE = 'R' */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ --v;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ applyleft = lsame_(side, "L");
+ lastv = 0;
+ lastc = 0;
+ if (*tau != 0.) {
+/* Set up variables for scanning V. LASTV begins pointing to the end */
+/* of V. */
+ if (applyleft) {
+ lastv = *m;
+ } else {
+ lastv = *n;
+ }
+ if (*incv > 0) {
+ i__ = (lastv - 1) * *incv + 1;
+ } else {
+ i__ = 1;
+ }
+/* Look for the last non-zero row in V. */
+ while(lastv > 0 && v[i__] == 0.) {
+ --lastv;
+ i__ -= *incv;
+ }
+ if (applyleft) {
+/* Scan for the last non-zero column in C(1:lastv,:). */
+ lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
+ } else {
+/* Scan for the last non-zero row in C(:,1:lastv). */
+ lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
+ }
+ }
+/* Note that lastc.eq.0 renders the BLAS operations null; no special */
+/* case is needed at this level. */
+ if (applyleft) {
+
+/* Form H * C */
+
+ if (lastv > 0) {
+
+/* w(1:lastc,1) := C(1:lastv,1:lastc)' * v(1:lastv,1) */
+
+ dgemv_("Transpose", &lastv, &lastc, &c_b4, &c__[c_offset], ldc, &
+ v[1], incv, &c_b5, &work[1], &c__1);
+
+/* C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)' */
+
+ d__1 = -(*tau);
+ dger_(&lastv, &lastc, &d__1, &v[1], incv, &work[1], &c__1, &c__[
+ c_offset], ldc);
+ }
+ } else {
+
+/* Form C * H */
+
+ if (lastv > 0) {
+
+/* w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1) */
+
+ dgemv_("No transpose", &lastc, &lastv, &c_b4, &c__[c_offset], ldc,
+ &v[1], incv, &c_b5, &work[1], &c__1);
+
+/* C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)' */
+
+ d__1 = -(*tau);
+ dger_(&lastc, &lastv, &d__1, &work[1], &c__1, &v[1], incv, &c__[
+ c_offset], ldc);
+ }
+ }
+ return 0;
+
+/* End of DLARF */
+
+} /* dlarf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlarfb.c b/src/lib/yac/clapack/SRC/dlarfb.c
new file mode 100644
index 000000000..d307b6c8a
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlarfb.c
@@ -0,0 +1,779 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlarfb.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b14 = 1.;
+static doublereal c_b25 = -1.;
+
+/* Subroutine */ int dlarfb_(char *side, char *trans, char *direct, char *
+ storev, integer *m, integer *n, integer *k, doublereal *v, integer *
+ ldv, doublereal *t, integer *ldt, doublereal *c__, integer *ldc,
+ doublereal *work, integer *ldwork)
+{
+ /* System generated locals */
+ integer c_dim1, c_offset, t_dim1, t_offset, v_dim1, v_offset, work_dim1,
+ work_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, j;
+ extern /* Subroutine */ int dgemm_(char *, char *, integer *, integer *,
+ integer *, doublereal *, doublereal *, integer *, doublereal *,
+ integer *, doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ integer lastc;
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dtrmm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *);
+ integer lastv;
+ extern integer iladlc_(integer *, integer *, doublereal *, integer *),
+ iladlr_(integer *, integer *, doublereal *, integer *);
+ char transt[1];
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLARFB applies a real block reflector H or its transpose H' to a */
+/* real m by n matrix C, from either the left or the right. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply H or H' from the Left */
+/* = 'R': apply H or H' from the Right */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply H (No transpose) */
+/* = 'T': apply H' (Transpose) */
+
+/* DIRECT (input) CHARACTER*1 */
+/* Indicates how H is formed from a product of elementary */
+/* reflectors */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+
+/* STOREV (input) CHARACTER*1 */
+/* Indicates how the vectors which define the elementary */
+/* reflectors are stored: */
+/* = 'C': Columnwise */
+/* = 'R': Rowwise */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. */
+
+/* K (input) INTEGER */
+/* The order of the matrix T (= the number of elementary */
+/* reflectors whose product defines the block reflector). */
+
+/* V (input) DOUBLE PRECISION array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,M) if STOREV = 'R' and SIDE = 'L' */
+/* (LDV,N) if STOREV = 'R' and SIDE = 'R' */
+/* The matrix V. See further details. */
+
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); */
+/* if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); */
+/* if STOREV = 'R', LDV >= K. */
+
+/* T (input) DOUBLE PRECISION array, dimension (LDT,K) */
+/* The triangular k by k matrix T in the representation of the */
+/* block reflector. */
+
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by H*C or H'*C or C*H or C*H'. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDA >= max(1,M). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,K) */
+
+/* LDWORK (input) INTEGER */
+/* The leading dimension of the array WORK. */
+/* If SIDE = 'L', LDWORK >= max(1,N); */
+/* if SIDE = 'R', LDWORK >= max(1,M). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Quick return if possible */
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1;
+ v -= v_offset;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1;
+ t -= t_offset;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ work_dim1 = *ldwork;
+ work_offset = 1 + work_dim1;
+ work -= work_offset;
+
+ /* Function Body */
+ if (*m <= 0 || *n <= 0) {
+ return 0;
+ }
+
+ if (lsame_(trans, "N")) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ if (lsame_(storev, "C")) {
+
+ if (lsame_(direct, "F")) {
+
+/* Let V = ( V1 ) (first K rows) */
+/* ( V2 ) */
+/* where V1 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C1' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1
+ + 1], &c__1);
+/* L10: */
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C2'*V2 */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "No transpose", &lastc, k, &i__1, &
+ c_b14, &c__[*k + 1 + c_dim1], ldc, &v[*k + 1 +
+ v_dim1], ldv, &c_b14, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", &lastc, k, &
+ c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (lastv > *k) {
+
+/* C2 := C2 - V2 * W' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &i__1, &lastc, k, &
+ c_b25, &v[*k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork, &c_b14, &c__[*k + 1 +
+ c_dim1], ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C1 */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L40: */
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C2 * V2 */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "No transpose", &lastc, k, &i__1, &
+ c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[*k +
+ 1 + v_dim1], ldv, &c_b14, &work[work_offset],
+ ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", &lastc, k, &c_b14,
+ &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (lastv > *k) {
+
+/* C2 := C2 - W * V2' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &lastc, &i__1, k, &
+ c_b25, &work[work_offset], ldwork, &v[*k + 1 +
+ v_dim1], ldv, &c_b14, &c__[(*k + 1) * c_dim1 + 1],
+ ldc);
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+ } else {
+
+/* Let V = ( V1 ) */
+/* ( V2 ) (last K rows) */
+/* where V2 is unit upper triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlr_(m, k, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
+
+/* W := C' * V = (C1'*V1 + C2'*V2) (stored in WORK) */
+
+/* W := C2' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[
+ j * work_dim1 + 1], &c__1);
+/* L70: */
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C1'*V1 */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "No transpose", &lastc, k, &i__1, &
+ c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b14, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", &lastc, k, &
+ c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V * W' */
+
+ if (lastv > *k) {
+
+/* C1 := C1 - V1 * W' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &i__1, &lastc, k, &
+ c_b25, &v[v_offset], ldv, &work[work_offset],
+ ldwork, &c_b14, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlr_(n, k, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
+
+/* W := C * V = (C1*V1 + C2*V2) (stored in WORK) */
+
+/* W := C2 */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[(*n - *k + j) * c_dim1 + 1], &c__1, &
+ work[j * work_dim1 + 1], &c__1);
+/* L100: */
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C1 * V1 */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "No transpose", &lastc, k, &i__1, &
+ c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b14, &work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", &lastc, k, &c_b14,
+ &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V' */
+
+ if (lastv > *k) {
+
+/* C1 := C1 - W * V1' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &lastc, &i__1, k, &
+ c_b25, &work[work_offset], ldwork, &v[v_offset],
+ ldv, &c_b14, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[lastv - *k + 1 + v_dim1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L110: */
+ }
+/* L120: */
+ }
+ }
+ }
+
+ } else if (lsame_(storev, "R")) {
+
+ if (lsame_(direct, "F")) {
+
+/* Let V = ( V1 V2 ) (V1: first K columns) */
+/* where V1 is unit upper triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C1' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[j + c_dim1], ldc, &work[j * work_dim1
+ + 1], &c__1);
+/* L130: */
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C2'*V2' */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "Transpose", &lastc, k, &i__1, &c_b14,
+ &c__[*k + 1 + c_dim1], ldc, &v[(*k + 1) * v_dim1
+ + 1], ldv, &c_b14, &work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Upper", transt, "Non-unit", &lastc, k, &
+ c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (lastv > *k) {
+
+/* C2 := C2 - V2' * W' */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "Transpose", &i__1, &lastc, k, &c_b25,
+ &v[(*k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork, &c_b14, &c__[*k + 1 +
+ c_dim1], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[j + i__ * c_dim1] -= work[i__ + j * work_dim1];
+/* L140: */
+ }
+/* L150: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C1 */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[j * c_dim1 + 1], &c__1, &work[j *
+ work_dim1 + 1], &c__1);
+/* L160: */
+ }
+
+/* W := W * V1' */
+
+ dtrmm_("Right", "Upper", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C2 * V2' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &lastc, k, &i__1, &
+ c_b14, &c__[(*k + 1) * c_dim1 + 1], ldc, &v[(*k +
+ 1) * v_dim1 + 1], ldv, &c_b14, &work[work_offset],
+ ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Upper", trans, "Non-unit", &lastc, k, &c_b14,
+ &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (lastv > *k) {
+
+/* C2 := C2 - W * V2 */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "No transpose", &lastc, &i__1, k, &
+ c_b25, &work[work_offset], ldwork, &v[(*k + 1) *
+ v_dim1 + 1], ldv, &c_b14, &c__[(*k + 1) * c_dim1
+ + 1], ldc);
+ }
+
+/* W := W * V1 */
+
+ dtrmm_("Right", "Upper", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[v_offset], ldv, &work[work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + j * c_dim1] -= work[i__ + j * work_dim1];
+/* L170: */
+ }
+/* L180: */
+ }
+
+ }
+
+ } else {
+
+/* Let V = ( V1 V2 ) (V2: last K columns) */
+/* where V2 is unit lower triangular. */
+
+ if (lsame_(side, "L")) {
+
+/* Form H * C or H' * C where C = ( C1 ) */
+/* ( C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlc_(k, m, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlc_(&lastv, n, &c__[c_offset], ldc);
+
+/* W := C' * V' = (C1'*V1' + C2'*V2') (stored in WORK) */
+
+/* W := C2' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[lastv - *k + j + c_dim1], ldc, &work[
+ j * work_dim1 + 1], &c__1);
+/* L190: */
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C1'*V1' */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "Transpose", &lastc, k, &i__1, &c_b14,
+ &c__[c_offset], ldc, &v[v_offset], ldv, &c_b14, &
+ work[work_offset], ldwork);
+ }
+
+/* W := W * T' or W * T */
+
+ dtrmm_("Right", "Lower", transt, "Non-unit", &lastc, k, &
+ c_b14, &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - V' * W' */
+
+ if (lastv > *k) {
+
+/* C1 := C1 - V1' * W' */
+
+ i__1 = lastv - *k;
+ dgemm_("Transpose", "Transpose", &i__1, &lastc, k, &c_b25,
+ &v[v_offset], ldv, &work[work_offset], ldwork, &
+ c_b14, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C2 := C2 - W' */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[lastv - *k + j + i__ * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L200: */
+ }
+/* L210: */
+ }
+
+ } else if (lsame_(side, "R")) {
+
+/* Form C * H or C * H' where C = ( C1 C2 ) */
+
+/* Computing MAX */
+ i__1 = *k, i__2 = iladlc_(k, n, &v[v_offset], ldv);
+ lastv = max(i__1,i__2);
+ lastc = iladlr_(m, &lastv, &c__[c_offset], ldc);
+
+/* W := C * V' = (C1*V1' + C2*V2') (stored in WORK) */
+
+/* W := C2 */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ dcopy_(&lastc, &c__[(lastv - *k + j) * c_dim1 + 1], &c__1,
+ &work[j * work_dim1 + 1], &c__1);
+/* L220: */
+ }
+
+/* W := W * V2' */
+
+ dtrmm_("Right", "Lower", "Transpose", "Unit", &lastc, k, &
+ c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+ if (lastv > *k) {
+
+/* W := W + C1 * V1' */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "Transpose", &lastc, k, &i__1, &
+ c_b14, &c__[c_offset], ldc, &v[v_offset], ldv, &
+ c_b14, &work[work_offset], ldwork);
+ }
+
+/* W := W * T or W * T' */
+
+ dtrmm_("Right", "Lower", trans, "Non-unit", &lastc, k, &c_b14,
+ &t[t_offset], ldt, &work[work_offset], ldwork);
+
+/* C := C - W * V */
+
+ if (lastv > *k) {
+
+/* C1 := C1 - W * V1 */
+
+ i__1 = lastv - *k;
+ dgemm_("No transpose", "No transpose", &lastc, &i__1, k, &
+ c_b25, &work[work_offset], ldwork, &v[v_offset],
+ ldv, &c_b14, &c__[c_offset], ldc);
+ }
+
+/* W := W * V2 */
+
+ dtrmm_("Right", "Lower", "No transpose", "Unit", &lastc, k, &
+ c_b14, &v[(lastv - *k + 1) * v_dim1 + 1], ldv, &work[
+ work_offset], ldwork);
+
+/* C1 := C1 - W */
+
+ i__1 = *k;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = lastc;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ c__[i__ + (lastv - *k + j) * c_dim1] -= work[i__ + j *
+ work_dim1];
+/* L230: */
+ }
+/* L240: */
+ }
+
+ }
+
+ }
+ }
+
+ return 0;
+
+/* End of DLARFB */
+
+} /* dlarfb_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlarfp.c b/src/lib/yac/clapack/SRC/dlarfp.c
new file mode 100644
index 000000000..3b7b0f804
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlarfp.c
@@ -0,0 +1,197 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlarfp.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlarfp_(integer *n, doublereal *alpha, doublereal *x,
+ integer *incx, doublereal *tau)
+{
+ /* System generated locals */
+ integer i__1;
+ doublereal d__1;
+
+ /* Builtin functions */
+ double d_sign(doublereal *, doublereal *);
+
+ /* Local variables */
+ integer j, knt;
+ doublereal beta;
+ extern doublereal dnrm2_(integer *, doublereal *, integer *);
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ doublereal xnorm;
+ extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
+ doublereal safmin, rsafmn;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLARFP generates a real elementary reflector H of order n, such */
+/* that */
+
+/* H * ( alpha ) = ( beta ), H' * H = I. */
+/* ( x ) ( 0 ) */
+
+/* where alpha and beta are scalars, beta is non-negative, and x is */
+/* an (n-1)-element real vector. H is represented in the form */
+
+/* H = I - tau * ( 1 ) * ( 1 v' ) , */
+/* ( v ) */
+
+/* where tau is a real scalar and v is a real (n-1)-element */
+/* vector. */
+
+/* If the elements of x are all zero, then tau = 0 and H is taken to be */
+/* the unit matrix. */
+
+/* Otherwise 1 <= tau <= 2. */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The order of the elementary reflector. */
+
+/* ALPHA (input/output) DOUBLE PRECISION */
+/* On entry, the value alpha. */
+/* On exit, it is overwritten with the value beta. */
+
+/* X (input/output) DOUBLE PRECISION array, dimension */
+/* (1+(N-2)*abs(INCX)) */
+/* On entry, the vector x. */
+/* On exit, it is overwritten with the vector v. */
+
+/* INCX (input) INTEGER */
+/* The increment between elements of X. INCX > 0. */
+
+/* TAU (output) DOUBLE PRECISION */
+/* The value tau. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n <= 0) {
+ *tau = 0.;
+ return 0;
+ }
+
+ i__1 = *n - 1;
+ xnorm = dnrm2_(&i__1, &x[1], incx);
+
+ if (xnorm == 0.) {
+
+/* H = [+/-1, 0; I], sign chosen so ALPHA >= 0 */
+
+ if (*alpha >= 0.) {
+/* When TAU.eq.ZERO, the vector is special-cased to be */
+/* all zeros in the application routines. We do not need */
+/* to clear it. */
+ *tau = 0.;
+ } else {
+/* However, the application routines rely on explicit */
+/* zero checks when TAU.ne.ZERO, and we must clear X. */
+ *tau = 2.;
+ i__1 = *n - 1;
+ for (j = 1; j <= i__1; ++j) {
+ x[(j - 1) * *incx + 1] = 0.;
+ }
+ *alpha = -(*alpha);
+ }
+ } else {
+
+/* general case */
+
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = d_sign(&d__1, alpha);
+ safmin = dlamch_("S") / dlamch_("E");
+ knt = 0;
+ if (abs(beta) < safmin) {
+
+/* XNORM, BETA may be inaccurate; scale X and recompute them */
+
+ rsafmn = 1. / safmin;
+L10:
+ ++knt;
+ i__1 = *n - 1;
+ dscal_(&i__1, &rsafmn, &x[1], incx);
+ beta *= rsafmn;
+ *alpha *= rsafmn;
+ if (abs(beta) < safmin) {
+ goto L10;
+ }
+
+/* New BETA is at most 1, at least SAFMIN */
+
+ i__1 = *n - 1;
+ xnorm = dnrm2_(&i__1, &x[1], incx);
+ d__1 = dlapy2_(alpha, &xnorm);
+ beta = d_sign(&d__1, alpha);
+ }
+ *alpha += beta;
+ if (beta < 0.) {
+ beta = -beta;
+ *tau = -(*alpha) / beta;
+ } else {
+ *alpha = xnorm * (xnorm / *alpha);
+ *tau = *alpha / beta;
+ *alpha = -(*alpha);
+ }
+ i__1 = *n - 1;
+ d__1 = 1. / *alpha;
+ dscal_(&i__1, &d__1, &x[1], incx);
+
+/* If BETA is subnormal, it may lose relative accuracy */
+
+ i__1 = knt;
+ for (j = 1; j <= i__1; ++j) {
+ beta *= safmin;
+/* L20: */
+ }
+ *alpha = beta;
+ }
+
+ return 0;
+
+/* End of DLARFP */
+
+} /* dlarfp_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlarft.c b/src/lib/yac/clapack/SRC/dlarft.c
new file mode 100644
index 000000000..f24738965
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlarft.c
@@ -0,0 +1,330 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlarft.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b8 = 0.;
+
+/* Subroutine */ int dlarft_(char *direct, char *storev, integer *n, integer *
+ k, doublereal *v, integer *ldv, doublereal *tau, doublereal *t,
+ integer *ldt)
+{
+ /* System generated locals */
+ integer t_dim1, t_offset, v_dim1, v_offset, i__1, i__2, i__3;
+ doublereal d__1;
+
+ /* Local variables */
+ integer i__, j, prevlastv;
+ doublereal vii;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ integer lastv;
+ extern /* Subroutine */ int dtrmv_(char *, char *, char *, integer *,
+ doublereal *, integer *, doublereal *, integer *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLARFT forms the triangular factor T of a real block reflector H */
+/* of order n, which is defined as a product of k elementary reflectors. */
+
+/* If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular; */
+
+/* If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular. */
+
+/* If STOREV = 'C', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th column of the array V, and */
+
+/* H = I - V * T * V' */
+
+/* If STOREV = 'R', the vector which defines the elementary reflector */
+/* H(i) is stored in the i-th row of the array V, and */
+
+/* H = I - V' * T * V */
+
+/* Arguments */
+/* ========= */
+
+/* DIRECT (input) CHARACTER*1 */
+/* Specifies the order in which the elementary reflectors are */
+/* multiplied to form the block reflector: */
+/* = 'F': H = H(1) H(2) . . . H(k) (Forward) */
+/* = 'B': H = H(k) . . . H(2) H(1) (Backward) */
+
+/* STOREV (input) CHARACTER*1 */
+/* Specifies how the vectors which define the elementary */
+/* reflectors are stored (see also Further Details): */
+/* = 'C': columnwise */
+/* = 'R': rowwise */
+
+/* N (input) INTEGER */
+/* The order of the block reflector H. N >= 0. */
+
+/* K (input) INTEGER */
+/* The order of the triangular factor T (= the number of */
+/* elementary reflectors). K >= 1. */
+
+/* V (input/output) DOUBLE PRECISION array, dimension */
+/* (LDV,K) if STOREV = 'C' */
+/* (LDV,N) if STOREV = 'R' */
+/* The matrix V. See further details. */
+
+/* LDV (input) INTEGER */
+/* The leading dimension of the array V. */
+/* If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K. */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i). */
+
+/* T (output) DOUBLE PRECISION array, dimension (LDT,K) */
+/* The k by k triangular factor T of the block reflector. */
+/* If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is */
+/* lower triangular. The rest of the array is not used. */
+
+/* LDT (input) INTEGER */
+/* The leading dimension of the array T. LDT >= K. */
+
+/* Further Details */
+/* =============== */
+
+/* The shape of the matrix V and the storage of the vectors which define */
+/* the H(i) is best illustrated by the following example with n = 5 and */
+/* k = 3. The elements equal to 1 are not stored; the corresponding */
+/* array elements are modified but restored on exit. The rest of the */
+/* array is not used. */
+
+/* DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': */
+
+/* V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) */
+/* ( v1 1 ) ( 1 v2 v2 v2 ) */
+/* ( v1 v2 1 ) ( 1 v3 v3 ) */
+/* ( v1 v2 v3 ) */
+/* ( v1 v2 v3 ) */
+
+/* DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': */
+
+/* V = ( v1 v2 v3 ) V = ( v1 v1 1 ) */
+/* ( v1 v2 v3 ) ( v2 v2 v2 1 ) */
+/* ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) */
+/* ( 1 v3 ) */
+/* ( 1 ) */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Quick return if possible */
+
+ /* Parameter adjustments */
+ v_dim1 = *ldv;
+ v_offset = 1 + v_dim1;
+ v -= v_offset;
+ --tau;
+ t_dim1 = *ldt;
+ t_offset = 1 + t_dim1;
+ t -= t_offset;
+
+ /* Function Body */
+ if (*n == 0) {
+ return 0;
+ }
+
+ if (lsame_(direct, "F")) {
+ prevlastv = *n;
+ i__1 = *k;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ prevlastv = max(i__,prevlastv);
+ if (tau[i__] == 0.) {
+
+/* H(i) = I */
+
+ i__2 = i__;
+ for (j = 1; j <= i__2; ++j) {
+ t[j + i__ * t_dim1] = 0.;
+/* L10: */
+ }
+ } else {
+
+/* general case */
+
+ vii = v[i__ + i__ * v_dim1];
+ v[i__ + i__ * v_dim1] = 1.;
+ if (lsame_(storev, "C")) {
+/* Skip any trailing zeros. */
+ i__2 = i__ + 1;
+ for (lastv = *n; lastv >= i__2; --lastv) {
+ if (v[lastv + i__ * v_dim1] != 0.) {
+ break;
+ }
+ }
+ j = min(lastv,prevlastv);
+
+/* T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)' * V(i:j,i) */
+
+ i__2 = j - i__ + 1;
+ i__3 = i__ - 1;
+ d__1 = -tau[i__];
+ dgemv_("Transpose", &i__2, &i__3, &d__1, &v[i__ + v_dim1],
+ ldv, &v[i__ + i__ * v_dim1], &c__1, &c_b8, &t[
+ i__ * t_dim1 + 1], &c__1);
+ } else {
+/* Skip any trailing zeros. */
+ i__2 = i__ + 1;
+ for (lastv = *n; lastv >= i__2; --lastv) {
+ if (v[i__ + lastv * v_dim1] != 0.) {
+ break;
+ }
+ }
+ j = min(lastv,prevlastv);
+
+/* T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)' */
+
+ i__2 = i__ - 1;
+ i__3 = j - i__ + 1;
+ d__1 = -tau[i__];
+ dgemv_("No transpose", &i__2, &i__3, &d__1, &v[i__ *
+ v_dim1 + 1], ldv, &v[i__ + i__ * v_dim1], ldv, &
+ c_b8, &t[i__ * t_dim1 + 1], &c__1);
+ }
+ v[i__ + i__ * v_dim1] = vii;
+
+/* T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i) */
+
+ i__2 = i__ - 1;
+ dtrmv_("Upper", "No transpose", "Non-unit", &i__2, &t[
+ t_offset], ldt, &t[i__ * t_dim1 + 1], &c__1);
+ t[i__ + i__ * t_dim1] = tau[i__];
+ if (i__ > 1) {
+ prevlastv = max(prevlastv,lastv);
+ } else {
+ prevlastv = lastv;
+ }
+ }
+/* L20: */
+ }
+ } else {
+ prevlastv = 1;
+ for (i__ = *k; i__ >= 1; --i__) {
+ if (tau[i__] == 0.) {
+
+/* H(i) = I */
+
+ i__1 = *k;
+ for (j = i__; j <= i__1; ++j) {
+ t[j + i__ * t_dim1] = 0.;
+/* L30: */
+ }
+ } else {
+
+/* general case */
+
+ if (i__ < *k) {
+ if (lsame_(storev, "C")) {
+ vii = v[*n - *k + i__ + i__ * v_dim1];
+ v[*n - *k + i__ + i__ * v_dim1] = 1.;
+/* Skip any leading zeros. */
+ i__1 = i__ - 1;
+ for (lastv = 1; lastv <= i__1; ++lastv) {
+ if (v[lastv + i__ * v_dim1] != 0.) {
+ break;
+ }
+ }
+ j = max(lastv,prevlastv);
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(j:n-k+i,i+1:k)' * V(j:n-k+i,i) */
+
+ i__1 = *n - *k + i__ - j + 1;
+ i__2 = *k - i__;
+ d__1 = -tau[i__];
+ dgemv_("Transpose", &i__1, &i__2, &d__1, &v[j + (i__
+ + 1) * v_dim1], ldv, &v[j + i__ * v_dim1], &
+ c__1, &c_b8, &t[i__ + 1 + i__ * t_dim1], &
+ c__1);
+ v[*n - *k + i__ + i__ * v_dim1] = vii;
+ } else {
+ vii = v[i__ + (*n - *k + i__) * v_dim1];
+ v[i__ + (*n - *k + i__) * v_dim1] = 1.;
+/* Skip any leading zeros. */
+ i__1 = i__ - 1;
+ for (lastv = 1; lastv <= i__1; ++lastv) {
+ if (v[i__ + lastv * v_dim1] != 0.) {
+ break;
+ }
+ }
+ j = max(lastv,prevlastv);
+
+/* T(i+1:k,i) := */
+/* - tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)' */
+
+ i__1 = *k - i__;
+ i__2 = *n - *k + i__ - j + 1;
+ d__1 = -tau[i__];
+ dgemv_("No transpose", &i__1, &i__2, &d__1, &v[i__ +
+ 1 + j * v_dim1], ldv, &v[i__ + j * v_dim1],
+ ldv, &c_b8, &t[i__ + 1 + i__ * t_dim1], &c__1);
+ v[i__ + (*n - *k + i__) * v_dim1] = vii;
+ }
+
+/* T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i) */
+
+ i__1 = *k - i__;
+ dtrmv_("Lower", "No transpose", "Non-unit", &i__1, &t[i__
+ + 1 + (i__ + 1) * t_dim1], ldt, &t[i__ + 1 + i__ *
+ t_dim1], &c__1)
+ ;
+ if (i__ > 1) {
+ prevlastv = min(prevlastv,lastv);
+ } else {
+ prevlastv = lastv;
+ }
+ }
+ t[i__ + i__ * t_dim1] = tau[i__];
+ }
+/* L40: */
+ }
+ }
+ return 0;
+
+/* End of DLARFT */
+
+} /* dlarft_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlascl.c b/src/lib/yac/clapack/SRC/dlascl.c
new file mode 100644
index 000000000..a4f4967b6
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlascl.c
@@ -0,0 +1,359 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlascl.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlascl_(char *type__, integer *kl, integer *ku,
+ doublereal *cfrom, doublereal *cto, integer *m, integer *n,
+ doublereal *a, integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4, i__5;
+
+ /* Local variables */
+ integer i__, j, k1, k2, k3, k4;
+ doublereal mul, cto1;
+ logical done;
+ doublereal ctoc;
+ extern logical lsame_(char *, char *);
+ integer itype;
+ doublereal cfrom1;
+ extern doublereal dlamch_(char *);
+ doublereal cfromc;
+ extern logical disnan_(doublereal *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ doublereal bignum, smlnum;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASCL multiplies the M by N real matrix A by the real scalar */
+/* CTO/CFROM. This is done without over/underflow as long as the final */
+/* result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that */
+/* A may be full, upper triangular, lower triangular, upper Hessenberg, */
+/* or banded. */
+
+/* Arguments */
+/* ========= */
+
+/* TYPE (input) CHARACTER*1 */
+/* TYPE indices the storage type of the input matrix. */
+/* = 'G': A is a full matrix. */
+/* = 'L': A is a lower triangular matrix. */
+/* = 'U': A is an upper triangular matrix. */
+/* = 'H': A is an upper Hessenberg matrix. */
+/* = 'B': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the lower */
+/* half stored. */
+/* = 'Q': A is a symmetric band matrix with lower bandwidth KL */
+/* and upper bandwidth KU and with the only the upper */
+/* half stored. */
+/* = 'Z': A is a band matrix with lower bandwidth KL and upper */
+/* bandwidth KU. */
+
+/* KL (input) INTEGER */
+/* The lower bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+
+/* KU (input) INTEGER */
+/* The upper bandwidth of A. Referenced only if TYPE = 'B', */
+/* 'Q' or 'Z'. */
+
+/* CFROM (input) DOUBLE PRECISION */
+/* CTO (input) DOUBLE PRECISION */
+/* The matrix A is multiplied by CTO/CFROM. A(I,J) is computed */
+/* without over/underflow if the final result CTO*A(I,J)/CFROM */
+/* can be represented without over/underflow. CFROM must be */
+/* nonzero. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The matrix to be multiplied by CTO/CFROM. See TYPE for the */
+/* storage type. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* INFO (output) INTEGER */
+/* 0 - successful exit */
+/* <0 - if INFO = -i, the i-th argument had an illegal value. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+
+ if (lsame_(type__, "G")) {
+ itype = 0;
+ } else if (lsame_(type__, "L")) {
+ itype = 1;
+ } else if (lsame_(type__, "U")) {
+ itype = 2;
+ } else if (lsame_(type__, "H")) {
+ itype = 3;
+ } else if (lsame_(type__, "B")) {
+ itype = 4;
+ } else if (lsame_(type__, "Q")) {
+ itype = 5;
+ } else if (lsame_(type__, "Z")) {
+ itype = 6;
+ } else {
+ itype = -1;
+ }
+
+ if (itype == -1) {
+ *info = -1;
+ } else if (*cfrom == 0. || disnan_(cfrom)) {
+ *info = -4;
+ } else if (disnan_(cto)) {
+ *info = -5;
+ } else if (*m < 0) {
+ *info = -6;
+ } else if (*n < 0 || itype == 4 && *n != *m || itype == 5 && *n != *m) {
+ *info = -7;
+ } else if (itype <= 3 && *lda < max(1,*m)) {
+ *info = -9;
+ } else if (itype >= 4) {
+/* Computing MAX */
+ i__1 = *m - 1;
+ if (*kl < 0 || *kl > max(i__1,0)) {
+ *info = -2;
+ } else /* if(complicated condition) */ {
+/* Computing MAX */
+ i__1 = *n - 1;
+ if (*ku < 0 || *ku > max(i__1,0) || (itype == 4 || itype == 5) &&
+ *kl != *ku) {
+ *info = -3;
+ } else if (itype == 4 && *lda < *kl + 1 || itype == 5 && *lda < *
+ ku + 1 || itype == 6 && *lda < (*kl << 1) + *ku + 1) {
+ *info = -9;
+ }
+ }
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DLASCL", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0 || *m == 0) {
+ return 0;
+ }
+
+/* Get machine parameters */
+
+ smlnum = dlamch_("S");
+ bignum = 1. / smlnum;
+
+ cfromc = *cfrom;
+ ctoc = *cto;
+
+L10:
+ cfrom1 = cfromc * smlnum;
+ if (cfrom1 == cfromc) {
+/* CFROMC is an inf. Multiply by a correctly signed zero for */
+/* finite CTOC, or a NaN if CTOC is infinite. */
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ cto1 = ctoc;
+ } else {
+ cto1 = ctoc / bignum;
+ if (cto1 == ctoc) {
+/* CTOC is either 0 or an inf. In both cases, CTOC itself */
+/* serves as the correct multiplication factor. */
+ mul = ctoc;
+ done = TRUE_;
+ cfromc = 1.;
+ } else if (abs(cfrom1) > abs(ctoc) && ctoc != 0.) {
+ mul = smlnum;
+ done = FALSE_;
+ cfromc = cfrom1;
+ } else if (abs(cto1) > abs(cfromc)) {
+ mul = bignum;
+ done = FALSE_;
+ ctoc = cto1;
+ } else {
+ mul = ctoc / cfromc;
+ done = TRUE_;
+ }
+ }
+
+ if (itype == 0) {
+
+/* Full matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L20: */
+ }
+/* L30: */
+ }
+
+ } else if (itype == 1) {
+
+/* Lower triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L40: */
+ }
+/* L50: */
+ }
+
+ } else if (itype == 2) {
+
+/* Upper triangular matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = min(j,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L60: */
+ }
+/* L70: */
+ }
+
+ } else if (itype == 3) {
+
+/* Upper Hessenberg matrix */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j + 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L80: */
+ }
+/* L90: */
+ }
+
+ } else if (itype == 4) {
+
+/* Lower half of a symmetric band matrix */
+
+ k3 = *kl + 1;
+ k4 = *n + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = k3, i__4 = k4 - j;
+ i__2 = min(i__3,i__4);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L100: */
+ }
+/* L110: */
+ }
+
+ } else if (itype == 5) {
+
+/* Upper half of a symmetric band matrix */
+
+ k1 = *ku + 2;
+ k3 = *ku + 1;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__2 = k1 - j;
+ i__3 = k3;
+ for (i__ = max(i__2,1); i__ <= i__3; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L120: */
+ }
+/* L130: */
+ }
+
+ } else if (itype == 6) {
+
+/* Band matrix */
+
+ k1 = *kl + *ku + 2;
+ k2 = *kl + 1;
+ k3 = (*kl << 1) + *ku + 1;
+ k4 = *kl + *ku + 1 + *m;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+/* Computing MAX */
+ i__3 = k1 - j;
+/* Computing MIN */
+ i__4 = k3, i__5 = k4 - j;
+ i__2 = min(i__4,i__5);
+ for (i__ = max(i__3,k2); i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] *= mul;
+/* L140: */
+ }
+/* L150: */
+ }
+
+ }
+
+ if (! done) {
+ goto L10;
+ }
+
+ return 0;
+
+/* End of DLASCL */
+
+} /* dlascl_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlaset.c b/src/lib/yac/clapack/SRC/dlaset.c
new file mode 100644
index 000000000..e37cb8262
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlaset.c
@@ -0,0 +1,157 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlaset.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlaset_(char *uplo, integer *m, integer *n, doublereal *
+ alpha, doublereal *beta, doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3;
+
+ /* Local variables */
+ integer i__, j;
+ extern logical lsame_(char *, char *);
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASET initializes an m-by-n matrix A to BETA on the diagonal and */
+/* ALPHA on the offdiagonals. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* Specifies the part of the matrix A to be set. */
+/* = 'U': Upper triangular part is set; the strictly lower */
+/* triangular part of A is not changed. */
+/* = 'L': Lower triangular part is set; the strictly upper */
+/* triangular part of A is not changed. */
+/* Otherwise: All of the matrix A is set. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. N >= 0. */
+
+/* ALPHA (input) DOUBLE PRECISION */
+/* The constant to which the offdiagonal elements are to be set. */
+
+/* BETA (input) DOUBLE PRECISION */
+/* The constant to which the diagonal elements are to be set. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On exit, the leading m-by-n submatrix of A is set as follows: */
+
+/* if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n, */
+/* if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n, */
+/* otherwise, A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j, */
+
+/* and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ if (lsame_(uplo, "U")) {
+
+/* Set the strictly upper triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ i__1 = *n;
+ for (j = 2; j <= i__1; ++j) {
+/* Computing MIN */
+ i__3 = j - 1;
+ i__2 = min(i__3,*m);
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L10: */
+ }
+/* L20: */
+ }
+
+ } else if (lsame_(uplo, "L")) {
+
+/* Set the strictly lower triangular or trapezoidal part of the */
+/* array to ALPHA. */
+
+ i__1 = min(*m,*n);
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = j + 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L30: */
+ }
+/* L40: */
+ }
+
+ } else {
+
+/* Set the leading m-by-n submatrix to ALPHA. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ i__2 = *m;
+ for (i__ = 1; i__ <= i__2; ++i__) {
+ a[i__ + j * a_dim1] = *alpha;
+/* L50: */
+ }
+/* L60: */
+ }
+ }
+
+/* Set the first min(M,N) diagonal elements to BETA. */
+
+ i__1 = min(*m,*n);
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ a[i__ + i__ * a_dim1] = *beta;
+/* L70: */
+ }
+
+ return 0;
+
+/* End of DLASET */
+
+} /* dlaset_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlassq.c b/src/lib/yac/clapack/SRC/dlassq.c
new file mode 100644
index 000000000..cc034f8ca
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlassq.c
@@ -0,0 +1,121 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlassq.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlassq_(integer *n, doublereal *x, integer *incx,
+ doublereal *scale, doublereal *sumsq)
+{
+ /* System generated locals */
+ integer i__1, i__2;
+ doublereal d__1;
+
+ /* Local variables */
+ integer ix;
+ doublereal absxi;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASSQ returns the values scl and smsq such that */
+
+/* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, */
+
+/* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is */
+/* assumed to be non-negative and scl returns the value */
+
+/* scl = max( scale, abs( x( i ) ) ). */
+
+/* scale and sumsq must be supplied in SCALE and SUMSQ and */
+/* scl and smsq are overwritten on SCALE and SUMSQ respectively. */
+
+/* The routine makes only one pass through the vector x. */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The number of elements to be used from the vector X. */
+
+/* X (input) DOUBLE PRECISION array, dimension (N) */
+/* The vector for which a scaled sum of squares is computed. */
+/* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. */
+
+/* INCX (input) INTEGER */
+/* The increment between successive values of the vector X. */
+/* INCX > 0. */
+
+/* SCALE (input/output) DOUBLE PRECISION */
+/* On entry, the value scale in the equation above. */
+/* On exit, SCALE is overwritten with scl , the scaling factor */
+/* for the sum of squares. */
+
+/* SUMSQ (input/output) DOUBLE PRECISION */
+/* On entry, the value sumsq in the equation above. */
+/* On exit, SUMSQ is overwritten with smsq , the basic sum of */
+/* squares from which scl has been factored out. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ --x;
+
+ /* Function Body */
+ if (*n > 0) {
+ i__1 = (*n - 1) * *incx + 1;
+ i__2 = *incx;
+ for (ix = 1; i__2 < 0 ? ix >= i__1 : ix <= i__1; ix += i__2) {
+ if (x[ix] != 0.) {
+ absxi = (d__1 = x[ix], abs(d__1));
+ if (*scale < absxi) {
+/* Computing 2nd power */
+ d__1 = *scale / absxi;
+ *sumsq = *sumsq * (d__1 * d__1) + 1;
+ *scale = absxi;
+ } else {
+/* Computing 2nd power */
+ d__1 = absxi / *scale;
+ *sumsq += d__1 * d__1;
+ }
+ }
+/* L10: */
+ }
+ }
+ return 0;
+
+/* End of DLASSQ */
+
+} /* dlassq_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlaswp.c b/src/lib/yac/clapack/SRC/dlaswp.c
new file mode 100644
index 000000000..fec1c547b
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlaswp.c
@@ -0,0 +1,163 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlaswp.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dlaswp_(integer *n, doublereal *a, integer *lda, integer
+ *k1, integer *k2, integer *ipiv, integer *incx)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
+
+ /* Local variables */
+ integer i__, j, k, i1, i2, n32, ip, ix, ix0, inc;
+ doublereal temp;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASWP performs a series of row interchanges on the matrix A. */
+/* One row interchange is initiated for each of rows K1 through K2 of A. */
+
+/* Arguments */
+/* ========= */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the matrix of column dimension N to which the row */
+/* interchanges will be applied. */
+/* On exit, the permuted matrix. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+
+/* K1 (input) INTEGER */
+/* The first element of IPIV for which a row interchange will */
+/* be done. */
+
+/* K2 (input) INTEGER */
+/* The last element of IPIV for which a row interchange will */
+/* be done. */
+
+/* IPIV (input) INTEGER array, dimension (K2*abs(INCX)) */
+/* The vector of pivot indices. Only the elements in positions */
+/* K1 through K2 of IPIV are accessed. */
+/* IPIV(K) = L implies rows K and L are to be interchanged. */
+
+/* INCX (input) INTEGER */
+/* The increment between successive values of IPIV. If IPIV */
+/* is negative, the pivots are applied in reverse order. */
+
+/* Further Details */
+/* =============== */
+
+/* Modified by */
+/* R. C. Whaley, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Interchange row I with row IPIV(I) for each of rows K1 through K2. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ if (*incx > 0) {
+ ix0 = *k1;
+ i1 = *k1;
+ i2 = *k2;
+ inc = 1;
+ } else if (*incx < 0) {
+ ix0 = (1 - *k2) * *incx + 1;
+ i1 = *k2;
+ i2 = *k1;
+ inc = -1;
+ } else {
+ return 0;
+ }
+
+ n32 = *n / 32 << 5;
+ if (n32 != 0) {
+ i__1 = n32;
+ for (j = 1; j <= i__1; j += 32) {
+ ix = ix0;
+ i__2 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__3)
+ {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__4 = j + 31;
+ for (k = j; k <= i__4; ++k) {
+ temp = a[i__ + k * a_dim1];
+ a[i__ + k * a_dim1] = a[ip + k * a_dim1];
+ a[ip + k * a_dim1] = temp;
+/* L10: */
+ }
+ }
+ ix += *incx;
+/* L20: */
+ }
+/* L30: */
+ }
+ }
+ if (n32 != *n) {
+ ++n32;
+ ix = ix0;
+ i__1 = i2;
+ i__3 = inc;
+ for (i__ = i1; i__3 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__3) {
+ ip = ipiv[ix];
+ if (ip != i__) {
+ i__2 = *n;
+ for (k = n32; k <= i__2; ++k) {
+ temp = a[i__ + k * a_dim1];
+ a[i__ + k * a_dim1] = a[ip + k * a_dim1];
+ a[ip + k * a_dim1] = temp;
+/* L40: */
+ }
+ }
+ ix += *incx;
+/* L50: */
+ }
+ }
+
+ return 0;
+
+/* End of DLASWP */
+
+} /* dlaswp_ */
+
diff --git a/src/lib/yac/clapack/SRC/dlasyf.c b/src/lib/yac/clapack/SRC/dlasyf.c
new file mode 100644
index 000000000..61049de56
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dlasyf.c
@@ -0,0 +1,726 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dlasyf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b8 = -1.;
+static doublereal c_b9 = 1.;
+
+/* Subroutine */ int dlasyf_(char *uplo, integer *n, integer *nb, integer *kb,
+ doublereal *a, integer *lda, integer *ipiv, doublereal *w, integer *
+ ldw, integer *info)
+{
+ /* System generated locals */
+ 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;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ integer j, k;
+ doublereal t, r1, d11, d21, d22;
+ integer jb, jj, kk, jp, kp, kw, kkw, imax, jmax;
+ doublereal alpha;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *), dgemm_(char *, char *, integer *, integer *, integer *
+, doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
+ doublereal *, doublereal *, integer *, doublereal *, integer *,
+ doublereal *, doublereal *, integer *), 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;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DLASYF computes a partial factorization of a real symmetric matrix A */
+/* using the Bunch-Kaufman diagonal pivoting method. The partial */
+/* factorization has the form: */
+
+/* A = ( I U12 ) ( A11 0 ) ( I 0 ) if UPLO = 'U', or: */
+/* ( 0 U22 ) ( 0 D ) ( U12' U22' ) */
+
+/* A = ( L11 0 ) ( D 0 ) ( L11' L21' ) if UPLO = 'L' */
+/* ( L21 I ) ( 0 A22 ) ( 0 I ) */
+
+/* where the order of D is at most NB. The actual order is returned in */
+/* the argument KB, and is either NB or NB-1, or N if N <= NB. */
+
+/* DLASYF is an auxiliary routine called by DSYTRF. It uses blocked code */
+/* (calling Level 3 BLAS) to update the submatrix A11 (if UPLO = 'U') or */
+/* A22 (if UPLO = 'L'). */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the upper or lower triangular part of the */
+/* symmetric matrix A is stored: */
+/* = 'U': Upper triangular */
+/* = 'L': Lower triangular */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* NB (input) INTEGER */
+/* The maximum number of columns of the matrix A that should be */
+/* factored. NB should be at least 2 to allow for 2-by-2 pivot */
+/* blocks. */
+
+/* KB (output) INTEGER */
+/* The number of columns of A that were actually factored. */
+/* KB is either NB-1 or NB, or N if N <= NB. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the symmetric matrix A. If UPLO = 'U', the leading */
+/* n-by-n upper triangular part of A contains the upper */
+/* triangular part of the matrix A, and the strictly lower */
+/* triangular part of A is not referenced. If UPLO = 'L', the */
+/* leading n-by-n lower triangular part of A contains the lower */
+/* triangular part of the matrix A, and the strictly upper */
+/* triangular part of A is not referenced. */
+/* On exit, A contains details of the partial factorization. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (output) INTEGER array, dimension (N) */
+/* Details of the interchanges and the block structure of D. */
+/* If UPLO = 'U', only the last KB elements of IPIV are set; */
+/* if UPLO = 'L', only the first KB elements are set. */
+
+/* If IPIV(k) > 0, then rows and columns k and IPIV(k) were */
+/* interchanged and D(k,k) is a 1-by-1 diagonal block. */
+/* If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and */
+/* columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k) */
+/* is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) = */
+/* IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were */
+/* interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block. */
+
+/* W (workspace) DOUBLE PRECISION array, dimension (LDW,NB) */
+
+/* LDW (input) INTEGER */
+/* The leading dimension of the array W. LDW >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* > 0: if INFO = k, D(k,k) is exactly zero. The factorization */
+/* has been completed, but the block diagonal matrix D is */
+/* exactly singular. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ w_dim1 = *ldw;
+ w_offset = 1 + w_dim1;
+ w -= w_offset;
+
+ /* Function Body */
+ *info = 0;
+
+/* Initialize ALPHA for use in choosing pivot block size. */
+
+ alpha = (sqrt(17.) + 1.) / 8.;
+
+ if (lsame_(uplo, "U")) {
+
+/* Factorize the trailing columns of A using the upper triangle */
+/* of A and working backwards, and compute the matrix W = U12*D */
+/* for use in updating A11 */
+
+/* K is the main loop index, decreasing from N in steps of 1 or 2 */
+
+/* KW is the column of W which corresponds to column K of A */
+
+ k = *n;
+L10:
+ kw = *nb + k - *n;
+
+/* Exit from loop */
+
+ if (k <= *n - *nb + 1 && *nb < *n || k < 1) {
+ goto L30;
+ }
+
+/* Copy column K of A to column KW of W and update it */
+
+ dcopy_(&k, &a[k * a_dim1 + 1], &c__1, &w[kw * w_dim1 + 1], &c__1);
+ if (k < *n) {
+ i__1 = *n - k;
+ dgemv_("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);
+ }
+
+ kstep = 1;
+
+/* Determine rows and columns to be interchanged and whether */
+/* a 1-by-1 or 2-by-2 pivot block will be used */
+
+ absakk = (d__1 = w[k + kw * w_dim1], abs(d__1));
+
+/* IMAX is the row-index of the largest off-diagonal element in */
+/* column K, and COLMAX is its absolute value */
+
+ 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.) {
+
+/* Column K is zero: set INFO and continue */
+
+ if (*info == 0) {
+ *info = k;
+ }
+ kp = k;
+ } else {
+ if (absakk >= alpha * colmax) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else {
+
+/* Copy column IMAX to column KW-1 of W and update it */
+
+ 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_("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);
+ }
+
+/* JMAX is the column-index of the largest off-diagonal */
+/* element in row IMAX, and ROWMAX is its absolute value */
+
+ 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);
+/* Computing MAX */
+ 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)) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else if ((d__1 = w[imax + (kw - 1) * w_dim1], abs(d__1)) >=
+ alpha * rowmax) {
+
+/* interchange rows and columns K and IMAX, use 1-by-1 */
+/* pivot block */
+
+ kp = imax;
+
+/* copy column KW-1 of W to column KW */
+
+ dcopy_(&k, &w[(kw - 1) * w_dim1 + 1], &c__1, &w[kw *
+ w_dim1 + 1], &c__1);
+ } else {
+
+/* interchange rows and columns K-1 and IMAX, use 2-by-2 */
+/* pivot block */
+
+ kp = imax;
+ kstep = 2;
+ }
+ }
+
+ kk = k - kstep + 1;
+ kkw = *nb + kk - *n;
+
+/* Updated column KP is already stored in column KKW of W */
+
+ if (kp != kk) {
+
+/* Copy non-updated column KK to column KP */
+
+ a[kp + k * a_dim1] = a[kk + k * a_dim1];
+ i__1 = k - 1 - kp;
+ dcopy_(&i__1, &a[kp + 1 + kk * a_dim1], &c__1, &a[kp + (kp +
+ 1) * a_dim1], lda);
+ dcopy_(&kp, &a[kk * a_dim1 + 1], &c__1, &a[kp * a_dim1 + 1], &
+ c__1);
+
+/* Interchange rows KK and KP in last KK columns of A and W */
+
+ i__1 = *n - kk + 1;
+ dswap_(&i__1, &a[kk + kk * a_dim1], lda, &a[kp + kk * 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) {
+
+/* 1-by-1 pivot block D(k): column KW of W now holds */
+
+/* W(k) = U(k)*D(k) */
+
+/* where U(k) is the k-th column of U */
+
+/* Store U(k) in column k of A */
+
+ 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 {
+
+/* 2-by-2 pivot block D(k): columns KW and KW-1 of W now */
+/* hold */
+
+/* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k) */
+
+/* where U(k) and U(k-1) are the k-th and (k-1)-th columns */
+/* of U */
+
+ if (k > 2) {
+
+/* Store U(k) and U(k-1) in columns k and k-1 of A */
+
+ 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]);
+/* L20: */
+ }
+ }
+
+/* Copy D(k) to A */
+
+ 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];
+ }
+ }
+
+/* Store details of the interchanges in IPIV */
+
+ if (kstep == 1) {
+ ipiv[k] = kp;
+ } else {
+ ipiv[k] = -kp;
+ ipiv[k - 1] = -kp;
+ }
+
+/* Decrease K and return to the start of the main loop */
+
+ k -= kstep;
+ goto L10;
+
+L30:
+
+/* Update the upper triangle of A11 (= A(1:k,1:k)) as */
+
+/* A11 := A11 - U12*D*U12' = A11 - U12*W' */
+
+/* computing blocks of NB columns at a time */
+
+ i__1 = -(*nb);
+ for (j = (k - 1) / *nb * *nb + 1; i__1 < 0 ? j >= 1 : j <= 1; j +=
+ i__1) {
+/* Computing MIN */
+ i__2 = *nb, i__3 = k - j + 1;
+ jb = min(i__2,i__3);
+
+/* Update the upper triangle of the diagonal block */
+
+ i__2 = j + jb - 1;
+ for (jj = j; jj <= i__2; ++jj) {
+ i__3 = jj - j + 1;
+ i__4 = *n - k;
+ dgemv_("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);
+/* L40: */
+ }
+
+/* Update the rectangular superdiagonal block */
+
+ i__2 = j - 1;
+ i__3 = *n - k;
+ dgemm_("No transpose", "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);
+/* L50: */
+ }
+
+/* Put U12 in standard form by partially undoing the interchanges */
+/* in columns k+1:n */
+
+ 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;
+ }
+
+/* Set KB to the number of columns factorized */
+
+ *kb = *n - k;
+
+ } else {
+
+/* Factorize the leading columns of A using the lower triangle */
+/* of A and working forwards, and compute the matrix W = L21*D */
+/* for use in updating A22 */
+
+/* K is the main loop index, increasing from 1 in steps of 1 or 2 */
+
+ k = 1;
+L70:
+
+/* Exit from loop */
+
+ if (k >= *nb && *nb < *n || k > *n) {
+ goto L90;
+ }
+
+/* Copy column K of A to column K of W and update it */
+
+ 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_("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);
+
+ kstep = 1;
+
+/* Determine rows and columns to be interchanged and whether */
+/* a 1-by-1 or 2-by-2 pivot block will be used */
+
+ absakk = (d__1 = w[k + k * w_dim1], abs(d__1));
+
+/* IMAX is the row-index of the largest off-diagonal element in */
+/* column K, and COLMAX is its absolute value */
+
+ 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.) {
+
+/* Column K is zero: set INFO and continue */
+
+ if (*info == 0) {
+ *info = k;
+ }
+ kp = k;
+ } else {
+ if (absakk >= alpha * colmax) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else {
+
+/* Copy column IMAX to column K+1 of W and update it */
+
+ 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_("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);
+
+/* JMAX is the column-index of the largest off-diagonal */
+/* element in row IMAX, and ROWMAX is its absolute value */
+
+ 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);
+/* Computing MAX */
+ 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)) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else if ((d__1 = w[imax + (k + 1) * w_dim1], abs(d__1)) >=
+ alpha * rowmax) {
+
+/* interchange rows and columns K and IMAX, use 1-by-1 */
+/* pivot block */
+
+ kp = imax;
+
+/* copy column K+1 of W to column K */
+
+ i__1 = *n - k + 1;
+ dcopy_(&i__1, &w[k + (k + 1) * w_dim1], &c__1, &w[k + k *
+ w_dim1], &c__1);
+ } else {
+
+/* interchange rows and columns K+1 and IMAX, use 2-by-2 */
+/* pivot block */
+
+ kp = imax;
+ kstep = 2;
+ }
+ }
+
+ kk = k + kstep - 1;
+
+/* Updated column KP is already stored in column KK of W */
+
+ if (kp != kk) {
+
+/* Copy non-updated column KK to column KP */
+
+ a[kp + k * a_dim1] = a[kk + k * a_dim1];
+ i__1 = kp - k - 1;
+ dcopy_(&i__1, &a[k + 1 + kk * a_dim1], &c__1, &a[kp + (k + 1)
+ * a_dim1], lda);
+ i__1 = *n - kp + 1;
+ dcopy_(&i__1, &a[kp + kk * a_dim1], &c__1, &a[kp + kp *
+ a_dim1], &c__1);
+
+/* Interchange rows KK and KP in first KK columns of A and W */
+
+ dswap_(&kk, &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) {
+
+/* 1-by-1 pivot block D(k): column k of W now holds */
+
+/* W(k) = L(k)*D(k) */
+
+/* where L(k) is the k-th column of L */
+
+/* Store L(k) in column k of A */
+
+ 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 {
+
+/* 2-by-2 pivot block D(k): columns k and k+1 of W now hold */
+
+/* ( W(k) W(k+1) ) = ( L(k) L(k+1) )*D(k) */
+
+/* where L(k) and L(k+1) are the k-th and (k+1)-th columns */
+/* of L */
+
+ if (k < *n - 1) {
+
+/* Store L(k) and L(k+1) in columns k and k+1 of A */
+
+ 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]);
+/* L80: */
+ }
+ }
+
+/* Copy D(k) to A */
+
+ 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];
+ }
+ }
+
+/* Store details of the interchanges in IPIV */
+
+ if (kstep == 1) {
+ ipiv[k] = kp;
+ } else {
+ ipiv[k] = -kp;
+ ipiv[k + 1] = -kp;
+ }
+
+/* Increase K and return to the start of the main loop */
+
+ k += kstep;
+ goto L70;
+
+L90:
+
+/* Update the lower triangle of A22 (= A(k:n,k:n)) as */
+
+/* A22 := A22 - L21*D*L21' = A22 - L21*W' */
+
+/* computing blocks of NB columns at a time */
+
+ i__1 = *n;
+ i__2 = *nb;
+ for (j = k; i__2 < 0 ? j >= i__1 : j <= i__1; j += i__2) {
+/* Computing MIN */
+ i__3 = *nb, i__4 = *n - j + 1;
+ jb = min(i__3,i__4);
+
+/* Update the lower triangle of the diagonal block */
+
+ i__3 = j + jb - 1;
+ for (jj = j; jj <= i__3; ++jj) {
+ i__4 = j + jb - jj;
+ i__5 = k - 1;
+ dgemv_("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);
+/* L100: */
+ }
+
+/* Update the rectangular subdiagonal block */
+
+ if (j + jb <= *n) {
+ i__3 = *n - j - jb + 1;
+ i__4 = k - 1;
+ dgemm_("No transpose", "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);
+ }
+/* L110: */
+ }
+
+/* Put L21 in standard form by partially undoing the interchanges */
+/* in columns 1:k-1 */
+
+ 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;
+ }
+
+/* Set KB to the number of columns factorized */
+
+ *kb = k - 1;
+
+ }
+ return 0;
+
+/* End of DLASYF */
+
+} /* dlasyf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dorm2r.c b/src/lib/yac/clapack/SRC/dorm2r.c
new file mode 100644
index 000000000..306ceea3b
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dorm2r.c
@@ -0,0 +1,240 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dorm2r.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int dorm2r_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ doublereal aii;
+ logical left;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ logical notran;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DORM2R overwrites the general real m by n matrix C with */
+
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+
+/* Q = H(1) H(2) . . . H(k) */
+
+/* as returned by DGEQRF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,K) */
+/* The i-th column must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGEQRF in the first k columns of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* If SIDE = 'L', LDA >= max(1,M); */
+/* if SIDE = 'R', LDA >= max(1,N). */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORM2R", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if (left && ! notran || ! left && notran) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], &c__1, &tau[i__], &c__[
+ ic + jc * c_dim1], ldc, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+/* L10: */
+ }
+ return 0;
+
+/* End of DORM2R */
+
+} /* dorm2r_ */
+
diff --git a/src/lib/yac/clapack/SRC/dorml2.c b/src/lib/yac/clapack/SRC/dorml2.c
new file mode 100644
index 000000000..c1bc9a0e2
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dorml2.c
@@ -0,0 +1,236 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dorml2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Subroutine */ int dorml2_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2;
+
+ /* Local variables */
+ integer i__, i1, i2, i3, ic, jc, mi, ni, nq;
+ doublereal aii;
+ logical left;
+ extern /* Subroutine */ int dlarf_(char *, integer *, integer *,
+ doublereal *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ logical notran;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DORML2 overwrites the general real m by n matrix C with */
+
+/* Q * C if SIDE = 'L' and TRANS = 'N', or */
+
+/* Q'* C if SIDE = 'L' and TRANS = 'T', or */
+
+/* C * Q if SIDE = 'R' and TRANS = 'N', or */
+
+/* C * Q' if SIDE = 'R' and TRANS = 'T', */
+
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+
+/* Q = H(k) . . . H(2) H(1) */
+
+/* as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n */
+/* if SIDE = 'R'. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q' from the Left */
+/* = 'R': apply Q or Q' from the Right */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': apply Q (No transpose) */
+/* = 'T': apply Q' (Transpose) */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension */
+/* (LDA,M) if SIDE = 'L', */
+/* (LDA,N) if SIDE = 'R' */
+/* The i-th row must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGELQF in the first k rows of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,K). */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGELQF. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the m by n matrix C. */
+/* On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension */
+/* (N) if SIDE = 'L', */
+/* (M) if SIDE = 'R' */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+
+/* NQ is the order of Q */
+
+ if (left) {
+ nq = *m;
+ } else {
+ nq = *n;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORML2", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ return 0;
+ }
+
+ if (left && notran || ! left && ! notran) {
+ i1 = 1;
+ i2 = *k;
+ i3 = 1;
+ } else {
+ i1 = *k;
+ i2 = 1;
+ i3 = -1;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+ if (left) {
+
+/* H(i) is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H(i) is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H(i) */
+
+ aii = a[i__ + i__ * a_dim1];
+ a[i__ + i__ * a_dim1] = 1.;
+ dlarf_(side, &mi, &ni, &a[i__ + i__ * a_dim1], lda, &tau[i__], &c__[
+ ic + jc * c_dim1], ldc, &work[1]);
+ a[i__ + i__ * a_dim1] = aii;
+/* L10: */
+ }
+ return 0;
+
+/* End of DORML2 */
+
+} /* dorml2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dormlq.c b/src/lib/yac/clapack/SRC/dormlq.c
new file mode 100644
index 000000000..8c6ab6e79
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dormlq.c
@@ -0,0 +1,339 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dormlq.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static integer c__65 = 65;
+
+/* Subroutine */ int dormlq_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ integer i__;
+ doublereal t[4160] /* was [65][64] */;
+ integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ logical left;
+ extern logical lsame_(char *, char *);
+ integer nbmin, iinfo;
+ extern /* Subroutine */ int dorml2_(char *, char *, 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 *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ logical notran;
+ integer ldwork;
+ char transt[1];
+ integer lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DORMLQ overwrites the general real M-by-N matrix C with */
+
+/* SIDE = 'L' SIDE = 'R' */
+/* TRANS = 'N': Q * C C * Q */
+/* TRANS = 'T': Q**T * C C * Q**T */
+
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+
+/* Q = H(k) . . . H(2) H(1) */
+
+/* as returned by DGELQF. Q is of order M if SIDE = 'L' and of order N */
+/* if SIDE = 'R'. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q**T from the Left; */
+/* = 'R': apply Q or Q**T from the Right. */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': No transpose, apply Q; */
+/* = 'T': Transpose, apply Q**T. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension */
+/* (LDA,M) if SIDE = 'L', */
+/* (LDA,N) if SIDE = 'R' */
+/* The i-th row must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGELQF in the first k rows of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,K). */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGELQF. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the M-by-N matrix C. */
+/* On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. */
+/* If SIDE = 'L', LWORK >= max(1,N); */
+/* if SIDE = 'R', LWORK >= max(1,M). */
+/* For optimum performance LWORK >= N*NB if SIDE = 'L', and */
+/* LWORK >= M*NB if SIDE = 'R', where NB is the optimal */
+/* blocksize. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Local Arrays .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,*k)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if (*lwork < max(1,nw) && ! lquery) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/* Determine the block size. NB may be at most NBMAX, where NBMAX */
+/* is used to define the local array T. */
+
+/* Computing MIN */
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DORMLQ", ch__1, m, n, k, &c_n1);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMLQ", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if (nb > 1 && nb < *k) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/* Computing MAX */
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORMLQ", ch__1, m, n, k, &c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorml2_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if (left && notran || ! left && ! notran) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ if (notran) {
+ *(unsigned char *)transt = 'T';
+ } else {
+ *(unsigned char *)transt = 'N';
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__4 = nq - i__ + 1;
+ dlarft_("Forward", "Rowwise", &i__4, &ib, &a[i__ + i__ * a_dim1],
+ lda, &tau[i__], t, &c__65);
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, transt, "Forward", "Rowwise", &mi, &ni, &ib, &a[i__
+ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc * c_dim1],
+ ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMLQ */
+
+} /* dormlq_ */
+
diff --git a/src/lib/yac/clapack/SRC/dormqr.c b/src/lib/yac/clapack/SRC/dormqr.c
new file mode 100644
index 000000000..e911dd8e2
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dormqr.c
@@ -0,0 +1,332 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dormqr.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static integer c__65 = 65;
+
+/* Subroutine */ int dormqr_(char *side, char *trans, integer *m, integer *n,
+ integer *k, doublereal *a, integer *lda, doublereal *tau, doublereal *
+ c__, integer *ldc, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, c_dim1, c_offset, i__1, i__2, i__3[2], i__4,
+ i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ integer i__;
+ doublereal t[4160] /* was [65][64] */;
+ integer i1, i2, i3, ib, ic, jc, nb, mi, ni, nq, nw, iws;
+ logical left;
+ extern logical lsame_(char *, char *);
+ integer nbmin, iinfo;
+ extern /* Subroutine */ int dorm2r_(char *, char *, 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 *), dlarft_(char *, char *, integer *, integer *, doublereal
+ *, integer *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ logical notran;
+ integer ldwork, lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DORMQR overwrites the general real M-by-N matrix C with */
+
+/* SIDE = 'L' SIDE = 'R' */
+/* TRANS = 'N': Q * C C * Q */
+/* TRANS = 'T': Q**T * C C * Q**T */
+
+/* where Q is a real orthogonal matrix defined as the product of k */
+/* elementary reflectors */
+
+/* Q = H(1) H(2) . . . H(k) */
+
+/* as returned by DGEQRF. Q is of order M if SIDE = 'L' and of order N */
+/* if SIDE = 'R'. */
+
+/* Arguments */
+/* ========= */
+
+/* SIDE (input) CHARACTER*1 */
+/* = 'L': apply Q or Q**T from the Left; */
+/* = 'R': apply Q or Q**T from the Right. */
+
+/* TRANS (input) CHARACTER*1 */
+/* = 'N': No transpose, apply Q; */
+/* = 'T': Transpose, apply Q**T. */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix C. M >= 0. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix C. N >= 0. */
+
+/* K (input) INTEGER */
+/* The number of elementary reflectors whose product defines */
+/* the matrix Q. */
+/* If SIDE = 'L', M >= K >= 0; */
+/* if SIDE = 'R', N >= K >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,K) */
+/* The i-th column must contain the vector which defines the */
+/* elementary reflector H(i), for i = 1,2,...,k, as returned by */
+/* DGEQRF in the first k columns of its array argument A. */
+/* A is modified by the routine but restored on exit. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. */
+/* If SIDE = 'L', LDA >= max(1,M); */
+/* if SIDE = 'R', LDA >= max(1,N). */
+
+/* TAU (input) DOUBLE PRECISION array, dimension (K) */
+/* TAU(i) must contain the scalar factor of the elementary */
+/* reflector H(i), as returned by DGEQRF. */
+
+/* C (input/output) DOUBLE PRECISION array, dimension (LDC,N) */
+/* On entry, the M-by-N matrix C. */
+/* On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q. */
+
+/* LDC (input) INTEGER */
+/* The leading dimension of the array C. LDC >= max(1,M). */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The dimension of the array WORK. */
+/* If SIDE = 'L', LWORK >= max(1,N); */
+/* if SIDE = 'R', LWORK >= max(1,M). */
+/* For optimum performance LWORK >= N*NB if SIDE = 'L', and */
+/* LWORK >= M*NB if SIDE = 'R', where NB is the optimal */
+/* blocksize. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Local Arrays .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input arguments */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --tau;
+ c_dim1 = *ldc;
+ c_offset = 1 + c_dim1;
+ c__ -= c_offset;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ left = lsame_(side, "L");
+ notran = lsame_(trans, "N");
+ lquery = *lwork == -1;
+
+/* NQ is the order of Q and NW is the minimum dimension of WORK */
+
+ if (left) {
+ nq = *m;
+ nw = *n;
+ } else {
+ nq = *n;
+ nw = *m;
+ }
+ if (! left && ! lsame_(side, "R")) {
+ *info = -1;
+ } else if (! notran && ! lsame_(trans, "T")) {
+ *info = -2;
+ } else if (*m < 0) {
+ *info = -3;
+ } else if (*n < 0) {
+ *info = -4;
+ } else if (*k < 0 || *k > nq) {
+ *info = -5;
+ } else if (*lda < max(1,nq)) {
+ *info = -7;
+ } else if (*ldc < max(1,*m)) {
+ *info = -10;
+ } else if (*lwork < max(1,nw) && ! lquery) {
+ *info = -12;
+ }
+
+ if (*info == 0) {
+
+/* Determine the block size. NB may be at most NBMAX, where NBMAX */
+/* is used to define the local array T. */
+
+/* Computing MIN */
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 64, i__2 = ilaenv_(&c__1, "DORMQR", ch__1, m, n, k, &c_n1);
+ nb = min(i__1,i__2);
+ lwkopt = max(1,nw) * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DORMQR", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*m == 0 || *n == 0 || *k == 0) {
+ work[1] = 1.;
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = nw;
+ if (nb > 1 && nb < *k) {
+ iws = nw * nb;
+ if (*lwork < iws) {
+ nb = *lwork / ldwork;
+/* Computing MAX */
+/* Writing concatenation */
+ i__3[0] = 1, a__1[0] = side;
+ i__3[1] = 1, a__1[1] = trans;
+ s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)2);
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DORMQR", ch__1, m, n, k, &c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = nw;
+ }
+
+ if (nb < nbmin || nb >= *k) {
+
+/* Use unblocked code */
+
+ dorm2r_(side, trans, m, n, k, &a[a_offset], lda, &tau[1], &c__[
+ c_offset], ldc, &work[1], &iinfo);
+ } else {
+
+/* Use blocked code */
+
+ if (left && ! notran || ! left && notran) {
+ i1 = 1;
+ i2 = *k;
+ i3 = nb;
+ } else {
+ i1 = (*k - 1) / nb * nb + 1;
+ i2 = 1;
+ i3 = -nb;
+ }
+
+ if (left) {
+ ni = *n;
+ jc = 1;
+ } else {
+ mi = *m;
+ ic = 1;
+ }
+
+ i__1 = i2;
+ i__2 = i3;
+ for (i__ = i1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *k - i__ + 1;
+ ib = min(i__4,i__5);
+
+/* Form the triangular factor of the block reflector */
+/* H = H(i) H(i+1) . . . H(i+ib-1) */
+
+ i__4 = nq - i__ + 1;
+ dlarft_("Forward", "Columnwise", &i__4, &ib, &a[i__ + i__ *
+ a_dim1], lda, &tau[i__], t, &c__65)
+ ;
+ if (left) {
+
+/* H or H' is applied to C(i:m,1:n) */
+
+ mi = *m - i__ + 1;
+ ic = i__;
+ } else {
+
+/* H or H' is applied to C(1:m,i:n) */
+
+ ni = *n - i__ + 1;
+ jc = i__;
+ }
+
+/* Apply H or H' */
+
+ dlarfb_(side, trans, "Forward", "Columnwise", &mi, &ni, &ib, &a[
+ i__ + i__ * a_dim1], lda, t, &c__65, &c__[ic + jc *
+ c_dim1], ldc, &work[1], &ldwork);
+/* L10: */
+ }
+ }
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DORMQR */
+
+} /* dormqr_ */
+
diff --git a/src/lib/yac/clapack/SRC/dsytf2.c b/src/lib/yac/clapack/SRC/dsytf2.c
new file mode 100644
index 000000000..7516ad3d1
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dsytf2.c
@@ -0,0 +1,613 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dsytf2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int dsytf2_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+ doublereal d__1, d__2, d__3;
+
+ /* Builtin functions */
+ double sqrt(doublereal);
+
+ /* Local variables */
+ integer i__, j, k;
+ doublereal t, r1, d11, d12, d21, d22;
+ integer kk, kp;
+ doublereal wk, wkm1, wkp1;
+ integer imax, jmax;
+ extern /* Subroutine */ int dsyr_(char *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *);
+ doublereal alpha;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
+ doublereal *, integer *);
+ integer kstep;
+ logical upper;
+ doublereal absakk;
+ extern integer idamax_(integer *, doublereal *, integer *);
+ extern logical disnan_(doublereal *);
+ extern /* Subroutine */ int xerbla_(char *, integer *);
+ doublereal colmax, rowmax;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DSYTF2 computes the factorization of a real symmetric matrix A using */
+/* the Bunch-Kaufman diagonal pivoting method: */
+
+/* A = U*D*U' or A = L*D*L' */
+
+/* where U (or L) is a product of permutation and unit upper (lower) */
+/* triangular matrices, U' is the transpose of U, and D is symmetric and */
+/* block diagonal with 1-by-1 and 2-by-2 diagonal blocks. */
+
+/* This is the unblocked version of the algorithm, calling Level 2 BLAS. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the upper or lower triangular part of the */
+/* symmetric matrix A is stored: */
+/* = 'U': Upper triangular */
+/* = 'L': Lower triangular */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the symmetric matrix A. If UPLO = 'U', the leading */
+/* n-by-n upper triangular part of A contains the upper */
+/* triangular part of the matrix A, and the strictly lower */
+/* triangular part of A is not referenced. If UPLO = 'L', the */
+/* leading n-by-n lower triangular part of A contains the lower */
+/* triangular part of the matrix A, and the strictly upper */
+/* triangular part of A is not referenced. */
+
+/* On exit, the block diagonal matrix D and the multipliers used */
+/* to obtain the factor U or L (see below for further details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (output) INTEGER array, dimension (N) */
+/* Details of the interchanges and the block structure of D. */
+/* If IPIV(k) > 0, then rows and columns k and IPIV(k) were */
+/* interchanged and D(k,k) is a 1-by-1 diagonal block. */
+/* If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and */
+/* columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k) */
+/* is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) = */
+/* IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were */
+/* interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -k, the k-th argument had an illegal value */
+/* > 0: if INFO = k, D(k,k) is exactly zero. The factorization */
+/* has been completed, but the block diagonal matrix D is */
+/* exactly singular, and division by zero will occur if it */
+/* is used to solve a system of equations. */
+
+/* Further Details */
+/* =============== */
+
+/* 09-29-06 - patch from */
+/* Bobby Cheng, MathWorks */
+
+/* Replace l.204 and l.372 */
+/* IF( MAX( ABSAKK, COLMAX ).EQ.ZERO ) THEN */
+/* by */
+/* IF( (MAX( ABSAKK, COLMAX ).EQ.ZERO) .OR. DISNAN(ABSAKK) ) THEN */
+
+/* 01-01-96 - Based on modifications by */
+/* J. Lewis, Boeing Computer Services Company */
+/* A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA */
+/* 1-96 - Based on modifications by J. Lewis, Boeing Computer Services */
+/* Company */
+
+/* If UPLO = 'U', then A = U*D*U', where */
+/* U = P(n)*U(n)* ... *P(k)U(k)* ..., */
+/* i.e., U is a product of terms P(k)*U(k), where k decreases from n to */
+/* 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 */
+/* and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as */
+/* defined by IPIV(k), and U(k) is a unit upper triangular matrix, such */
+/* that if the diagonal block D(k) is of order s (s = 1 or 2), then */
+
+/* ( I v 0 ) k-s */
+/* U(k) = ( 0 I 0 ) s */
+/* ( 0 0 I ) n-k */
+/* k-s s n-k */
+
+/* If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k). */
+/* If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k), */
+/* and A(k,k), and v overwrites A(1:k-2,k-1:k). */
+
+/* If UPLO = 'L', then A = L*D*L', where */
+/* L = P(1)*L(1)* ... *P(k)*L(k)* ..., */
+/* i.e., L is a product of terms P(k)*L(k), where k increases from 1 to */
+/* n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 */
+/* and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as */
+/* defined by IPIV(k), and L(k) is a unit lower triangular matrix, such */
+/* that if the diagonal block D(k) is of order s (s = 1 or 2), then */
+
+/* ( I 0 0 ) k-1 */
+/* L(k) = ( 0 I 0 ) s */
+/* ( 0 v I ) n-k-s+1 */
+/* k-1 s n-k-s+1 */
+
+/* If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k). */
+/* If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k), */
+/* and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if (! upper && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYTF2", &i__1);
+ return 0;
+ }
+
+/* Initialize ALPHA for use in choosing pivot block size. */
+
+ alpha = (sqrt(17.) + 1.) / 8.;
+
+ if (upper) {
+
+/* Factorize A as U*D*U' using the upper triangle of A */
+
+/* K is the main loop index, decreasing from N to 1 in steps of */
+/* 1 or 2 */
+
+ k = *n;
+L10:
+
+/* If K < 1, exit from loop */
+
+ if (k < 1) {
+ goto L70;
+ }
+ kstep = 1;
+
+/* Determine rows and columns to be interchanged and whether */
+/* a 1-by-1 or 2-by-2 pivot block will be used */
+
+ absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
+
+/* IMAX is the row-index of the largest off-diagonal element in */
+/* column K, and COLMAX is its absolute value */
+
+ 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)) {
+
+/* Column K is zero or contains a NaN: set INFO and continue */
+
+ if (*info == 0) {
+ *info = k;
+ }
+ kp = k;
+ } else {
+ if (absakk >= alpha * colmax) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else {
+
+/* JMAX is the column-index of the largest off-diagonal */
+/* element in row IMAX, and ROWMAX is its absolute value */
+
+ 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);
+/* Computing MAX */
+ 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)) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >=
+ alpha * rowmax) {
+
+/* interchange rows and columns K and IMAX, use 1-by-1 */
+/* pivot block */
+
+ kp = imax;
+ } else {
+
+/* interchange rows and columns K-1 and IMAX, use 2-by-2 */
+/* pivot block */
+
+ kp = imax;
+ kstep = 2;
+ }
+ }
+
+ kk = k - kstep + 1;
+ if (kp != kk) {
+
+/* Interchange rows and columns KK and KP in the leading */
+/* submatrix A(1:k,1:k) */
+
+ 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;
+ }
+ }
+
+/* Update the leading submatrix */
+
+ if (kstep == 1) {
+
+/* 1-by-1 pivot block D(k): column k now holds */
+
+/* W(k) = U(k)*D(k) */
+
+/* where U(k) is the k-th column of U */
+
+/* Perform a rank-1 update of A(1:k-1,1:k-1) as */
+
+/* A := A - U(k)*D(k)*U(k)' = A - W(k)*1/D(k)*W(k)' */
+
+ 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);
+
+/* Store U(k) in column k */
+
+ i__1 = k - 1;
+ dscal_(&i__1, &r1, &a[k * a_dim1 + 1], &c__1);
+ } else {
+
+/* 2-by-2 pivot block D(k): columns k and k-1 now hold */
+
+/* ( W(k-1) W(k) ) = ( U(k-1) U(k) )*D(k) */
+
+/* where U(k) and U(k-1) are the k-th and (k-1)-th columns */
+/* of U */
+
+/* Perform a rank-2 update of A(1:k-2,1:k-2) as */
+
+/* A := A - ( U(k-1) U(k) )*D(k)*( U(k-1) U(k) )' */
+/* = A - ( W(k-1) W(k) )*inv(D(k))*( W(k-1) W(k) )' */
+
+ 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;
+/* L20: */
+ }
+ a[j + k * a_dim1] = wk;
+ a[j + (k - 1) * a_dim1] = wkm1;
+/* L30: */
+ }
+
+ }
+
+ }
+ }
+
+/* Store details of the interchanges in IPIV */
+
+ if (kstep == 1) {
+ ipiv[k] = kp;
+ } else {
+ ipiv[k] = -kp;
+ ipiv[k - 1] = -kp;
+ }
+
+/* Decrease K and return to the start of the main loop */
+
+ k -= kstep;
+ goto L10;
+
+ } else {
+
+/* Factorize A as L*D*L' using the lower triangle of A */
+
+/* K is the main loop index, increasing from 1 to N in steps of */
+/* 1 or 2 */
+
+ k = 1;
+L40:
+
+/* If K > N, exit from loop */
+
+ if (k > *n) {
+ goto L70;
+ }
+ kstep = 1;
+
+/* Determine rows and columns to be interchanged and whether */
+/* a 1-by-1 or 2-by-2 pivot block will be used */
+
+ absakk = (d__1 = a[k + k * a_dim1], abs(d__1));
+
+/* IMAX is the row-index of the largest off-diagonal element in */
+/* column K, and COLMAX is its absolute value */
+
+ 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)) {
+
+/* Column K is zero or contains a NaN: set INFO and continue */
+
+ if (*info == 0) {
+ *info = k;
+ }
+ kp = k;
+ } else {
+ if (absakk >= alpha * colmax) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else {
+
+/* JMAX is the column-index of the largest off-diagonal */
+/* element in row IMAX, and ROWMAX is its absolute value */
+
+ 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);
+/* Computing MAX */
+ 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)) {
+
+/* no interchange, use 1-by-1 pivot block */
+
+ kp = k;
+ } else if ((d__1 = a[imax + imax * a_dim1], abs(d__1)) >=
+ alpha * rowmax) {
+
+/* interchange rows and columns K and IMAX, use 1-by-1 */
+/* pivot block */
+
+ kp = imax;
+ } else {
+
+/* interchange rows and columns K+1 and IMAX, use 2-by-2 */
+/* pivot block */
+
+ kp = imax;
+ kstep = 2;
+ }
+ }
+
+ kk = k + kstep - 1;
+ if (kp != kk) {
+
+/* Interchange rows and columns KK and KP in the trailing */
+/* submatrix A(k:n,k:n) */
+
+ 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;
+ }
+ }
+
+/* Update the trailing submatrix */
+
+ if (kstep == 1) {
+
+/* 1-by-1 pivot block D(k): column k now holds */
+
+/* W(k) = L(k)*D(k) */
+
+/* where L(k) is the k-th column of L */
+
+ if (k < *n) {
+
+/* Perform a rank-1 update of A(k+1:n,k+1:n) as */
+
+/* A := A - L(k)*D(k)*L(k)' = A - W(k)*(1/D(k))*W(k)' */
+
+ 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);
+
+/* Store L(k) in column K */
+
+ i__1 = *n - k;
+ dscal_(&i__1, &d11, &a[k + 1 + k * a_dim1], &c__1);
+ }
+ } else {
+
+/* 2-by-2 pivot block D(k) */
+
+ if (k < *n - 1) {
+
+/* Perform a rank-2 update of A(k+2:n,k+2:n) as */
+
+/* A := A - ( (A(k) A(k+1))*D(k)**(-1) ) * (A(k) A(k+1))' */
+
+/* where L(k) and L(k+1) are the k-th and (k+1)-th */
+/* columns of L */
+
+ 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;
+/* L50: */
+ }
+
+ a[j + k * a_dim1] = wk;
+ a[j + (k + 1) * a_dim1] = wkp1;
+
+/* L60: */
+ }
+ }
+ }
+ }
+
+/* Store details of the interchanges in IPIV */
+
+ if (kstep == 1) {
+ ipiv[k] = kp;
+ } else {
+ ipiv[k] = -kp;
+ ipiv[k + 1] = -kp;
+ }
+
+/* Increase K and return to the start of the main loop */
+
+ k += kstep;
+ goto L40;
+
+ }
+
+L70:
+
+ return 0;
+
+/* End of DSYTF2 */
+
+} /* dsytf2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dsytrf.c b/src/lib/yac/clapack/SRC/dsytrf.c
new file mode 100644
index 000000000..34848c633
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dsytrf.c
@@ -0,0 +1,346 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dsytrf.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+
+/* Subroutine */ int dsytrf_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *lwork, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer j, k, kb, nb, iws;
+ extern logical lsame_(char *, char *);
+ integer nbmin, iinfo;
+ logical upper;
+ extern /* Subroutine */ int dsytf2_(char *, integer *, doublereal *,
+ integer *, integer *, integer *), xerbla_(char *, integer
+ *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ extern /* Subroutine */ int dlasyf_(char *, integer *, integer *, integer
+ *, doublereal *, integer *, integer *, doublereal *, integer *,
+ integer *);
+ integer ldwork, lwkopt;
+ logical lquery;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DSYTRF computes the factorization of a real symmetric matrix A using */
+/* the Bunch-Kaufman diagonal pivoting method. The form of the */
+/* factorization is */
+
+/* A = U*D*U**T or A = L*D*L**T */
+
+/* where U (or L) is a product of permutation and unit upper (lower) */
+/* triangular matrices, and D is symmetric and block diagonal with */
+/* 1-by-1 and 2-by-2 diagonal blocks. */
+
+/* This is the blocked version of the algorithm, calling Level 3 BLAS. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* = 'U': Upper triangle of A is stored; */
+/* = 'L': Lower triangle of A is stored. */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the symmetric matrix A. If UPLO = 'U', the leading */
+/* N-by-N upper triangular part of A contains the upper */
+/* triangular part of the matrix A, and the strictly lower */
+/* triangular part of A is not referenced. If UPLO = 'L', the */
+/* leading N-by-N lower triangular part of A contains the lower */
+/* triangular part of the matrix A, and the strictly upper */
+/* triangular part of A is not referenced. */
+
+/* On exit, the block diagonal matrix D and the multipliers used */
+/* to obtain the factor U or L (see below for further details). */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (output) INTEGER array, dimension (N) */
+/* Details of the interchanges and the block structure of D. */
+/* If IPIV(k) > 0, then rows and columns k and IPIV(k) were */
+/* interchanged and D(k,k) is a 1-by-1 diagonal block. */
+/* If UPLO = 'U' and IPIV(k) = IPIV(k-1) < 0, then rows and */
+/* columns k-1 and -IPIV(k) were interchanged and D(k-1:k,k-1:k) */
+/* is a 2-by-2 diagonal block. If UPLO = 'L' and IPIV(k) = */
+/* IPIV(k+1) < 0, then rows and columns k+1 and -IPIV(k) were */
+/* interchanged and D(k:k+1,k:k+1) is a 2-by-2 diagonal block. */
+
+/* WORK (workspace/output) DOUBLE PRECISION array, dimension (MAX(1,LWORK)) */
+/* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */
+
+/* LWORK (input) INTEGER */
+/* The length of WORK. LWORK >=1. For best performance */
+/* LWORK >= N*NB, where NB is the block size returned by ILAENV. */
+
+/* If LWORK = -1, then a workspace query is assumed; the routine */
+/* only calculates the optimal size of the WORK array, returns */
+/* this value as the first entry of the WORK array, and no error */
+/* message related to LWORK is issued by XERBLA. */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, D(i,i) is exactly zero. The factorization */
+/* has been completed, but the block diagonal matrix D is */
+/* exactly singular, and division by zero will occur if it */
+/* is used to solve a system of equations. */
+
+/* Further Details */
+/* =============== */
+
+/* If UPLO = 'U', then A = U*D*U', where */
+/* U = P(n)*U(n)* ... *P(k)U(k)* ..., */
+/* i.e., U is a product of terms P(k)*U(k), where k decreases from n to */
+/* 1 in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 */
+/* and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as */
+/* defined by IPIV(k), and U(k) is a unit upper triangular matrix, such */
+/* that if the diagonal block D(k) is of order s (s = 1 or 2), then */
+
+/* ( I v 0 ) k-s */
+/* U(k) = ( 0 I 0 ) s */
+/* ( 0 0 I ) n-k */
+/* k-s s n-k */
+
+/* If s = 1, D(k) overwrites A(k,k), and v overwrites A(1:k-1,k). */
+/* If s = 2, the upper triangle of D(k) overwrites A(k-1,k-1), A(k-1,k), */
+/* and A(k,k), and v overwrites A(1:k-2,k-1:k). */
+
+/* If UPLO = 'L', then A = L*D*L', where */
+/* L = P(1)*L(1)* ... *P(k)*L(k)* ..., */
+/* i.e., L is a product of terms P(k)*L(k), where k increases from 1 to */
+/* n in steps of 1 or 2, and D is a block diagonal matrix with 1-by-1 */
+/* and 2-by-2 diagonal blocks D(k). P(k) is a permutation matrix as */
+/* defined by IPIV(k), and L(k) is a unit lower triangular matrix, such */
+/* that if the diagonal block D(k) is of order s (s = 1 or 2), then */
+
+/* ( I 0 0 ) k-1 */
+/* L(k) = ( 0 I 0 ) s */
+/* ( 0 v I ) n-k-s+1 */
+/* k-1 s n-k-s+1 */
+
+/* If s = 1, D(k) overwrites A(k,k), and v overwrites A(k+1:n,k). */
+/* If s = 2, the lower triangle of D(k) overwrites A(k,k), A(k+1,k), */
+/* and A(k+1,k+1), and v overwrites A(k+2:n,k:k+1). */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ lquery = *lwork == -1;
+ if (! upper && ! lsame_(uplo, "L")) {
+ *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) {
+
+/* Determine the block size */
+
+ nb = ilaenv_(&c__1, "DSYTRF", uplo, n, &c_n1, &c_n1, &c_n1);
+ lwkopt = *n * nb;
+ work[1] = (doublereal) lwkopt;
+ }
+
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYTRF", &i__1);
+ return 0;
+ } else if (lquery) {
+ return 0;
+ }
+
+ nbmin = 2;
+ ldwork = *n;
+ if (nb > 1 && nb < *n) {
+ iws = ldwork * nb;
+ if (*lwork < iws) {
+/* Computing MAX */
+ i__1 = *lwork / ldwork;
+ nb = max(i__1,1);
+/* Computing MAX */
+ i__1 = 2, i__2 = ilaenv_(&c__2, "DSYTRF", uplo, n, &c_n1, &c_n1, &
+ c_n1);
+ nbmin = max(i__1,i__2);
+ }
+ } else {
+ iws = 1;
+ }
+ if (nb < nbmin) {
+ nb = *n;
+ }
+
+ if (upper) {
+
+/* Factorize A as U*D*U' using the upper triangle of A */
+
+/* K is the main loop index, decreasing from N to 1 in steps of */
+/* KB, where KB is the number of columns factorized by DLASYF; */
+/* KB is either NB or NB-1, or K for the last block */
+
+ k = *n;
+L10:
+
+/* If K < 1, exit from loop */
+
+ if (k < 1) {
+ goto L40;
+ }
+
+ if (k > nb) {
+
+/* Factorize columns k-kb+1:k of A and use blocked code to */
+/* update columns 1:k-kb */
+
+ dlasyf_(uplo, &k, &nb, &kb, &a[a_offset], lda, &ipiv[1], &work[1],
+ &ldwork, &iinfo);
+ } else {
+
+/* Use unblocked code to factorize columns 1:k of A */
+
+ dsytf2_(uplo, &k, &a[a_offset], lda, &ipiv[1], &iinfo);
+ kb = k;
+ }
+
+/* Set INFO on the first occurrence of a zero pivot */
+
+ if (*info == 0 && iinfo > 0) {
+ *info = iinfo;
+ }
+
+/* Decrease K and return to the start of the main loop */
+
+ k -= kb;
+ goto L10;
+
+ } else {
+
+/* Factorize A as L*D*L' using the lower triangle of A */
+
+/* K is the main loop index, increasing from 1 to N in steps of */
+/* KB, where KB is the number of columns factorized by DLASYF; */
+/* KB is either NB or NB-1, or N-K+1 for the last block */
+
+ k = 1;
+L20:
+
+/* If K > N, exit from loop */
+
+ if (k > *n) {
+ goto L40;
+ }
+
+ if (k <= *n - nb) {
+
+/* Factorize columns k:k+kb-1 of A and use blocked code to */
+/* update columns k+kb:n */
+
+ i__1 = *n - k + 1;
+ dlasyf_(uplo, &i__1, &nb, &kb, &a[k + k * a_dim1], lda, &ipiv[k],
+ &work[1], &ldwork, &iinfo);
+ } else {
+
+/* Use unblocked code to factorize columns k:n of A */
+
+ i__1 = *n - k + 1;
+ dsytf2_(uplo, &i__1, &a[k + k * a_dim1], lda, &ipiv[k], &iinfo);
+ kb = *n - k + 1;
+ }
+
+/* Set INFO on the first occurrence of a zero pivot */
+
+ if (*info == 0 && iinfo > 0) {
+ *info = iinfo + k - 1;
+ }
+
+/* Adjust IPIV */
+
+ 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;
+ }
+/* L30: */
+ }
+
+/* Increase K and return to the start of the main loop */
+
+ k += kb;
+ goto L20;
+
+ }
+
+L40:
+ work[1] = (doublereal) lwkopt;
+ return 0;
+
+/* End of DSYTRF */
+
+} /* dsytrf_ */
+
diff --git a/src/lib/yac/clapack/SRC/dsytri.c b/src/lib/yac/clapack/SRC/dsytri.c
new file mode 100644
index 000000000..16314546f
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dsytri.c
@@ -0,0 +1,401 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dsytri.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static doublereal c_b11 = -1.;
+static doublereal c_b13 = 0.;
+
+/* Subroutine */ int dsytri_(char *uplo, integer *n, doublereal *a, integer *
+ lda, integer *ipiv, doublereal *work, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1;
+ doublereal d__1;
+
+ /* Local variables */
+ doublereal d__;
+ integer k;
+ doublereal t, ak;
+ integer kp;
+ doublereal akp1;
+ extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
+ integer *);
+ doublereal temp, akkp1;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
+ doublereal *, integer *), dswap_(integer *, doublereal *, integer
+ *, doublereal *, integer *);
+ integer kstep;
+ logical upper;
+ extern /* Subroutine */ int dsymv_(char *, integer *, doublereal *,
+ doublereal *, integer *, doublereal *, integer *, doublereal *,
+ doublereal *, integer *), xerbla_(char *, integer *);
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DSYTRI computes the inverse of a real symmetric indefinite matrix */
+/* A using the factorization A = U*D*U**T or A = L*D*L**T computed by */
+/* DSYTRF. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the details of the factorization are stored */
+/* as an upper or lower triangular matrix. */
+/* = 'U': Upper triangular, form is A = U*D*U**T; */
+/* = 'L': Lower triangular, form is A = L*D*L**T. */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the block diagonal matrix D and the multipliers */
+/* used to obtain the factor U or L as computed by DSYTRF. */
+
+/* On exit, if INFO = 0, the (symmetric) inverse of the original */
+/* matrix. If UPLO = 'U', the upper triangular part of the */
+/* inverse is formed and the part of A below the diagonal is not */
+/* referenced; if UPLO = 'L' the lower triangular part of the */
+/* inverse is formed and the part of A above the diagonal is */
+/* not referenced. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* IPIV (input) INTEGER array, dimension (N) */
+/* Details of the interchanges and the block structure of D */
+/* as determined by DSYTRF. */
+
+/* WORK (workspace) DOUBLE PRECISION array, dimension (N) */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, D(i,i) = 0; the matrix is singular and its */
+/* inverse could not be computed. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ --ipiv;
+ --work;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ if (! upper && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (*n < 0) {
+ *info = -2;
+ } else if (*lda < max(1,*n)) {
+ *info = -4;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DSYTRI", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Check that the diagonal matrix D is nonsingular. */
+
+ if (upper) {
+
+/* Upper triangular storage: examine D from bottom to top */
+
+ for (*info = *n; *info >= 1; --(*info)) {
+ if (ipiv[*info] > 0 && a[*info + *info * a_dim1] == 0.) {
+ return 0;
+ }
+/* L10: */
+ }
+ } else {
+
+/* Lower triangular storage: examine D from top to bottom. */
+
+ i__1 = *n;
+ for (*info = 1; *info <= i__1; ++(*info)) {
+ if (ipiv[*info] > 0 && a[*info + *info * a_dim1] == 0.) {
+ return 0;
+ }
+/* L20: */
+ }
+ }
+ *info = 0;
+
+ if (upper) {
+
+/* Compute inv(A) from the factorization A = U*D*U'. */
+
+/* K is the main loop index, increasing from 1 to N in steps of */
+/* 1 or 2, depending on the size of the diagonal blocks. */
+
+ k = 1;
+L30:
+
+/* If K > N, exit from loop. */
+
+ if (k > *n) {
+ goto L40;
+ }
+
+ if (ipiv[k] > 0) {
+
+/* 1 x 1 diagonal block */
+
+/* Invert the diagonal block. */
+
+ a[k + k * a_dim1] = 1. / a[k + k * a_dim1];
+
+/* Compute column K of the inverse. */
+
+ if (k > 1) {
+ i__1 = k - 1;
+ dcopy_(&i__1, &a[k * a_dim1 + 1], &c__1, &work[1], &c__1);
+ i__1 = k - 1;
+ dsymv_(uplo, &i__1, &c_b11, &a[a_offset], lda, &work[1], &
+ c__1, &c_b13, &a[k * a_dim1 + 1], &c__1);
+ i__1 = k - 1;
+ a[k + k * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &a[k *
+ a_dim1 + 1], &c__1);
+ }
+ kstep = 1;
+ } else {
+
+/* 2 x 2 diagonal block */
+
+/* Invert the diagonal block. */
+
+ t = (d__1 = a[k + (k + 1) * a_dim1], abs(d__1));
+ ak = a[k + k * a_dim1] / t;
+ akp1 = a[k + 1 + (k + 1) * a_dim1] / t;
+ akkp1 = a[k + (k + 1) * a_dim1] / t;
+ d__ = t * (ak * akp1 - 1.);
+ a[k + k * a_dim1] = akp1 / d__;
+ a[k + 1 + (k + 1) * a_dim1] = ak / d__;
+ a[k + (k + 1) * a_dim1] = -akkp1 / d__;
+
+/* Compute columns K and K+1 of the inverse. */
+
+ if (k > 1) {
+ i__1 = k - 1;
+ dcopy_(&i__1, &a[k * a_dim1 + 1], &c__1, &work[1], &c__1);
+ i__1 = k - 1;
+ dsymv_(uplo, &i__1, &c_b11, &a[a_offset], lda, &work[1], &
+ c__1, &c_b13, &a[k * a_dim1 + 1], &c__1);
+ i__1 = k - 1;
+ a[k + k * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &a[k *
+ a_dim1 + 1], &c__1);
+ i__1 = k - 1;
+ a[k + (k + 1) * a_dim1] -= ddot_(&i__1, &a[k * a_dim1 + 1], &
+ c__1, &a[(k + 1) * a_dim1 + 1], &c__1);
+ i__1 = k - 1;
+ dcopy_(&i__1, &a[(k + 1) * a_dim1 + 1], &c__1, &work[1], &
+ c__1);
+ i__1 = k - 1;
+ dsymv_(uplo, &i__1, &c_b11, &a[a_offset], lda, &work[1], &
+ c__1, &c_b13, &a[(k + 1) * a_dim1 + 1], &c__1);
+ i__1 = k - 1;
+ a[k + 1 + (k + 1) * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &
+ a[(k + 1) * a_dim1 + 1], &c__1);
+ }
+ kstep = 2;
+ }
+
+ kp = (i__1 = ipiv[k], abs(i__1));
+ if (kp != k) {
+
+/* Interchange rows and columns K and KP in the leading */
+/* submatrix A(1:k+1,1:k+1) */
+
+ i__1 = kp - 1;
+ dswap_(&i__1, &a[k * a_dim1 + 1], &c__1, &a[kp * a_dim1 + 1], &
+ c__1);
+ i__1 = k - kp - 1;
+ dswap_(&i__1, &a[kp + 1 + k * a_dim1], &c__1, &a[kp + (kp + 1) *
+ a_dim1], lda);
+ temp = a[k + k * a_dim1];
+ a[k + k * a_dim1] = a[kp + kp * a_dim1];
+ a[kp + kp * a_dim1] = temp;
+ if (kstep == 2) {
+ temp = a[k + (k + 1) * a_dim1];
+ a[k + (k + 1) * a_dim1] = a[kp + (k + 1) * a_dim1];
+ a[kp + (k + 1) * a_dim1] = temp;
+ }
+ }
+
+ k += kstep;
+ goto L30;
+L40:
+
+ ;
+ } else {
+
+/* Compute inv(A) from the factorization A = L*D*L'. */
+
+/* K is the main loop index, increasing from 1 to N in steps of */
+/* 1 or 2, depending on the size of the diagonal blocks. */
+
+ k = *n;
+L50:
+
+/* If K < 1, exit from loop. */
+
+ if (k < 1) {
+ goto L60;
+ }
+
+ if (ipiv[k] > 0) {
+
+/* 1 x 1 diagonal block */
+
+/* Invert the diagonal block. */
+
+ a[k + k * a_dim1] = 1. / a[k + k * a_dim1];
+
+/* Compute column K of the inverse. */
+
+ if (k < *n) {
+ i__1 = *n - k;
+ dcopy_(&i__1, &a[k + 1 + k * a_dim1], &c__1, &work[1], &c__1);
+ i__1 = *n - k;
+ dsymv_(uplo, &i__1, &c_b11, &a[k + 1 + (k + 1) * a_dim1], lda,
+ &work[1], &c__1, &c_b13, &a[k + 1 + k * a_dim1], &
+ c__1);
+ i__1 = *n - k;
+ a[k + k * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &a[k + 1 +
+ k * a_dim1], &c__1);
+ }
+ kstep = 1;
+ } else {
+
+/* 2 x 2 diagonal block */
+
+/* Invert the diagonal block. */
+
+ t = (d__1 = a[k + (k - 1) * a_dim1], abs(d__1));
+ ak = a[k - 1 + (k - 1) * a_dim1] / t;
+ akp1 = a[k + k * a_dim1] / t;
+ akkp1 = a[k + (k - 1) * a_dim1] / t;
+ d__ = t * (ak * akp1 - 1.);
+ a[k - 1 + (k - 1) * a_dim1] = akp1 / d__;
+ a[k + k * a_dim1] = ak / d__;
+ a[k + (k - 1) * a_dim1] = -akkp1 / d__;
+
+/* Compute columns K-1 and K of the inverse. */
+
+ if (k < *n) {
+ i__1 = *n - k;
+ dcopy_(&i__1, &a[k + 1 + k * a_dim1], &c__1, &work[1], &c__1);
+ i__1 = *n - k;
+ dsymv_(uplo, &i__1, &c_b11, &a[k + 1 + (k + 1) * a_dim1], lda,
+ &work[1], &c__1, &c_b13, &a[k + 1 + k * a_dim1], &
+ c__1);
+ i__1 = *n - k;
+ a[k + k * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &a[k + 1 +
+ k * a_dim1], &c__1);
+ i__1 = *n - k;
+ a[k + (k - 1) * a_dim1] -= ddot_(&i__1, &a[k + 1 + k * a_dim1]
+, &c__1, &a[k + 1 + (k - 1) * a_dim1], &c__1);
+ i__1 = *n - k;
+ dcopy_(&i__1, &a[k + 1 + (k - 1) * a_dim1], &c__1, &work[1], &
+ c__1);
+ i__1 = *n - k;
+ dsymv_(uplo, &i__1, &c_b11, &a[k + 1 + (k + 1) * a_dim1], lda,
+ &work[1], &c__1, &c_b13, &a[k + 1 + (k - 1) * a_dim1]
+, &c__1);
+ i__1 = *n - k;
+ a[k - 1 + (k - 1) * a_dim1] -= ddot_(&i__1, &work[1], &c__1, &
+ a[k + 1 + (k - 1) * a_dim1], &c__1);
+ }
+ kstep = 2;
+ }
+
+ kp = (i__1 = ipiv[k], abs(i__1));
+ if (kp != k) {
+
+/* Interchange rows and columns K and KP in the trailing */
+/* submatrix A(k-1:n,k-1:n) */
+
+ if (kp < *n) {
+ i__1 = *n - kp;
+ dswap_(&i__1, &a[kp + 1 + k * a_dim1], &c__1, &a[kp + 1 + kp *
+ a_dim1], &c__1);
+ }
+ i__1 = kp - k - 1;
+ dswap_(&i__1, &a[k + 1 + k * a_dim1], &c__1, &a[kp + (k + 1) *
+ a_dim1], lda);
+ temp = a[k + k * a_dim1];
+ a[k + k * a_dim1] = a[kp + kp * a_dim1];
+ a[kp + kp * a_dim1] = temp;
+ if (kstep == 2) {
+ temp = a[k + (k - 1) * a_dim1];
+ a[k + (k - 1) * a_dim1] = a[kp + (k - 1) * a_dim1];
+ a[kp + (k - 1) * a_dim1] = temp;
+ }
+ }
+
+ k -= kstep;
+ goto L50;
+L60:
+ ;
+ }
+
+ return 0;
+
+/* End of DSYTRI */
+
+} /* dsytri_ */
+
diff --git a/src/lib/yac/clapack/SRC/dtrti2.c b/src/lib/yac/clapack/SRC/dtrti2.c
new file mode 100644
index 000000000..1a9295bac
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dtrti2.c
@@ -0,0 +1,188 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrti2.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int dtrti2_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, i__1, i__2;
+
+ /* Local variables */
+ integer j;
+ doublereal ajj;
+ extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
+ integer *);
+ extern logical lsame_(char *, char *);
+ logical upper;
+ extern /* Subroutine */ int dtrmv_(char *, char *, char *, integer *,
+ doublereal *, integer *, doublereal *, integer *), xerbla_(char *, integer *);
+ logical nounit;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRTI2 computes the inverse of a real upper or lower triangular */
+/* matrix. */
+
+/* This is the Level 2 BLAS version of the algorithm. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* Specifies whether the matrix A is upper or lower triangular. */
+/* = 'U': Upper triangular */
+/* = 'L': Lower triangular */
+
+/* DIAG (input) CHARACTER*1 */
+/* Specifies whether or not the matrix A is unit triangular. */
+/* = 'N': Non-unit triangular */
+/* = 'U': Unit triangular */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the triangular matrix A. If UPLO = 'U', the */
+/* leading n by n upper triangular part of the array A contains */
+/* the upper triangular matrix, and the strictly lower */
+/* triangular part of A is not referenced. If UPLO = 'L', the */
+/* leading n by n lower triangular part of the array A contains */
+/* the lower triangular matrix, and the strictly upper */
+/* triangular part of A is not referenced. If DIAG = 'U', the */
+/* diagonal elements of A are also not referenced and are */
+/* assumed to be 1. */
+
+/* On exit, the (triangular) inverse of the original matrix, in */
+/* the same storage format. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -k, the k-th argument had an illegal value */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ nounit = lsame_(diag, "N");
+ if (! upper && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (! nounit && ! lsame_(diag, "U")) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTRTI2", &i__1);
+ return 0;
+ }
+
+ if (upper) {
+
+/* Compute inverse of upper triangular matrix. */
+
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ if (nounit) {
+ a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
+ ajj = -a[j + j * a_dim1];
+ } else {
+ ajj = -1.;
+ }
+
+/* Compute elements 1:j-1 of j-th column. */
+
+ i__2 = j - 1;
+ dtrmv_("Upper", "No transpose", diag, &i__2, &a[a_offset], lda, &
+ a[j * a_dim1 + 1], &c__1);
+ i__2 = j - 1;
+ dscal_(&i__2, &ajj, &a[j * a_dim1 + 1], &c__1);
+/* L10: */
+ }
+ } else {
+
+/* Compute inverse of lower triangular matrix. */
+
+ for (j = *n; j >= 1; --j) {
+ if (nounit) {
+ a[j + j * a_dim1] = 1. / a[j + j * a_dim1];
+ ajj = -a[j + j * a_dim1];
+ } else {
+ ajj = -1.;
+ }
+ if (j < *n) {
+
+/* Compute elements j+1:n of j-th column. */
+
+ i__1 = *n - j;
+ dtrmv_("Lower", "No transpose", diag, &i__1, &a[j + 1 + (j +
+ 1) * a_dim1], lda, &a[j + 1 + j * a_dim1], &c__1);
+ i__1 = *n - j;
+ dscal_(&i__1, &ajj, &a[j + 1 + j * a_dim1], &c__1);
+ }
+/* L20: */
+ }
+ }
+
+ return 0;
+
+/* End of DTRTI2 */
+
+} /* dtrti2_ */
+
diff --git a/src/lib/yac/clapack/SRC/dtrtri.c b/src/lib/yac/clapack/SRC/dtrtri.c
new file mode 100644
index 000000000..c7f6e5fa0
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dtrtri.c
@@ -0,0 +1,247 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrtri.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static integer c_n1 = -1;
+static integer c__2 = 2;
+static doublereal c_b18 = 1.;
+static doublereal c_b22 = -1.;
+
+/* Subroutine */ int dtrtri_(char *uplo, char *diag, integer *n, doublereal *
+ a, integer *lda, integer *info)
+{
+ /* System generated locals */
+ address a__1[2];
+ integer a_dim1, a_offset, i__1, i__2[2], i__3, i__4, i__5;
+ char ch__1[2];
+
+ /* Builtin functions */
+ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
+
+ /* Local variables */
+ integer j, jb, nb, nn;
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dtrmm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), dtrsm_(
+ char *, char *, char *, char *, integer *, integer *, doublereal *
+, doublereal *, integer *, doublereal *, integer *);
+ logical upper;
+ extern /* Subroutine */ int dtrti2_(char *, char *, integer *, doublereal
+ *, integer *, integer *), xerbla_(char *, integer
+ *);
+ extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+ logical nounit;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRTRI computes the inverse of a real upper or lower triangular */
+/* matrix A. */
+
+/* This is the Level 3 BLAS version of the algorithm. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* = 'U': A is upper triangular; */
+/* = 'L': A is lower triangular. */
+
+/* DIAG (input) CHARACTER*1 */
+/* = 'N': A is non-unit triangular; */
+/* = 'U': A is unit triangular. */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* A (input/output) DOUBLE PRECISION array, dimension (LDA,N) */
+/* On entry, the triangular matrix A. If UPLO = 'U', the */
+/* leading N-by-N upper triangular part of the array A contains */
+/* the upper triangular matrix, and the strictly lower */
+/* triangular part of A is not referenced. If UPLO = 'L', the */
+/* leading N-by-N lower triangular part of the array A contains */
+/* the lower triangular matrix, and the strictly upper */
+/* triangular part of A is not referenced. If DIAG = 'U', the */
+/* diagonal elements of A are also not referenced and are */
+/* assumed to be 1. */
+/* On exit, the (triangular) inverse of the original matrix, in */
+/* the same storage format. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, A(i,i) is exactly zero. The triangular */
+/* matrix is singular and its inverse can not be computed. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ *info = 0;
+ upper = lsame_(uplo, "U");
+ nounit = lsame_(diag, "N");
+ if (! upper && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (! nounit && ! lsame_(diag, "U")) {
+ *info = -2;
+ } else if (*n < 0) {
+ *info = -3;
+ } else if (*lda < max(1,*n)) {
+ *info = -5;
+ }
+ if (*info != 0) {
+ i__1 = -(*info);
+ xerbla_("DTRTRI", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Check for singularity if non-unit. */
+
+ if (nounit) {
+ i__1 = *n;
+ for (*info = 1; *info <= i__1; ++(*info)) {
+ if (a[*info + *info * a_dim1] == 0.) {
+ return 0;
+ }
+/* L10: */
+ }
+ *info = 0;
+ }
+
+/* Determine the block size for this environment. */
+
+/* Writing concatenation */
+ i__2[0] = 1, a__1[0] = uplo;
+ i__2[1] = 1, a__1[1] = diag;
+ s_cat(ch__1, a__1, i__2, &c__2, (ftnlen)2);
+ nb = ilaenv_(&c__1, "DTRTRI", ch__1, n, &c_n1, &c_n1, &c_n1);
+ if (nb <= 1 || nb >= *n) {
+
+/* Use unblocked code */
+
+ dtrti2_(uplo, diag, n, &a[a_offset], lda, info);
+ } else {
+
+/* Use blocked code */
+
+ if (upper) {
+
+/* Compute inverse of upper triangular matrix */
+
+ i__1 = *n;
+ i__3 = nb;
+ for (j = 1; i__3 < 0 ? j >= i__1 : j <= i__1; j += i__3) {
+/* Computing MIN */
+ i__4 = nb, i__5 = *n - j + 1;
+ jb = min(i__4,i__5);
+
+/* Compute rows 1:j-1 of current block column */
+
+ i__4 = j - 1;
+ dtrmm_("Left", "Upper", "No transpose", diag, &i__4, &jb, &
+ c_b18, &a[a_offset], lda, &a[j * a_dim1 + 1], lda);
+ i__4 = j - 1;
+ dtrsm_("Right", "Upper", "No transpose", diag, &i__4, &jb, &
+ c_b22, &a[j + j * a_dim1], lda, &a[j * a_dim1 + 1],
+ lda);
+
+/* Compute inverse of current diagonal block */
+
+ dtrti2_("Upper", diag, &jb, &a[j + j * a_dim1], lda, info);
+/* L20: */
+ }
+ } else {
+
+/* Compute inverse of lower triangular matrix */
+
+ nn = (*n - 1) / nb * nb + 1;
+ i__3 = -nb;
+ for (j = nn; i__3 < 0 ? j >= 1 : j <= 1; j += i__3) {
+/* Computing MIN */
+ i__1 = nb, i__4 = *n - j + 1;
+ jb = min(i__1,i__4);
+ if (j + jb <= *n) {
+
+/* Compute rows j+jb:n of current block column */
+
+ i__1 = *n - j - jb + 1;
+ dtrmm_("Left", "Lower", "No transpose", diag, &i__1, &jb,
+ &c_b18, &a[j + jb + (j + jb) * a_dim1], lda, &a[j
+ + jb + j * a_dim1], lda);
+ i__1 = *n - j - jb + 1;
+ dtrsm_("Right", "Lower", "No transpose", diag, &i__1, &jb,
+ &c_b22, &a[j + j * a_dim1], lda, &a[j + jb + j *
+ a_dim1], lda);
+ }
+
+/* Compute inverse of current diagonal block */
+
+ dtrti2_("Lower", diag, &jb, &a[j + j * a_dim1], lda, info);
+/* L30: */
+ }
+ }
+ }
+
+ return 0;
+
+/* End of DTRTRI */
+
+} /* dtrtri_ */
+
diff --git a/src/lib/yac/clapack/SRC/dtrtrs.c b/src/lib/yac/clapack/SRC/dtrtrs.c
new file mode 100644
index 000000000..a4e41bf00
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/dtrtrs.c
@@ -0,0 +1,188 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* dtrtrs.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+/* Table of constant values */
+
+static doublereal c_b12 = 1.;
+
+/* Subroutine */ int dtrtrs_(char *uplo, char *trans, char *diag, integer *n,
+ integer *nrhs, doublereal *a, integer *lda, doublereal *b, integer *
+ ldb, integer *info)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, b_dim1, b_offset, i__1;
+
+ /* Local variables */
+ extern logical lsame_(char *, char *);
+ extern /* Subroutine */ int dtrsm_(char *, char *, char *, char *,
+ integer *, integer *, doublereal *, doublereal *, integer *,
+ doublereal *, integer *), xerbla_(
+ char *, integer *);
+ logical nounit;
+
+
+/* -- LAPACK routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* DTRTRS solves a triangular system of the form */
+
+/* A * X = B or A**T * X = B, */
+
+/* where A is a triangular matrix of order N, and B is an N-by-NRHS */
+/* matrix. A check is made to verify that A is nonsingular. */
+
+/* Arguments */
+/* ========= */
+
+/* UPLO (input) CHARACTER*1 */
+/* = 'U': A is upper triangular; */
+/* = 'L': A is lower triangular. */
+
+/* TRANS (input) CHARACTER*1 */
+/* Specifies the form of the system of equations: */
+/* = 'N': A * X = B (No transpose) */
+/* = 'T': A**T * X = B (Transpose) */
+/* = 'C': A**H * X = B (Conjugate transpose = Transpose) */
+
+/* DIAG (input) CHARACTER*1 */
+/* = 'N': A is non-unit triangular; */
+/* = 'U': A is unit triangular. */
+
+/* N (input) INTEGER */
+/* The order of the matrix A. N >= 0. */
+
+/* NRHS (input) INTEGER */
+/* The number of right hand sides, i.e., the number of columns */
+/* of the matrix B. NRHS >= 0. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The triangular matrix A. If UPLO = 'U', the leading N-by-N */
+/* upper triangular part of the array A contains the upper */
+/* triangular matrix, and the strictly lower triangular part of */
+/* A is not referenced. If UPLO = 'L', the leading N-by-N lower */
+/* triangular part of the array A contains the lower triangular */
+/* matrix, and the strictly upper triangular part of A is not */
+/* referenced. If DIAG = 'U', the diagonal elements of A are */
+/* also not referenced and are assumed to be 1. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,N). */
+
+/* B (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS) */
+/* On entry, the right hand side matrix B. */
+/* On exit, if INFO = 0, the solution matrix X. */
+
+/* LDB (input) INTEGER */
+/* The leading dimension of the array B. LDB >= max(1,N). */
+
+/* INFO (output) INTEGER */
+/* = 0: successful exit */
+/* < 0: if INFO = -i, the i-th argument had an illegal value */
+/* > 0: if INFO = i, the i-th diagonal element of A is zero, */
+/* indicating that the matrix is singular and the solutions */
+/* X have not been computed. */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. External Subroutines .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Test the input parameters. */
+
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+ b_dim1 = *ldb;
+ b_offset = 1 + b_dim1;
+ b -= b_offset;
+
+ /* Function Body */
+ *info = 0;
+ nounit = lsame_(diag, "N");
+ if (! lsame_(uplo, "U") && ! lsame_(uplo, "L")) {
+ *info = -1;
+ } else if (! lsame_(trans, "N") && ! lsame_(trans,
+ "T") && ! lsame_(trans, "C")) {
+ *info = -2;
+ } else if (! nounit && ! lsame_(diag, "U")) {
+ *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_("DTRTRS", &i__1);
+ return 0;
+ }
+
+/* Quick return if possible */
+
+ if (*n == 0) {
+ return 0;
+ }
+
+/* Check for singularity. */
+
+ if (nounit) {
+ i__1 = *n;
+ for (*info = 1; *info <= i__1; ++(*info)) {
+ if (a[*info + *info * a_dim1] == 0.) {
+ return 0;
+ }
+/* L10: */
+ }
+ }
+ *info = 0;
+
+/* Solve A * x = b or A' * x = b. */
+
+ dtrsm_("Left", uplo, trans, diag, n, nrhs, &c_b12, &a[a_offset], lda, &b[
+ b_offset], ldb);
+
+ return 0;
+
+/* End of DTRTRS */
+
+} /* dtrtrs_ */
+
diff --git a/src/lib/yac/clapack/SRC/ieeeck.c b/src/lib/yac/clapack/SRC/ieeeck.c
new file mode 100644
index 000000000..f5ae9a677
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/ieeeck.c
@@ -0,0 +1,171 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* ieeeck.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+integer ieeeck_(integer *ispec, real *zero, real *one)
+{
+ /* System generated locals */
+ integer ret_val;
+
+ /* Local variables */
+ real nan1, nan2, nan3, nan4, nan5, nan6, neginf, posinf, negzro, newzro;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* IEEECK is called from the ILAENV to verify that Infinity and */
+/* possibly NaN arithmetic is safe (i.e. will not trap). */
+
+/* Arguments */
+/* ========= */
+
+/* ISPEC (input) INTEGER */
+/* Specifies whether to test just for inifinity arithmetic */
+/* or whether to test for infinity and NaN arithmetic. */
+/* = 0: Verify infinity arithmetic only. */
+/* = 1: Verify infinity and NaN arithmetic. */
+
+/* ZERO (input) REAL */
+/* Must contain the value 0.0 */
+/* This is passed to prevent the compiler from optimizing */
+/* away this code. */
+
+/* ONE (input) REAL */
+/* Must contain the value 1.0 */
+/* This is passed to prevent the compiler from optimizing */
+/* away this code. */
+
+/* RETURN VALUE: INTEGER */
+/* = 0: Arithmetic failed to produce the correct answers */
+/* = 1: Arithmetic produced the correct answers */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Executable Statements .. */
+ ret_val = 1;
+
+ posinf = *one / *zero;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf = -(*one) / *zero;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ negzro = *one / (neginf + *one);
+ if (negzro != *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf = *one / negzro;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ newzro = negzro + *zero;
+ if (newzro != *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ posinf = *one / newzro;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ neginf *= posinf;
+ if (neginf >= *zero) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ posinf *= posinf;
+ if (posinf <= *one) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+
+
+
+/* Return if we were only asked to check infinity arithmetic */
+
+ if (*ispec == 0) {
+ return ret_val;
+ }
+
+ nan1 = posinf + neginf;
+
+ nan2 = posinf / neginf;
+
+ nan3 = posinf / posinf;
+
+ nan4 = posinf * *zero;
+
+ nan5 = neginf * negzro;
+
+ nan6 = nan5 * 0.f;
+
+ if (nan1 == nan1) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan2 == nan2) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan3 == nan3) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan4 == nan4) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan5 == nan5) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ if (nan6 == nan6) {
+ ret_val = 0;
+ return ret_val;
+ }
+
+ return ret_val;
+} /* ieeeck_ */
+
diff --git a/src/lib/yac/clapack/SRC/iladlc.c b/src/lib/yac/clapack/SRC/iladlc.c
new file mode 100644
index 000000000..595074514
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/iladlc.c
@@ -0,0 +1,93 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* iladlc.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+integer iladlc_(integer *m, integer *n, doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, ret_val, i__1;
+
+ /* Local variables */
+ integer i__;
+
+
+/* -- LAPACK auxiliary routine (version 3.2.1) -- */
+
+/* -- April 2009 -- */
+
+/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
+/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* ILADLC scans A for its last non-zero column. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The m by n matrix A. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Quick test for the common case where one corner is non-zero. */
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ if (*n == 0) {
+ ret_val = *n;
+ } else if (a[*n * a_dim1 + 1] != 0. || a[*m + *n * a_dim1] != 0.) {
+ ret_val = *n;
+ } else {
+/* Now scan each column from the end, returning with the first non-zero. */
+ for (ret_val = *n; ret_val >= 1; --ret_val) {
+ i__1 = *m;
+ for (i__ = 1; i__ <= i__1; ++i__) {
+ if (a[i__ + ret_val * a_dim1] != 0.) {
+ return ret_val;
+ }
+ }
+ }
+ }
+ return ret_val;
+} /* iladlc_ */
+
diff --git a/src/lib/yac/clapack/SRC/iladlr.c b/src/lib/yac/clapack/SRC/iladlr.c
new file mode 100644
index 000000000..4f3167389
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/iladlr.c
@@ -0,0 +1,95 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* iladlr.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+integer iladlr_(integer *m, integer *n, doublereal *a, integer *lda)
+{
+ /* System generated locals */
+ integer a_dim1, a_offset, ret_val, i__1;
+
+ /* Local variables */
+ integer i__, j;
+
+
+/* -- LAPACK auxiliary routine (version 3.2.1) -- */
+
+/* -- April 2009 -- */
+
+/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
+/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
+
+/* .. Scalar Arguments .. */
+/* .. */
+/* .. Array Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* ILADLR scans A for its last non-zero row. */
+
+/* Arguments */
+/* ========= */
+
+/* M (input) INTEGER */
+/* The number of rows of the matrix A. */
+
+/* N (input) INTEGER */
+/* The number of columns of the matrix A. */
+
+/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
+/* The m by n matrix A. */
+
+/* LDA (input) INTEGER */
+/* The leading dimension of the array A. LDA >= max(1,M). */
+
+/* ===================================================================== */
+
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Executable Statements .. */
+
+/* Quick test for the common case where one corner is non-zero. */
+ /* Parameter adjustments */
+ a_dim1 = *lda;
+ a_offset = 1 + a_dim1;
+ a -= a_offset;
+
+ /* Function Body */
+ if (*m == 0) {
+ ret_val = *m;
+ } else if (a[*m + a_dim1] != 0. || a[*m + *n * a_dim1] != 0.) {
+ ret_val = *m;
+ } else {
+/* Scan up each column tracking the last zero row seen. */
+ ret_val = 0;
+ i__1 = *n;
+ for (j = 1; j <= i__1; ++j) {
+ for (i__ = *m; i__ >= 1; --i__) {
+ if (a[i__ + j * a_dim1] != 0.) {
+ break;
+ }
+ }
+ ret_val = max(ret_val,i__);
+ }
+ }
+ return ret_val;
+} /* iladlr_ */
+
diff --git a/src/lib/yac/clapack/SRC/ilaenv.c b/src/lib/yac/clapack/SRC/ilaenv.c
new file mode 100644
index 000000000..84f980630
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/ilaenv.c
@@ -0,0 +1,659 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* ilaenv.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+#include "string.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+static real c_b163 = 0.f;
+static real c_b164 = 1.f;
+static integer c__0 = 0;
+
+integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
+ integer *n2, integer *n3, integer *n4)
+{
+ /* System generated locals */
+ integer ret_val;
+
+ /* Builtin functions */
+ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
+ integer s_cmp(char *, char *, ftnlen, ftnlen);
+
+ /* Local variables */
+ integer i__;
+ char c1[1], c2[1], c3[1], c4[1];
+ integer ic, nb, iz, nx;
+ logical cname;
+ integer nbmin;
+ logical sname;
+ extern integer ieeeck_(integer *, real *, real *);
+ char subnam[1];
+ extern integer iparmq_(integer *, char *, char *, integer *, integer *,
+ integer *, integer *);
+
+ ftnlen name_len, opts_len;
+
+ name_len = strlen (name__);
+ opts_len = strlen (opts);
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* January 2007 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* ILAENV is called from the LAPACK routines to choose problem-dependent */
+/* parameters for the local environment. See ISPEC for a description of */
+/* the parameters. */
+
+/* ILAENV returns an INTEGER */
+/* if ILAENV >= 0: ILAENV returns the value of the parameter specified by ISPEC */
+/* if ILAENV < 0: if ILAENV = -k, the k-th argument had an illegal value. */
+
+/* This version provides a set of parameters which should give good, */
+/* but not optimal, performance on many of the currently available */
+/* computers. Users are encouraged to modify this subroutine to set */
+/* the tuning parameters for their particular machine using the option */
+/* and problem size information in the arguments. */
+
+/* This routine will not function correctly if it is converted to all */
+/* lower case. Converting it to all upper case is allowed. */
+
+/* Arguments */
+/* ========= */
+
+/* ISPEC (input) INTEGER */
+/* Specifies the parameter to be returned as the value of */
+/* ILAENV. */
+/* = 1: the optimal blocksize; if this value is 1, an unblocked */
+/* algorithm will give the best performance. */
+/* = 2: the minimum block size for which the block routine */
+/* should be used; if the usable block size is less than */
+/* this value, an unblocked routine should be used. */
+/* = 3: the crossover point (in a block routine, for N less */
+/* than this value, an unblocked routine should be used) */
+/* = 4: the number of shifts, used in the nonsymmetric */
+/* eigenvalue routines (DEPRECATED) */
+/* = 5: the minimum column dimension for blocking to be used; */
+/* rectangular blocks must have dimension at least k by m, */
+/* where k is given by ILAENV(2,...) and m by ILAENV(5,...) */
+/* = 6: the crossover point for the SVD (when reducing an m by n */
+/* matrix to bidiagonal form, if max(m,n)/min(m,n) exceeds */
+/* this value, a QR factorization is used first to reduce */
+/* the matrix to a triangular form.) */
+/* = 7: the number of processors */
+/* = 8: the crossover point for the multishift QR method */
+/* for nonsymmetric eigenvalue problems (DEPRECATED) */
+/* = 9: maximum size of the subproblems at the bottom of the */
+/* computation tree in the divide-and-conquer algorithm */
+/* (used by xGELSD and xGESDD) */
+/* =10: ieee NaN arithmetic can be trusted not to trap */
+/* =11: infinity arithmetic can be trusted not to trap */
+/* 12 <= ISPEC <= 16: */
+/* xHSEQR or one of its subroutines, */
+/* see IPARMQ for detailed explanation */
+
+/* NAME (input) CHARACTER*(*) */
+/* The name of the calling subroutine, in either upper case or */
+/* lower case. */
+
+/* OPTS (input) CHARACTER*(*) */
+/* The character options to the subroutine NAME, concatenated */
+/* into a single character string. For example, UPLO = 'U', */
+/* TRANS = 'T', and DIAG = 'N' for a triangular routine would */
+/* be specified as OPTS = 'UTN'. */
+
+/* N1 (input) INTEGER */
+/* N2 (input) INTEGER */
+/* N3 (input) INTEGER */
+/* N4 (input) INTEGER */
+/* Problem dimensions for the subroutine NAME; these may not all */
+/* be required. */
+
+/* Further Details */
+/* =============== */
+
+/* The following conventions have been used when calling ILAENV from the */
+/* LAPACK routines: */
+/* 1) OPTS is a concatenation of all of the character options to */
+/* subroutine NAME, in the same order that they appear in the */
+/* argument list for NAME, even if they are not used in determining */
+/* the value of the parameter specified by ISPEC. */
+/* 2) The problem dimensions N1, N2, N3, N4 are specified in the order */
+/* that they appear in the argument list for NAME. N1 is used */
+/* first, N2 second, and so on, and unused problem dimensions are */
+/* passed a value of -1. */
+/* 3) The parameter value returned by ILAENV is checked for validity in */
+/* the calling subroutine. For example, ILAENV is used to retrieve */
+/* the optimal blocksize for STRTRI as follows: */
+
+/* NB = ILAENV( 1, 'STRTRI', UPLO // DIAG, N, -1, -1, -1 ) */
+/* IF( NB.LE.1 ) NB = MAX( 1, N ) */
+
+/* ===================================================================== */
+
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. External Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ switch (*ispec) {
+ case 1: goto L10;
+ case 2: goto L10;
+ case 3: goto L10;
+ case 4: goto L80;
+ case 5: goto L90;
+ case 6: goto L100;
+ case 7: goto L110;
+ case 8: goto L120;
+ case 9: goto L130;
+ case 10: goto L140;
+ case 11: goto L150;
+ case 12: goto L160;
+ case 13: goto L160;
+ case 14: goto L160;
+ case 15: goto L160;
+ case 16: goto L160;
+ }
+
+/* Invalid value for ISPEC */
+
+ ret_val = -1;
+ return ret_val;
+
+L10:
+
+/* Convert NAME to upper case if the first character is lower case. */
+
+ ret_val = 1;
+ s_copy(subnam, name__, (ftnlen)1, name_len);
+ ic = *(unsigned char *)subnam;
+ iz = 'Z';
+ if (iz == 90 || iz == 122) {
+
+/* ASCII character set */
+
+ if (ic >= 97 && ic <= 122) {
+ *(unsigned char *)subnam = (char) (ic - 32);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if (ic >= 97 && ic <= 122) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
+ }
+/* L20: */
+ }
+ }
+
+ } else if (iz == 233 || iz == 169) {
+
+/* EBCDIC character set */
+
+ if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
+ ic <= 169) {
+ *(unsigned char *)subnam = (char) (ic + 64);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
+ 162 && ic <= 169) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic + 64);
+ }
+/* L30: */
+ }
+ }
+
+ } else if (iz == 218 || iz == 250) {
+
+/* Prime machines: ASCII+128 */
+
+ if (ic >= 225 && ic <= 250) {
+ *(unsigned char *)subnam = (char) (ic - 32);
+ for (i__ = 2; i__ <= 6; ++i__) {
+ ic = *(unsigned char *)&subnam[i__ - 1];
+ if (ic >= 225 && ic <= 250) {
+ *(unsigned char *)&subnam[i__ - 1] = (char) (ic - 32);
+ }
+/* L40: */
+ }
+ }
+ }
+
+ *(unsigned char *)c1 = *(unsigned char *)subnam;
+ sname = *(unsigned char *)c1 == 'S' || *(unsigned char *)c1 == 'D';
+ cname = *(unsigned char *)c1 == 'C' || *(unsigned char *)c1 == 'Z';
+ if (! (cname || sname)) {
+ return ret_val;
+ }
+ s_copy(c2, subnam + 1, (ftnlen)1, (ftnlen)2);
+ s_copy(c3, subnam + 3, (ftnlen)1, (ftnlen)3);
+ s_copy(c4, c3 + 1, (ftnlen)1, (ftnlen)2);
+
+ switch (*ispec) {
+ case 1: goto L50;
+ case 2: goto L60;
+ case 3: goto L70;
+ }
+
+L50:
+
+/* ISPEC = 1: block size */
+
+/* In these examples, separate code is provided for setting NB for */
+/* real and complex. We assume that NB will take the same value in */
+/* single or double precision. */
+
+ nb = 1;
+
+ if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3,
+ "RQF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)
+ 1, (ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3)
+ == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 32;
+ } else {
+ nb = 32;
+ }
+ } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "PO", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 32;
+ } else if (sname && s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 64;
+ }
+ } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 64;
+ } else if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 32;
+ } else if (s_cmp(c3, "GST", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 64;
+ }
+ } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nb = 32;
+ }
+ }
+ } else if (s_cmp(c2, "GB", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n4 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "PB", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ } else {
+ if (*n2 <= 64) {
+ nb = 1;
+ } else {
+ nb = 32;
+ }
+ }
+ }
+ } else if (s_cmp(c2, "TR", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (s_cmp(c2, "LA", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "UUM", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nb = 64;
+ } else {
+ nb = 64;
+ }
+ }
+ } else if (sname && s_cmp(c2, "ST", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "EBZ", (ftnlen)1, (ftnlen)3) == 0) {
+ nb = 1;
+ }
+ }
+ ret_val = nb;
+ return ret_val;
+
+L60:
+
+/* ISPEC = 2: minimum block size */
+
+ nbmin = 2;
+ if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
+ ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
+ ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
+ {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ } else if (s_cmp(c3, "TRI", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 2;
+ } else {
+ nbmin = 2;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRF", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nbmin = 8;
+ } else {
+ nbmin = 8;
+ }
+ } else if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nbmin = 2;
+ }
+ } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nbmin = 2;
+ }
+ } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ } else if (*(unsigned char *)c3 == 'M') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nbmin = 2;
+ }
+ }
+ }
+ ret_val = nbmin;
+ return ret_val;
+
+L70:
+
+/* ISPEC = 3: crossover point */
+
+ nx = 0;
+ if (s_cmp(c2, "GE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "QRF", (ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "RQF", (
+ ftnlen)1, (ftnlen)3) == 0 || s_cmp(c3, "LQF", (ftnlen)1, (
+ ftnlen)3) == 0 || s_cmp(c3, "QLF", (ftnlen)1, (ftnlen)3) == 0)
+ {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "HRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ } else if (s_cmp(c3, "BRD", (ftnlen)1, (ftnlen)3) == 0) {
+ if (sname) {
+ nx = 128;
+ } else {
+ nx = 128;
+ }
+ }
+ } else if (s_cmp(c2, "SY", (ftnlen)1, (ftnlen)2) == 0) {
+ if (sname && s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nx = 32;
+ }
+ } else if (cname && s_cmp(c2, "HE", (ftnlen)1, (ftnlen)2) == 0) {
+ if (s_cmp(c3, "TRD", (ftnlen)1, (ftnlen)3) == 0) {
+ nx = 32;
+ }
+ } else if (sname && s_cmp(c2, "OR", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nx = 128;
+ }
+ }
+ } else if (cname && s_cmp(c2, "UN", (ftnlen)1, (ftnlen)2) == 0) {
+ if (*(unsigned char *)c3 == 'G') {
+ if (s_cmp(c4, "QR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "RQ",
+ (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "LQ", (ftnlen)1, (
+ ftnlen)2) == 0 || s_cmp(c4, "QL", (ftnlen)1, (ftnlen)2) ==
+ 0 || s_cmp(c4, "HR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(
+ c4, "TR", (ftnlen)1, (ftnlen)2) == 0 || s_cmp(c4, "BR", (
+ ftnlen)1, (ftnlen)2) == 0) {
+ nx = 128;
+ }
+ }
+ }
+ ret_val = nx;
+ return ret_val;
+
+L80:
+
+/* ISPEC = 4: number of shifts (used by xHSEQR) */
+
+ ret_val = 6;
+ return ret_val;
+
+L90:
+
+/* ISPEC = 5: minimum column dimension (not used) */
+
+ ret_val = 2;
+ return ret_val;
+
+L100:
+
+/* ISPEC = 6: crossover point for SVD (used by xGELSS and xGESVD) */
+
+ ret_val = (integer) ((real) min(*n1,*n2) * 1.6f);
+ return ret_val;
+
+L110:
+
+/* ISPEC = 7: number of processors (not used) */
+
+ ret_val = 1;
+ return ret_val;
+
+L120:
+
+/* ISPEC = 8: crossover point for multishift (used by xHSEQR) */
+
+ ret_val = 50;
+ return ret_val;
+
+L130:
+
+/* ISPEC = 9: maximum size of the subproblems at the bottom of the */
+/* computation tree in the divide-and-conquer algorithm */
+/* (used by xGELSD and xGESDD) */
+
+ ret_val = 25;
+ return ret_val;
+
+L140:
+
+/* ISPEC = 10: ieee NaN arithmetic can be trusted not to trap */
+
+/* ILAENV = 0 */
+ ret_val = 1;
+ if (ret_val == 1) {
+ ret_val = ieeeck_(&c__1, &c_b163, &c_b164);
+ }
+ return ret_val;
+
+L150:
+
+/* ISPEC = 11: infinity arithmetic can be trusted not to trap */
+
+/* ILAENV = 0 */
+ ret_val = 1;
+ if (ret_val == 1) {
+ ret_val = ieeeck_(&c__0, &c_b163, &c_b164);
+ }
+ return ret_val;
+
+L160:
+
+/* 12 <= ISPEC <= 16: xHSEQR or one of its subroutines. */
+
+ ret_val = iparmq_(ispec, name__, opts, n1, n2, n3, n4)
+ ;
+ return ret_val;
+
+/* End of ILAENV */
+
+} /* ilaenv_ */
+
diff --git a/src/lib/yac/clapack/SRC/iparmq.c b/src/lib/yac/clapack/SRC/iparmq.c
new file mode 100644
index 000000000..d0239d5b0
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/iparmq.c
@@ -0,0 +1,287 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* iparmq.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+
+integer iparmq_(integer *ispec, char *name__, char *opts, integer *n, integer
+ *ilo, integer *ihi, integer *lwork)
+{
+ /* System generated locals */
+ integer ret_val, i__1, i__2;
+ real r__1;
+
+ /* Builtin functions */
+ double log(doublereal);
+ integer i_nint(real *);
+
+ /* Local variables */
+ integer nh, ns;
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+
+/* Purpose */
+/* ======= */
+
+/* This program sets problem and machine dependent parameters */
+/* useful for xHSEQR and its subroutines. It is called whenever */
+/* ILAENV is called with 12 <= ISPEC <= 16 */
+
+/* Arguments */
+/* ========= */
+
+/* ISPEC (input) integer scalar */
+/* ISPEC specifies which tunable parameter IPARMQ should */
+/* return. */
+
+/* ISPEC=12: (INMIN) Matrices of order nmin or less */
+/* are sent directly to xLAHQR, the implicit */
+/* double shift QR algorithm. NMIN must be */
+/* at least 11. */
+
+/* ISPEC=13: (INWIN) Size of the deflation window. */
+/* This is best set greater than or equal to */
+/* the number of simultaneous shifts NS. */
+/* Larger matrices benefit from larger deflation */
+/* windows. */
+
+/* ISPEC=14: (INIBL) Determines when to stop nibbling and */
+/* invest in an (expensive) multi-shift QR sweep. */
+/* If the aggressive early deflation subroutine */
+/* finds LD converged eigenvalues from an order */
+/* NW deflation window and LD.GT.(NW*NIBBLE)/100, */
+/* then the next QR sweep is skipped and early */
+/* deflation is applied immediately to the */
+/* remaining active diagonal block. Setting */
+/* IPARMQ(ISPEC=14) = 0 causes TTQRE to skip a */
+/* multi-shift QR sweep whenever early deflation */
+/* finds a converged eigenvalue. Setting */
+/* IPARMQ(ISPEC=14) greater than or equal to 100 */
+/* prevents TTQRE from skipping a multi-shift */
+/* QR sweep. */
+
+/* ISPEC=15: (NSHFTS) The number of simultaneous shifts in */
+/* a multi-shift QR iteration. */
+
+/* ISPEC=16: (IACC22) IPARMQ is set to 0, 1 or 2 with the */
+/* following meanings. */
+/* 0: During the multi-shift QR sweep, */
+/* xLAQR5 does not accumulate reflections and */
+/* does not use matrix-matrix multiply to */
+/* update the far-from-diagonal matrix */
+/* entries. */
+/* 1: During the multi-shift QR sweep, */
+/* xLAQR5 and/or xLAQRaccumulates reflections and uses */
+/* matrix-matrix multiply to update the */
+/* far-from-diagonal matrix entries. */
+/* 2: During the multi-shift QR sweep. */
+/* xLAQR5 accumulates reflections and takes */
+/* advantage of 2-by-2 block structure during */
+/* matrix-matrix multiplies. */
+/* (If xTRMM is slower than xGEMM, then */
+/* IPARMQ(ISPEC=16)=1 may be more efficient than */
+/* IPARMQ(ISPEC=16)=2 despite the greater level of */
+/* arithmetic work implied by the latter choice.) */
+
+/* NAME (input) character string */
+/* Name of the calling subroutine */
+
+/* OPTS (input) character string */
+/* This is a concatenation of the string arguments to */
+/* TTQRE. */
+
+/* N (input) integer scalar */
+/* N is the order of the Hessenberg matrix H. */
+
+/* ILO (input) INTEGER */
+/* IHI (input) INTEGER */
+/* It is assumed that H is already upper triangular */
+/* in rows and columns 1:ILO-1 and IHI+1:N. */
+
+/* LWORK (input) integer scalar */
+/* The amount of workspace available. */
+
+/* Further Details */
+/* =============== */
+
+/* Little is known about how best to choose these parameters. */
+/* It is possible to use different values of the parameters */
+/* for each of CHSEQR, DHSEQR, SHSEQR and ZHSEQR. */
+
+/* It is probably best to choose different parameters for */
+/* different matrices and different parameters at different */
+/* times during the iteration, but this has not been */
+/* implemented --- yet. */
+
+
+/* The best choices of most of the parameters depend */
+/* in an ill-understood way on the relative execution */
+/* rate of xLAQR3 and xLAQR5 and on the nature of each */
+/* particular eigenvalue problem. Experiment may be the */
+/* only practical way to determine which choices are most */
+/* effective. */
+
+/* Following is a list of default values supplied by IPARMQ. */
+/* These defaults may be adjusted in order to attain better */
+/* performance in any particular computational environment. */
+
+/* IPARMQ(ISPEC=12) The xLAHQR vs xLAQR0 crossover point. */
+/* Default: 75. (Must be at least 11.) */
+
+/* IPARMQ(ISPEC=13) Recommended deflation window size. */
+/* This depends on ILO, IHI and NS, the */
+/* number of simultaneous shifts returned */
+/* by IPARMQ(ISPEC=15). The default for */
+/* (IHI-ILO+1).LE.500 is NS. The default */
+/* for (IHI-ILO+1).GT.500 is 3*NS/2. */
+
+/* IPARMQ(ISPEC=14) Nibble crossover point. Default: 14. */
+
+/* IPARMQ(ISPEC=15) Number of simultaneous shifts, NS. */
+/* a multi-shift QR iteration. */
+
+/* If IHI-ILO+1 is ... */
+
+/* greater than ...but less ... the */
+/* or equal to ... than default is */
+
+/* 0 30 NS = 2+ */
+/* 30 60 NS = 4+ */
+/* 60 150 NS = 10 */
+/* 150 590 NS = ** */
+/* 590 3000 NS = 64 */
+/* 3000 6000 NS = 128 */
+/* 6000 infinity NS = 256 */
+
+/* (+) By default matrices of this order are */
+/* passed to the implicit double shift routine */
+/* xLAHQR. See IPARMQ(ISPEC=12) above. These */
+/* values of NS are used only in case of a rare */
+/* xLAHQR failure. */
+
+/* (**) The asterisks (**) indicate an ad-hoc */
+/* function increasing from 10 to 64. */
+
+/* IPARMQ(ISPEC=16) Select structured matrix multiply. */
+/* (See ISPEC=16 above for details.) */
+/* Default: 3. */
+
+/* ================================================================ */
+/* .. Parameters .. */
+/* .. */
+/* .. Local Scalars .. */
+/* .. */
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+ if (*ispec == 15 || *ispec == 13 || *ispec == 16) {
+
+/* ==== Set the number simultaneous shifts ==== */
+
+ nh = *ihi - *ilo + 1;
+ ns = 2;
+ if (nh >= 30) {
+ ns = 4;
+ }
+ if (nh >= 60) {
+ ns = 10;
+ }
+ if (nh >= 150) {
+/* Computing MAX */
+ r__1 = log((real) nh) / log(2.f);
+ i__1 = 10, i__2 = nh / i_nint(&r__1);
+ ns = max(i__1,i__2);
+ }
+ if (nh >= 590) {
+ ns = 64;
+ }
+ if (nh >= 3000) {
+ ns = 128;
+ }
+ if (nh >= 6000) {
+ ns = 256;
+ }
+/* Computing MAX */
+ i__1 = 2, i__2 = ns - ns % 2;
+ ns = max(i__1,i__2);
+ }
+
+ if (*ispec == 12) {
+
+
+/* ===== Matrices of order smaller than NMIN get sent */
+/* . to xLAHQR, the classic double shift algorithm. */
+/* . This must be at least 11. ==== */
+
+ ret_val = 75;
+
+ } else if (*ispec == 14) {
+
+/* ==== INIBL: skip a multi-shift qr iteration and */
+/* . whenever aggressive early deflation finds */
+/* . at least (NIBBLE*(window size)/100) deflations. ==== */
+
+ ret_val = 14;
+
+ } else if (*ispec == 15) {
+
+/* ==== NSHFTS: The number of simultaneous shifts ===== */
+
+ ret_val = ns;
+
+ } else if (*ispec == 13) {
+
+/* ==== NW: deflation window size. ==== */
+
+ if (nh <= 500) {
+ ret_val = ns;
+ } else {
+ ret_val = ns * 3 / 2;
+ }
+
+ } else if (*ispec == 16) {
+
+/* ==== IACC22: Whether to accumulate reflections */
+/* . before updating the far-from-diagonal elements */
+/* . and whether to use 2-by-2 block structure while */
+/* . doing it. A small amount of work could be saved */
+/* . by making this choice dependent also upon the */
+/* . NH=IHI-ILO+1. */
+
+ ret_val = 0;
+ if (ns >= 14) {
+ ret_val = 1;
+ }
+ if (ns >= 14) {
+ ret_val = 2;
+ }
+
+ } else {
+/* ===== invalid value of ispec ===== */
+ ret_val = -1;
+
+ }
+
+/* ==== End of IPARMQ ==== */
+
+ return ret_val;
+} /* iparmq_ */
+
diff --git a/src/lib/yac/clapack/SRC/xerbla.c b/src/lib/yac/clapack/SRC/xerbla.c
new file mode 100644
index 000000000..697ddac91
--- /dev/null
+++ b/src/lib/yac/clapack/SRC/xerbla.c
@@ -0,0 +1,70 @@
+// Copyright (c) 1992-2008 The University of Tennessee. All rights reserved.
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+/* xerbla.f -- translated by f2c (version 20061008).
+ You must link the resulting object file with libf2c:
+ on Microsoft Windows system, link with libf2c.lib;
+ on Linux or Unix systems, link with .../path/to/libf2c.a -lm
+ or, if you install libf2c.a in a standard place, with -lf2c -lm
+ -- in that order, at the end of the command line, as in
+ cc *.o -lf2c -lm
+ Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
+
+ http://www.netlib.org/f2c/libf2c.zip
+*/
+
+#include "f2c.h"
+#include "blaswrap.h"
+#include "stdio.h"
+
+/* Table of constant values */
+
+static integer c__1 = 1;
+
+/* Subroutine */ int xerbla_(char *srname, integer *info)
+{
+
+
+/* -- LAPACK auxiliary routine (version 3.2) -- */
+/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
+/* November 2006 */
+
+/* .. Scalar Arguments .. */
+/* .. */
+
+/* Purpose */
+/* ======= */
+
+/* XERBLA is an error handler for the LAPACK routines. */
+/* It is called by an LAPACK routine if an input parameter has an */
+/* invalid value. A message is printed and execution stops. */
+
+/* Installers may consider modifying the STOP statement in order to */
+/* call system-specific exception-handling facilities. */
+
+/* Arguments */
+/* ========= */
+
+/* SRNAME (input) CHARACTER*(*) */
+/* The name of the routine which called XERBLA. */
+
+/* INFO (input) INTEGER */
+/* The position of the invalid parameter in the parameter list */
+/* of the calling routine. */
+
+/* ===================================================================== */
+
+/* .. Intrinsic Functions .. */
+/* .. */
+/* .. Executable Statements .. */
+
+ printf("** On entry to %6s, parameter number %2i had an illegal value\n",
+ srname, *info);
+
+
+/* End of XERBLA */
+
+ return 0;
+} /* xerbla_ */
+
diff --git a/src/lib/yac/CMakeLists.txt b/src/lib/yac/src/CMakeLists.txt
similarity index 100%
rename from src/lib/yac/CMakeLists.txt
rename to src/lib/yac/src/CMakeLists.txt
diff --git a/src/lib/yac/Makefile.am b/src/lib/yac/src/Makefile.am
similarity index 87%
rename from src/lib/yac/Makefile.am
rename to src/lib/yac/src/Makefile.am
index e2f91eb0d..b78decdae 100644
--- a/src/lib/yac/Makefile.am
+++ b/src/lib/yac/src/Makefile.am
@@ -25,6 +25,10 @@ libyac_la_SOURCES = \
utils_core.c \
utils_core.h \
utils_common.h \
+ compute_weights.c \
+ compute_weights.h \
+ yac_lapack_interface.c \
+ yac_lapack_interface.h \
yac_types.h \
yac_version.h
#
diff --git a/src/lib/yac/area.c b/src/lib/yac/src/area.c
similarity index 100%
rename from src/lib/yac/area.c
rename to src/lib/yac/src/area.c
diff --git a/src/lib/yac/area.h b/src/lib/yac/src/area.h
similarity index 100%
rename from src/lib/yac/area.h
rename to src/lib/yac/src/area.h
diff --git a/src/lib/yac/basic_grid.h b/src/lib/yac/src/basic_grid.h
similarity index 100%
rename from src/lib/yac/basic_grid.h
rename to src/lib/yac/src/basic_grid.h
diff --git a/src/lib/yac/basic_grid_data.h b/src/lib/yac/src/basic_grid_data.h
similarity index 100%
rename from src/lib/yac/basic_grid_data.h
rename to src/lib/yac/src/basic_grid_data.h
diff --git a/src/lib/yac/bnd_circle.c b/src/lib/yac/src/bnd_circle.c
similarity index 100%
rename from src/lib/yac/bnd_circle.c
rename to src/lib/yac/src/bnd_circle.c
diff --git a/src/lib/yac/check_overlap.c b/src/lib/yac/src/check_overlap.c
similarity index 100%
rename from src/lib/yac/check_overlap.c
rename to src/lib/yac/src/check_overlap.c
diff --git a/src/lib/yac/clipping.c b/src/lib/yac/src/clipping.c
similarity index 100%
rename from src/lib/yac/clipping.c
rename to src/lib/yac/src/clipping.c
diff --git a/src/lib/yac/clipping.h b/src/lib/yac/src/clipping.h
similarity index 100%
rename from src/lib/yac/clipping.h
rename to src/lib/yac/src/clipping.h
diff --git a/src/lib/yac/compare_files b/src/lib/yac/src/compare_files
similarity index 100%
rename from src/lib/yac/compare_files
rename to src/lib/yac/src/compare_files
diff --git a/src/lib/yac/src/compute_weights.c b/src/lib/yac/src/compute_weights.c
new file mode 100644
index 000000000..e180f5952
--- /dev/null
+++ b/src/lib/yac/src/compute_weights.c
@@ -0,0 +1,102 @@
+#include <math.h>
+#include <assert.h>
+#include "compute_weights.h"
+#include "yac_lapack_interface.h"
+#include "geometry.h"
+
+static void
+inverse(double *A, size_t n)
+{
+// LAPACKE_dsytrf_work and LAPACKE_dsytri might not be available (see yac_lapack_interface.h).
+#ifdef YAC_LAPACK_NO_DSYTR
+ lapack_int ipiv[n + 1];
+ double work[n * n];
+
+ for (size_t i = 0; i < n + 1; ++i) ipiv[i] = 0;
+ for (size_t i = 0; i < n * n; ++i) work[i] = 0;
+
+ assert(!LAPACKE_dgetrf(LAPACK_COL_MAJOR, (lapack_int) n, (lapack_int) n, A, (lapack_int) n, ipiv) || "internal ERROR: dgetrf");
+
+ assert(!LAPACKE_dgetri_work(LAPACK_COL_MAJOR, (lapack_int) n, A, (lapack_int) n, ipiv, work, (lapack_int) (n * n))
+ || "internal ERROR: dgetri");
+#else
+ lapack_int ipiv[n];
+ double work[n];
+
+ assert(!LAPACKE_dsytrf_work(LAPACK_COL_MAJOR, 'L', (lapack_int) n, A, (lapack_int) n, ipiv, work, (lapack_int) n)
+ || "internal ERROR: dsytrf");
+
+ assert(!LAPACKE_dsytri_work(LAPACK_COL_MAJOR, 'L', (lapack_int) n, A, (lapack_int) n, ipiv, work) || "internal ERROR: dsytri");
+
+ for (size_t i = 0; i < n; ++i)
+ for (size_t j = i + 1; j < n; ++j) A[j * n + i] = A[i * n + j];
+#endif
+}
+
+void
+yac_compute_weights_rbf(double tgt_coord[3], yac_coordinate_pointer src_coords, size_t const n, double *weights,
+ double const rbf_scale)
+{
+ double A[n][n];
+ double a[n];
+
+ double sum_d = 0.0, scale_d = 1.0;
+
+ // compute distance matrix for all found source points
+ for (size_t i = 0; i < n; ++i) A[i][i] = 0.0;
+ for (size_t i = 0; i < n - 1; ++i)
+ {
+ for (size_t j = i + 1; j < n; ++j)
+ {
+ double d = get_vector_angle(src_coords[i], src_coords[j]);
+ A[i][j] = d;
+ A[j][i] = d;
+ sum_d += d;
+ }
+ }
+
+ // compute and apply scale factor for distance matrix
+ if (sum_d > 0.0) scale_d = ((double) ((n - 1) * n)) / (2.0 * sum_d);
+ scale_d /= rbf_scale;
+
+ double sq_scale_d = scale_d * scale_d;
+
+ // compute matrix A[n][n]
+ // with A = rbf(A)
+ // rbf(a) => Radial basis function
+ for (size_t i = 0; i < n; ++i)
+ {
+ for (size_t j = 0; j < n; ++j)
+ {
+ double d = A[i][j];
+ // gauß rbf kernel
+ A[i][j] = exp(-1.0 * d * d * sq_scale_d);
+ }
+ }
+
+ // compute inverse of A
+ inverse(&A[0][0], n);
+
+ // compute a[NUM_NEIGH]
+ // with a_i = rbf(d(x_i, y))
+ // x => vector containing the coordinates of the
+ // n nearest neighbours of the current
+ // target point
+ // y => coordinates of target point
+ // d(a, b) => great circle distance between point a and b
+ // rbf(a) => Radial basis function
+ for (size_t i = 0; i < n; ++i)
+ {
+ double d = get_vector_angle(tgt_coord, src_coords[i]);
+ // gauß rbf kernel
+ a[i] = exp(-1.0 * d * d * sq_scale_d);
+ }
+
+ // compute weights
+ // with w_i = SUM(A_inv[i][j]*a[j]) // j = 0..n-1
+ for (size_t i = 0; i < n; ++i)
+ {
+ weights[i] = 0.0;
+ for (size_t j = 0; j < n; ++j) weights[i] += A[i][j] * a[j];
+ }
+}
diff --git a/src/lib/yac/src/compute_weights.h b/src/lib/yac/src/compute_weights.h
new file mode 100644
index 000000000..f911ac444
--- /dev/null
+++ b/src/lib/yac/src/compute_weights.h
@@ -0,0 +1,10 @@
+#ifndef COMPUTE_WEIGHTS_H
+#define COMPUTE_WEIGHTS_H
+
+#include <stddef.h>
+#include "yac_types.h"
+
+void yac_compute_weights_rbf(double tgt_coord[3], yac_coordinate_pointer src_coords, size_t const n, double *weights,
+ double const rbf_scale);
+
+#endif
diff --git a/src/lib/yac/ensure_array_size.c b/src/lib/yac/src/ensure_array_size.c
similarity index 100%
rename from src/lib/yac/ensure_array_size.c
rename to src/lib/yac/src/ensure_array_size.c
diff --git a/src/lib/yac/ensure_array_size.h b/src/lib/yac/src/ensure_array_size.h
similarity index 100%
rename from src/lib/yac/ensure_array_size.h
rename to src/lib/yac/src/ensure_array_size.h
diff --git a/src/lib/yac/field_data.h b/src/lib/yac/src/field_data.h
similarity index 100%
rename from src/lib/yac/field_data.h
rename to src/lib/yac/src/field_data.h
diff --git a/src/lib/yac/geometry.h b/src/lib/yac/src/geometry.h
similarity index 100%
rename from src/lib/yac/geometry.h
rename to src/lib/yac/src/geometry.h
diff --git a/src/lib/yac/grid_cell.c b/src/lib/yac/src/grid_cell.c
similarity index 100%
rename from src/lib/yac/grid_cell.c
rename to src/lib/yac/src/grid_cell.c
diff --git a/src/lib/yac/grid_cell.h b/src/lib/yac/src/grid_cell.h
similarity index 100%
rename from src/lib/yac/grid_cell.h
rename to src/lib/yac/src/grid_cell.h
diff --git a/src/lib/yac/intersection.c b/src/lib/yac/src/intersection.c
similarity index 100%
rename from src/lib/yac/intersection.c
rename to src/lib/yac/src/intersection.c
diff --git a/src/lib/yac/interval_tree.c b/src/lib/yac/src/interval_tree.c
similarity index 100%
rename from src/lib/yac/interval_tree.c
rename to src/lib/yac/src/interval_tree.c
diff --git a/src/lib/yac/interval_tree.h b/src/lib/yac/src/interval_tree.h
similarity index 100%
rename from src/lib/yac/interval_tree.h
rename to src/lib/yac/src/interval_tree.h
diff --git a/src/lib/yac/location.h b/src/lib/yac/src/location.h
similarity index 100%
rename from src/lib/yac/location.h
rename to src/lib/yac/src/location.h
diff --git a/src/lib/yac/sphere_part.c b/src/lib/yac/src/sphere_part.c
similarity index 100%
rename from src/lib/yac/sphere_part.c
rename to src/lib/yac/src/sphere_part.c
diff --git a/src/lib/yac/sphere_part.h b/src/lib/yac/src/sphere_part.h
similarity index 100%
rename from src/lib/yac/sphere_part.h
rename to src/lib/yac/src/sphere_part.h
diff --git a/src/lib/yac/utils_common.h b/src/lib/yac/src/utils_common.h
similarity index 100%
rename from src/lib/yac/utils_common.h
rename to src/lib/yac/src/utils_common.h
diff --git a/src/lib/yac/utils_core.c b/src/lib/yac/src/utils_core.c
similarity index 100%
rename from src/lib/yac/utils_core.c
rename to src/lib/yac/src/utils_core.c
diff --git a/src/lib/yac/utils_core.h b/src/lib/yac/src/utils_core.h
similarity index 100%
rename from src/lib/yac/utils_core.h
rename to src/lib/yac/src/utils_core.h
diff --git a/src/lib/yac/src/yac_lapack_interface.c b/src/lib/yac/src/yac_lapack_interface.c
new file mode 100644
index 000000000..8fcb44c10
--- /dev/null
+++ b/src/lib/yac/src/yac_lapack_interface.c
@@ -0,0 +1,362 @@
+// Copyright (c) 2024 The YAC Authors
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#include "yac_lapack_interface.h"
+
+#if YAC_LAPACK_INTERFACE_ID == 3 // ATLAS CLAPACK
+
+#include <assert.h>
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork )
+{
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ return (lapack_int) clapack_dgels(LAPACK_COL_MAJOR,
+ trans == 'N' ? CblasNoTrans : CblasTrans,
+ (ATL_INT) m, (ATL_INT) n, (ATL_INT) nrhs,
+ a, (ATL_INT) lda, b, (int) ldb);
+}
+#endif
+
+lapack_int LAPACKE_dgesv( int matrix_layout, lapack_int n, lapack_int nrhs,
+ double* a, lapack_int lda, lapack_int* ipiv,
+ double* b, lapack_int ldb )
+{
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ if (sizeof(int) == sizeof(lapack_int))
+ {
+ return (lapack_int) clapack_dgesv(LAPACK_COL_MAJOR, (int) n, (int) nrhs,
+ a, (int) lda, (int*) ipiv, b, (int) ldb);
+ }
+ else
+ {
+ int i, result, ipiv_size = (int) n;
+ int ipiv_[ipiv_size];
+ result = clapack_dgesv(LAPACK_COL_MAJOR, (int) n, (int) nrhs,
+ a, (int) lda, ipiv_, b, (int) ldb);
+ for (i = 0; i != ipiv_size; ++i) { ipiv[i] = (lapack_int) ipiv_[i]; }
+ return (lapack_int) result;
+ }
+}
+
+lapack_int LAPACKE_dgetrf( int matrix_layout, lapack_int m, lapack_int n,
+ double* a, lapack_int lda, lapack_int* ipiv )
+{
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ if (sizeof(int) == sizeof(lapack_int))
+ {
+ return (lapack_int) clapack_dgetrf(LAPACK_COL_MAJOR, (int) m, (int) n,
+ a, (int) lda, (int*) ipiv);
+ }
+ else
+ {
+ int i, result, ipiv_size = (int) (n < m ? n : m);
+ int ipiv_[ipiv_size];
+ result = clapack_dgetrf(LAPACK_COL_MAJOR, (int) m, (int) n,
+ a, (int) lda, ipiv_);
+ for (i = 0; i != ipiv_size; ++i) { ipiv[i] = (lapack_int) ipiv_[i]; }
+ return (lapack_int) result;
+ }
+}
+
+lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a,
+ lapack_int lda, const lapack_int* ipiv,
+ double* work, lapack_int lwork )
+{
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ if (sizeof(int) == sizeof(lapack_int))
+ {
+ return (lapack_int) clapack_dgetri(LAPACK_COL_MAJOR, (int) n, a,
+ (int) lda, (int*) ipiv);
+ }
+ else
+ {
+ int i, ipiv_size = (int) n;
+ int ipiv_[n];
+ for (i = 0; i != ipiv_size; ++i) { ipiv_[i] = (int) ipiv[i]; }
+ return (lapack_int) clapack_dgetri(LAPACK_COL_MAJOR, (int) n, a,
+ (int) lda, ipiv_);
+ }
+}
+
+#elif YAC_LAPACK_INTERFACE_ID == 4 // Netlib CLAPACK
+
+#include <assert.h>
+#include <clapack.h>
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dgels_(&trans, (integer*) &m, (integer*) &n, (integer*) &nrhs,
+ (doublereal*) a, (integer*) &lda,
+ (doublereal*) b, (integer*) &ldb,
+ (doublereal*) work, (integer*) &lwork,
+ &info);
+ }
+ else
+ {
+ integer m_ = (integer) m, n_ = (integer) n,
+ nrhs_ = (integer) nrhs, lda_ = (integer) lda,
+ ldb_ = (integer) ldb, lwork_ = (integer) lwork;
+ dgels_(&trans, &m_, &n_, &nrhs_,
+ (doublereal*) a, &lda_,
+ (doublereal*) b, &ldb_,
+ (doublereal*) work, &lwork_,
+ &info);
+ }
+ return (lapack_int) info;
+}
+#endif
+
+lapack_int LAPACKE_dgesv( int matrix_layout, lapack_int n, lapack_int nrhs,
+ double* a, lapack_int lda, lapack_int* ipiv,
+ double* b, lapack_int ldb )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dgesv_((integer*) &n, (integer*) &nrhs,
+ (doublereal*) a, (integer*) &lda , (integer*) ipiv,
+ (doublereal*) b, (integer*) &ldb, &info);
+ }
+ else
+ {
+ int i, ipiv_size = (int) n;
+ integer n_ = (integer) n, nrhs_ = (integer) nrhs,
+ lda_ = (integer) lda, ldb_ = (integer) ldb,
+ ipiv_[n];
+ dgesv_(&n_, &nrhs_,
+ (doublereal*) a, &lda_, ipiv_,
+ (doublereal*) b, &ldb_, &info);
+ for (i = 0; i != ipiv_size; ++i) { ipiv[i] = (lapack_int) ipiv_[i]; }
+ }
+ return (lapack_int) info;
+}
+
+lapack_int LAPACKE_dgetrf( int matrix_layout, lapack_int m, lapack_int n,
+ double* a, lapack_int lda, lapack_int* ipiv )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dgetrf_((integer*) &m, (integer*) &n,
+ (doublereal*) a, (integer*) &lda , (integer*) ipiv,
+ &info);
+ }
+ else
+ {
+ int i, ipiv_size = (int) (n < m ? n : m);
+ integer m_ = (integer) m, n_ = (integer) n,
+ lda_ = (integer) lda, ipiv_[ipiv_size];
+ dgetrf_(&m_, &n_,
+ (doublereal*) a, &lda_, ipiv_,
+ &info);
+ for (i = 0; i != ipiv_size; ++i) {ipiv[i] = (lapack_int) ipiv_[i]; }
+ }
+ return (lapack_int) info;
+}
+
+lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a,
+ lapack_int lda, const lapack_int* ipiv,
+ double* work, lapack_int lwork )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dgetri_((integer*) &n, (doublereal*) a,
+ (integer*) &lda , (integer*) ipiv,
+ (doublereal*) work, (integer*) &lwork,
+ &info);
+ }
+ else
+ {
+ int i, size_ipiv = (int) n;
+ integer n_ = (integer) n, lda_ = (integer) lda,
+ lwork_ = (integer) lwork, ipiv_[size_ipiv];
+ for (i = 0; i != size_ipiv; ++i) { ipiv_[i] = (integer) ipiv[i]; }
+ dgetri_(&n_, (doublereal*) a,
+ &lda_, ipiv_,
+ (doublereal*) work, &lwork_,
+ &info);
+ }
+ return (lapack_int) info;
+}
+
+lapack_int LAPACKE_dsytrf_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda, lapack_int* ipiv,
+ double* work, lapack_int lwork )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dsytrf_(&uplo, (integer*) &n,
+ (doublereal*) a, (integer*) &lda, (integer*) ipiv,
+ (doublereal*) work, (integer*) &lwork, &info);
+ }
+ else
+ {
+ int i, size_ipiv = (int) n;
+ integer n_ = (integer) n, lda_ = (integer) lda,
+ lwork_ = (integer) lwork, ipiv_[size_ipiv];
+ dsytrf_(&uplo, &n_,
+ (doublereal*) a, &lda_, ipiv_,
+ (doublereal*) work, &lwork_, &info);
+ for (i = 0; i != size_ipiv; ++i) { ipiv[i] = (lapack_int) ipiv_[i]; }
+ }
+ return (lapack_int) info;
+}
+
+lapack_int LAPACKE_dsytri_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ const lapack_int* ipiv, double* work )
+{
+ integer info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR &&
+ sizeof(doublereal) == sizeof(double));
+ if (sizeof(integer) == sizeof(lapack_int))
+ {
+ dsytri_(&uplo, (integer*) &n,
+ (doublereal*) a, (integer*) &lda, (integer*) ipiv,
+ (doublereal*) work, &info);
+ }
+ else
+ {
+ int i, size_ipiv = (int) n;
+ integer n_ = (integer) n, lda_ = (integer) lda,
+ ipiv_[size_ipiv];
+ for (i = 0; i != size_ipiv; ++i) { ipiv_[i] = (integer) ipiv[i]; }
+ dsytri_(&uplo, &n_,
+ (doublereal*) a, &lda_, ipiv_,
+ (doublereal*) work, &info);
+ }
+ return (lapack_int) info;
+}
+
+#elif YAC_LAPACK_INTERFACE_ID == 5 // Fortran LAPACK
+
+#include <assert.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#define LAPACK_dgels YAC_FC_GLOBAL(dgels,DGELS)
+#define LAPACK_dgesv YAC_FC_GLOBAL(dgesv,DGESV)
+#define LAPACK_dgetrf YAC_FC_GLOBAL(dgetrf,DGETRF)
+#define LAPACK_dgetri YAC_FC_GLOBAL(dgetri,DGETRI)
+#define LAPACK_dsytrf YAC_FC_GLOBAL(dsytrf,DSYTRF)
+#define LAPACK_dsytri YAC_FC_GLOBAL(dsytri,DSYTRI)
+
+#if 0
+void LAPACK_dgels( char* trans, lapack_int* m, lapack_int* n, lapack_int* nrhs,
+ double* a, lapack_int* lda, double* b, lapack_int* ldb,
+ double* work, lapack_int* lwork, lapack_int *info );
+#endif
+void LAPACK_dgesv( lapack_int* n, lapack_int* nrhs, double* a, lapack_int* lda,
+ lapack_int* ipiv, double* b, lapack_int* ldb,
+ lapack_int *info );
+void LAPACK_dgetrf( lapack_int* m, lapack_int* n, double* a, lapack_int* lda,
+ lapack_int* ipiv, lapack_int *info );
+void LAPACK_dgetri( lapack_int* n, double* a, lapack_int* lda,
+ const lapack_int* ipiv, double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_dsytrf( char* uplo, lapack_int* n, double* a, lapack_int* lda,
+ lapack_int* ipiv, double* work, lapack_int* lwork,
+ lapack_int *info );
+void LAPACK_dsytri( char* uplo, lapack_int* n, double* a, lapack_int* lda,
+ const lapack_int* ipiv, double* work, lapack_int *info );
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dgels(&trans, &m, &n, &nrhs, a, &lda, b, &ldb, work, &lwork, &info);
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+#endif
+
+lapack_int LAPACKE_dgesv( int matrix_layout, lapack_int n, lapack_int nrhs,
+ double* a, lapack_int lda, lapack_int* ipiv,
+ double* b, lapack_int ldb )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dgesv( &n, &nrhs, a, &lda, ipiv, b, &ldb, &info );
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+
+lapack_int LAPACKE_dgetrf( int matrix_layout, lapack_int m, lapack_int n,
+ double* a, lapack_int lda, lapack_int* ipiv )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dgetrf( &m, &n, a, &lda, ipiv, &info );
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+
+lapack_int LAPACKE_dgetri_work( int matrix_layout, lapack_int n, double* a,
+ lapack_int lda, const lapack_int* ipiv,
+ double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dgetri( &n, a, &lda, ipiv, work, &lwork, &info );
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+
+lapack_int LAPACKE_dsytrf_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda, lapack_int* ipiv,
+ double* work, lapack_int lwork )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dsytrf( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+
+lapack_int LAPACKE_dsytri_work( int matrix_layout, char uplo, lapack_int n,
+ double* a, lapack_int lda,
+ const lapack_int* ipiv, double* work )
+{
+ lapack_int info = 0;
+ assert(matrix_layout == LAPACK_COL_MAJOR);
+ LAPACK_dsytri( &uplo, &n, a, &lda, ipiv, work, &info );
+ if( info < 0 ) { info = info - 1; }
+ return info;
+}
+
+#endif
diff --git a/src/lib/yac/src/yac_lapack_interface.h b/src/lib/yac/src/yac_lapack_interface.h
new file mode 100644
index 000000000..95447fda6
--- /dev/null
+++ b/src/lib/yac/src/yac_lapack_interface.h
@@ -0,0 +1,125 @@
+// Copyright (c) 2024 The YAC Authors
+//
+// SPDX-License-Identifier: BSD-3-Clause
+
+#ifndef YAC_LAPACK_INTERFACE_H
+#define YAC_LAPACK_INTERFACE_H
+
+#ifdef HAVE_CONFIG_H
+// #include "config.h"
+#endif
+
+#define YAC_LAPACK_INTERFACE_ID 5
+#define YAC_FC_GLOBAL(name, NAME) name##_
+
+#ifndef YAC_LAPACK_INTERFACE_ID
+#error None of the supported LAPACK interfaces is available
+#endif
+
+#if YAC_LAPACK_INTERFACE_ID == 1 // Intel MKL LAPACKE
+
+#include <mkl_lapacke.h>
+
+#elif YAC_LAPACK_INTERFACE_ID == 2 // Netlib LAPACKE
+
+#include <lapacke.h>
+
+#elif YAC_LAPACK_INTERFACE_ID == 3 // ATLAS CLAPACK
+
+#include <clapack.h>
+
+#ifndef ATL_INT
+#define ATL_INT int
+#endif
+
+#ifndef lapack_int
+#define lapack_int ATL_INT
+#endif
+
+#define LAPACK_COL_MAJOR CblasColMajor
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork );
+#endif
+
+lapack_int LAPACKE_dgesv(int matrix_layout, lapack_int n, lapack_int nrhs, double *a, lapack_int lda, lapack_int *ipiv, double *b,
+ lapack_int ldb);
+
+lapack_int LAPACKE_dgetrf(int matrix_layout, lapack_int m, lapack_int n, double *a, lapack_int lda, lapack_int *ipiv);
+
+lapack_int LAPACKE_dgetri_work(int matrix_layout, lapack_int n, double *a, lapack_int lda, const lapack_int *ipiv, double *work,
+ lapack_int lwork);
+
+#define YAC_LAPACK_NO_DSYTR
+#define YAC_LAPACK_C_INDEXING
+
+#elif YAC_LAPACK_INTERFACE_ID == 4 // Netlib CLAPACK
+
+#include <f2c.h>
+
+#ifndef lapack_int
+#define lapack_int integer
+#endif
+
+#define LAPACK_COL_MAJOR 102
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork );
+#endif
+
+lapack_int LAPACKE_dgesv(int matrix_layout, lapack_int n, lapack_int nrhs, double *a, lapack_int lda, lapack_int *ipiv, double *b,
+ lapack_int ldb);
+
+lapack_int LAPACKE_dgetrf(int matrix_layout, lapack_int m, lapack_int n, double *a, lapack_int lda, lapack_int *ipiv);
+
+lapack_int LAPACKE_dgetri_work(int matrix_layout, lapack_int n, double *a, lapack_int lda, const lapack_int *ipiv, double *work,
+ lapack_int lwork);
+
+lapack_int LAPACKE_dsytrf_work(int matrix_layout, char uplo, lapack_int n, double *a, lapack_int lda, lapack_int *ipiv,
+ double *work, lapack_int lwork);
+
+lapack_int LAPACKE_dsytri_work(int matrix_layout, char uplo, lapack_int n, double *a, lapack_int lda, const lapack_int *ipiv,
+ double *work);
+
+#elif YAC_LAPACK_INTERFACE_ID == 5 // Fortran LAPACK
+
+#ifndef lapack_int
+#define lapack_int int
+#endif
+
+#define LAPACK_COL_MAJOR 102
+
+#if 0
+lapack_int LAPACKE_dgels_work( int matrix_layout, char trans, lapack_int m,
+ lapack_int n, lapack_int nrhs, double* a,
+ lapack_int lda, double* b, lapack_int ldb,
+ double* work, lapack_int lwork );
+#endif
+
+lapack_int LAPACKE_dgesv(int matrix_layout, lapack_int n, lapack_int nrhs, double *a, lapack_int lda, lapack_int *ipiv, double *b,
+ lapack_int ldb);
+
+lapack_int LAPACKE_dgetrf(int matrix_layout, lapack_int m, lapack_int n, double *a, lapack_int lda, lapack_int *ipiv);
+
+lapack_int LAPACKE_dgetri_work(int matrix_layout, lapack_int n, double *a, lapack_int lda, const lapack_int *ipiv, double *work,
+ lapack_int lwork);
+
+lapack_int LAPACKE_dsytrf_work(int matrix_layout, char uplo, lapack_int n, double *a, lapack_int lda, lapack_int *ipiv,
+ double *work, lapack_int lwork);
+
+lapack_int LAPACKE_dsytri_work(int matrix_layout, char uplo, lapack_int n, double *a, lapack_int lda, const lapack_int *ipiv,
+ double *work);
+
+#else
+
+#error Unexpected value for YAC_LAPACK_INTERFACE_ID
+
+#endif
+
+#endif // YAC_LAPACK_INTERFACE_H
diff --git a/src/lib/yac/yac_types.h b/src/lib/yac/src/yac_types.h
similarity index 100%
rename from src/lib/yac/yac_types.h
rename to src/lib/yac/src/yac_types.h
diff --git a/src/lib/yac/yac_version.h b/src/lib/yac/src/yac_version.h
similarity index 100%
rename from src/lib/yac/yac_version.h
rename to src/lib/yac/src/yac_version.h
diff --git a/src/pointsearch_spherepart.h b/src/pointsearch_spherepart.h
index d2cbb3f8a..e95e0cf42 100644
--- a/src/pointsearch_spherepart.h
+++ b/src/pointsearch_spherepart.h
@@ -16,8 +16,8 @@
#include "grid_convert.h"
extern "C"
{
-#include "lib/yac/grid_cell.h"
-#include "lib/yac/sphere_part.h"
+#include "lib/yac/src/grid_cell.h"
+#include "lib/yac/src/sphere_part.h"
}
class PointsearchSpherepart : public PointsearchStrategy
diff --git a/src/remap_knn.cc b/src/remap_knn.cc
index 00d68d0c1..dfdd84b39 100644
--- a/src/remap_knn.cc
+++ b/src/remap_knn.cc
@@ -37,7 +37,7 @@ remap_knn_weights(const KnnParams &knnParams, RemapSearch &rsearch, RemapVars &r
std::vector<KnnData> knnDataList;
knnDataList.reserve(Threading::ompNumMaxThreads);
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.push_back(KnnData(knnParams));
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(knnParams);
cdo::timer timer;
@@ -117,7 +117,7 @@ remap_knn(const Varray<T1> &srcArray, Varray<T2> &tgtArray, double srcMissval, s
std::vector<KnnData> knnDataList;
knnDataList.reserve(Threading::ompNumMaxThreads);
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.push_back(KnnData(knnParams));
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(knnParams);
cdo::timer timer;
@@ -191,7 +191,7 @@ intgrid_knn(KnnParams knnParams, const Field &field1, Field &field2)
std::vector<KnnData> knnDataList;
knnDataList.reserve(Threading::ompNumMaxThreads);
- for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.push_back(KnnData(knnParams));
+ for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(knnParams);
remap_search_init(mapType, remap.search, remap.srcGrid, remap.tgtGrid);
diff --git a/src/remap_method_conserv.h b/src/remap_method_conserv.h
index 112a0de61..67c115904 100644
--- a/src/remap_method_conserv.h
+++ b/src/remap_method_conserv.h
@@ -5,9 +5,9 @@
extern "C"
{
-#include "lib/yac/clipping.h"
-#include "lib/yac/area.h"
-#include "lib/yac/geometry.h"
+#include "lib/yac/src/clipping.h"
+#include "lib/yac/src/area.h"
+#include "lib/yac/src/geometry.h"
}
struct CellSearch
--
GitLab
From c229b5e272a7348354d951ad8717c8e77d54168d Mon Sep 17 00:00:00 2001
From: Uwe Schulzweida <uwe.schulzweida@mpimet.mpg.de>
Date: Mon, 17 Feb 2025 14:11:02 +0100
Subject: [PATCH 3/5] fix stack overflow
---
src/lib/yac/clapack/SRC/ilaenv.c | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/src/lib/yac/clapack/SRC/ilaenv.c b/src/lib/yac/clapack/SRC/ilaenv.c
index 84f980630..2eb991381 100644
--- a/src/lib/yac/clapack/SRC/ilaenv.c
+++ b/src/lib/yac/clapack/SRC/ilaenv.c
@@ -37,13 +37,14 @@ integer ilaenv_(integer *ispec, char *name__, char *opts, integer *n1,
/* Local variables */
integer i__;
- char c1[1], c2[1], c3[1], c4[1];
+ // 2025/02/17 US: fix stack overflow
+ char c1[4], c2[4], c3[4], c4[4];
integer ic, nb, iz, nx;
logical cname;
integer nbmin;
logical sname;
extern integer ieeeck_(integer *, real *, real *);
- char subnam[1];
+ char subnam[4];
extern integer iparmq_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
--
GitLab
From 57b0faeb56d76faa917129dd7a99e7c59518d6ba Mon Sep 17 00:00:00 2001
From: Uwe Schulzweida <uwe.schulzweida@mpimet.mpg.de>
Date: Mon, 17 Feb 2025 14:13:28 +0100
Subject: [PATCH 4/5] knndata: changed type of m_srcCoords to
std::unique_ptr<double[][3]>
---
src/knndata.cc | 5 +----
src/knndata.h | 11 +++++++----
src/lib/CMakeLists.txt | 2 +-
src/pointsearch_healpix.h | 4 ++--
src/pointsearch_reg2d.cc | 11 ++++++-----
src/pointsearch_reg2d.h | 2 +-
src/remap_point_search.cc | 8 ++++----
7 files changed, 22 insertions(+), 21 deletions(-)
diff --git a/src/knndata.cc b/src/knndata.cc
index cbb4a43c3..4c7f3b4a8 100644
--- a/src/knndata.cc
+++ b/src/knndata.cc
@@ -188,9 +188,6 @@ size_t
KnnData::compute_weights_rbf()
{
size_t n = m_numNeighbors;
- double tgt_coord[3];
- yac_coordinate_pointer src_coords = nullptr;
- double *weights = nullptr;
- yac_compute_weights_rbf(tgt_coord, src_coords, n, weights, m_rbfScale);
+ yac_compute_weights_rbf(m_tgtCoord, m_srcCoords.get(), n, m_dist.data(), m_rbfScale);
return n;
}
diff --git a/src/knndata.h b/src/knndata.h
index 8000c0a09..9f4f55632 100644
--- a/src/knndata.h
+++ b/src/knndata.h
@@ -75,8 +75,9 @@ public:
std::vector<double> m_dist; // angular distance four nearest neighbors
std::vector<size_t> m_tmpIndices;
std::vector<double> m_tmpDist;
- std::vector<std::array<double, 3>> m_srcCoords;
- std::unique_ptr<double[][3]> xm_srcCoords;
+ std::unique_ptr<double[][3]> m_srcCoords;
+ double m_tgtCoord[3];
+ bool m_needCoords{ false };
inline void
init()
@@ -85,7 +86,8 @@ public:
m_dist.resize(m_maxNeighbors);
// check some more points if distance is the same use the smaller index
m_maxPoints = (m_maxNeighbors > 8) ? m_maxNeighbors + 8 : m_maxNeighbors * 2;
- if (m_weighted == WeightingMethod::gaussWeighted) { xm_srcCoords = std::make_unique<double[][3]>(m_maxPoints); }
+ m_needCoords = (m_weighted == WeightingMethod::gaussWeighted || m_weighted == WeightingMethod::rbf);
+ if (m_needCoords) { m_srcCoords = std::make_unique<double[][3]>(m_maxPoints); }
}
explicit KnnData(KnnParams knnParams)
@@ -112,11 +114,12 @@ public:
m_searchRadius = other.m_searchRadius;
m_weight0 = other.m_weight0;
m_weightR = other.m_weightR;
+ m_needCoords = other.m_needCoords;
m_maxPoints = other.m_maxPoints;
m_indices = std::move(other.m_indices);
m_dist = std::move(other.m_dist);
- xm_srcCoords = std::move(other.xm_srcCoords);
+ m_srcCoords = std::move(other.m_srcCoords);
}
~KnnData() {}
diff --git a/src/lib/CMakeLists.txt b/src/lib/CMakeLists.txt
index 2d3ddf07a..16dd50381 100644
--- a/src/lib/CMakeLists.txt
+++ b/src/lib/CMakeLists.txt
@@ -1,3 +1,3 @@
add_subdirectory(gradsdes)
add_subdirectory(healpix)
-add_subdirectory(yac)
+add_subdirectory(yac/src)
diff --git a/src/pointsearch_healpix.h b/src/pointsearch_healpix.h
index 23b106c67..59462247a 100644
--- a/src/pointsearch_healpix.h
+++ b/src/pointsearch_healpix.h
@@ -55,10 +55,10 @@ public:
store_distance_healpix(searchRadius, pointLL, knnData, numIndices, indices, lons, lats);
- if (knnData.m_weighted == WeightingMethod::gaussWeighted)
+ if (knnData.m_needCoords)
{
+ gcLLtoXYZ(pointLL.get_lon(), pointLL.get_lat(), knnData.m_tgtCoord);
auto numNeighbors = knnData.m_numNeighbors;
- if (numNeighbors > knnData.m_srcCoords.size()) knnData.m_srcCoords.resize(numNeighbors);
for (size_t i = 0; i < numNeighbors; ++i)
{
double lon, lat;
diff --git a/src/pointsearch_reg2d.cc b/src/pointsearch_reg2d.cc
index e68d695b7..25bcdb64a 100644
--- a/src/pointsearch_reg2d.cc
+++ b/src/pointsearch_reg2d.cc
@@ -8,6 +8,7 @@
#include "cdo_math.h"
#include "knndata.h"
#include "pointsearch_reg2d.h"
+#include <cmath>
static size_t
fill_src_indices(bool isCyclic, long nx, long ny, long ii, long jj, long k, size_t *psrcIndices)
@@ -41,7 +42,7 @@ fill_src_indices(bool isCyclic, long nx, long ny, long ii, long jj, long k, size
}
void
-PointsearchReg2d::compute_point(size_t index, std::array<double, 3> &xyz)
+PointsearchReg2d::compute_point(size_t index, double_t (&xyz)[3])
{
auto iy = index / m_nx;
auto ix = index - iy * m_nx;
@@ -54,11 +55,11 @@ void
PointsearchReg2d::store_distance_reg2d(double plon, double plat, KnnData &knnData, size_t numIndices, size_t *indices,
double *distances, double searchRadius)
{
- std::array<double, 3> tgtCoord;
+ double tgtCoord[3];
gcLLtoXYZ(plon, plat, tgtCoord);
auto sqrSearchRadius = cdo::sqr(searchRadius);
- std::array<double, 3> srcCoord;
+ double srcCoord[3];
size_t numWeights = 0;
for (size_t i = 0; i < numIndices; ++i)
{
@@ -79,10 +80,10 @@ PointsearchReg2d::store_distance_reg2d(double plon, double plat, KnnData &knnDat
knnData.check_distance();
- if (knnData.m_weighted == WeightingMethod::gaussWeighted)
+ if (knnData.m_needCoords)
{
+ gcLLtoXYZ(plon, plat, knnData.m_tgtCoord);
auto numNeighbors = knnData.m_numNeighbors;
- if (numNeighbors > knnData.m_srcCoords.size()) knnData.m_srcCoords.resize(numNeighbors);
for (size_t i = 0; i < numNeighbors; ++i) { compute_point(knnData.m_indices[i], knnData.m_srcCoords[i]); }
}
}
diff --git a/src/pointsearch_reg2d.h b/src/pointsearch_reg2d.h
index ad531cf58..55fd37781 100644
--- a/src/pointsearch_reg2d.h
+++ b/src/pointsearch_reg2d.h
@@ -75,7 +75,7 @@ private:
Varray<double> m_cosLats, m_sinLats; // cosine, sine of grid lats (for distance)
Varray<double> m_cosLons, m_sinLons; // cosine, sine of grid lons (for distance)
- void compute_point(size_t index, std::array<double, 3> &xyz);
+ void compute_point(size_t index, double (&xyz)[3]);
};
#endif
diff --git a/src/remap_point_search.cc b/src/remap_point_search.cc
index 85990cbfd..d15d665dc 100644
--- a/src/remap_point_search.cc
+++ b/src/remap_point_search.cc
@@ -131,10 +131,10 @@ grid_search_point_unstruct(GridPointsearch &gps, const PointLonLat &pointLL, Knn
knnData.check_distance();
- if (knnData.m_weighted == WeightingMethod::gaussWeighted)
+ if (knnData.m_needCoords)
{
+ gcLLtoXYZ(pointLL.get_lon(), pointLL.get_lat(), knnData.m_tgtCoord);
numNeighbors = knnData.m_numNeighbors;
- if (numNeighbors > knnData.m_srcCoords.size()) knnData.m_srcCoords.resize(numNeighbors);
for (size_t i = 0; i < numNeighbors; ++i)
{
gcLLtoXYZ(gps.plons[knnData.m_indices[i]], gps.plats[knnData.m_indices[i]], knnData.m_srcCoords[i]);
@@ -191,10 +191,10 @@ grid_search_point_smooth(GridPointsearch &gps, const PointLonLat &pointLL, KnnDa
knnData.check_distance();
- if (knnData.m_weighted == WeightingMethod::gaussWeighted)
+ if (knnData.m_needCoords)
{
+ gcLLtoXYZ(pointLL.get_lon(), pointLL.get_lat(), knnData.m_tgtCoord);
numNeighbors = knnData.m_numNeighbors;
- if (numNeighbors > knnData.m_srcCoords.size()) knnData.m_srcCoords.resize(numNeighbors);
for (size_t i = 0; i < numNeighbors; ++i)
{
gcLLtoXYZ(gps.plons[knnData.m_indices[i]], gps.plats[knnData.m_indices[i]], knnData.m_srcCoords[i]);
--
GitLab
From 548bcb96e749d8e426c93b8d6b1c7dd16436c102 Mon Sep 17 00:00:00 2001
From: Uwe Schulzweida <uwe.schulzweida@mpimet.mpg.de>
Date: Mon, 17 Feb 2025 19:58:56 +0100
Subject: [PATCH 5/5] Smooth: added weighting method gaussWeighted
---
src/Remapgrid.cc | 11 ++++++-----
src/Smooth.cc | 40 +++++++++++++++++++++++-----------------
2 files changed, 29 insertions(+), 22 deletions(-)
diff --git a/src/Remapgrid.cc b/src/Remapgrid.cc
index 3f06af9cc..b47676ef4 100644
--- a/src/Remapgrid.cc
+++ b/src/Remapgrid.cc
@@ -304,6 +304,7 @@ RemapknnParams
remapknn_get_parameter()
{
RemapknnParams params;
+ auto &knnParams = params.knnParams;
auto pargc = cdo_operator_argc();
if (pargc)
@@ -323,11 +324,11 @@ remapknn_get_parameter()
const auto &value = kv.values[0];
// clang-format off
- if (key == "k") params.knnParams.k = parameter_to_int(value);
- else if (key == "kmin") params.knnParams.kMin = parameter_to_int(value);
- else if (key == "weighted") params.knnParams.weighted = string_to_weightingMethod(parameter_to_word(value));
- else if (key == "gauss_scale") params.knnParams.gaussScale = parameter_to_double(value);
- else if (key == "extrapolate") params.knnParams.extrapolate = parameter_to_bool(value);
+ if (key == "k") knnParams.k = parameter_to_int(value);
+ else if (key == "kmin") knnParams.kMin = parameter_to_int(value);
+ else if (key == "weighted") knnParams.weighted = string_to_weightingMethod(parameter_to_word(value));
+ else if (key == "gauss_scale") knnParams.gaussScale = parameter_to_double(value);
+ else if (key == "extrapolate") knnParams.extrapolate = parameter_to_bool(value);
else if (key == "grid") params.gridString = parameter_to_word(value);
else cdo_abort("Invalid parameter key >%s<!", key);
// clang-format on
diff --git a/src/Smooth.cc b/src/Smooth.cc
index 90bc4af42..ea16d7114 100644
--- a/src/Smooth.cc
+++ b/src/Smooth.cc
@@ -33,10 +33,15 @@ struct SmoothPoint
{
double arc_radius{ 0.0 };
double radius{ 1.0 };
- double weight0{ 0.25 };
- double weightR{ 0.25 };
size_t maxpoints{ SIZE_MAX };
- WeightingMethod weighted{ WeightingMethod::linear };
+ KnnParams knnParams;
+
+ SmoothPoint()
+ {
+ knnParams.weighted = WeightingMethod::linear;
+ knnParams.weight0 = 0.25;
+ knnParams.weightR = 0.25;
+ }
};
template <typename T1, typename T2>
@@ -63,13 +68,10 @@ smooth(int gridID, double mv, const Varray<T1> &array1, Varray<T2> &array2, cons
cdo_grid_to_radian(gridID, CDI_XAXIS, xvals, "grid center lon");
cdo_grid_to_radian(gridID, CDI_YAXIS, yvals, "grid center lat");
- KnnParams knnParams;
+ auto knnParams = spoint.knnParams;
knnParams.k = numNeighbors;
knnParams.kMin = 1;
- knnParams.weighted = spoint.weighted;
knnParams.searchRadius = spoint.radius;
- knnParams.weight0 = spoint.weight0;
- knnParams.weightR = spoint.weightR;
std::vector<KnnData> knnDataList;
for (int i = 0; i < Threading::ompNumMaxThreads; ++i) knnDataList.emplace_back(knnParams);
@@ -240,6 +242,7 @@ radiusDegToKm(double radiusInDeg)
static void
get_parameter(int &xnsmooth, SmoothPoint &spoint)
{
+ auto &knnParams = spoint.knnParams;
auto pargc = cdo_operator_argc();
if (pargc)
{
@@ -258,13 +261,14 @@ get_parameter(int &xnsmooth, SmoothPoint &spoint)
const auto &value = kv.values[0];
// clang-format off
- if (key == "nsmooth") xnsmooth = parameter_to_int(value);
- else if (key == "maxpoints") spoint.maxpoints = parameter_to_size_t(value);
- else if (key == "weight0") spoint.weight0 = parameter_to_double(value);
- else if (key == "weightR") spoint.weightR = parameter_to_double(value);
- else if (key == "radius") spoint.radius = radius_str_to_deg(value);
- else if (key == "arc_radius") spoint.arc_radius = radius_str_to_deg(value);
- else if (key == "weighted") spoint.weighted = string_to_weightingMethod(parameter_to_word(value));
+ if (key == "nsmooth") xnsmooth = parameter_to_int(value);
+ else if (key == "maxpoints") spoint.maxpoints = parameter_to_size_t(value);
+ else if (key == "radius") spoint.radius = radius_str_to_deg(value);
+ else if (key == "arc_radius") spoint.arc_radius = radius_str_to_deg(value);
+ else if (key == "weighted") knnParams.weighted = string_to_weightingMethod(parameter_to_word(value));
+ else if (key == "gauss_scale") knnParams.gaussScale = parameter_to_double(value);
+ else if (key == "weight0") knnParams.weight0 = parameter_to_double(value);
+ else if (key == "weightR") knnParams.weightR = parameter_to_double(value);
else cdo_abort("Invalid parameter key >%s<!", key);
// clang-format on
}
@@ -272,8 +276,9 @@ get_parameter(int &xnsmooth, SmoothPoint &spoint)
}
static void
-print_parameter(const SmoothPoint &sp)
+print_parameter(SmoothPoint const &sp)
{
+ auto const &kp = sp.knnParams;
std::stringstream outbuffer;
if (sp.arc_radius > 0.0)
@@ -282,8 +287,9 @@ print_parameter(const SmoothPoint &sp)
outbuffer << "radius=" << sp.radius << "deg(" << radiusDegToKm(sp.radius) << "km)";
outbuffer << ", maxpoints=" << sp.maxpoints;
- outbuffer << ", weighted=" << weightingMethod_to_string(sp.weighted);
- if (sp.weighted == WeightingMethod::linear) outbuffer << ", weight0=" << sp.weight0 << ", weightR=" << sp.weightR;
+ outbuffer << ", weighted=" << weightingMethod_to_string(kp.weighted);
+ if (kp.weighted == WeightingMethod::linear) outbuffer << ", weight0=" << kp.weight0 << ", weightR=" << kp.weightR;
+ if (kp.weighted == WeightingMethod::gaussWeighted) outbuffer << ", gauss_scale=" << kp.gaussScale;
cdo_print("%s", outbuffer.str());
}
--
GitLab