diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml index 713bbf64..fafd897c 100644 --- a/.pre-commit-config.yaml +++ b/.pre-commit-config.yaml @@ -1,3 +1,4 @@ +exclude: (^integration_tests) default_language_version: python: "3.12" repos: diff --git a/CHANGELOG.md b/CHANGELOG.md index 8ee49173..17c20d6e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,18 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.30.0] - 2024/10/15 + +### Changed + +- Changed how build dependencies "numpy" and "scipy" is handled. + Previously, if a package depends on "numpy" or "scipy", the build system would + not install those packages. Instead, it pointed to the pre-built packages that pyodide-build provides. + This caused some issues when the package relies on some tools that are not available in the pre-built packages. + Now, the build system will install the "numpy" and "scipy" during the build process, but replace some of the + files with the pre-built ones to make sure the target platform is compatible to WebAssembly. + [#21](https://github.com/pyodide/pyodide-build/pull/21) + ## [0.29.0] - 2024/09/19 ### Added diff --git a/integration_tests/recipes/libf2c/extras/make.inc b/integration_tests/recipes/libf2c/extras/make.inc new file mode 100644 index 00000000..7eaae7b5 --- /dev/null +++ b/integration_tests/recipes/libf2c/extras/make.inc @@ -0,0 +1,80 @@ +# -*- Makefile -*- +#################################################################### +# LAPACK make include file. # +# LAPACK, Version 3.2.1 # +# June 2009 # +#################################################################### +# +# See the INSTALL/ directory for more examples. +# +SHELL = /usr/bin/env sh +# +# The machine (platform) identifier to append to the library names +# +# WA for WebAssembly +PLAT = _WA +# +# Modify the FORTRAN and OPTS definitions to refer to the +# compiler and desired compiler options for your machine. NOOPT +# refers to the compiler options desired when NO OPTIMIZATION is +# selected. Define LOADER and LOADOPTS to refer to the loader +# and desired load options for your machine. +# +####################################################### +# This is used to compile C library +#CC = gcc # inherit $CC from emmake +# if no wrapping of the blas library is needed, uncomment next line +#CC = gcc -DNO_BLAS_WRAP +CFLAGS = -O3 -I$(TOPDIR)/INCLUDE -fPIC -DNO_BLAS_WRAP +LDFLAGS = -O3 +LOADER = $(CC) +LOADOPTS = +NOOPT = -O0 -I$(TOPDIR)/INCLUDE -fPIC +DRVCFLAGS = $(CFLAGS) +F2CCFLAGS = $(CFLAGS) +####################################################################### + +# +# Timer for the SECOND and DSECND routines +# +# Default : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME +# TIMER = EXT_ETIME +# For RS6K : SECOND and DSECND will use a call to the EXTERNAL FUNCTION ETIME_ +# TIMER = EXT_ETIME_ +# For gfortran compiler: SECOND and DSECND will use a call to the INTERNAL FUNCTION ETIME +# TIMER = INT_ETIME +# If your Fortran compiler does not provide etime (like Nag Fortran Compiler, etc...) +# SECOND and DSECND will use a call to the Fortran standard INTERNAL FUNCTION CPU_TIME +TIMER = INT_CPU_TIME +# If neither of this works...you can use the NONE value... In that case, SECOND and DSECND will always return 0 +# TIMER = NONE +# +# The archiver and the flag(s) to use when building archive (library) +# If you system has no ranlib, set RANLIB = echo. +# +ARCH = $(AR) +ARCHFLAGS= cr +#RANLIB = ranlib +# +# The location of BLAS library for linking the testing programs. +# The target's machine-specific, optimized BLAS library should be +# used whenever possible. +# +BLASLIB = ../../blas$(PLAT).a +# +# Location of the extended-precision BLAS (XBLAS) Fortran library +# used for building and testing extended-precision routines. The +# relevant routines will be compiled and XBLAS will be linked only if +# USEXBLAS is defined. +# +# USEXBLAS = Yes +XBLASLIB = +# XBLASLIB = -lxblas +# +# Names of generated libraries. +# +LAPACKLIB = lapack$(PLAT).a +F2CLIB = ../../F2CLIBS/libf2c.a +TMGLIB = tmglib$(PLAT).a +EIGSRCLIB = eigsrc$(PLAT).a +LINSRCLIB = linsrc$(PLAT).a diff --git a/integration_tests/recipes/libf2c/meta.yaml b/integration_tests/recipes/libf2c/meta.yaml new file mode 100644 index 00000000..45858b5a --- /dev/null +++ b/integration_tests/recipes/libf2c/meta.yaml @@ -0,0 +1,46 @@ +# We still download the full CLAPACK but we are only using the libf2c part of CLAPACK. +# libf2c part is needed for the f2ced Fortran files in scipy for example to +# define things like pow_dd, i_len, etc... +# +# Note f2clib package only creates f2clib.a, and f2clib.a symbols are added to +# libopenblas.so in the OpenBLAS meta.yaml. +package: + name: libf2c + version: CLAPACK-3.2.1 + tag: + - library +source: + sha256: 6dc4c382164beec8aaed8fd2acc36ad24232c406eda6db462bd4c41d5e455fac + url: http://www.netlib.org/clapack/clapack.tgz + extract_dir: CLAPACK-3.2.1 + patches: + - patches/0001-fix-arith.h.patch + - patches/0002-fix-f2clibs-build.patch + - patches/0003-remove-redundant-symbols.patch + - patches/0004-correct-return-types.patch + - patches/0005-Remove-symbols-defined-in-OpenBLAS.patch + # In CLAPACK's F2CLIBS/libf2c Makefile, some commands are mistakenly (?) hardcoded + # instead of using the right variables + - patches/0006-adjust-ld-ar-ranlib.patch + - patches/0007-add-singlecomplex.patch + + extras: + - [extras/make.inc, make.inc] + +build: + type: static_library + script: | + # The archive's contents have default permission 0750. If we use docker + # to build, then we will not own the contents in the host, which means + # we cannot navigate into the folder. Setting it to 0750 makes it + # easier to debug. + chmod -R o+rx . + + ARCH="emar" \ + emmake make -j ${PYODIDE_JOBS:-3} f2clib + mkdir -p ${WASM_LIBRARY_DIR}/{lib,include} + cp INCLUDE/f2c.h ${WASM_LIBRARY_DIR}/include + cp F2CLIBS/libf2c.a ${WASM_LIBRARY_DIR}/lib +about: + home: https://www.netlib.org/clapack/ + license: BSD-3-Clause diff --git a/integration_tests/recipes/libf2c/patches/0001-fix-arith.h.patch b/integration_tests/recipes/libf2c/patches/0001-fix-arith.h.patch new file mode 100644 index 00000000..7773825a --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0001-fix-arith.h.patch @@ -0,0 +1,30 @@ +From 01990867ee7a641078505efba367a413a97f7802 Mon Sep 17 00:00:00 2001 +From: Michael Droettboom +Date: Fri, 18 Mar 2022 19:59:25 -0700 +Subject: [PATCH 1/5] fix arith.h + +arith.h is a file generated at build time by compiling and running a C program. +Since we use emscripten to build throughout, the C program becomes a wasm file +and we call it differently. +--- + F2CLIBS/libf2c/Makefile | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/F2CLIBS/libf2c/Makefile b/F2CLIBS/libf2c/Makefile +index 0a3ed0d..a473ed8 100644 +--- a/F2CLIBS/libf2c/Makefile ++++ b/F2CLIBS/libf2c/Makefile +@@ -173,8 +173,8 @@ xwsne.o: fmt.h + arith.h: arithchk.c + $(CC) $(CFLAGS) -DNO_FPINIT arithchk.c -lm ||\ + $(CC) -DNO_LONG_LONG $(CFLAGS) -DNO_FPINIT arithchk.c -lm +- ./a.out >arith.h +- rm -f a.out arithchk.o ++ node a.out.js >arith.h ++ rm -f a.out.js a.out.wasm + + check: + xsum Notice README abort_.c arithchk.c backspac.c c_abs.c c_cos.c \ +-- +2.25.1 + diff --git a/integration_tests/recipes/libf2c/patches/0002-fix-f2clibs-build.patch b/integration_tests/recipes/libf2c/patches/0002-fix-f2clibs-build.patch new file mode 100644 index 00000000..89d94e5d --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0002-fix-f2clibs-build.patch @@ -0,0 +1,31 @@ +From d88133066f9f6312145c1186116fdb6446d3f7a5 Mon Sep 17 00:00:00 2001 +From: Michael Droettboom +Date: Fri, 18 Mar 2022 20:00:51 -0700 +Subject: [PATCH 2/5] fix f2clibs build + +emscripten produces LLVM bitcode here, not genuine object files, so it doesn't +make sense to strip symbols. + +(It would also fail because emcc uses the file extension to determine what kind +of object to output, and .xxx is not a recognized extension; this is the error +message you would receive if you try to run the commands) +--- + F2CLIBS/libf2c/Makefile | 2 -- + 1 file changed, 2 deletions(-) + +diff --git a/F2CLIBS/libf2c/Makefile b/F2CLIBS/libf2c/Makefile +index a473ed8..e51d826 100644 +--- a/F2CLIBS/libf2c/Makefile ++++ b/F2CLIBS/libf2c/Makefile +@@ -19,8 +19,6 @@ include ../../make.inc + # compile, then strip unnecessary symbols + .c.o: + $(CC) -c -DSkip_f2c_Undefs $(CFLAGS) $*.c +- ld -r -x -o $*.xxx $*.o +- mv $*.xxx $*.o + ## Under Solaris (and other systems that do not understand ld -x), + ## omit -x in the ld line above. + ## If your system does not have the ld command, comment out +-- +2.25.1 + diff --git a/integration_tests/recipes/libf2c/patches/0003-remove-redundant-symbols.patch b/integration_tests/recipes/libf2c/patches/0003-remove-redundant-symbols.patch new file mode 100644 index 00000000..bfd7257f --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0003-remove-redundant-symbols.patch @@ -0,0 +1,34 @@ +From 78ff0cec961d9eb4e94193995fe151e1ecdae9df Mon Sep 17 00:00:00 2001 +From: Roman Yurchak +Date: Fri, 18 Mar 2022 20:01:39 -0700 +Subject: [PATCH 3/5] remove redundant symbols + +Remove a few symbols from LAPACK that are redundantly defined with BLAS or are +ported in scipy. It wouldn't be an issue if we were linking dynamically, but +because of static linking otherwise we get errors at link time about symbols +defined twice. + + - Roman Yurchak (https://github.com/pyodide/pyodide/pull/238) +--- + SRC/Makefile | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/SRC/Makefile b/SRC/Makefile +index 5f1eb22..32e669b 100644 +--- a/SRC/Makefile ++++ b/SRC/Makefile +@@ -48,9 +48,9 @@ include ../make.inc + # + ####################################################################### + +-ALLAUX = maxloc.o ilaenv.o ieeeck.o lsamen.o xerbla.o xerbla_array.o iparmq.o \ ++ALLAUX = maxloc.o ilaenv.o ieeeck.o lsamen.o iparmq.o \ + ilaprec.o ilatrans.o ilauplo.o iladiag.o chla_transtype.o \ +- ../INSTALL/ilaver.o ../INSTALL/lsame.o ++ ../INSTALL/ilaver.o + + ALLXAUX = + +-- +2.25.1 + diff --git a/integration_tests/recipes/libf2c/patches/0004-correct-return-types.patch b/integration_tests/recipes/libf2c/patches/0004-correct-return-types.patch new file mode 100644 index 00000000..5d95f705 --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0004-correct-return-types.patch @@ -0,0 +1,81 @@ +From 572a3e20ba040b4f29bbef97a9db6658c10077d3 Mon Sep 17 00:00:00 2001 +From: Joe Marshall +Date: Fri, 18 Mar 2022 20:02:42 -0700 +Subject: [PATCH 4/5] correct return types + +Make return types to fortran subroutines consistently be int. Some functions are defined within clapack as variously +void and int return. Normal C compilers don't care, but emscripten is strict about return values. +--- + F2CLIBS/libf2c/ef1asc_.c | 2 +- + F2CLIBS/libf2c/f2ch.add | 4 ++-- + F2CLIBS/libf2c/s_cat.c | 6 +++--- + F2CLIBS/libf2c/s_copy.c | 4 ++-- + 4 files changed, 8 insertions(+), 8 deletions(-) + +diff --git a/F2CLIBS/libf2c/ef1asc_.c b/F2CLIBS/libf2c/ef1asc_.c +index 70be0bc..b2a82a2 100644 +--- a/F2CLIBS/libf2c/ef1asc_.c ++++ b/F2CLIBS/libf2c/ef1asc_.c +@@ -13,7 +13,7 @@ extern "C" { + extern VOID s_copy(); + ef1asc_(a, la, b, lb) ftnint *a, *b; ftnlen *la, *lb; + #else +-extern void s_copy(char*,char*,ftnlen,ftnlen); ++extern int s_copy(char*,char*,ftnlen,ftnlen); + int ef1asc_(ftnint *a, ftnlen *la, ftnint *b, ftnlen *lb) + #endif + { +diff --git a/F2CLIBS/libf2c/f2ch.add b/F2CLIBS/libf2c/f2ch.add +index a2acc17..f3f0466 100644 +--- a/F2CLIBS/libf2c/f2ch.add ++++ b/F2CLIBS/libf2c/f2ch.add +@@ -124,9 +124,9 @@ extern double r_sinh(float *); + extern double r_sqrt(float *); + extern double r_tan(float *); + extern double r_tanh(float *); +-extern void s_cat(char *, char **, integer *, integer *, ftnlen); ++extern int s_cat(char *, char **, integer *, integer *, ftnlen); + extern integer s_cmp(char *, char *, ftnlen, ftnlen); +-extern void s_copy(char *, char *, ftnlen, ftnlen); ++extern int s_copy(char *, char *, ftnlen, ftnlen); + extern int s_paus(char *, ftnlen); + extern integer s_rdfe(cilist *); + extern integer s_rdue(cilist *); +diff --git a/F2CLIBS/libf2c/s_cat.c b/F2CLIBS/libf2c/s_cat.c +index 8d92a63..54c4ff1 100644 +--- a/F2CLIBS/libf2c/s_cat.c ++++ b/F2CLIBS/libf2c/s_cat.c +@@ -28,11 +28,11 @@ extern + extern "C" { + #endif + +- VOID ++ + #ifdef KR_headers +-s_cat(lp, rpp, rnp, np, ll) char *lp, *rpp[]; ftnint rnp[], *np; ftnlen ll; ++int 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) ++int s_cat(char *lp, char *rpp[], ftnint rnp[], ftnint *np, ftnlen ll) + #endif + { + ftnlen i, nc; +diff --git a/F2CLIBS/libf2c/s_copy.c b/F2CLIBS/libf2c/s_copy.c +index 9dacfc7..8d8963f 100644 +--- a/F2CLIBS/libf2c/s_copy.c ++++ b/F2CLIBS/libf2c/s_copy.c +@@ -12,9 +12,9 @@ extern "C" { + /* assign strings: a = b */ + + #ifdef KR_headers +-VOID s_copy(a, b, la, lb) register char *a, *b; ftnlen la, lb; ++int 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) ++int s_copy(register char *a, register char *b, ftnlen la, ftnlen lb) + #endif + { + register char *aend, *bend; +-- +2.25.1 + diff --git a/integration_tests/recipes/libf2c/patches/0005-Remove-symbols-defined-in-OpenBLAS.patch b/integration_tests/recipes/libf2c/patches/0005-Remove-symbols-defined-in-OpenBLAS.patch new file mode 100644 index 00000000..7dce211b --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0005-Remove-symbols-defined-in-OpenBLAS.patch @@ -0,0 +1,27 @@ +From eaf5c5db6e956036869255cb51831e720474d01d Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Lo=C3=AFc=20Est=C3=A8ve?= +Date: Fri, 7 Apr 2023 15:20:18 +0200 +Subject: [PATCH 5/5] Remove symbols defined in OpenBLAS + +--- + F2CLIBS/libf2c/Makefile | 4 ++-- + 1 file changed, 2 insertions(+), 2 deletions(-) + +diff --git a/F2CLIBS/libf2c/Makefile b/F2CLIBS/libf2c/Makefile +index 57eff0d..136050f 100644 +--- a/F2CLIBS/libf2c/Makefile ++++ b/F2CLIBS/libf2c/Makefile +@@ -31,8 +31,8 @@ MISC = f77vers.o i77vers.o main.o s_rnge.o abort_.o exit_.o getarg_.o iargc_.o\ + getenv_.o signal_.o s_stop.o s_paus.o system_.o cabs.o ctype.o\ + derf_.o derfc_.o erf_.o erfc_.o sig_die.o uninit.o + POW = pow_ci.o pow_dd.o pow_di.o pow_hh.o pow_ii.o pow_ri.o pow_zi.o pow_zz.o +-CX = c_abs.o c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o +-DCX = z_abs.o z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o ++CX = c_cos.o c_div.o c_exp.o c_log.o c_sin.o c_sqrt.o ++DCX = z_cos.o z_div.o z_exp.o z_log.o z_sin.o z_sqrt.o + REAL = r_abs.o r_acos.o r_asin.o r_atan.o r_atn2.o r_cnjg.o r_cos.o\ + r_cosh.o r_dim.o r_exp.o r_imag.o r_int.o\ + r_lg10.o r_log.o r_mod.o r_nint.o r_sign.o\ +-- +2.34.1 + diff --git a/integration_tests/recipes/libf2c/patches/0006-adjust-ld-ar-ranlib.patch b/integration_tests/recipes/libf2c/patches/0006-adjust-ld-ar-ranlib.patch new file mode 100644 index 00000000..336f3761 --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0006-adjust-ld-ar-ranlib.patch @@ -0,0 +1,33 @@ +Index: CLAPACK-3.2.1/F2CLIBS/libf2c/Makefile +=================================================================== +--- CLAPACK-3.2.1.orig/F2CLIBS/libf2c/Makefile ++++ CLAPACK-3.2.1/F2CLIBS/libf2c/Makefile +@@ -70,8 +70,8 @@ OFILES = $(MISC) $(POW) $(CX) $(DCX) $(R + all: f2c.h signal1.h sysdep1.h libf2c.a clapack_install + + libf2c.a: $(OFILES) +- ar r libf2c.a $? +- -ranlib libf2c.a ++ $(ARCH) r libf2c.a $? ++ $(RANLIB) libf2c.a + + ## Shared-library variant: the following rule works on Linux + ## systems. Details are system-dependent. Under Linux, -fPIC +@@ -80,7 +80,7 @@ libf2c.a: $(OFILES) + ## of "cc -shared". + + libf2c.so: $(OFILES) +- cc -shared -o libf2c.so $(OFILES) ++ $(CC) -shared -o libf2c.so $(OFILES) + + ### If your system lacks ranlib, you don't need it; see README. + +@@ -117,7 +117,7 @@ sysdep1.h: sysdep1.h0 + + install: libf2c.a + cp libf2c.a $(LIBDIR) +- -ranlib $(LIBDIR)/libf2c.a ++ $(RANLIB) $(LIBDIR)/libf2c.a + + clapack_install: libf2c.a + mv libf2c.a .. diff --git a/integration_tests/recipes/libf2c/patches/0007-add-singlecomplex.patch b/integration_tests/recipes/libf2c/patches/0007-add-singlecomplex.patch new file mode 100644 index 00000000..982d3065 --- /dev/null +++ b/integration_tests/recipes/libf2c/patches/0007-add-singlecomplex.patch @@ -0,0 +1,10 @@ +--- a/INCLUDE/f2c.h ++++ b/INCLUDE/f2c.h +@@ -14,6 +14,7 @@ typedef short int shortint; + typedef float real; + typedef double doublereal; + typedef struct { real r, i; } complex; ++typedef struct { real r, i; } singlecomplex; + typedef struct { doublereal r, i; } doublecomplex; + typedef long int logical; + typedef short int shortlogical; diff --git a/integration_tests/recipes/numpy/meta.yaml b/integration_tests/recipes/numpy/meta.yaml index 9c3a8fee..3c1fdf81 100644 --- a/integration_tests/recipes/numpy/meta.yaml +++ b/integration_tests/recipes/numpy/meta.yaml @@ -30,4 +30,4 @@ about: home: https://www.numpy.org PyPI: https://pypi.org/project/numpy summary: NumPy is the fundamental package for array computing with Python. - license: BSD + license: BSD-3-Clause diff --git a/integration_tests/recipes/numpy/test_numpy.py b/integration_tests/recipes/numpy/test_numpy.py new file mode 100644 index 00000000..c446b936 --- /dev/null +++ b/integration_tests/recipes/numpy/test_numpy.py @@ -0,0 +1,364 @@ +import pytest +from pytest_pyodide import run_in_pyodide + + +def test_numpy(selenium): + selenium.load_package("numpy") + selenium.run( + """ + import numpy + x = numpy.ones((32, 64)) + """ + ) + selenium.run_js( + """ + let xpy = pyodide.runPython('x'); + self.x = xpy.toJs(); + xpy.destroy(); + """ + ) + assert selenium.run_js("return x.length === 32") + for i in range(32): + assert selenium.run_js(f"return x[{i}].length == 64") + for j in range(64): + assert selenium.run_js(f"return x[{i}][{j}] == 1") + + +def test_typed_arrays(selenium): + selenium.load_package("numpy") + selenium.run("import numpy") + for jstype, npytype in ( + ("Int8Array", "int8"), + ("Uint8Array", "uint8"), + ("Uint8ClampedArray", "uint8"), + ("Int16Array", "int16"), + ("Uint16Array", "uint16"), + ("Int32Array", "int32"), + ("Uint32Array", "uint32"), + ("Float32Array", "float32"), + ("Float64Array", "float64"), + ): + selenium.run_js(f"self.array = new {jstype}([1, 2, 3, 4]);\n") + assert selenium.run( + "from js import array\n" + "npyarray = numpy.asarray(array.to_py())\n" + f'npyarray.dtype.name == "{npytype}" ' + "and npyarray == [1, 2, 3, 4]" + ) + + +@pytest.mark.skip_pyproxy_check +@pytest.mark.parametrize("order", ("C", "F")) +@pytest.mark.parametrize( + "dtype", + ( + "int8", + "uint8", + "int16", + "uint16", + "int32", + "uint32", + "int64", + "uint64", + "float32", + "float64", + ), +) +def test_python2js_numpy_dtype(selenium, order, dtype): + selenium.load_package("numpy") + selenium.run("import numpy as np") + + expected_result = [[[0, 1], [2, 3]], [[4, 5], [6, 7]]] + + def assert_equal(): + # We have to do this an element at a time, since the Selenium driver + # for Firefox does not convert TypedArrays to Python correctly + for i in range(2): + for j in range(2): + for k in range(2): + assert ( + selenium.run_js( + f"return Number(pyodide.globals.get('x').toJs()[{i}][{j}][{k}])" + ) + == expected_result[i][j][k] + ) + + selenium.run( + f""" + x = np.arange(8, dtype=np.{dtype}) + x = x.reshape((2, 2, 2)) + x = x.copy({order!r}) + """ + ) + assert_equal() + classname = selenium.run_js( + "return pyodide.globals.get('x').toJs()[0][0].constructor.name" + ) + # We expect a TypedArray subclass, such as Uint8Array, but not a plain-old + # Array + assert classname.endswith("Array") + assert classname != "Array" + selenium.run( + """ + x = x.byteswap().newbyteorder() + """ + ) + assert_equal() + classname = selenium.run_js( + "return pyodide.globals.get('x').toJs()[0][0].constructor.name" + ) + assert classname.endswith("Array") + assert classname != "Array" + + assert selenium.run("np.array([True, False])") == [True, False] + + +@pytest.mark.skip_pyproxy_check +def test_py2js_buffer_clear_error_flag(selenium): + selenium.load_package("numpy") + selenium.run("import numpy as np") + selenium.run("x = np.array([['string1', 'string2'], ['string3', 'string4']])") + selenium.run_js( + """ + pyodide.globals.get("x") + // Implicit assertion: this doesn't leave python error indicator set + // (automatically checked in conftest.py) + """ + ) + + +@pytest.mark.skip_pyproxy_check +@pytest.mark.parametrize( + "dtype", + ( + "int8", + "uint8", + "int16", + "uint16", + "int32", + "uint32", + "int64", + "uint64", + "float32", + "float64", + ), +) +def test_python2js_numpy_scalar(selenium, dtype): + selenium.load_package("numpy") + selenium.run("import numpy as np") + selenium.run( + f""" + x = np.{dtype}(1) + """ + ) + assert ( + selenium.run_js( + """ + return pyodide.globals.get('x') == 1 + """ + ) + is True + ) + selenium.run( + """ + x = x.byteswap().newbyteorder() + """ + ) + assert ( + selenium.run_js( + """ + return pyodide.globals.get('x') == 1 + """ + ) + is True + ) + + +@pytest.mark.skip_pyproxy_check +def test_runpythonasync_numpy(selenium_standalone): + selenium_standalone.run_async( + """ + import numpy as np + x = np.zeros(5) + """ + ) + for i in range(5): + assert selenium_standalone.run_js( + f"return pyodide.globals.get('x').toJs()[{i}] == 0" + ) + + +@pytest.mark.xfail_browsers( + firefox="Timeout in WebWorker when using numpy in Firefox 87" +) +@pytest.mark.driver_timeout(30) +def test_runwebworker_numpy(selenium_webworker_standalone): + output = selenium_webworker_standalone.run_webworker( + """ + import numpy as np + x = np.zeros(5) + str(x) + """ + ) + assert output == "[0. 0. 0. 0. 0.]" + + +@pytest.mark.skip_pyproxy_check +def test_get_buffer(selenium): + selenium.run_js( + """ + await pyodide.loadPackage(['numpy']); + pyodide.runPython(` + import numpy as np + x = np.arange(24) + z1 = x.reshape([8,3]) + z2 = z1[-1::-1] + z3 = z1[::,-1::-1] + z4 = z1[-1::-1,-1::-1] + `); + for(let x of ["z1", "z2", "z3", "z4"]){ + let z = pyodide.globals.get(x).getBuffer("u32"); + for(let idx1 = 0; idx1 < 8; idx1++) { + for(let idx2 = 0; idx2 < 3; idx2++){ + let v1 = z.data[z.offset + z.strides[0] * idx1 + z.strides[1] * idx2]; + let v2 = pyodide.runPython(`repr(${x}[${idx1}, ${idx2}])`); + console.log(`${v1}, ${typeof(v1)}, ${v2}, ${typeof(v2)}, ${v1===v2}`); + if(v1.toString() !== v2){ + throw new Error(`Discrepancy ${x}[${idx1}, ${idx2}]: ${v1} != ${v2}`); + } + } + } + z.release(); + } + """ + ) + + +@pytest.mark.skip_pyproxy_check +@pytest.mark.parametrize( + "arg", + [ + "np.arange(6).reshape((2, -1))", + "np.arange(12).reshape((3, -1))[::2, ::2]", + "np.arange(12).reshape((3, -1))[::-1, ::-1]", + "np.arange(12).reshape((3, -1))[::, ::-1]", + "np.arange(12).reshape((3, -1))[::-1, ::]", + "np.arange(12).reshape((3, -1))[::-2, ::-2]", + "np.arange(6).reshape((2, -1)).astype(np.int8, order='C')", + "np.arange(6).reshape((2, -1)).astype(np.int8, order='F')", + "np.arange(6).reshape((2, -1, 1))", + "np.ones((1, 1))[0:0]", # shape[0] == 0 + "np.ones(1)", # ndim == 0 + ] + + [ + f"np.arange(3).astype(np.{type_})" + for type_ in ["int8", "uint8", "int16", "int32", "float32", "float64"] + ], +) +def test_get_buffer_roundtrip(selenium, arg): + selenium.run_js( + f""" + await pyodide.loadPackage(['numpy']); + pyodide.runPython(` + import numpy as np + x = {arg} + `); + self.x_js_buf = pyodide.globals.get("x").getBuffer(); + x_js_buf.length = x_js_buf.data.length; + """ + ) + + selenium.run_js( + """ + pyodide.runPython(` + import itertools + from unittest import TestCase + from js import x_js_buf + assert_equal = TestCase().assertEqual + + assert_equal(x_js_buf.ndim, x.ndim) + assert_equal(x_js_buf.shape.to_py(), list(x.shape)) + assert_equal(x_js_buf.strides.to_py(), [s/x.itemsize for s in x.data.strides]) + assert_equal(x_js_buf.format, x.data.format) + if len(x) == 0: + assert x_js_buf.length == 0 + else: + minoffset = 1000 + maxoffset = 0 + for tup in itertools.product(*[range(n) for n in x.shape]): + offset = x_js_buf.offset + sum(x*y for (x,y) in zip(tup, x_js_buf.strides)) + minoffset = min(offset, minoffset) + maxoffset = max(offset, maxoffset) + assert_equal(x[tup], x_js_buf.data[offset]) + assert_equal(minoffset, 0) + assert_equal(maxoffset + 1, x_js_buf.length) + x_js_buf.release() + `); + """ + ) + + +def test_get_buffer_big_endian(selenium): + selenium.run_js( + """ + await pyodide.loadPackage(['numpy']); + self.a = pyodide.runPython(` + import numpy as np + np.arange(24, dtype="int16").byteswap().newbyteorder() + `); + """ + ) + with pytest.raises( + Exception, match="Javascript has no native support for big endian buffers" + ): + selenium.run_js("a.getBuffer()") + result = selenium.run_js( + """ + let buf = a.getBuffer("i8") + let result = Array.from(buf.data); + buf.release(); + a.destroy(); + return result; + """ + ) + assert len(result) == 48 + assert result[:18] == [0, 0, 0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0, 6, 0, 7, 0, 8] + + +def test_get_buffer_error_messages(selenium): + with pytest.raises(Exception, match="Javascript has no Float16 support"): + selenium.run_js( + """ + await pyodide.loadPackage(['numpy']); + pyodide.runPython(` + import numpy as np + x = np.ones(2, dtype=np.float16) + `); + let x = pyodide.runPython("x"); + try { + x.getBuffer(); + } finally { + x.destroy(); + } + """ + ) + + +def test_fft(selenium): + selenium.run_js( + """ + await pyodide.loadPackage(['numpy']); + pyodide.runPython(` + import numpy + assert all(numpy.fft.fft([1, 1]) == [2, 0]) + `); + """ + ) + + +@run_in_pyodide(packages=["numpy"]) +def test_np_unique(selenium): + """Numpy comparator functions formerly had a fatal error, see PR #2110""" + import numpy as np + + np.unique(np.array([1.1, 1.1]), axis=-1) diff --git a/integration_tests/recipes/openblas/meta.yaml b/integration_tests/recipes/openblas/meta.yaml new file mode 100644 index 00000000..1325649a --- /dev/null +++ b/integration_tests/recipes/openblas/meta.yaml @@ -0,0 +1,47 @@ +package: + name: openblas + version: 0.3.26 + tag: + - library +source: + sha256: 4e6e4f5cb14c209262e33e6816d70221a2fe49eb69eaf0a06f065598ac602c68 + url: https://github.com/OpenMathLib/OpenBLAS/releases/download/v0.3.26/OpenBLAS-0.3.26.tar.gz + patches: + - patches/0001-Add-Wno-return-type-flag.patch + - patches/0002-Align-xerbla_array-signature-with-scipy-expectation.patch + +build: + type: shared_library + script: | + # seems like .zip does not maintain executable flags, need to reset these + chmod u+x c_check + chmod u+x f_check + chmod u+x exports/gensymbol + # Replace void returns by int returns + sed -ri 's/void(\s+)BLASFUNC/int\1BLASFUNC/g' common_interface.h + sed -ri 's/void(\s+)cblas_/int\1cblas_/g' cblas.h ctest/*.c + sed -ri 's/void(\s+)(C?NAME)/int\1\2/g' interface/*.c + sed -ri 's/((extern)?.+) void ([a-z0-9]+_)/\1\2 int \3/g' lapack-netlib/SRC/*.c \ + lapack-netlib/SRC/DEPRECATED/*.c + # For some functions (mostly handling complex I think) f2c actually + # generate a function that returns void so I need to revert the void to int + # change the previous line does. + sed -ri 's@int ([cz](dotc|dotu|ladiv))@void \1@g' lapack-netlib/SRC/*.c\ + lapack-netlib/SRC/DEPRECATED/*.c + + emmake make libs shared CC=emcc HOSTCC=gcc TARGET=RISCV64_GENERIC NOFORTRAN=1 NO_LAPACKE=1 \ + USE_THREAD=0 LDFLAGS="${SIDE_MODULE_LDFLAGS}" + mkdir -p dist + # Add libf2c symbols to libopenblas.so + emcc ${WASM_LIBRARY_DIR}/lib/libf2c.a libopenblas.a ${SIDE_MODULE_LDFLAGS} \ + -o libopenblas.so + + cp libopenblas.so dist + emmake make install PREFIX=${WASM_LIBRARY_DIR} + +requirements: + host: + - libf2c +about: + home: https://www.openblas.net/ + license: BSD-3-Clause diff --git a/integration_tests/recipes/openblas/patches/0001-Add-Wno-return-type-flag.patch b/integration_tests/recipes/openblas/patches/0001-Add-Wno-return-type-flag.patch new file mode 100644 index 00000000..ae57a81a --- /dev/null +++ b/integration_tests/recipes/openblas/patches/0001-Add-Wno-return-type-flag.patch @@ -0,0 +1,29 @@ +From 09fd1aa0aa6a98e1cebaa6e34fca1e424dab8f48 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Lo=C3=AFc=20Est=C3=A8ve?= +Date: Fri, 9 Dec 2022 16:40:13 +0100 +Subject: [PATCH 1/2] Add -Wno-return-type flag + +This is needed because we are changing many signatures to return int instead of +void with some regex expressions but we are not modifying the returned value + which would potentially be a lot more tricky. + +--- + Makefile.rule | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/Makefile.rule b/Makefile.rule +index 5f787a9c..6890046a 100644 +--- a/Makefile.rule ++++ b/Makefile.rule +@@ -228,7 +228,7 @@ NO_AFFINITY = 1 + # Common Optimization Flag; + # The default -O2 is enough. + # Flags for POWER8 are defined in Makefile.power. Don't modify COMMON_OPT +-# COMMON_OPT = -O2 ++COMMON_OPT = -O2 -Wno-return-type + + # gfortran option for LAPACK to improve thread-safety + # It is enabled by default in Makefile.system for gfortran +-- +2.34.1 + diff --git a/integration_tests/recipes/openblas/patches/0002-Align-xerbla_array-signature-with-scipy-expectation.patch b/integration_tests/recipes/openblas/patches/0002-Align-xerbla_array-signature-with-scipy-expectation.patch new file mode 100644 index 00000000..d7ba240d --- /dev/null +++ b/integration_tests/recipes/openblas/patches/0002-Align-xerbla_array-signature-with-scipy-expectation.patch @@ -0,0 +1,25 @@ +From fb8f9ec54121a889783cce3d42ea841cc513a22e Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Lo=C3=AFc=20Est=C3=A8ve?= +Date: Fri, 7 Apr 2023 10:27:59 +0200 +Subject: [PATCH 2/2] Align xerbla_array signature with scipy expectation + +--- + lapack-netlib/SRC/xerbla_array.c | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/lapack-netlib/SRC/xerbla_array.c b/lapack-netlib/SRC/xerbla_array.c +index fe7d6d898..74d3ca96a 100644 +--- a/lapack-netlib/SRC/xerbla_array.c ++++ b/lapack-netlib/SRC/xerbla_array.c +@@ -600,7 +600,7 @@ array.f"> */ + + /* ===================================================================== */ + /* Subroutine */ void xerbla_array_(char *srname_array__, integer * +- srname_len__, integer *info, integer srname_array_len) ++ srname_len__, integer *info) + { + /* System generated locals */ + integer i__1, i__2, i__3; +-- +2.34.1 + diff --git a/integration_tests/recipes/scipy/cmdline_test_file.py b/integration_tests/recipes/scipy/cmdline_test_file.py new file mode 100644 index 00000000..0d98ef20 --- /dev/null +++ b/integration_tests/recipes/scipy/cmdline_test_file.py @@ -0,0 +1,8 @@ +import numpy as np +from scipy.sparse.linalg import svds + +rng = np.random.default_rng(0) +A = rng.random((10, 10)) + +res = svds(A, k=3, which="LM", random_state=0) +print("res", res) diff --git a/integration_tests/recipes/scipy/info.md b/integration_tests/recipes/scipy/info.md new file mode 100644 index 00000000..97efdd05 --- /dev/null +++ b/integration_tests/recipes/scipy/info.md @@ -0,0 +1,81 @@ +The biggest issue that comes up in building scipy is that we don't have a good +fortran to wasm compiler. Some version of flang classic might work. + +Instead of compiling from fortran directly, we rely on f2c to cross compile +the code to C and then compile C to wasm. We rely on f2c both directly and via +OpenBLAS which has f2c'd its Fortran files and then modified the generated C +files by hand. + +A big problem with f2c is that it cannot handle implicit casts of function +arguments, because it tries to guess the types of the arguments of the function +being called based on the types of the arguments at the call site. There are +two distinct versions of this: + +1. casts between number types -- we deal with this automatically in + `fix_inconsistent_decls` in `_f2c_fixes.py` +2. casts between char\* and int -- this is too annoying to deal with + automatically, so we write manual patches. + +Type 1: the fortran equivalent of the following C code: + +```C +double f(double x){ + return x + 5; +} + +double g(int x){ + return f(x); +} +``` + +gets f2c'd to + +```C +double f(double x){ + return x + 5; +} + +double g(int x){ + double f(int); + return f(x); +} +``` + +When we try to compile this, we get an error saying that f has been declared +with two different types. + +Type 2: For each string argument, the Fortran ABI adds arguments at the end of +the argument list. LAPACK never declares functions as taking strings, preferring +to call them integers: + +```C +int some_lapack_func(int *some_string, int *some_string_length){ + // ... +} +``` + +But then when we call it: `some_lapack_func("a string here", 14);` the f2c'd +version looks like: + +```C +int str_len = 14; +int some_lapack_func(int *some_string, int *some_string_length, fortranlen some_string_length_again); +some_lapack_func("a string here", &str_len, 14); +``` + +When changing `packages/scipy/meta.yaml`, rebuilding scipy takes time, it can +be convenient to only build a few sub-packages to reduce iteration time. You +can add something like this to `packages/scipy/meta.yaml`: + +```bash +# Define which sub-packages to keep +TO_KEEP='linalg|sparse|_lib|_build_utils' +# Update scipy/setup.py +perl -pi -e "s@(config.add_subpackage\(')(?!$TO_KEEP)@# \1\2@" scipy/setup.py +# delete unwanted folders to avoid unneeded cythonization +folders_to_delete=$(find scipy -mindepth 1 -maxdepth 1 -type d | grep -vP "$TO_KEEP") +rm -rf $folders_to_delete +``` + +Building only `scipy.(linalg|sparse|_lib|_build_utils)` takes ~4 minutes on my +machine compared to ~10-15 minutes for a full scipy build. diff --git a/integration_tests/recipes/scipy/meta.yaml b/integration_tests/recipes/scipy/meta.yaml new file mode 100644 index 00000000..959954fa --- /dev/null +++ b/integration_tests/recipes/scipy/meta.yaml @@ -0,0 +1,182 @@ +package: + name: scipy + version: 1.14.1 + tag: + - min-scipy-stack + top-level: + - scipy + +# See extra explanation in info.md +# +# For future reference: if you see the following errors: +# Declaration error: adjustable dimension on non-argument +# or: +# nonconstant array size +# you are trying to compile code that isn't written to the fortran 77 standard. +# The line number in the error points to the last line of the problematic +# subroutine. Try deleting it. + +source: + url: https://files.pythonhosted.org/packages/62/11/4d44a1f274e002784e4dbdb81e0ea96d2de2d1045b2132d5af62cc31fd28/scipy-1.14.1.tar.gz + sha256: 5a275584e726026a5699459aa72f828a610821006228e841b94275c4a7c08417 + + patches: + - patches/0001-Fix-dstevr-in-special-lapack_defs.h.patch + - patches/0002-int-to-string.patch + - patches/0003-gemm_-no-const.patch + - patches/0004-make-int-return-values.patch + - patches/0005-Fix-fitpack.patch + - patches/0006-Fix-gees-calls.patch + - patches/0007-MAINT-linalg-Remove-id_dist-Fortran-files.patch + - patches/0008-Mark-mvndst-functions-recursive.patch + - patches/0009-Make-sreorth-recursive.patch + - patches/0010-Link-openblas-with-modules-that-require-f2c.patch + - patches/0011-Remove-fpchec-inline-if-then-endif-constructs.patch # remove with SciPy v1.15.0 + - patches/0012-Remove-chla_transtype.patch + - patches/0013-Set-wrapper-return-type-to-int.patch + - patches/0014-Skip-svd_gesdd-test.patch # remove with SciPy v1.15.0 + - patches/0015-Remove-f2py-generators.patch + - patches/0016-Make-sf_error_state_lib-a-static-library.patch + - patches/0017-Remove-test-modules-that-fail-to-build.patch + - patches/0018-Fix-lapack-larfg-function-signature.patch + +build: + cflags: | + -I$(WASM_LIBRARY_DIR)/include + -Wno-return-type + -DUNDERSCORE_G77 + -fvisibility=default + cxxflags: | + -fexceptions + -fvisibility=default + ldflags: | + -L$(NUMPY_LIB)/core/lib/ + -L$(NUMPY_LIB)/random/lib/ + -fexceptions + + # Exclude tests via Meson's install tags functionality. + unvendor-tests: true + # install-args=--tags=runtime,python-runtime,devel + # Disable when running tests, enable when a PR is ready, i.e., building for distribution. + backend-flags: | + build-dir=build + + # IMPORTANT: Other locations important in scipy build process: + # There are two files built in the "capture" pass that need patching: + # _blas_subroutines.h, and _cython + # Scipy has a bunch of custom logic implemented in + # pyodide-build/pyodide_build/_f2c_fixes.py. + script: | + set -x + git clone https://github.com/hoodmane/f2c.git --depth 1 + (cd f2c/src && cp makefile.u makefile && sed -i "s/gram.c:/gram.c1:/" makefile && make) + export F2C_PATH=$(pwd)/f2c/src/f2c + + echo F2C_PATH: $F2C_PATH + export NPY_BLAS_LIBS="-I$WASM_LIBRARY_DIR/include $WASM_LIBRARY_DIR/lib/libopenblas.so" + export NPY_LAPACK_LIBS="-I$WASM_LIBRARY_DIR/include $WASM_LIBRARY_DIR/lib/libopenblas.so" + + sed -i 's/void DQA/int DQA/g' scipy/integrate/__quadpack.h + + # Change many functions that return void into functions that return int + find scipy -name "*.c*" -type f | xargs sed -i 's/extern void F_FUNC/extern int F_FUNC/g' + + sed -i 's/void F_FUNC/int F_FUNC/g' scipy/odr/__odrpack.c + sed -i 's/^void/int/g' scipy/odr/odrpack.h + sed -i 's/^void/int/g' scipy/odr/__odrpack.c + + sed -i 's/void BLAS_FUNC/int BLAS_FUNC/g' scipy/special/lapack_defs.h + # sed -i 's/void F_FUNC/int F_FUNC/g' scipy/linalg/_lapack_subroutines.h + sed -i 's/extern void/extern int/g' scipy/optimize/__minpack.h + sed -i 's/void/int/g' scipy/linalg/cython_blas_signatures.txt + sed -i 's/void/int/g' scipy/linalg/cython_lapack_signatures.txt + sed -i 's/^void/int/g' scipy/interpolate/src/_fitpackmodule.c + + sed -i 's/extern void/extern int/g' scipy/sparse/linalg/_dsolve/SuperLU/SRC/*.{c,h} + sed -i 's/PUBLIC void/PUBLIC int/g' scipy/sparse/linalg/_dsolve/SuperLU/SRC/*.{c,h} + sed -i 's/^void/int/g' scipy/sparse/linalg/_dsolve/SuperLU/SRC/*.{c,h} + sed -i 's/^void/int/g' scipy/sparse/linalg/_dsolve/*.{c,h} + sed -i 's/void \(.\)print/int \1/g' scipy/sparse/linalg/_dsolve/SuperLU/SRC/*.{c,h} + sed -i 's/TYPE_GENERIC_FUNC(\(.*\), void)/TYPE_GENERIC_FUNC(\1, int)/g' scipy/sparse/linalg/_dsolve/_superluobject.h + + sed -i 's/^void/int/g' scipy/optimize/_trlib/trlib_private.h + sed -i 's/^void/int/g' scipy/optimize/_trlib/trlib/trlib_private.h + sed -i 's/^void/int/g' scipy/_build_utils/src/wrap_dummy_g77_abi.c + sed -i 's/, int)/)/g' scipy/optimize/_trlib/trlib_private.h + sed -i 's/, 1)/)/g' scipy/optimize/_trlib/trlib_private.h + + sed -i 's/^void/int/g' scipy/spatial/qhull_misc.h + sed -i 's/, size_t)/)/g' scipy/spatial/qhull_misc.h + sed -i 's/,1)/)/g' scipy/spatial/qhull_misc.h + + # Input error causes "duplicate symbol" linker errors. Empty out the file. + echo "" > scipy/sparse/linalg/_dsolve/SuperLU/SRC/input_error.c + + _retain-test-patterns: + - "*_page_trend_test.py" + - "*bws_test.py" + + cross-build-env: true + cross-build-files: + - scipy/linalg/cython_lapack.pxd + - scipy/linalg/cython_blas.pxd + +requirements: + host: + - numpy + - openblas + run: + - numpy + - openblas + executable: + - gfortran + +test: + imports: + - scipy + - scipy.cluster + - scipy.cluster.vq + - scipy.cluster.hierarchy + - scipy.constants + - scipy.fft + - scipy.fftpack + - scipy.integrate + - scipy.interpolate + - scipy.io + - scipy.io.arff + - scipy.io.matlab + - scipy.io.wavfile + - scipy.linalg + - scipy.linalg.blas + - scipy.linalg.cython_blas + - scipy.linalg.lapack + - scipy.linalg.cython_lapack + - scipy.linalg.interpolative + - scipy.misc + - scipy.ndimage + - scipy.odr + - scipy.optimize + - scipy.signal + - scipy.signal.windows + - scipy.sparse + - scipy.sparse.linalg + - scipy.sparse.csgraph + - scipy.spatial + - scipy.spatial.distance + - scipy.spatial.transform + - scipy.special + - scipy.stats + - scipy.stats.contingency + - scipy.stats.distributions + - scipy.stats.mstats + - scipy.stats.qmc +about: + home: https://www.scipy.org + PyPI: https://pypi.org/project/scipy + summary: "SciPy: Scientific Library for Python" + license: BSD-3-Clause +extra: + recipe-maintainers: + - lesteve + - steppi + - agriyakhetarpal diff --git a/integration_tests/recipes/scipy/patches/0001-Fix-dstevr-in-special-lapack_defs.h.patch b/integration_tests/recipes/scipy/patches/0001-Fix-dstevr-in-special-lapack_defs.h.patch new file mode 100644 index 00000000..ca6d80a0 --- /dev/null +++ b/integration_tests/recipes/scipy/patches/0001-Fix-dstevr-in-special-lapack_defs.h.patch @@ -0,0 +1,32 @@ +From 45a31145679c83f2719b6420f234d484b9459697 Mon Sep 17 00:00:00 2001 +From: Hood Chatham +Date: Fri, 18 Mar 2022 16:25:39 -0700 +Subject: [PATCH 1/18] Fix dstevr in special/lapack_defs.h + +--- + scipy/special/lapack_defs.h | 5 ++--- + 1 file changed, 2 insertions(+), 3 deletions(-) + +diff --git a/scipy/special/lapack_defs.h b/scipy/special/lapack_defs.h +index 0d20ba1ca..d4325f71f 100644 +--- a/scipy/special/lapack_defs.h ++++ b/scipy/special/lapack_defs.h +@@ -8,13 +8,12 @@ extern void BLAS_FUNC(dstevr)(char *jobz, char *range, CBLAS_INT *n, double *d, + double *vl, double *vu, CBLAS_INT *il, CBLAS_INT *iu, double *abstol, + CBLAS_INT *m, double *w, double *z, CBLAS_INT *ldz, CBLAS_INT *isuppz, + double *work, CBLAS_INT *lwork, CBLAS_INT *iwork, CBLAS_INT *liwork, +- CBLAS_INT *info, size_t jobz_len, size_t range_len); ++ CBLAS_INT *info); + + static void c_dstevr(char *jobz, char *range, CBLAS_INT *n, double *d, double *e, + double *vl, double *vu, CBLAS_INT *il, CBLAS_INT *iu, double *abstol, + CBLAS_INT *m, double *w, double *z, CBLAS_INT *ldz, CBLAS_INT *isuppz, + double *work, CBLAS_INT *lwork, CBLAS_INT *iwork, CBLAS_INT *liwork, CBLAS_INT *info) { + BLAS_FUNC(dstevr)(jobz, range, n, d, e, vl, vu, il, iu, abstol, m, +- w, z, ldz, isuppz, work, lwork, iwork, liwork, info, +- 1, 1); ++ w, z, ldz, isuppz, work, lwork, iwork, liwork, info); + } +-- +2.34.1 + diff --git a/integration_tests/recipes/scipy/patches/0002-int-to-string.patch b/integration_tests/recipes/scipy/patches/0002-int-to-string.patch new file mode 100644 index 00000000..7a172cb2 --- /dev/null +++ b/integration_tests/recipes/scipy/patches/0002-int-to-string.patch @@ -0,0 +1,29 @@ +From d53ade3f03ba3557fd50fb38990d605f4ae7f8f1 Mon Sep 17 00:00:00 2001 +From: Hood Chatham +Date: Sat, 25 Dec 2021 18:04:18 -0800 +Subject: [PATCH 2/18] int to string + +f2c does not handle implicit casts of function arguments correctly. The msg +argument of `xerrwv` is defined to be an `int *`, and then implicitly cast +from a string at the call site. This doesn't work correctly. + +We redefine the type of the first argument to be string to fix the problem. +--- + scipy/integrate/odepack/xerrwv.f | 3 ++- + 1 file changed, 2 insertions(+), 1 deletion(-) + +diff --git a/scipy/integrate/odepack/xerrwv.f b/scipy/integrate/odepack/xerrwv.f +index 7e180e4f8..b940bb702 100644 +--- a/scipy/integrate/odepack/xerrwv.f ++++ b/scipy/integrate/odepack/xerrwv.f +@@ -1,5 +1,6 @@ + subroutine xerrwv (msg, nmes, nerr, level, ni, i1, i2, nr, r1, r2) +- integer msg, nmes, nerr, level, ni, i1, i2, nr, ++ character msg*1 ++ integer nmes, nerr, level, ni, i1, i2, nr, + 1 i, lun, lunit, mesflg, ncpw, nch, nwds + double precision r1, r2 + dimension msg(nmes) +-- +2.34.1 + diff --git a/integration_tests/recipes/scipy/patches/0003-gemm_-no-const.patch b/integration_tests/recipes/scipy/patches/0003-gemm_-no-const.patch new file mode 100644 index 00000000..3840f745 --- /dev/null +++ b/integration_tests/recipes/scipy/patches/0003-gemm_-no-const.patch @@ -0,0 +1,86 @@ +From e528227dd37c8b0512381992c222789a114e3169 Mon Sep 17 00:00:00 2001 +From: Hood Chatham +Date: Sat, 18 Dec 2021 11:41:15 -0800 +Subject: [PATCH 3/18] gemm_ no const + +cgemm, dgemm, sgemm, and zgemm are declared with `const` in slu_cdefs.h, but +other places don't have the cosnt causing compile errors. +This patch drops the consts and fixes the problem. +--- + scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_cdefs.h | 6 +++--- + scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_ddefs.h | 6 +++--- + scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_sdefs.h | 6 +++--- + scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_zdefs.h | 6 +++--- + 4 files changed, 12 insertions(+), 12 deletions(-) + +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_cdefs.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_cdefs.h +index dfc0516ac..92d7d7d6b 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_cdefs.h ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_cdefs.h +@@ -262,9 +262,9 @@ extern void ccheck_tempv(int, singlecomplex *); + + /*! \brief BLAS */ + +-extern int cgemm_(const char*, const char*, const int*, const int*, const int*, +- const singlecomplex*, const singlecomplex*, const int*, const singlecomplex*, +- const int*, const singlecomplex*, singlecomplex*, const int*); ++extern int cgemm_( char*, char*, int*, int*, int*, ++ singlecomplex*, singlecomplex*, int*, singlecomplex*, ++ int*, singlecomplex*, singlecomplex*, int*); + extern int ctrsv_(char*, char*, char*, int*, singlecomplex*, int*, + singlecomplex*, int*); + extern int ctrsm_(char*, char*, char*, char*, int*, int*, +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_ddefs.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_ddefs.h +index 3b5aa509f..1305641bd 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_ddefs.h ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_ddefs.h +@@ -260,9 +260,9 @@ extern void dcheck_tempv(int, double *); + + /*! \brief BLAS */ + +-extern int dgemm_(const char*, const char*, const int*, const int*, const int*, +- const double*, const double*, const int*, const double*, +- const int*, const double*, double*, const int*); ++extern int dgemm_( char*, char*, int*, int*, int*, ++ double*, double*, int*, double*, ++ int*, double*, double*, int*); + extern int dtrsv_(char*, char*, char*, int*, double*, int*, + double*, int*); + extern int dtrsm_(char*, char*, char*, char*, int*, int*, +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_sdefs.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_sdefs.h +index 9bb6a38e7..b013962a4 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_sdefs.h ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_sdefs.h +@@ -259,9 +259,9 @@ extern void scheck_tempv(int, float *); + + /*! \brief BLAS */ + +-extern int sgemm_(const char*, const char*, const int*, const int*, const int*, +- const float*, const float*, const int*, const float*, +- const int*, const float*, float*, const int*); ++extern int sgemm_( char*, char*, int*, int*, int*, ++ float*, float*, int*, float*, ++ int*, float*, float*, int*); + extern int strsv_(char*, char*, char*, int*, float*, int*, + float*, int*); + extern int strsm_(char*, char*, char*, char*, int*, int*, +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_zdefs.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_zdefs.h +index c6418d584..c5a2692be 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_zdefs.h ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_zdefs.h +@@ -262,9 +262,9 @@ extern void zcheck_tempv(int, doublecomplex *); + + /*! \brief BLAS */ + +-extern int zgemm_(const char*, const char*, const int*, const int*, const int*, +- const doublecomplex*, const doublecomplex*, const int*, const doublecomplex*, +- const int*, const doublecomplex*, doublecomplex*, const int*); ++extern int zgemm_( char*, char*, int*, int*, int*, ++ doublecomplex*, doublecomplex*, int*, doublecomplex*, ++ int*, doublecomplex*, doublecomplex*, int*); + extern int ztrsv_(char*, char*, char*, int*, doublecomplex*, int*, + doublecomplex*, int*); + extern int ztrsm_(char*, char*, char*, char*, int*, int*, +-- +2.34.1 + diff --git a/integration_tests/recipes/scipy/patches/0004-make-int-return-values.patch b/integration_tests/recipes/scipy/patches/0004-make-int-return-values.patch new file mode 100644 index 00000000..5abeb4f0 --- /dev/null +++ b/integration_tests/recipes/scipy/patches/0004-make-int-return-values.patch @@ -0,0 +1,345 @@ +From a86a2304fd925f815bbb0e0753e46a7b863e2de2 Mon Sep 17 00:00:00 2001 +From: Joe Marshall +Date: Wed, 6 Apr 2022 21:25:13 -0700 +Subject: [PATCH 4/18] make int return values + +The return values of f2c functions are insignificant in most cases, so often it +is treated as returning void, when it really should return int (values are +"returned" by writing to pointers passed as an argument, but an obscure feature +known as alternative returns can cause the return value to be significant). + +There's a big change to scipy/linalg/_cython_wrapper_generators.py, which is +called on build to generate python wrappers for lapack and BLAS. The change +makes everything call direct to CLAPACK with the correct function signatures +and also fixes some fortran -> c linking oddities that occur because f2py assumes +different function signatures to f2c, which in turn creates different function +signatures compared to what has been done in CLAPACK. + +f2py is patched in numpy to make subroutines return int. + +emscripten is very strict about void vs int returns and function signatures, so +we change everything to return int from subroutines, and signatures are altered +to be consistent. + +Co-Developed-by: Joe Marshall +Co-Authored-By: Joe Marshall +--- + scipy/_build_utils/src/wrap_g77_abi.c | 16 ++++++------ + scipy/integrate/_odepackmodule.c | 8 +++--- + scipy/odr/__odrpack.c | 2 +- + .../_dsolve/SuperLU/SRC/ilu_cdrop_row.c | 8 +++--- + .../_dsolve/SuperLU/SRC/ilu_scopy_to_ucol.c | 2 +- + .../_dsolve/SuperLU/SRC/scipy_slu_config.h | 3 +++ + .../linalg/_dsolve/SuperLU/SRC/sgssvx.c | 7 ++--- + .../linalg/_dsolve/SuperLU/SRC/slu_dcomplex.h | 5 +++- + .../linalg/_dsolve/SuperLU/SRC/slu_scomplex.h | 5 ++-- + scipy/sparse/linalg/_dsolve/_superlu_utils.c | 4 +-- + .../linalg/_eigen/arpack/ARPACK/SRC/debug.h | 20 +++++++------- + .../linalg/_eigen/arpack/ARPACK/SRC/stat.h | 26 +++++++++---------- + 12 files changed, 57 insertions(+), 49 deletions(-) + +diff --git a/scipy/_build_utils/src/wrap_g77_abi.c b/scipy/_build_utils/src/wrap_g77_abi.c +index f35c94f984..1872d335aa 100644 +--- a/scipy/_build_utils/src/wrap_g77_abi.c ++++ b/scipy/_build_utils/src/wrap_g77_abi.c +@@ -71,7 +71,7 @@ double_complex F_FUNC(wzdotu,WZDOTU)(CBLAS_INT *n, double_complex *zx, \ + return ret; + } + +-void BLAS_FUNC(sladiv)(float *xr, float *xi, float *yr, float *yi, \ ++int BLAS_FUNC(sladiv)(float *xr, float *xi, float *yr, float *yi, \ + float *retr, float *reti); + float_complex F_FUNC(wcladiv,WCLADIV)(float_complex *x, float_complex *y){ + float_complex ret; +@@ -83,7 +83,7 @@ float_complex F_FUNC(wcladiv,WCLADIV)(float_complex *x, float_complex *y){ + return ret; + } + +-void BLAS_FUNC(dladiv)(double *xr, double *xi, double *yr, double *yi, \ ++int BLAS_FUNC(dladiv)(double *xr, double *xi, double *yr, double *yi, \ + double *retr, double *reti); + double_complex F_FUNC(wzladiv,WZLADIV)(double_complex *x, double_complex *y){ + double_complex ret; +@@ -95,31 +95,31 @@ double_complex F_FUNC(wzladiv,WZLADIV)(double_complex *x, double_complex *y){ + return ret; + } + +-void F_FUNC(cdotcwrp,WCDOTCWRP)(float_complex *ret, CBLAS_INT *n, float_complex *cx, \ ++int F_FUNC(cdotcwrp,WCDOTCWRP)(float_complex *ret, CBLAS_INT *n, float_complex *cx, \ + CBLAS_INT *incx, float_complex *cy, CBLAS_INT *incy){ + *ret = F_FUNC(wcdotc,WCDOTC)(n, cx, incx, cy, incy); + } + +-void F_FUNC(zdotcwrp,WZDOTCWRP)(double_complex *ret, CBLAS_INT *n, double_complex *zx, \ ++int F_FUNC(zdotcwrp,WZDOTCWRP)(double_complex *ret, CBLAS_INT *n, double_complex *zx, \ + CBLAS_INT *incx, double_complex *zy, CBLAS_INT *incy){ + *ret = F_FUNC(wzdotc,WZDOTC)(n, zx, incx, zy, incy); + } + +-void F_FUNC(cdotuwrp,CDOTUWRP)(float_complex *ret, CBLAS_INT *n, float_complex *cx, \ ++int F_FUNC(cdotuwrp,CDOTUWRP)(float_complex *ret, CBLAS_INT *n, float_complex *cx, \ + CBLAS_INT *incx, float_complex *cy, CBLAS_INT *incy){ + *ret = F_FUNC(wcdotu,WCDOTU)(n, cx, incx, cy, incy); + } + +-void F_FUNC(zdotuwrp,ZDOTUWRP)(double_complex *ret, CBLAS_INT *n, double_complex *zx, \ ++int F_FUNC(zdotuwrp,ZDOTUWRP)(double_complex *ret, CBLAS_INT *n, double_complex *zx, \ + CBLAS_INT *incx, double_complex *zy, CBLAS_INT *incy){ + *ret = F_FUNC(wzdotu,WZDOTU)(n, zx, incx, zy, incy); + } + +-void F_FUNC(cladivwrp,CLADIVWRP)(float_complex *ret, float_complex *x, float_complex *y){ ++int F_FUNC(cladivwrp,CLADIVWRP)(float_complex *ret, float_complex *x, float_complex *y){ + *ret = F_FUNC(wcladiv,WCLADIV)(x, y); + } + +-void F_FUNC(zladivwrp,ZLADIVWRP)(double_complex *ret, double_complex *x, double_complex *y){ ++int F_FUNC(zladivwrp,ZLADIVWRP)(double_complex *ret, double_complex *x, double_complex *y){ + *ret = F_FUNC(wzladiv,WZLADIV)(x, y); + } + +diff --git a/scipy/integrate/_odepackmodule.c b/scipy/integrate/_odepackmodule.c +index 0c8067e652..d085939859 100644 +--- a/scipy/integrate/_odepackmodule.c ++++ b/scipy/integrate/_odepackmodule.c +@@ -156,17 +156,17 @@ static PyObject *odepack_error; + #endif + #endif + +-typedef void lsoda_f_t(F_INT *n, double *t, double *y, double *ydot); ++typedef int lsoda_f_t(F_INT *n, double *t, double *y, double *ydot); + typedef int lsoda_jac_t(F_INT *n, double *t, double *y, F_INT *ml, F_INT *mu, + double *pd, F_INT *nrowpd); + +-void LSODA(lsoda_f_t *f, F_INT *neq, double *y, double *t, double *tout, F_INT *itol, ++int LSODA(lsoda_f_t *f, F_INT *neq, double *y, double *t, double *tout, F_INT *itol, + double *rtol, double *atol, F_INT *itask, F_INT *istate, F_INT *iopt, + double *rwork, F_INT *lrw, F_INT *iwork, F_INT *liw, lsoda_jac_t *jac, + F_INT *jt); + + /* +-void ode_function(int *n, double *t, double *y, double *ydot) ++int ode_function(int *n, double *t, double *y, double *ydot) + { + ydot[0] = -0.04*y[0] + 1e4*y[1]*y[2]; + ydot[2] = 3e7*y[1]*y[1]; +@@ -175,7 +175,7 @@ void ode_function(int *n, double *t, double *y, double *ydot) + } + */ + +-void ++int + ode_function(F_INT *n, double *t, double *y, double *ydot) + { + /* +diff --git a/scipy/odr/__odrpack.c b/scipy/odr/__odrpack.c +index c806e33fbf..c4b822eb92 100644 +--- a/scipy/odr/__odrpack.c ++++ b/scipy/odr/__odrpack.c +@@ -13,7 +13,7 @@ + #include "odrpack.h" + + +-void F_FUNC(dodrc,DODRC)(void (*fcn)(F_INT *n, F_INT *m, F_INT *np, F_INT *nq, F_INT *ldn, F_INT *ldm, ++void F_FUNC(dodrc,DODRC)(int (*fcn)(F_INT *n, F_INT *m, F_INT *np, F_INT *nq, F_INT *ldn, F_INT *ldm, + F_INT *ldnp, double *beta, double *xplusd, F_INT *ifixb, F_INT *ifixx, + F_INT *ldifx, F_INT *ideval, double *f, double *fjacb, double *fjacd, + F_INT *istop), +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_cdrop_row.c b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_cdrop_row.c +index c1dc7fcf8f..d1903db4a6 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_cdrop_row.c ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_cdrop_row.c +@@ -23,10 +23,10 @@ at the top-level directory. + #include + #include "slu_cdefs.h" + +-extern void cswap_(int *, singlecomplex [], int *, singlecomplex [], int *); +-extern void caxpy_(int *, singlecomplex *, singlecomplex [], int *, singlecomplex [], int *); +-extern void ccopy_(int *, singlecomplex [], int *, singlecomplex [], int *); +-extern void scopy_(int *, float [], int *, float [], int *); ++extern int cswap_(int *, singlecomplex [], int *, singlecomplex [], int *); ++extern int caxpy_(int *, singlecomplex *, singlecomplex [], int *, singlecomplex [], int *); ++extern int ccopy_(int *, singlecomplex [], int *, singlecomplex [], int *); ++extern int scopy_(int *, float [], int *, float [], int *); + extern float scasum_(int *, singlecomplex *, int *); + extern float scnrm2_(int *, singlecomplex *, int *); + extern double dnrm2_(int *, double [], int *); +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_scopy_to_ucol.c b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_scopy_to_ucol.c +index 4e2654e8ac..d5b955d40e 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_scopy_to_ucol.c ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/ilu_scopy_to_ucol.c +@@ -26,7 +26,7 @@ at the top-level directory. + int num_drop_U; + #endif + +-extern void scopy_(int *, float [], int *, float [], int *); ++extern int scopy_(int *, float [], int *, float [], int *); + + #if 0 + static float *A; /* used in _compare_ only */ +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/scipy_slu_config.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/scipy_slu_config.h +index 5afc93b5d9..7ac5f80fb9 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/scipy_slu_config.h ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/scipy_slu_config.h +@@ -3,6 +3,9 @@ + + #include + ++#include "f2c.h" ++ ++ + /* + * Support routines + */ +diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/sgssvx.c b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/sgssvx.c +index 1395752d4c..7f5538140d 100644 +--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/sgssvx.c ++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/sgssvx.c +@@ -21,6 +21,8 @@ at the top-level directory. + */ + #include "slu_sdefs.h" + ++extern float slangs(char *, SuperMatrix *); ++ + /*! \brief + * + * 
+@@ -377,8 +379,6 @@ sgssvx(superlu_options_t *options, SuperMatrix *A, int *perm_c, int *perm_r,
+     double    t0;      /* temporary time */
+     double    *utime;
+ 
+-    /* External functions */
+-    extern float slangs(char *, SuperMatrix *);
+ 
+     Bstore = B->Store;
+     Xstore = X->Store;
+@@ -573,7 +573,8 @@ printf("dgssvx: Fact=%4d, Trans=%4d, equed=%c\n",
+         } else {
+ 	    *(unsigned char *)norm = 'I';
+         }
+-        anorm = slangs(norm, AA);
++        anorm = slangs(norm, AA);    /* External functions */
++        extern float slangs(char *, SuperMatrix *);
+         sgscon(norm, L, U, anorm, rcond, stat, &info1);
+         utime[RCOND] = SuperLU_timer_() - t0;
+     }
+diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_dcomplex.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_dcomplex.h
+index 67e83bcc77..e5757d5c4d 100644
+--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_dcomplex.h
++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_dcomplex.h
+@@ -28,7 +28,10 @@ at the top-level directory.
+ #ifndef DCOMPLEX_INCLUDE
+ #define DCOMPLEX_INCLUDE
+ 
+-typedef struct { double r, i; } doublecomplex;
++#include"scipy_slu_config.h"
++
++// defined in clapack
++//typedef struct { double r, i; } doublecomplex;
+ 
+ 
+ /* Macro definitions */
+diff --git a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_scomplex.h b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_scomplex.h
+index 83be8c971f..047a07ce9c 100644
+--- a/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_scomplex.h
++++ b/scipy/sparse/linalg/_dsolve/SuperLU/SRC/slu_scomplex.h
+@@ -27,8 +27,9 @@ at the top-level directory.
+ 
+ #ifndef SCOMPLEX_INCLUDE
+ #define SCOMPLEX_INCLUDE
+-
+-typedef struct { float r, i; } singlecomplex;
++#include"scipy_slu_config.h"
++// defined in  CLAPACK
++//typedef struct { float r, i; } singlecomplex;
+ 
+ 
+ /* Macro definitions */
+diff --git a/scipy/sparse/linalg/_dsolve/_superlu_utils.c b/scipy/sparse/linalg/_dsolve/_superlu_utils.c
+index 49b928a431..0822687719 100644
+--- a/scipy/sparse/linalg/_dsolve/_superlu_utils.c
++++ b/scipy/sparse/linalg/_dsolve/_superlu_utils.c
+@@ -243,12 +243,12 @@ int input_error(char *srname, int *info)
+  * Stubs for Harwell Subroutine Library functions that SuperLU tries to call.
+  */
+ 
+-void mc64id_(int *a)
++int mc64id_(int *a)
+ {
+     superlu_python_module_abort("chosen functionality not available");
+ }
+ 
+-void mc64ad_(int *a, int *b, int *c, int d[], int e[], double f[],
++int mc64ad_(int *a, int *b, int *c, int d[], int e[], double f[],
+ 	     int *g, int h[], int *i, int j[], int *k, double l[],
+ 	     int m[], int n[])
+ {
+diff --git a/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/debug.h b/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/debug.h
+index 5eb0bb1b3d..81a6efafb9 100644
+--- a/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/debug.h
++++ b/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/debug.h
+@@ -1,16 +1,16 @@
+-c
++
+ c\SCCS Information: @(#) 
+ c FILE: debug.h   SID: 2.3   DATE OF SID: 11/16/95   RELEASE: 2 
+ c
+ c     %---------------------------------%
+ c     | See debug.doc for documentation |
+ c     %---------------------------------%
+-      integer  logfil, ndigit, mgetv0,
+-     &         msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
+-     &         mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
+-     &         mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
+-      common /debug/ 
+-     &         logfil, ndigit, mgetv0,
+-     &         msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
+-     &         mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
+-     &         mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
++c      integer  logfil, ndigit, mgetv0,
++c     &         msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
++c     &         mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
++c     &         mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
++c      common /debug/
++c     &         logfil, ndigit, mgetv0,
++c     &         msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd,
++c     &         mnaupd, mnaup2, mnaitr, mneigh, mnapps, mngets, mneupd,
++c     &         mcaupd, mcaup2, mcaitr, mceigh, mcapps, mcgets, mceupd
+diff --git a/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/stat.h b/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/stat.h
+index 66a8e9f87f..81d49c3bd2 100644
+--- a/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/stat.h
++++ b/scipy/sparse/linalg/_eigen/arpack/ARPACK/SRC/stat.h
+@@ -5,17 +5,17 @@ c
+ c\SCCS Information: @(#) 
+ c FILE: stat.h   SID: 2.2   DATE OF SID: 11/16/95   RELEASE: 2 
+ c
+-      real       t0, t1, t2, t3, t4, t5
+-      save       t0, t1, t2, t3, t4, t5
++c      real       t0, t1, t2, t3, t4, t5
++c      save       t0, t1, t2, t3, t4, t5
+ c
+-      integer    nopx, nbx, nrorth, nitref, nrstrt
+-      real       tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
+-     &           tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
+-     &           tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
+-     &           tmvopx, tmvbx, tgetv0, titref, trvec
+-      common /timing/ 
+-     &           nopx, nbx, nrorth, nitref, nrstrt,
+-     &           tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
+-     &           tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
+-     &           tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
+-     &           tmvopx, tmvbx, tgetv0, titref, trvec
++c      integer    nopx, nbx, nrorth, nitref, nrstrt
++c      real       tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
++c     &           tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
++c     &           tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
++c     &           tmvopx, tmvbx, tgetv0, titref, trvec
++c      common /timing/
++c     &           nopx, nbx, nrorth, nitref, nrstrt,
++c     &           tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
++c     &           tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
++c     &           tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
++c     &           tmvopx, tmvbx, tgetv0, titref, trvec
+-- 
+2.34.1
+
diff --git a/integration_tests/recipes/scipy/patches/0005-Fix-fitpack.patch b/integration_tests/recipes/scipy/patches/0005-Fix-fitpack.patch
new file mode 100644
index 00000000..1df3145c
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0005-Fix-fitpack.patch
@@ -0,0 +1,112 @@
+From c784d3a1ee38da88943364de4ea847a3b9cd155f Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Tue, 30 Aug 2022 11:51:53 -0700
+Subject: [PATCH 5/18] Fix fitpack
+
+---
+ scipy/interpolate/fitpack/dblint.f | 9 ++++-----
+ scipy/interpolate/fitpack/evapol.f | 5 ++---
+ scipy/interpolate/fitpack/fprati.f | 5 ++---
+ scipy/interpolate/fitpack/splint.f | 7 +++----
+ 4 files changed, 11 insertions(+), 15 deletions(-)
+
+diff --git a/scipy/interpolate/fitpack/dblint.f b/scipy/interpolate/fitpack/dblint.f
+index 8ae6b175f..51ec84744 100644
+--- a/scipy/interpolate/fitpack/dblint.f
++++ b/scipy/interpolate/fitpack/dblint.f
+@@ -1,7 +1,6 @@
+-      recursive function dblint(tx,nx,ty,ny,c,kx,ky,xb,xe,yb,
+-     *    ye,wrk) result(dblint_res)
++      recursive real*8 function dblint(tx,nx,ty,ny,c,kx,ky,xb,xe,yb,
++     *    ye,wrk)
+       implicit none
+-      real*8 :: dblint_res
+ c  function dblint calculates the double integral
+ c         / xe  / ye
+ c        |     |      s(x,y) dx dy
+@@ -75,7 +74,7 @@ c  we calculate the integrals of the normalized b-splines ni,kx+1(x)
+ c  we calculate the integrals of the normalized b-splines nj,ky+1(y)
+       call fpintb(ty,ny,wrk(nkx1+1),nky1,yb,ye)
+ c  calculate the integral of s(x,y)
+-      dblint_res = 0.
++      dblint = 0.
+       do 200 i=1,nkx1
+         res = wrk(i)
+         if(res.eq.0.) go to 200
+@@ -84,7 +83,7 @@ c  calculate the integral of s(x,y)
+         do 100 j=1,nky1
+           m = m+1
+           l = l+1
+-          dblint_res = dblint_res + res*wrk(l)*c(m)
++          dblint = dblint + res*wrk(l)*c(m)
+  100    continue
+  200  continue
+       return
+diff --git a/scipy/interpolate/fitpack/evapol.f b/scipy/interpolate/fitpack/evapol.f
+index f02569a40..1e4d65724 100644
+--- a/scipy/interpolate/fitpack/evapol.f
++++ b/scipy/interpolate/fitpack/evapol.f
+@@ -1,6 +1,5 @@
+-      recursive function evapol(tu,nu,tv,nv,c,rad,x,y) result(e_res)
++      recursive real*8 function evapol(tu,nu,tv,nv,c,rad,x,y)
+       implicit none
+-      real*8 :: e_res
+ c  function program evacir evaluates the function f(x,y) = s(u,v),
+ c  defined through the transformation
+ c      x = u*rad(v)*cos(v)    y = u*rad(v)*sin(v)
+@@ -78,7 +77,7 @@ c  calculate the (u,v)-coordinates of the given point.
+       if(u.gt.one) u = one
+ c  evaluate s(u,v)
+   10  call bispev(tu,nu,tv,nv,c,3,3,u,1,v,1,f,wrk,8,iwrk,2,ier)
+-      e_res = f
++      evapol = f
+       return
+       end
+ 
+diff --git a/scipy/interpolate/fitpack/fprati.f b/scipy/interpolate/fitpack/fprati.f
+index 71c57eb01..97b5851df 100644
+--- a/scipy/interpolate/fitpack/fprati.f
++++ b/scipy/interpolate/fitpack/fprati.f
+@@ -1,6 +1,5 @@
+-      recursive function fprati(p1,f1,p2,f2,p3,f3) result(fprati_res)
++      real*8 function fprati(p1,f1,p2,f2,p3,f3)
+       implicit none
+-      real*8 :: fprati_res
+ c  given three points (p1,f1),(p2,f2) and (p3,f3), function fprati
+ c  gives the value of p such that the rational interpolating function
+ c  of the form r(p) = (u*p+v)/(p+w) equals zero at p.
+@@ -26,6 +25,6 @@ c  adjust the value of p1,f1,p3 and f3 such that f1 > 0 and f3 < 0.
+       go to 40
+   30  p3 = p2
+       f3 = f2
+-  40  fprati_res = p
++  40  fprati = p
+       return
+       end
+diff --git a/scipy/interpolate/fitpack/splint.f b/scipy/interpolate/fitpack/splint.f
+index 02b00da6a..6024a0476 100644
+--- a/scipy/interpolate/fitpack/splint.f
++++ b/scipy/interpolate/fitpack/splint.f
+@@ -1,6 +1,5 @@
+-      recursive function splint(t,n,c,nc,k,a,b,wrk) result(splint_res)
++      real*8 function splint(t,n,c,nc,k,a,b,wrk)
+       implicit none
+-      real*8 :: splint_res
+ c  function splint calculates the integral of a spline function s(x)
+ c  of degree k, which is given in its normalized b-spline representation
+ c
+@@ -54,9 +53,9 @@ c  calculate the integrals wrk(i) of the normalized b-splines
+ c  ni,k+1(x), i=1,2,...nk1.
+       call fpintb(t,n,wrk,nk1,a,b)
+ c  calculate the integral of s(x).
+-      splint_res = 0.0d0
++      splint = 0.0d0
+       do 10 i=1,nk1
+-        splint_res = splint_res+c(i)*wrk(i)
++        splint = splint+c(i)*wrk(i)
+   10  continue
+       return
+       end
+-- 
+2.34.1
+
diff --git a/integration_tests/recipes/scipy/patches/0006-Fix-gees-calls.patch b/integration_tests/recipes/scipy/patches/0006-Fix-gees-calls.patch
new file mode 100644
index 00000000..feabf913
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0006-Fix-gees-calls.patch
@@ -0,0 +1,38 @@
+From 8addc1da35bc63df651946ef14c723797a431e0c Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Mon, 26 Jun 2023 20:12:25 -0700
+Subject: [PATCH 6/18] Fix gees calls
+
+---
+ scipy/linalg/flapack_gen.pyf.src | 8 ++++----
+ 1 file changed, 4 insertions(+), 4 deletions(-)
+
+diff --git a/scipy/linalg/flapack_gen.pyf.src b/scipy/linalg/flapack_gen.pyf.src
+index 04037fdca..3686cea86 100644
+--- a/scipy/linalg/flapack_gen.pyf.src
++++ b/scipy/linalg/flapack_gen.pyf.src
+@@ -1196,8 +1196,8 @@ subroutine gees(compute_v,sort_t,select,n,a,nrows,sdim,w,vs,
+     !  A = Z * T * Z^H  -- a complex matrix is in Schur form if it is upper
+     !  triangular
+ 
+-    callstatement (*f2py_func)((compute_v?"V":"N"),(sort_t?"S":"N"),cb_select_in_gees__user__routines,&n,a,&nrows,&sdim,w,vs,&ldvs,work,&lwork,rwork,bwork,&info,1,1)
+-    callprotoargument char*,char*,F_INT(*)(*),F_INT*,*,F_INT*,F_INT*,*,*,F_INT*,*,F_INT*,*,F_INT*,F_INT*,F_INT,F_INT
++    callstatement (*f2py_func)((compute_v?"V":"N"),(sort_t?"S":"N"),cb_select_in_gees__user__routines,&n,a,&nrows,&sdim,w,vs,&ldvs,work,&lwork,rwork,bwork,&info)
++    callprotoargument char*,char*,F_INT(*)(*),F_INT*,*,F_INT*,F_INT*,*,*,F_INT*,*,F_INT*,*,F_INT*,F_INT*
+ 
+     use gees__user__routines
+ 
+@@ -1226,8 +1226,8 @@ subroutine gees(compute_v,sort_t,select,n,a,nrows,sdim,wr,wi,v
+     !  A = Z * T * Z^H  -- a real matrix is in Schur form if it is upper quasi-
+     !  triangular with 1x1 and 2x2 blocks.
+ 
+-    callstatement (*f2py_func)((compute_v?"V":"N"),(sort_t?"S":"N"),cb_select_in_gees__user__routines,&n,a,&nrows,&sdim,wr,wi,vs,&ldvs,work,&lwork,bwork,&info,1,1)
+-    callprotoargument char*,char*,F_INT(*)(*,*),F_INT*,*,F_INT*,F_INT*,*,*,*,F_INT*,*,F_INT*,F_INT*,F_INT*,F_INT,F_INT
++    callstatement (*f2py_func)((compute_v?"V":"N"),(sort_t?"S":"N"),cb_select_in_gees__user__routines,&n,a,&nrows,&sdim,wr,wi,vs,&ldvs,work,&lwork,bwork,&info)
++    callprotoargument char*,char*,F_INT(*)(*,*),F_INT*,*,F_INT*,F_INT*,*,*,*,F_INT*,*,F_INT*,F_INT*,F_INT*
+ 
+     use gees__user__routines
+ 
+-- 
+2.34.1
+
diff --git a/integration_tests/recipes/scipy/patches/0007-MAINT-linalg-Remove-id_dist-Fortran-files.patch b/integration_tests/recipes/scipy/patches/0007-MAINT-linalg-Remove-id_dist-Fortran-files.patch
new file mode 100644
index 00000000..e3a57c5b
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0007-MAINT-linalg-Remove-id_dist-Fortran-files.patch
@@ -0,0 +1,21867 @@
+From 12ba8a395ce04194074a24d362143c22e7ac54bd Mon Sep 17 00:00:00 2001
+From: Ilhan Polat 
+Date: Tue, 23 Apr 2024 09:26:38 +0200
+Subject: [PATCH 7/18] MAINT:linalg:Remove id_dist Fortran files
+
+[skip ci]
+
+ENH:linalg:Translate id_dist F77 code to Cython
+
+MAINT:linalg: Convert double to numpy types
+
+MAINT:linalg: Fix linting and a typo in interpolative code
+
+DOC:linalg: Remove non-compliant dash character
+
+MAINT:linalg: Modify meson file for id_dist F77 translation
+
+[skip ci]
+
+MAINT:linalg: Adjust public api for the translated funcs
+
+[skip ci]
+
+ENH:linalg: Modify function signatures for interpolative
+
+[skip ci]
+
+TST:linalg: Adjust tests for the id_dist translation
+
+MAINT:linalg:Remove fortran wrappers for id_dist
+
+[skip ci]
+
+MAINT:linalg:Modify mypy.ini for interpolative Cython code
+
+DOC:linalg: Adjust interpolative docs due to new Cython code
+
+DOC:linalg: Fix grammar and typos
+---
+ mypy.ini                                      |    2 +-
+ scipy/linalg/_decomp_interpolative.pyx        | 1992 +++++++++++
+ scipy/linalg/_interpolative_backend.py        | 1681 ---------
+ scipy/linalg/interpolative.py                 |  316 +-
+ scipy/linalg/meson.build                      |   55 +-
+ scipy/linalg/src/id_dist/README.txt           |    6 -
+ scipy/linalg/src/id_dist/doc/doc.bib          |   19 -
+ scipy/linalg/src/id_dist/doc/doc.tex          |  977 ------
+ scipy/linalg/src/id_dist/doc/supertabular.sty |  483 ---
+ scipy/linalg/src/id_dist/src/dfft.f           | 3014 -----------------
+ scipy/linalg/src/id_dist/src/id_rand.f        |  379 ---
+ scipy/linalg/src/id_dist/src/id_rtrans.f      |  746 ----
+ scipy/linalg/src/id_dist/src/idd_frm.f        |  525 ---
+ scipy/linalg/src/id_dist/src/idd_house.f      |  288 --
+ scipy/linalg/src/id_dist/src/idd_id.f         |  560 ---
+ scipy/linalg/src/id_dist/src/idd_id2svd.f     |  384 ---
+ scipy/linalg/src/id_dist/src/idd_qrpiv.f      |  893 -----
+ scipy/linalg/src/id_dist/src/idd_sfft.f       |  443 ---
+ scipy/linalg/src/id_dist/src/idd_snorm.f      |  400 ---
+ scipy/linalg/src/id_dist/src/idd_svd.f        |  409 ---
+ scipy/linalg/src/id_dist/src/iddp_aid.f       |  386 ---
+ scipy/linalg/src/id_dist/src/iddp_asvd.f      |  180 -
+ scipy/linalg/src/id_dist/src/iddp_rid.f       |  376 --
+ scipy/linalg/src/id_dist/src/iddp_rsvd.f      |  216 --
+ scipy/linalg/src/id_dist/src/iddr_aid.f       |  208 --
+ scipy/linalg/src/id_dist/src/iddr_asvd.f      |  114 -
+ scipy/linalg/src/id_dist/src/iddr_rid.f       |  155 -
+ scipy/linalg/src/id_dist/src/iddr_rsvd.f      |  157 -
+ scipy/linalg/src/id_dist/src/idz_frm.f        |  419 ---
+ scipy/linalg/src/id_dist/src/idz_house.f      |  298 --
+ scipy/linalg/src/id_dist/src/idz_id.f         |  566 ----
+ scipy/linalg/src/id_dist/src/idz_id2svd.f     |  389 ---
+ scipy/linalg/src/id_dist/src/idz_qrpiv.f      |  898 -----
+ scipy/linalg/src/id_dist/src/idz_sfft.f       |  210 --
+ scipy/linalg/src/id_dist/src/idz_snorm.f      |  407 ---
+ scipy/linalg/src/id_dist/src/idz_svd.f        |  438 ---
+ scipy/linalg/src/id_dist/src/idzp_aid.f       |  390 ---
+ scipy/linalg/src/id_dist/src/idzp_asvd.f      |  207 --
+ scipy/linalg/src/id_dist/src/idzp_rid.f       |  379 ---
+ scipy/linalg/src/id_dist/src/idzp_rsvd.f      |  244 --
+ scipy/linalg/src/id_dist/src/idzr_aid.f       |  209 --
+ scipy/linalg/src/id_dist/src/idzr_asvd.f      |  118 -
+ scipy/linalg/src/id_dist/src/idzr_rid.f       |  156 -
+ scipy/linalg/src/id_dist/src/idzr_rsvd.f      |  159 -
+ scipy/linalg/src/id_dist/src/prini.f          |  113 -
+ scipy/linalg/tests/test_interpolative.py      |   78 +-
+ 46 files changed, 2159 insertions(+), 18883 deletions(-)
+ create mode 100644 scipy/linalg/_decomp_interpolative.pyx
+ delete mode 100644 scipy/linalg/_interpolative_backend.py
+ delete mode 100644 scipy/linalg/src/id_dist/README.txt
+ delete mode 100644 scipy/linalg/src/id_dist/doc/doc.bib
+ delete mode 100644 scipy/linalg/src/id_dist/doc/doc.tex
+ delete mode 100644 scipy/linalg/src/id_dist/doc/supertabular.sty
+ delete mode 100644 scipy/linalg/src/id_dist/src/dfft.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/id_rand.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/id_rtrans.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_frm.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_house.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_id.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_id2svd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_qrpiv.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_sfft.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_snorm.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idd_svd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddp_aid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddp_asvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddp_rid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddp_rsvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddr_aid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddr_asvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddr_rid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/iddr_rsvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_frm.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_house.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_id.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_id2svd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_qrpiv.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_sfft.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_snorm.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idz_svd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzp_aid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzp_asvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzp_rid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzp_rsvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzr_aid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzr_asvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzr_rid.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/idzr_rsvd.f
+ delete mode 100644 scipy/linalg/src/id_dist/src/prini.f
+
+diff --git a/mypy.ini b/mypy.ini
+index 4417af39dc..4bdbdf9750 100644
+--- a/mypy.ini
++++ b/mypy.ini
+@@ -140,7 +140,7 @@ ignore_missing_imports = True
+ [mypy-scipy.linalg._solve_toeplitz]
+ ignore_missing_imports = True
+ 
+-[mypy-scipy.linalg._interpolative]
++[mypy-scipy.linalg._decomp_interpolative]
+ ignore_missing_imports = True
+ 
+ [mypy-scipy.optimize._group_columns]
+diff --git a/scipy/linalg/_decomp_interpolative.pyx b/scipy/linalg/_decomp_interpolative.pyx
+new file mode 100644
+index 000000000..e1a5b2a62
+--- /dev/null
++++ b/scipy/linalg/_decomp_interpolative.pyx
+@@ -0,0 +1,1992 @@
++# cython: boundscheck=False
++# cython: initializedcheck=False
++# cython: wraparound=False
++# cython: cdivision=True
++# cython: cpow=True
++
++"""
++This file is a Cython rewrite of the original Fortran code of "ID: A software package
++for low-rank approximation of matrices via interpolative decompositions, Version 0.4",
++written by Per-Gunnar Martinsson, Vladimir Rokhlin, Yoel Shkolnisky, and Mark Tygert.
++
++The original Fortran code can be found at the last author's current website
++http://tygert.com/software.html
++
++
++References
++----------
++
++N. Halko, P.G. Martinsson, and J. A. Tropp, "Finding structure with randomness:
++probabilistic algorithms for constructing approximate matrix decompositions",
++SIAM Review, 53 (2011), pp. 217-288. DOI:10.1137/090771806
++
++H. Cheng, Z. Gimbutas, P.G. Martinsson, V.Rokhlin, "On the Compression of Low
++Rank Matrices", SIAM Journal of Scientific Computing, 2005, Vol.26(4),
++DOI:10.1137/030602678
++
++
++
++Copyright (C) 2024 SciPy developers
++
++Redistribution and use in source and binary forms, with or without
++modification, are permitted provided that the following conditions are met:
++
++a. Redistributions of source code must retain the above copyright notice,
++   this list of conditions and the following disclaimer.
++b. Redistributions in binary form must reproduce the above copyright
++   notice, this list of conditions and the following disclaimer in the
++   documentation and/or other materials provided with the distribution.
++c. Names of the SciPy Developers may not be used to endorse or promote
++   products derived from this software without specific prior written
++   permission.
++
++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
++AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
++IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
++ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS
++BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
++OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
++SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
++INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
++CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
++ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
++THE POSSIBILITY OF SUCH DAMAGE.
++
++
++Notes
++-----
++
++The translated functions from the original Fortran77 code are as follows (with various
++internal functions subsumed into respective functions):
++
++    idd_diffsnorm
++    idd_estrank
++    idd_findrank
++    idd_id2svd
++    idd_ldiv
++    idd_poweroftwo
++    idd_reconid
++    idd_snorm
++    iddp_aid
++    iddp_asvd
++    iddp_id
++    iddp_qrpiv
++    iddp_rid
++    iddp_rsvd
++    iddp_svd
++    iddr_aid
++    iddr_asvd
++    iddr_id
++    iddr_qrpiv
++    iddr_rid
++    iddr_rsvd
++    iddr_svd
++    idz_diffsnorm
++    idz_estrank
++    idz_findrank
++    idz_id2svd
++    idz_reconid
++    idz_snorm
++    idzp_aid
++    idzp_asvd
++    idzp_id
++    idzp_qrpiv
++    idzp_rid
++    idzp_rsvd
++    idzp_svd
++    idzr_aid
++    idzr_asvd
++    idzr_id
++    idzr_rid
++    idzr_rsvd
++    idzr_qrpiv
++    idzr_svd
++
++"""
++
++import numpy as np
++from numpy.typing import NDArray
++cimport numpy as cnp
++cnp.import_array()
++
++from cpython.mem cimport PyMem_Free, PyMem_Malloc, PyMem_Realloc
++from libc.math cimport hypot
++
++import scipy.linalg as la
++from scipy.fft import rfft, fft
++from scipy.sparse.linalg import LinearOperator
++
++from scipy.linalg.cython_lapack cimport dlarfgp, dorm2r, zunm2r, zlarfgp
++from scipy.linalg.cython_blas cimport dnrm2, dtrsm, dznrm2, ztrsm
++
++
++__all__ = ['idd_estrank', 'idd_ldiv', 'idd_poweroftwo', 'idd_reconid', 'iddp_aid',
++           'iddp_asvd', 'iddp_id', 'iddp_qrpiv', 'iddp_svd', 'iddr_aid', 'iddr_asvd',
++           'iddr_id', 'iddr_qrpiv', 'iddr_svd', 'idz_estrank', 'idz_reconid',
++           'idzp_aid', 'idzp_asvd', 'idzp_id', 'idzp_qrpiv', 'idzp_svd', 'idzr_aid',
++           'idzr_asvd', 'idzr_id', 'idzr_qrpiv', 'idzr_svd', 'idd_id2svd', 'idz_id2svd'
++           # LinearOperator funcs
++           'idd_findrank', 'iddp_rid', 'iddp_rsvd', 'iddr_rid', 'iddr_rsvd',
++           'idz_findrank', 'idzp_rid', 'idzp_rsvd', 'idzr_rid', 'idzr_rsvd',
++           'idd_snorm', 'idz_snorm', 'idd_diffsnorm', 'idz_diffsnorm'
++           ]
++
++
++def idd_diffsnorm(A: LinearOperator, B: LinearOperator, int its=20, rng=None):
++    cdef int n = A.shape[1], j = 0, intone = 1
++    cdef cnp.float64_t snorm = 0.0
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] v1
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] v2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] u1
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] u2
++
++    if not rng:
++        rng = np.random.default_rng()
++    v1 = rng.uniform(low=-1., high=1., size=n)
++    v1 /= dnrm2(&n, &v1[0], &intone)
++
++    for j in range(its):
++        u1 = A.matvec(v1)
++        u2 = B.matvec(v1)
++        u1 -= u2
++        v1 = A.rmatvec(u1)
++        v2 = B.rmatvec(u1)
++        v1 -= v2
++
++        snorm = dnrm2(&n, &v1[0], &intone)
++        if snorm > 0.0:
++            v1 /= snorm
++
++        snorm = np.sqrt(snorm)
++
++    return snorm
++
++
++def idd_estrank(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a: NDArray, eps: float,
++                rng=None):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int intone = 1, n2, nsteps = 3, row, r, nstep, cols, k, nulls
++    cdef cnp.float64_t h, alpha, beta
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=3] albetas
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau_arr
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] subselect
++    cdef cnp.float64_t *aa
++    cdef cnp.float64_t *ff
++    cdef cnp.float64_t[:, ::1] Fmemview
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] giv2x2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] rta
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] Fc
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] F
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    n2 = idd_poweroftwo(m)
++
++    # This part is the initialization that is done via idd_frmi
++    # for a Subsampled Randomized Fourier Transfmrom (SRFT).
++
++    # Draw (nsteps x m x 2) arrays from [-1, 1) uniformly and scale
++    # each 2-element row to unity norm
++    albetas = rng.uniform(low=-1.0, high=1.0, size=[nsteps, m, 2])
++    aa = cnp.PyArray_DATA(albetas)
++    # Walk over every 2D row and normalize
++    for r in range(0, 2*nsteps*m, 2):
++        h = 1/hypot(aa[r], aa[r+1])
++        aa[r] *= h
++        aa[r+1] *= h
++
++    # idd_random_transf
++    rta = a.copy()
++
++    # Rotate and shuffle "a" nsteps-many times
++    giv2x2 = cnp.PyArray_ZEROS(2, [2, 2], cnp.NPY_FLOAT64, 0)
++    for nstep in range(nsteps):
++        for row in range(m-1):
++            alpha, beta = albetas[nstep, row, 0], albetas[nstep, row, 1]
++            giv2x2[0, 0] = alpha
++            giv2x2[0, 1] = beta
++            giv2x2[1, 0] = -beta
++            giv2x2[1, 1] = alpha
++            np.matmul(giv2x2, rta[row:row+2, :], out=rta[row:row+2, :])
++
++        rta = rta[rng.permutation(m), :]
++
++    # idd_subselect pick randomly n2-many rows
++    subselect = rng.choice(m, n2, replace=False)
++    rta = rta[subselect, :]
++
++    # Perform rfft on each column. Note that the first and the last
++    # element of the result is real valued (n2 is power of 2).
++    #
++    # We view the complex valued entries as two consecutive doubles
++    # (by also removing the 2nd and last all-0 rows -- see idd_frm).
++    # Then after transpose we do a final row shuffle after transpose.
++    Fc = rfft(rta.T, axis=1)
++    # Move the first col to second col
++    Fc[:, 0] *= 1.j
++    # Perform the final permutation
++    F = Fc.view(np.float64)[:, 1:-1].T[rng.permutation(n2), :]
++
++    Fcopy = F.copy()
++    cols = F.shape[1]
++    row = F.shape[0]
++    sssmax = 0.
++    ff = cnp.PyArray_DATA(F)
++    for r in range(cols):
++        h = dnrm2(&row, &ff[r], &cols)
++        if h > sssmax:
++            sssmax = h
++
++    tau_arr = cnp.PyArray_ZEROS(1, [cols], cnp.NPY_FLOAT64, 0)
++    k, nulls = 0, 0
++
++    # In Fortran id_dist, F is transposed and works on the columns
++    # Since we have a C-array we work directly on rows
++    # The reflectors are overwritten on rows of F directly
++    # Hence at any k'th step, we have
++    #
++    #            [ B  r  r  r  r  r  r  r ]
++    #            [           ....         ]
++    #            [           ....         ]
++    #            [ x  x  x  B  r  r  r  r ]
++    #            [ x  x  x  x  B  r  r  r ]
++    #            [ x  x  x  x  x  B  r  r ]
++    #            [ x  x  x  x  x  x  x  x ]
++    #            [ x  x  x  x  x  x  x  x ]
++    #
++
++    # Loop until nulls = 7, or krank+nulls = n2, or krank+nulls = n.
++    Fmemview = F
++    while (nulls < 7) and (k+nulls < min(n, n2)):
++        # Apply previous Householder reflectors
++        if k > 0:
++            for kk in range(k):
++                F[k, kk:] -= tau_arr[kk]*(F[kk, kk:] @ F[k, kk:])*F[kk, kk:]
++
++        # Get the next Householder reflector and store in F
++        r = cols-k
++        # n, alpha, x, incx, tau
++        dlarfgp(&r, &Fmemview[k, k], &Fmemview[k, k+1], &intone, &tau_arr[k])
++        beta = F[k, k]
++        F[k, k] = 1
++
++        if (beta <= eps*sssmax):
++            nulls += 1
++        k += 1
++
++    if nulls < 7:
++        k = 0
++
++    return k, Fcopy
++
++
++def idd_findrank(A: LinearOperator, cnp.float64_t eps, rng=None):
++    # Estimate the rank of A by repeatedly using A.rmatvec(random vec)
++
++    cdef int m = A.shape[0], n = A.shape[1], k = 0, kk = 0,r = n, krank
++    cdef int no_of_cols = 4, intone = 1, info = 0
++    cdef cnp.float64_t[::1] tau = cnp.PyArray_ZEROS(1, [min(m, n)], cnp.NPY_FLOAT64, 0)
++    cdef cnp.float64_t[::1] y = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] retarr
++
++    # The size of the QR decomposition is rank dependent which is unknown
++    # at runtime. Hence we don't want to allocate a dense version of the
++    # linear operator which can be too big. Instead, a typical "realloc double
++    # if run out of space" strategy is used here. Starts with 4*n
++    # Also, we hold the A.T @ x results in a separate array to return
++    # and do the same for that too.
++    cdef cnp.float64_t *ra = PyMem_Malloc(
++        sizeof(cnp.float64_t)*no_of_cols*n
++        )
++    cdef cnp.float64_t *reallocated_ra
++    cdef cnp.float64_t *ret = PyMem_Malloc(
++        sizeof(cnp.float64_t)*no_of_cols*n
++        )
++    cdef cnp.float64_t *reallocated_ret
++    cdef cnp.float64_t enorm = 0.0
++
++    if (not ra) or (not ret):
++        raise MemoryError("Failed to allocate at least required memory "
++                          f"{no_of_cols*n*8} bytes for"
++                          "'scipy.linalg.interpolative.idd_findrank()' "
++                          "function.")
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    krank = 0
++    try:
++        while True:
++
++            # Generate random vector and rmatvec then save the result
++            x = rng.uniform(size=m)
++            y = A.rmatvec(x)
++            for kk in range(n):
++                ret[krank*n + kk] = y[kk]
++
++            if krank == 0:
++                enorm = dnrm2(&n, &y[0], &intone)
++            else:  # krank > 0
++                # Transpose-Apply previous Householder reflectors, if any
++                # SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO
++                dorm2r('L','T', &n, &intone, &krank, &ra[0], &n,
++                       &tau[0], &y[0], &n, &ra[(no_of_cols-1)*n], &info)
++
++            # Get the next Householder reflector
++            r = n-krank
++            # N, ALPHA, X, INCX, TAU
++            dlarfgp(&r, &y[krank], &y[krank+1], &intone, &tau[krank])
++
++            for kk in range(n):
++                ra[krank*n + kk] = y[kk]
++
++            # Running out of space; try to double the size of ra
++            if krank == (no_of_cols-2):
++                reallocated_ra = PyMem_Realloc(
++                    ra, sizeof(cnp.float64_t)*no_of_cols*n*2)
++                reallocated_ret = PyMem_Realloc(
++                    ret, sizeof(cnp.float64_t)*no_of_cols*n*2)
++
++                if reallocated_ra and reallocated_ret:
++                    ra = reallocated_ra
++                    ret = reallocated_ret
++                    no_of_cols *= 2
++                else:
++                    raise MemoryError(
++                        "'scipy.linalg.interpolative.idd_findrank()' failed to "
++                        f"allocate the required memory,{no_of_cols*n*16} bytes "
++                        "while trying to determine the rank (currently "
++                        f"{krank}) of a LinearOperator with precision {eps}."
++                    )
++            krank += 1
++            if (y[krank-1] < eps*enorm) or (krank >= min(m, n)):
++                break
++    finally:
++        # Crashed or successfully ended up here
++        # Discard Householder vectors
++        PyMem_Free(ra)
++        retarr = cnp.PyArray_EMPTY(2, [krank, n], cnp.NPY_FLOAT64, 0)
++        for k in range(krank):
++            for kk in range(n):
++                retarr[k, kk] = ret[k*n+kk]
++        PyMem_Free(ret)
++
++    return krank, retarr
++
++
++def idd_id2svd(
++    cnp.ndarray[cnp.float64_t, mode='c', ndim=2] cols,
++    cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms,
++    cnp.ndarray[cnp.float64_t, ndim=2] proj,
++    ):
++    cdef int m = cols.shape[0], krank = cols.shape[1]
++    cdef int n = proj.shape[1] + krank, info, ci
++    cdef cnp.ndarray[cnp.float64_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] V
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] p
++
++    UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_FLOAT64, 0)
++    VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_FLOAT64, 0)
++    p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_FLOAT64, 0)
++
++    # idd_reconint
++    for ci in range(krank):
++        p[ci, perms[ci]] = 1.0
++
++    p[:, perms[krank:]] = proj[:, :]
++
++    inds1, tau1 = iddr_qrpiv(cols, krank)
++    # idd_rinqr and idd_rearr
++    r = np.triu(cols[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++    t = p.T.copy()
++    inds2, tau2 = iddr_qrpiv(t, krank)
++    r2 = np.triu(t[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++    r3 = r @ r2.T
++    UU[:krank, :krank], S, V = la.svd(r3,
++                                      full_matrices=False,
++                                      check_finite=False)
++
++    # Apply Q of col to U from the left, use cols as scratch
++    C = cols[:, :krank].copy(order='F')
++    dorm2r('R', 'T',
++           &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++           &UU[0,0], &krank, &cols[0, 0], &info)
++
++    VV[:krank, :krank] = V[:, :].T
++    # Apply Q of t to V from the left
++    C = t[:, :krank].copy(order='F')
++    dorm2r('R', 'T',
++           &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++           &VV[0, 0], &krank, &cols[0, 0], &info)
++
++    return UU, S, VV
++
++
++cdef inline int idd_ldiv(int l, int n) noexcept nogil:
++    cdef int m = l
++    while (n % m != 0):
++        m -= 1
++    return m
++
++
++cdef int idd_poweroftwo(int m) noexcept nogil:
++    """
++    Find the integer solution to l = floor(log2(m))
++    """
++    cdef int n = 1
++    while (n < m):
++        n <<= 1  # Times 2
++    return n >> 1  # Divide by 2
++
++
++def idd_reconid(B, idx, proj):
++    cdef int m = B.shape[0], krank = B.shape[1]
++    cdef int n = len(idx)
++    approx = np.zeros([m, n], dtype=np.float64)
++
++    approx[:, idx[:krank]] = B
++    approx[:, idx[krank:]] = B @ proj
++
++    return approx
++
++
++def idd_snorm(A: LinearOperator, int its=20, rng=None):
++    cdef int n = A.shape[1]
++    cdef int j = 0, intone = 1
++    cdef cnp.float64_t snorm = 0.0
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] v
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] u
++
++    if not rng:
++        rng = np.random.default_rng()
++    v = rng.uniform(low=-1., high=1., size=n)
++    v /= dnrm2(&n, &v[0], &intone)
++
++    for j in range(its):
++        u = A.matvec(v)
++        v = A.rmatvec(u)
++        snorm = dnrm2(&n, &v[0], &intone)
++        if snorm > 0.0:
++            v /= snorm
++
++        snorm = np.sqrt(snorm)
++
++    return snorm
++
++
++def iddp_aid(cnp.ndarray[cnp.float64_t, ndim=2] a: NDArray, eps: float, rng=None):
++    krank, proj = idd_estrank(a, eps, rng=rng)
++    if krank != 0:
++        proj = proj[:krank, :]
++        return iddp_id(proj, eps=eps)
++
++    return iddp_id(a, eps=eps)
++
++
++def iddp_asvd(cnp.ndarray[cnp.float64_t, ndim=2] a: NDArray, eps: float, rng=None):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int krank, info, ci
++    cdef cnp.ndarray[cnp.float64_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] V
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] perms
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] p
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] col
++
++    krank, perms, proj = iddp_aid(a.copy(), eps, rng=rng)
++
++    if krank > 0:
++        UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_FLOAT64, 0)
++        VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_FLOAT64, 0)
++
++        p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_FLOAT64, 0)
++        col = a[:, perms[:krank]].copy()
++
++        # idd_reconint
++        for ci in range(krank):
++            p[ci, perms[ci]] = 1.0
++
++        # p[np.arange(krank), perms[:krank]] = 1.
++        p[:, perms[krank:]] = proj[:, :]
++
++        inds1, tau1 = iddr_qrpiv(col, krank)
++        # idd_rinqr and idd_rearr
++        r = np.triu(col[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++        t = p.T.copy()
++        inds2, tau2 = iddr_qrpiv(t, krank)
++        r2 = np.triu(t[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++        r3 = r @ r2.T
++        UU[:krank, :krank], S, V = la.svd(r3, full_matrices=False)
++
++        # Apply Q of col to U from the left
++        C = col[:, :krank].copy(order='F')
++        dorm2r('R', 'T',
++               &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++               &UU[0,0], &krank, &a[0, 0], &info)
++
++        VV[:krank, :krank] = V[:, :].T
++        # Apply Q of t to V from the left
++        C = t[:, :krank].copy(order='F')
++        dorm2r('R', 'T',
++               &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++               &VV[0, 0], &krank, &a[0, 0], &info)
++
++    return UU, S, VV
++
++
++def iddp_id(cnp.ndarray[cnp.float64_t, ndim=2] a: NDArray, eps: float):
++    cdef int n = a.shape[1], krank, tmp_int, p
++    cdef cnp.float64_t one = 1
++    krank, _, inds = iddp_qrpiv(a, eps)
++
++    # Change pivots to permutation
++    perms = cnp.PyArray_ZEROS(1, [n], cnp.NPY_INT64, 0)
++    for p in range(n):
++        perms[p] = p
++
++    if krank > 0:
++        for p in range(krank):
++            # Apply pivots
++            tmp_int = perms[p]
++            perms[p] = perms[inds[p]]
++            perms[inds[p]] = tmp_int
++            # perms[[p, inds[p]]] = perms[[inds[p], p]]
++
++    # Let A = [A1, A2] and A1 has krank cols and upper triangular.
++    # Find X that satisfies A1 @ X = A2
++    # In SciPy.linalg this amounts to;
++    #
++    # proj = la.solve_triangular(a[:krank, :krank], a[:krank, krank:],
++    #                            lower=False, check_finite=False)
++    #
++    # Push into BLAS without transposes.
++    # A1 = a[:krank, :krank]
++    # A2 = a[:krank, krank:]
++    # Instead solve X @ A1.T = A2.T
++    # Fortran already sees A1 as A1.T and becomes lower tri, side = R
++
++    tmp_int = n - krank
++    # SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB
++    dtrsm('R', 'L', 'N', 'N',
++          &tmp_int, &krank, &one, &a[0, 0], &n, &a[0, krank], &n)
++
++    return krank, np.array(perms), a[:krank, krank:]
++
++
++def iddp_qrpiv(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a, cnp.float64_t eps):
++    """
++    This is a minimal version of ?GEQP3 from LAPACK with an
++    additional early stopping criterion over given precision.
++
++    This function overwrites entries of "a" !
++    """
++
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef cnp.ndarray col_norms = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    cdef int k = 0, kpiv = 0, i = 0, tmp_int = 0, int_n = 0
++    cdef cnp.float64_t tmp_sca = 0.
++    cdef cnp.ndarray taus = cnp.PyArray_ZEROS(1, [m], cnp.NPY_FLOAT64, 0)
++    cdef cnp.ndarray ind = cnp.PyArray_ZEROS(1, [n], cnp.NPY_INT64, 0)
++    cdef cnp.float64_t[::1] taus_v = taus
++    cdef cnp.float64_t feps = 0.1e-16  # np.finfo(np.float64).eps
++    cdef cnp.float64_t ssmax, ssmaxin
++    cdef int nupdate = 0
++
++    for i in range(n):
++        col_norms[i] = dnrm2(&m, &a[0, i], &n)**2
++
++    kpiv = np.argmax(col_norms)
++    ssmax = col_norms[kpiv]
++    ssmaxin = ssmax
++
++    for k in range(min(m, n)):
++
++        # Pivoting
++        ind[k] = kpiv
++        # Swap columns a[:, k] and a[:, kpiv]
++        a[:, [kpiv, k]] = a[:, [k, kpiv]]
++
++        # Swap col_norms[krank] and col_norms[kpiv]
++        col_norms[[kpiv, k]] = col_norms[[k, kpiv]]
++
++        if k < m-1:
++            # Compute the householder reflector for column k
++            tmp_sca = a[k, k]
++            # FIX: Convert these to F_INT
++            tmp_int = (m - k)
++            int_n = n
++            dlarfgp(&tmp_int, &tmp_sca, &a[k+1, k], &int_n, &taus_v[k])
++
++            # Overwrite with 1. for easy matmul
++            a[k, k] = 1
++            if k < n-1:
++                # Apply the householder reflector to the rest on the right
++                a[k:, k+1:] -= np.outer(taus[k]*a[k:, k], a[k:, k] @ a[k:, k+1:])
++
++            # Put back the beta in place
++            a[k, k] = tmp_sca
++
++            # Update the norms
++            col_norms[k] = 0
++            col_norms[k+1:] -= a[k, k+1:]**2
++            ssmax = 0
++            kpiv = k+1
++            if k < n-1:
++                kpiv = np.argmax(col_norms[k+1:]) + (k + 1)
++                ssmax = col_norms[kpiv]
++
++            if (((ssmax < 1000*feps*ssmaxin) and (nupdate == 0)) or
++                    ((ssmax < ((1000*feps)**2)*ssmaxin) and (nupdate == 1))):
++                nupdate += 1
++                ssmax = 0
++                kpiv = k+1
++
++                if k < n-1:
++                    for i in range(k+1, n):
++                        tmp_int = m-k-1
++                        col_norms[i] = dnrm2(&tmp_int, &a[k+1, i], &n)**2
++                    kpiv = np.argmax(col_norms[k+1:]) + (k + 1)
++                    ssmax = col_norms[kpiv]
++        if (ssmax <= (eps**2)*ssmaxin):
++            break
++    # a is overwritten; return numerical rank and pivots
++    return k + 1, taus, ind
++
++
++def iddp_rid(A: LinearOperator, cnp.float64_t eps, rng=None):
++    _, ret = idd_findrank(A, eps, rng)
++    return iddp_id(ret, eps)
++
++
++def iddp_rsvd(A: LinearOperator, cnp.float64_t eps, rng=None):
++    cdef int n = A.shape[1]
++    cdef int krank, j
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] col
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] x
++
++    krank, perms, proj = iddp_rid(A, eps, rng)
++    if krank > 0:
++        # idd_getcols
++        col = cnp.PyArray_EMPTY(2, [n, krank], cnp.NPY_FLOAT64, 0)
++        x = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++
++        for j in range(krank):
++            x[perms[j]] = 1.
++            col[:, j] = A.matvec(x)
++            x[perms[j]] = 0.
++
++        return idd_id2svd(cols=col, perms=perms, proj=proj)
++
++    # TODO: figure out empty return
++    return None
++
++
++def iddp_svd(cnp.ndarray[cnp.float64_t, ndim=2] a: NDArray, eps: float):
++    """a is overwritten"""
++    cdef int m = a.shape[0], krank, info
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] taus
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='fortran', ndim=2] C
++
++    # Get the pivoted QR
++    krank, taus, inds = iddp_qrpiv(a, eps)
++
++    if krank > 0:
++        r = np.triu(a[:krank, :])
++        # Apply pivots in reverse
++        for p in range(krank-1, -1, -1):
++            r[:, [p, inds[p]]] = r[:, [inds[p], p]]
++
++        # JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO
++        # dgesvd('S', 'O', &krank, &n)
++        U, S, V = la.svd(r, full_matrices=False)
++
++        # Apply Q to U via dorm2r
++        # Possibly U is shorter than Q
++        UU = np.zeros([m, krank], dtype=a.dtype)
++        UU[:krank, :krank] = U
++        # Do the transpose dance for C-layout, use a for scratch
++        C = a[:, :krank].copy(order='F')
++        dorm2r('R', 'T',
++               &krank, &m, &krank, &C[0, 0], &m, &taus[0],
++               &UU[0,0], &krank, &a[0, 0], &info)
++
++    return UU, S, V
++
++
++def iddr_aid(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a: NDArray, int krank,
++             rng=None):
++    cdef int m = a.shape[0], n = a.shape[1], n2, nsteps = 3, row, r, nstep, L
++    cdef cnp.float64_t h, alpha, beta
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=3] albetas
++    cdef cnp.ndarray[cnp.npy_int64, mode='c', ndim=1] subselect
++    cdef cnp.float64_t *aa
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] giv2x2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] rta
++    cdef cnp.ndarray[cnp.npy_int64, mode='c', ndim=1] marker
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    # idd_aidi
++    L = krank + 8
++    n2 = 0
++    if (L >= n2) or (L > m):
++        inds, proj = iddr_id(a, krank)
++        return inds, proj
++
++    n2 = idd_poweroftwo(m)
++
++    # idd_sfrmi
++    # idd_pairsamps
++    ind = rng.permutation(n2)
++    ind2 = cnp.PyArray_ZEROS(1, [L], cnp.NPY_INT64, 0)
++
++    marker = cnp.PyArray_ZEROS(1, [n2//2], cnp.NPY_INT64, 0)
++    for k in range(L):
++        marker[(ind[k]+1)//2] = marker[(ind[k]+1)//2]+1
++
++    for r in range(n2//2):
++        if marker[r] != 0:
++            l2 += 1
++            ind2[r] = r
++
++    # Draw (nsteps x m x 2) arrays from [-1, 1) uniformly and scale
++    # each 2-element row to unity norm
++    albetas = rng.uniform(low=-1.0, high=1.0, size=[nsteps, m, 2])
++    aa = cnp.PyArray_DATA(albetas)
++    # Walk over every 2D row and normalize
++    for r in range(0, 2*nsteps*m, 2):
++        # ignoring the improbable zero generation by rng.uniform
++        h = 1.0/hypot(aa[r], aa[r+1])
++        aa[r] *= h
++        aa[r+1] *= h
++
++    # idd_random_transf
++    rta = a.copy()
++
++    # Rotate and shuffle "a" nsteps-many times
++    giv2x2 = cnp.PyArray_ZEROS(2, [2, 2], cnp.NPY_FLOAT64, 0)
++    for nstep in range(nsteps):
++        for row in range(m-1):
++            alpha, beta = albetas[nstep, row, 0], albetas[nstep, row, 1]
++            giv2x2[0, 0] = alpha
++            giv2x2[0, 1] = beta
++            giv2x2[1, 0] = -beta
++            giv2x2[1, 1] = alpha
++            np.matmul(giv2x2, rta[row:row+2, :], out=rta[row:row+2, :])
++
++        rta = rta[rng.permutation(m), :]
++
++    # idd_subselect pick randomly n2-many rows
++    subselect = rng.choice(m, n2, replace=False)
++    rta = rta[subselect, :]
++
++    # idd_sffti
++    twopi = 2*np.pi
++    twopii = twopi*1.j
++    nblock = idd_ldiv(l2, n2)
++    fact = 1/np.sqrt(n2)
++
++    if l2 == 1:
++        wsave = np.exp(-twopii*k*ind2[0]/np.arange(1, n2+1))*fact
++    else:
++        m = n2//nblock
++
++        wsave = np.empty(m*l2, dtype=complex)
++        for j in range(l2):
++            i = ind2[j]
++            if (i+1) <= (n//2 - m//2):
++                idivm = i // m
++                imodm = i - m*idivm
++                for k in range(m):
++                    wsave[m*j+k] = (
++                        np.exp(-twopii*(k)*imodm/m)*
++                        np.exp(-twopii*(k)*(idivm+1)/n)*
++                        fact
++                        )
++            else:
++                idivm = (i+1)//(m//2)
++                imodm = (i+1)-(m//2)*idivm
++                for k in range(m):
++                    wsave[m*j+k] = np.exp(-twopii*(k-1)*imodm/m)*fact
++
++    # idd_sfft.f
++    # There is some significant index olympics happening in the original Fortran code
++    # however I could not reverse engineer it to understand what is happening and kept
++    # as is with all its cryptic movements and their performance hits.
++    # See DOI:10.1016/j.acha.2007.12.002 - Section 3.3
++
++    # Perform partial FFT to each nblock
++    F = rfft(rta.reshape(nblock, m, -1), order='F', axis=0)
++    # Roll the first entry to the last in the first axis for
++    # the real frequency components. (faster than np.roll)
++    F = F[[x for x in range(1, F.shape[0])] + [0], :, :]
++    # Convert back to 2D array
++    F = F.reshape(F.shape[0]*F.shape[1], -1)
++
++    csum = np.zeros_like(F[0, :])
++    rsum = np.zeros_like(F[0, :])
++
++    for j in range(l2):
++        i = ind2[j]
++        if (i+1) <= (n//2 - m//2):
++            idivm = i // m
++            imodm = i - m*idivm
++            csum[:] = 0.0
++            for k in range(m):
++                csum += F[m*idivm+k, :] * wsave[m*j+k]
++            rta[2*i, :] = csum.real
++            rta[2*i+1, :] = csum.imag
++
++        else:
++            idivm = (i+1)//(m//2)
++            imodm = (i+1)-(m//2)*idivm
++            csum[:] = 0.0
++            for k in range(m):
++                csum += F[m*(nblock//2)+k, :] * wsave[m*j+k]
++            rta[2*i, :] = csum.real
++            rta[2*i+1, :] = csum.imag
++            if i == (n//2) - 1:
++                for k in range(m):
++                    rsum += F[m*(nblock//2)+k, :]
++                rta[n-2, :] = rsum
++                rta[n-2, :] *= fact
++
++                rsum[:] = 0.0
++                for k in range(m//2):
++                    rsum += F[m*(nblock//2)+2*k-1]
++                    rsum -= F[m*(nblock//2)+2*k]
++                rta[n-1, :] = rsum
++                rta[n-1, :] *= fact
++
++    # idd_subselect pick randomly l2-many rows
++    subselect = rng.choice(n2, l2, replace=False)
++    rta = rta[subselect, :]
++
++    perms, proj = iddr_id(rta, krank)
++
++    return perms, proj
++
++
++def iddr_asvd(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a: NDArray, int krank,
++              rng=None):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int info, ci
++    cdef cnp.ndarray[cnp.float64_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] V
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] perms
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] p
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] col
++
++    perms, proj = iddr_aid(a.copy(), krank=krank, rng=rng)
++
++    UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_FLOAT64, 0)
++    VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_FLOAT64, 0)
++
++    p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_FLOAT64, 0)
++    col = a[:, perms[:krank]].copy()
++
++    # idd_reconint
++    for ci in range(krank):
++        p[ci, perms[ci]] = 1.0
++
++    p[:, perms[krank:]] = proj[:, :]
++
++    inds1, tau1 = iddr_qrpiv(col, krank)
++    # idd_rinqr and idd_rearr
++    r = np.triu(col[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++    t = p.T.copy()
++    inds2, tau2 = iddr_qrpiv(t, krank)
++    r2 = np.triu(t[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++    r3 = r @ r2.T
++    UU[:krank, :krank], S, V = la.svd(r3, full_matrices=False)
++
++    # Apply Q of col to U from the left
++    C = col[:, :krank].copy(order='F')
++    dorm2r('R', 'T',
++           &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++           &UU[0,0], &krank, &a[0, 0], &info)
++
++    VV[:krank, :krank] = V[:, :].T
++    # Apply Q of t to V from the left
++    C = t[:, :krank].copy(order='F')
++    dorm2r('R', 'T',
++           &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++           &VV[0, 0], &krank, &a[0, 0], &info)
++
++    return UU, S, VV
++
++
++def iddr_id(cnp.ndarray[cnp.float64_t, ndim=2] a, int krank):
++    cdef int n = a.shape[1]
++    cdef int tmp_int
++    cdef cnp.float64_t one = 1.0
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] perms
++
++    inds, _ = iddr_qrpiv(a, krank)
++    perms = cnp.PyArray_Arange(0, n, 1, cnp.NPY_INT64)
++
++    if krank > 0:
++        for p in range(krank):
++            # Apply pivots
++            tmp_int = perms[p]
++            perms[p] = perms[inds[p]]
++            perms[inds[p]] = tmp_int
++
++    # See iddp_id comments for below
++    tmp_int = n - krank
++    # SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB
++    dtrsm('R', 'L', 'N', 'N',
++          &tmp_int, &krank, &one, &a[0, 0], &n, &a[0, krank], &n)
++
++    return perms, a[:krank, krank:]
++
++
++def iddr_qrpiv(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a: NDArray, krank: int):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef cnp.ndarray col_norms = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    cdef int loop = 0, loops, kpiv = 0, i = 0, tmp_int = 0, int_n = 0
++    cdef cnp.float64_t tmp_sca = 0.
++    cdef cnp.ndarray taus = cnp.PyArray_ZEROS(1, [m], cnp.NPY_FLOAT64, 0)
++    cdef cnp.ndarray ind = cnp.PyArray_ZEROS(1, [n], cnp.NPY_INT64, 0)
++    cdef cnp.float64_t[::1] taus_v = taus
++    cdef cnp.float64_t feps = 0.1e-16  # np.finfo(np.float64).eps
++    cdef cnp.float64_t ssmax, ssmaxin
++    cdef int nupdate = 0
++
++    loops = min(krank, min(m, n))
++    for i in range(n):
++        col_norms[i] = dnrm2(&m, &a[0, i], &n)**2
++
++    kpiv = np.argmax(col_norms)
++    ssmax = col_norms[kpiv]
++    ssmaxin = ssmax
++
++    for loop in range(loops):
++
++        ind[loop] = kpiv
++        # Swap columns a[:, k] and a[:, kpiv]
++        a[:, [kpiv, loop]] = a[:, [loop, kpiv]]
++        # Swap col_norms[krank] and col_norms[kpiv]
++        col_norms[[kpiv, loop]] = col_norms[[loop, kpiv]]
++
++        if loop < m-1:
++            tmp_sca = a[loop, loop]
++            # FIX: Convert these to F_INT
++            tmp_int = (m - loop)
++            int_n = n
++            dlarfgp(&tmp_int, &tmp_sca, &a[loop+1, loop], &int_n, &taus_v[loop])
++
++            # Overwrite with 1. for easy matmul
++            a[loop, loop] = 1
++            if loop < n-1:
++                # Apply the householder reflector to the rest on the right
++                a[loop:, loop+1:] -= np.outer(taus[loop]*a[loop:, loop],
++                                              a[loop:, loop] @ a[loop:, loop+1:])
++
++            # Put back the beta in place
++            a[loop, loop] = tmp_sca
++
++            # Update the norms
++            col_norms[loop] = 0
++            col_norms[loop+1:] -= a[loop, loop+1:]**2
++            ssmax = 0
++            kpiv = loop+1
++
++            if loop < n-1:
++                kpiv = np.argmax(col_norms[loop+1:]) + (loop + 1)
++                ssmax = col_norms[kpiv]
++            if (((ssmax < 1000*feps*ssmaxin) and (nupdate == 0)) or
++                    ((ssmax < ((1000*feps)**2)*ssmaxin) and (nupdate == 1))):
++                nupdate += 1
++                ssmax = 0
++                kpiv = loop+1
++
++                if loop < n-1:
++                    for i in range(loop+1, n):
++                        tmp_int = m-loop-1
++                        col_norms[i] = dnrm2(&tmp_int, &a[loop+1, i], &n)**2
++                    kpiv = np.argmax(col_norms[loop+1:]) + (loop + 1)
++                    ssmax = col_norms[kpiv]
++
++    return ind, taus
++
++
++def iddr_rid(A: LinearOperator, int krank, rng=None):
++    cdef int m = A.shape[0], n = A.shape[1], k = 0
++    cdef int L = min(krank+2, min(m, n))
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] r
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    r = cnp.PyArray_EMPTY(2, [L, n], cnp.NPY_FLOAT64, 0)
++    for k in range(L):
++        r[k, :] = A.rmatvec(rng.uniform(size=m))
++
++    return iddr_id(a=r, krank=krank)
++
++
++def iddr_rsvd(A: LinearOperator, int krank, rng=None):
++    cdef int n = A.shape[1], j
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms
++    cdef cnp.ndarray[cnp.float64_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] col
++
++    perms, proj = iddr_rid(A, krank, rng)
++    # idd_getcols
++    col = cnp.PyArray_EMPTY(2, [n, krank], cnp.NPY_FLOAT64, 0)
++    x = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    for j in range(krank):
++        x[perms[j]] = 1.
++        col[:, j] = A.matvec(x)
++        x[perms[j]] = 0.
++
++    return idd_id2svd(cols=col, perms=perms, proj=proj)
++
++
++def iddr_svd(cnp.ndarray[cnp.float64_t, mode="c", ndim=2] a: NDArray, int krank):
++    cdef int m = a.shape[0], info = 0
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] taus
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='fortran', ndim=2] C
++
++    # Get the pivoted QR
++    inds, taus = iddr_qrpiv(a, krank)
++
++    r = np.triu(a[:krank, :])
++    # Apply pivots in reverse
++    for p in range(krank-1, -1, -1):
++        r[:, [p, inds[p]]] = r[:, [inds[p], p]]
++
++    # JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO
++    # dgesvd('S', 'O', &krank, &n)
++    U, S, V = la.svd(r, full_matrices=False)
++
++    # Apply Q to U via dorm2r
++    # Possibly U is shorter than Q
++    UU = np.zeros([m, krank], dtype=a.dtype)
++    UU[:krank, :krank] = U
++    # Do the transpose dance for C-layout, use a for scratch
++    C = a[:, :krank].copy(order='F')
++    dorm2r('R', 'T',
++           &krank, &m, &krank, &C[0, 0], &m, &taus[0],
++           &UU[0,0], &krank, &a[0, 0], &info)
++
++    return UU, S, V
++
++
++def idz_diffsnorm(A: LinearOperator, B: LinearOperator, int its=20, rng=None):
++    cdef int n = A.shape[1], j = 0, intone = 1
++    cdef cnp.float64_t snorm = 0.0
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] v1
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] v2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] u1
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] u2
++
++    if not rng:
++        rng = np.random.default_rng()
++    v1 = rng.uniform(low=-1, high=1, size=(n, 2)).view(np.complex128).ravel()
++    v1 /= dznrm2(&n, &v1[0], &intone)
++
++    for j in range(its):
++        u1 = A.matvec(v1)
++        u2 = B.matvec(v1)
++        u1 -= u2
++        v1 = A.rmatvec(u1)
++        v2 = B.rmatvec(u1)
++        v1 -= v2
++
++        snorm = dznrm2(&n, &v1[0], &intone)
++        if snorm > 0.0:
++            v1 /= snorm
++
++        snorm = np.sqrt(snorm)
++
++    return snorm
++
++
++def idz_estrank(cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] a: NDArray, eps: float,
++                rng=None):
++    cdef int m = a.shape[0], n = a.shape[1], n2, nsteps = 3, row, r, nstep, cols, k
++    cdef cnp.float64_t h, alpha, beta
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=3] albetas
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau_arr
++    cdef cnp.ndarray[cnp.npy_int64, mode='c', ndim=1] subselect
++    cdef double complex[:, ::1] ff
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=2] giv2x2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] rta
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] F
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    n2 = idd_poweroftwo(m)
++    # This part is the initialization that is done via idz_frmi
++    # for a Subsampled Randomized Fourier Transfmrom (SRFT).
++
++    # Draw (nsteps x m x 4) array from [0, 2)*pi uniformly for
++    # random points on complex unit circle and unitary rotations
++    albetas = np.empty([nsteps, m, 4])
++    albetas[:, :, 2:] = rng.uniform(low=0.0, high=2.0, size=[nsteps, m, 2])
++    albetas[:, :, 2:] *= np.pi
++    np.cos(albetas[:, :, 2], out=albetas[:, :, 0])
++    np.sin(albetas[:, :, 2], out=albetas[:, :, 1])
++    np.cos(albetas[:, :, 3], out=albetas[:, :, 2])
++    np.sin(albetas[:, :, 3], out=albetas[:, :, 3])
++
++    # idd_random_transf
++    rta = a.copy()
++
++    # Rotate and shuffle "a" nsteps-many times
++    giv2x2 = cnp.PyArray_ZEROS(2, [2, 2], cnp.NPY_FLOAT64, 0)
++    for nstep in range(nsteps):
++        # Multiply with a point on the unit circle
++        rta *= albetas[nstep, :, 2:].view(np.complex128)
++        # Rotate
++        for row in range(m-1):
++            alpha, beta = albetas[nstep, row, 0], albetas[nstep, row, 1]
++            giv2x2[0, 0] = alpha
++            giv2x2[0, 1] = beta
++            giv2x2[1, 0] = -beta
++            giv2x2[1, 1] = alpha
++            np.matmul(giv2x2, rta[row:row+2, :], out=rta[row:row+2, :])
++
++        rta = rta[rng.permutation(m), :]
++
++    # idd_subselect pick randomly n2-many rows
++    subselect = rng.choice(m, n2, replace=False)
++    rta = rta[subselect, :]
++    # Perform rfft on each column.
++    F = fft(rta, axis=0)[rng.permutation(n2), :]
++
++    Fcopy = F.copy()
++    cols = F.shape[1]
++    row = F.shape[0]
++    sssmax = 0.
++
++    for r in range(cols):
++        h = dznrm2(&row, &F[0, r], &cols)
++        if h > sssmax:
++            sssmax = h
++
++    tau_arr = cnp.PyArray_ZEROS(1, [cols], cnp.NPY_COMPLEX128, 0)
++    k, nulls = 0, 0
++    ff = F
++    # Loop until nulls = 7, or krank+nulls = n2, or krank+nulls = n.
++    while (nulls < 7) and (k+nulls < min(n, n2)):
++        # Apply previous Householder reflectors
++        if k > 0:
++            for kk in range(k):
++                F[k, kk:] -= (
++                    np.conj(tau_arr[kk])*
++                    (F[kk, kk:].conj() @ F[k, kk:])*
++                    F[kk, kk:]
++                    )
++
++        # Get the next Householder reflector and store in F
++        r = cols-k
++        row = 1
++        zlarfgp(&r, &ff[k, k], &ff[k, k+1], &row, &tau_arr[k])
++        if (np.abs(F[k, k]) <= eps*sssmax):
++            nulls += 1
++        F[k, k] = 1
++        k += 1
++
++    if nulls < 7:
++        k = 0
++
++    return k, Fcopy
++
++
++def idz_findrank(A: LinearOperator, cnp.float64_t eps, rng=None):
++    # Estimate the rank of A by repeatedly using A.rmatvec(random vec)
++
++    cdef int m = A.shape[0], n = A.shape[1], k = 0, kk = 0,r = n, krank
++    cdef int no_of_cols = 4, intone = 1, info = 0
++    cdef cnp.complex128_t[::1] tau = cnp.PyArray_ZEROS(1, [min(m, n)],
++                                                       cnp.NPY_COMPLEX128, 0)
++    cdef cnp.complex128_t[::1] y = cnp.PyArray_ZEROS(1, [n], cnp.NPY_COMPLEX128, 0)
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] retarr
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] x
++
++    # The size of the QR decomposition is rank dependent which is unknown
++    # at runtime. Hence we don't want to allocate a dense version of the
++    # linear operator which can be too big. Instead, a typical "realloc double
++    # if run out of space" strategy is used here. Starts with 4*n
++    # Also, we hold the A.T @ x results in a separate array to return
++    # and do the same for that too.
++    cdef cnp.complex128_t *ra = PyMem_Malloc(
++        sizeof(cnp.complex128_t)*no_of_cols*n
++        )
++    cdef cnp.complex128_t *reallocated_ra
++    cdef cnp.complex128_t *ret = PyMem_Malloc(
++        sizeof(cnp.complex128_t)*no_of_cols*n
++        )
++    cdef cnp.complex128_t *reallocated_ret
++    cdef cnp.complex128_t enorm = 0.0
++
++    if (not ra) or (not ret):
++        raise MemoryError("Failed to allocate at least required memory "
++                          f"{no_of_cols*n*8} bytes for"
++                          "'scipy.linalg.interpolative.idz_findrank()' "
++                          "function.")
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    krank = 0
++    try:
++        while True:
++
++            # Generate random vector and rmatvec then save the result
++            x = rng.uniform(size=(m,2)).view(np.complex128).ravel()
++            y = A.rmatvec(x)
++
++            for kk in range(n):
++                ret[krank*n + kk] = y[kk]
++
++            if krank == 0:
++                enorm = dznrm2(&n, &y[0], &intone)
++            else:  # krank > 0
++                # Transpose-Apply previous Householder reflectors, if any
++                # SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO
++                zunm2r('L','C', &n, &intone, &krank, &ra[0], &n,
++                       &tau[0], &y[0], &n, &ra[(no_of_cols-1)*n], &info)
++
++            # Get the next Householder reflector
++            r = n-krank
++            # N, ALPHA, X, INCX, TAU
++            zlarfgp(&r, &y[krank], &y[krank+1], &intone, &tau[krank])
++
++            for kk in range(n):
++                ra[krank*n + kk] = y[kk]
++
++            # Running out of space; try to double the size of ra
++            if krank == (no_of_cols-2):
++                reallocated_ra = PyMem_Realloc(
++                    ra, sizeof(cnp.complex128_t)*no_of_cols*n*2)
++                reallocated_ret = PyMem_Realloc(
++                    ret, sizeof(cnp.complex128_t)*no_of_cols*n*2)
++
++                if reallocated_ra and reallocated_ret:
++                    ra = reallocated_ra
++                    ret = reallocated_ret
++                    no_of_cols *= 2
++                else:
++                    raise MemoryError(
++                        "'scipy.linalg.interpolative.idz_findrank()' failed to "
++                        f"allocate the required memory,{no_of_cols*n*16} bytes "
++                        "while trying to determine the rank (currently "
++                        f"{krank}) of a LinearOperator with precision {eps}."
++                    )
++            krank += 1
++            if (np.abs(y[krank-1]) < eps*enorm) or (krank >= min(m, n)):
++                break
++    finally:
++        # Crashed or successfully ended up here
++        # Discard Householder vectors
++        PyMem_Free(ra)
++        retarr = cnp.PyArray_EMPTY(2, [krank, n], cnp.NPY_COMPLEX128, 0)
++        for k in range(krank):
++            for kk in range(n):
++                retarr[k, kk] = ret[k*n+kk]
++        PyMem_Free(ret)
++
++    return krank, retarr
++
++
++def idz_id2svd(
++    cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] cols,
++    cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms,
++    cnp.ndarray[cnp.complex128_t, ndim=2] proj,
++    ):
++    cdef int m = cols.shape[0], krank = cols.shape[1]
++    cdef int n = proj.shape[1] + krank, info, ci
++    cdef cnp.ndarray[cnp.complex128_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] V
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] p
++
++    if krank > 0:
++        UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_COMPLEX128, 0)
++        VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_COMPLEX128, 0)
++        p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_COMPLEX128, 0)
++
++        # idd_reconint
++        for ci in range(krank):
++            p[ci, perms[ci]] = 1.0
++
++        p[:, perms[krank:]] = proj[:, :]
++        inds1, tau1 = idzr_qrpiv(cols, krank)
++        # idz_rinqr and idz_rearr
++        r = np.triu(cols[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++        t = p.T.conj().copy()
++        inds2, tau2 = idzr_qrpiv(t, krank)
++        r2 = np.triu(t[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++        r3 = r @ r2.T.conj()
++        UU[:krank, :krank], S, V = la.svd(r3, full_matrices=False)
++
++        # Apply Q of col to U from the left
++        # But do the adjoint dance for LAPACK via U.H @ Q.H
++        np.conjugate(tau1, out=tau1)
++        C = cols[:, :krank].conj().copy(order='F')
++        zunm2r('R', 'C',
++            &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++            &UU[0,0], &krank, &cols[0, 0], &info)
++
++        VV[:krank, :krank] = V[:, :].conj().T
++
++        # Apply Q of t to V from the left
++        # But do the adjoint dance for LAPACK via V.H @ Q.H
++        np.conjugate(tau2, out=tau2)
++        C = t[:, :krank].conj().copy(order='F')
++        zunm2r('R', 'C',
++            &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++            &VV[0, 0], &krank, &cols[0, 0], &info)
++
++    return UU, S, VV
++
++
++def idz_reconid(B, idx, proj):
++    cdef int m = B.shape[0], krank = B.shape[1]
++    cdef int n = len(idx)
++    approx = np.zeros([m, n], dtype=np.complex128)
++
++    approx[:, idx[:krank]] = B
++    approx[:, idx[krank:]] = B @ proj
++
++    return approx
++
++
++def idz_snorm(A: LinearOperator, int its=20, rng=None):
++    cdef int n = A.shape[1]
++    cdef int j = 0, intone = 1
++    cdef cnp.float64_t snorm = 0.0
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] v
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] u
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    v = rng.uniform(low=-1, high=1, size=(n, 2)).view(np.complex128).ravel()
++    v /= dznrm2(&n, &v[0], &intone)
++
++    for j in range(its):
++        u = A.matvec(v)
++        v = A.rmatvec(u)
++        snorm = dznrm2(&n, &v[0], &intone)
++        if snorm > 0.0:
++            v /= snorm
++
++        snorm = np.sqrt(snorm)
++
++    return snorm
++
++
++def idzp_aid(cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] a: NDArray, eps: float,
++             rng=None):
++    krank, proj = idz_estrank(a, eps=eps, rng=rng)
++    if krank != 0:
++        proj = proj[:krank, :]
++        return idzp_id(proj, eps=eps)
++
++    return idzp_id(a, eps=eps)
++
++
++def idzp_asvd(cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] a, cnp.float64_t eps,
++              rng=None):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int krank, info, ci
++    cdef cnp.ndarray[cnp.complex128_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] V
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] perms
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] p
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] col
++
++    krank, perms, proj = idzp_aid(a.copy(), eps, rng)
++
++    if krank > 0:
++        UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_COMPLEX128, 0)
++        VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_COMPLEX128, 0)
++        p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_COMPLEX128, 0)
++        col = a[:, perms[:krank]].copy()
++
++        # idd_reconint
++        for ci in range(krank):
++            p[ci, perms[ci]] = 1.0
++
++        p[:, perms[krank:]] = proj[:, :]
++        inds1, tau1 = idzr_qrpiv(col, krank)
++        # idz_rinqr and idz_rearr
++        r = np.triu(col[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++        t = p.T.conj().copy()
++        inds2, tau2 = idzr_qrpiv(t, krank)
++        r2 = np.triu(t[:krank, :])
++        for ci in range(krank-1, -1, -1):
++            r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++        r3 = r @ r2.T.conj()
++        UU[:krank, :krank], S, V = la.svd(r3, full_matrices=False)
++
++        # Apply Q of col to U from the left
++        # But do the adjoint dance for LAPACK via U.H @ Q.H
++        np.conjugate(tau1, out=tau1)
++        C = col[:, :krank].conj().copy(order='F')
++        zunm2r('R', 'C',
++            &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++            &UU[0,0], &krank, &a[0, 0], &info)
++
++        VV[:krank, :krank] = V[:, :].conj().T
++
++        # Apply Q of t to V from the left
++        # But do the adjoint dance for LAPACK via V.H @ Q.H
++        np.conjugate(tau2, out=tau2)
++        C = t[:, :krank].conj().copy(order='F')
++        zunm2r('R', 'C',
++            &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++            &VV[0, 0], &krank, &a[0, 0], &info)
++
++    return UU, S, VV
++
++
++def idzp_id(cnp.ndarray[cnp.complex128_t, mode="c", ndim=2] a, cnp.float64_t eps):
++    cdef int n = a.shape[1], krank, tmp_int, p
++    cdef double complex one = 1
++    krank, _, inds = idzp_qrpiv(a, eps)
++
++    # Change pivots to permutation
++    perms = cnp.PyArray_Arange(0, n, 1, cnp.NPY_INT64)
++
++    if krank > 0:
++        for p in range(krank):
++            # Apply pivots
++            tmp_int = perms[p]
++            perms[p] = perms[inds[p]]
++            perms[inds[p]] = tmp_int
++
++    tmp_int = n - krank
++    # SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB
++    ztrsm('R', 'L', 'N', 'N',
++          &tmp_int, &krank, &one, &a[0, 0], &n, &a[0, krank], &n)
++
++    return krank, perms, a[:krank, krank:]
++
++
++def idzp_qrpiv(cnp.ndarray[cnp.complex128_t, mode="c", ndim=2] a, cnp.float64_t eps):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef cnp.ndarray col_norms = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    cdef int k = 0, kpiv = 0, i = 0, tmp_int = 0, int_n = 0
++    cdef double complex tmp_sca = 0.
++    cdef cnp.ndarray taus = cnp.PyArray_ZEROS(1, [m], cnp.NPY_COMPLEX128, 0)
++    cdef cnp.ndarray ind = cnp.PyArray_ZEROS(1, [n], cnp.NPY_INT64, 0)
++    cdef double complex[::1] taus_v = taus
++    cdef cnp.float64_t feps = 0.1e-16  # Smaller than np.finfo(np.float64).eps
++    cdef cnp.float64_t ssmax, ssmaxin
++    cdef int nupdate = 0
++
++    for i in range(n):
++        col_norms[i] = dznrm2(&m, &a[0, i], &n)**2
++
++    kpiv = np.argmax(col_norms)
++    ssmax = col_norms[kpiv]
++    ssmaxin = ssmax
++
++    for k in range(min(m, n)):
++
++        # Pivoting
++        ind[k] = kpiv
++        # Swap columns a[:, k] and a[:, kpiv]
++        a[:, [kpiv, k]] = a[:, [k, kpiv]]
++
++        # Swap col_norms[krank] and col_norms[kpiv]
++        col_norms[[kpiv, k]] = col_norms[[k, kpiv]]
++
++        if k < m-1:
++            # Compute the householder reflector for column k
++            tmp_sca = a[k, k]
++            # FIX: Convert these to F_INT
++            tmp_int = (m - k)
++            int_n = n
++            zlarfgp(&tmp_int, &tmp_sca, &a[k+1, k], &int_n, &taus_v[k])
++
++            # Overwrite with 1. for easy matmul
++            a[k, k] = 1.0
++            if k < n-1:
++                # Apply the householder reflector to the rest on the right.
++                # Note! Tau returned by zlarfgp is complex valued and thus,
++                # reflector is not Hermitian, hence the conjugates. See the
++                # documentation of zlarfgp.
++                a[k:, k+1:] -= np.outer(taus[k].conj()*a[k:, k],
++                                        a[k:, k].conj() @ a[k:, k+1:]
++                                        )
++
++            # Put back the beta in place
++            a[k, k] = tmp_sca
++            # Update the norms
++            col_norms[k] = 0
++            col_norms[k+1:] -= (a[k, k+1:] * a[k, k+1:].conj()).real
++            ssmax = 0.0
++            kpiv = k+1
++
++            if k < n-1:
++                kpiv = np.argmax(col_norms[k+1:]) + (k + 1)
++                ssmax = col_norms[kpiv]
++
++            if (((ssmax < 1000*feps*ssmaxin) and (nupdate == 0)) or
++                    ((ssmax < ((1000*feps)**2)*ssmaxin) and (nupdate == 1))):
++                nupdate += 1
++                ssmax = 0
++                kpiv = k+1
++                if k < n-1:
++                    for i in range(k+1, n):
++                        tmp_int = m-k-1
++                        col_norms[i] = dznrm2(&tmp_int, &a[k+1, i], &n)**2
++                    kpiv = np.argmax(col_norms[k+1:]) + (k + 1)
++                    ssmax = col_norms[kpiv]
++        if (ssmax <= (eps**2)*ssmaxin):
++            break
++    # a is overwritten; return numerical rank and pivots
++
++    return k+1, taus, ind
++
++
++def idzp_rid(A: LinearOperator, cnp.float64_t eps, rng=None):
++    _, ret = idz_findrank(A, eps, rng=rng)
++    return idzp_id(ret, eps=eps)
++
++
++def idzp_rsvd(A: LinearOperator, cnp.float64_t eps, rng=None):
++    cdef int n = A.shape[1]
++    cdef int krank, j
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] col
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] x
++
++    krank, perms, proj = idzp_rid(A, eps, rng=rng)
++
++    if krank > 0:
++        # idd_getcols
++        col = cnp.PyArray_EMPTY(2, [n, krank], cnp.NPY_COMPLEX128, 0)
++        x = cnp.PyArray_ZEROS(1, [n], cnp.NPY_COMPLEX128, 0)
++
++        for j in range(krank):
++            x[perms[j]] = 1.
++            col[:, j] = A.matvec(x)
++            x[perms[j]] = 0.
++
++        return idz_id2svd(cols=col, perms=perms, proj=proj)
++
++    # TODO: figure out empty return
++    return None
++
++
++def idzp_svd(cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] a, cnp.float64_t eps):
++    cdef int m = a.shape[0], krank, info
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] taus
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] V
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] r
++    cdef cnp.ndarray[cnp.complex128_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.float64_t, ndim=1] S
++
++    # Get the pivoted QR
++    krank, taus, inds = idzp_qrpiv(a, eps)
++    UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_COMPLEX128, 0)
++
++    if krank > 0:
++        r = np.triu(a[:krank, :])
++
++        for p in range(krank-1, -1, -1):
++            r[:, [p, inds[p]]] = r[:, [inds[p], p]]
++
++        UU[:krank, :krank], S, V = la.svd(r, full_matrices=False)
++        # Apply Q to U via zunm2r
++        np.conjugate(taus, out=taus)
++        # But do the adjoint dance for LAPACK via U.H @ Q.H; use a for scratch
++        C = a[:, :krank].conj().copy(order='F')
++        zunm2r('R', 'C',
++               &krank, &m, &krank, &C[0, 0], &m, &taus[0],
++               &UU[0,0], &krank, &a[0, 0], &info)
++
++    return UU, S, V
++
++
++def idzr_aid(cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] a: NDArray, int krank,
++             rng=None):
++    cdef int m = a.shape[0], n2, L, nblock, nsteps = 3, mb
++    cdef cnp.float64_t twopi = 2*np.pi, fact
++    cdef double complex twopii = twopi*1.j
++    cdef cnp.ndarray[cnp.npy_int64, mode='c', ndim=1] ind
++    cdef cnp.ndarray[cnp.npy_int64, mode='c', ndim=1] subselect
++    cdef cnp.ndarray[cnp.npy_float64, mode='c', ndim=1] dm1
++    cdef cnp.ndarray[cnp.npy_float64, mode='c', ndim=1] dm2
++    cdef cnp.ndarray[cnp.npy_float64, mode='c', ndim=3] albetas
++    cdef cnp.ndarray[cnp.npy_float64, mode='c', ndim=2] rta
++    cdef cnp.ndarray[cnp.npy_float64, mode='c', ndim=2] giv2x2
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    n2 = 0
++    L = krank + 8
++    if (L >= n2) or (L > m):
++        inds, proj = idzr_id(a, krank)
++        return inds, proj
++
++    n2 = idd_poweroftwo(m)
++    # This part is the initialization that is done via idz_frmi
++    # for a Subsampled Randomized Fourier Transfmrom (SRFT).
++
++    # Draw (nsteps x m x 4) array from [0, 2)*pi uniformly for
++    # random points on complex unit circle and unitary rotations
++    albetas = np.empty([nsteps, m, 4])
++    albetas[:, :, 2:] = rng.uniform(low=0.0, high=2.0, size=[nsteps, m, 2])
++    albetas[:, :, 2:] *= np.pi
++    np.cos(albetas[:, :, 2], out=albetas[:, :, 0])
++    np.sin(albetas[:, :, 2], out=albetas[:, :, 1])
++    np.cos(albetas[:, :, 3], out=albetas[:, :, 2])
++    np.sin(albetas[:, :, 3], out=albetas[:, :, 3])
++
++    # idd_random_transf
++    rta = a.copy()
++
++    # Rotate and shuffle "a" nsteps-many times
++    giv2x2 = np.array([[0., 0. ], [0., 0.]])
++    for nstep in range(nsteps):
++        # Multiply with a point on the unit circle
++        rta *= albetas[nstep, :, 2:].view(np.complex128)
++        # Rotate
++        for row in range(m-1):
++            alpha, beta = albetas[nstep, row, 0], albetas[nstep, row, 1]
++            giv2x2[0, 0] = alpha
++            giv2x2[0, 1] = beta
++            giv2x2[1, 0] = -beta
++            giv2x2[1, 1] = alpha
++            np.matmul(giv2x2, rta[row:row+2, :], out=rta[row:row+2, :])
++
++        rta = rta[rng.permutation(m), :]
++
++    # idd_subselect pick randomly n2-many rows
++    subselect = rng.choice(m, n2, replace=False)
++    rta = rta[subselect, :]
++    ind = rng.choice(n2, L, replace=False)
++
++    nblock = idd_ldiv(L, n2)
++    mb = n2 // nblock
++    fact = 1.0 / np.sqrt(n2)
++
++    # Create (L x mb) DFT matrix
++    # wsave = np.empty([L, mb], dtype=np.complex128)
++    dm1, dm2 = np.divmod(ind, mb, dtype=np.float64)
++    dm1 /= n2
++    dm1 += dm2 / mb
++    wsave = np.outer(dm1, -twopii*np.arange(mb))
++    np.exp(wsave, out=wsave)
++    wsave *= fact
++
++    # Perform partial FFT to each nblock then swap first two axes for transposition
++    # and subsample by ind // mb. This is basically a few options combined into one
++    # First we view each column as (nblock x mb) then take fft of each mb-long chunk.
++    # Then we transpose and multiply with DFT matrix and subselect.
++    # See DOI:10.1016/j.acha.2007.12.002 - Section 3.3
++
++    # Original fortran code does this single column at a time. We do a bit of array
++    # manipulation to do it in one go for all columns at once.
++    F = np.swapaxes(
++          fft(rta.reshape(nblock, mb, -1, order='F'), axis=0), 0, 1
++          )[:, ind // mb, :]
++    # Perform direct calculation with DFT matrix
++    V = np.einsum('ij,jim->im', wsave, F)
++
++    return idzr_id(V, krank)
++
++
++def idzr_asvd(cnp.ndarray[cnp.complex128_t, mode="c", ndim=2] a, int krank, rng=None):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int info, ci
++    cdef cnp.ndarray[cnp.complex128_t, mode='fortran', ndim=2] C
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau1
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] tau2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.float64_t, mode='c', ndim=1] S
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] V
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] VV
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] perms
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds1
++    cdef cnp.ndarray[cnp.npy_int64, ndim=1] inds2
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] p
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] col
++    UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_COMPLEX128, 0)
++    VV = cnp.PyArray_ZEROS(2, [n, krank], cnp.NPY_COMPLEX128, 0)
++    p = cnp.PyArray_ZEROS(2, [krank, n], cnp.NPY_COMPLEX128, 0)
++
++    perms, proj = idzr_aid(a.copy(), krank=krank, rng=rng)
++    col = a[:, perms[:krank]].copy()
++
++    # idd_reconint
++    for ci in range(krank):
++        p[ci, perms[ci]] = 1.0
++
++    p[:, perms[krank:]] = proj[:, :]
++    inds1, tau1 = idzr_qrpiv(col, krank)
++    # idz_rinqr and idz_rearr
++    r = np.triu(col[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r[:, [ci, inds1[ci]]] = r[:,  [inds1[ci], ci]]
++
++    t = p.T.conj().copy()
++    inds2, tau2 = idzr_qrpiv(t, krank)
++    r2 = np.triu(t[:krank, :])
++    for ci in range(krank-1, -1, -1):
++        r2[:, [ci, inds2[ci]]] = r2[:,  [inds2[ci], ci]]
++
++    r3 = r @ r2.T.conj()
++    UU[:krank, :krank], S, V = la.svd(r3, full_matrices=False)
++
++    # Apply Q of col to U from the left
++    # But do the adjoint dance for LAPACK via U.H @ Q.H
++    np.conjugate(tau1, out=tau1)
++    C = col[:, :krank].conj().copy(order='F')
++    zunm2r('R', 'C',
++           &krank, &m, &krank, &C[0, 0], &m, &tau1[0],
++           &UU[0,0], &krank, &a[0, 0], &info)
++
++    VV[:krank, :krank] = V[:, :].conj().T
++
++    # Apply Q of t to V from the left
++    # But do the adjoint dance for LAPACK via V.H @ Q.H
++    np.conjugate(tau2, out=tau2)
++    C = t[:, :krank].conj().copy(order='F')
++    zunm2r('R', 'C',
++           &krank, &n, &krank, &C[0, 0], &n, &tau2[0],
++           &VV[0, 0], &krank, &a[0, 0], &info)
++
++    return UU, S, VV
++
++
++def idzr_id(cnp.ndarray[cnp.complex128_t, ndim=2] a, int krank):
++    cdef int n = a.shape[1], tmp_int, p
++    cdef double complex one = 1.0
++    cdef cnp.ndarray[cnp.int64_t, ndim=1] inds
++    cdef cnp.ndarray[cnp.int64_t, ndim=1] perms
++
++    inds, _ = idzr_qrpiv(a, krank)
++    perms = cnp.PyArray_Arange(0, n, 1, cnp.NPY_INT64)
++
++    if krank > 0:
++        for p in range(krank):
++            # Apply pivots
++            tmp_int = perms[p]
++            perms[p] = perms[inds[p]]
++            perms[inds[p]] = tmp_int
++    tmp_int = n - krank
++    # SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB
++    ztrsm('R', 'L', 'N', 'N',
++          &tmp_int, &krank, &one, &a[0, 0], &n, &a[0, krank], &n)
++
++    return perms, a[:krank, krank:]
++
++
++def idzr_qrpiv(cnp.ndarray[cnp.complex128_t, mode="c", ndim=2] a, int krank):
++    cdef int m = a.shape[0], n = a.shape[1]
++    cdef int loop = 0, loops, kpiv = 0, i = 0, tmp_int = 0
++    cdef cnp.ndarray col_norms = cnp.PyArray_ZEROS(1, [n], cnp.NPY_FLOAT64, 0)
++    cdef double complex tmp_sca = 0.
++    cdef cnp.ndarray taus = cnp.PyArray_ZEROS(1, [m], cnp.NPY_COMPLEX128, 0)
++    cdef cnp.ndarray ind = cnp.PyArray_ZEROS(1, [n], cnp.NPY_INT64, 0)
++    cdef double complex[::1] taus_v = taus
++    cdef cnp.float64_t feps = 0.1e-16  # Smaller than np.finfo(np.float64).eps
++    cdef cnp.float64_t ssmax, ssmaxin
++    cdef int nupdate = 0
++
++    loops = min(krank, min(m, n))
++    for i in range(n):
++        col_norms[i] = dznrm2(&m, &a[0, i], &n)**2
++
++    kpiv = np.argmax(col_norms)
++    ssmax = col_norms[kpiv]
++    ssmaxin = ssmax
++
++    for loop in range(loops):
++
++        ind[loop] = kpiv
++        # Swap columns a[:, k] and a[:, kpiv]
++        a[:, [kpiv, loop]] = a[:, [loop, kpiv]]
++        # Swap col_norms[krank] and col_norms[kpiv]
++        col_norms[[kpiv, loop]] = col_norms[[loop, kpiv]]
++
++        if loop < m-1:
++            tmp_sca = a[loop, loop]
++            # FIX: Convert these to F_INT
++            tmp_int = (m - loop)
++            zlarfgp(&tmp_int, &tmp_sca, &a[loop+1, loop], &n, &taus_v[loop])
++
++            # Overwrite with 1. for easy matmul
++            a[loop, loop] = 1
++            if loop < n-1:
++                # Apply the householder reflector to the rest on the right
++                a[loop:, loop+1:] -= np.outer(
++                    np.conj(taus[loop])*a[loop:, loop],
++                    a[loop:, loop].conj() @ a[loop:, loop+1:]
++                    )
++            # Put back the beta in place
++            a[loop, loop] = tmp_sca
++
++            # Update the norms
++            col_norms[loop] = 0
++            col_norms[loop+1:] -= (a[loop, loop+1:]*a[loop, loop+1:].conj()).real
++            ssmax = 0
++            kpiv = loop+1
++
++            if loop < n-1:
++                kpiv = np.argmax(col_norms[loop+1:]) + (loop + 1)
++                ssmax = col_norms[kpiv]
++            if (((ssmax < 1000*feps*ssmaxin) and (nupdate == 0)) or
++                    ((ssmax < ((1000*feps)**2)*ssmaxin) and (nupdate == 1))):
++                nupdate += 1
++                ssmax = 0
++                kpiv = loop+1
++
++                if loop < n-1:
++                    for i in range(loop+1, n):
++                        tmp_int = m-loop-1
++                        col_norms[i] = dznrm2(&tmp_int, &a[loop+1, i], &n)**2
++                    kpiv = np.argmax(col_norms[loop+1:]) + (loop + 1)
++                    ssmax = col_norms[kpiv]
++
++    return ind, taus
++
++
++def idzr_rid(A: LinearOperator, int krank, rng=None):
++    cdef int m = A.shape[0], n = A.shape[1], k = 0
++    cdef int L = min(krank+2, min(m, n))
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] r
++
++    if not rng:
++        rng = np.random.default_rng()
++
++    r = cnp.PyArray_EMPTY(2, [L, n], cnp.NPY_COMPLEX128, 0)
++    for k in range(L):
++        r[k, :] = A.rmatvec(rng.uniform(size=(m,2)).view(np.complex128).ravel())
++
++    return idzr_id(a=r.conj(), krank=krank)
++
++
++def idzr_rsvd(A: LinearOperator, int krank, rng=None):
++    cdef int n = A.shape[1], j
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] perms
++    cdef cnp.ndarray[cnp.complex128_t, ndim=2] proj
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] col
++
++    perms, proj = idzr_rid(A, krank, rng)
++    # idd_getcols
++    col = cnp.PyArray_EMPTY(2, [n, krank], cnp.NPY_COMPLEX128, 0)
++    x = cnp.PyArray_ZEROS(1, [n], cnp.NPY_COMPLEX128, 0)
++    for j in range(krank):
++        x[perms[j]] = 1.
++        col[:, j] = A.matvec(x)
++        x[perms[j]] = 0.
++
++    return idz_id2svd(cols=col, perms=perms, proj=proj)
++
++
++def idzr_svd(cnp.ndarray[cnp.complex128_t, mode="c", ndim=2] a, int krank):
++    cdef int m = a.shape[0], n = a.shape[1], info = 0
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=1] taus
++    cdef cnp.ndarray[cnp.int64_t, mode='c', ndim=1] inds
++    cdef cnp.ndarray[cnp.complex128_t, mode='c', ndim=2] UU
++    cdef cnp.ndarray[cnp.complex128_t, mode='fortran', ndim=2] C
++    UU = cnp.PyArray_ZEROS(2, [m, krank], cnp.NPY_COMPLEX128, 0)
++
++    krank = min(krank, min(m, n))
++    # Get the pivoted QR
++    inds, taus = idzr_qrpiv(a, krank)
++    r = np.triu(a[:krank, :])
++    # Apply pivots in reverse
++    for p in range(krank-1, -1, -1):
++        r[:, [p, inds[p]]] = r[:, [inds[p], p]]
++
++    # JOBU, JOBVT, M, N, A, LDA, S, U, LDU, VT, LDVT, WORK, LWORK, INFO
++    # zgesvd()
++    UU[:krank, :krank], S, V = la.svd(r, full_matrices=False)
++
++    # Apply Q to U via zunm2r
++    np.conjugate(taus, out=taus)
++    # But do the adjoint dance for LAPACK via U.H @ Q.H; use a for scratch
++    C = a[:, :krank].conj().copy(order='F')
++    zunm2r('R', 'C',
++           &krank, &m, &krank, &C[0, 0], &m, &taus[0],
++           &UU[0,0], &krank, &a[0, 0], &info)
++
++    return UU, S, V
+diff --git a/scipy/linalg/_interpolative_backend.py b/scipy/linalg/_interpolative_backend.py
+deleted file mode 100644
+index 7835314f7..000000000
+--- a/scipy/linalg/_interpolative_backend.py
++++ /dev/null
+@@ -1,1681 +0,0 @@
+-#******************************************************************************
+-#   Copyright (C) 2013 Kenneth L. Ho
+-#
+-#   Redistribution and use in source and binary forms, with or without
+-#   modification, are permitted provided that the following conditions are met:
+-#
+-#   Redistributions of source code must retain the above copyright notice, this
+-#   list of conditions and the following disclaimer. Redistributions in binary
+-#   form must reproduce the above copyright notice, this list of conditions and
+-#   the following disclaimer in the documentation and/or other materials
+-#   provided with the distribution.
+-#
+-#   None of the names of the copyright holders may be used to endorse or
+-#   promote products derived from this software without specific prior written
+-#   permission.
+-#
+-#   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+-#   AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+-#   IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+-#   ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+-#   LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+-#   CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+-#   SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+-#   INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+-#   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+-#   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+-#   POSSIBILITY OF SUCH DAMAGE.
+-#******************************************************************************
+-
+-"""
+-Direct wrappers for Fortran `id_dist` backend.
+-"""
+-
+-import scipy.linalg._interpolative as _id
+-import numpy as np
+-
+-_RETCODE_ERROR = RuntimeError("nonzero return code")
+-
+-
+-def _asfortranarray_copy(A):
+-    """
+-    Same as np.asfortranarray, but ensure a copy
+-    """
+-    A = np.asarray(A)
+-    if A.flags.f_contiguous:
+-        A = A.copy(order="F")
+-    else:
+-        A = np.asfortranarray(A)
+-    return A
+-
+-
+-#------------------------------------------------------------------------------
+-# id_rand.f
+-#------------------------------------------------------------------------------
+-
+-def id_srand(n):
+-    """
+-    Generate standard uniform pseudorandom numbers via a very efficient lagged
+-    Fibonacci method.
+-
+-    :param n:
+-        Number of pseudorandom numbers to generate.
+-    :type n: int
+-
+-    :return:
+-        Pseudorandom numbers.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.id_srand(n)
+-
+-
+-def id_srandi(t):
+-    """
+-    Initialize seed values for :func:`id_srand` (any appropriately random
+-    numbers will do).
+-
+-    :param t:
+-        Array of 55 seed values.
+-    :type t: :class:`numpy.ndarray`
+-    """
+-    t = np.asfortranarray(t)
+-    _id.id_srandi(t)
+-
+-
+-def id_srando():
+-    """
+-    Reset seed values to their original values.
+-    """
+-    _id.id_srando()
+-
+-
+-#------------------------------------------------------------------------------
+-# idd_frm.f
+-#------------------------------------------------------------------------------
+-
+-def idd_frm(n, w, x):
+-    """
+-    Transform real vector via a composition of Rokhlin's random transform,
+-    random subselection, and an FFT.
+-
+-    In contrast to :func:`idd_sfrm`, this routine works best when the length of
+-    the transformed vector is the power-of-two integer output by
+-    :func:`idd_frmi`, or when the length is not specified but instead
+-    determined a posteriori from the output. The returned transformed vector is
+-    randomly permuted.
+-
+-    :param n:
+-        Greatest power-of-two integer satisfying `n <= x.size` as obtained from
+-        :func:`idd_frmi`; `n` is also the length of the output vector.
+-    :type n: int
+-    :param w:
+-        Initialization array constructed by :func:`idd_frmi`.
+-    :type w: :class:`numpy.ndarray`
+-    :param x:
+-        Vector to be transformed.
+-    :type x: :class:`numpy.ndarray`
+-
+-    :return:
+-        Transformed vector.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idd_frm(n, w, x)
+-
+-
+-def idd_sfrm(l, n, w, x):
+-    """
+-    Transform real vector via a composition of Rokhlin's random transform,
+-    random subselection, and an FFT.
+-
+-    In contrast to :func:`idd_frm`, this routine works best when the length of
+-    the transformed vector is known a priori.
+-
+-    :param l:
+-        Length of transformed vector, satisfying `l <= n`.
+-    :type l: int
+-    :param n:
+-        Greatest power-of-two integer satisfying `n <= x.size` as obtained from
+-        :func:`idd_sfrmi`.
+-    :type n: int
+-    :param w:
+-        Initialization array constructed by :func:`idd_sfrmi`.
+-    :type w: :class:`numpy.ndarray`
+-    :param x:
+-        Vector to be transformed.
+-    :type x: :class:`numpy.ndarray`
+-
+-    :return:
+-        Transformed vector.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idd_sfrm(l, n, w, x)
+-
+-
+-def idd_frmi(m):
+-    """
+-    Initialize data for :func:`idd_frm`.
+-
+-    :param m:
+-        Length of vector to be transformed.
+-    :type m: int
+-
+-    :return:
+-        Greatest power-of-two integer `n` satisfying `n <= m`.
+-    :rtype: int
+-    :return:
+-        Initialization array to be used by :func:`idd_frm`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idd_frmi(m)
+-
+-
+-def idd_sfrmi(l, m):
+-    """
+-    Initialize data for :func:`idd_sfrm`.
+-
+-    :param l:
+-        Length of output transformed vector.
+-    :type l: int
+-    :param m:
+-        Length of the vector to be transformed.
+-    :type m: int
+-
+-    :return:
+-        Greatest power-of-two integer `n` satisfying `n <= m`.
+-    :rtype: int
+-    :return:
+-        Initialization array to be used by :func:`idd_sfrm`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idd_sfrmi(l, m)
+-
+-
+-#------------------------------------------------------------------------------
+-# idd_id.f
+-#------------------------------------------------------------------------------
+-
+-def iddp_id(eps, A):
+-    """
+-    Compute ID of a real matrix to a specified relative precision.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = _asfortranarray_copy(A)
+-    k, idx, rnorms = _id.iddp_id(eps, A)
+-    n = A.shape[1]
+-    proj = A.T.ravel()[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def iddr_id(A, k):
+-    """
+-    Compute ID of a real matrix to a specified rank.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = _asfortranarray_copy(A)
+-    idx, rnorms = _id.iddr_id(A, k)
+-    n = A.shape[1]
+-    proj = A.T.ravel()[:k*(n-k)].reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-def idd_reconid(B, idx, proj):
+-    """
+-    Reconstruct matrix from real ID.
+-
+-    :param B:
+-        Skeleton matrix.
+-    :type B: :class:`numpy.ndarray`
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Reconstructed matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    B = np.asfortranarray(B)
+-    if proj.size > 0:
+-        return _id.idd_reconid(B, idx, proj)
+-    else:
+-        return B[:, np.argsort(idx)]
+-
+-
+-def idd_reconint(idx, proj):
+-    """
+-    Reconstruct interpolation matrix from real ID.
+-
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Interpolation matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idd_reconint(idx, proj)
+-
+-
+-def idd_copycols(A, k, idx):
+-    """
+-    Reconstruct skeleton matrix from real ID.
+-
+-    :param A:
+-        Original matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-
+-    :return:
+-        Skeleton matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    return _id.idd_copycols(A, k, idx)
+-
+-
+-#------------------------------------------------------------------------------
+-# idd_id2svd.f
+-#------------------------------------------------------------------------------
+-
+-def idd_id2svd(B, idx, proj):
+-    """
+-    Convert real ID to SVD.
+-
+-    :param B:
+-        Skeleton matrix.
+-    :type B: :class:`numpy.ndarray`
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    B = np.asfortranarray(B)
+-    U, V, S, ier = _id.idd_id2svd(B, idx, proj)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idd_snorm.f
+-#------------------------------------------------------------------------------
+-
+-def idd_snorm(m, n, matvect, matvec, its=20):
+-    """
+-    Estimate spectral norm of a real matrix by the randomized power method.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param its:
+-        Number of power method iterations.
+-    :type its: int
+-
+-    :return:
+-        Spectral norm estimate.
+-    :rtype: float
+-    """
+-    snorm, v = _id.idd_snorm(m, n, matvect, matvec, its)
+-    return snorm
+-
+-
+-def idd_diffsnorm(m, n, matvect, matvect2, matvec, matvec2, its=20):
+-    """
+-    Estimate spectral norm of the difference of two real matrices by the
+-    randomized power method.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the transpose of the first matrix to a vector, with
+-        call signature `y = matvect(x)`, where `x` and `y` are the input and
+-        output vectors, respectively.
+-    :type matvect: function
+-    :param matvect2:
+-        Function to apply the transpose of the second matrix to a vector, with
+-        call signature `y = matvect2(x)`, where `x` and `y` are the input and
+-        output vectors, respectively.
+-    :type matvect2: function
+-    :param matvec:
+-        Function to apply the first matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param matvec2:
+-        Function to apply the second matrix to a vector, with call signature
+-        `y = matvec2(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec2: function
+-    :param its:
+-        Number of power method iterations.
+-    :type its: int
+-
+-    :return:
+-        Spectral norm estimate of matrix difference.
+-    :rtype: float
+-    """
+-    return _id.idd_diffsnorm(m, n, matvect, matvect2, matvec, matvec2, its)
+-
+-
+-#------------------------------------------------------------------------------
+-# idd_svd.f
+-#------------------------------------------------------------------------------
+-
+-def iddr_svd(A, k):
+-    """
+-    Compute SVD of a real matrix to a specified rank.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    U, V, S, ier = _id.iddr_svd(A, k)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-def iddp_svd(eps, A):
+-    """
+-    Compute SVD of a real matrix to a specified relative precision.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    k, iU, iV, iS, w, ier = _id.iddp_svd(eps, A)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# iddp_aid.f
+-#------------------------------------------------------------------------------
+-
+-def iddp_aid(eps, A):
+-    """
+-    Compute ID of a real matrix to a specified relative precision using random
+-    sampling.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, w = idd_frmi(m)
+-    proj = np.empty(n*(2*n2 + 1) + n2 + 1, order='F')
+-    k, idx, proj = _id.iddp_aid(eps, A, w, proj)
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def idd_estrank(eps, A):
+-    """
+-    Estimate rank of a real matrix to a specified relative precision using
+-    random sampling.
+-
+-    The output rank is typically about 8 higher than the actual rank.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank estimate.
+-    :rtype: int
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, w = idd_frmi(m)
+-    ra = np.empty(n*n2 + (n + 1)*(n2 + 1), order='F')
+-    k, ra = _id.idd_estrank(eps, A, w, ra)
+-    return k
+-
+-
+-#------------------------------------------------------------------------------
+-# iddp_asvd.f
+-#------------------------------------------------------------------------------
+-
+-def iddp_asvd(eps, A):
+-    """
+-    Compute SVD of a real matrix to a specified relative precision using random
+-    sampling.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, winit = _id.idd_frmi(m)
+-    w = np.empty(
+-        max((min(m, n) + 1)*(3*m + 5*n + 1) + 25*min(m, n)**2,
+-            (2*n + 1)*(n2 + 1)),
+-        order='F')
+-    k, iU, iV, iS, w, ier = _id.iddp_asvd(eps, A, winit, w)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# iddp_rid.f
+-#------------------------------------------------------------------------------
+-
+-def iddp_rid(eps, m, n, matvect):
+-    """
+-    Compute ID of a real matrix to a specified relative precision using random
+-    matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    proj = np.empty(m + 1 + 2*n*(min(m, n) + 1), order='F')
+-    k, idx, proj, ier = _id.iddp_rid(eps, m, n, matvect, proj)
+-    if ier != 0:
+-        raise _RETCODE_ERROR
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def idd_findrank(eps, m, n, matvect):
+-    """
+-    Estimate rank of a real matrix to a specified relative precision using
+-    random matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-
+-    :return:
+-        Rank estimate.
+-    :rtype: int
+-    """
+-    k, ra, ier = _id.idd_findrank(eps, m, n, matvect)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return k
+-
+-
+-#------------------------------------------------------------------------------
+-# iddp_rsvd.f
+-#------------------------------------------------------------------------------
+-
+-def iddp_rsvd(eps, m, n, matvect, matvec):
+-    """
+-    Compute SVD of a real matrix to a specified relative precision using random
+-    matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    k, iU, iV, iS, w, ier = _id.iddp_rsvd(eps, m, n, matvect, matvec)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# iddr_aid.f
+-#------------------------------------------------------------------------------
+-
+-def iddr_aid(A, k):
+-    """
+-    Compute ID of a real matrix to a specified rank using random sampling.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    w = iddr_aidi(m, n, k)
+-    idx, proj = _id.iddr_aid(A, k, w)
+-    if k == n:
+-        proj = np.empty((k, n-k), dtype='float64', order='F')
+-    else:
+-        proj = proj.reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-def iddr_aidi(m, n, k):
+-    """
+-    Initialize array for :func:`iddr_aid`.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Initialization array to be used by :func:`iddr_aid`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.iddr_aidi(m, n, k)
+-
+-
+-#------------------------------------------------------------------------------
+-# iddr_asvd.f
+-#------------------------------------------------------------------------------
+-
+-def iddr_asvd(A, k):
+-    """
+-    Compute SVD of a real matrix to a specified rank using random sampling.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    w = np.empty((2*k + 28)*m + (6*k + 21)*n + 25*k**2 + 100, order='F')
+-    w_ = iddr_aidi(m, n, k)
+-    w[:w_.size] = w_
+-    U, V, S, ier = _id.iddr_asvd(A, k, w)
+-    if ier != 0:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# iddr_rid.f
+-#------------------------------------------------------------------------------
+-
+-def iddr_rid(m, n, matvect, k):
+-    """
+-    Compute ID of a real matrix to a specified rank using random matrix-vector
+-    multiplication.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    idx, proj = _id.iddr_rid(m, n, matvect, k)
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-#------------------------------------------------------------------------------
+-# iddr_rsvd.f
+-#------------------------------------------------------------------------------
+-
+-def iddr_rsvd(m, n, matvect, matvec, k):
+-    """
+-    Compute SVD of a real matrix to a specified rank using random matrix-vector
+-    multiplication.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matvect:
+-        Function to apply the matrix transpose to a vector, with call signature
+-        `y = matvect(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvect: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    U, V, S, ier = _id.iddr_rsvd(m, n, matvect, matvec, k)
+-    if ier != 0:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idz_frm.f
+-#------------------------------------------------------------------------------
+-
+-def idz_frm(n, w, x):
+-    """
+-    Transform complex vector via a composition of Rokhlin's random transform,
+-    random subselection, and an FFT.
+-
+-    In contrast to :func:`idz_sfrm`, this routine works best when the length of
+-    the transformed vector is the power-of-two integer output by
+-    :func:`idz_frmi`, or when the length is not specified but instead
+-    determined a posteriori from the output. The returned transformed vector is
+-    randomly permuted.
+-
+-    :param n:
+-        Greatest power-of-two integer satisfying `n <= x.size` as obtained from
+-        :func:`idz_frmi`; `n` is also the length of the output vector.
+-    :type n: int
+-    :param w:
+-        Initialization array constructed by :func:`idz_frmi`.
+-    :type w: :class:`numpy.ndarray`
+-    :param x:
+-        Vector to be transformed.
+-    :type x: :class:`numpy.ndarray`
+-
+-    :return:
+-        Transformed vector.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idz_frm(n, w, x)
+-
+-
+-def idz_sfrm(l, n, w, x):
+-    """
+-    Transform complex vector via a composition of Rokhlin's random transform,
+-    random subselection, and an FFT.
+-
+-    In contrast to :func:`idz_frm`, this routine works best when the length of
+-    the transformed vector is known a priori.
+-
+-    :param l:
+-        Length of transformed vector, satisfying `l <= n`.
+-    :type l: int
+-    :param n:
+-        Greatest power-of-two integer satisfying `n <= x.size` as obtained from
+-        :func:`idz_sfrmi`.
+-    :type n: int
+-    :param w:
+-        Initialization array constructed by :func:`idd_sfrmi`.
+-    :type w: :class:`numpy.ndarray`
+-    :param x:
+-        Vector to be transformed.
+-    :type x: :class:`numpy.ndarray`
+-
+-    :return:
+-        Transformed vector.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idz_sfrm(l, n, w, x)
+-
+-
+-def idz_frmi(m):
+-    """
+-    Initialize data for :func:`idz_frm`.
+-
+-    :param m:
+-        Length of vector to be transformed.
+-    :type m: int
+-
+-    :return:
+-        Greatest power-of-two integer `n` satisfying `n <= m`.
+-    :rtype: int
+-    :return:
+-        Initialization array to be used by :func:`idz_frm`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idz_frmi(m)
+-
+-
+-def idz_sfrmi(l, m):
+-    """
+-    Initialize data for :func:`idz_sfrm`.
+-
+-    :param l:
+-        Length of output transformed vector.
+-    :type l: int
+-    :param m:
+-        Length of the vector to be transformed.
+-    :type m: int
+-
+-    :return:
+-        Greatest power-of-two integer `n` satisfying `n <= m`.
+-    :rtype: int
+-    :return:
+-        Initialization array to be used by :func:`idz_sfrm`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idz_sfrmi(l, m)
+-
+-
+-#------------------------------------------------------------------------------
+-# idz_id.f
+-#------------------------------------------------------------------------------
+-
+-def idzp_id(eps, A):
+-    """
+-    Compute ID of a complex matrix to a specified relative precision.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = _asfortranarray_copy(A)
+-    k, idx, rnorms = _id.idzp_id(eps, A)
+-    n = A.shape[1]
+-    proj = A.T.ravel()[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def idzr_id(A, k):
+-    """
+-    Compute ID of a complex matrix to a specified rank.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = _asfortranarray_copy(A)
+-    idx, rnorms = _id.idzr_id(A, k)
+-    n = A.shape[1]
+-    proj = A.T.ravel()[:k*(n-k)].reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-def idz_reconid(B, idx, proj):
+-    """
+-    Reconstruct matrix from complex ID.
+-
+-    :param B:
+-        Skeleton matrix.
+-    :type B: :class:`numpy.ndarray`
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Reconstructed matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    B = np.asfortranarray(B)
+-    if proj.size > 0:
+-        return _id.idz_reconid(B, idx, proj)
+-    else:
+-        return B[:, np.argsort(idx)]
+-
+-
+-def idz_reconint(idx, proj):
+-    """
+-    Reconstruct interpolation matrix from complex ID.
+-
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Interpolation matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idz_reconint(idx, proj)
+-
+-
+-def idz_copycols(A, k, idx):
+-    """
+-    Reconstruct skeleton matrix from complex ID.
+-
+-    :param A:
+-        Original matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-
+-    :return:
+-        Skeleton matrix.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    return _id.idz_copycols(A, k, idx)
+-
+-
+-#------------------------------------------------------------------------------
+-# idz_id2svd.f
+-#------------------------------------------------------------------------------
+-
+-def idz_id2svd(B, idx, proj):
+-    """
+-    Convert complex ID to SVD.
+-
+-    :param B:
+-        Skeleton matrix.
+-    :type B: :class:`numpy.ndarray`
+-    :param idx:
+-        Column index array.
+-    :type idx: :class:`numpy.ndarray`
+-    :param proj:
+-        Interpolation coefficients.
+-    :type proj: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    B = np.asfortranarray(B)
+-    U, V, S, ier = _id.idz_id2svd(B, idx, proj)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idz_snorm.f
+-#------------------------------------------------------------------------------
+-
+-def idz_snorm(m, n, matveca, matvec, its=20):
+-    """
+-    Estimate spectral norm of a complex matrix by the randomized power method.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param its:
+-        Number of power method iterations.
+-    :type its: int
+-
+-    :return:
+-        Spectral norm estimate.
+-    :rtype: float
+-    """
+-    snorm, v = _id.idz_snorm(m, n, matveca, matvec, its)
+-    return snorm
+-
+-
+-def idz_diffsnorm(m, n, matveca, matveca2, matvec, matvec2, its=20):
+-    """
+-    Estimate spectral norm of the difference of two complex matrices by the
+-    randomized power method.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the adjoint of the first matrix to a vector, with
+-        call signature `y = matveca(x)`, where `x` and `y` are the input and
+-        output vectors, respectively.
+-    :type matveca: function
+-    :param matveca2:
+-        Function to apply the adjoint of the second matrix to a vector, with
+-        call signature `y = matveca2(x)`, where `x` and `y` are the input and
+-        output vectors, respectively.
+-    :type matveca2: function
+-    :param matvec:
+-        Function to apply the first matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param matvec2:
+-        Function to apply the second matrix to a vector, with call signature
+-        `y = matvec2(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec2: function
+-    :param its:
+-        Number of power method iterations.
+-    :type its: int
+-
+-    :return:
+-        Spectral norm estimate of matrix difference.
+-    :rtype: float
+-    """
+-    return _id.idz_diffsnorm(m, n, matveca, matveca2, matvec, matvec2, its)
+-
+-
+-#------------------------------------------------------------------------------
+-# idz_svd.f
+-#------------------------------------------------------------------------------
+-
+-def idzr_svd(A, k):
+-    """
+-    Compute SVD of a complex matrix to a specified rank.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    U, V, S, ier = _id.idzr_svd(A, k)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-def idzp_svd(eps, A):
+-    """
+-    Compute SVD of a complex matrix to a specified relative precision.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    k, iU, iV, iS, w, ier = _id.idzp_svd(eps, A)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idzp_aid.f
+-#------------------------------------------------------------------------------
+-
+-def idzp_aid(eps, A):
+-    """
+-    Compute ID of a complex matrix to a specified relative precision using
+-    random sampling.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, w = idz_frmi(m)
+-    proj = np.empty(n*(2*n2 + 1) + n2 + 1, dtype='complex128', order='F')
+-    k, idx, proj = _id.idzp_aid(eps, A, w, proj)
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def idz_estrank(eps, A):
+-    """
+-    Estimate rank of a complex matrix to a specified relative precision using
+-    random sampling.
+-
+-    The output rank is typically about 8 higher than the actual rank.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Rank estimate.
+-    :rtype: int
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, w = idz_frmi(m)
+-    ra = np.empty(n*n2 + (n + 1)*(n2 + 1), dtype='complex128', order='F')
+-    k, ra = _id.idz_estrank(eps, A, w, ra)
+-    return k
+-
+-
+-#------------------------------------------------------------------------------
+-# idzp_asvd.f
+-#------------------------------------------------------------------------------
+-
+-def idzp_asvd(eps, A):
+-    """
+-    Compute SVD of a complex matrix to a specified relative precision using
+-    random sampling.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    n2, winit = _id.idz_frmi(m)
+-    w = np.empty(
+-        max((min(m, n) + 1)*(3*m + 5*n + 11) + 8*min(m, n)**2,
+-            (2*n + 1)*(n2 + 1)),
+-        dtype=np.complex128, order='F')
+-    k, iU, iV, iS, w, ier = _id.idzp_asvd(eps, A, winit, w)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idzp_rid.f
+-#------------------------------------------------------------------------------
+-
+-def idzp_rid(eps, m, n, matveca):
+-    """
+-    Compute ID of a complex matrix to a specified relative precision using
+-    random matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-
+-    :return:
+-        Rank of ID.
+-    :rtype: int
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    proj = np.empty(
+-        m + 1 + 2*n*(min(m, n) + 1),
+-        dtype=np.complex128, order='F')
+-    k, idx, proj, ier = _id.idzp_rid(eps, m, n, matveca, proj)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return k, idx, proj
+-
+-
+-def idz_findrank(eps, m, n, matveca):
+-    """
+-    Estimate rank of a complex matrix to a specified relative precision using
+-    random matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-
+-    :return:
+-        Rank estimate.
+-    :rtype: int
+-    """
+-    k, ra, ier = _id.idz_findrank(eps, m, n, matveca)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return k
+-
+-
+-#------------------------------------------------------------------------------
+-# idzp_rsvd.f
+-#------------------------------------------------------------------------------
+-
+-def idzp_rsvd(eps, m, n, matveca, matvec):
+-    """
+-    Compute SVD of a complex matrix to a specified relative precision using
+-    random matrix-vector multiplication.
+-
+-    :param eps:
+-        Relative precision.
+-    :type eps: float
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    k, iU, iV, iS, w, ier = _id.idzp_rsvd(eps, m, n, matveca, matvec)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    U = w[iU-1:iU+m*k-1].reshape((m, k), order='F')
+-    V = w[iV-1:iV+n*k-1].reshape((n, k), order='F')
+-    S = w[iS-1:iS+k-1]
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idzr_aid.f
+-#------------------------------------------------------------------------------
+-
+-def idzr_aid(A, k):
+-    """
+-    Compute ID of a complex matrix to a specified rank using random sampling.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    w = idzr_aidi(m, n, k)
+-    idx, proj = _id.idzr_aid(A, k, w)
+-    if k == n:
+-        proj = np.empty((k, n-k), dtype='complex128', order='F')
+-    else:
+-        proj = proj.reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-def idzr_aidi(m, n, k):
+-    """
+-    Initialize array for :func:`idzr_aid`.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Initialization array to be used by :func:`idzr_aid`.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    return _id.idzr_aidi(m, n, k)
+-
+-
+-#------------------------------------------------------------------------------
+-# idzr_asvd.f
+-#------------------------------------------------------------------------------
+-
+-def idzr_asvd(A, k):
+-    """
+-    Compute SVD of a complex matrix to a specified rank using random sampling.
+-
+-    :param A:
+-        Matrix.
+-    :type A: :class:`numpy.ndarray`
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    A = np.asfortranarray(A)
+-    m, n = A.shape
+-    w = np.empty(
+-        (2*k + 22)*m + (6*k + 21)*n + 8*k**2 + 10*k + 90,
+-        dtype='complex128', order='F')
+-    w_ = idzr_aidi(m, n, k)
+-    w[:w_.size] = w_
+-    U, V, S, ier = _id.idzr_asvd(A, k, w)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+-
+-
+-#------------------------------------------------------------------------------
+-# idzr_rid.f
+-#------------------------------------------------------------------------------
+-
+-def idzr_rid(m, n, matveca, k):
+-    """
+-    Compute ID of a complex matrix to a specified rank using random
+-    matrix-vector multiplication.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-    :param k:
+-        Rank of ID.
+-    :type k: int
+-
+-    :return:
+-        Column index array.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Interpolation coefficients.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    idx, proj = _id.idzr_rid(m, n, matveca, k)
+-    proj = proj[:k*(n-k)].reshape((k, n-k), order='F')
+-    return idx, proj
+-
+-
+-#------------------------------------------------------------------------------
+-# idzr_rsvd.f
+-#------------------------------------------------------------------------------
+-
+-def idzr_rsvd(m, n, matveca, matvec, k):
+-    """
+-    Compute SVD of a complex matrix to a specified rank using random
+-    matrix-vector multiplication.
+-
+-    :param m:
+-        Matrix row dimension.
+-    :type m: int
+-    :param n:
+-        Matrix column dimension.
+-    :type n: int
+-    :param matveca:
+-        Function to apply the matrix adjoint to a vector, with call signature
+-        `y = matveca(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matveca: function
+-    :param matvec:
+-        Function to apply the matrix to a vector, with call signature
+-        `y = matvec(x)`, where `x` and `y` are the input and output vectors,
+-        respectively.
+-    :type matvec: function
+-    :param k:
+-        Rank of SVD.
+-    :type k: int
+-
+-    :return:
+-        Left singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Right singular vectors.
+-    :rtype: :class:`numpy.ndarray`
+-    :return:
+-        Singular values.
+-    :rtype: :class:`numpy.ndarray`
+-    """
+-    U, V, S, ier = _id.idzr_rsvd(m, n, matveca, matvec, k)
+-    if ier:
+-        raise _RETCODE_ERROR
+-    return U, V, S
+diff --git a/scipy/linalg/interpolative.py b/scipy/linalg/interpolative.py
+index b91cdd63a..f946b059f 100644
+--- a/scipy/linalg/interpolative.py
++++ b/scipy/linalg/interpolative.py
+@@ -1,4 +1,4 @@
+-#******************************************************************************
++#  ******************************************************************************
+ #   Copyright (C) 2013 Kenneth L. Ho
+ #
+ #   Redistribution and use in source and binary forms, with or without
+@@ -25,19 +25,19 @@
+ #   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ #   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ #   POSSIBILITY OF SUCH DAMAGE.
+-#******************************************************************************
+-
+-# Python module for interfacing with `id_dist`.
++#  ******************************************************************************
+ 
+ r"""
+ ======================================================================
+ Interpolative matrix decomposition (:mod:`scipy.linalg.interpolative`)
+ ======================================================================
+ 
+-.. moduleauthor:: Kenneth L. Ho 
+-
+ .. versionadded:: 0.13
+ 
++.. versionchanged:: 1.15.0
++    The underlying algorithms have been ported to Python from the original Fortran77
++    code. See references below for more details.
++
+ .. currentmodule:: scipy.linalg.interpolative
+ 
+ An interpolative decomposition (ID) of a matrix :math:`A \in
+@@ -94,7 +94,7 @@ Main functionality:
+    estimate_spectral_norm_diff
+    estimate_rank
+ 
+-Support functions:
++Following support functions are deprecated and will be removed in SciPy 1.17.0:
+ 
+ .. autosummary::
+    :toctree: generated/
+@@ -106,16 +106,13 @@ Support functions:
+ References
+ ==========
+ 
+-This module uses the ID software package [1]_ by Martinsson, Rokhlin,
+-Shkolnisky, and Tygert, which is a Fortran library for computing IDs
+-using various algorithms, including the rank-revealing QR approach of
+-[2]_ and the more recent randomized methods described in [3]_, [4]_,
+-and [5]_. This module exposes its functionality in a way convenient
+-for Python users. Note that this module does not add any functionality
+-beyond that of organizing a simpler and more consistent interface.
++This module uses the algorithms found in ID software package [1]_ by Martinsson,
++Rokhlin, Shkolnisky, and Tygert, which is a Fortran library for computing IDs using
++various algorithms, including the rank-revealing QR approach of [2]_ and the more
++recent randomized methods described in [3]_, [4]_, and [5]_.
+ 
+-We advise the user to consult also the `documentation for the ID package
+-`_.
++We advise the user to consult also the documentation for the `ID package
++`_.
+ 
+ .. [1] P.G. Martinsson, V. Rokhlin, Y. Shkolnisky, M. Tygert. "ID: a
+     software package for low-rank approximation of matrices via interpolative
+@@ -356,25 +353,8 @@ depending on the representation. The parameter ``eps`` controls the definition
+ of the numerical rank.
+ 
+ Finally, the random number generation required for all randomized routines can
+-be controlled via :func:`scipy.linalg.interpolative.seed`. To reset the seed
+-values to their original values, use:
+-
+->>> sli.seed('default')
+-
+-To specify the seed values, use:
+-
+->>> s = 42
+->>> sli.seed(s)
+-
+-where ``s`` must be an integer or array of 55 floats. If an integer, the array
+-of floats is obtained by using ``numpy.random.rand`` with the given integer
+-seed.
+-
+-To simply generate some random numbers, type:
+-
+->>> arr = sli.rand(n)
+-
+-where ``n`` is the number of random numbers to generate.
++be controlled via providing NumPy pseudo-random generators with a fixed seed. See
++:class:`numpy.random.Generator` and :func:`numpy.random.default_rng` for more details.
+ 
+ Remarks
+ -------
+@@ -385,9 +365,9 @@ backend routine.
+ 
+ """
+ 
+-import scipy.linalg._interpolative_backend as _backend
++import scipy.linalg._decomp_interpolative as _backend
+ import numpy as np
+-import sys
++import warnings
+ 
+ __all__ = [
+     'estimate_rank',
+@@ -405,9 +385,18 @@ __all__ = [
+ 
+ _DTYPE_ERROR = ValueError("invalid input dtype (input must be float64 or complex128)")
+ _TYPE_ERROR = TypeError("invalid input type (must be array or LinearOperator)")
+-_32BIT_ERROR = ValueError("interpolative decomposition on 32-bit systems "
+-                          "with complex128 is buggy")
+-_IS_32BIT = (sys.maxsize < 2**32)
++
++
++def _C_contiguous_copy(A):
++    """
++    Same as np.ascontiguousarray, but ensure a copy
++    """
++    A = np.asarray(A)
++    if A.flags.c_contiguous:
++        A = A.copy()
++    else:
++        A = np.ascontiguousarray(A)
++    return A
+ 
+ 
+ def _is_real(A):
+@@ -424,53 +413,29 @@ def _is_real(A):
+ 
+ def seed(seed=None):
+     """
+-    Seed the internal random number generator used in this ID package.
+-
+-    The generator is a lagged Fibonacci method with 55-element internal state.
+-
+-    Parameters
+-    ----------
+-    seed : int, sequence, 'default', optional
+-        If 'default', the random seed is reset to a default value.
+-
+-        If `seed` is a sequence containing 55 floating-point numbers
+-        in range [0,1], these are used to set the internal state of
+-        the generator.
+-
+-        If the value is an integer, the internal state is obtained
+-        from `numpy.random.RandomState` (MT19937) with the integer
+-        used as the initial seed.
+-
+-        If `seed` is omitted (None), ``numpy.random.rand`` is used to
+-        initialize the generator.
++    This function, historically, used to set the seed of the randomization algorithms
++    used in the `scipy.linalg.interpolative` functions written in Fortran77.
+ 
++    The library has been ported to Python and now the functions use the native NumPy
++    generators and this function has no content and returns None. Thus this function
++    should not be used and will be removed in SciPy version 1.17.0.
+     """
+-    # For details, see :func:`_backend.id_srand`, :func:`_backend.id_srandi`,
+-    # and :func:`_backend.id_srando`.
+-
+-    if isinstance(seed, str) and seed == 'default':
+-        _backend.id_srando()
+-    elif hasattr(seed, '__len__'):
+-        state = np.asfortranarray(seed, dtype=float)
+-        if state.shape != (55,):
+-            raise ValueError("invalid input size")
+-        elif state.min() < 0 or state.max() > 1:
+-            raise ValueError("values not in range [0,1]")
+-        _backend.id_srandi(state)
+-    elif seed is None:
+-        _backend.id_srandi(np.random.rand(55))
+-    else:
+-        rnd = np.random.RandomState(seed)
+-        _backend.id_srandi(rnd.rand(55))
++    warnings.warn("`scipy.linalg.interpolative.seed` is deprecated and will be "
++                  "removed in SciPy 1.17.0.", DeprecationWarning, stacklevel=3)
+ 
+ 
+ def rand(*shape):
+     """
+-    Generate standard uniform pseudorandom numbers via a very efficient lagged
+-    Fibonacci method.
++    This function, historically, used to generate uniformly distributed random number
++    for the randomization algorithms used in the `scipy.linalg.interpolative` functions
++    written in Fortran77.
+ 
+-    This routine is used for all random number generation in this package and
+-    can affect ID and SVD results.
++    The library has been ported to Python and now the functions use the native NumPy
++    generators. Thus this function should not be used and will be removed in the
++    SciPy version 1.17.0.
++
++    If pseudo-random numbers are needed, NumPy pseudo-random generators should be used
++    instead.
+ 
+     Parameters
+     ----------
+@@ -478,11 +443,13 @@ def rand(*shape):
+         Shape of output array
+ 
+     """
+-    # For details, see :func:`_backend.id_srand`, and :func:`_backend.id_srando`.
+-    return _backend.id_srand(np.prod(shape)).reshape(shape)
++    warnings.warn("`scipy.linalg.interpolative.rand` is deprecated and will be "
++                  "removed in SciPy 1.17.0.", DeprecationWarning, stacklevel=3)
++    rng = np.random.default_rng()
++    return rng.uniform(low=0., high=1.0, size=shape)
+ 
+ 
+-def interp_decomp(A, eps_or_k, rand=True):
++def interp_decomp(A, eps_or_k, rand=True, rng=None):
+     """
+     Compute ID of a matrix.
+ 
+@@ -546,6 +513,9 @@ def interp_decomp(A, eps_or_k, rand=True):
+         Whether to use random sampling if `A` is of type :class:`numpy.ndarray`
+         (randomized algorithms are always used if `A` is of type
+         :class:`scipy.sparse.linalg.LinearOperator`).
++    rng : :class:`numpy.random.Generator`
++        NumPy generator for the randomization steps in the algorithm. If ``rand`` is
++        ``False``, the argument is ignored.
+ 
+     Returns
+     -------
+@@ -562,57 +532,49 @@ def interp_decomp(A, eps_or_k, rand=True):
+     real = _is_real(A)
+ 
+     if isinstance(A, np.ndarray):
++        A = _C_contiguous_copy(A)
+         if eps_or_k < 1:
+             eps = eps_or_k
+             if rand:
+                 if real:
+-                    k, idx, proj = _backend.iddp_aid(eps, A)
++                    k, idx, proj = _backend.iddp_aid(A, eps, rng=rng)
+                 else:
+-                    if _IS_32BIT:
+-                        raise _32BIT_ERROR
+-                    k, idx, proj = _backend.idzp_aid(eps, A)
++                    k, idx, proj = _backend.idzp_aid(A, eps, rng=rng)
+             else:
+                 if real:
+-                    k, idx, proj = _backend.iddp_id(eps, A)
++                    k, idx, proj = _backend.iddp_id(A, eps)
+                 else:
+-                    k, idx, proj = _backend.idzp_id(eps, A)
+-            return k, idx - 1, proj
++                    k, idx, proj = _backend.idzp_id(A, eps)
++            return k, idx, proj
+         else:
+             k = int(eps_or_k)
+             if rand:
+                 if real:
+-                    idx, proj = _backend.iddr_aid(A, k)
++                    idx, proj = _backend.iddr_aid(A, k, rng=rng)
+                 else:
+-                    if _IS_32BIT:
+-                        raise _32BIT_ERROR
+-                    idx, proj = _backend.idzr_aid(A, k)
++                    idx, proj = _backend.idzr_aid(A, k, rng=rng)
+             else:
+                 if real:
+                     idx, proj = _backend.iddr_id(A, k)
+                 else:
+                     idx, proj = _backend.idzr_id(A, k)
+-            return idx - 1, proj
++            return idx, proj
+     elif isinstance(A, LinearOperator):
+-        m, n = A.shape
+-        matveca = A.rmatvec
++
+         if eps_or_k < 1:
+             eps = eps_or_k
+             if real:
+-                k, idx, proj = _backend.iddp_rid(eps, m, n, matveca)
++                k, idx, proj = _backend.iddp_rid(A, eps, rng=rng)
+             else:
+-                if _IS_32BIT:
+-                    raise _32BIT_ERROR
+-                k, idx, proj = _backend.idzp_rid(eps, m, n, matveca)
+-            return k, idx - 1, proj
++                k, idx, proj = _backend.idzp_rid(A, eps, rng=rng)
++            return k, idx, proj
+         else:
+             k = int(eps_or_k)
+             if real:
+-                idx, proj = _backend.iddr_rid(m, n, matveca, k)
++                idx, proj = _backend.iddr_rid(A, k, rng=rng)
+             else:
+-                if _IS_32BIT:
+-                    raise _32BIT_ERROR
+-                idx, proj = _backend.idzr_rid(m, n, matveca, k)
+-            return idx - 1, proj
++                idx, proj = _backend.idzr_rid(A, k, rng=rng)
++            return idx, proj
+     else:
+         raise _TYPE_ERROR
+ 
+@@ -648,9 +610,9 @@ def reconstruct_matrix_from_id(B, idx, proj):
+         Reconstructed matrix.
+     """
+     if _is_real(B):
+-        return _backend.idd_reconid(B, idx + 1, proj)
++        return _backend.idd_reconid(B, idx, proj)
+     else:
+-        return _backend.idz_reconid(B, idx + 1, proj)
++        return _backend.idz_reconid(B, idx, proj)
+ 
+ 
+ def reconstruct_interp_matrix(idx, proj):
+@@ -662,10 +624,8 @@ def reconstruct_interp_matrix(idx, proj):
+ 
+         P = numpy.hstack([numpy.eye(proj.shape[0]), proj])[:,numpy.argsort(idx)]
+ 
+-    The original matrix can then be reconstructed from its skeleton matrix `B`
+-    via::
+-
+-        numpy.dot(B, P)
++    The original matrix can then be reconstructed from its skeleton matrix ``B``
++    via ``A = B @ P``
+ 
+     See also :func:`reconstruct_matrix_from_id` and
+     :func:`reconstruct_skel_matrix`.
+@@ -677,7 +637,7 @@ def reconstruct_interp_matrix(idx, proj):
+     Parameters
+     ----------
+     idx : :class:`numpy.ndarray`
+-        Column index array.
++        1D column index array.
+     proj : :class:`numpy.ndarray`
+         Interpolation coefficients.
+ 
+@@ -686,10 +646,17 @@ def reconstruct_interp_matrix(idx, proj):
+     :class:`numpy.ndarray`
+         Interpolation matrix.
+     """
++    n, krank = len(idx), proj.shape[0]
+     if _is_real(proj):
+-        return _backend.idd_reconint(idx + 1, proj)
++        p = np.zeros([krank, n], dtype=np.float64)
+     else:
+-        return _backend.idz_reconint(idx + 1, proj)
++        p = np.zeros([krank, n], dtype=np.complex128)
++
++    for ci in range(krank):
++        p[ci, idx[ci]] = 1.0
++    p[:, idx[krank:]] = proj[:, :]
++
++    return p
+ 
+ 
+ def reconstruct_skel_matrix(A, k, idx):
+@@ -726,10 +693,7 @@ def reconstruct_skel_matrix(A, k, idx):
+     :class:`numpy.ndarray`
+         Skeleton matrix.
+     """
+-    if _is_real(A):
+-        return _backend.idd_copycols(A, k, idx + 1)
+-    else:
+-        return _backend.idz_copycols(A, k, idx + 1)
++    return A[:, idx[:k]]
+ 
+ 
+ def id_to_svd(B, idx, proj):
+@@ -753,7 +717,7 @@ def id_to_svd(B, idx, proj):
+     B : :class:`numpy.ndarray`
+         Skeleton matrix.
+     idx : :class:`numpy.ndarray`
+-        Column index array.
++        1D column index array.
+     proj : :class:`numpy.ndarray`
+         Interpolation coefficients.
+ 
+@@ -766,14 +730,16 @@ def id_to_svd(B, idx, proj):
+     V : :class:`numpy.ndarray`
+         Right singular vectors.
+     """
++    B = _C_contiguous_copy(B)
+     if _is_real(B):
+-        U, V, S = _backend.idd_id2svd(B, idx + 1, proj)
++        U, S, V = _backend.idd_id2svd(B, idx, proj)
+     else:
+-        U, V, S = _backend.idz_id2svd(B, idx + 1, proj)
++        U, S, V = _backend.idz_id2svd(B, idx, proj)
++
+     return U, S, V
+ 
+ 
+-def estimate_spectral_norm(A, its=20):
++def estimate_spectral_norm(A, its=20, rng=None):
+     """
+     Estimate spectral norm of a matrix by the randomized power method.
+ 
+@@ -788,6 +754,8 @@ def estimate_spectral_norm(A, its=20):
+         `matvec` and `rmatvec` methods (to apply the matrix and its adjoint).
+     its : int, optional
+         Number of power method iterations.
++    rng : :class:`numpy.random.Generator`
++        NumPy generator for the randomization steps in the algorithm.
+ 
+     Returns
+     -------
+@@ -796,18 +764,14 @@ def estimate_spectral_norm(A, its=20):
+     """
+     from scipy.sparse.linalg import aslinearoperator
+     A = aslinearoperator(A)
+-    m, n = A.shape
+-    def matvec(x):
+-        return A.matvec(x)
+-    def matveca(x):
+-        return A.rmatvec(x)
++
+     if _is_real(A):
+-        return _backend.idd_snorm(m, n, matveca, matvec, its=its)
++        return _backend.idd_snorm(A, its=its, rng=rng)
+     else:
+-        return _backend.idz_snorm(m, n, matveca, matvec, its=its)
++        return _backend.idz_snorm(A, its=its, rng=rng)
+ 
+ 
+-def estimate_spectral_norm_diff(A, B, its=20):
++def estimate_spectral_norm_diff(A, B, its=20, rng=None):
+     """
+     Estimate spectral norm of the difference of two matrices by the randomized
+     power method.
+@@ -826,6 +790,8 @@ def estimate_spectral_norm_diff(A, B, its=20):
+         the `matvec` and `rmatvec` methods (to apply the matrix and its adjoint).
+     its : int, optional
+         Number of power method iterations.
++    rng : :class:`numpy.random.Generator`
++        NumPy generator for the randomization steps in the algorithm.
+ 
+     Returns
+     -------
+@@ -835,30 +801,20 @@ def estimate_spectral_norm_diff(A, B, its=20):
+     from scipy.sparse.linalg import aslinearoperator
+     A = aslinearoperator(A)
+     B = aslinearoperator(B)
+-    m, n = A.shape
+-    def matvec1(x):
+-        return A.matvec(x)
+-    def matveca1(x):
+-        return A.rmatvec(x)
+-    def matvec2(x):
+-        return B.matvec(x)
+-    def matveca2(x):
+-        return B.rmatvec(x)
++
+     if _is_real(A):
+-        return _backend.idd_diffsnorm(
+-            m, n, matveca1, matveca2, matvec1, matvec2, its=its)
++        return _backend.idd_diffsnorm(A, B, its=its, rng=rng)
+     else:
+-        return _backend.idz_diffsnorm(
+-            m, n, matveca1, matveca2, matvec1, matvec2, its=its)
++        return _backend.idz_diffsnorm(A, B, its=its, rng=rng)
+ 
+ 
+-def svd(A, eps_or_k, rand=True):
++def svd(A, eps_or_k, rand=True, rng=None):
+     """
+     Compute SVD of a matrix via an ID.
+ 
+     An SVD of a matrix `A` is a factorization::
+ 
+-        A = numpy.dot(U, numpy.dot(numpy.diag(S), V.conj().T))
++        A = U @ np.diag(S) @ V.conj().T
+ 
+     where `U` and `V` have orthonormal columns and `S` is nonnegative.
+ 
+@@ -889,35 +845,39 @@ def svd(A, eps_or_k, rand=True):
+         Whether to use random sampling if `A` is of type :class:`numpy.ndarray`
+         (randomized algorithms are always used if `A` is of type
+         :class:`scipy.sparse.linalg.LinearOperator`).
++    rng : :class:`numpy.random.Generator`
++        NumPy generator for the randomization steps in the algorithm. If ``rand`` is
++        ``False``, the argument is ignored.
+ 
+     Returns
+     -------
+     U : :class:`numpy.ndarray`
+-        Left singular vectors.
++        2D array of left singular vectors.
+     S : :class:`numpy.ndarray`
+-        Singular values.
++        1D array of singular values.
+     V : :class:`numpy.ndarray`
+-        Right singular vectors.
++        2D array right singular vectors.
+     """
+     from scipy.sparse.linalg import LinearOperator
+ 
+     real = _is_real(A)
+ 
+     if isinstance(A, np.ndarray):
++        A = _C_contiguous_copy(A)
+         if eps_or_k < 1:
+             eps = eps_or_k
+             if rand:
+                 if real:
+-                    U, V, S = _backend.iddp_asvd(eps, A)
++                    U, S, V = _backend.iddp_asvd(A, eps, rng=rng)
+                 else:
+-                    if _IS_32BIT:
+-                        raise _32BIT_ERROR
+-                    U, V, S = _backend.idzp_asvd(eps, A)
++                    U, S, V = _backend.idzp_asvd(A, eps, rng=rng)
+             else:
+                 if real:
+-                    U, V, S = _backend.iddp_svd(eps, A)
++                    U, S, V = _backend.iddp_svd(A, eps)
++                    V = V.T.conj()
+                 else:
+-                    U, V, S = _backend.idzp_svd(eps, A)
++                    U, S, V = _backend.idzp_svd(A, eps)
++                    V = V.T.conj()
+         else:
+             k = int(eps_or_k)
+             if k > min(A.shape):
+@@ -925,44 +885,35 @@ def svd(A, eps_or_k, rand=True):
+                                  f" {min(A.shape)} ")
+             if rand:
+                 if real:
+-                    U, V, S = _backend.iddr_asvd(A, k)
++                    U, S, V = _backend.iddr_asvd(A, k, rng=rng)
+                 else:
+-                    if _IS_32BIT:
+-                        raise _32BIT_ERROR
+-                    U, V, S = _backend.idzr_asvd(A, k)
++                    U, S, V = _backend.idzr_asvd(A, k, rng=rng)
+             else:
+                 if real:
+-                    U, V, S = _backend.iddr_svd(A, k)
++                    U, S, V = _backend.iddr_svd(A, k)
++                    V = V.T.conj()
+                 else:
+-                    U, V, S = _backend.idzr_svd(A, k)
++                    U, S, V = _backend.idzr_svd(A, k)
++                    V = V.T.conj()
+     elif isinstance(A, LinearOperator):
+-        m, n = A.shape
+-        def matvec(x):
+-            return A.matvec(x)
+-        def matveca(x):
+-            return A.rmatvec(x)
+         if eps_or_k < 1:
+             eps = eps_or_k
+             if real:
+-                U, V, S = _backend.iddp_rsvd(eps, m, n, matveca, matvec)
++                U, S, V = _backend.iddp_rsvd(A, eps, rng=rng)
+             else:
+-                if _IS_32BIT:
+-                    raise _32BIT_ERROR
+-                U, V, S = _backend.idzp_rsvd(eps, m, n, matveca, matvec)
++                U, S, V = _backend.idzp_rsvd(A, eps, rng=rng)
+         else:
+             k = int(eps_or_k)
+             if real:
+-                U, V, S = _backend.iddr_rsvd(m, n, matveca, matvec, k)
++                U, S, V = _backend.iddr_rsvd(A, k, rng=rng)
+             else:
+-                if _IS_32BIT:
+-                    raise _32BIT_ERROR
+-                U, V, S = _backend.idzr_rsvd(m, n, matveca, matvec, k)
++                U, S, V = _backend.idzr_rsvd(A, k, rng=rng)
+     else:
+         raise _TYPE_ERROR
+     return U, S, V
+ 
+ 
+-def estimate_rank(A, eps):
++def estimate_rank(A, eps, rng=None):
+     """
+     Estimate matrix rank to a specified relative precision using randomized
+     methods.
+@@ -985,6 +936,8 @@ def estimate_rank(A, eps):
+         with the `rmatvec` method (to apply the matrix adjoint).
+     eps : float
+         Relative error for numerical rank definition.
++    rng : :class:`numpy.random.Generator`
++        NumPy generator for the randomization steps in the algorithm.
+ 
+     Returns
+     -------
+@@ -996,20 +949,19 @@ def estimate_rank(A, eps):
+     real = _is_real(A)
+ 
+     if isinstance(A, np.ndarray):
++        A = _C_contiguous_copy(A)
+         if real:
+-            rank = _backend.idd_estrank(eps, A)
++            rank, _ = _backend.idd_estrank(A, eps, rng=rng)
+         else:
+-            rank = _backend.idz_estrank(eps, A)
++            rank, _ = _backend.idz_estrank(A, eps, rng=rng)
+         if rank == 0:
+             # special return value for nearly full rank
+             rank = min(A.shape)
+         return rank
+     elif isinstance(A, LinearOperator):
+-        m, n = A.shape
+-        matveca = A.rmatvec
+         if real:
+-            return _backend.idd_findrank(eps, m, n, matveca)
++            return _backend.idd_findrank(A, eps, rng=rng)[0]
+         else:
+-            return _backend.idz_findrank(eps, m, n, matveca)
++            return _backend.idz_findrank(A, eps, rng=rng)[0]
+     else:
+         raise _TYPE_ERROR
+diff --git a/scipy/linalg/meson.build b/scipy/linalg/meson.build
+index cc208092e..777edd008 100644
+--- a/scipy/linalg/meson.build
++++ b/scipy/linalg/meson.build
+@@ -111,57 +111,15 @@ py3.extension_module('_flapack',
+ 
+ # TODO: cblas/clapack are built *only* for ATLAS. Why? Is it still needed?
+ 
+-# id_dist contains a copy of FFTPACK, which has type mismatch warnings
+-# that are hard to fix. This code is terrible and noisy during the build,
+-# silence it completely.
+-_suppress_all_warnings = ff.get_supported_arguments('-w')
+-
+-py3.extension_module('_interpolative',
+-  [
+-    'src/id_dist/src/dfft.f',
+-    'src/id_dist/src/id_rand.f',
+-    'src/id_dist/src/id_rtrans.f',
+-    'src/id_dist/src/idd_frm.f',
+-    'src/id_dist/src/idd_house.f',
+-    'src/id_dist/src/idd_id.f',
+-    'src/id_dist/src/idd_id2svd.f',
+-    'src/id_dist/src/idd_qrpiv.f',
+-    'src/id_dist/src/idd_sfft.f',
+-    'src/id_dist/src/idd_snorm.f',
+-    'src/id_dist/src/idd_svd.f',
+-    'src/id_dist/src/iddp_aid.f',
+-    'src/id_dist/src/iddp_asvd.f',
+-    'src/id_dist/src/iddp_rid.f',
+-    'src/id_dist/src/iddp_rsvd.f',
+-    'src/id_dist/src/iddr_aid.f',
+-    'src/id_dist/src/iddr_asvd.f',
+-    'src/id_dist/src/iddr_rid.f',
+-    'src/id_dist/src/iddr_rsvd.f',
+-    'src/id_dist/src/idz_frm.f',
+-    'src/id_dist/src/idz_house.f',
+-    'src/id_dist/src/idz_id.f',
+-    'src/id_dist/src/idz_id2svd.f',
+-    'src/id_dist/src/idz_qrpiv.f',
+-    'src/id_dist/src/idz_sfft.f',
+-    'src/id_dist/src/idz_snorm.f',
+-    'src/id_dist/src/idz_svd.f',
+-    'src/id_dist/src/idzp_aid.f',
+-    'src/id_dist/src/idzp_asvd.f',
+-    'src/id_dist/src/idzp_rid.f',
+-    'src/id_dist/src/idzp_rsvd.f',
+-    'src/id_dist/src/idzr_aid.f',
+-    'src/id_dist/src/idzr_asvd.f',
+-    'src/id_dist/src/idzr_rid.f',
+-    'src/id_dist/src/idzr_rsvd.f',
+-    'src/id_dist/src/prini.f',
+-    f2py_gen.process('interpolative.pyf'),
+-  ],
+-  fortran_args: [fortran_ignore_warnings, _suppress_all_warnings],
++# _decomp_interpolative
++py3.extension_module('_decomp_interpolative',
++  linalg_init_cython_gen.process('_decomp_interpolative.pyx'),
++  c_args: cython_c_args,
++  dependencies: np_dep,
++  c_args: numpy_nodepr_api,
+   link_args: version_link_args,
+-  dependencies: [lapack_dep, fortranobject_dep],
+   override_options: ['b_lto=false'],
+   install: true,
+-  link_language: 'fortran',
+   subdir: 'scipy/linalg'
+ )
+ 
+@@ -278,7 +236,6 @@ python_sources = [
+   '_decomp_schur.py',
+   '_decomp_svd.py',
+   '_expm_frechet.py',
+-  '_interpolative_backend.py',
+   '_matfuncs.py',
+   '_matfuncs_expm.pyi',
+   '_matfuncs_inv_ssq.py',
+diff --git a/scipy/linalg/src/id_dist/README.txt b/scipy/linalg/src/id_dist/README.txt
+deleted file mode 100644
+index 000bb1e5f..000000000
+--- a/scipy/linalg/src/id_dist/README.txt
++++ /dev/null
+@@ -1,6 +0,0 @@
+-Please see the documentation in subdirectory doc of this id_dist directory.
+-
+-At the minimum, please read Subsection 2.1 and Section 3 in the documentation,
+-and beware that the _N.B._'s in the source code comments highlight important
+-information about the routines -- _N.B._ stands for _nota_bene_ (Latin for
+-"note well").
+diff --git a/scipy/linalg/src/id_dist/doc/doc.bib b/scipy/linalg/src/id_dist/doc/doc.bib
+deleted file mode 100644
+index 1ab5cb220..000000000
+--- a/scipy/linalg/src/id_dist/doc/doc.bib
++++ /dev/null
+@@ -1,19 +0,0 @@
+-@book{golub-van_loan,
+-  author = {Gene Golub and Charles {Van L}oan},
+-  title = {Matrix Computations},
+-  edition = {Third},
+-  publisher = {Johns Hopkins University Press},
+-  year = {1996},
+-  address = {Baltimore, Maryland}
+-}
+-
+-@article{halko-martinsson-tropp,
+-  author = {Nathan Halko and {P.-G.} Martinsson and Joel A. Tropp},
+-  title = {Finding structure with randomness: probabilistic algorithms
+-           for constructing approximate matrix decompositions},
+-  journal = {SIAM Review},
+-  volume = {53},
+-  number = {2},
+-  pages = {217--288},
+-  year = {2011}
+-}
+diff --git a/scipy/linalg/src/id_dist/doc/doc.tex b/scipy/linalg/src/id_dist/doc/doc.tex
+deleted file mode 100644
+index 8bcece8c4..000000000
+--- a/scipy/linalg/src/id_dist/doc/doc.tex
++++ /dev/null
+@@ -1,977 +0,0 @@
+-\documentclass[letterpaper,12pt]{article}
+-\usepackage[margin=1in]{geometry}
+-\usepackage{verbatim}
+-\usepackage{amsmath}
+-\usepackage{supertabular}
+-\usepackage{array}
+-
+-\def\T{{\hbox{\scriptsize{\rm T}}}}
+-\def\epsilon{\varepsilon}
+-\def\bigoh{\mathcal{O}}
+-\def\phi{\varphi}
+-\def\st{{\hbox{\scriptsize{\rm st}}}}
+-\def\th{{\hbox{\scriptsize{\rm th}}}}
+-\def\x{\mathbf{x}}
+-
+-
+-\title{ID: A software package for low-rank approximation
+-       of matrices via interpolative decompositions, Version 0.4}
+-\author{Per-Gunnar Martinsson, Vladimir Rokhlin,\\
+-        Yoel Shkolnisky, and Mark Tygert}
+-
+-
+-\begin{document}
+-
+-\maketitle
+-
+-\newpage
+-
+-{\parindent=0pt
+-
+-The present document and all of the software
+-in the accompanying distribution (which is contained in the directory
+-{\tt id\_dist} and its subdirectories, or in the file
+-{\tt id\_dist.tar.gz})\, is
+-
+-\bigskip
+-
+-Copyright \copyright\ 2014 by P.-G. Martinsson, V. Rokhlin,
+-Y. Shkolnisky, and M. Tygert.
+-
+-\bigskip
+-
+-All rights reserved.
+-
+-\bigskip
+-
+-Redistribution and use in source and binary forms, with or without
+-modification, are permitted provided that the following conditions are
+-met:
+-
+-\begin{enumerate}
+-\item Redistributions of source code must retain the above copyright
+-notice, this list of conditions, and the following disclaimer.
+-\item Redistributions in binary form must reproduce the above copyright
+-notice, this list of conditions, and the following disclaimer in the
+-documentation and/or other materials provided with the distribution.
+-\item None of the names of the copyright holders may be used to endorse
+-or promote products derived from this software without specific prior
+-written permission.
+-\end{enumerate}
+-
+-\bigskip
+-
+-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS ``AS IS'' AND ANY
+-EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+-PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS BE
+-LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+-CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+-SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
+-BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+-WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+-OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+-ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+-
+-}
+-
+-\newpage
+-
+-\tableofcontents
+-
+-\newpage
+-
+-
+-
+-\hrule
+-
+-\medskip
+-
+-\centerline{\Large \bf IMPORTANT}
+-
+-\medskip
+-
+-\hrule
+-
+-\medskip
+-
+-\noindent At the minimum, please read Subsection~\ref{warning}
+-and Section~\ref{naming} below, and beware that the {\it N.B.}'s
+-in the source code comments highlight key information about the routines;
+-{\it N.B.} stands for {\it nota bene} (Latin for ``note well'').
+-
+-\medskip
+-
+-\hrule
+-
+-\bigskip
+-
+-
+-
+-\section{Introduction}
+-
+-This software distribution provides Fortran routines
+-for computing low-rank approximations to matrices,
+-in the forms of interpolative decompositions (IDs)
+-and singular value decompositions (SVDs).
+-The routines use algorithms based on the ID.
+-The ID is also commonly known as
+-the approximation obtained via skeletonization,
+-the approximation obtained via subsampling,
+-and the approximation obtained via subset selection.
+-The ID provides many advantages in many applications,
+-and we suspect that it will become increasingly popular
+-once tools for its computation become more widely available.
+-This software distribution includes some such tools,
+-as well as tools for computing low-rank approximations
+-in the form of SVDs.
+-Section~\ref{defs} below defines IDs and SVDs,
+-and provides references to detailed discussions of the algorithms
+-used in this software package.
+-
+-Please beware that normalized power iterations are better suited than
+-the software in this distribution
+-for computing principal component analyses
+-in the typical case when the square of the signal-to-noise ratio
+-is not orders of magnitude greater than both dimensions
+-of the data matrix; see~\cite{halko-martinsson-tropp}.
+-
+-The algorithms used in this distribution have been optimized
+-for accuracy, efficiency, and reliability;
+-as a somewhat counterintuitive consequence, many must be randomized.
+-All randomized codes in this software package succeed
+-with overwhelmingly high probability (see, for example,
+-\cite{halko-martinsson-tropp}).
+-The truly paranoid are welcome to use the routines {\tt idd\_diffsnorm}
+-and {\tt idz\_diffsnorm} to evaluate rapidly the quality
+-of the approximations produced by the randomized algorithms
+-(as done, for example, in the files
+-{\tt idd\_a\_test.f}, {\tt idd\_r\_test.f}, {\tt idz\_a\_test.f},
+-and {\tt idz\_r\_test.f} in the {\tt test} subdirectory
+-of the main directory {\tt id\_dist}).
+-In most circumstances, evaluating the quality of an approximation
+-via routines {\tt idd\_diffsnorm} or {\tt idz\_diffsnorm} is much faster
+-than forming the approximation to be evaluated. Still, we are unaware
+-of any instance in which a properly-compiled routine failed to produce
+-an accurate approximation.
+-To facilitate successful compilation, we encourage the user
+-to read the instructions in the next section,
+-and to read Section~\ref{naming}, too.
+-
+-
+-
+-\section{Compilation instructions}
+-
+-
+-Followed in numerical order, the subsections of this section
+-provide step-by-step instructions for compiling the software
+-under a Unix-compatible operating system.
+-
+-
+-\subsection{Beware that default command-line flags may not be
+-            sufficient for compiling the source codes!}
+-\label{warning}
+-
+-The Fortran source codes in this distribution pass {\tt real*8}
+-variables as integer variables, integers as {\tt real*8}'s,
+-{\tt real*8}'s as {\tt complex*16}'s, and so on.
+-This is common practice in numerical codes, and is not an error;
+-be sure to provide the relevant command-line flags to the compiler
+-(for example, run {\tt fort77} and {\tt f2c} with the flag {\tt -!P}).
+-When following the compilation instructions
+-in Subsection~\ref{makefile_edit} below,
+-be sure to set {\tt FFLAGS} appropriately.
+-
+-
+-\subsection{Install LAPACK}
+-
+-The SVD routines in this distribution depend on LAPACK.
+-Before compiling the present distribution,
+-create the LAPACK and BLAS archive (library) {\tt .a} files;
+-information about installing LAPACK is available
+-at {\tt http://www.netlib.org/lapack/} (and several other web sites).
+-
+-
+-\subsection{Decompress and untar the file {\tt id\_dist.tar.gz}}
+-
+-At the command line, decompress and untar the file
+-{\tt id\_dist.tar.gz} by issuing a command such as
+-{\tt tar -xvvzf id\_dist.tar.gz}.
+-This will create a directory named {\tt id\_dist}.
+-
+-
+-\subsection{Edit the Makefile}
+-\label{makefile_edit}
+-
+-The directory {\tt id\_dist} contains a file named {\tt Makefile}.
+-In {\tt Makefile}, set the following:
+-%
+-\begin{itemize}
+-\item {\tt FC} is the Fortran compiler.
+-\item {\tt FFLAGS} is the set of command-line flags
+-      (specifying optimization settings, for example)
+-      for the Fortran compiler specified by {\tt FC};
+-      please heed the warning in Subsection~\ref{warning} above!
+-\item {\tt BLAS\_LIB} is the file-system path to the BLAS archive
+-      (library) {\tt .a} file.
+-\item {\tt LAPACK\_LIB} is the file-system path to the LAPACK archive
+-      (library) {\tt .a} file.
+-\item {\tt ARCH} is the archiver utility (usually {\tt ar}).
+-\item {\tt ARCHFLAGS} is the set of command-line flags
+-      for the archiver specified by {\tt ARCH} needed
+-      to create an archive (usually {\tt cr}).
+-\item {\tt RANLIB} is to be set to {\tt ranlib}
+-      when {\tt ranlib} is available, and is to be set to {\tt echo}
+-      when {\tt ranlib} is not available.
+-\end{itemize}
+-
+-
+-\subsection{Make and test the libraries}
+-
+-At the command line in a shell that adheres
+-to the Bourne shell conventions for redirection, issue the command
+-``{\tt make clean; make}'' to both create the archive (library)
+-{\tt id\_lib.a} and test it.
+-(In most modern Unix distributions, {\tt sh} is the Bourne shell,
+-or else is fully compatible with the Bourne shell;
+-the Korn shell {\tt ksh} and the Bourne-again shell {\tt bash}
+-also use the Bourne shell conventions for redirection.)
+-{\tt make} places the file {\tt id\_lib.a}
+-in the directory {\tt id\_dist}; the archive (library) file
+-{\tt id\_lib.a} contains machine code for all user-callable routines
+-in this distribution.
+-
+-
+-
+-\section{Naming conventions}
+-\label{naming}
+-
+-The names of routines and files in this distribution
+-start with prefixes, followed by an underscore (``\_'').
+-The prefixes are two to four characters in length,
+-and have the following meanings:
+-%
+-\begin{itemize}
+-\item The first two letters are always ``{\tt id}'',
+-      the name of this distribution.
+-\item The third letter (when present) is either ``{\tt d}''
+-      or ``{\tt z}'';
+-      ``{\tt d}'' stands for double precision ({\tt real*8}),
+-      and ``{\tt z}'' stands for double complex ({\tt complex*16}).
+-\item The fourth letter (when present) is either ``{\tt r}''
+-      or ``{\tt p}'';
+-      ``{\tt r}'' stands for specified rank,
+-      and ``{\tt p}'' stands for specified precision.
+-      The specified rank routines require the user to provide
+-      the rank of the approximation to be constructed,
+-      while the specified precision routines adjust the rank adaptively
+-      to attain the desired precision.
+-\end{itemize}
+-
+-For example, {\tt iddr\_aid} is a {\tt real*8} routine which computes
+-an approximation of specified rank.
+-{\tt idz\_snorm} is a {\tt complex*16} routine.
+-{\tt id\_randperm} is yet another routine in this distribution.
+-
+-
+-
+-\section{Example programs}
+-
+-For examples of how to use the user-callable routines
+-in this distribution, see the source codes in subdirectory {\tt test}
+-of the main directory {\tt id\_dist}.
+-
+-
+-
+-\section{Directory structure}
+-
+-The main {\tt id\_dist} directory contains a Makefile,
+-the auxiliary text files {\tt README.txt} and {\tt size.txt},
+-and the following subdirectories, described in the subsections below:
+-%
+-\begin{enumerate}
+-\item {\tt bin}
+-\item {\tt development}
+-\item {\tt doc}
+-\item {\tt src}
+-\item {\tt test}
+-\item {\tt tmp}
+-\end{enumerate}
+-%
+-If a ``{\tt make all}'' command has completed successfully,
+-then the main {\tt id\_dist} directory will also contain
+-an archive (library) file {\tt id\_lib.a} containing machine code
+-for all of the user-callable routines.
+-
+-
+-\subsection{Subdirectory {\tt bin}}
+-
+-Once all of the libraries have been made via the Makefile
+-in the main {\tt id\_dist} directory,
+-the subdirectory {\tt bin} will contain object files (machine code),
+-each compiled from the corresponding file of source code
+-in the subdirectory {\tt src} of {\tt id\_dist}.
+-
+-
+-\subsection{Subdirectory {\tt development}}
+-
+-Each Fortran file in the subdirectory {\tt development}
+-(except for {\tt dfft.f} and {\tt prini.f})
+-specifies its dependencies at the top, then provides a main program
+-for testing and debugging, and finally provides source code
+-for a library of user-callable subroutines.
+-The Fortran file {\tt dfft.f} is a copy of P. N. Swarztrauber's FFTPACK library
+-for computing fast Fourier transforms.
+-The Fortran file {\tt prini.f} is a copy of V. Rokhlin's library
+-of formatted printing routines.
+-Both {\tt dfft.f} (version 4) and {\tt prini.f} are in the public domain.
+-The shell script {\tt RUNME.sh} runs shell scripts {\tt make\_src.sh}
+-and {\tt make\_test.sh}, which fill the subdirectories {\tt src}
+-and {\tt test} of the main directory {\tt id\_dist}
+-with source codes for user-callable routines
+-and with the main program testing codes.
+-
+-
+-\subsection{Subdirectory {\tt doc}}
+-
+-Subdirectory {\tt doc} contains this documentation,
+-supplementing comments in the source codes.
+-
+-
+-\subsection{Subdirectory {\tt src}}
+-
+-The files in the subdirectory {\tt src} provide source code
+-for software libraries. Each file in the subdirectory {\tt src}
+-(except for {\tt dfft.f} and {\tt prini.f}) is
+-the bottom part of the corresponding file
+-in the subdirectory {\tt development} of {\tt id\_dist}.
+-The file {\tt dfft.f} is just a copy
+-of P. N. Swarztrauber's FFTPACK library
+-for computing fast Fourier transforms.
+-The file {\tt prini.f} is a copy of V. Rokhlin's library
+-of formatted printing routines.
+-Both {\tt dfft.f} (version 4) and {\tt prini.f} are in the public domain.
+-
+-
+-\subsection{Subdirectory {\tt test}}
+-
+-The files in subdirectory {\tt test} provide source code
+-for testing and debugging. Each file in subdirectory {\tt test} is
+-the top part of the corresponding file
+-in subdirectory {\tt development} of {\tt id\_dist},
+-and provides a main program and a list of its dependencies.
+-These codes provide examples of how to call the user-callable routines.
+-
+-
+-
+-\section{Catalog of the routines}
+-
+-The main routines for decomposing {\tt real*8} matrices are:
+-%
+-\begin{enumerate}
+-%
+-\item IDs of arbitrary (generally dense) matrices:
+-{\tt iddp\_id}, {\tt iddr\_id}, {\tt iddp\_aid}, {\tt iddr\_aid}
+-%
+-\item IDs of matrices that may be rapidly applied to arbitrary vectors
+-(as may the matrices' transposes):
+-{\tt iddp\_rid}, {\tt iddr\_rid}
+-%
+-\item SVDs of arbitrary (generally dense) matrices:
+-{\tt iddp\_svd}, {\tt iddr\_svd}, {\tt iddp\_asvd},\\{\tt iddr\_asvd}
+-%
+-\item SVDs of matrices that may be rapidly applied to arbitrary vectors
+-(as may the matrices' transposes):
+-{\tt iddp\_rsvd}, {\tt iddr\_rsvd}
+-%
+-\end{enumerate}
+-
+-Similarly, the main routines for decomposing {\tt complex*16} matrices
+-are:
+-%
+-\begin{enumerate}
+-%
+-\item IDs of arbitrary (generally dense) matrices:
+-{\tt idzp\_id}, {\tt idzr\_id}, {\tt idzp\_aid}, {\tt idzr\_aid}
+-%
+-\item IDs of matrices that may be rapidly applied to arbitrary vectors
+-(as may the matrices' adjoints):
+-{\tt idzp\_rid}, {\tt idzr\_rid}
+-%
+-\item SVDs of arbitrary (generally dense) matrices:
+-{\tt idzp\_svd}, {\tt idzr\_svd}, {\tt idzp\_asvd},\\{\tt idzr\_asvd}
+-%
+-\item SVDs of matrices that may be rapidly applied to arbitrary vectors
+-(as may the matrices' adjoints):
+-{\tt idzp\_rsvd}, {\tt idzr\_rsvd}
+-%
+-\end{enumerate}
+-
+-This distribution also includes routines for constructing pivoted $QR$
+-decompositions (in {\tt idd\_qrpiv.f} and {\tt idz\_qrpiv.f}), for
+-estimating the spectral norms of matrices that may be applied rapidly
+-to arbitrary vectors as may their adjoints (in {\tt idd\_snorm.f}
+-and {\tt idz\_snorm.f}), for converting IDs to SVDs (in
+-{\tt idd\_id2svd.f} and {\tt idz\_id2svd.f}), and for computing rapidly
+-arbitrary subsets of the entries of the discrete Fourier transforms
+-of vectors (in {\tt idd\_sfft.f} and {\tt idz\_sfft.f}).
+-
+-
+-\subsection{List of the routines}
+-
+-The following is an alphabetical list of the routines
+-in this distribution, together with brief descriptions
+-of their functionality and the names of the files containing
+-the routines' source code:
+-
+-\begin{center}
+-%
+-\tablehead{\bf Routine & \bf Description & \bf Source file \\}
+-\tabletail{\hline}
+-%
+-\begin{supertabular}{>{\raggedright}p{1.2in} p{.53\textwidth} l}
+-%
+-\hline
+-{\tt id\_frand} & generates pseudorandom numbers drawn uniformly from
+-the interval $[0,1]$; this routine is more efficient than routine
+-{\tt id\_srand}, but cannot generate fewer than 55 pseudorandom numbers
+-per call & {\tt id\_rand.f} \\\hline
+-%
+-{\tt id\_frandi} & initializes the seed values for routine
+-{\tt id\_frand} to specified values & {\tt id\_rand.f} \\\hline
+-%
+-{\tt id\_frando} & initializes the seed values for routine
+-{\tt id\_frand} to their original, default values & {\tt id\_rand.f}
+-\\\hline
+-%
+-{\tt id\_randperm} & generates a uniformly random permutation &
+-{\tt id\_rand.f} \\\hline
+-%
+-{\tt id\_srand} & generates pseudorandom numbers drawn uniformly from
+-the interval $[0,1]$; this routine is less efficient than routine
+-{\tt id\_frand}, but can generate fewer than 55 pseudorandom numbers
+-per call & {\tt id\_rand.f} \\\hline
+-%
+-{\tt id\_srandi} & initializes the seed values for routine
+-{\tt id\_srand} to specified values & {\tt id\_rand.f} \\\hline
+-%
+-{\tt id\_srando} & initializes the seed values for routine
+-{\tt id\_srand} to their original, default values & {\tt id\_rand.f}
+-\\\hline
+-%
+-{\tt idd\_copycols} & collects together selected columns of a matrix &
+-{\tt idd\_id.f} \\\hline
+-%
+-{\tt idd\_diffsnorm} & estimates the spectral norm of the difference
+-between two matrices specified by routines for applying the matrices
+-and their transposes to arbitrary vectors; this routine uses the power
+-method with a random starting vector & {\tt idd\_snorm.f} \\\hline
+-%
+-{\tt idd\_enorm} & calculates the Euclidean norm of a vector &
+-{\tt idd\_snorm.f} \\\hline
+-%
+-{\tt idd\_estrank} & estimates the numerical rank of an arbitrary
+-(generally dense) matrix to a specified precision; this routine is
+-randomized, and must be initialized with routine {\tt idd\_frmi} &
+-{\tt iddp\_aid.f} \\\hline
+-%
+-{\tt idd\_frm} & transforms a vector into a vector which is
+-sufficiently scrambled to be subsampled, via a composition of Rokhlin's
+-random transform, random subselection, and a fast Fourier transform &
+-{\tt idd\_frm.f} \\\hline
+-%
+-{\tt idd\_frmi} & initializes routine {\tt idd\_frm} & {\tt idd\_frm.f}
+-\\\hline
+-%
+-{\tt idd\_getcols} & collects together selected columns of a matrix
+-specified by a routine for applying the matrix to arbitrary vectors &
+-{\tt idd\_id.f} \\\hline
+-%
+-{\tt idd\_house} & calculates the vector and scalar needed to apply the
+-Householder transformation reflecting a given vector into its first
+-entry & {\tt idd\_house.f} \\\hline
+-%
+-{\tt idd\_houseapp} & applies a Householder matrix to a vector &
+-{\tt idd\_house.f} \\\hline
+-%
+-{\tt idd\_id2svd} & converts an approximation to a matrix in the form
+-of an ID into an approximation in the form of an SVD &
+-{\tt idd\_id2svd.f} \\\hline
+-%
+-{\tt idd\_ldiv} & finds the greatest integer less than or equal to a
+-specified integer, that is divisible by another (larger) specified
+-integer & {\tt idd\_sfft.f} \\\hline
+-%
+-{\tt idd\_pairsamps} & calculates the indices of the pairs of integers
+-that the individual integers in a specified set belong to &
+-{\tt idd\_frm.f} \\\hline
+-%
+-{\tt idd\_permmult} & multiplies together a bunch of permutations &
+-{\tt idd\_qrpiv.f} \\\hline
+-%
+-{\tt idd\_qinqr} & reconstructs the $Q$ matrix in a $QR$ decomposition
+-from the output of routines {\tt iddp\_qrpiv} or {\tt iddr\_qrpiv} &
+-{\tt idd\_qrpiv.f} \\\hline
+-%
+-{\tt idd\_qrmatmat} & applies to multiple vectors collected together as
+-a matrix the $Q$ matrix (or its transpose) in the $QR$ decomposition of
+-a matrix, as described by the output of routines {\tt iddp\_qrpiv} or
+-{\tt iddr\_qrpiv}; to apply $Q$ (or its transpose) to a single vector
+-without having to provide a work array, use routine {\tt idd\_qrmatvec}
+-instead & {\tt idd\_qrpiv.f} \\\hline
+-%
+-{\tt idd\_qrmatvec} & applies to a single vector the $Q$ matrix (or its
+-transpose) in the $QR$ decomposition of a matrix, as described by the
+-output of routines {\tt iddp\_qrpiv} or {\tt iddr\_qrpiv}; to apply $Q$ 
+-(or its transpose) to several vectors efficiently, use routine
+-{\tt idd\_qrmatmat} instead & {\tt idd\_qrpiv.f} \\\hline
+-%
+-{\tt idd\_random\_} {\tt transf} & applies rapidly a
+-random orthogonal matrix to a user-supplied vector & {\tt id\_rtrans.f}
+-\\\hline
+-%
+-{\tt idd\_random\_ transf\_init} & \raggedright initializes routines
+-{\tt idd\_random\_transf} and {\tt idd\_random\_transf\_inverse} &
+-{\tt id\_rtrans.f} \\\hline
+-%
+-{\tt idd\_random\_} {\tt transf\_inverse} & applies
+-rapidly the inverse of the operator applied by routine
+-{\tt idd\_random\_transf} & {\tt id\_rtrans.f} \\\hline
+-%
+-{\tt idd\_reconid} & reconstructs a matrix from its ID &
+-{\tt idd\_id.f} \\\hline
+-%
+-{\tt idd\_reconint} & constructs $P$ in the ID $A = B \, P$, where the
+-columns of $B$ are a subset of the columns of $A$, and $P$ is the
+-projection coefficient matrix, given {\tt list}, {\tt krank}, and
+-{\tt proj} output by routines {\tt iddr\_id}, {\tt iddp\_id},
+-{\tt iddr\_aid}, {\tt iddp\_aid}, {\tt iddr\_rid}, or {\tt iddp\_rid} &
+-{\tt idd\_id.f} \\\hline
+-%
+-{\tt idd\_sfft} & rapidly computes a subset of the entries of the
+-discrete Fourier transform of a vector, composed with permutation
+-matrices both on input and on output & {\tt idd\_sfft.f} \\\hline
+-%
+-{\tt idd\_sffti} & initializes routine {\tt idd\_sfft} &
+-{\tt idd\_sfft.f} \\\hline
+-%
+-{\tt idd\_sfrm} & transforms a vector into a scrambled vector of
+-specified length, via a composition of Rokhlin's random transform,
+-random subselection, and a fast Fourier transform & {\tt idd\_frm.f}
+-\\\hline
+-%
+-{\tt idd\_sfrmi} & initializes routine {\tt idd\_sfrm} &
+-{\tt idd\_frm.f} \\\hline
+-%
+-{\tt idd\_snorm} & estimates the spectral norm of a matrix specified by
+-routines for applying the matrix and its transpose to arbitrary
+-vectors; this routine uses the power method with a random starting
+-vector & {\tt idd\_snorm.f} \\\hline
+-%
+-{\tt iddp\_aid} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is randomized, and must
+-be initialized with routine {\tt idd\_frmi} & {\tt iddp\_aid.f}
+-\\\hline
+-%
+-{\tt iddp\_asvd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is randomized, and must
+-be initialized with routine {\tt idd\_frmi} & {\tt iddp\_asvd.f}
+-\\\hline
+-%
+-{\tt iddp\_id} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is often less efficient
+-than routine {\tt iddp\_aid} & {\tt idd\_id.f} \\\hline
+-%
+-{\tt iddp\_qrpiv} & computes the pivoted $QR$ decomposition of an
+-arbitrary (generally dense) matrix via Householder transformations,
+-stopping at a specified precision of the decomposition &
+-{\tt idd\_qrpiv.f} \\\hline
+-%
+-{\tt iddp\_rid} & computes the ID, to a specified precision, of a
+-matrix specified by a routine for applying its transpose to arbitrary
+-vectors; this routine is randomized & {\tt iddp\_rid.f} \\\hline
+-%
+-{\tt iddp\_rsvd} & computes the SVD, to a specified precision, of a
+-matrix specified by routines for applying the matrix and its transpose
+-to arbitrary vectors; this routine is randomized & {\tt iddp\_rsvd.f}
+-\\\hline
+-%
+-{\tt iddp\_svd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is often less efficient
+-than routine {\tt iddp\_asvd} & {\tt idd\_svd.f} \\\hline
+-%
+-{\tt iddr\_aid} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is randomized, and must be
+-initialized by routine {\tt iddr\_aidi} & {\tt iddr\_aid.f} \\\hline
+-%
+-{\tt iddr\_aidi} & initializes routine {\tt iddr\_aid} &
+-{\tt iddr\_aid.f} \\\hline
+-%
+-{\tt iddr\_asvd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is randomized, and must be
+-initialized with routine {\tt idd\_aidi} & {\tt iddr\_asvd.f}
+-\\\hline
+-%
+-{\tt iddr\_id} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is often less efficient than
+-routine {\tt iddr\_aid} & {\tt idd\_id.f} \\\hline
+-%
+-{\tt iddr\_qrpiv} & computes the pivoted $QR$ decomposition of an
+-arbitrary (generally dense) matrix via Householder transformations,
+-stopping at a specified rank of the decomposition & {\tt idd\_qrpiv.f}
+-\\\hline
+-%
+-{\tt iddr\_rid} & computes the ID, to a specified rank, of a matrix
+-specified by a routine for applying its transpose to arbitrary vectors;
+-this routine is randomized & {\tt iddr\_rid.f} \\\hline
+-%
+-{\tt iddr\_rsvd} & computes the SVD, to a specified rank, of a matrix
+-specified by routines for applying the matrix and its transpose to
+-arbitrary vectors; this routine is randomized & {\tt iddr\_rsvd.f}
+-\\\hline
+-%
+-{\tt iddr\_svd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is often less efficient than
+-routine {\tt iddr\_asvd} & {\tt idd\_svd.f} \\\hline
+-%
+-{\tt idz\_copycols} & collects together selected columns of a matrix &
+-{\tt idz\_id.f} \\\hline
+-%
+-{\tt idz\_diffsnorm} & estimates the spectral norm of the difference
+-between two matrices specified by routines for applying the matrices
+-and their adjoints to arbitrary vectors; this routine uses the power
+-method with a random starting vector & {\tt idz\_snorm.f} \\\hline
+-%
+-{\tt idz\_enorm} & calculates the Euclidean norm of a vector &
+-{\tt idz\_snorm.f} \\\hline
+-%
+-{\tt idz\_estrank} & estimates the numerical rank of an arbitrary
+-(generally dense) matrix to a specified precision; this routine is
+-randomized, and must be initialized with routine {\tt idz\_frmi} &
+-{\tt idzp\_aid.f} \\\hline
+-%
+-{\tt idz\_frm} & transforms a vector into a vector which is
+-sufficiently scrambled to be subsampled, via a composition of Rokhlin's
+-random transform, random subselection, and a fast Fourier transform &
+-{\tt idz\_frm.f} \\\hline
+-%
+-{\tt idz\_frmi} & initializes routine {\tt idz\_frm} & {\tt idz\_frm.f}
+-\\\hline
+-%
+-{\tt idz\_getcols} & collects together selected columns of a matrix
+-specified by a routine for applying the matrix to arbitrary vectors &
+-{\tt idz\_id.f} \\\hline
+-%
+-{\tt idz\_house} & calculates the vector and scalar needed to apply the
+-Householder transformation reflecting a given vector into its first
+-entry & {\tt idz\_house.f} \\\hline
+-%
+-{\tt idz\_houseapp} & applies a Householder matrix to a vector &
+-{\tt idz\_house.f} \\\hline
+-%
+-{\tt idz\_id2svd} & converts an approximation to a matrix in the form
+-of an ID into an approximation in the form of an SVD &
+-{\tt idz\_id2svd.f} \\\hline
+-%
+-{\tt idz\_ldiv} & finds the greatest integer less than or equal to a
+-specified integer, that is divisible by another (larger) specified
+-integer & {\tt idz\_sfft.f} \\\hline
+-%
+-{\tt idz\_permmult} & multiplies together a bunch of permutations &
+-{\tt idz\_qrpiv.f} \\\hline
+-%
+-{\tt idz\_qinqr} & reconstructs the $Q$ matrix in a $QR$ decomposition
+-from the output of routines {\tt idzp\_qrpiv} or {\tt idzr\_qrpiv} &
+-{\tt idz\_qrpiv.f} \\\hline
+-%
+-{\tt idz\_qrmatmat} & applies to multiple vectors collected together as
+-a matrix the $Q$ matrix (or its adjoint) in the $QR$ decomposition of
+-a matrix, as described by the output of routines {\tt idzp\_qrpiv} or
+-{\tt idzr\_qrpiv}; to apply $Q$ (or its adjoint) to a single vector
+-without having to provide a work array, use routine {\tt idz\_qrmatvec}
+-instead & {\tt idz\_qrpiv.f} \\\hline
+-%
+-{\tt idz\_qrmatvec} & applies to a single vector the $Q$ matrix (or its
+-adjoint) in the $QR$ decomposition of a matrix, as described by the
+-output of routines {\tt idzp\_qrpiv} or {\tt idzr\_qrpiv}; to apply $Q$ 
+-(or its adjoint) to several vectors efficiently, use routine
+-{\tt idz\_qrmatmat} instead & {\tt idz\_qrpiv.f} \\\hline
+-%
+-{\tt idz\_random\_ transf} & applies rapidly a random unitary matrix to
+-a user-supplied vector & {\tt id\_rtrans.f} \\\hline
+-%
+-{\tt idz\_random\_ transf\_init} & \raggedright initializes routines
+-{\tt idz\_random\_transf} and {\tt idz\_random\_transf\_inverse} &
+-{\tt id\_rtrans.f} \\\hline
+-%
+-{\tt idz\_random\_ transf\_inverse} & applies rapidly the inverse of
+-the operator applied by routine {\tt idz\_random\_transf} &
+-{\tt id\_rtrans.f} \\\hline
+-%
+-{\tt idz\_reconid} & reconstructs a matrix from its ID &
+-{\tt idz\_id.f} \\\hline
+-%
+-{\tt idz\_reconint} & constructs $P$ in the ID $A = B \, P$, where the
+-columns of $B$ are a subset of the columns of $A$, and $P$ is the
+-projection coefficient matrix, given {\tt list}, {\tt krank}, and
+-{\tt proj} output by routines {\tt idzr\_id}, {\tt idzp\_id},
+-{\tt idzr\_aid}, {\tt idzp\_aid}, {\tt idzr\_rid}, or {\tt idzp\_rid} &
+-{\tt idz\_id.f} \\\hline
+-%
+-{\tt idz\_sfft} & rapidly computes a subset of the entries of the
+-discrete Fourier transform of a vector, composed with permutation
+-matrices both on input and on output & {\tt idz\_sfft.f} \\\hline
+-%
+-{\tt idz\_sffti} & initializes routine {\tt idz\_sfft} &
+-{\tt idz\_sfft.f} \\\hline
+-%
+-{\tt idz\_sfrm} & transforms a vector into a scrambled vector of
+-specified length, via a composition of Rokhlin's random transform,
+-random subselection, and a fast Fourier transform & {\tt idz\_frm.f}
+-\\\hline
+-%
+-{\tt idz\_sfrmi} & initializes routine {\tt idz\_sfrm} &
+-{\tt idz\_frm.f} \\\hline
+-%
+-{\tt idz\_snorm} & estimates the spectral norm of a matrix specified by
+-routines for applying the matrix and its adjoint to arbitrary
+-vectors; this routine uses the power method with a random starting
+-vector & {\tt idz\_snorm.f} \\\hline
+-%
+-{\tt idzp\_aid} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is randomized, and must
+-be initialized with routine {\tt idz\_frmi} & {\tt idzp\_aid.f}
+-\\\hline
+-%
+-{\tt idzp\_asvd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is randomized, and must
+-be initialized with routine {\tt idz\_frmi} & {\tt idzp\_asvd.f}
+-\\\hline
+-%
+-{\tt idzp\_id} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is often less efficient
+-than routine {\tt idzp\_aid} & {\tt idz\_id.f} \\\hline
+-%
+-{\tt idzp\_qrpiv} & computes the pivoted $QR$ decomposition of an
+-arbitrary (generally dense) matrix via Householder transformations,
+-stopping at a specified precision of the decomposition &
+-{\tt idz\_qrpiv.f} \\\hline
+-%
+-{\tt idzp\_rid} & computes the ID, to a specified precision, of a
+-matrix specified by a routine for applying its adjoint to arbitrary
+-vectors; this routine is randomized & {\tt idzp\_rid.f} \\\hline
+-%
+-{\tt idzp\_rsvd} & computes the SVD, to a specified precision, of a
+-matrix specified by routines for applying the matrix and its adjoint
+-to arbitrary vectors; this routine is randomized & {\tt idzp\_rsvd.f}
+-\\\hline
+-%
+-{\tt idzp\_svd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified precision; this routine is often less efficient
+-than routine {\tt idzp\_asvd} & {\tt idz\_svd.f} \\\hline
+-%
+-{\tt idzr\_aid} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is randomized, and must be
+-initialized by routine {\tt idzr\_aidi} & {\tt idzr\_aid.f} \\\hline
+-%
+-{\tt idzr\_aidi} & initializes routine {\tt idzr\_aid} &
+-{\tt idzr\_aid.f} \\\hline
+-%
+-{\tt idzr\_asvd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is randomized, and must be
+-initialized with routine {\tt idz\_aidi} & {\tt idzr\_asvd.f}
+-\\\hline
+-%
+-{\tt idzr\_id} & computes the ID of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is often less efficient than
+-routine {\tt idzr\_aid} & {\tt idz\_id.f} \\\hline
+-%
+-{\tt idzr\_qrpiv} & computes the pivoted $QR$ decomposition of an
+-arbitrary (generally dense) matrix via Householder transformations,
+-stopping at a specified rank of the decomposition & {\tt idz\_qrpiv.f}
+-\\\hline
+-%
+-{\tt idzr\_rid} & computes the ID, to a specified rank, of a matrix
+-specified by a routine for applying its adjoint to arbitrary vectors;
+-this routine is randomized & {\tt idzr\_rid.f} \\\hline
+-%
+-{\tt idzr\_rsvd} & computes the SVD, to a specified rank, of a matrix
+-specified by routines for applying the matrix and its adjoint to
+-arbitrary vectors; this routine is randomized & {\tt idzr\_rsvd.f}
+-\\\hline
+-%
+-{\tt idzr\_svd} & computes the SVD of an arbitrary (generally dense)
+-matrix, to a specified rank; this routine is often less efficient than
+-routine {\tt idzr\_asvd} & {\tt idz\_svd.f} \\
+-%
+-\end{supertabular}
+-\end{center}
+-
+-
+-
+-\section{Documentation in the source codes}
+-
+-Each routine in the source codes includes documentation
+-in the comments immediately following the declaration
+-of the subroutine's calling sequence.
+-This documentation describes the purpose of the routine,
+-the input and output variables, and the required work arrays (if any). 
+-This documentation also cites relevant references.
+-Please pay attention to the {\it N.B.}'s;
+-{\it N.B.} stands for {\it nota bene} (Latin for ``note well'')
+-and highlights important information about the routines.
+-
+-
+-
+-\section{Notation and decompositions}
+-\label{defs}
+-
+-This section sets notational conventions employed
+-in this documentation and the associated software,
+-and defines both the singular value decomposition (SVD)
+-and the interpolative decomposition (ID).
+-For information concerning other mathematical objects
+-used in the code (such as Householder transformations,
+-pivoted $QR$ decompositions, and discrete and fast Fourier transforms
+---- DFTs and FFTs), see, for example,~\cite{golub-van_loan}.
+-For detailed descriptions and proofs of the mathematical facts
+-discussed in the present section, see, for example,
+-\cite{golub-van_loan} and the references
+-in~\cite{halko-martinsson-tropp}.
+-
+-Throughout this document and the accompanying software distribution,
+-$\| \x \|$ always denotes the Euclidean norm of the vector $\x$,
+-and $\| A \|$ always denotes the spectral norm of the matrix $A$.
+-Subsection~\ref{Euclidean} below defines the Euclidean norm;
+-Subsection~\ref{spectral} below defines the spectral norm.
+-We use $A^*$ to denote the adjoint of the matrix $A$.
+-
+-
+-\subsection{Euclidean norm}
+-\label{Euclidean}
+-
+-For any positive integer $n$, and vector $\x$ of length $n$,
+-the Euclidean ($l^2$) norm $\| \x \|$ is
+-%
+-\begin{equation}
+-\| \x \| = \sqrt{ \sum_{k=1}^n |x_k|^2 },
+-\end{equation}
+-%
+-where $x_1$,~$x_2$, \dots, $x_{n-1}$,~$x_n$ are the entries of $\x$.
+-
+-
+-\subsection{Spectral norm}
+-\label{spectral}
+-
+-For any positive integers $m$ and $n$, and $m \times n$ matrix $A$,
+-the spectral ($l^2$ operator) norm $\| A \|$ is
+-%
+-\begin{equation}
+-\| A_{m \times n} \|
+-= \max \frac{\| A_{m \times n} \, \x_{n \times 1} \|}
+-            {\| \x_{n \times 1} \|},
+-\end{equation}
+-%
+-where the $\max$ is taken over all $n \times 1$ column vectors $\x$
+-such that $\| \x \| \ne 0$.
+-
+-
+-\subsection{Singular value decomposition (SVD)}
+-
+-For any positive real number $\epsilon$,
+-positive integers $k$, $m$, and $n$ with $k \le m$ and $k \le n$,
+-and any $m \times n$ matrix $A$,
+-a rank-$k$ approximation to $A$ in the form of an SVD
+-(to precision $\epsilon$) consists of an $m \times k$ matrix $U$
+-whose columns are orthonormal, an $n \times k$ matrix $V$
+-whose columns are orthonormal, and a diagonal $k \times k$ matrix
+-$\Sigma$ with diagonal entries
+-$\Sigma_{1,1} \ge \Sigma_{2,2} \ge \dots \ge \Sigma_{n-1,n-1}
+-                                         \ge \Sigma_{n,n} \ge 0$,
+-such that
+-%
+-\begin{equation}
+-\| A_{m \times n} - U_{m \times k} \, \Sigma_{k \times k}
+-                 \, (V^*)_{k \times n} \| \le \epsilon.
+-\end{equation}
+-%
+-The product $U \, \Sigma \, V^*$ is known as an SVD.
+-The columns of $U$ are known as left singular vectors;
+-the columns of $V$ are known as right singular vectors.
+-The diagonal entries of $\Sigma$ are known as singular values.
+-
+-When $k = m$ or $k = n$, and $A = U \, \Sigma \, V^*$,
+-then $U \, \Sigma \, V^*$ is known as the SVD
+-of $A$; the columns of $U$ are the left singular vectors of $A$,
+-the columns of $V$ are the right singular vectors of $A$,
+-and the diagonal entries of $\Sigma$ are the singular values of $A$.
+-For any positive integer $k$ with $k < m$ and $k < n$,
+-there exists a rank-$k$ approximation to $A$ in the form of an SVD,
+-to precision $\sigma_{k+1}$, where $\sigma_{k+1}$ is the $(k+1)^\st$
+-greatest singular value of $A$.
+-
+-
+-\subsection{Interpolative decomposition (ID)}
+-
+-For any positive real number $\epsilon$,
+-positive integers $k$, $m$, and $n$ with $k \le m$ and $k \le n$,
+-and any $m \times n$ matrix $A$,
+-a rank-$k$ approximation to $A$ in the form of an ID
+-(to precision $\epsilon$) consists of a $k \times n$ matrix $P$,
+-and an $m \times k$ matrix $B$ whose columns constitute a subset
+-of the columns of $A$, such that
+-%
+-\begin{enumerate}
+-\item $\| A_{m \times n} - B_{m \times k} \, P_{k \times n} \|
+-      \le \epsilon$,
+-\item some subset of the columns of $P$ makes up the $k \times k$
+-      identity matrix, and
+-\item every entry of $P$ has an absolute value less than or equal
+-      to a reasonably small positive real number, say 2.
+-\end{enumerate}
+-%
+-The product $B \, P$ is known as an ID.
+-The matrix $P$ is known as the projection or interpolation matrix
+-of the ID. Property~1 above approximates each column of $A$
+-via a linear combination of the columns of $B$
+-(which are themselves columns of $A$), with the coefficients
+-in the linear combination given by the entries of $P$.
+-
+-The interpolative decomposition is ``interpolative''
+-due to Property~2 above. The ID is numerically stable
+-due to Property~3 above.
+-It follows from Property~2 that the least ($k^\th$ greatest) singular value
+-of $P$ is at least 1. Combining Properties~2 and~3 yields that
+-%
+-\begin{equation}
+-\| P_{k \times n} \| \le \sqrt{4k(n-k)+1}.
+-\end{equation}
+-
+-When $k = m$ or $k = n$, and $A = B \, P$,
+-then $B \, P$ is known as the ID of $A$.
+-For any positive integer $k$ with $k < m$ and $k < n$,
+-there exists a rank-$k$ approximation to $A$ in the form of an ID,
+-to precision $\sqrt{k(n-k)+1} \; \sigma_{k+1}$,
+-where $\sigma_{k+1}$ is the $(k+1)^\st$ greatest singular value of $A$
+-(in fact, there exists an ID in which every entry
+-of the projection matrix $P$ has an absolute value less than or equal
+-to 1).
+-
+-
+-
+-\section{Bug reports, feedback, and support}
+-
+-Please let us know about errors in the software or in the documentation
+-via e-mail to {\tt tygert@aya.yale.edu}.
+-We would also appreciate hearing about particular applications of the codes,
+-especially in the form of journal articles
+-e-mailed to {\tt tygert@aya.yale.edu}.
+-Mathematical and technical support may also be available via e-mail. Enjoy!
+-
+-
+-
+-\bibliographystyle{siam}
+-\bibliography{doc}
+-
+-
+-\end{document}
+diff --git a/scipy/linalg/src/id_dist/doc/supertabular.sty b/scipy/linalg/src/id_dist/doc/supertabular.sty
+deleted file mode 100644
+index ac2638c23..000000000
+--- a/scipy/linalg/src/id_dist/doc/supertabular.sty
++++ /dev/null
+@@ -1,483 +0,0 @@
+-%%
+-%% This is file `supertabular.sty',
+-%% generated with the docstrip utility.
+-%%
+-%% The original source files were:
+-%%
+-%% supertabular.dtx  (with options: `package')
+-%% Copyright (C) 1989-2004 Johannes Braams. All rights reserved.
+-%% 
+-%% This file was generated from file(s) of the supertabular package.
+-%% -----------------------------------------------------------------
+-%% 
+-%% It may be distributed and/or modified under the
+-%% conditions of the LaTeX Project Public License, either version 1.3
+-%% of this license or (at your option) any later version.
+-%% The latest version of this license is in
+-%%   http://www.latex-project.org/lppl.txt
+-%% and version 1.3 or later is part of all distributions of LaTeX
+-%% version 2003/12/01 or later.
+-%% 
+-%% This work has the LPPL maintenance status "maintained".
+-%% 
+-%% The Current Maintainer of this work is Johannes Braams.
+-%% 
+-%% This file may only be distributed together with a copy of the
+-%% supertabular package. You may however distribute the supertabular package
+-%% without such generated files.
+-%% 
+-%% The list of all files belonging to the supertabular package is
+-%% given in the file `manifest.txt.
+-%% 
+-%% The list of derived (unpacked) files belonging to the distribution
+-%% and covered by LPPL is defined by the unpacking scripts (with
+-%% extension .ins) which are part of the distribution.
+-%% Sourcefile `supertabular.dtx'.
+-%%
+-%% Copyright (C) 1988 by Theo Jurriens
+-%% Copyright (C) 1990-2004 by Johannes Braams texniek at braams.cistron.nl
+-%%                            Kersengaarde 33
+-%%                            2723 BP Zoetermeer NL
+-%%                       all rights reserved.
+-%%
+-%%
+-\NeedsTeXFormat{LaTeX2e}
+-\ProvidesPackage{supertabular}
+-              [2004/02/20 v4.1e the supertabular environment]
+-\newcount\c@tracingst
+-\DeclareOption{errorshow}{\c@tracingst\z@}
+-\DeclareOption{pageshow}{\c@tracingst\tw@}
+-\DeclareOption{debugshow}{\c@tracingst5\relax}
+-\ProcessOptions
+-\newif\if@topcaption \@topcaptiontrue
+-\def\topcaption{\@topcaptiontrue\tablecaption}
+-\def\bottomcaption{\@topcaptionfalse\tablecaption}
+-\long\def\tablecaption{%
+-  \refstepcounter{table}\@dblarg{\@xtablecaption}}
+-\long\def\@xtablecaption[#1]#2{%
+-  \long\gdef\@process@tablecaption{\ST@caption{table}[#1]{#2}}}
+-\global\let\@process@tablecaption\relax
+-\newif\ifST@star
+-\newif\ifST@mp
+-\newdimen\ST@wd
+-\newskip\ST@rightskip
+-\newskip\ST@leftskip
+-\newskip\ST@parfillskip
+-\long\def\ST@caption#1[#2]#3{\par%
+-  \addcontentsline{\csname ext@#1\endcsname}{#1}%
+-                  {\protect\numberline{%
+-                      \csname the#1\endcsname}{\ignorespaces #2}}
+-  \begingroup
+-    \@parboxrestore
+-    \normalsize
+-    \if@topcaption \vskip -10\p@ \fi
+-    \@makecaption{\csname fnum@#1\endcsname}{\ignorespaces #3}\par
+-    \if@topcaption \vskip 10\p@ \fi
+-  \endgroup}
+-\newcommand\tablehead[1]{%
+-  \gdef\@tablehead{%
+-  \noalign{%
+-      \global\let\@savcr=\\
+-      \global\let\\=\org@tabularcr}%
+-    #1%
+-    \noalign{\global\let\\=\@savcr}}}
+-\tablehead{}
+-\newcommand\tablefirsthead[1]{\gdef\@table@first@head{#1}}
+-\newcommand\tabletail[1]{%
+-  \gdef\@tabletail{%
+-    \noalign{%
+-      \global\let\@savcr=\\
+-      \global\let\\=\org@tabularcr}%
+-    #1%
+-    \noalign{\global\let\\=\@savcr}}}
+-\tabletail{}
+-\newcommand\tablelasttail[1]{\gdef\@table@last@tail{#1}}
+-\newcommand\sttraceon{\c@tracingst5\relax}
+-\newcommand\sttraceoff{\c@tracingst\z@}
+-\newcommand\ST@trace[2]{%
+-  \ifnum\c@tracingst>#1\relax
+-    \GenericWarning
+-      {(supertabular)\@spaces\@spaces}
+-      {Package supertabular: #2}%
+-  \fi
+-  }
+-\newdimen\ST@pageleft
+-\newcommand*\shrinkheight[1]{%
+-  \noalign{\global\advance\ST@pageleft-#1\relax}}
+-\newcommand*\setSTheight[1]{%
+-  \noalign{\global\ST@pageleft=#1\relax}}
+-\newdimen\ST@headht
+-\newdimen\ST@tailht
+-\newdimen\ST@pagesofar
+-\newdimen\ST@pboxht
+-\newdimen\ST@lineht
+-\newdimen\ST@stretchht
+-\newdimen\ST@prevht
+-\newdimen\ST@toadd
+-\newdimen\ST@dimen
+-\newbox\ST@pbox
+-\def\ST@tabularcr{%
+-  {\ifnum0=`}\fi
+-  \@ifstar{\ST@xtabularcr}{\ST@xtabularcr}}
+-\def\ST@xtabularcr{%
+-  \@ifnextchar[%]
+-    {\ST@argtabularcr}%
+-    {\ifnum0=`{\fi}\cr\ST@cr}}
+-\def\ST@argtabularcr[#1]{%
+-  \ifnum0=`{\fi}%
+-  \ifdim #1>\z@
+-    \unskip\ST@xargarraycr{#1}
+-  \else
+-    \ST@yargarraycr{#1}%
+-  \fi}
+-\def\ST@xargarraycr#1{%
+-  \@tempdima #1\advance\@tempdima \dp \@arstrutbox
+-  \vrule \@height\z@ \@depth\@tempdima \@width\z@ \cr
+-  \noalign{\global\ST@toadd=#1}\ST@cr}
+-\def\ST@yargarraycr#1{%
+-  \cr\noalign{\vskip #1\global\ST@toadd=#1}\ST@cr}
+-\def\ST@startpbox#1{%
+-  \setbox\ST@pbox\vtop\bgroup\hsize#1\@arrayparboxrestore}
+-\def\ST@astartpbox#1{%
+-  \bgroup\hsize#1%
+-  \setbox\ST@pbox\vtop\bgroup\hsize#1\@arrayparboxrestore}
+-\def\ST@endpbox{%
+-  \@finalstrut\@arstrutbox\par\egroup
+-  \ST@dimen=\ht\ST@pbox
+-  \advance\ST@dimen by \dp\ST@pbox
+-  \ifnum\ST@pboxht<\ST@dimen
+-    \global\ST@pboxht=\ST@dimen
+-  \fi
+-  \ST@dimen=\z@
+-  \box\ST@pbox\hfil}
+-\def\ST@aendpbox{%
+-  \@finalstrut\@arstrutbox\par\egroup
+-  \ST@dimen=\ht\ST@pbox
+-  \advance\ST@dimen by \dp\ST@pbox
+-  \ifnum\ST@pboxht<\ST@dimen
+-    \global\ST@pboxht=\ST@dimen
+-  \fi
+-  \ST@dimen=\z@
+-  \unvbox\ST@pbox\egroup\hfil}
+-\def\estimate@lineht{%
+-  \ST@lineht=\arraystretch \baslineskp
+-  \global\advance\ST@lineht by 1\p@
+-  \ST@stretchht\ST@lineht\advance\ST@stretchht-\baslineskp
+-  \ifdim\ST@stretchht<\z@\ST@stretchht\z@\fi
+-  \ST@trace\tw@{Average line height: \the\ST@lineht}%
+-  \ST@trace\tw@{Stretched line height: \the\ST@stretchht}%
+-  }
+-\def\@calfirstpageht{%
+-  \ST@trace\tw@{Calculating height of tabular on first page}%
+-  \global\ST@pagesofar\pagetotal
+-  \global\ST@pageleft\@colroom
+-  \ST@trace\tw@{Height of text = \the\pagetotal; \MessageBreak
+-                Height of page = \the\ST@pageleft}%
+-  \if@twocolumn
+-    \ST@trace\tw@{two column mode}%
+-    \if@firstcolumn
+-     \ST@trace\tw@{First column}%
+-      \ifnum\ST@pagesofar > \ST@pageleft
+-        \global\ST@pageleft=2\ST@pageleft
+-        \ifnum\ST@pagesofar > \ST@pageleft
+-          \newpage\@calnextpageht
+-          \ST@trace\tw@{starting new page}%
+-        \else
+-          \ST@trace\tw@{Second column}%
+-          \global\advance\ST@pageleft -\ST@pagesofar
+-          \global\advance\ST@pageleft -\@colroom
+-        \fi
+-      \else
+-        \global\advance\ST@pageleft by -\ST@pagesofar
+-        \global\ST@pagesofar\z@
+-      \fi
+-    \else
+-      \ST@trace\tw@{Second column}
+-      \ifnum\ST@pagesofar > \ST@pageleft
+-        \ST@trace\tw@{starting new page}%
+-        \newpage\@calnextpageht
+-      \else
+-        \global\advance\ST@pageleft by -\ST@pagesofar
+-        \global\ST@pagesofar\z@
+-      \fi
+-    \fi
+-  \else
+-    \ST@trace\tw@{one column mode}%
+-    \ifnum\ST@pagesofar > \ST@pageleft
+-      \ST@trace\tw@{starting new page}%
+-      \newpage\@calnextpageht
+-    \else
+-      \global\advance\ST@pageleft by -\ST@pagesofar
+-      \global\ST@pagesofar\z@
+-    \fi
+-  \fi
+-  \ST@trace\tw@{Available height: \the\ST@pageleft}%
+-  \ifx\@@tablehead\@empty
+-    \ST@headht=\z@
+-  \else
+-    \setbox\@tempboxa=\vbox{\@arrayparboxrestore
+-      \ST@restore
+-      \expandafter\tabular\expandafter{\ST@tableformat}%
+-      \@@tablehead\endtabular}%
+-    \ST@headht=\ht\@tempboxa\advance\ST@headht\dp\@tempboxa
+-  \fi
+-  \ST@trace\tw@{Height of head: \the\ST@headht}%
+-  \ifx\@tabletail\@empty
+-    \ST@tailht=\z@
+-  \else
+-    \setbox\@tempboxa=\vbox{\@arrayparboxrestore
+-      \ST@restore
+-      \expandafter\tabular\expandafter{\ST@tableformat}
+-        \@tabletail\endtabular}
+-    \ST@tailht=\ht\@tempboxa\advance\ST@tailht\dp\@tempboxa
+-  \fi
+-  \advance\ST@tailht by \ST@lineht
+-  \ST@trace\tw@{Height of tail: \the\ST@tailht}%
+-  \ST@trace\tw@{Maximum height of tabular: \the\ST@pageleft}%
+-  \@tempdima\ST@headht
+-  \advance\@tempdima\ST@lineht
+-  \advance\@tempdima\ST@tailht
+-  \ST@trace\tw@{Minimum height of tabular: \the\@tempdima}%
+-  \ifnum\@tempdima>\ST@pageleft
+-    \ST@trace\tw@{starting new page}%
+-    \newpage\@calnextpageht
+-  \fi
+-}
+-\def\@calnextpageht{%
+-  \ST@trace\tw@{Calculating height of tabular on next page}%
+-  \global\ST@pageleft\@colroom
+-  \global\ST@pagesofar=\z@
+-  \ST@trace\tw@{Maximum height of tabular: \the\ST@pageleft}%
+-  }
+-\def\x@supertabular{%
+-  \let\org@tabular\tabular
+-  \let\tabular\inner@tabular
+-  \expandafter\let
+-    \csname org@tabular*\expandafter\endcsname
+-    \csname tabular*\endcsname
+-  \expandafter\let\csname tabular*\expandafter\endcsname
+-    \csname inner@tabular*\endcsname
+-  \if@topcaption \@process@tablecaption \fi
+-  \global\let\@oldcr=\\
+-  \def\baslineskp{\baselineskip}%
+-  \ifx\undefined\@classix
+-    \let\org@tabularcr\@tabularcr
+-    \let\@tabularcr\ST@tabularcr
+-    \let\org@startpbox=\@startpbox
+-    \let\org@endpbox=\@endpbox
+-    \let\@@startpbox=\ST@startpbox
+-    \let\@@endpbox=\ST@endpbox
+-  \else
+-    \let\org@tabularcr\@arraycr
+-    \let\@arraycr\ST@tabularcr
+-    \let\org@startpbox=\@startpbox
+-    \let\org@endpbox=\@endpbox
+-    \let\@startpbox=\ST@astartpbox
+-    \let\@endpbox=\ST@aendpbox
+-  \fi
+-  \ifx\@table@first@head\undefined
+-    \let\@@tablehead=\@tablehead
+-  \else
+-    \let\@@tablehead=\@table@first@head
+-  \fi
+-  \let\ST@skippage\ST@skipfirstpart
+-  \estimate@lineht
+-  \@calfirstpageht
+-  \noindent
+-  }
+-\def\supertabular{%
+-  \@ifnextchar[{\@supertabular}%]
+-               {\@supertabular[]}}
+-\def\@supertabular[#1]#2{%
+-  \def\ST@tableformat{#2}%
+-  \ST@trace\tw@{Starting a new supertabular}%
+-  \global\ST@starfalse
+-  \global\ST@mpfalse
+-  \x@supertabular
+-  \expandafter\org@tabular\expandafter{\ST@tableformat}%
+-  \@@tablehead}
+-\@namedef{supertabular*}#1{%
+-  \@ifnextchar[{\@nameuse{@supertabular*}{#1}}%
+-               {\@nameuse{@supertabular*}{#1}[]}%]
+-  }
+-\@namedef{@supertabular*}#1[#2]#3{%
+-  \ST@trace\tw@{Starting a new supertabular*}%
+-  \def\ST@tableformat{#3}%
+-  \ST@wd=#1\relax
+-  \global\ST@startrue
+-  \global\ST@mpfalse
+-  \x@supertabular
+-  \expandafter\csname org@tabular*\expandafter\endcsname
+-  \expandafter{\expandafter\ST@wd\expandafter}%
+-  \expandafter{\ST@tableformat}%
+-  \@@tablehead}%
+-\def\mpsupertabular{%
+-  \@ifnextchar[{\@mpsupertabular}%]
+-               {\@mpsupertabular[]}}
+-\def\@mpsupertabular[#1]#2{%
+-  \def\ST@tableformat{#2}%
+-  \ST@trace\tw@{Starting a new mpsupertabular}%
+-  \global\ST@starfalse
+-  \global\ST@mptrue
+-  \ST@rightskip \rightskip
+-  \ST@leftskip \leftskip
+-  \ST@parfillskip \parfillskip
+-  \x@supertabular
+-  \minipage{\columnwidth}%
+-  \parfillskip\ST@parfillskip
+-  \rightskip \ST@rightskip
+-  \leftskip \ST@leftskip
+-  \noindent\expandafter\org@tabular\expandafter{\ST@tableformat}%
+-  \@@tablehead}
+-\@namedef{mpsupertabular*}#1{%
+-  \@ifnextchar[{\@nameuse{@mpsupertabular*}{#1}}%
+-               {\@nameuse{@mpsupertabular*}{#1}[]}%]
+-  }
+-\@namedef{@mpsupertabular*}#1[#2]#3{%
+-  \ST@trace\tw@{Starting a new mpsupertabular*}%
+-  \def\ST@tableformat{#3}%
+-  \ST@wd=#1\relax
+-  \global\ST@startrue
+-  \global\ST@mptrue
+-  \ST@rightskip \rightskip
+-  \ST@leftskip \leftskip
+-  \ST@parfillskip \parfillskip
+-  \x@supertabular
+-  \minipage{\columnwidth}%
+-  \parfillskip\ST@parfillskip
+-  \rightskip \ST@rightskip
+-  \leftskip \ST@leftskip
+-  \noindent\expandafter\csname org@tabular*\expandafter\endcsname
+-  \expandafter{\expandafter\ST@wd\expandafter}%
+-  \expandafter{\ST@tableformat}%
+-  \@@tablehead}%
+-\def\endsupertabular{%
+-  \ifx\@table@last@tail\undefined
+-    \@tabletail
+-  \else
+-    \@table@last@tail
+-  \fi
+-  \csname endtabular\ifST@star*\fi\endcsname
+-  \ST@restore
+-  \if@topcaption
+-  \else
+-    \@process@tablecaption
+-    \@topcaptiontrue
+-  \fi
+-  \global\let\\\@oldcr
+-  \global\let\@process@tablecaption\relax
+-  \ST@trace\tw@{Ended a supertabular\ifST@star*\fi}%
+-  }
+-\expandafter\let\csname endsupertabular*\endcsname\endsupertabular
+-\def\endmpsupertabular{%
+-  \ifx\@table@last@tail\undefined
+-    \@tabletail
+-  \else
+-    \@table@last@tail
+-  \fi
+-  \csname endtabular\ifST@star*\fi\endcsname
+-  \endminipage
+-  \ST@restore
+-  \if@topcaption
+-  \else
+-    \@process@tablecaption
+-    \@topcaptiontrue
+-  \fi
+-  \global\let\\\@oldcr
+-  \global\let\@process@tablecaption\relax
+-  \ST@trace\tw@{Ended a mpsupertabular\ifST@star*\fi}%
+-  }
+-\expandafter\let\csname endmpsupertabular*\endcsname\endmpsupertabular
+-\def\ST@restore{%
+-  \ifx\undefined\@classix
+-    \let\@tabularcr\org@tabularcr
+-  \else
+-    \let\@arraycr\org@tabularcr
+-  \fi
+-  \let\@startpbox\org@startpbox
+-  \let\@endpbox\org@endpbox
+-  }
+-\def\inner@tabular{%
+-  \ST@restore
+-  \let\\\@oldcr
+-  \noindent
+-  \org@tabular}
+-\@namedef{inner@tabular*}{%
+-  \ST@restore
+-  \let\\\@oldcr
+-  \noindent
+-  \csname org@tabular*\endcsname}
+-\def\ST@cr{%
+-  \noalign{%
+-    \ifnum\ST@pboxht<\ST@lineht
+-      \global\advance\ST@pageleft -\ST@lineht
+-      \global\ST@prevht\ST@lineht
+-    \else
+-     \ST@trace\thr@@{Added par box with height \the\ST@pboxht}%
+-      \global\advance\ST@pageleft -\ST@pboxht
+-      \global\advance\ST@pageleft -0.1\ST@pboxht
+-      \global\advance\ST@pageleft -\ST@stretchht
+-      \global\ST@prevht\ST@pboxht
+-      \global\ST@pboxht\z@
+-    \fi
+-    \global\advance\ST@pageleft -\ST@toadd
+-    \global\ST@toadd=\z@
+-    \ST@trace\thr@@{Space left for tabular: \the\ST@pageleft}%
+-  }
+-  \noalign{\global\let\ST@next\@empty}%
+-  \ifnum\ST@pageleft<\z@
+-    \ST@skippage
+-  \else
+-    \noalign{\global\@tempdima\ST@tailht
+-      \global\advance\@tempdima\ST@prevht
+-    \ifST@mp
+-      \ifvoid\@mpfootins\else
+-        \global\advance\@tempdima\ht\@mpfootins
+-        \global\advance\@tempdima 3pt
+-      \fi
+-    \fi}
+-    \ifnum\ST@pageleft<\@tempdima
+-      \ST@newpage
+-    \fi
+-  \fi
+-  \ST@next}
+-\def\ST@skipfirstpart{%
+-  \noalign{%
+-    \ST@trace\tw@{Tabular too high, moving to next page}%
+-    \global\advance\ST@pageleft\pagetotal
+-    \global\ST@pagesofar\z@
+-    \newpage
+-    \global\let\ST@skippage\ST@newpage
+-    }}
+-\def\ST@newpage{%
+-  \noalign{\ST@trace\tw@{Starting new page, writing tail}}%
+-  \@tabletail
+-  \ifST@star
+-    \csname endtabular*\endcsname
+-  \else
+-    \endtabular
+-  \fi
+-  \ifST@mp
+-    \endminipage
+-  \fi
+-  \global\let\ST@skippage\ST@newpage
+-  \newpage\@calnextpageht
+-  \let\ST@next\@tablehead
+-  \ST@trace\tw@{writing head}%
+-  \ifST@mp
+-    \noindent\minipage{\columnwidth}%
+-    \parfillskip\ST@parfillskip
+-    \rightskip \ST@rightskip
+-    \leftskip \ST@leftskip
+-  \fi
+-  \noindent
+-  \ifST@star
+-    \expandafter\csname org@tabular*\expandafter\endcsname
+-    \expandafter{\expandafter\ST@wd\expandafter}%
+-    \expandafter{\ST@tableformat}%
+-  \else
+-    \expandafter\org@tabular\expandafter{\ST@tableformat}%
+-  \fi}
+-\endinput
+-%%
+-%% End of file `supertabular.sty'.
+diff --git a/scipy/linalg/src/id_dist/src/dfft.f b/scipy/linalg/src/id_dist/src/dfft.f
+deleted file mode 100644
+index b1b1b3206..000000000
+--- a/scipy/linalg/src/id_dist/src/dfft.f
++++ /dev/null
+@@ -1,3014 +0,0 @@
+-C
+-C                       FFTPACK
+-C
+-C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+-C
+-C                   VERSION 4  APRIL 1985
+-C
+-C      A PACKAGE OF FORTRAN SUBPROGRAMS FOR THE FAST FOURIER
+-C       TRANSFORM OF PERIODIC AND OTHER SYMMETRIC SEQUENCES
+-C
+-C                          BY
+-C
+-C                   PAUL N SWARZTRAUBER
+-C
+-C   NATIONAL CENTER FOR ATMOSPHERIC RESEARCH  BOULDER,COLORADO 80307
+-C
+-C    WHICH IS SPONSORED BY THE NATIONAL SCIENCE FOUNDATION
+-C
+-C * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
+-C
+-C
+-C THIS PACKAGE CONSISTS OF PROGRAMS WHICH PERFORM FAST FOURIER
+-C TRANSFORMS FOR BOTH COMPLEX AND REAL PERIODIC SEQUENCES AND
+-C CERTAIN OTHER SYMMETRIC SEQUENCES THAT ARE LISTED BELOW.
+-C
+-C 1.   DFFTI     INITIALIZE  DFFTF AND DFFTB
+-C 2.   DFFTF     FORWARD TRANSFORM OF A REAL PERIODIC SEQUENCE
+-C 3.   DFFTB     BACKWARD TRANSFORM OF A REAL COEFFICIENT ARRAY
+-C
+-C 4.   DZFFTI    INITIALIZE DZFFTF AND DZFFTB
+-C 5.   DZFFTF    A SIMPLIFIED REAL PERIODIC FORWARD TRANSFORM
+-C 6.   DZFFTB    A SIMPLIFIED REAL PERIODIC BACKWARD TRANSFORM
+-C
+-C 7.   DSINTI     INITIALIZE DSINT
+-C 8.   DSINT      SINE TRANSFORM OF A REAL ODD SEQUENCE
+-C
+-C 9.   DCOSTI     INITIALIZE DCOST
+-C 10.  DCOST      COSINE TRANSFORM OF A REAL EVEN SEQUENCE
+-C
+-C 11.  DSINQI     INITIALIZE DSINQF AND DSINQB
+-C 12.  DSINQF     FORWARD SINE TRANSFORM WITH ODD WAVE NUMBERS
+-C 13.  DSINQB     UNNORMALIZED INVERSE OF DSINQF
+-C
+-C 14.  DCOSQI     INITIALIZE DCOSQF AND DCOSQB
+-C 15.  DCOSQF     FORWARD COSINE TRANSFORM WITH ODD WAVE NUMBERS
+-C 16.  DCOSQB     UNNORMALIZED INVERSE OF DCOSQF
+-C
+-C 17.  ZFFTI     INITIALIZE ZFFTF AND ZFFTB
+-C 18.  ZFFTF     FORWARD TRANSFORM OF A COMPLEX PERIODIC SEQUENCE
+-C 19.  ZFFTB     UNNORMALIZED INVERSE OF ZFFTF
+-C
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C BOTH DFFTF AND DFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
+-C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DFFTF AND DFFTB
+-C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
+-C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
+-C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DFFTF OR DFFTB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTF(N,R,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTF COMPUTES THE FOURIER COEFFICIENTS OF A REAL
+-C PERODIC SEQUENCE (FOURIER ANALYSIS). THE TRANSFORM IS DEFINED
+-C BELOW AT OUTPUT PARAMETER R.
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C         N MAY CHANGE SO LONG AS DIFFERENT WORK ARRAYS ARE PROVIDED
+-C
+-C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
+-C         TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
+-C         IN THE PROGRAM THAT CALLS DFFTF. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY DFFTF AND DFFTB.
+-C
+-C
+-C OUTPUT PARAMETERS
+-C
+-C R       R(1) = THE SUM FROM I=1 TO I=N OF R(I)
+-C
+-C         IF N IS EVEN SET L =N/2   , IF N IS ODD SET L = (N+1)/2
+-C
+-C           THEN FOR K = 2,...,L
+-C
+-C              R(2*K-2) = THE SUM FROM I = 1 TO I = N OF
+-C
+-C                   R(I)*COS((K-1)*(I-1)*2*PI/N)
+-C
+-C              R(2*K-1) = THE SUM FROM I = 1 TO I = N OF
+-C
+-C                  -R(I)*SIN((K-1)*(I-1)*2*PI/N)
+-C
+-C         IF N IS EVEN
+-C
+-C              R(N) = THE SUM FROM I = 1 TO I = N OF
+-C
+-C                   (-1)**(I-1)*R(I)
+-C
+-C  *****  NOTE
+-C              THIS TRANSFORM IS UNNORMALIZED SINCE A CALL OF DFFTF
+-C              FOLLOWED BY A CALL OF DFFTB WILL MULTIPLY THE INPUT
+-C              SEQUENCE BY N.
+-C
+-C WSAVE   CONTAINS RESULTS WHICH MUST NOT BE DESTROYED BETWEEN
+-C         CALLS OF DFFTF OR DFFTB.
+-C
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTB(N,R,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DFFTB COMPUTES THE REAL PERODIC SEQUENCE FROM ITS
+-C FOURIER COEFFICIENTS (FOURIER SYNTHESIS). THE TRANSFORM IS DEFINED
+-C BELOW AT OUTPUT PARAMETER R.
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C         N MAY CHANGE SO LONG AS DIFFERENT WORK ARRAYS ARE PROVIDED
+-C
+-C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
+-C         TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 2*N+15.
+-C         IN THE PROGRAM THAT CALLS DFFTB. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY DFFTF AND DFFTB.
+-C
+-C
+-C OUTPUT PARAMETERS
+-C
+-C R       FOR N EVEN AND FOR I = 1,...,N
+-C
+-C              R(I) = R(1)+(-1)**(I-1)*R(N)
+-C
+-C                   PLUS THE SUM FROM K=2 TO K=N/2 OF
+-C
+-C                    2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+-C
+-C                   -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+-C
+-C         FOR N ODD AND FOR I = 1,...,N
+-C
+-C              R(I) = R(1) PLUS THE SUM FROM K=2 TO K=(N+1)/2 OF
+-C
+-C                   2.*R(2*K-2)*COS((K-1)*(I-1)*2*PI/N)
+-C
+-C                  -2.*R(2*K-1)*SIN((K-1)*(I-1)*2*PI/N)
+-C
+-C  *****  NOTE
+-C              THIS TRANSFORM IS UNNORMALIZED SINCE A CALL OF DFFTF
+-C              FOLLOWED BY A CALL OF DFFTB WILL MULTIPLY THE INPUT
+-C              SEQUENCE BY N.
+-C
+-C WSAVE   CONTAINS RESULTS WHICH MUST NOT BE DESTROYED BETWEEN
+-C         CALLS OF DFFTB OR DFFTF.
+-C
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C BOTH DZFFTF AND DZFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DZFFTF AND DZFFTB
+-C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
+-C         ARE REQUIRED FOR DIFFERENT VALUES OF N.
+-C
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTF(N,R,AZERO,A,B,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTF COMPUTES THE FOURIER COEFFICIENTS OF A REAL
+-C PERODIC SEQUENCE (FOURIER ANALYSIS). THE TRANSFORM IS DEFINED
+-C BELOW AT OUTPUT PARAMETERS AZERO,A AND B. DZFFTF IS A SIMPLIFIED
+-C BUT SLOWER VERSION OF DFFTF.
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY R TO BE TRANSFORMED.  THE METHOD
+-C         IS MUST EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES.
+-C
+-C R       A REAL ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
+-C         TO BE TRANSFORMED. R IS NOT DESTROYED.
+-C
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         IN THE PROGRAM THAT CALLS DZFFTF. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DZFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY DZFFTF AND DZFFTB.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C AZERO   THE SUM FROM I=1 TO I=N OF R(I)/N
+-C
+-C A,B     FOR N EVEN B(N/2)=0. AND A(N/2) IS THE SUM FROM I=1 TO
+-C         I=N OF (-1)**(I-1)*R(I)/N
+-C
+-C         FOR N EVEN DEFINE KMAX=N/2-1
+-C         FOR N ODD  DEFINE KMAX=(N-1)/2
+-C
+-C         THEN FOR  K=1,...,KMAX
+-C
+-C              A(K) EQUALS THE SUM FROM I=1 TO I=N OF
+-C
+-C                   2./N*R(I)*COS(K*(I-1)*2*PI/N)
+-C
+-C              B(K) EQUALS THE SUM FROM I=1 TO I=N OF
+-C
+-C                   2./N*R(I)*SIN(K*(I-1)*2*PI/N)
+-C
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTB(N,R,AZERO,A,B,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DZFFTB COMPUTES A REAL PERODIC SEQUENCE FROM ITS
+-C FOURIER COEFFICIENTS (FOURIER SYNTHESIS). THE TRANSFORM IS
+-C DEFINED BELOW AT OUTPUT PARAMETER R. DZFFTB IS A SIMPLIFIED
+-C BUT SLOWER VERSION OF DFFTB.
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE OUTPUT ARRAY R.  THE METHOD IS MOST
+-C         EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES.
+-C
+-C AZERO   THE CONSTANT FOURIER COEFFICIENT
+-C
+-C A,B     ARRAYS WHICH CONTAIN THE REMAINING FOURIER COEFFICIENTS
+-C         THESE ARRAYS ARE NOT DESTROYED.
+-C
+-C         THE LENGTH OF THESE ARRAYS DEPENDS ON WHETHER N IS EVEN OR
+-C         ODD.
+-C
+-C         IF N IS EVEN N/2    LOCATIONS ARE REQUIRED
+-C         IF N IS ODD (N-1)/2 LOCATIONS ARE REQUIRED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         IN THE PROGRAM THAT CALLS DZFFTB. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DZFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY DZFFTF AND DZFFTB.
+-C
+-C
+-C OUTPUT PARAMETERS
+-C
+-C R       IF N IS EVEN DEFINE KMAX=N/2
+-C         IF N IS ODD  DEFINE KMAX=(N-1)/2
+-C
+-C         THEN FOR I=1,...,N
+-C
+-C              R(I)=AZERO PLUS THE SUM FROM K=1 TO K=KMAX OF
+-C
+-C              A(K)*COS(K*(I-1)*2*PI/N)+B(K)*SIN(K*(I-1)*2*PI/N)
+-C
+-C ********************* COMPLEX NOTATION **************************
+-C
+-C         FOR J=1,...,N
+-C
+-C         R(J) EQUALS THE SUM FROM K=-KMAX TO K=KMAX OF
+-C
+-C              C(K)*EXP(I*K*(J-1)*2*PI/N)
+-C
+-C         WHERE
+-C
+-C              C(K) = .5*CMPLX(A(K),-B(K))   FOR K=1,...,KMAX
+-C
+-C              C(-K) = CONJG(C(K))
+-C
+-C              C(0) = AZERO
+-C
+-C                   AND I=SQRT(-1)
+-C
+-C *************** AMPLITUDE - PHASE NOTATION ***********************
+-C
+-C         FOR I=1,...,N
+-C
+-C         R(I) EQUALS AZERO PLUS THE SUM FROM K=1 TO K=KMAX OF
+-C
+-C              ALPHA(K)*COS(K*(I-1)*2*PI/N+BETA(K))
+-C
+-C         WHERE
+-C
+-C              ALPHA(K) = SQRT(A(K)*A(K)+B(K)*B(K))
+-C
+-C              COS(BETA(K))=A(K)/ALPHA(K)
+-C
+-C              SIN(BETA(K))=-B(K)/ALPHA(K)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINTI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C SUBROUTINE DSINT. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N+1 IS A PRODUCT OF SMALL PRIMES.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WITH AT LEAST INT(2.5*N+15) LOCATIONS.
+-C         DIFFERENT WSAVE ARRAYS ARE REQUIRED FOR DIFFERENT VALUES
+-C         OF N. THE CONTENTS OF WSAVE MUST NOT BE CHANGED BETWEEN
+-C         CALLS OF DSINT.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINT(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINT COMPUTES THE DISCRETE FOURIER SINE TRANSFORM
+-C OF AN ODD SEQUENCE X(I). THE TRANSFORM IS DEFINED BELOW AT
+-C OUTPUT PARAMETER X.
+-C
+-C DSINT IS THE UNNORMALIZED INVERSE OF ITSELF SINCE A CALL OF DSINT
+-C FOLLOWED BY ANOTHER CALL OF DSINT WILL MULTIPLY THE INPUT SEQUENCE
+-C X BY 2*(N+1).
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINT MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DSINTI(N,WSAVE).
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N+1 IS THE PRODUCT OF SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C
+-C WSAVE   A WORK ARRAY WITH DIMENSION AT LEAST INT(2.5*N+15)
+-C         IN THE PROGRAM THAT CALLS DSINT. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DSINTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C              X(I)= THE SUM FROM K=1 TO K=N
+-C
+-C                   2*X(K)*SIN(K*I*PI/(N+1))
+-C
+-C              A CALL OF DSINT FOLLOWED BY ANOTHER CALL OF
+-C              DSINT WILL MULTIPLY THE SEQUENCE X BY 2*(N+1).
+-C              HENCE DSINT IS THE UNNORMALIZED INVERSE
+-C              OF ITSELF.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
+-C         DESTROYED BETWEEN CALLS OF DSINT.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSTI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C SUBROUTINE DCOST. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N-1 IS A PRODUCT OF SMALL PRIMES.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         DIFFERENT WSAVE ARRAYS ARE REQUIRED FOR DIFFERENT VALUES
+-C         OF N. THE CONTENTS OF WSAVE MUST NOT BE CHANGED BETWEEN
+-C         CALLS OF DCOST.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOST(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOST COMPUTES THE DISCRETE FOURIER COSINE TRANSFORM
+-C OF AN EVEN SEQUENCE X(I). THE TRANSFORM IS DEFINED BELOW AT OUTPUT
+-C PARAMETER X.
+-C
+-C DCOST IS THE UNNORMALIZED INVERSE OF ITSELF SINCE A CALL OF DCOST
+-C FOLLOWED BY ANOTHER CALL OF DCOST WILL MULTIPLY THE INPUT SEQUENCE
+-C X BY 2*(N-1). THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOST MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DCOSTI(N,WSAVE).
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE SEQUENCE X. N MUST BE GREATER THAN 1.
+-C         THE METHOD IS MOST EFFICIENT WHEN N-1 IS A PRODUCT OF
+-C         SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15
+-C         IN THE PROGRAM THAT CALLS DCOST. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DCOSTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C             X(I) = X(1)+(-1)**(I-1)*X(N)
+-C
+-C              + THE SUM FROM K=2 TO K=N-1
+-C
+-C                  2*X(K)*COS((K-1)*(I-1)*PI/(N-1))
+-C
+-C              A CALL OF DCOST FOLLOWED BY ANOTHER CALL OF
+-C              DCOST WILL MULTIPLY THE SEQUENCE X BY 2*(N-1)
+-C              HENCE DCOST IS THE UNNORMALIZED INVERSE
+-C              OF ITSELF.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
+-C         DESTROYED BETWEEN CALLS OF DCOST.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C BOTH DSINQF AND DSINQB. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED. THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DSINQF AND DSINQB
+-C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
+-C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
+-C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DSINQF OR DSINQB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQF(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQF COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
+-C WAVE DATA. THAT IS , DSINQF COMPUTES THE COEFFICIENTS IN A SINE
+-C SERIES REPRESENTATION WITH ONLY ODD WAVE NUMBERS. THE TRANSFORM
+-C IS DEFINED BELOW AT OUTPUT PARAMETER X.
+-C
+-C DSINQB IS THE UNNORMALIZED INVERSE OF DSINQF SINCE A CALL OF DSINQF
+-C FOLLOWED BY A CALL OF DSINQB WILL MULTIPLY THE INPUT SEQUENCE X
+-C BY 4*N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINQF MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE).
+-C
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         IN THE PROGRAM THAT CALLS DSINQF. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C              X(I) = (-1)**(I-1)*X(N)
+-C
+-C                 + THE SUM FROM K=1 TO K=N-1 OF
+-C
+-C                 2*X(K)*SIN((2*I-1)*K*PI/(2*N))
+-C
+-C              A CALL OF DSINQF FOLLOWED BY A CALL OF
+-C              DSINQB WILL MULTIPLY THE SEQUENCE X BY 4*N.
+-C              THEREFORE DSINQB IS THE UNNORMALIZED INVERSE
+-C              OF DSINQF.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
+-C         BE DESTROYED BETWEEN CALLS OF DSINQF OR DSINQB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQB(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DSINQB COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
+-C WAVE DATA. THAT IS , DSINQB COMPUTES A SEQUENCE FROM ITS
+-C REPRESENTATION IN TERMS OF A SINE SERIES WITH ODD WAVE NUMBERS.
+-C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X.
+-C
+-C DSINQF IS THE UNNORMALIZED INVERSE OF DSINQB SINCE A CALL OF DSINQB
+-C FOLLOWED BY A CALL OF DSINQF WILL MULTIPLY THE INPUT SEQUENCE X
+-C BY 4*N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DSINQB MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE).
+-C
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         IN THE PROGRAM THAT CALLS DSINQB. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DSINQI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C              X(I)= THE SUM FROM K=1 TO K=N OF
+-C
+-C                4*X(K)*SIN((2K-1)*I*PI/(2*N))
+-C
+-C              A CALL OF DSINQB FOLLOWED BY A CALL OF
+-C              DSINQF WILL MULTIPLY THE SEQUENCE X BY 4*N.
+-C              THEREFORE DSINQF IS THE UNNORMALIZED INVERSE
+-C              OF DSINQB.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
+-C         BE DESTROYED BETWEEN CALLS OF DSINQB OR DSINQF.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C BOTH DCOSQF AND DCOSQB. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE ARRAY TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15.
+-C         THE SAME WORK ARRAY CAN BE USED FOR BOTH DCOSQF AND DCOSQB
+-C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
+-C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
+-C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF DCOSQF OR DCOSQB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQF(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQF COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
+-C WAVE DATA. THAT IS , DCOSQF COMPUTES THE COEFFICIENTS IN A COSINE
+-C SERIES REPRESENTATION WITH ONLY ODD WAVE NUMBERS. THE TRANSFORM
+-C IS DEFINED BELOW AT OUTPUT PARAMETER X
+-C
+-C DCOSQF IS THE UNNORMALIZED INVERSE OF DCOSQB SINCE A CALL OF DCOSQF
+-C FOLLOWED BY A CALL OF DCOSQB WILL MULTIPLY THE INPUT SEQUENCE X
+-C BY 4*N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOSQF MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE).
+-C
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 3*N+15
+-C         IN THE PROGRAM THAT CALLS DCOSQF. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C              X(I) = X(1) PLUS THE SUM FROM K=2 TO K=N OF
+-C
+-C                 2*X(K)*COS((2*I-1)*(K-1)*PI/(2*N))
+-C
+-C              A CALL OF DCOSQF FOLLOWED BY A CALL OF
+-C              DCOSQB WILL MULTIPLY THE SEQUENCE X BY 4*N.
+-C              THEREFORE DCOSQB IS THE UNNORMALIZED INVERSE
+-C              OF DCOSQF.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
+-C         BE DESTROYED BETWEEN CALLS OF DCOSQF OR DCOSQB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQB(N,X,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE DCOSQB COMPUTES THE FAST FOURIER TRANSFORM OF QUARTER
+-C WAVE DATA. THAT IS , DCOSQB COMPUTES A SEQUENCE FROM ITS
+-C REPRESENTATION IN TERMS OF A COSINE SERIES WITH ODD WAVE NUMBERS.
+-C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER X.
+-C
+-C DCOSQB IS THE UNNORMALIZED INVERSE OF DCOSQF SINCE A CALL OF DCOSQB
+-C FOLLOWED BY A CALL OF DCOSQF WILL MULTIPLY THE INPUT SEQUENCE X
+-C BY 4*N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE DCOSQB MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE).
+-C
+-C
+-C INPUT PARAMETERS
+-C
+-C N       THE LENGTH OF THE ARRAY X TO BE TRANSFORMED.  THE METHOD
+-C         IS MOST EFFICIENT WHEN N IS A PRODUCT OF SMALL PRIMES.
+-C
+-C X       AN ARRAY WHICH CONTAINS THE SEQUENCE TO BE TRANSFORMED
+-C
+-C WSAVE   A WORK ARRAY THAT MUST BE DIMENSIONED AT LEAST 3*N+15
+-C         IN THE PROGRAM THAT CALLS DCOSQB. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE DCOSQI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C X       FOR I=1,...,N
+-C
+-C              X(I)= THE SUM FROM K=1 TO K=N OF
+-C
+-C                4*X(K)*COS((2*K-1)*(I-1)*PI/(2*N))
+-C
+-C              A CALL OF DCOSQB FOLLOWED BY A CALL OF
+-C              DCOSQF WILL MULTIPLY THE SEQUENCE X BY 4*N.
+-C              THEREFORE DCOSQF IS THE UNNORMALIZED INVERSE
+-C              OF DCOSQB.
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT
+-C         BE DESTROYED BETWEEN CALLS OF DCOSQB OR DCOSQF.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTI(N,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTI INITIALIZES THE ARRAY WSAVE WHICH IS USED IN
+-C BOTH ZFFTF AND ZFFTB. THE PRIME FACTORIZATION OF N TOGETHER WITH
+-C A TABULATION OF THE TRIGONOMETRIC FUNCTIONS ARE COMPUTED AND
+-C STORED IN WSAVE.
+-C
+-C INPUT PARAMETER
+-C
+-C N       THE LENGTH OF THE SEQUENCE TO BE TRANSFORMED
+-C
+-C OUTPUT PARAMETER
+-C
+-C WSAVE   A WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4*N+15
+-C         THE SAME WORK ARRAY CAN BE USED FOR BOTH ZFFTF AND ZFFTB
+-C         AS LONG AS N REMAINS UNCHANGED. DIFFERENT WSAVE ARRAYS
+-C         ARE REQUIRED FOR DIFFERENT VALUES OF N. THE CONTENTS OF
+-C         WSAVE MUST NOT BE CHANGED BETWEEN CALLS OF ZFFTF OR ZFFTB.
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTF(N,C,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTF COMPUTES THE FORWARD COMPLEX DISCRETE FOURIER
+-C TRANSFORM (THE FOURIER ANALYSIS). EQUIVALENTLY , ZFFTF COMPUTES
+-C THE FOURIER COEFFICIENTS OF A COMPLEX PERIODIC SEQUENCE.
+-C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER C.
+-C
+-C THE TRANSFORM IS NOT NORMALIZED. TO OBTAIN A NORMALIZED TRANSFORM
+-C THE OUTPUT MUST BE DIVIDED BY N. OTHERWISE A CALL OF ZFFTF
+-C FOLLOWED BY A CALL OF ZFFTB WILL MULTIPLY THE SEQUENCE BY N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE ZFFTF MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE ZFFTI(N,WSAVE).
+-C
+-C INPUT PARAMETERS
+-C
+-C
+-C N      THE LENGTH OF THE COMPLEX SEQUENCE C. THE METHOD IS
+-C        MORE EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES. N
+-C
+-C C      A COMPLEX ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
+-C
+-C WSAVE   A REAL WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4N+15
+-C         IN THE PROGRAM THAT CALLS ZFFTF. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE ZFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY ZFFTF AND ZFFTB.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C C      FOR J=1,...,N
+-C
+-C            C(J)=THE SUM FROM K=1,...,N OF
+-C
+-C                  C(K)*EXP(-I*(J-1)*(K-1)*2*PI/N)
+-C
+-C                        WHERE I=SQRT(-1)
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
+-C         DESTROYED BETWEEN CALLS OF SUBROUTINE ZFFTF OR ZFFTB
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTB(N,C,WSAVE)
+-C
+-C ******************************************************************
+-C
+-C SUBROUTINE ZFFTB COMPUTES THE BACKWARD COMPLEX DISCRETE FOURIER
+-C TRANSFORM (THE FOURIER SYNTHESIS). EQUIVALENTLY , ZFFTB COMPUTES
+-C A COMPLEX PERIODIC SEQUENCE FROM ITS FOURIER COEFFICIENTS.
+-C THE TRANSFORM IS DEFINED BELOW AT OUTPUT PARAMETER C.
+-C
+-C A CALL OF ZFFTF FOLLOWED BY A CALL OF ZFFTB WILL MULTIPLY THE
+-C SEQUENCE BY N.
+-C
+-C THE ARRAY WSAVE WHICH IS USED BY SUBROUTINE ZFFTB MUST BE
+-C INITIALIZED BY CALLING SUBROUTINE ZFFTI(N,WSAVE).
+-C
+-C INPUT PARAMETERS
+-C
+-C
+-C N      THE LENGTH OF THE COMPLEX SEQUENCE C. THE METHOD IS
+-C        MORE EFFICIENT WHEN N IS THE PRODUCT OF SMALL PRIMES.
+-C
+-C C      A COMPLEX ARRAY OF LENGTH N WHICH CONTAINS THE SEQUENCE
+-C
+-C WSAVE   A REAL WORK ARRAY WHICH MUST BE DIMENSIONED AT LEAST 4N+15
+-C         IN THE PROGRAM THAT CALLS ZFFTB. THE WSAVE ARRAY MUST BE
+-C         INITIALIZED BY CALLING SUBROUTINE ZFFTI(N,WSAVE) AND A
+-C         DIFFERENT WSAVE ARRAY MUST BE USED FOR EACH DIFFERENT
+-C         VALUE OF N. THIS INITIALIZATION DOES NOT HAVE TO BE
+-C         REPEATED SO LONG AS N REMAINS UNCHANGED THUS SUBSEQUENT
+-C         TRANSFORMS CAN BE OBTAINED FASTER THAN THE FIRST.
+-C         THE SAME WSAVE ARRAY CAN BE USED BY ZFFTF AND ZFFTB.
+-C
+-C OUTPUT PARAMETERS
+-C
+-C C      FOR J=1,...,N
+-C
+-C            C(J)=THE SUM FROM K=1,...,N OF
+-C
+-C                  C(K)*EXP(I*(J-1)*(K-1)*2*PI/N)
+-C
+-C                        WHERE I=SQRT(-1)
+-C
+-C WSAVE   CONTAINS INITIALIZATION CALCULATIONS WHICH MUST NOT BE
+-C         DESTROYED BETWEEN CALLS OF SUBROUTINE ZFFTF OR ZFFTB
+-C
+-C
+-C
+-C ["SEND INDEX FOR VFFTPK" DESCRIBES A VECTORIZED VERSION OF FFTPACK]
+-C
+-C
+-C
+-
+-      SUBROUTINE ZFFTB1 (N,C,CH,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
+-      NF = IFAC(2)
+-      NA = 0
+-      L1 = 1
+-      IW = 1
+-      DO 116 K1=1,NF
+-         IP = IFAC(K1+2)
+-         L2 = IP*L1
+-         IDO = N/L2
+-         IDOT = IDO+IDO
+-         IDL1 = IDOT*L1
+-         IF (IP .NE. 4) GO TO 103
+-         IX2 = IW+IDOT
+-         IX3 = IX2+IDOT
+-         IF (NA .NE. 0) GO TO 101
+-         CALL DPASSB4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+-         GO TO 102
+-  101    CALL DPASSB4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+-  102    NA = 1-NA
+-         GO TO 115
+-  103    IF (IP .NE. 2) GO TO 106
+-         IF (NA .NE. 0) GO TO 104
+-         CALL DPASSB2 (IDOT,L1,C,CH,WA(IW))
+-         GO TO 105
+-  104    CALL DPASSB2 (IDOT,L1,CH,C,WA(IW))
+-  105    NA = 1-NA
+-         GO TO 115
+-  106    IF (IP .NE. 3) GO TO 109
+-         IX2 = IW+IDOT
+-         IF (NA .NE. 0) GO TO 107
+-         CALL DPASSB3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
+-         GO TO 108
+-  107    CALL DPASSB3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
+-  108    NA = 1-NA
+-         GO TO 115
+-  109    IF (IP .NE. 5) GO TO 112
+-         IX2 = IW+IDOT
+-         IX3 = IX2+IDOT
+-         IX4 = IX3+IDOT
+-         IF (NA .NE. 0) GO TO 110
+-         CALL DPASSB5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-         GO TO 111
+-  110    CALL DPASSB5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-  111    NA = 1-NA
+-         GO TO 115
+-  112    IF (NA .NE. 0) GO TO 113
+-         CALL DPASSB (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+-         GO TO 114
+-  113    CALL DPASSB (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+-  114    IF (NAC .NE. 0) NA = 1-NA
+-  115    L1 = L2
+-         IW = IW+(IP-1)*IDOT
+-  116 CONTINUE
+-      IF (NA .EQ. 0) RETURN
+-      N2 = N+N
+-      DO 117 I=1,N2
+-         C(I) = CH(I)
+-  117 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE ZFFTB (N,C,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       C(*)       ,WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      IW1 = N+N+1
+-      IW2 = IW1+N+N
+-      CALL ZFFTB1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
+-      RETURN
+-      END
+-
+-      SUBROUTINE ZFFTF1 (N,C,CH,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
+-      NF = IFAC(2)
+-      NA = 0
+-      L1 = 1
+-      IW = 1
+-      DO 116 K1=1,NF
+-         IP = IFAC(K1+2)
+-         L2 = IP*L1
+-         IDO = N/L2
+-         IDOT = IDO+IDO
+-         IDL1 = IDOT*L1
+-         IF (IP .NE. 4) GO TO 103
+-         IX2 = IW+IDOT
+-         IX3 = IX2+IDOT
+-         IF (NA .NE. 0) GO TO 101
+-         CALL DPASSF4 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+-         GO TO 102
+-  101    CALL DPASSF4 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+-  102    NA = 1-NA
+-         GO TO 115
+-  103    IF (IP .NE. 2) GO TO 106
+-         IF (NA .NE. 0) GO TO 104
+-         CALL DPASSF2 (IDOT,L1,C,CH,WA(IW))
+-         GO TO 105
+-  104    CALL DPASSF2 (IDOT,L1,CH,C,WA(IW))
+-  105    NA = 1-NA
+-         GO TO 115
+-  106    IF (IP .NE. 3) GO TO 109
+-         IX2 = IW+IDOT
+-         IF (NA .NE. 0) GO TO 107
+-         CALL DPASSF3 (IDOT,L1,C,CH,WA(IW),WA(IX2))
+-         GO TO 108
+-  107    CALL DPASSF3 (IDOT,L1,CH,C,WA(IW),WA(IX2))
+-  108    NA = 1-NA
+-         GO TO 115
+-  109    IF (IP .NE. 5) GO TO 112
+-         IX2 = IW+IDOT
+-         IX3 = IX2+IDOT
+-         IX4 = IX3+IDOT
+-         IF (NA .NE. 0) GO TO 110
+-         CALL DPASSF5 (IDOT,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-         GO TO 111
+-  110    CALL DPASSF5 (IDOT,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-  111    NA = 1-NA
+-         GO TO 115
+-  112    IF (NA .NE. 0) GO TO 113
+-         CALL DPASSF (NAC,IDOT,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+-         GO TO 114
+-  113    CALL DPASSF (NAC,IDOT,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+-  114    IF (NAC .NE. 0) NA = 1-NA
+-  115    L1 = L2
+-         IW = IW+(IP-1)*IDOT
+-  116 CONTINUE
+-      IF (NA .EQ. 0) RETURN
+-      N2 = N+N
+-      DO 117 I=1,N2
+-         C(I) = CH(I)
+-  117 CONTINUE
+-      RETURN
+-      END
+-
+-
+-      SUBROUTINE ZFFTF (N,C,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       C(*)       ,WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      IW1 = N+N+1
+-      IW2 = IW1+N+N
+-      CALL ZFFTF1 (N,C,WSAVE,WSAVE(IW1),WSAVE(IW2))
+-      RETURN
+-      END
+-
+-
+-      SUBROUTINE ZFFTI1 (N,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WA(*)      ,IFAC(*)    ,NTRYH(4)
+-      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/3,4,2,5/
+-      NL = N
+-      NF = 0
+-      J = 0
+-  101 J = J+1
+-      IF (J-4) 102,102,103
+-  102 NTRY = NTRYH(J)
+-      GO TO 104
+-  103 NTRY = NTRY+2
+-  104 NQ = NL/NTRY
+-      NR = NL-NTRY*NQ
+-      IF (NR) 101,105,101
+-  105 NF = NF+1
+-      IFAC(NF+2) = NTRY
+-      NL = NQ
+-      IF (NTRY .NE. 2) GO TO 107
+-      IF (NF .EQ. 1) GO TO 107
+-      DO 106 I=2,NF
+-         IB = NF-I+2
+-         IFAC(IB+2) = IFAC(IB+1)
+-  106 CONTINUE
+-      IFAC(3) = 2
+-  107 IF (NL .NE. 1) GO TO 104
+-      IFAC(1) = N
+-      IFAC(2) = NF
+-      TPI = 6.2831853071795864769252867665590057D0
+-      ARGH = TPI/DBLE(N)
+-      I = 2
+-      L1 = 1
+-      DO 110 K1=1,NF
+-         IP = IFAC(K1+2)
+-         LD = 0
+-         L2 = L1*IP
+-         IDO = N/L2
+-         IDOT = IDO+IDO+2
+-         IPM = IP-1
+-         DO 109 J=1,IPM
+-            I1 = I
+-            WA(I-1) = 1.0D0
+-            WA(I) = 0.0D0
+-            LD = LD+L1
+-            FI = 0.0D0
+-            ARGLD = DBLE(LD)*ARGH
+-            DO 108 II=4,IDOT,2
+-               I = I+2
+-               FI = FI+1.0D0
+-               ARG = FI*ARGLD
+-               WA(I-1) = DCOS(ARG)
+-               WA(I) = DSIN(ARG)
+-  108       CONTINUE
+-            IF (IP .LE. 5) GO TO 109
+-            WA(I1-1) = WA(I-1)
+-            WA(I1) = WA(I)
+-  109    CONTINUE
+-         L1 = L2
+-  110 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE ZFFTI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      IW1 = N+N+1
+-      IW2 = IW1+N+N
+-      CALL ZFFTI1 (N,WSAVE(IW1),WSAVE(IW2))
+-      RETURN
+-      END
+-
+-      SUBROUTINE DCOSQB1 (N,X,W,XH)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,W(*)       ,XH(*)
+-      NS2 = (N+1)/2
+-      NP2 = N+2
+-      DO 101 I=3,N,2
+-         XIM1 = X(I-1)+X(I)
+-         X(I) = X(I)-X(I-1)
+-         X(I-1) = XIM1
+-  101 CONTINUE
+-      X(1) = X(1)+X(1)
+-      MODN = MOD(N,2)
+-      IF (MODN .EQ. 0) X(N) = X(N)+X(N)
+-      CALL DFFTB (N,X,XH)
+-      DO 102 K=2,NS2
+-         KC = NP2-K
+-         XH(K) = W(K-1)*X(KC)+W(KC-1)*X(K)
+-         XH(KC) = W(K-1)*X(K)-W(KC-1)*X(KC)
+-  102 CONTINUE
+-      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*(X(NS2+1)+X(NS2+1))
+-      DO 103 K=2,NS2
+-         KC = NP2-K
+-         X(K) = XH(K)+XH(KC)
+-         X(KC) = XH(K)-XH(KC)
+-  103 CONTINUE
+-      X(1) = X(1)+X(1)
+-      RETURN
+-      END
+-
+-      SUBROUTINE DCOSQF1 (N,X,W,XH)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,W(*)       ,XH(*)
+-      NS2 = (N+1)/2
+-      NP2 = N+2
+-      DO 101 K=2,NS2
+-         KC = NP2-K
+-         XH(K) = X(K)+X(KC)
+-         XH(KC) = X(K)-X(KC)
+-  101 CONTINUE
+-      MODN = MOD(N,2)
+-      IF (MODN .EQ. 0) XH(NS2+1) = X(NS2+1)+X(NS2+1)
+-      DO 102 K=2,NS2
+-         KC = NP2-K
+-         X(K) = W(K-1)*XH(KC)+W(KC-1)*XH(K)
+-         X(KC) = W(K-1)*XH(K)-W(KC-1)*XH(KC)
+-  102 CONTINUE
+-      IF (MODN .EQ. 0) X(NS2+1) = W(NS2)*XH(NS2+1)
+-      CALL DFFTF (N,X,XH)
+-      DO 103 I=3,N,2
+-         XIM1 = X(I-1)-X(I)
+-         X(I) = X(I-1)+X(I)
+-         X(I-1) = XIM1
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DCOSQI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      DATA PIH /1.5707963267948966192313216916397514D0/
+-      DT = PIH/DBLE(N)
+-      FK = 0.0D0
+-      DO 101 K=1,N
+-         FK = FK+1.0D0
+-         WSAVE(K) = DCOS(FK*DT)
+-  101 CONTINUE
+-      CALL DFFTI (N,WSAVE(N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DCOST (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      NM1 = N-1
+-      NP1 = N+1
+-      NS2 = N/2
+-      IF (N-2) 106,101,102
+-  101 X1H = X(1)+X(2)
+-      X(2) = X(1)-X(2)
+-      X(1) = X1H
+-      RETURN
+-  102 IF (N .GT. 3) GO TO 103
+-      X1P3 = X(1)+X(3)
+-      TX2 = X(2)+X(2)
+-      X(2) = X(1)-X(3)
+-      X(1) = X1P3+TX2
+-      X(3) = X1P3-TX2
+-      RETURN
+-  103 C1 = X(1)-X(N)
+-      X(1) = X(1)+X(N)
+-      DO 104 K=2,NS2
+-         KC = NP1-K
+-         T1 = X(K)+X(KC)
+-         T2 = X(K)-X(KC)
+-         C1 = C1+WSAVE(KC)*T2
+-         T2 = WSAVE(K)*T2
+-         X(K) = T1-T2
+-         X(KC) = T1+T2
+-  104 CONTINUE
+-      MODN = MOD(N,2)
+-      IF (MODN .NE. 0) X(NS2+1) = X(NS2+1)+X(NS2+1)
+-      CALL DFFTF (NM1,X,WSAVE(N+1))
+-      XIM2 = X(2)
+-      X(2) = C1
+-      DO 105 I=4,N,2
+-         XI = X(I)
+-         X(I) = X(I-2)-X(I-1)
+-         X(I-1) = XIM2
+-         XIM2 = XI
+-  105 CONTINUE
+-      IF (MODN .NE. 0) X(N) = XIM2
+-  106 RETURN
+-      END
+-
+-      SUBROUTINE DZFFT1 (N,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WA(*)      ,IFAC(*)    ,NTRYH(4)
+-      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
+-     1    ,TPI/6.2831853071795864769252867665590057D0/
+-      NL = N
+-      NF = 0
+-      J = 0
+-  101 J = J+1
+-      IF (J-4) 102,102,103
+-  102 NTRY = NTRYH(J)
+-      GO TO 104
+-  103 NTRY = NTRY+2
+-  104 NQ = NL/NTRY
+-      NR = NL-NTRY*NQ
+-      IF (NR) 101,105,101
+-  105 NF = NF+1
+-      IFAC(NF+2) = NTRY
+-      NL = NQ
+-      IF (NTRY .NE. 2) GO TO 107
+-      IF (NF .EQ. 1) GO TO 107
+-      DO 106 I=2,NF
+-         IB = NF-I+2
+-         IFAC(IB+2) = IFAC(IB+1)
+-  106 CONTINUE
+-      IFAC(3) = 2
+-  107 IF (NL .NE. 1) GO TO 104
+-      IFAC(1) = N
+-      IFAC(2) = NF
+-      ARGH = TPI/DBLE(N)
+-      IS = 0
+-      NFM1 = NF-1
+-      L1 = 1
+-      IF (NFM1 .EQ. 0) RETURN
+-      DO 111 K1=1,NFM1
+-         IP = IFAC(K1+2)
+-         L2 = L1*IP
+-         IDO = N/L2
+-         IPM = IP-1
+-         ARG1 = DBLE(L1)*ARGH
+-         CH1 = 1.0D0
+-         SH1 = 0.0D0
+-         DCH1 = DCOS(ARG1)
+-         DSH1 = DSIN(ARG1)
+-         DO 110 J=1,IPM
+-            CH1H = DCH1*CH1-DSH1*SH1
+-            SH1 = DCH1*SH1+DSH1*CH1
+-            CH1 = CH1H
+-            I = IS+2
+-            WA(I-1) = CH1
+-            WA(I) = SH1
+-            IF (IDO .LT. 5) GO TO 109
+-            DO 108 II=5,IDO,2
+-               I = I+2
+-               WA(I-1) = CH1*WA(I-3)-SH1*WA(I-2)
+-               WA(I) = CH1*WA(I-2)+SH1*WA(I-3)
+-  108       CONTINUE
+-  109       IS = IS+IDO
+-  110    CONTINUE
+-         L1 = L2
+-  111 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE DCOSQB (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      DATA TSQRT2 /2.8284271247461900976033774484193961D0/
+-      IF (N-2) 101,102,103
+-  101 X(1) = 4.0D0*X(1)
+-      RETURN
+-  102 X1 = 4.0D0*(X(1)+X(2))
+-      X(2) = TSQRT2*(X(1)-X(2))
+-      X(1) = X1
+-      RETURN
+-  103 CALL DCOSQB1 (N,X,WSAVE,WSAVE(N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DCOSQF (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      DATA SQRT2 /1.4142135623730950488016887242096980D0/
+-      IF (N-2) 102,101,103
+-  101 TSQX = SQRT2*X(2)
+-      X(2) = X(1)-TSQX
+-      X(1) = X(1)+TSQX
+-  102 RETURN
+-  103 CALL DCOSQF1 (N,X,WSAVE,WSAVE(N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DCOSTI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      DATA PI /3.1415926535897932384626433832795028D0/
+-      IF (N .LE. 3) RETURN
+-      NM1 = N-1
+-      NP1 = N+1
+-      NS2 = N/2
+-      DT = PI/DBLE(NM1)
+-      FK = 0.0D0
+-      DO 101 K=2,NS2
+-         KC = NP1-K
+-         FK = FK+1.0D0
+-         WSAVE(K) = 2.0D0*DSIN(FK*DT)
+-         WSAVE(KC) = 2.0D0*DCOS(FK*DT)
+-  101 CONTINUE
+-      CALL DFFTI (NM1,WSAVE(N+1))
+-      RETURN
+-      END
+-
+-      SUBROUTINE DZFFTB (N,R,AZERO,A,B,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       R(*)       ,A(*)       ,B(*)       ,WSAVE(*)
+-      IF (N-2) 101,102,103
+-  101 R(1) = AZERO
+-      RETURN
+-  102 R(1) = AZERO+A(1)
+-      R(2) = AZERO-A(1)
+-      RETURN
+-  103 NS2 = (N-1)/2
+-      DO 104 I=1,NS2
+-         R(2*I) = .5D0*A(I)
+-         R(2*I+1) = -.5D0*B(I)
+-  104 CONTINUE
+-      R(1) = AZERO
+-      IF (MOD(N,2) .EQ. 0) R(N) = A(NS2+1)
+-      CALL DFFTB (N,R,WSAVE(N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DZFFTF (N,R,AZERO,A,B,WSAVE)
+-C
+-C                       VERSION 3  JUNE 1979
+-C
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       R(*)       ,A(*)       ,B(*)       ,WSAVE(*)
+-      IF (N-2) 101,102,103
+-  101 AZERO = R(1)
+-      RETURN
+-  102 AZERO = .5D0*(R(1)+R(2))
+-      A(1) = .5D0*(R(1)-R(2))
+-      RETURN
+-  103 DO 104 I=1,N
+-         WSAVE(I) = R(I)
+-  104 CONTINUE
+-      CALL DFFTF (N,WSAVE,WSAVE(N+1))
+-      CF = 2.0D0/DBLE(N)
+-      CFM = -CF
+-      AZERO = .5D0*CF*WSAVE(1)
+-      NS2 = (N+1)/2
+-      NS2M = NS2-1
+-      DO 105 I=1,NS2M
+-         A(I) = CF*WSAVE(2*I)
+-         B(I) = CFM*WSAVE(2*I+1)
+-  105 CONTINUE
+-      IF (MOD(N,2) .EQ. 1) RETURN
+-      A(NS2) = .5D0*CF*WSAVE(N)
+-      B(NS2) = 0.0D0
+-      RETURN
+-      END
+-      SUBROUTINE DZFFTI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      CALL DZFFT1 (N,WSAVE(2*N+1),WSAVE(3*N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DPASSB (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
+-     1                C1(IDO,L1,IP)          ,WA(*)      ,C2(IDL1,IP),
+-     2                CH2(IDL1,IP)
+-      IDOT = IDO/2
+-      NT = IP*IDL1
+-      IPP2 = IP+2
+-      IPPH = (IP+1)/2
+-      IDP = IP*IDO
+-C
+-      IF (IDO .LT. L1) GO TO 106
+-      DO 103 J=2,IPPH
+-         JC = IPP2-J
+-         DO 102 K=1,L1
+-            DO 101 I=1,IDO
+-               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
+-               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
+-  101       CONTINUE
+-  102    CONTINUE
+-  103 CONTINUE
+-      DO 105 K=1,L1
+-         DO 104 I=1,IDO
+-            CH(I,K,1) = CC(I,1,K)
+-  104    CONTINUE
+-  105 CONTINUE
+-      GO TO 112
+-  106 DO 109 J=2,IPPH
+-         JC = IPP2-J
+-         DO 108 I=1,IDO
+-            DO 107 K=1,L1
+-               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
+-               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
+-  107       CONTINUE
+-  108    CONTINUE
+-  109 CONTINUE
+-      DO 111 I=1,IDO
+-         DO 110 K=1,L1
+-            CH(I,K,1) = CC(I,1,K)
+-  110    CONTINUE
+-  111 CONTINUE
+-  112 IDL = 2-IDO
+-      INC = 0
+-      DO 116 L=2,IPPH
+-         LC = IPP2-L
+-         IDL = IDL+IDO
+-         DO 113 IK=1,IDL1
+-            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)
+-            C2(IK,LC) = WA(IDL)*CH2(IK,IP)
+-  113    CONTINUE
+-         IDLJ = IDL
+-         INC = INC+IDO
+-         DO 115 J=3,IPPH
+-            JC = IPP2-J
+-            IDLJ = IDLJ+INC
+-            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP
+-            WAR = WA(IDLJ-1)
+-            WAI = WA(IDLJ)
+-            DO 114 IK=1,IDL1
+-               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)
+-               C2(IK,LC) = C2(IK,LC)+WAI*CH2(IK,JC)
+-  114       CONTINUE
+-  115    CONTINUE
+-  116 CONTINUE
+-      DO 118 J=2,IPPH
+-         DO 117 IK=1,IDL1
+-            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
+-  117    CONTINUE
+-  118 CONTINUE
+-      DO 120 J=2,IPPH
+-         JC = IPP2-J
+-         DO 119 IK=2,IDL1,2
+-            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)
+-            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)
+-            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC)
+-            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
+-  119    CONTINUE
+-  120 CONTINUE
+-      NAC = 1
+-      IF (IDO .EQ. 2) RETURN
+-      NAC = 0
+-      DO 121 IK=1,IDL1
+-         C2(IK,1) = CH2(IK,1)
+-  121 CONTINUE
+-      DO 123 J=2,IP
+-         DO 122 K=1,L1
+-            C1(1,K,J) = CH(1,K,J)
+-            C1(2,K,J) = CH(2,K,J)
+-  122    CONTINUE
+-  123 CONTINUE
+-      IF (IDOT .GT. L1) GO TO 127
+-      IDIJ = 0
+-      DO 126 J=2,IP
+-         IDIJ = IDIJ+2
+-         DO 125 I=4,IDO,2
+-            IDIJ = IDIJ+2
+-            DO 124 K=1,L1
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+-  124       CONTINUE
+-  125    CONTINUE
+-  126 CONTINUE
+-      RETURN
+-  127 IDJ = 2-IDO
+-      DO 130 J=2,IP
+-         IDJ = IDJ+IDO
+-         DO 129 K=1,L1
+-            IDIJ = IDJ
+-            DO 128 I=4,IDO,2
+-               IDIJ = IDIJ+2
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+-  128       CONTINUE
+-  129    CONTINUE
+-  130 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSB2 (IDO,L1,CC,CH,WA1)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
+-     1                WA1(*)
+-      IF (IDO .GT. 2) GO TO 102
+-      DO 101 K=1,L1
+-         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
+-         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
+-         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
+-         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K)
+-            TR2 = CC(I-1,1,K)-CC(I-1,2,K)
+-            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)
+-            TI2 = CC(I,1,K)-CC(I,2,K)
+-            CH(I,K,2) = WA1(I-1)*TI2+WA1(I)*TR2
+-            CH(I-1,K,2) = WA1(I-1)*TR2-WA1(I)*TI2
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSB3 (IDO,L1,CC,CH,WA1,WA2)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
+-     1                WA1(*)     ,WA2(*)
+-      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TR2 = CC(1,2,K)+CC(1,3,K)
+-         CR2 = CC(1,1,K)+TAUR*TR2
+-         CH(1,K,1) = CC(1,1,K)+TR2
+-         TI2 = CC(2,2,K)+CC(2,3,K)
+-         CI2 = CC(2,1,K)+TAUR*TI2
+-         CH(2,K,1) = CC(2,1,K)+TI2
+-         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))
+-         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))
+-         CH(1,K,2) = CR2-CI3
+-         CH(1,K,3) = CR2+CI3
+-         CH(2,K,2) = CI2+CR3
+-         CH(2,K,3) = CI2-CR3
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TR2 = CC(I-1,2,K)+CC(I-1,3,K)
+-            CR2 = CC(I-1,1,K)+TAUR*TR2
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2
+-            TI2 = CC(I,2,K)+CC(I,3,K)
+-            CI2 = CC(I,1,K)+TAUR*TI2
+-            CH(I,K,1) = CC(I,1,K)+TI2
+-            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))
+-            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K))
+-            DR2 = CR2-CI3
+-            DR3 = CR2+CI3
+-            DI2 = CI2+CR3
+-            DI3 = CI2-CR3
+-            CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
+-            CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
+-            CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
+-            CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TI1 = CC(2,1,K)-CC(2,3,K)
+-         TI2 = CC(2,1,K)+CC(2,3,K)
+-         TR4 = CC(2,4,K)-CC(2,2,K)
+-         TI3 = CC(2,2,K)+CC(2,4,K)
+-         TR1 = CC(1,1,K)-CC(1,3,K)
+-         TR2 = CC(1,1,K)+CC(1,3,K)
+-         TI4 = CC(1,2,K)-CC(1,4,K)
+-         TR3 = CC(1,2,K)+CC(1,4,K)
+-         CH(1,K,1) = TR2+TR3
+-         CH(1,K,3) = TR2-TR3
+-         CH(2,K,1) = TI2+TI3
+-         CH(2,K,3) = TI2-TI3
+-         CH(1,K,2) = TR1+TR4
+-         CH(1,K,4) = TR1-TR4
+-         CH(2,K,2) = TI1+TI4
+-         CH(2,K,4) = TI1-TI4
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TI1 = CC(I,1,K)-CC(I,3,K)
+-            TI2 = CC(I,1,K)+CC(I,3,K)
+-            TI3 = CC(I,2,K)+CC(I,4,K)
+-            TR4 = CC(I,4,K)-CC(I,2,K)
+-            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
+-            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
+-            TI4 = CC(I-1,2,K)-CC(I-1,4,K)
+-            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
+-            CH(I-1,K,1) = TR2+TR3
+-            CR3 = TR2-TR3
+-            CH(I,K,1) = TI2+TI3
+-            CI3 = TI2-TI3
+-            CR2 = TR1+TR4
+-            CR4 = TR1-TR4
+-            CI2 = TI1+TI4
+-            CI4 = TI1-TI4
+-            CH(I-1,K,2) = WA1(I-1)*CR2-WA1(I)*CI2
+-            CH(I,K,2) = WA1(I-1)*CI2+WA1(I)*CR2
+-            CH(I-1,K,3) = WA2(I-1)*CR3-WA2(I)*CI3
+-            CH(I,K,3) = WA2(I-1)*CI3+WA2(I)*CR3
+-            CH(I-1,K,4) = WA3(I-1)*CR4-WA3(I)*CI4
+-            CH(I,K,4) = WA3(I-1)*CI4+WA3(I)*CR4
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
+-      DATA TR11,TI11,TR12,TI12 /
+-     1   .30901699437494742410229341718281905D0,
+-     2   .95105651629515357211643933337938214D0,
+-     3  -.80901699437494742410229341718281906D0,
+-     4   .58778525229247312916870595463907276D0/
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TI5 = CC(2,2,K)-CC(2,5,K)
+-         TI2 = CC(2,2,K)+CC(2,5,K)
+-         TI4 = CC(2,3,K)-CC(2,4,K)
+-         TI3 = CC(2,3,K)+CC(2,4,K)
+-         TR5 = CC(1,2,K)-CC(1,5,K)
+-         TR2 = CC(1,2,K)+CC(1,5,K)
+-         TR4 = CC(1,3,K)-CC(1,4,K)
+-         TR3 = CC(1,3,K)+CC(1,4,K)
+-         CH(1,K,1) = CC(1,1,K)+TR2+TR3
+-         CH(2,K,1) = CC(2,1,K)+TI2+TI3
+-         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
+-         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
+-         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
+-         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
+-         CR5 = TI11*TR5+TI12*TR4
+-         CI5 = TI11*TI5+TI12*TI4
+-         CR4 = TI12*TR5-TI11*TR4
+-         CI4 = TI12*TI5-TI11*TI4
+-         CH(1,K,2) = CR2-CI5
+-         CH(1,K,5) = CR2+CI5
+-         CH(2,K,2) = CI2+CR5
+-         CH(2,K,3) = CI3+CR4
+-         CH(1,K,3) = CR3-CI4
+-         CH(1,K,4) = CR3+CI4
+-         CH(2,K,4) = CI3-CR4
+-         CH(2,K,5) = CI2-CR5
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TI5 = CC(I,2,K)-CC(I,5,K)
+-            TI2 = CC(I,2,K)+CC(I,5,K)
+-            TI4 = CC(I,3,K)-CC(I,4,K)
+-            TI3 = CC(I,3,K)+CC(I,4,K)
+-            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
+-            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
+-            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
+-            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+-            CH(I,K,1) = CC(I,1,K)+TI2+TI3
+-            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+-            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+-            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+-            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+-            CR5 = TI11*TR5+TI12*TR4
+-            CI5 = TI11*TI5+TI12*TI4
+-            CR4 = TI12*TR5-TI11*TR4
+-            CI4 = TI12*TI5-TI11*TI4
+-            DR3 = CR3-CI4
+-            DR4 = CR3+CI4
+-            DI3 = CI3+CR4
+-            DI4 = CI3-CR4
+-            DR5 = CR2+CI5
+-            DR2 = CR2-CI5
+-            DI5 = CI2-CR5
+-            DI2 = CI2+CR5
+-            CH(I-1,K,2) = WA1(I-1)*DR2-WA1(I)*DI2
+-            CH(I,K,2) = WA1(I-1)*DI2+WA1(I)*DR2
+-            CH(I-1,K,3) = WA2(I-1)*DR3-WA2(I)*DI3
+-            CH(I,K,3) = WA2(I-1)*DI3+WA2(I)*DR3
+-            CH(I-1,K,4) = WA3(I-1)*DR4-WA3(I)*DI4
+-            CH(I,K,4) = WA3(I-1)*DI4+WA3(I)*DR4
+-            CH(I-1,K,5) = WA4(I-1)*DR5-WA4(I)*DI5
+-            CH(I,K,5) = WA4(I-1)*DI5+WA4(I)*DR5
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSF (NAC,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
+-     1                C1(IDO,L1,IP)          ,WA(*)      ,C2(IDL1,IP),
+-     2                CH2(IDL1,IP)
+-      IDOT = IDO/2
+-      NT = IP*IDL1
+-      IPP2 = IP+2
+-      IPPH = (IP+1)/2
+-      IDP = IP*IDO
+-C
+-      IF (IDO .LT. L1) GO TO 106
+-      DO 103 J=2,IPPH
+-         JC = IPP2-J
+-         DO 102 K=1,L1
+-            DO 101 I=1,IDO
+-               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
+-               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
+-  101       CONTINUE
+-  102    CONTINUE
+-  103 CONTINUE
+-      DO 105 K=1,L1
+-         DO 104 I=1,IDO
+-            CH(I,K,1) = CC(I,1,K)
+-  104    CONTINUE
+-  105 CONTINUE
+-      GO TO 112
+-  106 DO 109 J=2,IPPH
+-         JC = IPP2-J
+-         DO 108 I=1,IDO
+-            DO 107 K=1,L1
+-               CH(I,K,J) = CC(I,J,K)+CC(I,JC,K)
+-               CH(I,K,JC) = CC(I,J,K)-CC(I,JC,K)
+-  107       CONTINUE
+-  108    CONTINUE
+-  109 CONTINUE
+-      DO 111 I=1,IDO
+-         DO 110 K=1,L1
+-            CH(I,K,1) = CC(I,1,K)
+-  110    CONTINUE
+-  111 CONTINUE
+-  112 IDL = 2-IDO
+-      INC = 0
+-      DO 116 L=2,IPPH
+-         LC = IPP2-L
+-         IDL = IDL+IDO
+-         DO 113 IK=1,IDL1
+-            C2(IK,L) = CH2(IK,1)+WA(IDL-1)*CH2(IK,2)
+-            C2(IK,LC) = -WA(IDL)*CH2(IK,IP)
+-  113    CONTINUE
+-         IDLJ = IDL
+-         INC = INC+IDO
+-         DO 115 J=3,IPPH
+-            JC = IPP2-J
+-            IDLJ = IDLJ+INC
+-            IF (IDLJ .GT. IDP) IDLJ = IDLJ-IDP
+-            WAR = WA(IDLJ-1)
+-            WAI = WA(IDLJ)
+-            DO 114 IK=1,IDL1
+-               C2(IK,L) = C2(IK,L)+WAR*CH2(IK,J)
+-               C2(IK,LC) = C2(IK,LC)-WAI*CH2(IK,JC)
+-  114       CONTINUE
+-  115    CONTINUE
+-  116 CONTINUE
+-      DO 118 J=2,IPPH
+-         DO 117 IK=1,IDL1
+-            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
+-  117    CONTINUE
+-  118 CONTINUE
+-      DO 120 J=2,IPPH
+-         JC = IPP2-J
+-         DO 119 IK=2,IDL1,2
+-            CH2(IK-1,J) = C2(IK-1,J)-C2(IK,JC)
+-            CH2(IK-1,JC) = C2(IK-1,J)+C2(IK,JC)
+-            CH2(IK,J) = C2(IK,J)+C2(IK-1,JC)
+-            CH2(IK,JC) = C2(IK,J)-C2(IK-1,JC)
+-  119    CONTINUE
+-  120 CONTINUE
+-      NAC = 1
+-      IF (IDO .EQ. 2) RETURN
+-      NAC = 0
+-      DO 121 IK=1,IDL1
+-         C2(IK,1) = CH2(IK,1)
+-  121 CONTINUE
+-      DO 123 J=2,IP
+-         DO 122 K=1,L1
+-            C1(1,K,J) = CH(1,K,J)
+-            C1(2,K,J) = CH(2,K,J)
+-  122    CONTINUE
+-  123 CONTINUE
+-      IF (IDOT .GT. L1) GO TO 127
+-      IDIJ = 0
+-      DO 126 J=2,IP
+-         IDIJ = IDIJ+2
+-         DO 125 I=4,IDO,2
+-            IDIJ = IDIJ+2
+-            DO 124 K=1,L1
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
+-  124       CONTINUE
+-  125    CONTINUE
+-  126 CONTINUE
+-      RETURN
+-  127 IDJ = 2-IDO
+-      DO 130 J=2,IP
+-         IDJ = IDJ+IDO
+-         DO 129 K=1,L1
+-            IDIJ = IDJ
+-            DO 128 I=4,IDO,2
+-               IDIJ = IDIJ+2
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)+WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)-WA(IDIJ)*CH(I-1,K,J)
+-  128       CONTINUE
+-  129    CONTINUE
+-  130 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSF2 (IDO,L1,CC,CH,WA1)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
+-     1                WA1(*)
+-      IF (IDO .GT. 2) GO TO 102
+-      DO 101 K=1,L1
+-         CH(1,K,1) = CC(1,1,K)+CC(1,2,K)
+-         CH(1,K,2) = CC(1,1,K)-CC(1,2,K)
+-         CH(2,K,1) = CC(2,1,K)+CC(2,2,K)
+-         CH(2,K,2) = CC(2,1,K)-CC(2,2,K)
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            CH(I-1,K,1) = CC(I-1,1,K)+CC(I-1,2,K)
+-            TR2 = CC(I-1,1,K)-CC(I-1,2,K)
+-            CH(I,K,1) = CC(I,1,K)+CC(I,2,K)
+-            TI2 = CC(I,1,K)-CC(I,2,K)
+-            CH(I,K,2) = WA1(I-1)*TI2-WA1(I)*TR2
+-            CH(I-1,K,2) = WA1(I-1)*TR2+WA1(I)*TI2
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSF3 (IDO,L1,CC,CH,WA1,WA2)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
+-     1                WA1(*)     ,WA2(*)
+-      DATA TAUR,TAUI /-.5D0,-.86602540378443864676372317075293618D0/
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TR2 = CC(1,2,K)+CC(1,3,K)
+-         CR2 = CC(1,1,K)+TAUR*TR2
+-         CH(1,K,1) = CC(1,1,K)+TR2
+-         TI2 = CC(2,2,K)+CC(2,3,K)
+-         CI2 = CC(2,1,K)+TAUR*TI2
+-         CH(2,K,1) = CC(2,1,K)+TI2
+-         CR3 = TAUI*(CC(1,2,K)-CC(1,3,K))
+-         CI3 = TAUI*(CC(2,2,K)-CC(2,3,K))
+-         CH(1,K,2) = CR2-CI3
+-         CH(1,K,3) = CR2+CI3
+-         CH(2,K,2) = CI2+CR3
+-         CH(2,K,3) = CI2-CR3
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TR2 = CC(I-1,2,K)+CC(I-1,3,K)
+-            CR2 = CC(I-1,1,K)+TAUR*TR2
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2
+-            TI2 = CC(I,2,K)+CC(I,3,K)
+-            CI2 = CC(I,1,K)+TAUR*TI2
+-            CH(I,K,1) = CC(I,1,K)+TI2
+-            CR3 = TAUI*(CC(I-1,2,K)-CC(I-1,3,K))
+-            CI3 = TAUI*(CC(I,2,K)-CC(I,3,K))
+-            DR2 = CR2-CI3
+-            DR3 = CR2+CI3
+-            DI2 = CI2+CR3
+-            DI3 = CI2-CR3
+-            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
+-            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
+-            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
+-            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TI1 = CC(2,1,K)-CC(2,3,K)
+-         TI2 = CC(2,1,K)+CC(2,3,K)
+-         TR4 = CC(2,2,K)-CC(2,4,K)
+-         TI3 = CC(2,2,K)+CC(2,4,K)
+-         TR1 = CC(1,1,K)-CC(1,3,K)
+-         TR2 = CC(1,1,K)+CC(1,3,K)
+-         TI4 = CC(1,4,K)-CC(1,2,K)
+-         TR3 = CC(1,2,K)+CC(1,4,K)
+-         CH(1,K,1) = TR2+TR3
+-         CH(1,K,3) = TR2-TR3
+-         CH(2,K,1) = TI2+TI3
+-         CH(2,K,3) = TI2-TI3
+-         CH(1,K,2) = TR1+TR4
+-         CH(1,K,4) = TR1-TR4
+-         CH(2,K,2) = TI1+TI4
+-         CH(2,K,4) = TI1-TI4
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TI1 = CC(I,1,K)-CC(I,3,K)
+-            TI2 = CC(I,1,K)+CC(I,3,K)
+-            TI3 = CC(I,2,K)+CC(I,4,K)
+-            TR4 = CC(I,2,K)-CC(I,4,K)
+-            TR1 = CC(I-1,1,K)-CC(I-1,3,K)
+-            TR2 = CC(I-1,1,K)+CC(I-1,3,K)
+-            TI4 = CC(I-1,4,K)-CC(I-1,2,K)
+-            TR3 = CC(I-1,2,K)+CC(I-1,4,K)
+-            CH(I-1,K,1) = TR2+TR3
+-            CR3 = TR2-TR3
+-            CH(I,K,1) = TI2+TI3
+-            CI3 = TI2-TI3
+-            CR2 = TR1+TR4
+-            CR4 = TR1-TR4
+-            CI2 = TI1+TI4
+-            CI4 = TI1-TI4
+-            CH(I-1,K,2) = WA1(I-1)*CR2+WA1(I)*CI2
+-            CH(I,K,2) = WA1(I-1)*CI2-WA1(I)*CR2
+-            CH(I-1,K,3) = WA2(I-1)*CR3+WA2(I)*CI3
+-            CH(I,K,3) = WA2(I-1)*CI3-WA2(I)*CR3
+-            CH(I-1,K,4) = WA3(I-1)*CR4+WA3(I)*CI4
+-            CH(I,K,4) = WA3(I-1)*CI4-WA3(I)*CR4
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DPASSF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
+-      DATA TR11,TI11,TR12,TI12 /
+-     1   .30901699437494742410229341718281905D0,
+-     2  -.95105651629515357211643933337938214D0,
+-     3  -.80901699437494742410229341718281906D0,
+-     4  -.58778525229247312916870595463907276D0/
+-      IF (IDO .NE. 2) GO TO 102
+-      DO 101 K=1,L1
+-         TI5 = CC(2,2,K)-CC(2,5,K)
+-         TI2 = CC(2,2,K)+CC(2,5,K)
+-         TI4 = CC(2,3,K)-CC(2,4,K)
+-         TI3 = CC(2,3,K)+CC(2,4,K)
+-         TR5 = CC(1,2,K)-CC(1,5,K)
+-         TR2 = CC(1,2,K)+CC(1,5,K)
+-         TR4 = CC(1,3,K)-CC(1,4,K)
+-         TR3 = CC(1,3,K)+CC(1,4,K)
+-         CH(1,K,1) = CC(1,1,K)+TR2+TR3
+-         CH(2,K,1) = CC(2,1,K)+TI2+TI3
+-         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
+-         CI2 = CC(2,1,K)+TR11*TI2+TR12*TI3
+-         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
+-         CI3 = CC(2,1,K)+TR12*TI2+TR11*TI3
+-         CR5 = TI11*TR5+TI12*TR4
+-         CI5 = TI11*TI5+TI12*TI4
+-         CR4 = TI12*TR5-TI11*TR4
+-         CI4 = TI12*TI5-TI11*TI4
+-         CH(1,K,2) = CR2-CI5
+-         CH(1,K,5) = CR2+CI5
+-         CH(2,K,2) = CI2+CR5
+-         CH(2,K,3) = CI3+CR4
+-         CH(1,K,3) = CR3-CI4
+-         CH(1,K,4) = CR3+CI4
+-         CH(2,K,4) = CI3-CR4
+-         CH(2,K,5) = CI2-CR5
+-  101 CONTINUE
+-      RETURN
+-  102 DO 104 K=1,L1
+-         DO 103 I=2,IDO,2
+-            TI5 = CC(I,2,K)-CC(I,5,K)
+-            TI2 = CC(I,2,K)+CC(I,5,K)
+-            TI4 = CC(I,3,K)-CC(I,4,K)
+-            TI3 = CC(I,3,K)+CC(I,4,K)
+-            TR5 = CC(I-1,2,K)-CC(I-1,5,K)
+-            TR2 = CC(I-1,2,K)+CC(I-1,5,K)
+-            TR4 = CC(I-1,3,K)-CC(I-1,4,K)
+-            TR3 = CC(I-1,3,K)+CC(I-1,4,K)
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+-            CH(I,K,1) = CC(I,1,K)+TI2+TI3
+-            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+-            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+-            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+-            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+-            CR5 = TI11*TR5+TI12*TR4
+-            CI5 = TI11*TI5+TI12*TI4
+-            CR4 = TI12*TR5-TI11*TR4
+-            CI4 = TI12*TI5-TI11*TI4
+-            DR3 = CR3-CI4
+-            DR4 = CR3+CI4
+-            DI3 = CI3+CR4
+-            DI4 = CI3-CR4
+-            DR5 = CR2+CI5
+-            DR2 = CR2-CI5
+-            DI5 = CI2-CR5
+-            DI2 = CI2+CR5
+-            CH(I-1,K,2) = WA1(I-1)*DR2+WA1(I)*DI2
+-            CH(I,K,2) = WA1(I-1)*DI2-WA1(I)*DR2
+-            CH(I-1,K,3) = WA2(I-1)*DR3+WA2(I)*DI3
+-            CH(I,K,3) = WA2(I-1)*DI3-WA2(I)*DR3
+-            CH(I-1,K,4) = WA3(I-1)*DR4+WA3(I)*DI4
+-            CH(I,K,4) = WA3(I-1)*DI4-WA3(I)*DR4
+-            CH(I-1,K,5) = WA4(I-1)*DR5+WA4(I)*DI5
+-            CH(I,K,5) = WA4(I-1)*DI5-WA4(I)*DR5
+-  103    CONTINUE
+-  104 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DRADB2 (IDO,L1,CC,CH,WA1)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,2,L1)           ,CH(IDO,L1,2)           ,
+-     1                WA1(*)
+-      DO 101 K=1,L1
+-         CH(1,K,1) = CC(1,1,K)+CC(IDO,2,K)
+-         CH(1,K,2) = CC(1,1,K)-CC(IDO,2,K)
+-  101 CONTINUE
+-      IF (IDO-2) 107,105,102
+-  102 IDP2 = IDO+2
+-      DO 104 K=1,L1
+-         DO 103 I=3,IDO,2
+-            IC = IDP2-I
+-            CH(I-1,K,1) = CC(I-1,1,K)+CC(IC-1,2,K)
+-            TR2 = CC(I-1,1,K)-CC(IC-1,2,K)
+-            CH(I,K,1) = CC(I,1,K)-CC(IC,2,K)
+-            TI2 = CC(I,1,K)+CC(IC,2,K)
+-            CH(I-1,K,2) = WA1(I-2)*TR2-WA1(I-1)*TI2
+-            CH(I,K,2) = WA1(I-2)*TI2+WA1(I-1)*TR2
+-  103    CONTINUE
+-  104 CONTINUE
+-      IF (MOD(IDO,2) .EQ. 1) RETURN
+-  105 DO 106 K=1,L1
+-         CH(IDO,K,1) = CC(IDO,1,K)+CC(IDO,1,K)
+-         CH(IDO,K,2) = -(CC(1,2,K)+CC(1,2,K))
+-  106 CONTINUE
+-  107 RETURN
+-      END
+-      SUBROUTINE DRADB3 (IDO,L1,CC,CH,WA1,WA2)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,3,L1)           ,CH(IDO,L1,3)           ,
+-     1                WA1(*)     ,WA2(*)
+-      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
+-      DO 101 K=1,L1
+-         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+-         CR2 = CC(1,1,K)+TAUR*TR2
+-         CH(1,K,1) = CC(1,1,K)+TR2
+-         CI3 = TAUI*(CC(1,3,K)+CC(1,3,K))
+-         CH(1,K,2) = CR2-CI3
+-         CH(1,K,3) = CR2+CI3
+-  101 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      IDP2 = IDO+2
+-      DO 103 K=1,L1
+-         DO 102 I=3,IDO,2
+-            IC = IDP2-I
+-            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+-            CR2 = CC(I-1,1,K)+TAUR*TR2
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2
+-            TI2 = CC(I,3,K)-CC(IC,2,K)
+-            CI2 = CC(I,1,K)+TAUR*TI2
+-            CH(I,K,1) = CC(I,1,K)+TI2
+-            CR3 = TAUI*(CC(I-1,3,K)-CC(IC-1,2,K))
+-            CI3 = TAUI*(CC(I,3,K)+CC(IC,2,K))
+-            DR2 = CR2-CI3
+-            DR3 = CR2+CI3
+-            DI2 = CI2+CR3
+-            DI3 = CI2-CR3
+-            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+-            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+-            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+-            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+-  102    CONTINUE
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DRADB4 (IDO,L1,CC,CH,WA1,WA2,WA3)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,4,L1)           ,CH(IDO,L1,4)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)
+-      DATA SQRT2 /1.4142135623730950488016887242096980D0/
+-      DO 101 K=1,L1
+-         TR1 = CC(1,1,K)-CC(IDO,4,K)
+-         TR2 = CC(1,1,K)+CC(IDO,4,K)
+-         TR3 = CC(IDO,2,K)+CC(IDO,2,K)
+-         TR4 = CC(1,3,K)+CC(1,3,K)
+-         CH(1,K,1) = TR2+TR3
+-         CH(1,K,2) = TR1-TR4
+-         CH(1,K,3) = TR2-TR3
+-         CH(1,K,4) = TR1+TR4
+-  101 CONTINUE
+-      IF (IDO-2) 107,105,102
+-  102 IDP2 = IDO+2
+-      DO 104 K=1,L1
+-         DO 103 I=3,IDO,2
+-            IC = IDP2-I
+-            TI1 = CC(I,1,K)+CC(IC,4,K)
+-            TI2 = CC(I,1,K)-CC(IC,4,K)
+-            TI3 = CC(I,3,K)-CC(IC,2,K)
+-            TR4 = CC(I,3,K)+CC(IC,2,K)
+-            TR1 = CC(I-1,1,K)-CC(IC-1,4,K)
+-            TR2 = CC(I-1,1,K)+CC(IC-1,4,K)
+-            TI4 = CC(I-1,3,K)-CC(IC-1,2,K)
+-            TR3 = CC(I-1,3,K)+CC(IC-1,2,K)
+-            CH(I-1,K,1) = TR2+TR3
+-            CR3 = TR2-TR3
+-            CH(I,K,1) = TI2+TI3
+-            CI3 = TI2-TI3
+-            CR2 = TR1-TR4
+-            CR4 = TR1+TR4
+-            CI2 = TI1+TI4
+-            CI4 = TI1-TI4
+-            CH(I-1,K,2) = WA1(I-2)*CR2-WA1(I-1)*CI2
+-            CH(I,K,2) = WA1(I-2)*CI2+WA1(I-1)*CR2
+-            CH(I-1,K,3) = WA2(I-2)*CR3-WA2(I-1)*CI3
+-            CH(I,K,3) = WA2(I-2)*CI3+WA2(I-1)*CR3
+-            CH(I-1,K,4) = WA3(I-2)*CR4-WA3(I-1)*CI4
+-            CH(I,K,4) = WA3(I-2)*CI4+WA3(I-1)*CR4
+-  103    CONTINUE
+-  104 CONTINUE
+-      IF (MOD(IDO,2) .EQ. 1) RETURN
+-  105 CONTINUE
+-      DO 106 K=1,L1
+-         TI1 = CC(1,2,K)+CC(1,4,K)
+-         TI2 = CC(1,4,K)-CC(1,2,K)
+-         TR1 = CC(IDO,1,K)-CC(IDO,3,K)
+-         TR2 = CC(IDO,1,K)+CC(IDO,3,K)
+-         CH(IDO,K,1) = TR2+TR2
+-         CH(IDO,K,2) = SQRT2*(TR1-TI1)
+-         CH(IDO,K,3) = TI2+TI2
+-         CH(IDO,K,4) = -SQRT2*(TR1+TI1)
+-  106 CONTINUE
+-  107 RETURN
+-      END
+-      SUBROUTINE DRADB5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,5,L1)           ,CH(IDO,L1,5)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
+-      DATA TR11,TI11,TR12,TI12 /
+-     1   .30901699437494742410229341718281905D0,
+-     2   .95105651629515357211643933337938214D0,
+-     3  -.80901699437494742410229341718281906D0,
+-     4   .58778525229247312916870595463907276D0/
+-      DO 101 K=1,L1
+-         TI5 = CC(1,3,K)+CC(1,3,K)
+-         TI4 = CC(1,5,K)+CC(1,5,K)
+-         TR2 = CC(IDO,2,K)+CC(IDO,2,K)
+-         TR3 = CC(IDO,4,K)+CC(IDO,4,K)
+-         CH(1,K,1) = CC(1,1,K)+TR2+TR3
+-         CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
+-         CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
+-         CI5 = TI11*TI5+TI12*TI4
+-         CI4 = TI12*TI5-TI11*TI4
+-         CH(1,K,2) = CR2-CI5
+-         CH(1,K,3) = CR3-CI4
+-         CH(1,K,4) = CR3+CI4
+-         CH(1,K,5) = CR2+CI5
+-  101 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      IDP2 = IDO+2
+-      DO 103 K=1,L1
+-         DO 102 I=3,IDO,2
+-            IC = IDP2-I
+-            TI5 = CC(I,3,K)+CC(IC,2,K)
+-            TI2 = CC(I,3,K)-CC(IC,2,K)
+-            TI4 = CC(I,5,K)+CC(IC,4,K)
+-            TI3 = CC(I,5,K)-CC(IC,4,K)
+-            TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
+-            TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
+-            TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
+-            TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
+-            CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
+-            CH(I,K,1) = CC(I,1,K)+TI2+TI3
+-            CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
+-            CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
+-            CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
+-            CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
+-            CR5 = TI11*TR5+TI12*TR4
+-            CI5 = TI11*TI5+TI12*TI4
+-            CR4 = TI12*TR5-TI11*TR4
+-            CI4 = TI12*TI5-TI11*TI4
+-            DR3 = CR3-CI4
+-            DR4 = CR3+CI4
+-            DI3 = CI3+CR4
+-            DI4 = CI3-CR4
+-            DR5 = CR2+CI5
+-            DR2 = CR2-CI5
+-            DI5 = CI2-CR5
+-            DI2 = CI2+CR5
+-            CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
+-            CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
+-            CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
+-            CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
+-            CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
+-            CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
+-            CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
+-            CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
+-  102    CONTINUE
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DRADBG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
+-     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
+-     2                CH2(IDL1,IP)           ,WA(*)
+-      DATA TPI/6.2831853071795864769252867665590057D0/
+-      ARG = TPI/DBLE(IP)
+-      DCP = DCOS(ARG)
+-      DSP = DSIN(ARG)
+-      IDP2 = IDO+2
+-      NBD = (IDO-1)/2
+-      IPP2 = IP+2
+-      IPPH = (IP+1)/2
+-      IF (IDO .LT. L1) GO TO 103
+-      DO 102 K=1,L1
+-         DO 101 I=1,IDO
+-            CH(I,K,1) = CC(I,1,K)
+-  101    CONTINUE
+-  102 CONTINUE
+-      GO TO 106
+-  103 DO 105 I=1,IDO
+-         DO 104 K=1,L1
+-            CH(I,K,1) = CC(I,1,K)
+-  104    CONTINUE
+-  105 CONTINUE
+-  106 DO 108 J=2,IPPH
+-         JC = IPP2-J
+-         J2 = J+J
+-         DO 107 K=1,L1
+-            CH(1,K,J) = CC(IDO,J2-2,K)+CC(IDO,J2-2,K)
+-            CH(1,K,JC) = CC(1,J2-1,K)+CC(1,J2-1,K)
+-  107    CONTINUE
+-  108 CONTINUE
+-      IF (IDO .EQ. 1) GO TO 116
+-      IF (NBD .LT. L1) GO TO 112
+-      DO 111 J=2,IPPH
+-         JC = IPP2-J
+-         DO 110 K=1,L1
+-            DO 109 I=3,IDO,2
+-               IC = IDP2-I
+-               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+-               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+-               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+-               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+-  109       CONTINUE
+-  110    CONTINUE
+-  111 CONTINUE
+-      GO TO 116
+-  112 DO 115 J=2,IPPH
+-         JC = IPP2-J
+-         DO 114 I=3,IDO,2
+-            IC = IDP2-I
+-            DO 113 K=1,L1
+-               CH(I-1,K,J) = CC(I-1,2*J-1,K)+CC(IC-1,2*J-2,K)
+-               CH(I-1,K,JC) = CC(I-1,2*J-1,K)-CC(IC-1,2*J-2,K)
+-               CH(I,K,J) = CC(I,2*J-1,K)-CC(IC,2*J-2,K)
+-               CH(I,K,JC) = CC(I,2*J-1,K)+CC(IC,2*J-2,K)
+-  113       CONTINUE
+-  114    CONTINUE
+-  115 CONTINUE
+-  116 AR1 = 1.0D0
+-      AI1 = 0.0D0
+-      DO 120 L=2,IPPH
+-         LC = IPP2-L
+-         AR1H = DCP*AR1-DSP*AI1
+-         AI1 = DCP*AI1+DSP*AR1
+-         AR1 = AR1H
+-         DO 117 IK=1,IDL1
+-            C2(IK,L) = CH2(IK,1)+AR1*CH2(IK,2)
+-            C2(IK,LC) = AI1*CH2(IK,IP)
+-  117    CONTINUE
+-         DC2 = AR1
+-         DS2 = AI1
+-         AR2 = AR1
+-         AI2 = AI1
+-         DO 119 J=3,IPPH
+-            JC = IPP2-J
+-            AR2H = DC2*AR2-DS2*AI2
+-            AI2 = DC2*AI2+DS2*AR2
+-            AR2 = AR2H
+-            DO 118 IK=1,IDL1
+-               C2(IK,L) = C2(IK,L)+AR2*CH2(IK,J)
+-               C2(IK,LC) = C2(IK,LC)+AI2*CH2(IK,JC)
+-  118       CONTINUE
+-  119    CONTINUE
+-  120 CONTINUE
+-      DO 122 J=2,IPPH
+-         DO 121 IK=1,IDL1
+-            CH2(IK,1) = CH2(IK,1)+CH2(IK,J)
+-  121    CONTINUE
+-  122 CONTINUE
+-      DO 124 J=2,IPPH
+-         JC = IPP2-J
+-         DO 123 K=1,L1
+-            CH(1,K,J) = C1(1,K,J)-C1(1,K,JC)
+-            CH(1,K,JC) = C1(1,K,J)+C1(1,K,JC)
+-  123    CONTINUE
+-  124 CONTINUE
+-      IF (IDO .EQ. 1) GO TO 132
+-      IF (NBD .LT. L1) GO TO 128
+-      DO 127 J=2,IPPH
+-         JC = IPP2-J
+-         DO 126 K=1,L1
+-            DO 125 I=3,IDO,2
+-               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+-               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+-               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+-               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+-  125       CONTINUE
+-  126    CONTINUE
+-  127 CONTINUE
+-      GO TO 132
+-  128 DO 131 J=2,IPPH
+-         JC = IPP2-J
+-         DO 130 I=3,IDO,2
+-            DO 129 K=1,L1
+-               CH(I-1,K,J) = C1(I-1,K,J)-C1(I,K,JC)
+-               CH(I-1,K,JC) = C1(I-1,K,J)+C1(I,K,JC)
+-               CH(I,K,J) = C1(I,K,J)+C1(I-1,K,JC)
+-               CH(I,K,JC) = C1(I,K,J)-C1(I-1,K,JC)
+-  129       CONTINUE
+-  130    CONTINUE
+-  131 CONTINUE
+-  132 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      DO 133 IK=1,IDL1
+-         C2(IK,1) = CH2(IK,1)
+-  133 CONTINUE
+-      DO 135 J=2,IP
+-         DO 134 K=1,L1
+-            C1(1,K,J) = CH(1,K,J)
+-  134    CONTINUE
+-  135 CONTINUE
+-      IF (NBD .GT. L1) GO TO 139
+-      IS = -IDO
+-      DO 138 J=2,IP
+-         IS = IS+IDO
+-         IDIJ = IS
+-         DO 137 I=3,IDO,2
+-            IDIJ = IDIJ+2
+-            DO 136 K=1,L1
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+-  136       CONTINUE
+-  137    CONTINUE
+-  138 CONTINUE
+-      GO TO 143
+-  139 IS = -IDO
+-      DO 142 J=2,IP
+-         IS = IS+IDO
+-         DO 141 K=1,L1
+-            IDIJ = IS
+-            DO 140 I=3,IDO,2
+-               IDIJ = IDIJ+2
+-               C1(I-1,K,J) = WA(IDIJ-1)*CH(I-1,K,J)-WA(IDIJ)*CH(I,K,J)
+-               C1(I,K,J) = WA(IDIJ-1)*CH(I,K,J)+WA(IDIJ)*CH(I-1,K,J)
+-  140       CONTINUE
+-  141    CONTINUE
+-  142 CONTINUE
+-  143 RETURN
+-      END
+-      SUBROUTINE DRADF2 (IDO,L1,CC,CH,WA1)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,2,L1)           ,CC(IDO,L1,2)           ,
+-     1                WA1(*)
+-      DO 101 K=1,L1
+-         CH(1,1,K) = CC(1,K,1)+CC(1,K,2)
+-         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,2)
+-  101 CONTINUE
+-      IF (IDO-2) 107,105,102
+-  102 IDP2 = IDO+2
+-      DO 104 K=1,L1
+-         DO 103 I=3,IDO,2
+-            IC = IDP2-I
+-            TR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+-            TI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+-            CH(I,1,K) = CC(I,K,1)+TI2
+-            CH(IC,2,K) = TI2-CC(I,K,1)
+-            CH(I-1,1,K) = CC(I-1,K,1)+TR2
+-            CH(IC-1,2,K) = CC(I-1,K,1)-TR2
+-  103    CONTINUE
+-  104 CONTINUE
+-      IF (MOD(IDO,2) .EQ. 1) RETURN
+-  105 DO 106 K=1,L1
+-         CH(1,2,K) = -CC(IDO,K,2)
+-         CH(IDO,1,K) = CC(IDO,K,1)
+-  106 CONTINUE
+-  107 RETURN
+-      END
+-      SUBROUTINE DRADF3 (IDO,L1,CC,CH,WA1,WA2)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,3,L1)           ,CC(IDO,L1,3)           ,
+-     1                WA1(*)     ,WA2(*)
+-      DATA TAUR,TAUI /-.5D0,.86602540378443864676372317075293618D0/
+-      DO 101 K=1,L1
+-         CR2 = CC(1,K,2)+CC(1,K,3)
+-         CH(1,1,K) = CC(1,K,1)+CR2
+-         CH(1,3,K) = TAUI*(CC(1,K,3)-CC(1,K,2))
+-         CH(IDO,2,K) = CC(1,K,1)+TAUR*CR2
+-  101 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      IDP2 = IDO+2
+-      DO 103 K=1,L1
+-         DO 102 I=3,IDO,2
+-            IC = IDP2-I
+-            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+-            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+-            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+-            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+-            CR2 = DR2+DR3
+-            CI2 = DI2+DI3
+-            CH(I-1,1,K) = CC(I-1,K,1)+CR2
+-            CH(I,1,K) = CC(I,K,1)+CI2
+-            TR2 = CC(I-1,K,1)+TAUR*CR2
+-            TI2 = CC(I,K,1)+TAUR*CI2
+-            TR3 = TAUI*(DI2-DI3)
+-            TI3 = TAUI*(DR3-DR2)
+-            CH(I-1,3,K) = TR2+TR3
+-            CH(IC-1,2,K) = TR2-TR3
+-            CH(I,3,K) = TI2+TI3
+-            CH(IC,2,K) = TI3-TI2
+-  102    CONTINUE
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DRADF4 (IDO,L1,CC,CH,WA1,WA2,WA3)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,L1,4)           ,CH(IDO,4,L1)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)
+-      DATA HSQT2 /0.70710678118654752440084436210484904D0/
+-      DO 101 K=1,L1
+-         TR1 = CC(1,K,2)+CC(1,K,4)
+-         TR2 = CC(1,K,1)+CC(1,K,3)
+-         CH(1,1,K) = TR1+TR2
+-         CH(IDO,4,K) = TR2-TR1
+-         CH(IDO,2,K) = CC(1,K,1)-CC(1,K,3)
+-         CH(1,3,K) = CC(1,K,4)-CC(1,K,2)
+-  101 CONTINUE
+-      IF (IDO-2) 107,105,102
+-  102 IDP2 = IDO+2
+-      DO 104 K=1,L1
+-         DO 103 I=3,IDO,2
+-            IC = IDP2-I
+-            CR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+-            CI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+-            CR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+-            CI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+-            CR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+-            CI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+-            TR1 = CR2+CR4
+-            TR4 = CR4-CR2
+-            TI1 = CI2+CI4
+-            TI4 = CI2-CI4
+-            TI2 = CC(I,K,1)+CI3
+-            TI3 = CC(I,K,1)-CI3
+-            TR2 = CC(I-1,K,1)+CR3
+-            TR3 = CC(I-1,K,1)-CR3
+-            CH(I-1,1,K) = TR1+TR2
+-            CH(IC-1,4,K) = TR2-TR1
+-            CH(I,1,K) = TI1+TI2
+-            CH(IC,4,K) = TI1-TI2
+-            CH(I-1,3,K) = TI4+TR3
+-            CH(IC-1,2,K) = TR3-TI4
+-            CH(I,3,K) = TR4+TI3
+-            CH(IC,2,K) = TR4-TI3
+-  103    CONTINUE
+-  104 CONTINUE
+-      IF (MOD(IDO,2) .EQ. 1) RETURN
+-  105 CONTINUE
+-      DO 106 K=1,L1
+-         TI1 = -HSQT2*(CC(IDO,K,2)+CC(IDO,K,4))
+-         TR1 = HSQT2*(CC(IDO,K,2)-CC(IDO,K,4))
+-         CH(IDO,1,K) = TR1+CC(IDO,K,1)
+-         CH(IDO,3,K) = CC(IDO,K,1)-TR1
+-         CH(1,2,K) = TI1-CC(IDO,K,3)
+-         CH(1,4,K) = TI1+CC(IDO,K,3)
+-  106 CONTINUE
+-  107 RETURN
+-      END
+-      SUBROUTINE DRADF5 (IDO,L1,CC,CH,WA1,WA2,WA3,WA4)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CC(IDO,L1,5)           ,CH(IDO,5,L1)           ,
+-     1                WA1(*)     ,WA2(*)     ,WA3(*)     ,WA4(*)
+-      DATA TR11,TI11,TR12,TI12 /
+-     1   .30901699437494742410229341718281905D0,
+-     2   .95105651629515357211643933337938214D0,
+-     3  -.80901699437494742410229341718281906D0,
+-     4   .58778525229247312916870595463907276D0/
+-      DO 101 K=1,L1
+-         CR2 = CC(1,K,5)+CC(1,K,2)
+-         CI5 = CC(1,K,5)-CC(1,K,2)
+-         CR3 = CC(1,K,4)+CC(1,K,3)
+-         CI4 = CC(1,K,4)-CC(1,K,3)
+-         CH(1,1,K) = CC(1,K,1)+CR2+CR3
+-         CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
+-         CH(1,3,K) = TI11*CI5+TI12*CI4
+-         CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
+-         CH(1,5,K) = TI12*CI5-TI11*CI4
+-  101 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      IDP2 = IDO+2
+-      DO 103 K=1,L1
+-         DO 102 I=3,IDO,2
+-            IC = IDP2-I
+-            DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
+-            DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
+-            DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
+-            DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
+-            DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
+-            DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
+-            DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
+-            DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
+-            CR2 = DR2+DR5
+-            CI5 = DR5-DR2
+-            CR5 = DI2-DI5
+-            CI2 = DI2+DI5
+-            CR3 = DR3+DR4
+-            CI4 = DR4-DR3
+-            CR4 = DI3-DI4
+-            CI3 = DI3+DI4
+-            CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
+-            CH(I,1,K) = CC(I,K,1)+CI2+CI3
+-            TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
+-            TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
+-            TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
+-            TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
+-            TR5 = TI11*CR5+TI12*CR4
+-            TI5 = TI11*CI5+TI12*CI4
+-            TR4 = TI12*CR5-TI11*CR4
+-            TI4 = TI12*CI5-TI11*CI4
+-            CH(I-1,3,K) = TR2+TR5
+-            CH(IC-1,2,K) = TR2-TR5
+-            CH(I,3,K) = TI2+TI5
+-            CH(IC,2,K) = TI5-TI2
+-            CH(I-1,5,K) = TR3+TR4
+-            CH(IC-1,4,K) = TR3-TR4
+-            CH(I,5,K) = TI3+TI4
+-            CH(IC,4,K) = TI4-TI3
+-  102    CONTINUE
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DRADFG (IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(IDO,L1,IP)          ,CC(IDO,IP,L1)          ,
+-     1                C1(IDO,L1,IP)          ,C2(IDL1,IP),
+-     2                CH2(IDL1,IP)           ,WA(*)
+-      DATA TPI/6.2831853071795864769252867665590057D0/
+-      ARG = TPI/DBLE(IP)
+-      DCP = DCOS(ARG)
+-      DSP = DSIN(ARG)
+-      IPPH = (IP+1)/2
+-      IPP2 = IP+2
+-      IDP2 = IDO+2
+-      NBD = (IDO-1)/2
+-      IF (IDO .EQ. 1) GO TO 119
+-      DO 101 IK=1,IDL1
+-         CH2(IK,1) = C2(IK,1)
+-  101 CONTINUE
+-      DO 103 J=2,IP
+-         DO 102 K=1,L1
+-            CH(1,K,J) = C1(1,K,J)
+-  102    CONTINUE
+-  103 CONTINUE
+-      IF (NBD .GT. L1) GO TO 107
+-      IS = -IDO
+-      DO 106 J=2,IP
+-         IS = IS+IDO
+-         IDIJ = IS
+-         DO 105 I=3,IDO,2
+-            IDIJ = IDIJ+2
+-            DO 104 K=1,L1
+-               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+-               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+-  104       CONTINUE
+-  105    CONTINUE
+-  106 CONTINUE
+-      GO TO 111
+-  107 IS = -IDO
+-      DO 110 J=2,IP
+-         IS = IS+IDO
+-         DO 109 K=1,L1
+-            IDIJ = IS
+-            DO 108 I=3,IDO,2
+-               IDIJ = IDIJ+2
+-               CH(I-1,K,J) = WA(IDIJ-1)*C1(I-1,K,J)+WA(IDIJ)*C1(I,K,J)
+-               CH(I,K,J) = WA(IDIJ-1)*C1(I,K,J)-WA(IDIJ)*C1(I-1,K,J)
+-  108       CONTINUE
+-  109    CONTINUE
+-  110 CONTINUE
+-  111 IF (NBD .LT. L1) GO TO 115
+-      DO 114 J=2,IPPH
+-         JC = IPP2-J
+-         DO 113 K=1,L1
+-            DO 112 I=3,IDO,2
+-               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+-               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+-               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+-               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+-  112       CONTINUE
+-  113    CONTINUE
+-  114 CONTINUE
+-      GO TO 121
+-  115 DO 118 J=2,IPPH
+-         JC = IPP2-J
+-         DO 117 I=3,IDO,2
+-            DO 116 K=1,L1
+-               C1(I-1,K,J) = CH(I-1,K,J)+CH(I-1,K,JC)
+-               C1(I-1,K,JC) = CH(I,K,J)-CH(I,K,JC)
+-               C1(I,K,J) = CH(I,K,J)+CH(I,K,JC)
+-               C1(I,K,JC) = CH(I-1,K,JC)-CH(I-1,K,J)
+-  116       CONTINUE
+-  117    CONTINUE
+-  118 CONTINUE
+-      GO TO 121
+-  119 DO 120 IK=1,IDL1
+-         C2(IK,1) = CH2(IK,1)
+-  120 CONTINUE
+-  121 DO 123 J=2,IPPH
+-         JC = IPP2-J
+-         DO 122 K=1,L1
+-            C1(1,K,J) = CH(1,K,J)+CH(1,K,JC)
+-            C1(1,K,JC) = CH(1,K,JC)-CH(1,K,J)
+-  122    CONTINUE
+-  123 CONTINUE
+-C
+-      AR1 = 1.0D0
+-      AI1 = 0.0D0
+-      DO 127 L=2,IPPH
+-         LC = IPP2-L
+-         AR1H = DCP*AR1-DSP*AI1
+-         AI1 = DCP*AI1+DSP*AR1
+-         AR1 = AR1H
+-         DO 124 IK=1,IDL1
+-            CH2(IK,L) = C2(IK,1)+AR1*C2(IK,2)
+-            CH2(IK,LC) = AI1*C2(IK,IP)
+-  124    CONTINUE
+-         DC2 = AR1
+-         DS2 = AI1
+-         AR2 = AR1
+-         AI2 = AI1
+-         DO 126 J=3,IPPH
+-            JC = IPP2-J
+-            AR2H = DC2*AR2-DS2*AI2
+-            AI2 = DC2*AI2+DS2*AR2
+-            AR2 = AR2H
+-            DO 125 IK=1,IDL1
+-               CH2(IK,L) = CH2(IK,L)+AR2*C2(IK,J)
+-               CH2(IK,LC) = CH2(IK,LC)+AI2*C2(IK,JC)
+-  125       CONTINUE
+-  126    CONTINUE
+-  127 CONTINUE
+-      DO 129 J=2,IPPH
+-         DO 128 IK=1,IDL1
+-            CH2(IK,1) = CH2(IK,1)+C2(IK,J)
+-  128    CONTINUE
+-  129 CONTINUE
+-C
+-      IF (IDO .LT. L1) GO TO 132
+-      DO 131 K=1,L1
+-         DO 130 I=1,IDO
+-            CC(I,1,K) = CH(I,K,1)
+-  130    CONTINUE
+-  131 CONTINUE
+-      GO TO 135
+-  132 DO 134 I=1,IDO
+-         DO 133 K=1,L1
+-            CC(I,1,K) = CH(I,K,1)
+-  133    CONTINUE
+-  134 CONTINUE
+-  135 DO 137 J=2,IPPH
+-         JC = IPP2-J
+-         J2 = J+J
+-         DO 136 K=1,L1
+-            CC(IDO,J2-2,K) = CH(1,K,J)
+-            CC(1,J2-1,K) = CH(1,K,JC)
+-  136    CONTINUE
+-  137 CONTINUE
+-      IF (IDO .EQ. 1) RETURN
+-      IF (NBD .LT. L1) GO TO 141
+-      DO 140 J=2,IPPH
+-         JC = IPP2-J
+-         J2 = J+J
+-         DO 139 K=1,L1
+-            DO 138 I=3,IDO,2
+-               IC = IDP2-I
+-               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+-               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+-               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+-               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+-  138       CONTINUE
+-  139    CONTINUE
+-  140 CONTINUE
+-      RETURN
+-  141 DO 144 J=2,IPPH
+-         JC = IPP2-J
+-         J2 = J+J
+-         DO 143 I=3,IDO,2
+-            IC = IDP2-I
+-            DO 142 K=1,L1
+-               CC(I-1,J2-1,K) = CH(I-1,K,J)+CH(I-1,K,JC)
+-               CC(IC-1,J2-2,K) = CH(I-1,K,J)-CH(I-1,K,JC)
+-               CC(I,J2-1,K) = CH(I,K,J)+CH(I,K,JC)
+-               CC(IC,J2-2,K) = CH(I,K,JC)-CH(I,K,J)
+-  142       CONTINUE
+-  143    CONTINUE
+-  144 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE DFFTB1 (N,C,CH,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
+-      NF = IFAC(2)
+-      NA = 0
+-      L1 = 1
+-      IW = 1
+-      DO 116 K1=1,NF
+-         IP = IFAC(K1+2)
+-         L2 = IP*L1
+-         IDO = N/L2
+-         IDL1 = IDO*L1
+-         IF (IP .NE. 4) GO TO 103
+-         IX2 = IW+IDO
+-         IX3 = IX2+IDO
+-         IF (NA .NE. 0) GO TO 101
+-         CALL DRADB4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+-         GO TO 102
+-  101    CALL DRADB4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+-  102    NA = 1-NA
+-         GO TO 115
+-  103    IF (IP .NE. 2) GO TO 106
+-         IF (NA .NE. 0) GO TO 104
+-         CALL DRADB2 (IDO,L1,C,CH,WA(IW))
+-         GO TO 105
+-  104    CALL DRADB2 (IDO,L1,CH,C,WA(IW))
+-  105    NA = 1-NA
+-         GO TO 115
+-  106    IF (IP .NE. 3) GO TO 109
+-         IX2 = IW+IDO
+-         IF (NA .NE. 0) GO TO 107
+-         CALL DRADB3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+-         GO TO 108
+-  107    CALL DRADB3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+-  108    NA = 1-NA
+-         GO TO 115
+-  109    IF (IP .NE. 5) GO TO 112
+-         IX2 = IW+IDO
+-         IX3 = IX2+IDO
+-         IX4 = IX3+IDO
+-         IF (NA .NE. 0) GO TO 110
+-         CALL DRADB5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-         GO TO 111
+-  110    CALL DRADB5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-  111    NA = 1-NA
+-         GO TO 115
+-  112    IF (NA .NE. 0) GO TO 113
+-         CALL DRADBG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+-         GO TO 114
+-  113    CALL DRADBG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+-  114    IF (IDO .EQ. 1) NA = 1-NA
+-  115    L1 = L2
+-         IW = IW+(IP-1)*IDO
+-  116 CONTINUE
+-      IF (NA .EQ. 0) RETURN
+-      DO 117 I=1,N
+-         C(I) = CH(I)
+-  117 CONTINUE
+-      RETURN
+-      END
+-
+-
+-      SUBROUTINE DFFTB (N,R,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       R(*)       ,WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      CALL DFFTB1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
+-      RETURN
+-      END
+-
+-      SUBROUTINE DFFTF1 (N,C,CH,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       CH(*)      ,C(*)       ,WA(*)      ,IFAC(*)
+-      NF = IFAC(2)
+-      NA = 1
+-      L2 = N
+-      IW = N
+-      DO 111 K1=1,NF
+-         KH = NF-K1
+-         IP = IFAC(KH+3)
+-         L1 = L2/IP
+-         IDO = N/L2
+-         IDL1 = IDO*L1
+-         IW = IW-(IP-1)*IDO
+-         NA = 1-NA
+-         IF (IP .NE. 4) GO TO 102
+-         IX2 = IW+IDO
+-         IX3 = IX2+IDO
+-         IF (NA .NE. 0) GO TO 101
+-         CALL DRADF4 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3))
+-         GO TO 110
+-  101    CALL DRADF4 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3))
+-         GO TO 110
+-  102    IF (IP .NE. 2) GO TO 104
+-         IF (NA .NE. 0) GO TO 103
+-         CALL DRADF2 (IDO,L1,C,CH,WA(IW))
+-         GO TO 110
+-  103    CALL DRADF2 (IDO,L1,CH,C,WA(IW))
+-         GO TO 110
+-  104    IF (IP .NE. 3) GO TO 106
+-         IX2 = IW+IDO
+-         IF (NA .NE. 0) GO TO 105
+-         CALL DRADF3 (IDO,L1,C,CH,WA(IW),WA(IX2))
+-         GO TO 110
+-  105    CALL DRADF3 (IDO,L1,CH,C,WA(IW),WA(IX2))
+-         GO TO 110
+-  106    IF (IP .NE. 5) GO TO 108
+-         IX2 = IW+IDO
+-         IX3 = IX2+IDO
+-         IX4 = IX3+IDO
+-         IF (NA .NE. 0) GO TO 107
+-         CALL DRADF5 (IDO,L1,C,CH,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-         GO TO 110
+-  107    CALL DRADF5 (IDO,L1,CH,C,WA(IW),WA(IX2),WA(IX3),WA(IX4))
+-         GO TO 110
+-  108    IF (IDO .EQ. 1) NA = 1-NA
+-         IF (NA .NE. 0) GO TO 109
+-         CALL DRADFG (IDO,IP,L1,IDL1,C,C,C,CH,CH,WA(IW))
+-         NA = 1
+-         GO TO 110
+-  109    CALL DRADFG (IDO,IP,L1,IDL1,CH,CH,CH,C,C,WA(IW))
+-         NA = 0
+-  110    L2 = L1
+-  111 CONTINUE
+-      IF (NA .EQ. 1) RETURN
+-      DO 112 I=1,N
+-         C(I) = CH(I)
+-  112 CONTINUE
+-      RETURN
+-      END
+-
+-
+-      SUBROUTINE DFFTF (N,R,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       R(*)       ,WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      CALL DFFTF1 (N,R,WSAVE,WSAVE(N+1),WSAVE(2*N+1))
+-      RETURN
+-      END
+-
+-      SUBROUTINE DFFTI1 (N,WA,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WA(*)      ,IFAC(*)    ,NTRYH(4)
+-      DATA NTRYH(1),NTRYH(2),NTRYH(3),NTRYH(4)/4,2,3,5/
+-      NL = N
+-      NF = 0
+-      J = 0
+-  101 J = J+1
+-      IF (J-4) 102,102,103
+-  102 NTRY = NTRYH(J)
+-      GO TO 104
+-  103 NTRY = NTRY+2
+-  104 NQ = NL/NTRY
+-      NR = NL-NTRY*NQ
+-      IF (NR) 101,105,101
+-  105 NF = NF+1
+-      IFAC(NF+2) = NTRY
+-      NL = NQ
+-      IF (NTRY .NE. 2) GO TO 107
+-      IF (NF .EQ. 1) GO TO 107
+-      DO 106 I=2,NF
+-         IB = NF-I+2
+-         IFAC(IB+2) = IFAC(IB+1)
+-  106 CONTINUE
+-      IFAC(3) = 2
+-  107 IF (NL .NE. 1) GO TO 104
+-      IFAC(1) = N
+-      IFAC(2) = NF
+-      TPI = 6.2831853071795864769252867665590057D0
+-      ARGH = TPI/DBLE(N)
+-      IS = 0
+-      NFM1 = NF-1
+-      L1 = 1
+-      IF (NFM1 .EQ. 0) RETURN
+-      DO 110 K1=1,NFM1
+-         IP = IFAC(K1+2)
+-         LD = 0
+-         L2 = L1*IP
+-         IDO = N/L2
+-         IPM = IP-1
+-         DO 109 J=1,IPM
+-            LD = LD+L1
+-            I = IS
+-            ARGLD = DBLE(LD)*ARGH
+-            FI = 0.0D0
+-            DO 108 II=3,IDO,2
+-               I = I+2
+-               FI = FI+1.0D0
+-               ARG = FI*ARGLD
+-               WA(I-1) = DCOS(ARG)
+-               WA(I) = DSIN(ARG)
+-  108       CONTINUE
+-            IS = IS+IDO
+-  109    CONTINUE
+-         L1 = L2
+-  110 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE DFFTI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      CALL DFFTI1 (N,WSAVE(N+1),WSAVE(2*N+1))
+-      RETURN
+-      END
+-      SUBROUTINE DSINQB (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      IF (N .GT. 1) GO TO 101
+-      X(1) = 4.0D0*X(1)
+-      RETURN
+-  101 NS2 = N/2
+-      DO 102 K=2,N,2
+-         X(K) = -X(K)
+-  102 CONTINUE
+-      CALL DCOSQB (N,X,WSAVE)
+-      DO 103 K=1,NS2
+-         KC = N-K
+-         XHOLD = X(K)
+-         X(K) = X(KC+1)
+-         X(KC+1) = XHOLD
+-  103 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DSINQF (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      IF (N .EQ. 1) RETURN
+-      NS2 = N/2
+-      DO 101 K=1,NS2
+-         KC = N-K
+-         XHOLD = X(K)
+-         X(K) = X(KC+1)
+-         X(KC+1) = XHOLD
+-  101 CONTINUE
+-      CALL DCOSQF (N,X,WSAVE)
+-      DO 102 K=2,N,2
+-         X(K) = -X(K)
+-  102 CONTINUE
+-      RETURN
+-      END
+-      SUBROUTINE DSINQI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      CALL DCOSQI (N,WSAVE)
+-      RETURN
+-      END
+-
+-      SUBROUTINE DSINT1(N,WAR,WAS,XH,X,IFAC)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION WAR(*),WAS(*),X(*),XH(*),IFAC(*)
+-      DATA SQRT3 /1.7320508075688772935274463415058723D0/
+-      DO 100 I=1,N
+-      XH(I) = WAR(I)
+-      WAR(I) = X(I)
+-  100 CONTINUE
+-      IF (N-2) 101,102,103
+-  101 XH(1) = XH(1)+XH(1)
+-      GO TO 106
+-  102 XHOLD = SQRT3*(XH(1)+XH(2))
+-      XH(2) = SQRT3*(XH(1)-XH(2))
+-      XH(1) = XHOLD
+-      GO TO 106
+-  103 NP1 = N+1
+-      NS2 = N/2
+-      X(1) = 0.0D0
+-      DO 104 K=1,NS2
+-         KC = NP1-K
+-         T1 = XH(K)-XH(KC)
+-         T2 = WAS(K)*(XH(K)+XH(KC))
+-         X(K+1) = T1+T2
+-         X(KC+1) = T2-T1
+-  104 CONTINUE
+-      MODN = MOD(N,2)
+-      IF (MODN .NE. 0) X(NS2+2) = 4.0D0*XH(NS2+1)
+-      CALL DFFTF1 (NP1,X,XH,WAR,IFAC)
+-      XH(1) = .5D0*X(1)
+-      DO 105 I=3,N,2
+-         XH(I-1) = -X(I)
+-         XH(I) = XH(I-2)+X(I-1)
+-  105 CONTINUE
+-      IF (MODN .NE. 0) GO TO 106
+-      XH(N) = -X(N+1)
+-  106 DO 107 I=1,N
+-      X(I) = WAR(I)
+-      WAR(I) = XH(I)
+-  107 CONTINUE
+-      RETURN
+-      END
+-
+-      SUBROUTINE DSINT (N,X,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       X(*)       ,WSAVE(*)
+-      NP1 = N+1
+-      IW1 = N/2+1
+-      IW2 = IW1+NP1
+-      IW3 = IW2+NP1
+-      CALL DSINT1(N,X,WSAVE,WSAVE(IW1),WSAVE(IW2),WSAVE(IW3))
+-      RETURN
+-      END
+-
+-      SUBROUTINE DSINTI (N,WSAVE)
+-	IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+-      DIMENSION       WSAVE(*)
+-      DATA PI /3.1415926535897932384626433832795028D0/
+-      IF (N .LE. 1) RETURN
+-      NS2 = N/2
+-      NP1 = N+1
+-      DT = PI/DBLE(NP1)
+-      DO 101 K=1,NS2
+-         WSAVE(K) = 2.0D0*DSIN(K*DT)
+-  101 CONTINUE
+-      CALL DFFTI (NP1,WSAVE(NS2+1))
+-      RETURN
+-      END
+diff --git a/scipy/linalg/src/id_dist/src/id_rand.f b/scipy/linalg/src/id_dist/src/id_rand.f
+deleted file mode 100644
+index b49d2ef1f..000000000
+--- a/scipy/linalg/src/id_dist/src/id_rand.f
++++ /dev/null
+@@ -1,379 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine id_frand generates pseudorandom numbers
+-c       drawn uniformly from [0,1]. id_frand is more
+-c       efficient that id_srand, but cannot generate
+-c       fewer than 55 pseudorandom numbers per call.
+-c
+-c       routine id_srand generates pseudorandom numbers
+-c       drawn uniformly from [0,1]. id_srand is less
+-c       efficient that id_frand, but can generate
+-c       fewer than 55 pseudorandom numbers per call.
+-c
+-c       entry id_frandi initializes the seed values
+-c       for routine id_frand.
+-c
+-c       entry id_srandi initializes the seed values
+-c       for routine id_srand.
+-c
+-c       entry id_frando initializes the seed values
+-c       for routine id_frand to their original values.
+-c
+-c       entry id_srando initializes the seed values
+-c       for routine id_srand to their original values.
+-c
+-c       routine id_randperm generates a uniformly random permutation.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine id_frand(n,r)
+-c
+-c       generates n pseudorandom numbers drawn uniformly from [0,1],
+-c       via a very efficient lagged Fibonnaci method.
+-c       Unlike routine id_srand, the present routine requires that
+-c       n be at least 55.
+-c
+-c       input:
+-c       n -- number of pseudorandom numbers to generate
+-c
+-c       output:
+-c       r -- array of pseudorandom numbers
+-c
+-c       _N.B._: n must be at least 55.
+-c
+-c       reference:
+-c       Press, Teukolsky, Vetterling, Flannery, "Numerical Recipes,"
+-c            3rd edition, Cambridge University Press, 2007,
+-c            Section 7.1.5.
+-c
+-        implicit none
+-        integer n,k
+-        real*8 r(n),s(55),t(55),s0(55),x
+-        save
+-c
+-        data s/
+-     1  0.2793574644042651d0, 0.1882566493961346d0,
+-     2  0.5202478134503912d0, 0.7568505373052146d0,
+-     3  0.5682465992936152d0, 0.5153148754383294d0,
+-     4  0.7806554095454596d0, 1.982474428974643d-2,
+-     5  0.2520464262278498d0, 0.6423784715775962d0,
+-     6  0.5802024387972178d0, 0.3784471040388249d0,
+-     7  7.839919528229308d-2, 0.6334519212594525d0,
+-     8  3.387627157788001d-2, 0.1709066283884670d0,
+-     9  0.4801610983518325d0, 0.8983424668099422d0,
+-     *  5.358948687598758d-2, 0.1265377231771848d0,
+-     1  0.8979988627693677d0, 0.6470084038238917d0,
+-     2  0.3031709395541237d0, 0.6674702804438126d0,
+-     3  0.6318240977112699d0, 0.2235229633873050d0,
+-     4  0.2784629939177633d0, 0.2365462014457445d0,
+-     5  0.7226213454977284d0, 0.8986523045307989d0,
+-     6  0.5488233229247885d0, 0.3924605412141200d0,
+-     7  0.6288356378374988d0, 0.6370664115760445d0,
+-     8  0.5925600062791174d0, 0.4322113919396362d0,
+-     9  0.9766098520360393d0, 0.5168619893947437d0,
+-     *  0.6799970440779681d0, 0.4196004604766881d0,
+-     1  0.2324473089903044d0, 0.1439046416143282d0,
+-     2  0.4670307948601256d0, 0.7076498261128343d0,
+-     3  0.9458030397562582d0, 0.4557892460080424d0,
+-     4  0.3905930854589403d0, 0.3361770064397268d0,
+-     5  0.8303274937900278d0, 0.3041110304032945d0,
+-     6  0.5752684022049654d0, 7.985703137991175d-2,
+-     7  0.5522643936454465d0, 1.956754937251801d-2,
+-     8  0.9920272858340107d0/
+-c
+-        data s0/
+-     1  0.2793574644042651d0, 0.1882566493961346d0,
+-     2  0.5202478134503912d0, 0.7568505373052146d0,
+-     3  0.5682465992936152d0, 0.5153148754383294d0,
+-     4  0.7806554095454596d0, 1.982474428974643d-2,
+-     5  0.2520464262278498d0, 0.6423784715775962d0,
+-     6  0.5802024387972178d0, 0.3784471040388249d0,
+-     7  7.839919528229308d-2, 0.6334519212594525d0,
+-     8  3.387627157788001d-2, 0.1709066283884670d0,
+-     9  0.4801610983518325d0, 0.8983424668099422d0,
+-     *  5.358948687598758d-2, 0.1265377231771848d0,
+-     1  0.8979988627693677d0, 0.6470084038238917d0,
+-     2  0.3031709395541237d0, 0.6674702804438126d0,
+-     3  0.6318240977112699d0, 0.2235229633873050d0,
+-     4  0.2784629939177633d0, 0.2365462014457445d0,
+-     5  0.7226213454977284d0, 0.8986523045307989d0,
+-     6  0.5488233229247885d0, 0.3924605412141200d0,
+-     7  0.6288356378374988d0, 0.6370664115760445d0,
+-     8  0.5925600062791174d0, 0.4322113919396362d0,
+-     9  0.9766098520360393d0, 0.5168619893947437d0,
+-     *  0.6799970440779681d0, 0.4196004604766881d0,
+-     1  0.2324473089903044d0, 0.1439046416143282d0,
+-     2  0.4670307948601256d0, 0.7076498261128343d0,
+-     3  0.9458030397562582d0, 0.4557892460080424d0,
+-     4  0.3905930854589403d0, 0.3361770064397268d0,
+-     5  0.8303274937900278d0, 0.3041110304032945d0,
+-     6  0.5752684022049654d0, 7.985703137991175d-2,
+-     7  0.5522643936454465d0, 1.956754937251801d-2,
+-     8  0.9920272858340107d0/
+-c
+-c
+-        do k = 1,24
+-c
+-          x = s(k+31)-s(k)
+-          if(x .lt. 0) x = x+1
+-          r(k) = x
+-c
+-        enddo ! k
+-c
+-c
+-        do k = 25,55
+-c
+-          x = r(k-24)-s(k)
+-          if(x .lt. 0) x = x+1
+-          r(k) = x
+-c
+-        enddo ! k
+-c
+-c
+-        do k = 56,n
+-c
+-          x = r(k-24)-r(k-55)
+-          if(x .lt. 0) x = x+1
+-          r(k) = x
+-c
+-        enddo ! k
+-c
+-c
+-        do k = 1,55
+-          s(k) = r(n-55+k)
+-        enddo ! k
+-c
+-c
+-        return
+-c
+-c
+-c
+-        entry id_frandi(t)
+-c
+-c       initializes the seed values in s
+-c       (any appropriately random numbers will do).
+-c
+-c       input:
+-c       t -- values to copy into s
+-c
+-        do k = 1,55
+-          s(k) = t(k)
+-        enddo ! k
+-c
+-        return
+-c
+-c
+-c
+-        entry id_frando()
+-c
+-c       initializes the seed values in s to their original values.
+-c
+-        do k = 1,55
+-          s(k) = s0(k)
+-        enddo ! k
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine id_srand(n,r)
+-c
+-c       generates n pseudorandom numbers drawn uniformly from [0,1],
+-c       via a very efficient lagged Fibonnaci method.
+-c       Unlike routine id_frand, the present routine does not requires
+-c       that n be at least 55.
+-c
+-c       input:
+-c       n -- number of pseudorandom numbers to generate
+-c
+-c       output:
+-c       r -- array of pseudorandom numbers
+-c
+-c       reference:
+-c       Press, Teukolsky, Vetterling, Flannery, "Numerical Recipes,"
+-c            3rd edition, Cambridge University Press, 2007,
+-c            Section 7.1.5.
+-c
+-        implicit none
+-        integer n,k,l,m
+-        real*8 s(55),r(n),s0(55),t(55),x
+-        save
+-c
+-        data l/55/,m/24/
+-c
+-        data s/
+-     1  0.8966049453474352d0, 0.7789471911260157d0,
+-     2  0.6071529762908476d0, 0.8287077988663865d0,
+-     3  0.8249336255502409d0, 0.5735259423199479d0,
+-     4  0.2436346323812991d0, 0.2656149927259701d0,
+-     5  0.6594784809929011d0, 0.3432392503145575d0,
+-     6  0.5051287353012308d0, 0.1444493249757482d0,
+-     7  0.7643753221285416d0, 0.4843422506977382d0,
+-     8  0.4427513254774826d0, 0.2965991475108561d0,
+-     9  0.2650513544474467d0, 2.768759325778929d-2,
+-     *  0.6106305243078063d0, 0.4246918885003141d0,
+-     1  0.2863757386932874d0, 0.6211983878375777d0,
+-     2  0.7534336463880467d0, 0.7471458603576737d0,
+-     3  0.2017455446928328d0, 0.9334235874832779d0,
+-     4  0.6343440435422822d0, 0.8819824804812527d0,
+-     5  1.994761401222460d-2, 0.7023693520374801d0,
+-     6  0.6010088924817263d0, 6.498095955562046d-2,
+-     7  0.3090915456102685d0, 0.3014924769096677d0,
+-     8  0.5820726822705102d0, 0.3630527222866207d0,
+-     9  0.3787166916242271d0, 0.3932772088505305d0,
+-     *  0.5570720335382000d0, 0.9712062146993835d0,
+-     1  0.1338293907964648d0, 0.1857441593107195d0,
+-     2  0.9102503893692572d0, 0.2623337538798778d0,
+-     3  0.3542828591321135d0, 2.246286032456513d-2,
+-     4  0.7935703170405717d0, 6.051464729640567d-2,
+-     5  0.7271929955172147d0, 1.968513010678739d-3,
+-     6  0.4914223624495486d0, 0.8730023176789450d0,
+-     7  0.9639777091743168d0, 0.1084256187532446d0,
+-     8  0.8539399636754000d0/
+-c
+-        data s0/
+-     1  0.8966049453474352d0, 0.7789471911260157d0,
+-     2  0.6071529762908476d0, 0.8287077988663865d0,
+-     3  0.8249336255502409d0, 0.5735259423199479d0,
+-     4  0.2436346323812991d0, 0.2656149927259701d0,
+-     5  0.6594784809929011d0, 0.3432392503145575d0,
+-     6  0.5051287353012308d0, 0.1444493249757482d0,
+-     7  0.7643753221285416d0, 0.4843422506977382d0,
+-     8  0.4427513254774826d0, 0.2965991475108561d0,
+-     9  0.2650513544474467d0, 2.768759325778929d-2,
+-     *  0.6106305243078063d0, 0.4246918885003141d0,
+-     1  0.2863757386932874d0, 0.6211983878375777d0,
+-     2  0.7534336463880467d0, 0.7471458603576737d0,
+-     3  0.2017455446928328d0, 0.9334235874832779d0,
+-     4  0.6343440435422822d0, 0.8819824804812527d0,
+-     5  1.994761401222460d-2, 0.7023693520374801d0,
+-     6  0.6010088924817263d0, 6.498095955562046d-2,
+-     7  0.3090915456102685d0, 0.3014924769096677d0,
+-     8  0.5820726822705102d0, 0.3630527222866207d0,
+-     9  0.3787166916242271d0, 0.3932772088505305d0,
+-     *  0.5570720335382000d0, 0.9712062146993835d0,
+-     1  0.1338293907964648d0, 0.1857441593107195d0,
+-     2  0.9102503893692572d0, 0.2623337538798778d0,
+-     3  0.3542828591321135d0, 2.246286032456513d-2,
+-     4  0.7935703170405717d0, 6.051464729640567d-2,
+-     5  0.7271929955172147d0, 1.968513010678739d-3,
+-     6  0.4914223624495486d0, 0.8730023176789450d0,
+-     7  0.9639777091743168d0, 0.1084256187532446d0,
+-     8  0.8539399636754000d0/
+-c
+-c
+-        do k = 1,n
+-c
+-c         Run one step of the recurrence.
+-c
+-          x = s(m)-s(l)
+-          if(x .lt. 0) x = x+1
+-          s(l) = x
+-          r(k) = x
+-c
+-c         Decrement l and m.
+-c
+-          l = l-1
+-          m = m-1
+-c
+-c         Circle back to the end if required.
+-c
+-          if(l .eq. 0) l = 55
+-          if(m .eq. 0) m = 55
+-c
+-        enddo ! k
+-c
+-c
+-        return
+-c
+-c
+-c
+-        entry id_srandi(t)
+-c
+-c       initializes the seed values in s
+-c       (any appropriately random numbers will do).
+-c
+-c       input:
+-c       t -- values to copy into s
+-c
+-        do k = 1,55
+-          s(k) = t(k)
+-        enddo ! k
+-c
+-        l = 55
+-        m = 24
+-c
+-        return
+-c
+-c
+-c
+-        entry id_srando()
+-c
+-c       initializes the seed values in s to their original values.
+-c
+-        do k = 1,55
+-          s(k) = s0(k)
+-        enddo ! k
+-c
+-        l = 55
+-        m = 24
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine id_randperm(n,ind)
+-c
+-c       draws a permutation ind uniformly at random from the group
+-c       of all permutations of n objects.
+-c
+-c       input:
+-c       n -- length of ind
+-c
+-c       output:
+-c       ind -- random permutation of length n
+-c
+-        implicit none
+-        integer n,ind(n),m,j,iswap
+-        real*8 r
+-c
+-c
+-c       Initialize ind.
+-c
+-        do j = 1,n
+-          ind(j) = j
+-        enddo ! j
+-c
+-c
+-c       Shuffle ind via the Fisher-Yates (Knuth/Durstenfeld) algorithm.
+-c
+-        do m = n,2,-1
+-c
+-c         Draw an integer uniformly at random from 1, 2, ..., m.
+-c
+-          call id_srand(1,r)
+-          j = m*r+1
+-c
+-c         Uncomment the following line if r could equal 1:
+-c         if(j .eq. m+1) j = m
+-c
+-c         Swap ind(j) and ind(m).
+-c
+-          iswap = ind(j)
+-          ind(j) = ind(m)
+-          ind(m) = iswap
+-c
+-        enddo ! m
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/id_rtrans.f b/scipy/linalg/src/id_dist/src/id_rtrans.f
+deleted file mode 100644
+index a970d7fb5..000000000
+--- a/scipy/linalg/src/id_dist/src/id_rtrans.f
++++ /dev/null
+@@ -1,746 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_random_transf applies rapidly
+-c       a random orthogonal matrix to a user-supplied vector.
+-c
+-c       routine idd_random_transf_inverse applies rapidly
+-c       the inverse of the operator applied
+-c       by routine idd_random_transf.
+-c
+-c       routine idz_random_transf applies rapidly
+-c       a random unitary matrix to a user-supplied vector.
+-c
+-c       routine idz_random_transf_inverse applies rapidly
+-c       the inverse of the operator applied
+-c       by routine idz_random_transf.
+-c
+-c       routine idd_random_transf_init initializes data
+-c       for routines idd_random_transf and idd_random_transf_inverse.
+-c
+-c       routine idz_random_transf_init initializes data
+-c       for routines idz_random_transf and idz_random_transf_inverse.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf_init(nsteps,n,w,keep)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension w(*)
+-c
+-c       prepares and stores in array w the data used
+-c       by the routines idd_random_transf and idd_random_transf_inverse
+-c       to apply rapidly a random orthogonal matrix
+-c       to an arbitrary user-specified vector.
+-c
+-c       input:
+-c       nsteps -- the degree of randomness of the operator
+-c                 to be applied
+-c       n -- the size of the matrix to be applied
+-c
+-c       output:
+-c       w -- the first keep elements of w contain all the data
+-c            to be used by routines idd_random_tranf
+-c            and idd_random_transf_inverse. Please note that
+-c            the number of elements used by the present routine
+-c            is also equal to keep. This array should be at least
+-c            3*nsteps*n + 2*n + n/4 + 50 real*8 elements long.
+-c       keep - the number of elements in w actually used
+-c              by the present routine; keep is also the number
+-c              of elements that must not be changed between the call
+-c              to this routine and subsequent calls to routines
+-c              idd_random_transf and idd_random_transf_inverse.
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ninire=2
+-c
+-        ialbetas=10
+-        lalbetas=2*n*nsteps+10
+-c
+-        iixs=ialbetas+lalbetas
+-        lixs=n*nsteps/ninire+10
+-c
+-        iww=iixs+lixs
+-        lww=2*n+n/4+20
+-c
+-        keep=iww+lww
+-c
+-        w(1)=ialbetas+0.1
+-        w(2)=iixs+0.1
+-        w(3)=nsteps+0.1
+-        w(4)=iww+0.1
+-        w(5)=n+0.1
+-c
+-        call idd_random_transf_init0(nsteps,n,w(ialbetas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf_init(nsteps,n,w,keep)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension w(*)
+-c
+-c       prepares and stores in array w the data used
+-c       by routines idz_random_transf and idz_random_transf_inverse
+-c       to apply rapidly a random unitary matrix
+-c       to an arbitrary user-specified vector.
+-c
+-c       input:
+-c       nsteps -- the degree of randomness of the operator
+-c                 to be applied
+-c       n -- the size of the matrix to be applied
+-c
+-c       output:
+-c       w -- the first keep elements of w contain all the data
+-c            to be used by routines idz_random_transf
+-c            and idz_random_transf_inverse. Please note that
+-c            the number of elements used by the present routine
+-c            is also equal to keep. This array should be at least
+-c            5*nsteps*n + 2*n + n/4 + 60 real*8 elements long.
+-c       keep - the number of elements in w actually used
+-c              by the present routine; keep is also the number
+-c              of elements that must not be changed between the call
+-c              to this routine and subsequent calls to routines
+-c              idz_random_transf and idz_random_transf_inverse.
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ninire=2
+-c
+-        ialbetas=10
+-        lalbetas=2*n*nsteps+10
+-c
+-        igammas=ialbetas+lalbetas
+-        lgammas=2*n*nsteps+10
+-c
+-        iixs=igammas+lgammas
+-        lixs=n*nsteps/ninire+10
+-c
+-        iww=iixs+lixs
+-        lww=2*n+n/4+20
+-c
+-        keep=iww+lww
+-c
+-        w(1)=ialbetas+0.1
+-        w(2)=iixs+0.1
+-        w(3)=nsteps+0.1
+-        w(4)=iww+0.1
+-        w(5)=n+0.1
+-        w(6)=igammas+0.1
+-c
+-        call idz_random_transf_init0(nsteps,n,w(ialbetas),
+-     1      w(igammas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf(x,y,w)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),w(*)
+-c
+-c       applies rapidly a random orthogonal matrix
+-c       to the user-specified real vector x,
+-c       using the data in array w stored there by a preceding
+-c       call to routine idd_random_transf_init.
+-c
+-c       input:
+-c       x -- the vector of length n to which the random matrix is
+-c            to be applied
+-c       w -- array containing all initialization data
+-c
+-c       output:
+-c       y -- the result of applying the random matrix to x
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ialbetas=w(1)
+-        iixs=w(2)
+-        nsteps=w(3)
+-        iww=w(4)
+-        n=w(5)
+-c
+-        call idd_random_transf0(nsteps,x,y,n,w(iww),
+-     1      w(ialbetas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf_inverse(x,y,w)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),w(*)
+-c
+-c       applies rapidly a random orthogonal matrix
+-c       to the user-specified real vector x,
+-c       using the data in array w stored there by a preceding
+-c       call to routine idd_random_transf_init.
+-c       The transformation applied by the present routine is
+-c       the inverse of the transformation applied
+-c       by routine idd_random_transf.
+-c
+-c       input:
+-c       x -- the vector of length n to which the random matrix is
+-c            to be applied
+-c       w -- array containing all initialization data
+-c
+-c       output:
+-c       y -- the result of applying the random matrix to x
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ialbetas=w(1)
+-        iixs=w(2)
+-        nsteps=w(3)
+-        iww=w(4)
+-        n=w(5)
+-c
+-        call idd_random_transf0_inv(nsteps,x,y,n,w(iww),
+-     1      w(ialbetas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf(x,y,w)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*)
+-        dimension w(*)
+-c
+-c       applies rapidly a random unitary matrix
+-c       to the user-specified vector x,
+-c       using the data in array w stored there by a preceding
+-c       call to routine idz_random_transf_init.
+-c
+-c       input:
+-c       x -- the vector of length n to which the random matrix is
+-c            to be applied
+-c       w -- array containing all initialization data
+-c
+-c       output:
+-c       y -- the result of applying the random matrix to x
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ialbetas=w(1)
+-        iixs=w(2)
+-        nsteps=w(3)
+-        iww=w(4)
+-        n=w(5)
+-        igammas=w(6)
+-c
+-        call idz_random_transf0(nsteps,x,y,n,w(iww),w(ialbetas),
+-     1      w(igammas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf_inverse(x,y,w)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*)
+-        dimension w(*)
+-c
+-c       applies rapidly a random unitary matrix
+-c       to the user-specified vector x,
+-c       using the data in array w stored there by a preceding
+-c       call to routine idz_random_transf_init.
+-c       The transformation applied by the present routine is
+-c       the inverse of the transformation applied
+-c       by routine idz_random_transf.
+-c
+-c       input:
+-c       x -- the vector of length n to which the random matrix is
+-c            to be applied
+-c       w -- array containing all initialization data
+-c
+-c       output:
+-c       y -- the result of applying the random matrix to x
+-c
+-c
+-c        . . . allocate memory
+-c
+-        ialbetas=w(1)
+-        iixs=w(2)
+-        nsteps=w(3)
+-        iww=w(4)
+-        n=w(5)
+-        igammas=w(6)
+-c
+-        call idz_random_transf0_inv(nsteps,x,y,n,w(iww),
+-     1      w(ialbetas),w(igammas),w(iixs))
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf0_inv(nsteps,x,y,n,w2,albetas,iixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),w2(*),albetas(2,n,*),iixs(n,*)
+-c
+-c       routine idd_random_transf_inverse serves as a memory wrapper
+-c       for the present routine; see routine idd_random_transf_inverse
+-c       for documentation.
+-c
+-        do 1200 i=1,n
+-c
+-        w2(i)=x(i)
+- 1200 continue
+-c
+-        do 2000 ijk=nsteps,1,-1
+-c
+-        call idd_random_transf00_inv(w2,y,n,albetas(1,1,ijk),
+-     1      iixs(1,ijk) )
+-c
+-        do 1400 j=1,n
+-c
+-        w2(j)=y(j)
+- 1400 continue
+- 2000 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf00_inv(x,y,n,albetas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),albetas(2,*),ixs(*)
+-c
+-c       implements one step of the random transform required
+-c       by routine idd_random_transf0_inv (please see the latter).
+-c
+-c
+-c        implement 2 \times 2 matrices
+-c
+-        do 1600 i=1,n
+-        y(i)=x(i)
+- 1600 continue
+-c
+-        do 1800 i=n-1,1,-1
+-c
+-        alpha=albetas(1,i)
+-        beta=albetas(2,i)
+-c
+-        a=y(i)
+-        b=y(i+1)
+-c
+-        y(i)=alpha*a-beta*b
+-        y(i+1)=beta*a+alpha*b
+- 1800 continue
+-c
+-c        implement the permutation
+-c
+-        do 2600 i=1,n
+-c
+-        j=ixs(i)
+-        x(j)=y(i)
+- 2600 continue
+-c
+-        do 2800 i=1,n
+-c
+-        y(i)=x(i)
+- 2800 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf0_inv(nsteps,x,y,n,w2,albetas,
+-     1      gammas,iixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*),w2(*),gammas(n,*)
+-        dimension albetas(2,n,*),iixs(n,*)
+-c
+-c       routine idz_random_transf_inverse serves as a memory wrapper
+-c       for the present routine; please see routine
+-c       idz_random_transf_inverse for documentation.
+-c
+-        do 1200 i=1,n
+-c
+-        w2(i)=x(i)
+- 1200 continue
+-c
+-        do 2000 ijk=nsteps,1,-1
+-c
+-        call idz_random_transf00_inv(w2,y,n,albetas(1,1,ijk),
+-     1      gammas(1,ijk),iixs(1,ijk) )
+-c
+-        do 1400 j=1,n
+-c
+-        w2(j)=y(j)
+- 1400 continue
+- 2000 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf00_inv(x,y,n,albetas,gammas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*),gammas(*),a,b
+-        dimension albetas(2,*),ixs(*)
+-c
+-c       implements one step of the random transform
+-c       required by routine idz_random_transf0_inv
+-c       (please see the latter).
+-c
+-c        implement 2 \times 2 matrices
+-c
+-        do 1600 i=n-1,1,-1
+-c
+-        alpha=albetas(1,i)
+-        beta=albetas(2,i)
+-c
+-        a=x(i)
+-        b=x(i+1)
+-c
+-        x(i)=alpha*a-beta*b
+-        x(i+1)=beta*a+alpha*b
+- 1600 continue
+-c
+-c        implement the permutation
+-c        and divide by the random numbers on the unit circle
+-c        (or, equivalently, multiply by their conjugates)
+-c
+-        do 1800 i=1,n
+-c
+-        j=ixs(i)
+-        y(j)=x(i)*conjg(gammas(i))
+- 1800 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf0(nsteps,x,y,n,w2,albetas,iixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),w2(*),albetas(2,n,*),iixs(n,*)
+-c
+-c       routine idd_random_transf serves as a memory wrapper
+-c       for the present routine; please see routine idd_random_transf
+-c       for documentation.
+-c
+-        do 1200 i=1,n
+-c
+-        w2(i)=x(i)
+- 1200 continue
+-c
+-        do 2000 ijk=1,nsteps
+-c
+-        call idd_random_transf00(w2,y,n,albetas(1,1,ijk),iixs(1,ijk) )
+-c
+-        do 1400 j=1,n
+-c
+-        w2(j)=y(j)
+- 1400 continue
+- 2000 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf00(x,y,n,albetas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension x(*),y(*),albetas(2,*),ixs(*)
+-c
+-c       implements one step of the random transform
+-c       required by routine idd_random_transf0 (please see the latter).
+-c
+-c        implement the permutation
+-c
+-        do 1600 i=1,n
+-c
+-        j=ixs(i)
+-        y(i)=x(j)
+- 1600 continue
+-c
+-c        implement 2 \times 2 matrices
+-c
+-        do 1800 i=1,n-1
+-c
+-        alpha=albetas(1,i)
+-        beta=albetas(2,i)
+-c
+-        a=y(i)
+-        b=y(i+1)
+-c
+-        y(i)=alpha*a+beta*b
+-        y(i+1)=-beta*a+alpha*b
+- 1800 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf_init0(nsteps,n,albetas,gammas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension albetas(2,n,*),ixs(n,*)
+-        complex *16 gammas(n,*)
+-c
+-c       routine idz_random_transf_init serves as a memory wrapper
+-c       for the present routine; please see routine
+-c       idz_random_transf_init for documentation.
+-c
+-        do 2000 ijk=1,nsteps
+-c
+-        call idz_random_transf_init00(n,albetas(1,1,ijk),
+-     1      gammas(1,ijk),ixs(1,ijk) )
+- 2000 continue
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf_init00(n,albetas,gammas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension albetas(2,*),gammas(*),ixs(*)
+-c
+-c       constructs one stage of the random transform
+-c       initialized by routine idz_random_transf_init0
+-c       (please see the latter).
+-c
+-        done=1
+-        twopi=2*4*atan(done)
+-c
+-c        construct the random permutation
+-c
+-        ifrepeat=0
+-        call id_randperm(n,ixs)
+-c
+-c        construct the random variables
+-c
+-        call id_srand(2*n,albetas)
+-        call id_srand(2*n,gammas)
+-c
+-        do 1300 i=1,n
+-c
+-        albetas(1,i)=2*albetas(1,i)-1
+-        albetas(2,i)=2*albetas(2,i)-1
+-        gammas(2*i-1)=2*gammas(2*i-1)-1
+-        gammas(2*i)=2*gammas(2*i)-1
+- 1300 continue
+-c
+-c        construct the random 2 \times 2 transformations
+-c
+-        do 1400 i=1,n
+-c
+-        d=albetas(1,i)**2+albetas(2,i)**2
+-        d=1/sqrt(d)
+-        albetas(1,i)=albetas(1,i)*d
+-        albetas(2,i)=albetas(2,i)*d
+- 1400 continue
+-c
+-c        construct the random multipliers on the unit circle
+-c
+-        do 1500 i=1,n
+-c
+-        d=gammas(2*i-1)**2+gammas(2*i)**2
+-        d=1/sqrt(d)
+-c
+-c        fill the real part
+-c
+-        gammas(2*i-1)=gammas(2*i-1)*d
+-c
+-c        fill the imaginary part
+-c
+-        gammas(2*i)=gammas(2*i)*d
+- 1500 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf0(nsteps,x,y,n,w2,albetas,
+-     1      gammas,iixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*),w2(*),gammas(n,*)
+-        dimension albetas(2,n,*),iixs(n,*)
+-c
+-c       routine idz_random_transf serves as a memory wrapper
+-c       for the present routine; please see routine idz_random_transf
+-c       for documentation.
+-c
+-        do 1200 i=1,n
+-c
+-        w2(i)=x(i)
+- 1200 continue
+-c
+-        do 2000 ijk=1,nsteps
+-c
+-        call idz_random_transf00(w2,y,n,albetas(1,1,ijk),
+-     1      gammas(1,ijk),iixs(1,ijk) )
+-        do 1400 j=1,n
+-c
+-        w2(j)=y(j)
+- 1400 continue
+- 2000 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idz_random_transf00(x,y,n,albetas,gammas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        complex *16 x(*),y(*),gammas(*),a,b
+-        dimension albetas(2,*),ixs(*)
+-c
+-c       implements one step of the random transform
+-c       required by routine idz_random_transf0 (please see the latter).
+-c
+-c        implement the permutation
+-c        and multiply by the random numbers
+-c        on the unit circle
+-c
+-        do 1600 i=1,n
+-c
+-        j=ixs(i)
+-        y(i)=x(j)*gammas(i)
+- 1600 continue
+-c
+-c        implement 2 \times 2 matrices
+-c
+-        do 2600 i=1,n-1
+-c
+-        alpha=albetas(1,i)
+-        beta=albetas(2,i)
+-c
+-        a=y(i)
+-        b=y(i+1)
+-c
+-        y(i)=alpha*a+beta*b
+-        y(i+1)=-beta*a+alpha*b
+- 2600 continue
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf_init0(nsteps,n,albetas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension albetas(2,n,*),ixs(n,*)
+-c
+-c       routine idd_random_transf_init serves as a memory wrapper
+-c       for the present routine; please see routine
+-c       idd_random_transf_init for documentation.
+-c
+-        do 2000 ijk=1,nsteps
+-c
+-        call idd_random_transf_init00(n,albetas(1,1,ijk),ixs(1,ijk) )
+- 2000 continue
+-        return
+-        end
+-c
+-c
+-c
+-c
+-c
+-        subroutine idd_random_transf_init00(n,albetas,ixs)
+-        implicit real *8 (a-h,o-z)
+-        save
+-        dimension albetas(2,*),ixs(*)
+-c
+-c       constructs one stage of the random transform
+-c       initialized by routine idd_random_transf_init0
+-c       (please see the latter).
+-c
+-c        construct the random permutation
+-c
+-        ifrepeat=0
+-        call id_randperm(n,ixs)
+-c
+-c        construct the random variables
+-c
+-        call id_srand(2*n,albetas)
+-c
+-        do 1300 i=1,n
+-c
+-        albetas(1,i)=2*albetas(1,i)-1
+-        albetas(2,i)=2*albetas(2,i)-1
+- 1300 continue
+-c
+-c        construct the random 2 \times 2 transformations
+-c
+-        do 1400 i=1,n
+-c
+-        d=albetas(1,i)**2+albetas(2,i)**2
+-        d=1/sqrt(d)
+-        albetas(1,i)=albetas(1,i)*d
+-        albetas(2,i)=albetas(2,i)*d
+- 1400 continue
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_frm.f b/scipy/linalg/src/id_dist/src/idd_frm.f
+deleted file mode 100644
+index 0a13112eb..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_frm.f
++++ /dev/null
+@@ -1,525 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_frm transforms a vector via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c
+-c       routine idd_sfrm transforms a vector into a vector
+-c       of specified length via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c
+-c       routine idd_frmi initializes routine idd_frm.
+-c
+-c       routine idd_sfrmi initializes routine idd_sfrm.
+-c
+-c       routine idd_pairsamps calculates the indices of the pairs
+-c       of integers to which the individual integers
+-c       in a specified set belong.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idd_frm(m,n,w,x,y)
+-c
+-c       transforms x into y via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c       In contrast to routine idd_sfrm, the present routine works best
+-c       when the length of the transformed vector is the integer n
+-c       output by routine idd_frmi, or when the length
+-c       is not specified, but instead determined a posteriori
+-c       using the output of the present routine. The transformed vector
+-c       output by the present routine is randomly permuted.
+-c
+-c       input:
+-c       m -- length of x
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m, as obtained
+-c            from the routine idd_frmi; n is the length of y
+-c       w -- initialization array constructed by routine idd_frmi
+-c       x -- vector to be transformed
+-c
+-c       output:
+-c       y -- transform of x
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,iw,n,k
+-        real*8 w(17*m+70),x(m),y(n)
+-c
+-c
+-c       Apply Rokhlin's random transformation to x, obtaining
+-c       w(16*m+71 : 17*m+70).
+-c
+-        iw = w(3+m+n)
+-        call idd_random_transf(x,w(16*m+70+1),w(iw))
+-c
+-c
+-c       Subselect from  w(16*m+71 : 17*m+70)  to obtain y.
+-c
+-        call idd_subselect(n,w(3),m,w(16*m+70+1),y)
+-c
+-c
+-c       Copy y into  w(16*m+71 : 16*m+n+70).
+-c
+-        do k = 1,n
+-          w(16*m+70+k) = y(k)
+-        enddo ! k
+-c
+-c
+-c       Fourier transform  w(16*m+71 : 16*m+n+70).
+-c
+-        call dfftf(n,w(16*m+70+1),w(4+m+n))
+-c
+-c
+-c       Permute  w(16*m+71 : 16*m+n+70)  to obtain y.
+-c
+-        call idd_permute(n,w(3+m),w(16*m+70+1),y)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sfrm(l,m,n,w,x,y)
+-c
+-c       transforms x into y via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c       In contrast to routine idd_frm, the present routine works best
+-c       when the length l of the transformed vector is known a priori.
+-c
+-c       input:
+-c       l -- length of y; l must be less than or equal to n
+-c       m -- length of x
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m, as obtained
+-c            from the routine idd_sfrmi
+-c       w -- initialization array constructed by routine idd_sfrmi
+-c       x -- vector to be transformed
+-c
+-c       output:
+-c       y -- transform of x
+-c
+-c       _N.B._: l must be less than or equal to n.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,iw,n,l,l2
+-        real*8 w(27*m+90),x(m),y(l)
+-c
+-c
+-c       Retrieve the number of pairs of outputs to be calculated
+-c       via sfft.
+-c
+-        l2 = w(3)
+-c
+-c
+-c       Apply Rokhlin's random transformation to x, obtaining
+-c       w(25*m+91 : 26*m+90).
+-c
+-        iw = w(4+m+l+l2)
+-        call idd_random_transf(x,w(25*m+90+1),w(iw))
+-c
+-c
+-c       Subselect from  w(25*m+91 : 26*m+90)  to obtain
+-c       w(26*m+91 : 26*m+n+90).
+-c
+-        call idd_subselect(n,w(4),m,w(25*m+90+1),w(26*m+90+1))
+-c
+-c
+-c       Fourier transform  w(26*m+91 : 26*m+n+90).
+-c
+-        call idd_sfft(l2,w(4+m+l),n,w(5+m+l+l2),w(26*m+90+1))
+-c
+-c
+-c       Copy the desired entries from  w(26*m+91 : 26*m+n+90)
+-c       to y.
+-c
+-        call idd_subselect(l,w(4+m),n,w(26*m+90+1),y)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_pairsamps(n,l,ind,l2,ind2,marker)
+-c
+-c       calculates the indices of the l2 pairs of integers
+-c       to which the l individual integers from ind belong.
+-c       The integers in ind may range from 1 to n.
+-c
+-c       input:
+-c       n -- upper bound on the integers in ind
+-c            (the number 1 must be a lower bound);
+-c            n must be even
+-c       l -- length of ind
+-c       ind -- integers selected from 1 to n
+-c
+-c       output:
+-c       l2 -- length of ind2
+-c       ind2 -- indices in the range from 1 to n/2 of the pairs
+-c               of integers to which the entries of ind belong
+-c
+-c       work:
+-c       marker -- must be at least n/2 integer elements long
+-c
+-c       _N.B._: n must be even.
+-c
+-        implicit none
+-        integer l,n,ind(l),ind2(l),marker(n/2),l2,k
+-c
+-c
+-c       Unmark all pairs.
+-c
+-        do k = 1,n/2
+-          marker(k) = 0
+-        enddo ! k
+-c
+-c
+-c       Mark the required pairs.
+-c
+-        do k = 1,l
+-          marker((ind(k)+1)/2) = marker((ind(k)+1)/2)+1
+-        enddo ! k
+-c
+-c
+-c       Record the required pairs in indpair.
+-c
+-        l2 = 0
+-c
+-        do k = 1,n/2
+-c
+-          if(marker(k) .ne. 0) then
+-            l2 = l2+1
+-            ind2(l2) = k
+-          endif
+-c
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_permute(n,ind,x,y)
+-c
+-c       copy the entries of x into y, rearranged according
+-c       to the permutation specified by ind.
+-c
+-c       input:
+-c       n -- length of ind, x, and y
+-c       ind -- permutation of n objects
+-c       x -- vector to be permuted
+-c
+-c       output:
+-c       y -- permutation of x
+-c
+-        implicit none
+-        integer n,ind(n),k
+-        real*8 x(n),y(n)
+-c
+-c
+-        do k = 1,n
+-          y(k) = x(ind(k))
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_subselect(n,ind,m,x,y)
+-c
+-c       copies into y the entries of x indicated by ind.
+-c
+-c       input:
+-c       n -- number of entries of x to copy into y
+-c       ind -- indices of the entries in x to copy into y
+-c       m -- length of x
+-c       x -- vector whose entries are to be copied
+-c
+-c       output:
+-c       y -- collection of entries of x specified by ind
+-c
+-        implicit none
+-        integer n,ind(n),m,k
+-        real*8 x(m),y(n)
+-c
+-c
+-        do k = 1,n
+-          y(k) = x(ind(k))
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_frmi(m,n,w)
+-c
+-c       initializes data for the routine idd_frm.
+-c
+-c       input:
+-c       m -- length of the vector to be transformed
+-c
+-c       output:
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m
+-c       w -- initialization array to be used by routine idd_frm
+-c
+-c
+-c       glossary for the fully initialized w:
+-c
+-c       w(1) = m
+-c       w(2) = n
+-c       w(3:2+m) stores a permutation of m objects
+-c       w(3+m:2+m+n) stores a permutation of n objects
+-c       w(3+m+n) = address in w of the initialization array
+-c                  for idd_random_transf
+-c       w(4+m+n:int(w(3+m+n))-1) stores the initialization array
+-c                                for dfft
+-c       w(int(w(3+m+n)):16*m+70) stores the initialization array
+-c                                for idd_random_transf
+-c
+-c
+-c       _N.B._: n is an output of the present routine;
+-c               this routine changes n.
+-c
+-c
+-        implicit none
+-        integer m,n,l,nsteps,keep,lw,ia
+-        real*8 w(17*m+70)
+-c
+-c
+-c       Find the greatest integer less than or equal to m
+-c       which is a power of two.
+-c
+-        call idd_poweroftwo(m,l,n)
+-c
+-c
+-c       Store m and n in w.
+-c
+-        w(1) = m
+-        w(2) = n
+-c
+-c
+-c       Store random permutations of m and n objects in w.
+-c
+-        call id_randperm(m,w(3))
+-        call id_randperm(n,w(3+m))
+-c
+-c
+-c       Store the address within w of the idd_random_transf_init
+-c       initialization data.
+-c
+-        ia = 4+m+n+2*n+15
+-        w(3+m+n) = ia
+-c
+-c
+-c       Store the initialization data for dfft in w.
+-c
+-        call dffti(n,w(4+m+n))
+-c
+-c
+-c       Store the initialization data for idd_random_transf_init in w.
+-c
+-        nsteps = 3
+-        call idd_random_transf_init(nsteps,m,w(ia),keep)
+-c
+-c
+-c       Calculate the total number of elements used in w.
+-c
+-        lw = 3+m+n+2*n+15 + 3*nsteps*m+2*m+m/4+50
+-c
+-        if(16*m+70 .lt. lw) then
+-          call prinf('lw = *',lw,1)
+-          call prinf('16m+70 = *',16*m+70,1)
+-          stop
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sfrmi(l,m,n,w)
+-c
+-c       initializes data for the routine idd_sfrm.
+-c
+-c       input:
+-c       l -- length of the transformed (output) vector
+-c       m -- length of the vector to be transformed
+-c
+-c       output:
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m
+-c       w -- initialization array to be used by routine idd_sfrm
+-c
+-c
+-c       glossary for the fully initialized w:
+-c
+-c       w(1) = m
+-c       w(2) = n
+-c       w(3) = l2
+-c       w(4:3+m) stores a permutation of m objects
+-c       w(4+m:3+m+l) stores the indices of the l outputs which idd_sfft
+-c                    calculates
+-c       w(4+m+l:3+m+l+l2) stores the indices of the l2 pairs of outputs
+-c                         which idd_sfft calculates
+-c       w(4+m+l+l2) = address in w of the initialization array
+-c                     for idd_random_transf
+-c       w(5+m+l+l2:int(w(4+m+l+l2))-1) stores the initialization array
+-c                                      for idd_sfft
+-c       w(int(w(4+m+l+l2)):25*m+90) stores the initialization array
+-c                                   for idd_random_transf
+-c
+-c
+-c       _N.B._: n is an output of the present routine;
+-c               this routine changes n.
+-c
+-c
+-        implicit none
+-        integer l,m,n,idummy,nsteps,keep,lw,l2,ia
+-        real*8 w(27*m+90)
+-c
+-c
+-c       Find the greatest integer less than or equal to m
+-c       which is a power of two.
+-c
+-        call idd_poweroftwo(m,idummy,n)
+-c
+-c
+-c       Store m and n in w.
+-c
+-        w(1) = m
+-        w(2) = n
+-c
+-c
+-c       Store random permutations of m and n objects in w.
+-c
+-        call id_randperm(m,w(4))
+-        call id_randperm(n,w(4+m))
+-c
+-c
+-c       Find the pairs of integers covering the integers in
+-c       w(4+m : 3+m+(l+1)/2).
+-c
+-        call idd_pairsamps(n,l,w(4+m),l2,w(4+m+2*l),w(4+m+3*l))
+-        w(3) = l2
+-        call idd_copyints(l2,w(4+m+2*l),w(4+m+l))
+-c
+-c
+-c       Store the address within w of the idd_random_transf_init
+-c       initialization data.
+-c
+-        ia = 5+m+l+l2+4*l2+30+8*n
+-        w(4+m+l+l2) = ia
+-c
+-c
+-c       Store the initialization data for idd_sfft in w.
+-c
+-        call idd_sffti(l2,w(4+m+l),n,w(5+m+l+l2))
+-c
+-c
+-c       Store the initialization data for idd_random_transf_init in w.
+-c
+-        nsteps = 3
+-        call idd_random_transf_init(nsteps,m,w(ia),keep)
+-c
+-c
+-c       Calculate the total number of elements used in w.
+-c
+-        lw = 4+m+l+l2+4*l2+30+8*n + 3*nsteps*m+2*m+m/4+50
+-c
+-        if(25*m+90 .lt. lw) then
+-          call prinf('lw = *',lw,1)
+-          call prinf('25m+90 = *',25*m+90,1)
+-          stop
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_copyints(n,ia,ib)
+-c
+-c       copies ia into ib.
+-c
+-c       input:
+-c       n -- length of ia and ib
+-c       ia -- array to be copied
+-c
+-c       output:
+-c       ib -- copy of ia
+-c
+-        implicit none
+-        integer n,ia(n),ib(n),k
+-c
+-c
+-        do k = 1,n
+-          ib(k) = ia(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_poweroftwo(m,l,n)
+-c
+-c       computes l = floor(log_2(m)) and n = 2**l.
+-c
+-c       input:
+-c       m -- integer whose log_2 is to be taken
+-c
+-c       output:
+-c       l -- floor(log_2(m))
+-c       n -- 2**l
+-c
+-        implicit none
+-        integer l,m,n
+-c
+-c
+-        l = 0
+-        n = 1
+-c
+- 1000   continue
+-          l = l+1
+-          n = n*2
+-        if(n .le. m) goto 1000
+-c
+-        l = l-1
+-        n = n/2
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_house.f b/scipy/linalg/src/id_dist/src/idd_house.f
+deleted file mode 100644
+index 715037117..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_house.f
++++ /dev/null
+@@ -1,288 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_house calculates the vector and scalar
+-c       needed to apply the Householder transformation reflecting
+-c       a given vector into its first component.
+-c
+-c       routine idd_houseapp applies a Householder matrix to a vector.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idd_houseapp(n,vn,u,ifrescal,scal,v)
+-c
+-c       applies the Householder matrix
+-c       identity_matrix - scal * vn * transpose(vn)
+-c       to the vector u, yielding the vector v;
+-c
+-c       scal = 2/(1 + vn(2)^2 + ... + vn(n)^2)
+-c       when vn(2), ..., vn(n) don't all vanish;
+-c
+-c       scal = 0
+-c       when vn(2), ..., vn(n) do all vanish
+-c       (including when n = 1).
+-c
+-c       input:
+-c       n -- size of vn, u, and v, though the indexing on vn goes
+-c            from 2 to n
+-c       vn -- components 2 to n of the Householder vector vn;
+-c             vn(1) is assumed to be 1
+-c       u -- vector to be transformed
+-c       ifrescal -- set to 1 to recompute scal from vn(2), ..., vn(n);
+-c                   set to 0 to use scal as input
+-c       scal -- see the entry for ifrescal in the decription
+-c               of the input
+-c
+-c       output:
+-c       scal -- see the entry for ifrescal in the decription
+-c               of the input
+-c       v -- result of applying the Householder matrix to u;
+-c            it's O.K. to have v be the same as u
+-c            in order to apply the matrix to the vector in place
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        save
+-        integer n,k,ifrescal
+-        real*8 vn(2:*),scal,u(n),v(n),fact,sum
+-c
+-c
+-c       Get out of this routine if n = 1.
+-c
+-        if(n .eq. 1) then
+-          v(1) = u(1)
+-          return
+-        endif
+-c
+-c
+-        if(ifrescal .eq. 1) then
+-c
+-c
+-c         Calculate (vn(2))^2 + ... + (vn(n))^2.
+-c
+-          sum = 0
+-          do k = 2,n
+-            sum = sum+vn(k)**2
+-          enddo ! k
+-c
+-c
+-c         Calculate scal.
+-c
+-          if(sum .eq. 0) scal = 0
+-          if(sum .ne. 0) scal = 2/(1+sum)
+-c
+-c
+-        endif
+-c
+-c
+-c       Calculate fact = scal * transpose(vn) * u.
+-c
+-        fact = u(1)
+-c
+-        do k = 2,n
+-          fact = fact+vn(k)*u(k)
+-        enddo ! k
+-c
+-        fact = fact*scal
+-c
+-c
+-c       Subtract fact*vn from u, yielding v.
+-c
+-        v(1) = u(1) - fact
+-c
+-        do k = 2,n
+-          v(k) = u(k) - fact*vn(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_house(n,x,rss,vn,scal)
+-c
+-c       constructs the vector vn with vn(1) = 1
+-c       and the scalar scal such that
+-c       H := identity_matrix - scal * vn * transpose(vn) is orthogonal
+-c       and Hx = +/- e_1 * the root-sum-square of the entries of x
+-c       (H is the Householder matrix corresponding to x).
+-c
+-c       input:
+-c       n -- size of x and vn, though the indexing on vn goes
+-c            from 2 to n
+-c       x -- vector to reflect into its first component
+-c
+-c       output:
+-c       rss -- first entry of the vector resulting from the application
+-c              of the Householder matrix to x;
+-c              its absolute value is the root-sum-square
+-c              of the entries of x
+-c       vn -- entries 2 to n of the Householder vector vn;
+-c             vn(1) is assumed to be 1
+-c       scal -- scalar multiplying vn * transpose(vn);
+-c
+-c               scal = 2/(1 + vn(2)^2 + ... + vn(n)^2)
+-c               when vn(2), ..., vn(n) don't all vanish;
+-c
+-c               scal = 0
+-c               when vn(2), ..., vn(n) do all vanish
+-c               (including when n = 1)
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        save
+-        integer n,k
+-        real*8 x(n),rss,sum,v1,scal,vn(2:*),x1
+-c
+-c
+-        x1 = x(1)
+-c
+-c
+-c       Get out of this routine if n = 1.
+-c
+-        if(n .eq. 1) then
+-          rss = x1
+-          scal = 0
+-          return
+-        endif
+-c
+-c
+-c       Calculate (x(2))^2 + ... (x(n))^2
+-c       and the root-sum-square value of the entries in x.
+-c
+-c
+-        sum = 0
+-        do k = 2,n
+-          sum = sum+x(k)**2
+-        enddo ! k
+-c
+-c
+-c       Get out of this routine if sum = 0;
+-c       flag this case as such by setting v(2), ..., v(n) all to 0.
+-c
+-        if(sum .eq. 0) then
+-c
+-          rss = x1
+-          do k = 2,n
+-            vn(k) = 0
+-          enddo ! k
+-          scal = 0
+-c
+-          return
+-c
+-        endif
+-c
+-c
+-        rss = x1**2 + sum
+-        rss = sqrt(rss)
+-c
+-c
+-c       Determine the first component v1
+-c       of the unnormalized Householder vector
+-c       v = x - rss * (1 0 0 ... 0 0)^T.
+-c
+-c       If x1 <= 0, then form x1-rss directly,
+-c       since that expression cannot involve any cancellation.
+-c
+-        if(x1 .le. 0) v1 = x1-rss
+-c
+-c       If x1 > 0, then use the fact that
+-c       x1-rss = -sum / (x1+rss),
+-c       in order to avoid potential cancellation.
+-c
+-        if(x1 .gt. 0) v1 = -sum / (x1+rss)
+-c
+-c
+-c       Compute the vector vn and the scalar scal such that vn(1) = 1
+-c       in the Householder transformation
+-c       identity_matrix - scal * vn * transpose(vn).
+-c
+-        do k = 2,n
+-          vn(k) = x(k)/v1
+-        enddo ! k
+-c
+-c       scal = 2
+-c            / ( vn(1)^2 + vn(2)^2 + ... + vn(n)^2 )
+-c
+-c            = 2
+-c            / ( 1 + vn(2)^2 + ... + vn(n)^2 )
+-c
+-c            = 2*v(1)^2
+-c            / ( v(1)^2 + (v(1)*vn(2))^2 + ... + (v(1)*vn(n))^2 )
+-c
+-c            = 2*v(1)^2
+-c            / ( v(1)^2 + (v(2)^2 + ... + v(n)^2) )
+-c
+-        scal = 2*v1**2 / (v1**2+sum)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_housemat(n,vn,scal,h)
+-c
+-c       fills h with the Householder matrix
+-c       identity_matrix - scal * vn * transpose(vn).
+-c
+-c       input:
+-c       n -- size of vn and h, though the indexing of vn goes
+-c            from 2 to n
+-c       vn -- entries 2 to n of the vector vn;
+-c             vn(1) is assumed to be 1
+-c       scal -- scalar multiplying vn * transpose(vn)
+-c
+-c       output:
+-c       h -- identity_matrix - scal * vn * transpose(vn)
+-c
+-        implicit none
+-        save
+-        integer n,j,k
+-        real*8 vn(2:*),h(n,n),scal,factor1,factor2
+-c
+-c
+-c       Fill h with the identity matrix.
+-c
+-        do j = 1,n
+-          do k = 1,n
+-c
+-            if(j .eq. k) h(k,j) = 1
+-            if(j .ne. k) h(k,j) = 0
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-c       Subtract from h the matrix scal*vn*transpose(vn).
+-c
+-        do j = 1,n
+-          do k = 1,n
+-c
+-            if(j .eq. 1) factor1 = 1
+-            if(j .ne. 1) factor1 = vn(j)
+-c
+-            if(k .eq. 1) factor2 = 1
+-            if(k .ne. 1) factor2 = vn(k)
+-c
+-            h(k,j) = h(k,j) - scal*factor1*factor2
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_id.f b/scipy/linalg/src/id_dist/src/idd_id.f
+deleted file mode 100644
+index 640ff455b..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_id.f
++++ /dev/null
+@@ -1,560 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_id computes the ID of a matrix,
+-c       to a specified precision.
+-c
+-c       routine iddr_id computes the ID of a matrix,
+-c       to a specified rank.
+-c
+-c       routine idd_reconid reconstructs a matrix from its ID.
+-c
+-c       routine idd_copycols collects together selected columns
+-c       of a matrix.
+-c
+-c       routine idd_getcols collects together selected columns
+-c       of a matrix specified by a routine for applying the matrix
+-c       to arbitrary vectors.
+-c
+-c       routine idd_reconint constructs p in the ID a = b p,
+-c       where the columns of b are a subset of the columns of a,
+-c       and p is the projection coefficient matrix,
+-c       given list, krank, and proj output by routines iddr_id
+-c       or iddp_id.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddp_id(eps,m,n,a,krank,list,rnorms)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c       The present routine stores the krank x (n-krank) matrix proj
+-c       in the memory initially occupied by a.
+-c
+-c       input:
+-c       eps -- relative precision of the resulting ID
+-c       m -- first dimension of a
+-c       n -- second dimension of a, as well as the dimension required
+-c            of list
+-c       a -- matrix to be ID'd
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) interpolation matrix proj
+-c       krank -- numerical rank
+-c       list -- list of the indices of the krank columns of a
+-c               through which the other columns of a are expressed;
+-c               also, list describes the permutation of proj
+-c               required to reconstruct a as indicated in (*) above
+-c       rnorms -- absolute values of the entries on the diagonal
+-c                 of the triangular matrix used to compute the ID
+-c                 (these may be used to check the stability of the ID)
+-c
+-c       _N.B._: This routine changes a.
+-c
+-c       reference:
+-c       Cheng, Gimbutas, Martinsson, Rokhlin, "On the compression of
+-c            low-rank matrices," SIAM Journal on Scientific Computing,
+-c            26 (4): 1389-1404, 2005.
+-c
+-        implicit none
+-        integer m,n,krank,k,list(n),iswap
+-        real*8 a(m,n),eps,rnorms(n)
+-c
+-c
+-c       QR decompose a.
+-c
+-        call iddp_qrpiv(eps,m,n,a,krank,list,rnorms)
+-c
+-c
+-c       Build the list of columns chosen in a
+-c       by multiplying together the permutations in list,
+-c       with the permutation swapping 1 and list(1) taken rightmost
+-c       in the product, that swapping 2 and list(2) taken next
+-c       rightmost, ..., that swapping krank and list(krank) taken
+-c       leftmost.
+-c
+-        do k = 1,n
+-          rnorms(k) = k
+-        enddo ! k
+-c
+-        if(krank .gt. 0) then
+-          do k = 1,krank
+-c
+-c           Swap rnorms(k) and rnorms(list(k)).
+-c
+-            iswap = rnorms(k)
+-            rnorms(k) = rnorms(list(k))
+-            rnorms(list(k)) = iswap
+-c
+-          enddo ! k
+-        endif
+-c
+-        do k = 1,n
+-          list(k) = rnorms(k)
+-        enddo ! k
+-c
+-c
+-c       Fill rnorms for the output.
+-c
+-        if(krank .gt. 0) then
+-c
+-          do k = 1,krank
+-            rnorms(k) = a(k,k)
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-c       Backsolve for proj, storing it at the beginning of a.
+-c
+-        if(krank .gt. 0) then
+-          call idd_lssolve(m,n,a,krank)
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_id(m,n,a,krank,list,rnorms)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c       The present routine stores the krank x (n-krank) matrix proj
+-c       in the memory initially occupied by a.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a, as well as the dimension required
+-c            of list
+-c       a -- matrix to be ID'd
+-c       krank -- desired rank of the output matrix
+-c                (please note that if krank > m or krank > n,
+-c                then the rank of the output matrix will be
+-c                less than krank)
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) interpolation matrix proj
+-c       list -- list of the indices of the krank columns of a
+-c               through which the other columns of a are expressed;
+-c               also, list describes the permutation of proj
+-c               required to reconstruct a as indicated in (*) above
+-c       rnorms -- absolute values of the entries on the diagonal
+-c                 of the triangular matrix used to compute the ID
+-c                 (these may be used to check the stability of the ID)
+-c
+-c       _N.B._: This routine changes a.
+-c
+-c       reference:
+-c       Cheng, Gimbutas, Martinsson, Rokhlin, "On the compression of
+-c            low-rank matrices," SIAM Journal on Scientific Computing,
+-c            26 (4): 1389-1404, 2005.
+-c
+-        implicit none
+-        integer m,n,krank,j,k,list(n),iswap
+-        real*8 a(m,n),rnorms(n),ss
+-c
+-c
+-c       QR decompose a.
+-c
+-        call iddr_qrpiv(m,n,a,krank,list,rnorms)
+-c
+-c
+-c       Build the list of columns chosen in a
+-c       by multiplying together the permutations in list,
+-c       with the permutation swapping 1 and list(1) taken rightmost
+-c       in the product, that swapping 2 and list(2) taken next
+-c       rightmost, ..., that swapping krank and list(krank) taken
+-c       leftmost.
+-c
+-        do k = 1,n
+-          rnorms(k) = k
+-        enddo ! k
+-c
+-        if(krank .gt. 0) then
+-          do k = 1,krank
+-c
+-c           Swap rnorms(k) and rnorms(list(k)).
+-c
+-            iswap = rnorms(k)
+-            rnorms(k) = rnorms(list(k))
+-            rnorms(list(k)) = iswap
+-c
+-          enddo ! k
+-        endif
+-c
+-        do k = 1,n
+-          list(k) = rnorms(k)
+-        enddo ! k
+-c
+-c
+-c       Fill rnorms for the output.
+-c
+-        ss = 0
+-c
+-        do k = 1,krank
+-          rnorms(k) = a(k,k)
+-          ss = ss+rnorms(k)**2
+-        enddo ! k
+-c
+-c
+-c       Backsolve for proj, storing it at the beginning of a.
+-c
+-        if(krank .gt. 0 .and. ss .gt. 0) then
+-          call idd_lssolve(m,n,a,krank)
+-        endif
+-c
+-        if(ss .eq. 0) then
+-c
+-          do k = 1,n
+-            do j = 1,m
+-c
+-              a(j,k) = 0
+-c
+-            enddo ! j
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_reconid(m,krank,col,n,list,proj,approx)
+-c
+-c       reconstructs the matrix that the routine iddp_id
+-c       or iddr_id has decomposed, using the columns col
+-c       of the reconstructed matrix whose indices are listed in list,
+-c       in addition to the interpolation matrix proj.
+-c
+-c       input:
+-c       m -- first dimension of cols and approx
+-c       krank -- first dimension of cols and proj; also,
+-c                n-krank is the second dimension of proj
+-c       col -- columns of the matrix to be reconstructed
+-c       n -- second dimension of approx; also,
+-c            n-krank is the second dimension of proj
+-c       list(k) -- index of col(1:m,k) in the reconstructed matrix
+-c                  when k <= krank; in general, list describes
+-c                  the permutation required for reconstruction
+-c                  via cols and proj
+-c       proj -- interpolation matrix
+-c
+-c       output:
+-c       approx -- reconstructed matrix
+-c
+-        implicit none
+-        integer m,n,krank,j,k,l,list(n)
+-        real*8 col(m,krank),proj(krank,n-krank),approx(m,n)
+-c
+-c
+-        do j = 1,m
+-          do k = 1,n
+-c
+-            approx(j,list(k)) = 0
+-c
+-c           Add in the contributions due to the identity matrix.
+-c
+-            if(k .le. krank) then
+-              approx(j,list(k)) = approx(j,list(k)) + col(j,k)
+-            endif
+-c
+-c           Add in the contributions due to proj.
+-c
+-            if(k .gt. krank) then
+-              if(krank .gt. 0) then
+-c
+-                do l = 1,krank
+-                  approx(j,list(k)) = approx(j,list(k))
+-     1                              + col(j,l)*proj(l,k-krank)
+-                enddo ! l
+-c
+-              endif
+-            endif
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_lssolve(m,n,a,krank)
+-c
+-c       backsolves for proj satisfying R_11 proj ~ R_12,
+-c       where R_11 = a(1:krank,1:krank)
+-c       and R_12 = a(1:krank,krank+1:n).
+-c       This routine overwrites the beginning of a with proj.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a; also,
+-c            n-krank is the second dimension of proj
+-c       a -- trapezoidal input matrix
+-c       krank -- first dimension of proj; also,
+-c                n-krank is the second dimension of proj
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) matrix proj
+-c
+-        implicit none
+-        integer m,n,krank,j,k,l
+-        real*8 a(m,n),sum
+-c
+-c
+-c       Overwrite a(1:krank,krank+1:n) with proj.
+-c
+-        do k = 1,n-krank
+-          do j = krank,1,-1
+-c
+-            sum = 0
+-c
+-            do l = j+1,krank
+-              sum = sum+a(j,l)*a(l,krank+k)
+-            enddo ! l
+-c
+-            a(j,krank+k) = a(j,krank+k)-sum
+-c
+-c           Make sure that the entry in proj won't be too big;
+-c           set the entry to 0 when roundoff would make it too big
+-c           (in which case a(j,j) is so small that the contribution
+-c           from this entry in proj to the overall matrix approximation
+-c           is supposed to be negligible).
+-c
+-            if(abs(a(j,krank+k)) .lt. 2**20*abs(a(j,j))) then
+-              a(j,krank+k) = a(j,krank+k)/a(j,j)
+-            else
+-              a(j,krank+k) = 0
+-            endif
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       Move proj from a(1:krank,krank+1:n) to the beginning of a.
+-c
+-        call idd_moverup(m,n,krank,a)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_moverup(m,n,krank,a)
+-c
+-c       moves the krank x (n-krank) matrix in a(1:krank,krank+1:n),
+-c       where a is initially dimensioned m x n, to the beginning of a.
+-c       (This is not the most natural way to code the move,
+-c       but one of my usually well-behaved compilers chokes
+-c       on more natural ways.)
+-c
+-c       input:
+-c       m -- initial first dimension of a
+-c       n -- initial second dimension of a
+-c       krank -- number of rows to move
+-c       a -- m x n matrix whose krank x (n-krank) block
+-c            a(1:krank,krank+1:n) is to be moved
+-c
+-c       output:
+-c       a -- array starting with the moved krank x (n-krank) block
+-c
+-        implicit none
+-        integer m,n,krank,j,k
+-        real*8 a(m*n)
+-c
+-c
+-        do k = 1,n-krank
+-          do j = 1,krank
+-            a(j+krank*(k-1)) = a(j+m*(krank+k-1))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,
+-     1                         col,x)
+-c
+-c       collects together the columns of the matrix a indexed by list
+-c       into the matrix col, where routine matvec applies a
+-c       to an arbitrary vector.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matvec -- routine which applies a to an arbitrary vector;
+-c                 this routine must have a calling sequence of the form
+-c
+-c                 matvec(m,x,n,y,p1,p2,p3,p4)
+-c
+-c                 where m is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 n is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       krank -- number of columns to be extracted
+-c       list -- indices of the columns to be extracted
+-c
+-c       output:
+-c       col -- columns of a indexed by list
+-c
+-c       work:
+-c       x -- must be at least n real*8 elements long
+-c
+-        implicit none
+-        integer m,n,krank,list(krank),j,k
+-        real*8 col(m,krank),x(n),p1,p2,p3,p4
+-        external matvec
+-c
+-c
+-        do j = 1,krank
+-c
+-          do k = 1,n
+-            x(k) = 0
+-          enddo ! k
+-c
+-          x(list(j)) = 1
+-c
+-          call matvec(n,x,m,col(1,j),p1,p2,p3,p4)
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_reconint(n,list,krank,proj,p)
+-c
+-c       constructs p in the ID a = b p,
+-c       where the columns of b are a subset of the columns of a,
+-c       and p is the projection coefficient matrix,
+-c       given list, krank, and proj output
+-c       by routines iddp_id or iddr_id.
+-c
+-c       input:
+-c       n -- part of the second dimension of proj and p
+-c       list -- list of columns retained from the original matrix
+-c               in the ID
+-c       krank -- rank of the ID
+-c       proj -- matrix of projection coefficients in the ID
+-c
+-c       output:
+-c       p -- projection matrix in the ID
+-c
+-        implicit none
+-        integer n,krank,list(n),j,k
+-        real*8 proj(krank,n-krank),p(krank,n)
+-c
+-c
+-        do k = 1,krank
+-          do j = 1,n
+-c
+-            if(j .le. krank) then
+-              if(j .eq. k) p(k,list(j)) = 1
+-              if(j .ne. k) p(k,list(j)) = 0
+-            endif
+-c
+-            if(j .gt. krank) then
+-              p(k,list(j)) = proj(k,j-krank)
+-            endif
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_copycols(m,n,a,krank,list,col)
+-c
+-c       collects together the columns of the matrix a indexed by list
+-c       into the matrix col.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix whose columns are to be extracted
+-c       krank -- number of columns to be extracted
+-c       list -- indices of the columns to be extracted
+-c
+-c       output:
+-c       col -- columns of a indexed by list
+-c
+-        implicit none
+-        integer m,n,krank,list(krank),j,k
+-        real*8 a(m,n),col(m,krank)
+-c
+-c
+-        do k = 1,krank
+-          do j = 1,m
+-c
+-            col(j,k) = a(j,list(k))
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_id2svd.f b/scipy/linalg/src/id_dist/src/idd_id2svd.f
+deleted file mode 100644
+index 42e1f23cd..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_id2svd.f
++++ /dev/null
+@@ -1,384 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_id2svd converts an approximation to a matrix
+-c       in the form of an ID to an approximation in the form of an SVD.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idd_id2svd(m,krank,b,n,list,proj,u,v,s,ier,w)
+-c
+-c       converts an approximation to a matrix in the form of an ID
+-c       to an approximation in the form of an SVD.
+-c
+-c       input:
+-c       m -- first dimension of b
+-c       krank -- rank of the ID
+-c       b -- columns of the original matrix in the ID
+-c       list -- list of columns chosen from the original matrix
+-c               in the ID
+-c       n -- length of list and part of the second dimension of proj
+-c       proj -- projection coefficients in the ID
+-c
+-c       output:
+-c       u -- left singular vectors
+-c       v -- right singular vectors
+-c       s -- singular values
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       work:
+-c       w -- must be at least (krank+1)*(m+3*n)+26*krank**2 real*8
+-c            elements long
+-c
+-c       _N.B._: This routine destroys b.
+-c
+-        implicit none
+-        integer m,krank,n,list(n),iwork,lwork,ip,lp,it,lt,ir,lr,
+-     1          ir2,lr2,ir3,lr3,iind,lind,iindt,lindt,lw,ier
+-        real*8 b(m,krank),proj(krank,n-krank),u(m,krank),v(n,krank),
+-     1         w((krank+1)*(m+3*n)+26*krank**2),s(krank)
+-c
+-c
+-        lw = 0
+-c
+-        iwork = lw+1
+-        lwork = 25*krank**2
+-        lw = lw+lwork
+-c
+-        ip = lw+1
+-        lp = krank*n
+-        lw = lw+lp
+-c
+-        it = lw+1
+-        lt = n*krank
+-        lw = lw+lt
+-c
+-        ir = lw+1
+-        lr = krank*n
+-        lw = lw+lr
+-c
+-        ir2 = lw+1
+-        lr2 = krank*m
+-        lw = lw+lr2
+-c
+-        ir3 = lw+1
+-        lr3 = krank*krank
+-        lw = lw+lr3
+-c
+-        iind = lw+1
+-        lind = n/2+1
+-        lw = lw+1
+-c
+-        iindt = lw+1
+-        lindt = m/2+1
+-        lw = lw+1
+-c
+-c
+-        call idd_id2svd0(m,krank,b,n,list,proj,u,v,s,ier,
+-     1                   w(iwork),w(ip),w(it),w(ir),w(ir2),w(ir3),
+-     2                   w(iind),w(iindt))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_id2svd0(m,krank,b,n,list,proj,u,v,s,ier,
+-     1                         work,p,t,r,r2,r3,ind,indt)
+-c
+-c       routine idd_id2svd serves as a memory wrapper
+-c       for the present routine (please see routine idd_id2svd
+-c       for further documentation).
+-c
+-        implicit none
+-c
+-        character*1 jobz
+-        integer m,n,krank,list(n),ind(n),indt(m),iftranspose,
+-     1          lwork,ldu,ldvt,ldr,info,j,k,ier
+-        real*8 b(m,krank),proj(krank,n-krank),p(krank,n),
+-     1         r(krank,n),r2(krank,m),t(n,krank),r3(krank,krank),
+-     2         u(m,krank),v(n,krank),s(krank),work(25*krank**2)
+-c
+-c
+-c
+-        ier = 0
+-c
+-c
+-c
+-c       Construct the projection matrix p from the ID.
+-c
+-        call idd_reconint(n,list,krank,proj,p)
+-c
+-c
+-c
+-c       Compute a pivoted QR decomposition of b.
+-c
+-        call iddr_qrpiv(m,krank,b,krank,ind,r)
+-c
+-c
+-c       Extract r from the QR decomposition.
+-c
+-        call idd_rinqr(m,krank,b,krank,r)
+-c
+-c
+-c       Rearrange r according to ind.
+-c
+-        call idd_rearr(krank,ind,krank,krank,r)
+-c
+-c
+-c
+-c       Transpose p to obtain t.
+-c
+-        call idd_mattrans(krank,n,p,t)
+-c
+-c
+-c       Compute a pivoted QR decomposition of t.
+-c
+-        call iddr_qrpiv(n,krank,t,krank,indt,r2)
+-c
+-c
+-c       Extract r2 from the QR decomposition.
+-c
+-        call idd_rinqr(n,krank,t,krank,r2)
+-c
+-c
+-c       Rearrange r2 according to indt.
+-c
+-        call idd_rearr(krank,indt,krank,krank,r2)
+-c
+-c
+-c
+-c       Multiply r and r2^T to obtain r3.
+-c
+-        call idd_matmultt(krank,krank,r,krank,r2,r3)
+-c
+-c
+-c
+-c       Use LAPACK to SVD r3.
+-c
+-        jobz = 'S'
+-        ldr = krank
+-        lwork = 25*krank**2-krank**2-4*krank
+-        ldu = krank
+-        ldvt = krank
+-c
+-        call dgesdd(jobz,krank,krank,r3,ldr,s,work,ldu,r,ldvt,
+-     1              work(krank**2+4*krank+1),lwork,
+-     2              work(krank**2+1),info)
+-c
+-        if(info .ne. 0) then
+-          ier = info
+-          return
+-        endif
+-c
+-c
+-c
+-c       Multiply the u from r3 from the left by the q from b
+-c       to obtain the u for a.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            u(j,k) = work(j+krank*(k-1))
+-          enddo ! j
+-c
+-          do j = krank+1,m
+-            u(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        iftranspose = 0
+-        call idd_qmatmat(iftranspose,m,krank,b,krank,krank,u,r2)
+-c
+-c
+-c
+-c       Transpose r to obtain r2.
+-c
+-        call idd_mattrans(krank,krank,r,r2)
+-c
+-c
+-c       Multiply the v from r3 from the left by the q from p^T
+-c       to obtain the v for a.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            v(j,k) = r2(j,k)
+-          enddo ! j
+-c
+-          do j = krank+1,n
+-            v(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        iftranspose = 0
+-        call idd_qmatmat(iftranspose,n,krank,t,krank,krank,v,r2)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_mattrans(m,n,a,at)
+-c
+-c       transposes a to obtain at.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of at
+-c       n -- second dimension of a, and first dimension of at
+-c       a -- matrix to be transposed
+-c
+-c       output:
+-c       at -- transpose of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        real*8 a(m,n),at(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            at(k,j) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_matmultt(l,m,a,n,b,c)
+-c
+-c       multiplies a and b^T to obtain c.
+-c
+-c       input:
+-c       l -- first dimension of a and c
+-c       m -- second dimension of a and b
+-c       a -- leftmost matrix in the product c = a b^T
+-c       n -- first dimension of b and second dimension of c
+-c       b -- rightmost matrix in the product c = a b^T
+-c
+-c       output:
+-c       c -- product of a and b^T
+-c
+-        implicit none
+-        integer l,m,n,i,j,k
+-        real*8 a(l,m),b(n,m),c(l,n),sum
+-c
+-c
+-        do i = 1,l
+-          do k = 1,n
+-c
+-            sum = 0
+-c
+-            do j = 1,m
+-              sum = sum+a(i,j)*b(k,j)
+-            enddo ! j
+-c
+-            c(i,k) = sum
+-c
+-          enddo ! k
+-        enddo ! i
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_rearr(krank,ind,m,n,a)
+-c
+-c       rearranges a according to ind obtained
+-c       from routines iddr_qrpiv or iddp_qrpiv,
+-c       assuming that a = q r, where q and r are from iddr_qrpiv
+-c       or iddp_qrpiv.
+-c
+-c       input:
+-c       krank -- rank obtained from routine iddp_qrpiv,
+-c                or provided to routine iddr_qrpiv
+-c       ind -- indexing array obtained from routine iddr_qrpiv
+-c              or iddp_qrpiv
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be rearranged
+-c
+-c       output:
+-c       a -- rearranged matrix
+-c
+-        implicit none
+-        integer k,krank,m,n,j,ind(krank)
+-        real*8 rswap,a(m,n)
+-c
+-c
+-        do k = krank,1,-1
+-          do j = 1,m
+-c
+-            rswap = a(j,k)
+-            a(j,k) = a(j,ind(k))
+-            a(j,ind(k)) = rswap
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_rinqr(m,n,a,krank,r)
+-c
+-c       extracts R in the QR decomposition specified by the output a
+-c       of the routine iddr_qrpiv or iddp_qrpiv.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a and r
+-c       a -- output of routine iddr_qrpiv or iddp_qrpiv
+-c       krank -- rank output by routine iddp_qrpiv (or specified
+-c                to routine iddr_qrpiv)
+-c
+-c       output:
+-c       r -- triangular factor in the QR decomposition specified
+-c            by the output a of the routine iddr_qrpiv or iddp_qrpiv
+-c
+-        implicit none
+-        integer m,n,j,k,krank
+-        real*8 a(m,n),r(krank,n)
+-c
+-c
+-c       Copy a into r and zero out the appropriate
+-c       Householder vectors that are stored in one triangle of a.
+-c
+-        do k = 1,n
+-          do j = 1,krank
+-            r(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-        do k = 1,n
+-          if(k .lt. krank) then
+-            do j = k+1,krank
+-              r(j,k) = 0
+-            enddo ! j
+-          endif
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_qrpiv.f b/scipy/linalg/src/id_dist/src/idd_qrpiv.f
+deleted file mode 100644
+index b1dd88e15..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_qrpiv.f
++++ /dev/null
+@@ -1,893 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_qrpiv computes the pivoted QR decomposition
+-c       of a matrix via Householder transformations,
+-c       stopping at a specified precision of the decomposition.
+-c
+-c       routine iddr_qrpiv computes the pivoted QR decomposition
+-c       of a matrix via Householder transformations,
+-c       stopping at a specified rank of the decomposition.
+-c
+-c       routine idd_qmatvec applies to a single vector
+-c       the Q matrix (or its transpose) in the QR decomposition
+-c       of a matrix, as described by the output of iddp_qrpiv
+-c       or iddr_qrpiv. If you're concerned about efficiency
+-c       and want to apply Q (or its transpose) to multiple vectors,
+-c       use idd_qmatmat instead.
+-c
+-c       routine idd_qmatmat applies
+-c       to multiple vectors collected together
+-c       as a matrix the Q matrix (or its transpose)
+-c       in the QR decomposition of a matrix, as described
+-c       by the output of iddp_qrpiv or iddr_qrpiv. If you don't want
+-c       to provide a work array and want to apply Q (or its transpose)
+-c       to a single vector, use idd_qmatvec instead.
+-c
+-c       routine idd_qinqr reconstructs the Q matrix
+-c       in a QR decomposition from the data generated
+-c       by iddp_qrpiv or iddr_qrpiv.
+-c
+-c       routine idd_permmult multiplies together a bunch
+-c       of permutations.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-
+-        subroutine idd_permmult(m,ind,n,indprod)
+-c
+-c       multiplies together the series of permutations in ind.
+-c
+-c       input:
+-c       m -- length of ind
+-c       ind(k) -- number of the slot with which to swap
+-c                 the k^th slot
+-c       n -- length of indprod and indprodinv
+-c
+-c       output:
+-c       indprod -- product of the permutations in ind,
+-c                  with the permutation swapping 1 and ind(1)
+-c                  taken leftmost in the product,
+-c                  that swapping 2 and ind(2) taken next leftmost,
+-c                  ..., that swapping krank and ind(krank)
+-c                  taken rightmost; indprod(k) is the number
+-c                  of the slot with which to swap the k^th slot
+-c                  in the product permutation
+-c
+-        implicit none
+-        integer m,n,ind(m),indprod(n),k,iswap
+-c
+-c
+-        do k = 1,n
+-          indprod(k) = k
+-        enddo ! k
+-c
+-        do k = m,1,-1
+-c
+-c         Swap indprod(k) and indprod(ind(k)).
+-c
+-          iswap = indprod(k)
+-          indprod(k) = indprod(ind(k))
+-          indprod(ind(k)) = iswap
+-c
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_qinqr(m,n,a,krank,q)
+-c
+-c       constructs the matrix q from iddp_qrpiv or iddr_qrpiv
+-c       (see the routine iddp_qrpiv or iddr_qrpiv
+-c       for more information).
+-c
+-c       input:
+-c       m -- first dimension of a; also, right now, q is m x m
+-c       n -- second dimension of a
+-c       a -- matrix output by iddp_qrpiv or iddr_qrpiv
+-c            (and denoted the same there)
+-c       krank -- numerical rank output by iddp_qrpiv or iddr_qrpiv
+-c                (and denoted the same there)
+-c
+-c       output:
+-c       q -- orthogonal matrix implicitly specified by the data in a
+-c            from iddp_qrpiv or iddr_qrpiv
+-c
+-c       Note:
+-c       Right now, this routine simply multiplies
+-c       one after another the krank Householder matrices
+-c       in the full QR decomposition of a,
+-c       in order to obtain the complete m x m Q factor in the QR.
+-c       This routine should instead use the following
+-c       (more elaborate but more efficient) scheme
+-c       to construct a q dimensioned q(krank,m); this scheme
+-c       was introduced by Robert Schreiber and Charles Van Loan
+-c       in "A Storage-Efficient _WY_ Representation
+-c       for Products of Householder Transformations,"
+-c       _SIAM Journal on Scientific and Statistical Computing_,
+-c       Vol. 10, No. 1, pp. 53-57, January, 1989:
+-c
+-c       Theorem 1. Suppose that Q = _1_ + YTY^T is
+-c       an m x m orthogonal real matrix,
+-c       where Y is an m x k real matrix
+-c       and T is a k x k upper triangular real matrix.
+-c       Suppose also that P = _1_ - 2 v v^T is
+-c       a real Householder matrix and Q_+ = QP,
+-c       where v is an m x 1 real vector,
+-c       normalized so that v^T v = 1.
+-c       Then, Q_+ = _1_ + Y_+ T_+ Y_+^T,
+-c       where Y_+ = (Y v) is the m x (k+1) matrix
+-c       formed by adjoining v to the right of Y,
+-c                 ( T   z )
+-c       and T_+ = (       ) is
+-c                 ( 0  -2 )
+-c       the (k+1) x (k+1) upper triangular matrix
+-c       formed by adjoining z to the right of T
+-c       and the vector (0 ... 0 -2) with k zeroes below (T z),
+-c       where z = -2 T Y^T v.
+-c
+-c       Now, suppose that A is a (rank-deficient) matrix
+-c       whose complete QR decomposition has
+-c       the blockwise partioned form
+-c           ( Q_11 Q_12 ) ( R_11 R_12 )   ( Q_11 )
+-c       A = (           ) (           ) = (      ) (R_11 R_12).
+-c           ( Q_21 Q_22 ) (  0    0   )   ( Q_21 )
+-c       Then, the only blocks of the orthogonal factor
+-c       in the above QR decomposition of A that matter are
+-c                                                        ( Q_11 )
+-c       Q_11 and Q_21, _i.e._, only the block of columns (      )
+-c                                                        ( Q_21 )
+-c       interests us.
+-c       Suppose in addition that Q_11 is a k x k matrix,
+-c       Q_21 is an (m-k) x k matrix, and that
+-c       ( Q_11 Q_12 )
+-c       (           ) = _1_ + YTY^T, as in Theorem 1 above.
+-c       ( Q_21 Q_22 )
+-c       Then, Q_11 = _1_ + Y_1 T Y_1^T
+-c       and Q_21 = Y_2 T Y_1^T,
+-c       where Y_1 is the k x k matrix and Y_2 is the (m-k) x k matrix
+-c                   ( Y_1 )
+-c       so that Y = (     ).
+-c                   ( Y_2 )
+-c
+-c       So, you can calculate T and Y via the above recursions,
+-c       and then use these to compute the desired Q_11 and Q_21.
+-c
+-c
+-        implicit none
+-        integer m,n,krank,j,k,mm,ifrescal
+-        real*8 a(m,n),q(m,m),scal
+-c
+-c
+-c       Zero all of the entries of q.
+-c
+-        do k = 1,m
+-          do j = 1,m
+-            q(j,k) = 0
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       Place 1's along the diagonal of q.
+-c
+-        do k = 1,m
+-          q(k,k) = 1
+-        enddo ! k
+-c
+-c
+-c       Apply the krank Householder transformations stored in a.
+-c
+-        do k = krank,1,-1
+-          do j = k,m
+-            mm = m-k+1
+-            ifrescal = 1
+-            if(k .lt. m)
+-     1       call idd_houseapp(mm,a(k+1,k),q(k,j),ifrescal,scal,q(k,j))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_qmatvec(iftranspose,m,n,a,krank,v)
+-c
+-c       applies to a single vector the Q matrix (or its transpose)
+-c       which the routine iddp_qrpiv or iddr_qrpiv has stored
+-c       in a triangle of the matrix it produces (stored, incidentally,
+-c       as data for applying a bunch of Householder reflections).
+-c       Use the routine qmatmat to apply the Q matrix
+-c       (or its transpose)
+-c       to a bunch of vectors collected together as a matrix,
+-c       if you're concerned about efficiency.
+-c
+-c       input:
+-c       iftranspose -- set to 0 for applying Q;
+-c                      set to 1 for applying the transpose of Q
+-c       m -- first dimension of a and length of v
+-c       n -- second dimension of a
+-c       a -- data describing the qr decomposition of a matrix,
+-c            as produced by iddp_qrpiv or iddr_qrpiv
+-c       krank -- numerical rank
+-c       v -- vector to which Q (or its transpose) is to be applied
+-c
+-c       output:
+-c       v -- vector to which Q (or its transpose) has been applied
+-c
+-        implicit none
+-        save
+-        integer m,n,krank,k,ifrescal,mm,iftranspose
+-        real*8 a(m,n),v(m),scal
+-c
+-c
+-        ifrescal = 1
+-c
+-c
+-        if(iftranspose .eq. 0) then
+-c
+-          do k = krank,1,-1
+-            mm = m-k+1
+-            if(k .lt. m)
+-     1       call idd_houseapp(mm,a(k+1,k),v(k),ifrescal,scal,v(k))
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        if(iftranspose .eq. 1) then
+-c
+-          do k = 1,krank
+-            mm = m-k+1
+-            if(k .lt. m)
+-     1       call idd_houseapp(mm,a(k+1,k),v(k),ifrescal,scal,v(k))
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_qmatmat(iftranspose,m,n,a,krank,l,b,work)
+-c
+-c       applies to a bunch of vectors collected together as a matrix
+-c       the Q matrix (or its transpose) which the routine iddp_qrpiv or
+-c       iddr_qrpiv has stored in a triangle of the matrix it produces
+-c       (stored, incidentally, as data for applying a bunch
+-c       of Householder reflections).
+-c       Use the routine qmatvec to apply the Q matrix
+-c       (or its transpose)
+-c       to a single vector, if you'd rather not provide a work array.
+-c
+-c       input:
+-c       iftranspose -- set to 0 for applying Q;
+-c                      set to 1 for applying the transpose of Q
+-c       m -- first dimension of both a and b
+-c       n -- second dimension of a
+-c       a -- data describing the qr decomposition of a matrix,
+-c            as produced by iddp_qrpiv or iddr_qrpiv
+-c       krank -- numerical rank
+-c       l -- second dimension of b
+-c       b -- matrix to which Q (or its transpose) is to be applied
+-c
+-c       output:
+-c       b -- matrix to which Q (or its transpose) has been applied
+-c
+-c       work:
+-c       work -- must be at least krank real*8 elements long
+-c
+-        implicit none
+-        save
+-        integer l,m,n,krank,j,k,ifrescal,mm,iftranspose
+-        real*8 a(m,n),b(m,l),work(krank)
+-c
+-c
+-        if(iftranspose .eq. 0) then
+-c
+-c
+-c         Handle the first iteration, j = 1,
+-c         calculating all scals (ifrescal = 1).
+-c
+-          ifrescal = 1
+-c
+-          j = 1
+-c
+-          do k = krank,1,-1
+-            if(k .lt. m) then
+-              mm = m-k+1
+-              call idd_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                          work(k),b(k,j))
+-            endif
+-          enddo ! k
+-c
+-c
+-          if(l .gt. 1) then
+-c
+-c           Handle the other iterations, j > 1,
+-c           using the scals just computed (ifrescal = 0).
+-c
+-            ifrescal = 0
+-c
+-            do j = 2,l
+-c
+-              do k = krank,1,-1
+-                if(k .lt. m) then
+-                  mm = m-k+1
+-                  call idd_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                              work(k),b(k,j))
+-                endif
+-              enddo ! k
+-c
+-            enddo ! j
+-c
+-          endif ! j .gt. 1
+-c
+-c
+-        endif ! iftranspose .eq. 0
+-c
+-c
+-        if(iftranspose .eq. 1) then
+-c
+-c
+-c         Handle the first iteration, j = 1,
+-c         calculating all scals (ifrescal = 1).
+-c
+-          ifrescal = 1
+-c
+-          j = 1
+-c
+-          do k = 1,krank
+-            if(k .lt. m) then
+-              mm = m-k+1
+-              call idd_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                          work(k),b(k,j))
+-            endif
+-          enddo ! k
+-c
+-c
+-          if(l .gt. 1) then
+-c
+-c           Handle the other iterations, j > 1,
+-c           using the scals just computed (ifrescal = 0).
+-c
+-            ifrescal = 0
+-c
+-            do j = 2,l
+-c
+-              do k = 1,krank
+-                if(k .lt. m) then
+-                  mm = m-k+1
+-                  call idd_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                              work(k),b(k,j))
+-                endif
+-              enddo ! k
+-c
+-            enddo ! j
+-c
+-          endif ! j .gt. 1
+-c
+-c
+-        endif ! iftranspose .eq. 1
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_qrpiv(eps,m,n,a,krank,ind,ss)
+-c
+-c       computes the pivoted QR decomposition
+-c       of the matrix input into a, using Householder transformations,
+-c       _i.e._, transforms the matrix a from its input value in
+-c       to the matrix out with entry
+-c
+-c                               m
+-c       out(j,indprod(k))  =  Sigma  q(l,j) * in(l,k),
+-c                              l=1
+-c
+-c       for all j = 1, ..., krank, and k = 1, ..., n,
+-c
+-c       where in = the a from before the routine runs,
+-c       out = the a from after the routine runs,
+-c       out(j,k) = 0 when j > k (so that out is triangular),
+-c       q(1:m,1), ..., q(1:m,krank) are orthonormal,
+-c       indprod is the product of the permutations given by ind,
+-c       (as computable via the routine permmult,
+-c       with the permutation swapping 1 and ind(1) taken leftmost
+-c       in the product, that swapping 2 and ind(2) taken next leftmost,
+-c       ..., that swapping krank and ind(krank) taken rightmost),
+-c       and with the matrix out satisfying
+-c
+-c                   krank
+-c       in(j,k)  =  Sigma  q(j,l) * out(l,indprod(k))  +  epsilon(j,k),
+-c                    l=1
+-c
+-c       for all j = 1, ..., m, and k = 1, ..., n,
+-c
+-c       for some matrix epsilon such that
+-c       the root-sum-square of the entries of epsilon
+-c       <= the root-sum-square of the entries of in * eps.
+-c       Well, technically, this routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       input:
+-c       eps -- relative precision of the resulting QR decomposition
+-c       m -- first dimension of a and q
+-c       n -- second dimension of a
+-c       a -- matrix whose QR decomposition gets computed
+-c
+-c       output:
+-c       a -- triangular (R) factor in the QR decompositon
+-c            of the matrix input into the same storage locations,
+-c            with the Householder vectors stored in the part of a
+-c            that would otherwise consist entirely of zeroes, that is,
+-c            in a(j,k) with m >= j > k >= 1
+-c       krank -- numerical rank
+-c       ind(k) -- index of the k^th pivot vector;
+-c                 the following code segment will correctly rearrange
+-c                 the product b of q and the upper triangle of out
+-c                 so that b matches the input matrix in
+-c                 to relative precision eps:
+-c
+-c                 copy the non-rearranged product of q and out into b
+-c                 set k to krank
+-c                 [start of loop]
+-c                   swap b(1:m,k) and b(1:m,ind(k))
+-c                   decrement k by 1
+-c                 if k > 0, then go to [start of loop]
+-c
+-c       work:
+-c       ss -- must be at least n real*8 words long
+-c
+-c       _N.B._: This routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        integer n,m,ind(n),krank,k,j,kpiv,mm,nupdate,ifrescal
+-        real*8 a(m,n),ss(n),eps,feps,ssmax,scal,ssmaxin,rswap
+-c
+-c
+-        feps = .1d-16
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of a,
+-c       the maximum of all such sums, and find the first pivot
+-c       (column with the greatest such sum).
+-c
+-        ssmax = 0
+-        kpiv = 1
+-c
+-        do k = 1,n
+-c
+-          ss(k) = 0
+-          do j = 1,m
+-            ss(k) = ss(k)+a(j,k)**2
+-          enddo ! j
+-c
+-          if(ss(k) .gt. ssmax) then
+-            ssmax = ss(k)
+-            kpiv = k
+-          endif
+-c
+-        enddo ! k
+-c
+-        ssmaxin = ssmax
+-c
+-        nupdate = 0
+-c
+-c
+-c       While ssmax > eps**2*ssmaxin, krank < m, and krank < n,
+-c       do the following block of code,
+-c       which ends at the statement labeled 2000.
+-c
+-        krank = 0
+- 1000   continue
+-c
+-        if(ssmax .le. eps**2*ssmaxin
+-     1   .or. krank .ge. m .or. krank .ge. n) goto 2000
+-        krank = krank+1
+-c
+-c
+-          mm = m-krank+1
+-c
+-c
+-c         Perform the pivoting.
+-c
+-          ind(krank) = kpiv
+-c
+-c         Swap a(1:m,krank) and a(1:m,kpiv).
+-c
+-          do j = 1,m
+-            rswap = a(j,krank)
+-            a(j,krank) = a(j,kpiv)
+-            a(j,kpiv) = rswap
+-          enddo ! j
+-c
+-c         Swap ss(krank) and ss(kpiv).
+-c
+-          rswap = ss(krank)
+-          ss(krank) = ss(kpiv)
+-          ss(kpiv) = rswap
+-c
+-c
+-          if(krank .lt. m) then
+-c
+-c
+-c           Compute the data for the Householder transformation
+-c           which will zero a(krank+1,krank), ..., a(m,krank)
+-c           when applied to a, replacing a(krank,krank)
+-c           with the first entry of the result of the application
+-c           of the Householder matrix to a(krank:m,krank),
+-c           and storing entries 2 to mm of the Householder vector
+-c           in a(krank+1,krank), ..., a(m,krank)
+-c           (which otherwise would get zeroed upon application
+-c           of the Householder transformation).
+-c
+-            call idd_house(mm,a(krank,krank),a(krank,krank),
+-     1                     a(krank+1,krank),scal)
+-            ifrescal = 0
+-c
+-c
+-c           Apply the Householder transformation
+-c           to the lower right submatrix of a
+-c           with upper leftmost entry at position (krank,krank+1).
+-c
+-            if(krank .lt. n) then
+-              do k = krank+1,n
+-                call idd_houseapp(mm,a(krank+1,krank),a(krank,k),
+-     1                            ifrescal,scal,a(krank,k))
+-              enddo ! k
+-            endif
+-c
+-c
+-c           Update the sums-of-squares array ss.
+-c
+-            do k = krank,n
+-              ss(k) = ss(k)-a(krank,k)**2
+-            enddo ! k
+-c
+-c
+-c           Find the pivot (column with the greatest sum of squares
+-c           of its entries).
+-c
+-            ssmax = 0
+-            kpiv = krank+1
+-c
+-            if(krank .lt. n) then
+-c
+-              do k = krank+1,n
+-c
+-                if(ss(k) .gt. ssmax) then
+-                  ssmax = ss(k)
+-                  kpiv = k
+-                endif
+-c
+-              enddo ! k
+-c
+-            endif ! krank .lt. n
+-c
+-c
+-c           Recompute the sums-of-squares and the pivot
+-c           when ssmax first falls below
+-c           sqrt((1000*feps)^2) * ssmaxin
+-c           and when ssmax first falls below
+-c           ((1000*feps)^2) * ssmaxin.
+-c
+-            if(
+-     1       (ssmax .lt. sqrt((1000*feps)**2) * ssmaxin
+-     2        .and. nupdate .eq. 0) .or.
+-     3       (ssmax .lt. ((1000*feps)**2) * ssmaxin
+-     4        .and. nupdate .eq. 1)
+-     5      ) then
+-c
+-              nupdate = nupdate+1
+-c
+-              ssmax = 0
+-              kpiv = krank+1
+-c
+-              if(krank .lt. n) then
+-c
+-                do k = krank+1,n
+-c
+-                  ss(k) = 0
+-                  do j = krank+1,m
+-                    ss(k) = ss(k)+a(j,k)**2
+-                  enddo ! j
+-c
+-                  if(ss(k) .gt. ssmax) then
+-                    ssmax = ss(k)
+-                    kpiv = k
+-                  endif
+-c
+-                enddo ! k
+-c
+-              endif ! krank .lt. n
+-c
+-            endif
+-c
+-c
+-          endif ! krank .lt. m
+-c
+-c
+-        goto 1000
+- 2000   continue
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_qrpiv(m,n,a,krank,ind,ss)
+-c
+-c       computes the pivoted QR decomposition
+-c       of the matrix input into a, using Householder transformations,
+-c       _i.e._, transforms the matrix a from its input value in
+-c       to the matrix out with entry
+-c
+-c                               m
+-c       out(j,indprod(k))  =  Sigma  q(l,j) * in(l,k),
+-c                              l=1
+-c
+-c       for all j = 1, ..., krank, and k = 1, ..., n,
+-c
+-c       where in = the a from before the routine runs,
+-c       out = the a from after the routine runs,
+-c       out(j,k) = 0 when j > k (so that out is triangular),
+-c       q(1:m,1), ..., q(1:m,krank) are orthonormal,
+-c       indprod is the product of the permutations given by ind,
+-c       (as computable via the routine permmult,
+-c       with the permutation swapping 1 and ind(1) taken leftmost
+-c       in the product, that swapping 2 and ind(2) taken next leftmost,
+-c       ..., that swapping krank and ind(krank) taken rightmost),
+-c       and with the matrix out satisfying
+-c
+-c                  min(krank,m,n)
+-c       in(j,k)  =     Sigma      q(j,l) * out(l,indprod(k))
+-c                       l=1
+-c
+-c                +  epsilon(j,k),
+-c
+-c       for all j = 1, ..., m, and k = 1, ..., n,
+-c
+-c       for some matrix epsilon whose norm is (hopefully) minimized
+-c       by the pivoting procedure.
+-c       Well, technically, this routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       input:
+-c       m -- first dimension of a and q
+-c       n -- second dimension of a
+-c       a -- matrix whose QR decomposition gets computed
+-c       krank -- desired rank of the output matrix
+-c                (please note that if krank > m or krank > n,
+-c                then the rank of the output matrix will be
+-c                less than krank)
+-c
+-c       output:
+-c       a -- triangular (R) factor in the QR decompositon
+-c            of the matrix input into the same storage locations,
+-c            with the Householder vectors stored in the part of a
+-c            that would otherwise consist entirely of zeroes, that is,
+-c            in a(j,k) with m >= j > k >= 1
+-c       ind(k) -- index of the k^th pivot vector;
+-c                 the following code segment will correctly rearrange
+-c                 the product b of q and the upper triangle of out
+-c                 so that b best matches the input matrix in:
+-c
+-c                 copy the non-rearranged product of q and out into b
+-c                 set k to krank
+-c                 [start of loop]
+-c                   swap b(1:m,k) and b(1:m,ind(k))
+-c                   decrement k by 1
+-c                 if k > 0, then go to [start of loop]
+-c
+-c       work:
+-c       ss -- must be at least n real*8 words long
+-c
+-c       _N.B._: This routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        integer n,m,ind(n),krank,k,j,kpiv,mm,nupdate,ifrescal,
+-     1          loops,loop
+-        real*8 a(m,n),ss(n),ssmax,scal,ssmaxin,rswap,feps
+-c
+-c
+-        feps = .1d-16
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of a,
+-c       the maximum of all such sums, and find the first pivot
+-c       (column with the greatest such sum).
+-c
+-        ssmax = 0
+-        kpiv = 1
+-c
+-        do k = 1,n
+-c
+-          ss(k) = 0
+-          do j = 1,m
+-            ss(k) = ss(k)+a(j,k)**2
+-          enddo ! j
+-c
+-          if(ss(k) .gt. ssmax) then
+-            ssmax = ss(k)
+-            kpiv = k
+-          endif
+-c
+-        enddo ! k
+-c
+-        ssmaxin = ssmax
+-c
+-        nupdate = 0
+-c
+-c
+-c       Set loops = min(krank,m,n).
+-c
+-        loops = krank
+-        if(m .lt. loops) loops = m
+-        if(n .lt. loops) loops = n
+-c
+-        do loop = 1,loops
+-c
+-c
+-          mm = m-loop+1
+-c
+-c
+-c         Perform the pivoting.
+-c
+-          ind(loop) = kpiv
+-c
+-c         Swap a(1:m,loop) and a(1:m,kpiv).
+-c
+-          do j = 1,m
+-            rswap = a(j,loop)
+-            a(j,loop) = a(j,kpiv)
+-            a(j,kpiv) = rswap
+-          enddo ! j
+-c
+-c         Swap ss(loop) and ss(kpiv).
+-c
+-          rswap = ss(loop)
+-          ss(loop) = ss(kpiv)
+-          ss(kpiv) = rswap
+-c
+-c
+-          if(loop .lt. m) then
+-c
+-c
+-c           Compute the data for the Householder transformation
+-c           which will zero a(loop+1,loop), ..., a(m,loop)
+-c           when applied to a, replacing a(loop,loop)
+-c           with the first entry of the result of the application
+-c           of the Householder matrix to a(loop:m,loop),
+-c           and storing entries 2 to mm of the Householder vector
+-c           in a(loop+1,loop), ..., a(m,loop)
+-c           (which otherwise would get zeroed upon application
+-c           of the Householder transformation).
+-c
+-            call idd_house(mm,a(loop,loop),a(loop,loop),
+-     1                     a(loop+1,loop),scal)
+-            ifrescal = 0
+-c
+-c
+-c           Apply the Householder transformation
+-c           to the lower right submatrix of a
+-c           with upper leftmost entry at position (loop,loop+1).
+-c
+-            if(loop .lt. n) then
+-              do k = loop+1,n
+-                call idd_houseapp(mm,a(loop+1,loop),a(loop,k),
+-     1                            ifrescal,scal,a(loop,k))
+-              enddo ! k
+-            endif
+-c
+-c
+-c           Update the sums-of-squares array ss.
+-c
+-            do k = loop,n
+-              ss(k) = ss(k)-a(loop,k)**2
+-            enddo ! k
+-c
+-c
+-c           Find the pivot (column with the greatest sum of squares
+-c           of its entries).
+-c
+-            ssmax = 0
+-            kpiv = loop+1
+-c
+-            if(loop .lt. n) then
+-c
+-              do k = loop+1,n
+-c
+-                if(ss(k) .gt. ssmax) then
+-                  ssmax = ss(k)
+-                  kpiv = k
+-                endif
+-c
+-              enddo ! k
+-c
+-            endif ! loop .lt. n
+-c
+-c
+-c           Recompute the sums-of-squares and the pivot
+-c           when ssmax first falls below
+-c           sqrt((1000*feps)^2) * ssmaxin
+-c           and when ssmax first falls below
+-c           ((1000*feps)^2) * ssmaxin.
+-c
+-            if(
+-     1       (ssmax .lt. sqrt((1000*feps)**2) * ssmaxin
+-     2        .and. nupdate .eq. 0) .or.
+-     3       (ssmax .lt. ((1000*feps)**2) * ssmaxin
+-     4        .and. nupdate .eq. 1)
+-     5      ) then
+-c
+-              nupdate = nupdate+1
+-c
+-              ssmax = 0
+-              kpiv = loop+1
+-c
+-              if(loop .lt. n) then
+-c
+-                do k = loop+1,n
+-c
+-                  ss(k) = 0
+-                  do j = loop+1,m
+-                    ss(k) = ss(k)+a(j,k)**2
+-                  enddo ! j
+-c
+-                  if(ss(k) .gt. ssmax) then
+-                    ssmax = ss(k)
+-                    kpiv = k
+-                  endif
+-c
+-                enddo ! k
+-c
+-              endif ! loop .lt. n
+-c
+-            endif
+-c
+-c
+-          endif ! loop .lt. m
+-c
+-c
+-        enddo ! loop
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_sfft.f b/scipy/linalg/src/id_dist/src/idd_sfft.f
+deleted file mode 100644
+index e46045ac2..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_sfft.f
++++ /dev/null
+@@ -1,443 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_sffti initializes routine idd_sfft.
+-c
+-c       routine idd_sfft rapidly computes a subset of the entries
+-c       of the DFT of a vector, composed with permutation matrices
+-c       both on input and on output.
+-c
+-c       routine idd_ldiv finds the greatest integer less than or equal
+-c       to a specified integer, that is divisible by another (larger)
+-c       specified integer.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idd_ldiv(l,n,m)
+-c
+-c       finds the greatest integer less than or equal to l
+-c       that divides n.
+-c
+-c       input:
+-c       l -- integer at least as great as m
+-c       n -- integer divisible by m
+-c
+-c       output:
+-c       m -- greatest integer less than or equal to l that divides n
+-c
+-        implicit none
+-        integer n,l,m
+-c
+-c
+-        m = l
+-c
+- 1000   continue
+-        if(m*(n/m) .eq. n) goto 2000
+-c
+-          m = m-1
+-          goto 1000
+-c
+- 2000   continue
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sffti(l,ind,n,wsave)
+-c
+-c       initializes wsave for using routine idd_sfft.
+-c
+-c       input:
+-c       l -- number of pairs of entries in the output of idd_sfft
+-c            to compute
+-c       ind -- indices of the pairs of entries in the output
+-c              of idd_sfft to compute; the indices must be chosen
+-c              in the range from 1 to n/2
+-c       n -- length of the vector to be transformed
+-c
+-c       output:
+-c       wsave -- array needed by routine idd_sfft for processing
+-c                (the present routine does not use the last n elements
+-c                 of wsave, but routine idd_sfft does)
+-c
+-        implicit none
+-        integer l,ind(l),n
+-        complex*16 wsave(2*l+15+4*n)
+-c
+-c
+-        if(l .eq. 1) call idd_sffti1(ind,n,wsave)
+-        if(l .gt. 1) call idd_sffti2(l,ind,n,wsave)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sffti1(ind,n,wsave)
+-c
+-c       routine idd_sffti serves as a wrapper around
+-c       the present routine; please see routine idd_sffti
+-c       for documentation.
+-c
+-        implicit none
+-        integer ind,n,k
+-        real*8 r1,twopi,wsave(2*(2+15+4*n)),fact
+-c
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-c
+-c
+-        fact = 1/sqrt(r1*n)
+-c
+-c
+-        do k = 1,n
+-          wsave(k) = cos(twopi*(k-1)*ind/(r1*n))*fact
+-        enddo ! k
+-c
+-        do k = 1,n
+-          wsave(n+k) = -sin(twopi*(k-1)*ind/(r1*n))*fact
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sffti2(l,ind,n,wsave)
+-c
+-c       routine idd_sffti serves as a wrapper around
+-c       the present routine; please see routine idd_sffti
+-c       for documentation.
+-c
+-        implicit none
+-        integer l,ind(l),n,nblock,ii,m,idivm,imodm,i,j,k
+-        real*8 r1,twopi,fact
+-        complex*16 wsave(2*l+15+4*n),ci,twopii
+-c
+-        ci = (0,1)
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-        twopii = twopi*ci
+-c
+-c
+-c       Determine the block lengths for the FFTs.
+-c
+-        call idd_ldiv(l,n,nblock)
+-        m = n/nblock
+-c
+-c
+-c       Initialize wsave for using routine dfftf.
+-c
+-        call dffti(nblock,wsave)
+-c
+-c
+-c       Calculate the coefficients in the linear combinations
+-c       needed for the direct portion of the calculation.
+-c
+-        fact = 1/sqrt(r1*n)
+-c
+-        ii = 2*l+15
+-c
+-        do j = 1,l
+-c
+-c
+-          i = ind(j)
+-c
+-c
+-          if(i .le. n/2-m/2) then
+-c
+-            idivm = (i-1)/m
+-            imodm = (i-1)-m*idivm
+-c
+-            do k = 1,m
+-              wsave(ii+m*(j-1)+k) = exp(-twopii*(k-1)*imodm/(r1*m))
+-     1         * exp(-twopii*(k-1)*(idivm+1)/(r1*n)) * fact
+-            enddo ! k
+-c
+-          endif ! i .le. n/2-m/2
+-c
+-c
+-          if(i .gt. n/2-m/2) then
+-c
+-            idivm = i/(m/2)
+-            imodm = i-(m/2)*idivm
+-c
+-            do k = 1,m
+-              wsave(ii+m*(j-1)+k) = exp(-twopii*(k-1)*imodm/(r1*m))
+-     1                            * fact
+-            enddo ! k
+-c
+-          endif ! i .gt. n/2-m/2
+-c
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sfft(l,ind,n,wsave,v)
+-c
+-c       computes a subset of the entries of the DFT of v,
+-c       composed with permutation matrices both on input and on output,
+-c       via a two-stage procedure (debugging code routine dfftf2 above
+-c       is supposed to calculate the full vector from which idd_sfft
+-c       returns a subset of the entries, when dfftf2 has
+-c       the same parameter nblock as in the present routine).
+-c
+-c       input:
+-c       l -- number of pairs of entries in the output to compute
+-c       ind -- indices of the pairs of entries in the output
+-c              to compute; the indices must be chosen
+-c              in the range from 1 to n/2
+-c       n -- length of v; n must be a positive integer power of 2
+-c       v -- vector to be transformed
+-c       wsave -- processing array initialized by routine idd_sffti
+-c
+-c       output:
+-c       v -- pairs of entries indexed by ind are given
+-c            their appropriately transformed values
+-c
+-c       _N.B._: n must be a positive integer power of 2.
+-c
+-c       references:
+-c       Sorensen and Burrus, "Efficient computation of the DFT with
+-c            only a subset of input or output points,"
+-c            IEEE Transactions on Signal Processing, 41 (3): 1184-1200,
+-c            1993.
+-c       Woolfe, Liberty, Rokhlin, Tygert, "A fast randomized algorithm
+-c            for the approximation of matrices," Applied and
+-c            Computational Harmonic Analysis, 25 (3): 335-366, 2008;
+-c            Section 3.3.
+-c
+-        implicit none
+-        integer l,ind(l),n
+-        real*8 v(n)
+-        complex*16 wsave(2*l+15+4*n)
+-c
+-c
+-        if(l .eq. 1) call idd_sfft1(ind,n,v,wsave)
+-        if(l .gt. 1) call idd_sfft2(l,ind,n,v,wsave)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sfft1(ind,n,v,wsave)
+-c
+-c       routine idd_sfft serves as a wrapper around
+-c       the present routine; please see routine idd_sfft
+-c       for documentation.
+-c
+-        implicit none
+-        integer ind,n,k
+-        real*8 v(n),r1,twopi,sumr,sumi,fact,wsave(2*(2+15+4*n))
+-c
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-c
+-c
+-        if(ind .lt. n/2) then
+-c
+-c
+-          sumr = 0
+-c
+-          do k = 1,n
+-            sumr = sumr+wsave(k)*v(k)
+-          enddo ! k
+-c
+-c
+-          sumi = 0
+-c
+-          do k = 1,n
+-            sumi = sumi+wsave(n+k)*v(k)
+-          enddo ! k
+-c
+-c
+-        endif ! ind .lt. n/2
+-c
+-c
+-        if(ind .eq. n/2) then
+-c
+-c
+-          fact = 1/sqrt(r1*n)
+-c
+-c
+-          sumr = 0
+-c
+-          do k = 1,n
+-            sumr = sumr+v(k)
+-          enddo ! k
+-c
+-          sumr = sumr*fact
+-c
+-c
+-          sumi = 0
+-c
+-          do k = 1,n/2
+-            sumi = sumi+v(2*k-1)
+-            sumi = sumi-v(2*k)
+-          enddo ! k
+-c
+-          sumi = sumi*fact
+-c
+-c
+-        endif ! ind .eq. n/2
+-c
+-c
+-        v(2*ind-1) = sumr
+-        v(2*ind) = sumi
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_sfft2(l,ind,n,v,wsave)
+-c
+-c       routine idd_sfft serves as a wrapper around
+-c       the present routine; please see routine idd_sfft
+-c       for documentation.
+-c
+-        implicit none
+-        integer n,m,l,k,j,ind(l),i,idivm,nblock,ii,iii,imodm
+-        real*8 r1,twopi,v(n),rsum,fact
+-        complex*16 wsave(2*l+15+4*n),ci,sum
+-c
+-        ci = (0,1)
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-c
+-c
+-c       Determine the block lengths for the FFTs.
+-c
+-        call idd_ldiv(l,n,nblock)
+-c
+-c
+-        m = n/nblock
+-c
+-c
+-c       FFT each block of length nblock of v.
+-c
+-        do k = 1,m
+-          call dfftf(nblock,v(nblock*(k-1)+1),wsave)
+-        enddo ! k
+-c
+-c
+-c       Transpose v to obtain wsave(2*l+15+2*n+1 : 2*l+15+3*n).
+-c
+-        iii = 2*l+15+2*n
+-c
+-        do k = 1,m
+-          do j = 1,nblock/2-1
+-            wsave(iii+m*(j-1)+k) = v(nblock*(k-1)+2*j)
+-     1                           + ci*v(nblock*(k-1)+2*j+1)
+-          enddo ! j
+-        enddo ! k
+-c
+-c       Handle the purely real frequency components separately.
+-c
+-        do k = 1,m
+-          wsave(iii+m*(nblock/2-1)+k) = v(nblock*(k-1)+nblock)
+-          wsave(iii+m*(nblock/2)+k) = v(nblock*(k-1)+1)
+-        enddo ! k
+-c
+-c
+-c       Directly calculate the desired entries of v.
+-c
+-        ii = 2*l+15
+-c
+-        do j = 1,l
+-c
+-c
+-          i = ind(j)
+-c
+-c
+-          if(i .le. n/2-m/2) then
+-c
+-            idivm = (i-1)/m
+-            imodm = (i-1)-m*idivm
+-c
+-            sum = 0
+-c
+-            do k = 1,m
+-              sum = sum + wsave(iii+m*idivm+k) * wsave(ii+m*(j-1)+k)
+-            enddo ! k
+-c
+-            v(2*i-1) = sum
+-            v(2*i) = -ci*sum
+-c
+-          endif ! i .le. n/2-m/2
+-c
+-c
+-          if(i .gt. n/2-m/2) then
+-c
+-            if(i .lt. n/2) then
+-c
+-              idivm = i/(m/2)
+-              imodm = i-(m/2)*idivm
+-c
+-              sum = 0
+-c
+-              do k = 1,m
+-                sum = sum + wsave(iii+m*(nblock/2)+k)
+-     1              * wsave(ii+m*(j-1)+k)
+-              enddo ! k
+-c
+-              v(2*i-1) = sum
+-              v(2*i) = -ci*sum
+-c
+-            endif
+-c
+-            if(i .eq. n/2) then
+-c
+-              fact = 1/sqrt(r1*n)
+-c
+-c
+-              rsum = 0
+-c
+-              do k = 1,m
+-                rsum = rsum + wsave(iii+m*(nblock/2)+k)
+-              enddo ! k
+-c
+-              v(n-1) = rsum*fact
+-c
+-c
+-              rsum = 0
+-c
+-              do k = 1,m/2
+-                rsum = rsum + wsave(iii+m*(nblock/2)+2*k-1)
+-                rsum = rsum - wsave(iii+m*(nblock/2)+2*k)
+-              enddo ! k
+-c
+-              v(n) = rsum*fact
+-c
+-            endif
+-c
+-          endif ! i .gt. n/2-m/2
+-c
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_snorm.f b/scipy/linalg/src/id_dist/src/idd_snorm.f
+deleted file mode 100644
+index c718ce12f..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_snorm.f
++++ /dev/null
+@@ -1,400 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idd_snorm estimates the spectral norm
+-c       of a matrix specified by routines for applying the matrix
+-c       and its transpose to arbitrary vectors. This routine uses
+-c       the power method with a random starting vector.
+-c
+-c       routine idd_diffsnorm estimates the spectral norm
+-c       of the difference between two matrices specified by routines
+-c       for applying the matrices and their transposes
+-c       to arbitrary vectors. This routine uses
+-c       the power method with a random starting vector.
+-c
+-c       routine idd_enorm calculates the Euclidean norm of a vector.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idd_snorm(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                       matvec,p1,p2,p3,p4,its,snorm,v,u)
+-c
+-c       estimates the spectral norm of a matrix a specified
+-c       by a routine matvec for applying a to an arbitrary vector,
+-c       and by a routine matvect for applying a^T
+-c       to an arbitrary vector. This routine uses the power method
+-c       with a random starting vector.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matvect -- routine which applies the transpose of a
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvect(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose of a
+-c                  is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transpose of a and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matvect
+-c       p2t -- parameter to be passed to routine matvect
+-c       p3t -- parameter to be passed to routine matvect
+-c       p4t -- parameter to be passed to routine matvect
+-c       matvec -- routine which applies the matrix a
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which a is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of a and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       its -- number of iterations of the power method to conduct
+-c
+-c       output:
+-c       snorm -- estimate of the spectral norm of a
+-c       v -- estimate of a normalized right singular vector
+-c            corresponding to the greatest singular value of a
+-c
+-c       work:
+-c       u -- must be at least m real*8 elements long
+-c
+-c       reference:
+-c       Kuczynski and Wozniakowski, "Estimating the largest eigenvalue
+-c            by the power and Lanczos algorithms with a random start,"
+-c            SIAM Journal on Matrix Analysis and Applications,
+-c            13 (4): 1992, 1094-1122.
+-c
+-        implicit none
+-        integer m,n,its,it,k
+-        real*8 snorm,enorm,p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m),v(n)
+-        external matvect,matvec
+-c
+-c
+-c       Fill the real and imaginary parts of each entry
+-c       of the initial vector v with i.i.d. random variables
+-c       drawn uniformly from [-1,1].
+-c
+-        call id_srand(n,v)
+-c
+-        do k = 1,n
+-          v(k) = 2*v(k)-1
+-        enddo ! k
+-c
+-c
+-c       Normalize v.
+-c
+-        call idd_enorm(n,v,enorm)
+-c
+-        do k = 1,n
+-          v(k) = v(k)/enorm
+-        enddo ! k
+-c
+-c
+-        do it = 1,its
+-c
+-c         Apply a to v, obtaining u.
+-c
+-          call matvec(n,v,m,u,p1,p2,p3,p4)
+-c
+-c         Apply a^T to u, obtaining v.
+-c
+-          call matvect(m,u,n,v,p1t,p2t,p3t,p4t)
+-c
+-c         Normalize v.
+-c
+-          call idd_enorm(n,v,snorm)
+-c
+-          if(snorm .gt. 0) then
+-c
+-            do k = 1,n
+-              v(k) = v(k)/snorm
+-            enddo ! k
+-c
+-          endif
+-c
+-          snorm = sqrt(snorm)
+-c
+-        enddo ! it
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_enorm(n,v,enorm)
+-c
+-c       computes the Euclidean norm of v, the square root
+-c       of the sum of the squares of the entries of v.
+-c
+-c       input:
+-c       n -- length of v
+-c       v -- vector whose Euclidean norm is to be calculated
+-c
+-c       output:
+-c       enorm -- Euclidean norm of v
+-c
+-        implicit none
+-        integer n,k
+-        real*8 enorm,v(n)
+-c
+-c
+-        enorm = 0
+-c
+-        do k = 1,n
+-          enorm = enorm+v(k)**2
+-        enddo ! k
+-c
+-        enorm = sqrt(enorm)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_diffsnorm(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                           matvect2,p1t2,p2t2,p3t2,p4t2,
+-     2                           matvec,p1,p2,p3,p4,
+-     3                           matvec2,p12,p22,p32,p42,its,snorm,w)
+-c
+-c       estimates the spectral norm of the difference between matrices
+-c       a and a2, where a is specified by routines matvec and matvect
+-c       for applying a and a^T to arbitrary vectors,
+-c       and a2 is specified by routines matvec2 and matvect2
+-c       for applying a2 and (a2)^T to arbitrary vectors.
+-c       This routine uses the power method
+-c       with a random starting vector.
+-c
+-c       input:
+-c       m -- number of rows in a, as well as the number of rows in a2
+-c       n -- number of columns in a, as well as the number of columns
+-c            in a2
+-c       matvect -- routine which applies the transpose of a
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvect(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose of a
+-c                  is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transpose of a and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matvect
+-c       p2t -- parameter to be passed to routine matvect
+-c       p3t -- parameter to be passed to routine matvect
+-c       p4t -- parameter to be passed to routine matvect
+-c       matvect2 -- routine which applies the transpose of a2
+-c                   to an arbitrary vector; this routine must have
+-c                   a calling sequence of the form
+-c
+-c                   matvect2(m,x,n,y,p1t2,p2t2,p3t2,p4t2),
+-c
+-c                   where m is the length of x,
+-c                   x is the vector to which the transpose of a2
+-c                   is to be applied,
+-c                   n is the length of y,
+-c                   y is the product of the transpose of a2 and x,
+-c                   and p1t2, p2t2, p3t2, and p4t2 are user-specified
+-c                   parameters
+-c       p1t2 -- parameter to be passed to routine matvect2
+-c       p2t2 -- parameter to be passed to routine matvect2
+-c       p3t2 -- parameter to be passed to routine matvect2
+-c       p4t2 -- parameter to be passed to routine matvect2
+-c       matvec -- routine which applies the matrix a
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which a is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of a and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       matvec2 -- routine which applies the matrix a2
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvec2(n,x,m,y,p12,p22,p32,p42),
+-c
+-c                  where n is the length of x,
+-c                  x is the vector to which a2 is to be applied,
+-c                  m is the length of y,
+-c                  y is the product of a2 and x, and
+-c                  p12, p22, p32, and p42 are user-specified parameters
+-c       p12 -- parameter to be passed to routine matvec2
+-c       p22 -- parameter to be passed to routine matvec2
+-c       p32 -- parameter to be passed to routine matvec2
+-c       p42 -- parameter to be passed to routine matvec2
+-c       its -- number of iterations of the power method to conduct
+-c
+-c       output:
+-c       snorm -- estimate of the spectral norm of a-a2
+-c
+-c       work:
+-c       w -- must be at least 3*m+3*n real*8 elements long
+-c
+-c       reference:
+-c       Kuczynski and Wozniakowski, "Estimating the largest eigenvalue
+-c            by the power and Lanczos algorithms with a random start,"
+-c            SIAM Journal on Matrix Analysis and Applications,
+-c            13 (4): 1992, 1094-1122.
+-c
+-        implicit none
+-        integer m,n,its,lw,iu,lu,iu1,lu1,iu2,lu2,
+-     1          iv,lv,iv1,lv1,iv2,lv2
+-        real*8 snorm,p1t,p2t,p3t,p4t,p1t2,p2t2,p3t2,p4t2,
+-     1         p1,p2,p3,p4,p12,p22,p32,p42,w(3*m+3*n)
+-        external matvect,matvec,matvect2,matvec2
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iu = lw+1
+-        lu = m
+-        lw = lw+lu
+-c
+-        iu1 = lw+1
+-        lu1 = m
+-        lw = lw+lu1
+-c
+-        iu2 = lw+1
+-        lu2 = m
+-        lw = lw+lu2
+-c
+-        iv = lw+1
+-        lv = n
+-        lw = lw+1
+-c
+-        iv1 = lw+1
+-        lv1 = n
+-        lw = lw+lv1
+-c
+-        iv2 = lw+1
+-        lv2 = n
+-        lw = lw+lv2
+-c
+-c
+-        call idd_diffsnorm0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                      matvect2,p1t2,p2t2,p3t2,p4t2,
+-     2                      matvec,p1,p2,p3,p4,
+-     3                      matvec2,p12,p22,p32,p42,
+-     4                      its,snorm,w(iu),w(iu1),w(iu2),
+-     5                      w(iv),w(iv1),w(iv2))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_diffsnorm0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                            matvect2,p1t2,p2t2,p3t2,p4t2,
+-     2                            matvec,p1,p2,p3,p4,
+-     3                            matvec2,p12,p22,p32,p42,
+-     4                            its,snorm,u,u1,u2,v,v1,v2)
+-c
+-c       routine idd_diffsnorm serves as a memory wrapper
+-c       for the present routine. (Please see routine idd_diffsnorm
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,its,it,k
+-        real*8 snorm,enorm,p1t,p2t,p3t,p4t,p1t2,p2t2,p3t2,p4t2,
+-     1         p1,p2,p3,p4,p12,p22,p32,p42,u(m),u1(m),u2(m),
+-     2         v(n),v1(n),v2(n)
+-        external matvect,matvec,matvect2,matvec2
+-c
+-c
+-c       Fill the real and imaginary parts of each entry
+-c       of the initial vector v with i.i.d. random variables
+-c       drawn uniformly from [-1,1].
+-c
+-        call id_srand(n,v)
+-c
+-        do k = 1,n
+-          v(k) = 2*v(k)-1
+-        enddo ! k
+-c
+-c
+-c       Normalize v.
+-c
+-        call idd_enorm(n,v,enorm)
+-c
+-        do k = 1,n
+-          v(k) = v(k)/enorm
+-        enddo ! k
+-c
+-c
+-        do it = 1,its
+-c
+-c         Apply a and a2 to v, obtaining u1 and u2.
+-c
+-          call matvec(n,v,m,u1,p1,p2,p3,p4)
+-          call matvec2(n,v,m,u2,p12,p22,p32,p42)
+-c
+-c         Form u = u1-u2.
+-c
+-          do k = 1,m
+-            u(k) = u1(k)-u2(k)
+-          enddo ! k
+-c
+-c         Apply a^T and (a2)^T to u, obtaining v1 and v2.
+-c
+-          call matvect(m,u,n,v1,p1t,p2t,p3t,p4t)
+-          call matvect2(m,u,n,v2,p1t2,p2t2,p3t2,p4t2)
+-c
+-c         Form v = v1-v2.
+-c
+-          do k = 1,n
+-            v(k) = v1(k)-v2(k)
+-          enddo ! k
+-c
+-c         Normalize v.
+-c
+-          call idd_enorm(n,v,snorm)
+-c
+-          if(snorm .gt. 0) then
+-c
+-            do k = 1,n
+-              v(k) = v(k)/snorm
+-            enddo ! k
+-c
+-          endif
+-c
+-          snorm = sqrt(snorm)
+-c
+-        enddo ! it
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idd_svd.f b/scipy/linalg/src/id_dist/src/idd_svd.f
+deleted file mode 100644
+index 969422b8c..000000000
+--- a/scipy/linalg/src/id_dist/src/idd_svd.f
++++ /dev/null
+@@ -1,409 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddr_svd computes an approximation of specified rank
+-c       to a given matrix, in the usual SVD form U S V^T,
+-c       where U has orthonormal columns, V has orthonormal columns,
+-c       and S is diagonal.
+-c
+-c       routine iddp_svd computes an approximation of specified
+-c       precision to a given matrix, in the usual SVD form U S V^T,
+-c       where U has orthonormal columns, V has orthonormal columns,
+-c       and S is diagonal.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddr_svd(m,n,a,krank,u,v,s,ier,r)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^T  approximating a,
+-c       where u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine combines a QR code
+-c       (which is based on plane/Householder reflections)
+-c       with the LAPACK routine dgesdd.
+-c
+-c       input:
+-c       m -- first dimension of a and u
+-c       n -- second dimension of a, and first dimension of v
+-c       a -- matrix to be SVD'd
+-c       krank -- desired rank of the approximation to a
+-c
+-c       output:
+-c       u -- left singular vectors of a corresponding
+-c            to the k greatest singular values of a
+-c       v -- right singular vectors of a corresponding
+-c            to the k greatest singular values of a
+-c       s -- k greatest singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero when the routine encounters an error
+-c
+-c       work:
+-c       r -- must be at least
+-c            (krank+2)*n+8*min(m,n)+15*krank**2+8*krank
+-c            real*8 elements long
+-c
+-c       _N.B._: This routine destroys a. Also, please beware that
+-c               the source code for this routine could be clearer.
+-c
+-        implicit none
+-        character*1 jobz
+-        integer m,n,k,krank,iftranspose,ldr,ldu,ldvt,lwork,
+-     1          info,j,ier,io
+-        real*8 a(m,n),u(m,krank),v(n*krank),s(krank),r(*)
+-c
+-c
+-        io = 8*min(m,n)
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Compute a pivoted QR decomposition of a.
+-c
+-        call iddr_qrpiv(m,n,a,krank,r,r(io+1))
+-c
+-c
+-c       Extract R from the QR decomposition.
+-c
+-        call idd_retriever(m,n,a,krank,r(io+1))
+-c
+-c
+-c       Rearrange R according to ind (which is stored in r).
+-c
+-        call idd_permuter(krank,r,krank,n,r(io+1))
+-c
+-c
+-c       Use LAPACK to SVD R,
+-c       storing the krank (krank x 1) left singular vectors
+-c       in r(io+krank*n+1 : io+krank*n+krank*krank).
+-c
+-        jobz = 'S'
+-        ldr = krank
+-        lwork = 2*(3*krank**2+n+4*krank**2+4*krank)
+-        ldu = krank
+-        ldvt = krank
+-c
+-        call dgesdd(jobz,krank,n,r(io+1),ldr,s,r(io+krank*n+1),ldu,
+-     1              v,ldvt,r(io+krank*n+krank*krank+1),lwork,r,info)
+-c
+-        if(info .ne. 0) then
+-          ier = info
+-          return
+-        endif
+-c
+-c
+-c       Multiply the U from R from the left by Q to obtain the U
+-c       for A.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            u(j,k) = r(io+krank*n+j+krank*(k-1))
+-          enddo ! j
+-c
+-          do j = krank+1,m
+-            u(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        iftranspose = 0
+-        call idd_qmatmat(iftranspose,m,n,a,krank,krank,u,r)
+-c
+-c
+-c       Transpose v to obtain r.
+-c
+-        call idd_transer(krank,n,v,r)
+-c
+-c
+-c       Copy r into v.
+-c
+-        do k = 1,n*krank
+-          v(k) = r(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_svd(lw,eps,m,n,a,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^T  approximating a
+-c       to precision eps, where U is an m x krank matrix whose
+-c       columns are orthonormal, V is an n x krank matrix whose
+-c       columns are orthonormal, and Sigma is a diagonal krank x krank
+-c       matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine combines a QR code
+-c       (which is based on plane/Householder reflections)
+-c       with the LAPACK routine dgesdd.
+-c
+-c       input:
+-c       lw -- maximum usable length of w (in real*8 elements)
+-c       eps -- precision to which the SVD approximates a
+-c       m -- first dimension of a and u
+-c       n -- second dimension of a, and first dimension of v
+-c       a -- matrix to be SVD'd
+-c
+-c       output:
+-c       krank -- rank of the approximation to a
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            (krank+1)*(m+2*n+9)+8*min(m,n)+15*krank**2
+-c            real*8 elements long, where krank is the rank
+-c            output by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when dgesdd bombs
+-c
+-c       _N.B._: This routine destroys a. Also, please beware that
+-c               the source code for this routine could be clearer.
+-c               w must be at least
+-c               (krank+1)*(m+2*n+9)+8*min(m,n)+15*krank**2
+-c               real*8 elements long, where krank is the rank
+-c               output by the present routine.
+-c
+-        implicit none
+-        character*1 jobz
+-        integer m,n,k,krank,iftranspose,ldr,ldu,ldvt,lwork,
+-     1          info,j,ier,io,iu,iv,is,ivi,isi,lw,lu,lv,ls
+-        real*8 a(m,n),w(*),eps
+-c
+-c
+-        io = 8*min(m,n)
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Compute a pivoted QR decomposition of a.
+-c
+-        call iddp_qrpiv(eps,m,n,a,krank,w,w(io+1))
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Extract R from the QR decomposition.
+-c
+-          call idd_retriever(m,n,a,krank,w(io+1))
+-c
+-c
+-c         Rearrange R according to ind (which is stored in w).
+-c
+-          call idd_permuter(krank,w,krank,n,w(io+1))
+-c
+-c
+-c         Use LAPACK to SVD R,
+-c         storing the krank (krank x 1) left singular vectors
+-c         in w(io+krank*n+1 : io+krank*n+krank*krank).
+-c
+-          jobz = 'S'
+-          ldr = krank
+-          lwork = 2*(3*krank**2+n+4*krank**2+4*krank)
+-          ldu = krank
+-          ldvt = krank
+-c
+-          ivi = io+krank*n+krank*krank+lwork+1
+-          lv = n*krank
+-c
+-          isi = ivi+lv
+-          ls = krank
+-c
+-          if(lw .lt. isi+ls+m*krank-1) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-          call dgesdd(jobz,krank,n,w(io+1),ldr,w(isi),w(io+krank*n+1),
+-     1                ldu,w(ivi),ldvt,w(io+krank*n+krank*krank+1),
+-     2                lwork,w,info)
+-c
+-          if(info .ne. 0) then
+-            ier = info
+-            return
+-          endif
+-c
+-c
+-c         Transpose w(ivi:ivi+lv-1) to obtain V.
+-c
+-          iv = 1
+-          call idd_transer(krank,n,w(ivi),w(iv))
+-c
+-c
+-c         Copy w(isi:isi+ls-1) into w(is:is+ls-1).
+-c
+-          is = iv+lv
+-c
+-          do k = 1,ls
+-            w(is+k-1) = w(isi+k-1)
+-          enddo ! k
+-c
+-c
+-c         Multiply the U from R from the left by Q to obtain the U
+-c         for A.
+-c
+-          iu = is+ls
+-          lu = m*krank
+-c
+-          do k = 1,krank
+-c
+-            do j = 1,krank
+-              w(iu-1+j+krank*(k-1)) = w(io+krank*n+j+krank*(k-1))
+-            enddo ! j
+-c
+-          enddo ! k
+-c
+-          do k = krank,1,-1
+-c
+-            do j = m,krank+1,-1
+-              w(iu-1+j+m*(k-1)) = 0
+-            enddo ! j
+-c
+-            do j = krank,1,-1
+-              w(iu-1+j+m*(k-1)) = w(iu-1+j+krank*(k-1))
+-            enddo ! j
+-c
+-          enddo ! k
+-c
+-          iftranspose = 0
+-          call idd_qmatmat(iftranspose,m,n,a,krank,krank,w(iu),
+-     1                     w(iu+lu+1))
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_permuter(krank,ind,m,n,a)
+-c
+-c       permutes the columns of a according to ind obtained
+-c       from routine iddr_qrpiv or iddp_qrpiv, assuming that
+-c       a = q r from iddr_qrpiv or iddp_qrpiv.
+-c
+-c       input:
+-c       krank -- rank specified to routine iddr_qrpiv
+-c                or obtained from routine iddp_qrpiv
+-c       ind -- indexing array obtained from routine iddr_qrpiv
+-c              or iddp_qrpiv
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be rearranged
+-c
+-c       output:
+-c       a -- rearranged matrix
+-c
+-        implicit none
+-        integer k,krank,m,n,j,ind(krank)
+-        real*8 rswap,a(m,n)
+-c
+-c
+-        do k = krank,1,-1
+-          do j = 1,m
+-c
+-            rswap = a(j,k)
+-            a(j,k) = a(j,ind(k))
+-            a(j,ind(k)) = rswap
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_retriever(m,n,a,krank,r)
+-c
+-c       extracts R in the QR decomposition specified by the output a
+-c       of the routine iddr_qrpiv or iddp_qrpiv
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a and r
+-c       a -- output of routine iddr_qrpiv or iddp_qrpiv
+-c       krank -- rank specified to routine iddr_qrpiv,
+-c                or output by routine iddp_qrpiv
+-c
+-c       output:
+-c       r -- triangular factor in the QR decomposition specified
+-c            by the output a of the routine iddr_qrpiv or iddp_qrpiv
+-c
+-        implicit none
+-        integer m,n,j,k,krank
+-        real*8 a(m,n),r(krank,n)
+-c
+-c
+-c       Copy a into r and zero out the appropriate
+-c       Householder vectors that are stored in one triangle of a.
+-c
+-        do k = 1,n
+-          do j = 1,krank
+-            r(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-        do k = 1,n
+-          if(k .lt. krank) then
+-            do j = k+1,krank
+-              r(j,k) = 0
+-            enddo ! j
+-          endif
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_transer(m,n,a,at)
+-c
+-c       forms the transpose at of a.
+-c
+-c       input:
+-c       m -- first dimension of a and second dimension of at
+-c       n -- second dimension of a and first dimension of at
+-c       a -- matrix to be transposed
+-c
+-c       output:
+-c       at -- transpose of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        real*8 a(m,n),at(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            at(k,j) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddp_aid.f b/scipy/linalg/src/id_dist/src/iddp_aid.f
+deleted file mode 100644
+index f3f9ddfdd..000000000
+--- a/scipy/linalg/src/id_dist/src/iddp_aid.f
++++ /dev/null
+@@ -1,386 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_aid computes the ID, to a specified precision,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c       routine idd_estrank estimates the numerical rank,
+-c       to a specified precision, of an arbitrary matrix.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddp_aid(eps,m,n,a,work,krank,list,proj)
+-c
+-c       computes the ID of the matrix a, i.e., lists in list
+-c       the indices of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c
+-c       input:
+-c       eps -- precision to which the ID is to be computed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be decomposed; the present routine does not
+-c            alter a
+-c       work -- initialization array that has been constructed
+-c               by routine idd_frmi
+-c
+-c       output:
+-c       krank -- numerical rank of a to precision eps
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               proj doubles as a work array in the present routine, so
+-c               proj must be at least n*(2*n2+1)+n2+1 real*8 elements
+-c               long, where n2 is the greatest integer less than
+-c               or equal to m, such that n2 is a positive integer
+-c               power of two.
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least n*(2*n2+1)+n2+1 real*8 elements
+-c               long, where n2 is the greatest integer less than
+-c               or equal to m, such that n2 is a positive integer
+-c               power of two.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,list(n),krank,kranki,n2
+-        real*8 eps,a(m,n),proj(*),work(17*m+70)
+-c
+-c
+-c       Allocate memory in proj.
+-c
+-        n2 = work(2)
+-c
+-c
+-c       Find the rank of a.
+-c
+-        call idd_estrank(eps,m,n,a,work,kranki,proj)
+-c
+-c
+-        if(kranki .eq. 0) call iddp_aid0(eps,m,n,a,krank,list,proj,
+-     1                                   proj(m*n+1))
+-c
+-        if(kranki .ne. 0) call iddp_aid1(eps,n2,n,kranki,proj,
+-     1                                   krank,list,proj(n2*n+1))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_aid0(eps,m,n,a,krank,list,proj,rnorms)
+-c
+-c       uses routine iddp_id to ID a without modifying its entries
+-c       (in contrast to the usual behavior of iddp_id).
+-c
+-c       input:
+-c       eps -- precision of the decomposition to be constructed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c
+-c       output:
+-c       krank -- numerical rank of the ID
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns in a;
+-c               proj doubles as a work array in the present routine, so
+-c               must be at least m*n real*8 elements long
+-c
+-c       work:
+-c       rnorms -- must be at least n real*8 elements long
+-c
+-c       _N.B._: proj must be at least m*n real*8 elements long
+-c
+-        implicit none
+-        integer m,n,krank,list(n),j,k
+-        real*8 eps,a(m,n),proj(m,n),rnorms(n)
+-c
+-c
+-c       Copy a into proj.
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            proj(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       ID proj.
+-c
+-        call iddp_id(eps,m,n,proj,krank,list,rnorms)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_aid1(eps,n2,n,kranki,proj,krank,list,rnorms)
+-c
+-c       IDs the uppermost kranki x n block of the n2 x n matrix
+-c       input as proj.
+-c
+-c       input:
+-c       eps -- precision of the decomposition to be constructed
+-c       n2 -- first dimension of proj as input
+-c       n -- second dimension of proj as input
+-c       kranki -- number of rows to extract from proj
+-c       proj -- matrix containing the kranki x n block to be ID'd
+-c
+-c       output:
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd
+-c       krank -- numerical rank of the ID
+-c       list -- indices of the columns in the ID
+-c
+-c       work:
+-c       rnorms -- must be at least n real*8 elements long
+-c
+-        implicit none
+-        integer n,n2,kranki,krank,list(n),j,k
+-        real*8 eps,proj(n2*n),rnorms(n)
+-c
+-c
+-c       Move the uppermost kranki x n block of the n2 x n matrix proj
+-c       to the beginning of proj.
+-c
+-        do k = 1,n
+-          do j = 1,kranki
+-            proj(j+kranki*(k-1)) = proj(j+n2*(k-1))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       ID proj.
+-c
+-        call iddp_id(eps,kranki,n,proj,krank,list,rnorms)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_estrank(eps,m,n,a,w,krank,ra)
+-c
+-c       estimates the numerical rank krank of an m x n matrix a
+-c       to precision eps. This routine applies n2 random vectors
+-c       to a, obtaining ra, where n2 is the greatest integer
+-c       less than or equal to m such that n2 is a positive integer
+-c       power of two. krank is typically about 8 higher than
+-c       the actual numerical rank.
+-c
+-c       input:
+-c       eps -- precision defining the numerical rank
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix whose rank is to be estimated
+-c       w -- initialization array that has been constructed
+-c            by routine idd_frmi
+-c
+-c       output:
+-c       krank -- estimate of the numerical rank of a;
+-c                this routine returns krank = 0 when the actual
+-c                numerical rank is nearly full (that is,
+-c                greater than n - 8 or n2 - 8)
+-c       ra -- product of an n2 x m random matrix and the m x n matrix
+-c             a, where n2 is the greatest integer less than or equal
+-c             to m such that n2 is a positive integer power of two;
+-c             ra doubles as a work array in the present routine, and so
+-c             must be at least n*n2+(n+1)*(n2+1) real*8 elements long
+-c
+-c       _N.B._: ra must be at least n*n2+(n2+1)*(n+1) real*8
+-c               elements long for use in the present routine
+-c               (here, n2 is the greatest integer less than or equal
+-c               to m, such that n2 is a positive integer power of two).
+-c               This routine returns krank = 0 when the actual
+-c               numerical rank is nearly full.
+-c
+-        implicit none
+-        integer m,n,krank,n2,irat,lrat,iscal,lscal,ira,lra,lra2
+-        real*8 eps,a(m,n),ra(*),w(17*m+70)
+-c
+-c
+-c       Extract from the array w initialized by routine idd_frmi
+-c       the greatest integer less than or equal to m that is
+-c       a positive integer power of two.
+-c
+-        n2 = w(2)
+-c
+-c
+-c       Allocate memory in ra.
+-c
+-        lra = 0
+-c
+-        ira = lra+1
+-        lra2 = n2*n
+-        lra = lra+lra2
+-c
+-        irat = lra+1
+-        lrat = n*(n2+1)
+-        lra = lra+lrat
+-c
+-        iscal = lra+1
+-        lscal = n2+1
+-        lra = lra+lscal
+-c
+-        call idd_estrank0(eps,m,n,a,w,n2,krank,ra(ira),ra(irat),
+-     1                    ra(iscal))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_estrank0(eps,m,n,a,w,n2,krank,ra,rat,scal)
+-c
+-c       routine idd_estrank serves as a memory wrapper
+-c       for the present routine. (Please see routine idd_estrank
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,n2,krank,ifrescal,k,nulls,j
+-        real*8 a(m,n),ra(n2,n),scal(n2+1),eps,residual,
+-     1         w(17*m+70),rat(n,n2+1),ss,ssmax
+-c
+-c
+-c       Apply the random matrix to every column of a, obtaining ra.
+-c
+-        do k = 1,n
+-          call idd_frm(m,n2,w,a(1,k),ra(1,k))
+-        enddo ! k
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of ra
+-c       and the maximum of all such sums.
+-c
+-        ssmax = 0
+-c
+-        do k = 1,n
+-c
+-          ss = 0
+-          do j = 1,m
+-            ss = ss+a(j,k)**2
+-          enddo ! j
+-c
+-          if(ss .gt. ssmax) ssmax = ss
+-c
+-        enddo ! k
+-c
+-c
+-c       Transpose ra to obtain rat.
+-c
+-        call idd_atransposer(n2,n,ra,rat)
+-c
+-c
+-        krank = 0
+-        nulls = 0
+-c
+-c
+-c       Loop until nulls = 7, krank+nulls = n2, or krank+nulls = n.
+-c
+- 1000   continue
+-c
+-c
+-          if(krank .gt. 0) then
+-c
+-c           Apply the previous Householder transformations
+-c           to rat(:,krank+1).
+-c
+-            ifrescal = 0
+-c
+-            do k = 1,krank
+-              call idd_houseapp(n-k+1,rat(1,k),rat(k,krank+1),
+-     1                          ifrescal,scal(k),rat(k,krank+1))
+-            enddo ! k
+-c
+-          endif ! krank .gt. 0
+-c
+-c
+-c         Compute the Householder vector associated
+-c         with rat(krank+1:*,krank+1).
+-c
+-          call idd_house(n-krank,rat(krank+1,krank+1),
+-     1                   residual,rat(1,krank+1),scal(krank+1))
+-          residual = abs(residual)
+-c
+-c
+-          krank = krank+1
+-          if(residual .le. eps*sqrt(ssmax)) nulls = nulls+1
+-c
+-c
+-        if(nulls .lt. 7 .and. krank+nulls .lt. n2
+-     1   .and. krank+nulls .lt. n)
+-     2   goto 1000
+-c
+-c
+-        if(nulls .lt. 7) krank = 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_atransposer(m,n,a,at)
+-c
+-c       transposes a to obtain at.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of at
+-c       n -- second dimension of a, and first dimension of at
+-c       a -- matrix to be transposed
+-c
+-c       output:
+-c       at -- transpose of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        real*8 a(m,n),at(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-c
+-            at(k,j) = a(j,k)
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddp_asvd.f b/scipy/linalg/src/id_dist/src/iddp_asvd.f
+deleted file mode 100644
+index a3dea4611..000000000
+--- a/scipy/linalg/src/id_dist/src/iddp_asvd.f
++++ /dev/null
+@@ -1,180 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_asvd computes the SVD, to a specified precision,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddp_asvd(lw,eps,m,n,a,winit,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^T  approximating a
+-c       to precision eps, where U is an m x krank matrix whose
+-c       columns are orthonormal, V is an n x krank matrix whose
+-c       columns are orthonormal, and Sigma is a diagonal krank x krank
+-c       matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       lw -- maximum usable length (in real*8 elements)
+-c             of the array w
+-c       eps -- precision of the desired approximation
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be approximated; the present routine does not
+-c            alter a
+-c       winit -- initialization array that has been constructed
+-c                by routine idd_frmi
+-c
+-c       output:
+-c       krank -- rank of the SVD constructed
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            max( (krank+1)*(3*m+5*n+1)+25*krank**2, (2*n+1)*(n2+1) )
+-c            real*8 elements long, where n2 is the greatest integer
+-c            less than or equal to m, such that n2 is
+-c            a positive integer power of two; krank is the rank output
+-c            by this routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when idd_id2svd bombs
+-c
+-c       _N.B._: w must be at least
+-c               max( (krank+1)*(3*m+5*n+1)+25*krank^2, (2*n+1)*(n2+1) )
+-c               real*8 elements long, where n2 is the greatest integer
+-c               less than or equal to m, such that n2 is
+-c               a positive integer power of two;
+-c               krank is the rank output by this routine.
+-c               Also, the algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,k,ier,lw2,iu,iv,is,iui,ivi,isi,lu,lv,ls
+-        real*8 eps,a(m,n),winit(17*m+70),w(*)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw2 = 0
+-c
+-        ilist = lw2+1
+-        llist = n
+-        lw2 = lw2+llist
+-c
+-        iproj = lw2+1
+-c
+-c
+-c       ID a.
+-c
+-        call iddp_aid(eps,m,n,a,winit,krank,w(ilist),w(iproj))
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Allocate more memory in w.
+-c
+-          lproj = krank*(n-krank)
+-          lw2 = lw2+lproj
+-c
+-          icol = lw2+1
+-          lcol = m*krank
+-          lw2 = lw2+lcol
+-c
+-          iui = lw2+1
+-          lu = m*krank
+-          lw2 = lw2+lu
+-c
+-          ivi = lw2+1
+-          lv = n*krank
+-          lw2 = lw2+lv
+-c
+-          isi = lw2+1
+-          ls = krank
+-          lw2 = lw2+ls
+-c
+-          iwork = lw2+1
+-          lwork = (krank+1)*(m+3*n)+26*krank**2
+-          lw2 = lw2+lwork
+-c
+-c
+-          if(lw .lt. lw2) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-          call iddp_asvd0(m,n,a,krank,w(ilist),w(iproj),
+-     1                    w(iui),w(ivi),w(isi),ier,w(icol),w(iwork))
+-          if(ier .ne. 0) return
+-c
+-c
+-          iu = 1
+-          iv = iu+lu
+-          is = iv+lv
+-c
+-c
+-c         Copy the singular values and singular vectors
+-c         into their proper locations.
+-c
+-          do k = 1,lu
+-            w(iu+k-1) = w(iui+k-1)
+-          enddo ! k
+-c
+-          do k = 1,lv
+-            w(iv+k-1) = w(ivi+k-1)
+-          enddo ! k
+-c
+-          do k = 1,ls
+-            w(is+k-1) = w(isi+k-1)
+-          enddo ! k
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_asvd0(m,n,a,krank,list,proj,u,v,s,ier,
+-     1                        col,work)
+-c
+-c       routine iddp_asvd serves as a memory wrapper
+-c       for the present routine (please see routine iddp_asvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 a(m,n),u(m,krank),v(n,krank),
+-     1         s(krank),proj(krank,n-krank),col(m,krank),
+-     2         work((krank+1)*(m+3*n)+26*krank**2)
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idd_copycols(m,n,a,krank,list,col)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idd_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddp_rid.f b/scipy/linalg/src/id_dist/src/iddp_rid.f
+deleted file mode 100644
+index 93b255f15..000000000
+--- a/scipy/linalg/src/id_dist/src/iddp_rid.f
++++ /dev/null
+@@ -1,376 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_rid computes the ID, to a specified precision,
+-c       of a matrix specified by a routine for applying its transpose
+-c       to arbitrary vectors. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddp_rid(lproj,eps,m,n,matvect,p1,p2,p3,p4,
+-     1                      krank,list,proj,ier)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c
+-c       input:
+-c       lproj -- maximum usable length (in real*8 elements)
+-c                of the array proj
+-c       eps -- precision to which the ID is to be computed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matvect -- routine which applies the transpose
+-c                  of the matrix to be ID'd to an arbitrary vector;
+-c                  this routine must have a calling sequence
+-c                  of the form
+-c
+-c                  matvect(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transposed matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvect
+-c       p2 -- parameter to be passed to routine matvect
+-c       p3 -- parameter to be passed to routine matvect
+-c       p4 -- parameter to be passed to routine matvect
+-c
+-c       output:
+-c       krank -- numerical rank
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               the present routine uses proj as a work array, too, so
+-c               proj must be at least m+1 + 2*n*(krank+1) real*8
+-c               elements long, where krank is the rank output
+-c               by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lproj is too small
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least m+1 + 2*n*(krank+1) real*8
+-c               elements long, where krank is the rank output
+-c               by the present routine.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,list(n),krank,lw,iwork,lwork,ira,kranki,lproj,
+-     1          lra,ier,k
+-        real*8 eps,p1,p2,p3,p4,proj(*)
+-        external matvect
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Allocate memory in proj.
+-c
+-        lw = 0
+-c
+-        iwork = lw+1
+-        lwork = m+2*n+1
+-        lw = lw+lwork
+-c
+-        ira = lw+1
+-c
+-c
+-c       Find the rank of a.
+-c
+-        lra = lproj-lwork
+-        call idd_findrank(lra,eps,m,n,matvect,p1,p2,p3,p4,
+-     1                    kranki,proj(ira),ier,proj(iwork))
+-        if(ier .ne. 0) return
+-c
+-c
+-        if(lproj .lt. lwork+2*kranki*n) then
+-          ier = -1000
+-          return
+-        endif
+-c
+-c
+-c       Transpose ra.
+-c
+-        call idd_rtransposer(n,kranki,proj(ira),proj(ira+kranki*n))
+-c
+-c
+-c       Move the tranposed matrix to the beginning of proj.
+-c
+-        do k = 1,kranki*n
+-          proj(k) = proj(ira+kranki*n+k-1)
+-        enddo ! k
+-c
+-c
+-c       ID the transposed matrix.
+-c
+-        call iddp_id(eps,kranki,n,proj,krank,list,proj(1+kranki*n))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_findrank(lra,eps,m,n,matvect,p1,p2,p3,p4,
+-     1                          krank,ra,ier,w)
+-c
+-c       estimates the numerical rank krank of a matrix a to precision
+-c       eps, where the routine matvect applies the transpose of a
+-c       to an arbitrary vector. This routine applies the transpose of a
+-c       to krank random vectors, and returns the resulting vectors
+-c       as the columns of ra.
+-c
+-c       input:
+-c       lra -- maximum usable length (in real*8 elements) of array ra
+-c       eps -- precision defining the numerical rank
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matvect -- routine which applies the transpose
+-c                  of the matrix whose rank is to be estimated
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvect(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transposed matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvect
+-c       p2 -- parameter to be passed to routine matvect
+-c       p3 -- parameter to be passed to routine matvect
+-c       p4 -- parameter to be passed to routine matvect
+-c
+-c       output:
+-c       krank -- estimate of the numerical rank of a
+-c       ra -- product of the transpose of a and a matrix whose entries
+-c             are pseudorandom realizations of i.i.d. random numbers,
+-c             uniformly distributed on [0,1];
+-c             ra must be at least 2*n*krank real*8 elements long
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lra is too small
+-c
+-c       work:
+-c       w -- must be at least m+2*n+1 real*8 elements long
+-c
+-c       _N.B._: ra must be at least 2*n*krank real*8 elements long.
+-c               Also, the algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,lw,krank,ix,lx,iy,ly,iscal,lscal,lra,ier
+-        real*8 eps,p1,p2,p3,p4,ra(n,*),w(m+2*n+1)
+-        external matvect
+-c
+-c
+-        lw = 0
+-c
+-        ix = lw+1
+-        lx = m
+-        lw = lw+lx
+-c
+-        iy = lw+1
+-        ly = n
+-        lw = lw+ly
+-c
+-        iscal = lw+1
+-        lscal = n+1
+-        lw = lw+lscal
+-c
+-c
+-        call idd_findrank0(lra,eps,m,n,matvect,p1,p2,p3,p4,
+-     1                     krank,ra,ier,w(ix),w(iy),w(iscal))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_findrank0(lra,eps,m,n,matvect,p1,p2,p3,p4,
+-     1                           krank,ra,ier,x,y,scal)
+-c
+-c       routine idd_findrank serves as a memory wrapper
+-c       for the present routine. (Please see routine idd_findrank
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,krank,ifrescal,k,lra,ier
+-        real*8 x(m),ra(n,2,*),p1,p2,p3,p4,scal(n+1),y(n),eps,residual,
+-     1         enorm
+-        external matvect
+-c
+-c
+-        ier = 0
+-c
+-c
+-        krank = 0
+-c
+-c
+-c       Loop until the relative residual is greater than eps,
+-c       or krank = m or krank = n.
+-c
+- 1000   continue
+-c
+-c
+-          if(lra .lt. n*2*(krank+1)) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-c         Apply the transpose of a to a random vector.
+-c
+-          call id_srand(m,x)
+-          call matvect(m,x,n,ra(1,1,krank+1),p1,p2,p3,p4)
+-c
+-          do k = 1,n
+-            y(k) = ra(k,1,krank+1)
+-          enddo ! k
+-c
+-c
+-          if(krank .eq. 0) then
+-c
+-c           Compute the Euclidean norm of y.
+-c
+-            enorm = 0
+-c
+-            do k = 1,n
+-              enorm = enorm + y(k)**2
+-            enddo ! k
+-c
+-            enorm = sqrt(enorm)
+-c
+-          endif ! krank .eq. 0
+-c
+-c
+-          if(krank .gt. 0) then
+-c
+-c           Apply the previous Householder transformations to y.
+-c
+-            ifrescal = 0
+-c
+-            do k = 1,krank
+-              call idd_houseapp(n-k+1,ra(1,2,k),y(k),
+-     1                          ifrescal,scal(k),y(k))
+-            enddo ! k
+-c
+-          endif ! krank .gt. 0
+-c
+-c
+-c         Compute the Householder vector associated with y.
+-c
+-          call idd_house(n-krank,y(krank+1),
+-     1                   residual,ra(1,2,krank+1),scal(krank+1))
+-          residual = abs(residual)
+-c
+-c
+-          krank = krank+1
+-c
+-c
+-        if(residual .gt. eps*enorm
+-     1   .and. krank .lt. m .and. krank .lt. n)
+-     2   goto 1000
+-c
+-c
+-c       Delete the Householder vectors from the array ra.
+-c
+-        call idd_crunch(n,krank,ra)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_crunch(n,l,a)
+-c
+-c       removes every other block of n entries from a vector.
+-c
+-c       input:
+-c       n -- length of each block to remove
+-c       l -- half of the total number of blocks
+-c       a -- original array
+-c
+-c       output:
+-c       a -- array with every other block of n entries removed
+-c
+-        implicit none
+-        integer j,k,n,l
+-        real*8 a(n,2*l)
+-c
+-c
+-        do j = 2,l
+-          do k = 1,n
+-c
+-            a(k,j) = a(k,2*j-1)
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idd_rtransposer(m,n,a,at)
+-c
+-c       transposes a to obtain at.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of at
+-c       n -- second dimension of a, and first dimension of at
+-c       a -- matrix to be transposed
+-c
+-c       output:
+-c       at -- transpose of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        real*8 a(m,n),at(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-c
+-            at(k,j) = a(j,k)
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddp_rsvd.f b/scipy/linalg/src/id_dist/src/iddp_rsvd.f
+deleted file mode 100644
+index 8af9ba04c..000000000
+--- a/scipy/linalg/src/id_dist/src/iddp_rsvd.f
++++ /dev/null
+@@ -1,216 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddp_rsvd computes the SVD, to a specified precision,
+-c       of a matrix specified by routines for applying the matrix
+-c       and its transpose to arbitrary vectors.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddp_rsvd(lw,eps,m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                       matvec,p1,p2,p3,p4,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^T  approximating a
+-c       to precision eps, where matvect is a routine which applies a^T
+-c       to an arbitrary vector, and matvec is a routine
+-c       which applies a to an arbitrary vector; U is an m x krank
+-c       matrix whose columns are orthonormal, V is an n x krank
+-c       matrix whose columns are orthonormal, and Sigma is a diagonal
+-c       krank x krank matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       lw -- maximum usable length (in real*8 elements)
+-c             of the array w
+-c       eps -- precision of the desired approximation
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matvect -- routine which applies the transpose
+-c                  of the matrix to be SVD'd
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvect(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transposed matrix and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matvect
+-c       p2t -- parameter to be passed to routine matvect
+-c       p3t -- parameter to be passed to routine matvect
+-c       p4t -- parameter to be passed to routine matvect
+-c       matvec -- routine which applies the matrix to be SVD'd
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c
+-c       output:
+-c       krank -- rank of the SVD constructed
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            (krank+1)*(3*m+5*n+1)+25*krank**2 real*8 elements long,
+-c            where krank is the rank returned by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when idd_id2svd bombs
+-c
+-c       _N.B._: w must be at least (krank+1)*(3*m+5*n+1)+25*krank**2
+-c               real*8 elements long, where krank is the rank
+-c               returned by the present routine. Also, the algorithm
+-c               used by the present routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,lw2,ilist,llist,iproj,icol,lcol,lp,
+-     1          iwork,lwork,ier,lproj,iu,iv,is,lu,lv,ls,iui,ivi,isi,k
+-        real*8 eps,p1t,p2t,p3t,p4t,p1,p2,p3,p4,w(*)
+-        external matvect,matvec
+-c
+-c
+-c       Allocate some memory.
+-c
+-        lw2 = 0
+-c
+-        ilist = lw2+1
+-        llist = n
+-        lw2 = lw2+llist
+-c
+-        iproj = lw2+1
+-c
+-c
+-c       ID a.
+-c
+-        lp = lw-lw2
+-        call iddp_rid(lp,eps,m,n,matvect,p1t,p2t,p3t,p4t,krank,
+-     1                w(ilist),w(iproj),ier)
+-        if(ier .ne. 0) return
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Allocate more memory.
+-c
+-          lproj = krank*(n-krank)
+-          lw2 = lw2+lproj
+-c
+-          icol = lw2+1
+-          lcol = m*krank
+-          lw2 = lw2+lcol
+-c
+-          iui = lw2+1
+-          lu = m*krank
+-          lw2 = lw2+lu
+-c
+-          ivi = lw2+1
+-          lv = n*krank
+-          lw2 = lw2+lv
+-c
+-          isi = lw2+1
+-          ls = krank
+-          lw2 = lw2+ls
+-c
+-          iwork = lw2+1
+-          lwork = (krank+1)*(m+3*n)+26*krank**2
+-          lw2 = lw2+lwork
+-c
+-c
+-          if(lw .lt. lw2) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-          call iddp_rsvd0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                    matvec,p1,p2,p3,p4,krank,w(iui),w(ivi),
+-     2                    w(isi),ier,w(ilist),w(iproj),w(icol),
+-     3                    w(iwork))
+-          if(ier .ne. 0) return
+-c
+-c
+-          iu = 1
+-          iv = iu+lu
+-          is = iv+lv
+-c
+-c
+-c         Copy the singular values and singular vectors
+-c         into their proper locations.
+-c
+-          do k = 1,lu
+-            w(iu+k-1) = w(iui+k-1)
+-          enddo ! k
+-c
+-          do k = 1,lv
+-            w(iv+k-1) = w(ivi+k-1)
+-          enddo ! k
+-c
+-          do k = 1,ls
+-            w(is+k-1) = w(isi+k-1)
+-          enddo ! k
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddp_rsvd0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                        matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                        list,proj,col,work)
+-c
+-c       routine iddp_rsvd serves as a memory wrapper
+-c       for the present routine (please see routine iddp_rsvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1         s(krank),proj(krank,n-krank),col(m*krank),
+-     2         work((krank+1)*(m+3*n)+26*krank**2)
+-        external matvect,matvec
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idd_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,col,work)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idd_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddr_aid.f b/scipy/linalg/src/id_dist/src/iddr_aid.f
+deleted file mode 100644
+index 2dc811148..000000000
+--- a/scipy/linalg/src/id_dist/src/iddr_aid.f
++++ /dev/null
+@@ -1,208 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddr_aid computes the ID, to a specified rank,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c       routine iddr_aidi initializes routine iddr_aid.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddr_aid(m,n,a,krank,w,list,proj)
+-c
+-c       computes the ID of the matrix a, i.e., lists in list
+-c       the indices of krank columns of a such that 
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                       min(m,n,krank)
+-c       a(j,list(k))  =     Sigma      a(j,list(l)) * proj(l,k-krank)(*)
+-c                            l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be ID'd; the present routine does not alter a
+-c       krank -- rank of the ID to be constructed
+-c       w -- initialization array that routine iddr_aidi
+-c            has constructed
+-c
+-c       output:
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,krank,list(n),lw,ir,lr,lw2,iw
+-        real*8 a(m,n),proj(krank*(n-krank)),w((2*krank+17)*n+27*m+100)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iw = lw+1
+-        lw2 = 27*m+100+n
+-        lw = lw+lw2
+-c
+-        ir = lw+1
+-        lr = (krank+8)*2*n
+-        lw = lw+lr
+-c
+-c
+-        call iddr_aid0(m,n,a,krank,w(iw),list,proj,w(ir))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_aid0(m,n,a,krank,w,list,proj,r)
+-c
+-c       routine iddr_aid serves as a memory wrapper
+-c       for the present routine
+-c       (see iddr_aid for further documentation).
+-c
+-        implicit none
+-        integer k,l,m,n2,n,krank,list(n),mn,lproj
+-        real*8 a(m,n),r(krank+8,2*n),proj(krank,n-krank),
+-     1         w(27*m+100+n)
+-c
+-c       Please note that the second dimension of r is 2*n
+-c       (instead of n) so that if krank+8 >= m/2, then
+-c       we can copy the whole of a into r.
+-c
+-c
+-c       Retrieve the number of random test vectors
+-c       and the greatest integer less than m that is
+-c       a positive integer power of two.
+-c
+-        l = w(1)
+-        n2 = w(2)
+-c
+-c
+-        if(l .lt. n2 .and. l .le. m) then
+-c
+-c         Apply the random matrix.
+-c
+-          do k = 1,n
+-            call idd_sfrm(l,m,n2,w(11),a(1,k),r(1,k))
+-          enddo ! k
+-c
+-c         ID r.
+-c
+-          call iddr_id(l,n,r,krank,list,w(26*m+101))
+-c
+-c         Retrieve proj from r.
+-c
+-          lproj = krank*(n-krank)
+-          call iddr_copydarr(lproj,r,proj)
+-c
+-        endif
+-c
+-c
+-        if(l .ge. n2 .or. l .gt. m) then
+-c
+-c         ID a directly.
+-c
+-          mn = m*n
+-          call iddr_copydarr(mn,a,r)
+-          call iddr_id(m,n,r,krank,list,w(26*m+101))
+-c
+-c         Retrieve proj from r.
+-c
+-          lproj = krank*(n-krank)
+-          call iddr_copydarr(lproj,r,proj)
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_copydarr(n,a,b)
+-c
+-c       copies a into b.
+-c
+-c       input:
+-c       n -- length of a and b
+-c       a -- array to copy into b
+-c
+-c       output:
+-c       b -- copy of a
+-c
+-        implicit none
+-        integer n,k
+-        real*8 a(n),b(n)
+-c
+-c
+-        do k = 1,n
+-          b(k) = a(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_aidi(m,n,krank,w)
+-c
+-c       initializes the array w for using routine iddr_aid.
+-c
+-c       input:
+-c       m -- number of rows in the matrix to be ID'd
+-c       n -- number of columns in the matrix to be ID'd
+-c       krank -- rank of the ID to be constructed
+-c
+-c       output:
+-c       w -- initialization array for using routine iddr_aid
+-c
+-        implicit none
+-        integer m,n,krank,l,n2
+-        real*8 w((2*krank+17)*n+27*m+100)
+-c
+-c
+-c       Set the number of random test vectors to 8 more than the rank.
+-c
+-        l = krank+8
+-        w(1) = l
+-c
+-c
+-c       Initialize the rest of the array w.
+-c
+-        n2 = 0
+-        if(l .le. m) call idd_sfrmi(l,m,n2,w(11))
+-        w(2) = n2
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddr_asvd.f b/scipy/linalg/src/id_dist/src/iddr_asvd.f
+deleted file mode 100644
+index 9641f0cd6..000000000
+--- a/scipy/linalg/src/id_dist/src/iddr_asvd.f
++++ /dev/null
+@@ -1,114 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddr_aid computes the SVD, to a specified rank,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddr_asvd(m,n,a,krank,w,u,v,s,ier)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^T  approximating a,
+-c       where u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be decomposed; the present routine does not
+-c            alter a
+-c       krank -- rank of the SVD being constructed
+-c       w -- initialization array that routine iddr_aidi
+-c            has constructed (for use in the present routine, w must
+-c            be at least (2*krank+28)*m+(6*krank+21)*n+25*krank**2+100
+-c            real*8 elements long)
+-c
+-c       output:
+-c       u -- matrix of orthonormal left singular vectors of a
+-c       v -- matrix of orthonormal right singular vectors of a
+-c       s -- array of singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,iwinit,lwinit,ier
+-        real*8 a(m,n),u(m,krank),v(n,krank),s(krank),
+-     1         w((2*krank+28)*m+(6*krank+21)*n+25*krank**2+100)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iwinit = lw+1
+-        lwinit = (2*krank+17)*n+27*m+100
+-        lw = lw+lwinit
+-c
+-        ilist = lw+1
+-        llist = n
+-        lw = lw+llist
+-c
+-        iproj = lw+1
+-        lproj = krank*(n-krank)
+-        lw = lw+lproj
+-c
+-        icol = lw+1
+-        lcol = m*krank
+-        lw = lw+lcol
+-c
+-        iwork = lw+1
+-        lwork = (krank+1)*(m+3*n)+26*krank**2
+-        lw = lw+lwork
+-c
+-c
+-        call iddr_asvd0(m,n,a,krank,w(iwinit),u,v,s,ier,
+-     1                  w(ilist),w(iproj),w(icol),w(iwork))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_asvd0(m,n,a,krank,winit,u,v,s,ier,
+-     1                        list,proj,col,work)
+-c
+-c       routine iddr_asvd serves as a memory wrapper
+-c       for the present routine (please see routine iddr_asvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 a(m,n),u(m,krank),v(n,krank),s(krank),
+-     1         proj(krank,n-krank),col(m*krank),
+-     2         winit((2*krank+17)*n+27*m+100),
+-     3         work((krank+1)*(m+3*n)+26*krank**2)
+-c
+-c
+-c       ID a.
+-c
+-        call iddr_aid(m,n,a,krank,winit,list,proj)
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idd_copycols(m,n,a,krank,list,col)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idd_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddr_rid.f b/scipy/linalg/src/id_dist/src/iddr_rid.f
+deleted file mode 100644
+index eb96c145a..000000000
+--- a/scipy/linalg/src/id_dist/src/iddr_rid.f
++++ /dev/null
+@@ -1,155 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddr_rid computes the ID, to a specified rank,
+-c       of a matrix specified by a routine for applying its transpose
+-c       to arbitrary vectors. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddr_rid(m,n,matvect,p1,p2,p3,p4,krank,list,proj)
+-c
+-c       computes the ID of a matrix "a" specified by
+-c       the routine matvect -- matvect must apply the transpose
+-c       of the matrix being ID'd to an arbitrary vector --
+-c       i.e., the present routine lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                       min(m,n,krank)
+-c       a(j,list(k))  =     Sigma      a(j,list(l)) * proj(l,k-krank)(*)
+-c                            l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c
+-c       input:
+-c       m -- number of rows in the matrix to be ID'd
+-c       n -- number of columns in the matrix to be ID'd
+-c       matvect -- routine which applies the transpose
+-c                  of the matrix to be ID'd to an arbitrary vector;
+-c                  this routine must have a calling sequence
+-c                  of the form
+-c
+-c                  matvect(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transposed matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvect
+-c       p2 -- parameter to be passed to routine matvect
+-c       p3 -- parameter to be passed to routine matvect
+-c       p4 -- parameter to be passed to routine matvect
+-c       krank -- rank of the ID to be constructed
+-c
+-c       output:
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               proj doubles as a work array in the present routine, so
+-c               proj must be at least m+(krank+3)*n real*8 elements
+-c               long
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least m+(krank+3)*n real*8 elements
+-c               long.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,krank,list(n),lw,ix,lx,iy,ly,ir,lr
+-        real*8 p1,p2,p3,p4,proj(m+(krank+3)*n)
+-        external matvect
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        ir = lw+1
+-        lr = (krank+2)*n
+-        lw = lw+lr
+-c
+-        ix = lw+1
+-        lx = m
+-        lw = lw+lx
+-c
+-        iy = lw+1
+-        ly = n
+-        lw = lw+ly
+-c
+-c
+-        call iddr_ridall0(m,n,matvect,p1,p2,p3,p4,krank,
+-     1                    list,proj(ir),proj(ix),proj(iy))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_ridall0(m,n,matvect,p1,p2,p3,p4,krank,
+-     1                          list,r,x,y)
+-c
+-c       routine iddr_ridall serves as a memory wrapper
+-c       for the present routine
+-c       (see iddr_ridall for further documentation).
+-c
+-        implicit none
+-        integer j,k,l,m,n,krank,list(n)
+-        real*8 x(m),y(n),p1,p2,p3,p4,r(krank+2,n)
+-        external matvect
+-c
+-c
+-c       Set the number of random test vectors to 2 more than the rank.
+-c
+-        l = krank+2
+-c
+-c       Apply the transpose of the original matrix to l random vectors.
+-c
+-        do j = 1,l
+-c
+-c         Generate a random vector.
+-c
+-          call id_srand(m,x)
+-c
+-c         Apply the transpose of the matrix to x, obtaining y.
+-c
+-          call matvect(m,x,n,y,p1,p2,p3,p4)
+-c
+-c         Copy y into row j of r.
+-c
+-          do k = 1,n
+-            r(j,k) = y(k)
+-          enddo ! k
+-c
+-        enddo ! j
+-c
+-c
+-c       ID r.
+-c
+-        call iddr_id(l,n,r,krank,list,y)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/iddr_rsvd.f b/scipy/linalg/src/id_dist/src/iddr_rsvd.f
+deleted file mode 100644
+index 000ce8693..000000000
+--- a/scipy/linalg/src/id_dist/src/iddr_rsvd.f
++++ /dev/null
+@@ -1,157 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine iddr_rsvd computes the SVD, to a specified rank,
+-c       of a matrix specified by routines for applying the matrix
+-c       and its transpose to arbitrary vectors.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine iddr_rsvd(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                       matvec,p1,p2,p3,p4,krank,u,v,s,ier,w)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^T  approximating a,
+-c       where matvect is a routine which applies a^T
+-c       to an arbitrary vector, and matvec is a routine
+-c       which applies a to an arbitrary vector;
+-c       u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matvect -- routine which applies the transpose
+-c                  of the matrix to be SVD'd
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvect(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the transpose
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the transposed matrix and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matvect
+-c       p2t -- parameter to be passed to routine matvect
+-c       p3t -- parameter to be passed to routine matvect
+-c       p4t -- parameter to be passed to routine matvect
+-c       matvec -- routine which applies the matrix to be SVD'd
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       krank -- rank of the SVD being constructed
+-c
+-c       output:
+-c       u -- matrix of orthonormal left singular vectors of a
+-c       v -- matrix of orthonormal right singular vectors of a
+-c       s -- array of singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       work:
+-c       w -- must be at least (krank+1)*(2*m+4*n)+25*krank**2
+-c            real*8 elements long
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,ier
+-        real*8 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1         s(krank),w((krank+1)*(2*m+4*n)+25*krank**2)
+-        external matvect,matvec
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        ilist = lw+1
+-        llist = n
+-        lw = lw+llist
+-c
+-        iproj = lw+1
+-        lproj = krank*(n-krank)
+-        lw = lw+lproj
+-c
+-        icol = lw+1
+-        lcol = m*krank
+-        lw = lw+lcol
+-c
+-        iwork = lw+1
+-        lwork = (krank+1)*(m+3*n)+26*krank**2
+-        lw = lw+lwork
+-c
+-c
+-        call iddr_rsvd0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                  matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                  w(ilist),w(iproj),w(icol),w(iwork))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine iddr_rsvd0(m,n,matvect,p1t,p2t,p3t,p4t,
+-     1                        matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                        list,proj,col,work)
+-c
+-c       routine iddr_rsvd serves as a memory wrapper
+-c       for the present routine (please see routine iddr_rsvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier,k
+-        real*8 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1         s(krank),proj(krank*(n-krank)),col(m*krank),
+-     2         work((krank+1)*(m+3*n)+26*krank**2)
+-        external matvect,matvec
+-c
+-c
+-c       ID a.
+-c
+-        call iddr_rid(m,n,matvect,p1t,p2t,p3t,p4t,krank,list,work)
+-c
+-c
+-c       Retrieve proj from work.
+-c
+-        do k = 1,krank*(n-krank)
+-          proj(k) = work(k)
+-        enddo ! k
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idd_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,col,work)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idd_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_frm.f b/scipy/linalg/src/id_dist/src/idz_frm.f
+deleted file mode 100644
+index 93c4d8ec7..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_frm.f
++++ /dev/null
+@@ -1,419 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idz_frm transforms a vector via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c
+-c       routine idz_sfrm transforms a vector into a vector
+-c       of specified length via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c
+-c       routine idz_frmi initializes routine idz_frm.
+-c
+-c       routine idz_sfrmi initializes routine idz_sfrm.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_frm(m,n,w,x,y)
+-c
+-c       transforms x into y via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c       In contrast to routine idz_sfrm, the present routine works best
+-c       when the length of the transformed vector is the integer n
+-c       output by routine idz_frmi, or when the length
+-c       is not specified, but instead determined a posteriori
+-c       using the output of the present routine. The transformed vector
+-c       output by the present routine is randomly permuted.
+-c
+-c       input:
+-c       m -- length of x
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m, as obtained
+-c            from the routine idz_frmi; n is the length of y
+-c       w -- initialization array constructed by routine idz_frmi
+-c       x -- vector to be transformed
+-c
+-c       output:
+-c       y -- transform of x
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,iw,n,k
+-        complex*16 w(17*m+70),x(m),y(n)
+-c
+-c
+-c       Apply Rokhlin's random transformation to x, obtaining
+-c       w(16*m+71 : 17*m+70).
+-c
+-        iw = w(3+m+n)
+-        call idz_random_transf(x,w(16*m+70+1),w(iw))
+-c
+-c
+-c       Subselect from  w(16*m+71 : 17*m+70)  to obtain y.
+-c
+-        call idz_subselect(n,w(3),m,w(16*m+70+1),y)
+-c
+-c
+-c       Copy y into  w(16*m+71 : 16*m+n+70).
+-c
+-        do k = 1,n
+-          w(16*m+70+k) = y(k)
+-        enddo ! k
+-c
+-c
+-c       Fourier transform  w(16*m+71 : 16*m+n+70).
+-c
+-        call zfftf(n,w(16*m+70+1),w(4+m+n))
+-c
+-c
+-c       Permute  w(16*m+71 : 16*m+n+70)  to obtain y.
+-c
+-        call idz_permute(n,w(3+m),w(16*m+70+1),y)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_sfrm(l,m,n,w,x,y)
+-c
+-c       transforms x into y via a composition
+-c       of Rokhlin's random transform, random subselection, and an FFT.
+-c       In contrast to routine idz_frm, the present routine works best
+-c       when the length l of the transformed vector is known a priori.
+-c
+-c       input:
+-c       l -- length of y; l must be less than or equal to n
+-c       m -- length of x
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m, as obtained
+-c            from the routine idz_frmi
+-c       w -- initialization array constructed by routine idz_sfrmi
+-c       x -- vector to be transformed
+-c
+-c       output:
+-c       y -- transform of x
+-c
+-c       _N.B._: l must be less than or equal to n.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,iw,n,l
+-        complex*16 w(21*m+70),x(m),y(l)
+-c
+-c
+-c       Apply Rokhlin's random transformation to x, obtaining
+-c       w(19*m+71 : 20*m+70).
+-c
+-        iw = w(4+m+l)
+-        call idz_random_transf(x,w(19*m+70+1),w(iw))
+-c
+-c
+-c       Subselect from  w(19*m+71 : 20*m+70)  to obtain
+-c       w(20*m+71 : 20*m+n+70).
+-c
+-        call idz_subselect(n,w(4),m,w(19*m+70+1),w(20*m+70+1))
+-c
+-c
+-c       Fourier transform  w(20*m+71 : 20*m+n+70).
+-c
+-        call idz_sfft(l,w(4+m),n,w(5+m+l),w(20*m+70+1))
+-c
+-c
+-c       Copy the desired entries from  w(20*m+71 : 20*m+n+70)
+-c       to y.
+-c
+-        call idz_subselect(l,w(4+m),n,w(20*m+70+1),y)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_permute(n,ind,x,y)
+-c
+-c       copy the entries of x into y, rearranged according
+-c       to the permutation specified by ind.
+-c
+-c       input:
+-c       n -- length of ind, x, and y
+-c       ind -- permutation of n objects
+-c       x -- vector to be permuted
+-c
+-c       output:
+-c       y -- permutation of x
+-c
+-        implicit none
+-        integer n,ind(n),k
+-        complex*16 x(n),y(n)
+-c
+-c
+-        do k = 1,n
+-          y(k) = x(ind(k))
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_subselect(n,ind,m,x,y)
+-c
+-c       copies into y the entries of x indicated by ind.
+-c
+-c       input:
+-c       n -- number of entries of x to copy into y
+-c       ind -- indices of the entries in x to copy into y
+-c       m -- length of x
+-c       x -- vector whose entries are to be copied
+-c
+-c       output:
+-c       y -- collection of entries of x specified by ind
+-c
+-        implicit none
+-        integer n,ind(n),m,k
+-        complex*16 x(m),y(n)
+-c
+-c
+-        do k = 1,n
+-          y(k) = x(ind(k))
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_frmi(m,n,w)
+-c
+-c       initializes data for the routine idz_frm.
+-c
+-c       input:
+-c       m -- length of the vector to be transformed
+-c
+-c       output:
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m
+-c       w -- initialization array to be used by routine idz_frm
+-c
+-c
+-c       glossary for the fully initialized w:
+-c
+-c       w(1) = m
+-c       w(2) = n
+-c       w(3:2+m) stores a permutation of m objects
+-c       w(3+m:2+m+n) stores a permutation of n objects
+-c       w(3+m+n) = address in w of the initialization array
+-c                  for idz_random_transf
+-c       w(4+m+n:int(w(3+m+n))-1) stores the initialization array
+-c                                for zfft
+-c       w(int(w(3+m+n)):16*m+70) stores the initialization array
+-c                                for idz_random_transf
+-c
+-c
+-c       _N.B._: n is an output of the present routine;
+-c               this routine changes n.
+-c
+-c
+-        implicit none
+-        integer m,n,l,nsteps,keep,lw,ia
+-        complex*16 w(17*m+70)
+-c
+-c
+-c       Find the greatest integer less than or equal to m
+-c       which is a power of two.
+-c
+-        call idz_poweroftwo(m,l,n)
+-c
+-c
+-c       Store m and n in w.
+-c
+-        w(1) = m
+-        w(2) = n
+-c
+-c
+-c       Store random permutations of m and n objects in w.
+-c
+-        call id_randperm(m,w(3))
+-        call id_randperm(n,w(3+m))
+-c
+-c
+-c       Store the address within w of the idz_random_transf_init
+-c       initialization data.
+-c
+-        ia = 4+m+n+2*n+15
+-        w(3+m+n) = ia
+-c
+-c
+-c       Store the initialization data for zfft in w.
+-c
+-        call zffti(n,w(4+m+n))
+-c
+-c
+-c       Store the initialization data for idz_random_transf_init in w.
+-c
+-        nsteps = 3
+-        call idz_random_transf_init(nsteps,m,w(ia),keep)
+-c
+-c
+-c       Calculate the total number of elements used in w.
+-c
+-        lw = 3+m+n+2*n+15 + 3*nsteps*m+2*m+m/4+50
+-c
+-        if(16*m+70 .lt. lw) then
+-          call prinf('lw = *',lw,1)
+-          call prinf('16m+70 = *',16*m+70,1)
+-          stop
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_sfrmi(l,m,n,w)
+-c
+-c       initializes data for the routine idz_sfrm.
+-c
+-c       input:
+-c       l -- length of the transformed (output) vector
+-c       m -- length of the vector to be transformed
+-c
+-c       output:
+-c       n -- greatest integer expressible as a positive integer power
+-c            of 2 that is less than or equal to m
+-c       w -- initialization array to be used by routine idz_sfrm
+-c
+-c
+-c       glossary for the fully initialized w:
+-c
+-c       w(1) = m
+-c       w(2) = n
+-c       w(3) is unused
+-c       w(4:3+m) stores a permutation of m objects
+-c       w(4+m:3+m+l) stores the indices of the l outputs which idz_sfft
+-c                    calculates
+-c       w(4+m+l) = address in w of the initialization array
+-c                  for idz_random_transf
+-c       w(5+m+l:int(w(4+m+l))-1) stores the initialization array
+-c                                for idz_sfft
+-c       w(int(w(4+m+l)):19*m+70) stores the initialization array
+-c                                for idz_random_transf
+-c
+-c
+-c       _N.B._: n is an output of the present routine;
+-c               this routine changes n.
+-c
+-c
+-        implicit none
+-        integer l,m,n,idummy,nsteps,keep,lw,ia
+-        complex*16 w(21*m+70)
+-c
+-c
+-c       Find the greatest integer less than or equal to m
+-c       which is a power of two.
+-c
+-        call idz_poweroftwo(m,idummy,n)
+-c
+-c
+-c       Store m and n in w.
+-c
+-        w(1) = m
+-        w(2) = n
+-        w(3) = 0
+-c
+-c
+-c       Store random permutations of m and n objects in w.
+-c
+-        call id_randperm(m,w(4))
+-        call id_randperm(n,w(4+m))
+-c
+-c
+-c       Store the address within w of the idz_random_transf_init
+-c       initialization data.
+-c
+-        ia = 5+m+l+2*l+15+3*n
+-        w(4+m+l) = ia
+-c
+-c
+-c       Store the initialization data for idz_sfft in w.
+-c
+-        call idz_sffti(l,w(4+m),n,w(5+m+l))
+-c
+-c
+-c       Store the initialization data for idz_random_transf_init in w.
+-c
+-        nsteps = 3
+-        call idz_random_transf_init(nsteps,m,w(ia),keep)
+-c
+-c
+-c       Calculate the total number of elements used in w.
+-c
+-        lw = 4+m+l+2*l+15+3*n + 3*nsteps*m+2*m+m/4+50
+-c
+-        if(19*m+70 .lt. lw) then
+-          call prinf('lw = *',lw,1)
+-          call prinf('19m+70 = *',19*m+70,1)
+-          stop
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_poweroftwo(m,l,n)
+-c
+-c       computes l = floor(log_2(m)) and n = 2**l.
+-c
+-c       input:
+-c       m -- integer whose log_2 is to be taken
+-c
+-c       output:
+-c       l -- floor(log_2(m))
+-c       n -- 2**l
+-c
+-        implicit none
+-        integer l,m,n
+-c
+-c
+-        l = 0
+-        n = 1
+-c
+- 1000   continue
+-          l = l+1
+-          n = n*2
+-        if(n .le. m) goto 1000
+-c
+-        l = l-1
+-        n = n/2
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_house.f b/scipy/linalg/src/id_dist/src/idz_house.f
+deleted file mode 100644
+index 93db06e6d..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_house.f
++++ /dev/null
+@@ -1,298 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idz_house calculates the vector and scalar
+-c       needed to apply the Householder transformation reflecting
+-c       a given vector into its first component.
+-c
+-c       routine idz_houseapp applies a Householder matrix to a vector.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_houseapp(n,vn,u,ifrescal,scal,v)
+-c
+-c       applies the Householder matrix
+-c       identity_matrix - scal * vn * adjoint(vn)
+-c       to the vector u, yielding the vector v;
+-c
+-c       scal = 2/(1 + |vn(2)|^2 + ... + |vn(n)|^2)
+-c       when vn(2), ..., vn(n) don't all vanish;
+-c
+-c       scal = 0
+-c       when vn(2), ..., vn(n) do all vanish
+-c       (including when n = 1).
+-c
+-c       input:
+-c       n -- size of vn, u, and v, though the indexing on vn goes
+-c            from 2 to n
+-c       vn -- components 2 to n of the Householder vector vn;
+-c             vn(1) is assumed to be 1
+-c       u -- vector to be transformed
+-c       ifrescal -- set to 1 to recompute scal from vn(2), ..., vn(n);
+-c                   set to 0 to use scal as input
+-c       scal -- see the entry for ifrescal in the decription
+-c               of the input
+-c
+-c       output:
+-c       scal -- see the entry for ifrescal in the decription
+-c               of the input
+-c       v -- result of applying the Householder matrix to u;
+-c            it's O.K. to have v be the same as u
+-c            in order to apply the matrix to the vector in place
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        save
+-        integer n,k,ifrescal
+-        real*8 scal,sum
+-        complex*16 vn(2:*),u(n),v(n),fact
+-c
+-c
+-c       Get out of this routine if n = 1.
+-c
+-        if(n .eq. 1) then
+-          v(1) = u(1)
+-          return
+-        endif
+-c
+-c
+-        if(ifrescal .eq. 1) then
+-c
+-c
+-c         Calculate |vn(2)|^2 + ... + |vn(n)|^2.
+-c
+-          sum = 0
+-          do k = 2,n
+-            sum = sum+vn(k)*conjg(vn(k))
+-          enddo ! k
+-c
+-c
+-c         Calculate scal.
+-c
+-          if(sum .eq. 0) scal = 0
+-          if(sum .ne. 0) scal = 2/(1+sum)
+-c
+-c
+-        endif
+-c
+-c
+-c       Calculate fact = scal * adjoint(vn) * u.
+-c
+-        fact = u(1)
+-c
+-        do k = 2,n
+-          fact = fact+conjg(vn(k))*u(k)
+-        enddo ! k
+-c
+-        fact = fact*scal
+-c
+-c
+-c       Subtract fact*vn from u, yielding v.
+-c
+-        v(1) = u(1) - fact
+-c
+-        do k = 2,n
+-          v(k) = u(k) - fact*vn(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_house(n,x,css,vn,scal)
+-c
+-c       constructs the vector vn with vn(1) = 1,
+-c       and the scalar scal, such that the obviously self-adjoint
+-c       H := identity_matrix - scal * vn * adjoint(vn) is unitary,
+-c       the absolute value of the first entry of Hx
+-c       is the root-sum-square of the entries of x,
+-c       and all other entries of Hx are zero
+-c       (H is the Householder matrix corresponding to x).
+-c
+-c       input:
+-c       n -- size of x and vn, though the indexing on vn goes
+-c            from 2 to n
+-c       x -- vector to reflect into its first component
+-c
+-c       output:
+-c       css -- root-sum-square of the entries of x * the phase of x(1)
+-c       vn -- entries 2 to n of the Householder vector vn;
+-c             vn(1) is assumed to be 1
+-c       scal -- scalar multiplying vn * adjoint(vn);
+-c
+-c               scal = 2/(1 + |vn(2)|^2 + ... + |vn(n)|^2)
+-c               when vn(2), ..., vn(n) don't all vanish;
+-c
+-c               scal = 0
+-c               when vn(2), ..., vn(n) do all vanish
+-c               (including when n = 1)
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        save
+-        integer n,k
+-        real*8 scal,test,rss,sum
+-        complex*16 x(n),v1,vn(2:*),x1,phase,css
+-c
+-c
+-        x1 = x(1)
+-c
+-c
+-c       Get out of this routine if n = 1.
+-c
+-        if(n .eq. 1) then
+-          css = x1
+-          scal = 0
+-          return
+-        endif
+-c
+-c
+-c       Calculate |x(2)|^2 + ... |x(n)|^2
+-c       and the root-sum-square value of the entries in x.
+-c
+-c
+-        sum = 0
+-        do k = 2,n
+-          sum = sum+x(k)*conjg(x(k))
+-        enddo ! k
+-c
+-c
+-c       Get out of this routine if sum = 0;
+-c       flag this case as such by setting v(2), ..., v(n) all to 0.
+-c
+-        if(sum .eq. 0) then
+-c
+-          css = x1
+-          do k = 2,n
+-            vn(k) = 0
+-          enddo ! k
+-          scal = 0
+-c
+-          return
+-c
+-        endif
+-c
+-c
+-        rss = x1*conjg(x1) + sum
+-        rss = sqrt(rss)
+-c
+-c
+-c       Determine the first component v1
+-c       of the unnormalized Householder vector
+-c       v = x - phase(x1) * rss * (1 0 0 ... 0 0)^T.
+-c
+-        if(x1 .eq. 0) phase = 1
+-        if(x1 .ne. 0) phase = x1/abs(x1)
+-        test = conjg(phase) * x1
+-        css = phase*rss
+-c
+-c       If test <= 0, then form x1-phase*rss directly,
+-c       since that expression cannot involve any cancellation.
+-c
+-        if(test .le. 0) v1 = x1-phase*rss
+-c
+-c       If test > 0, then use the fact that
+-c       x1-phase*rss = -phase*sum / ((phase)^* * x1 + rss),
+-c       in order to avoid potential cancellation.
+-c
+-        if(test .gt. 0) v1 = -phase*sum / (conjg(phase)*x1+rss)
+-c
+-c
+-c       Compute the vector vn and the scalar scal such that vn(1) = 1
+-c       in the Householder transformation
+-c       identity_matrix - scal * vn * adjoint(vn).
+-c
+-        do k = 2,n
+-          vn(k) = x(k)/v1
+-        enddo ! k
+-c
+-c       scal = 2
+-c            / ( |vn(1)|^2 + |vn(2)|^2 + ... + |vn(n)|^2 )
+-c
+-c            = 2
+-c            / ( 1 + |vn(2)|^2 + ... + |vn(n)|^2 )
+-c
+-c            = 2*|v(1)|^2
+-c            / ( |v(1)|^2 + |v(1)*vn(2)|^2 + ... + |v(1)*vn(n)|^2 )
+-c
+-c            = 2*|v(1)|^2
+-c            / ( |v(1)|^2 + (|v(2)|^2 + ... + |v(n)|^2) )
+-c
+-        scal = 2*v1*conjg(v1) / (v1*conjg(v1)+sum)
+-c
+-c
+-        rss = phase*rss
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_housemat(n,vn,scal,h)
+-c
+-c       fills h with the Householder matrix
+-c       identity_matrix - scal * vn * adjoint(vn).
+-c
+-c       input:
+-c       n -- size of vn and h, though the indexing of vn goes
+-c            from 2 to n
+-c       vn -- entries 2 to n of the vector vn;
+-c             vn(1) is assumed to be 1
+-c       scal -- scalar multiplying vn * adjoint(vn)
+-c
+-c       output:
+-c       h -- identity_matrix - scal * vn * adjoint(vn)
+-c
+-        implicit none
+-        save
+-        integer n,j,k
+-        real*8 scal
+-        complex*16 vn(2:*),h(n,n),factor1,factor2
+-c
+-c
+-c       Fill h with the identity matrix.
+-c
+-        do j = 1,n
+-          do k = 1,n
+-c
+-            if(j .eq. k) h(k,j) = 1
+-            if(j .ne. k) h(k,j) = 0
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-c       Subtract from h the matrix scal*vn*adjoint(vn).
+-c
+-        do j = 1,n
+-          do k = 1,n
+-c
+-            if(j .eq. 1) factor1 = 1
+-            if(j .ne. 1) factor1 = vn(j)
+-c
+-            if(k .eq. 1) factor2 = 1
+-            if(k .ne. 1) factor2 = conjg(vn(k))
+-c
+-            h(k,j) = h(k,j) - scal*factor1*factor2
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_id.f b/scipy/linalg/src/id_dist/src/idz_id.f
+deleted file mode 100644
+index 7a80243ff..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_id.f
++++ /dev/null
+@@ -1,566 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_id computes the ID of a matrix,
+-c       to a specified precision.
+-c
+-c       routine idzr_id computes the ID of a matrix,
+-c       to a specified rank.
+-c
+-c       routine idz_reconid reconstructs a matrix from its ID.
+-c
+-c       routine idz_copycols collects together selected columns
+-c       of a matrix.
+-c
+-c       routine idz_getcols collects together selected columns
+-c       of a matrix specified by a routine for applying the matrix
+-c       to arbitrary vectors.
+-c
+-c       routine idz_reconint constructs p in the ID a = b p,
+-c       where the columns of b are a subset of the columns of a,
+-c       and p is the projection coefficient matrix,
+-c       given list, krank, and proj output by routines idzr_id
+-c       or idzp_id.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzp_id(eps,m,n,a,krank,list,rnorms)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c       The present routine stores the krank x (n-krank) matrix proj
+-c       in the memory initially occupied by a.
+-c
+-c       input:
+-c       eps -- relative precision of the resulting ID
+-c       m -- first dimension of a
+-c       n -- second dimension of a, as well as the dimension required
+-c            of list
+-c       a -- matrix to be ID'd
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) interpolation matrix proj
+-c       krank -- numerical rank
+-c       list -- list of the indices of the krank columns of a
+-c               through which the other columns of a are expressed;
+-c               also, list describes the permutation of proj
+-c               required to reconstruct a as indicated in (*) above
+-c       rnorms -- absolute values of the entries on the diagonal
+-c                 of the triangular matrix used to compute the ID
+-c                 (these may be used to check the stability of the ID)
+-c
+-c       _N.B._: This routine changes a.
+-c
+-c       reference:
+-c       Cheng, Gimbutas, Martinsson, Rokhlin, "On the compression of
+-c            low-rank matrices," SIAM Journal on Scientific Computing,
+-c            26 (4): 1389-1404, 2005.
+-c
+-        implicit none
+-        integer m,n,krank,k,list(n),iswap
+-        real*8 eps,rnorms(n)
+-        complex*16 a(m,n)
+-c
+-c
+-c       QR decompose a.
+-c
+-        call idzp_qrpiv(eps,m,n,a,krank,list,rnorms)
+-c
+-c
+-c       Build the list of columns chosen in a
+-c       by multiplying together the permutations in list,
+-c       with the permutation swapping 1 and list(1) taken rightmost
+-c       in the product, that swapping 2 and list(2) taken next
+-c       rightmost, ..., that swapping krank and list(krank) taken
+-c       leftmost.
+-c
+-        do k = 1,n
+-          rnorms(k) = k
+-        enddo ! k
+-c
+-        if(krank .gt. 0) then
+-          do k = 1,krank
+-c
+-c           Swap rnorms(k) and rnorms(list(k)).
+-c
+-            iswap = rnorms(k)
+-            rnorms(k) = rnorms(list(k))
+-            rnorms(list(k)) = iswap
+-c
+-          enddo ! k
+-        endif
+-c
+-        do k = 1,n
+-          list(k) = rnorms(k)
+-        enddo ! k
+-c
+-c
+-c       Fill rnorms for the output.
+-c
+-        if(krank .gt. 0) then
+-c
+-          do k = 1,krank
+-            rnorms(k) = a(k,k)
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-c       Backsolve for proj, storing it at the beginning of a.
+-c
+-        if(krank .gt. 0) then
+-          call idz_lssolve(m,n,a,krank)
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_id(m,n,a,krank,list,rnorms)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c       The present routine stores the krank x (n-krank) matrix proj
+-c       in the memory initially occupied by a.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a, as well as the dimension required
+-c            of list
+-c       a -- matrix to be ID'd
+-c       krank -- desired rank of the output matrix
+-c                (please note that if krank > m or krank > n,
+-c                then the rank of the output matrix will be
+-c                less than krank)
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) interpolation matrix proj
+-c       list -- list of the indices of the krank columns of a
+-c               through which the other columns of a are expressed;
+-c               also, list describes the permutation of proj
+-c               required to reconstruct a as indicated in (*) above
+-c       rnorms -- absolute values of the entries on the diagonal
+-c                 of the triangular matrix used to compute the ID
+-c                 (these may be used to check the stability of the ID)
+-c
+-c       _N.B._: This routine changes a.
+-c
+-c       reference:
+-c       Cheng, Gimbutas, Martinsson, Rokhlin, "On the compression of
+-c            low-rank matrices," SIAM Journal on Scientific Computing,
+-c            26 (4): 1389-1404, 2005.
+-c
+-        implicit none
+-        integer m,n,krank,j,k,list(n),iswap
+-        real*8 rnorms(n),ss
+-        complex*16 a(m,n)
+-c
+-c
+-c       QR decompose a.
+-c
+-        call idzr_qrpiv(m,n,a,krank,list,rnorms)
+-c
+-c
+-c       Build the list of columns chosen in a
+-c       by multiplying together the permutations in list,
+-c       with the permutation swapping 1 and list(1) taken rightmost
+-c       in the product, that swapping 2 and list(2) taken next
+-c       rightmost, ..., that swapping krank and list(krank) taken
+-c       leftmost.
+-c
+-        do k = 1,n
+-          rnorms(k) = k
+-        enddo ! k
+-c
+-        if(krank .gt. 0) then
+-          do k = 1,krank
+-c
+-c           Swap rnorms(k) and rnorms(list(k)).
+-c
+-            iswap = rnorms(k)
+-            rnorms(k) = rnorms(list(k))
+-            rnorms(list(k)) = iswap
+-c
+-          enddo ! k
+-        endif
+-c
+-        do k = 1,n
+-          list(k) = rnorms(k)
+-        enddo ! k
+-c
+-c
+-c       Fill rnorms for the output.
+-c
+-        ss = 0
+-c
+-        do k = 1,krank
+-          rnorms(k) = a(k,k)
+-          ss = ss + rnorms(k)**2
+-        enddo ! k
+-c
+-c
+-c       Backsolve for proj, storing it at the beginning of a.
+-c
+-        if(krank .gt. 0 .and. ss .gt. 0) then
+-          call idz_lssolve(m,n,a,krank)
+-        endif
+-c
+-        if(ss .eq. 0) then
+-c
+-          do k = 1,n
+-            do j = 1,m
+-c
+-              a(j,k) = 0
+-c
+-            enddo ! j
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_reconid(m,krank,col,n,list,proj,approx)
+-c
+-c       reconstructs the matrix that the routine idzp_id
+-c       or idzr_id has decomposed, using the columns col
+-c       of the reconstructed matrix whose indices are listed in list,
+-c       in addition to the interpolation matrix proj.
+-c
+-c       input:
+-c       m -- first dimension of cols and approx
+-c       krank -- first dimension of cols and proj; also,
+-c                n-krank is the second dimension of proj
+-c       col -- columns of the matrix to be reconstructed
+-c       n -- second dimension of approx; also,
+-c            n-krank is the second dimension of proj
+-c       list(k) -- index of col(1:m,k) in the reconstructed matrix
+-c                  when k <= krank; in general, list describes
+-c                  the permutation required for reconstruction
+-c                  via cols and proj
+-c       proj -- interpolation matrix
+-c
+-c       output:
+-c       approx -- reconstructed matrix
+-c
+-        implicit none
+-        integer m,n,krank,j,k,l,list(n)
+-        complex*16 col(m,krank),proj(krank,n-krank),approx(m,n)
+-c
+-c
+-        do j = 1,m
+-          do k = 1,n
+-c
+-            approx(j,list(k)) = 0
+-c
+-c           Add in the contributions due to the identity matrix.
+-c
+-            if(k .le. krank) then
+-              approx(j,list(k)) = approx(j,list(k)) + col(j,k)
+-            endif
+-c
+-c           Add in the contributions due to proj.
+-c
+-            if(k .gt. krank) then
+-              if(krank .gt. 0) then
+-c
+-                do l = 1,krank
+-                  approx(j,list(k)) = approx(j,list(k))
+-     1                              + col(j,l)*proj(l,k-krank)
+-                enddo ! l
+-c
+-              endif
+-            endif
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_lssolve(m,n,a,krank)
+-c
+-c       backsolves for proj satisfying R_11 proj ~ R_12,
+-c       where R_11 = a(1:krank,1:krank)
+-c       and R_12 = a(1:krank,krank+1:n).
+-c       This routine overwrites the beginning of a with proj.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a; also,
+-c            n-krank is the second dimension of proj
+-c       a -- trapezoidal input matrix
+-c       krank -- first dimension of proj; also,
+-c                n-krank is the second dimension of proj
+-c
+-c       output:
+-c       a -- the first krank*(n-krank) elements of a constitute
+-c            the krank x (n-krank) matrix proj
+-c
+-        implicit none
+-        integer m,n,krank,j,k,l
+-        real*8 rnumer,rdenom
+-        complex*16 a(m,n),sum
+-c
+-c
+-c       Overwrite a(1:krank,krank+1:n) with proj.
+-c
+-        do k = 1,n-krank
+-          do j = krank,1,-1
+-c
+-            sum = 0
+-c
+-            do l = j+1,krank
+-              sum = sum+a(j,l)*a(l,krank+k)
+-            enddo ! l
+-c
+-            a(j,krank+k) = a(j,krank+k)-sum
+-c
+-c           Make sure that the entry in proj won't be too big;
+-c           set the entry to 0 when roundoff would make it too big
+-c           (in which case a(j,j) is so small that the contribution
+-c           from this entry in proj to the overall matrix approximation
+-c           is supposed to be negligible).
+-c
+-            rnumer = a(j,krank+k)*conjg(a(j,krank+k))
+-            rdenom = a(j,j)*conjg(a(j,j))
+-c
+-            if(rnumer .lt. 2**30*rdenom) then
+-              a(j,krank+k) = a(j,krank+k)/a(j,j)
+-            else
+-              a(j,krank+k) = 0
+-            endif
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       Move proj from a(1:krank,krank+1:n) to the beginning of a.
+-c
+-        call idz_moverup(m,n,krank,a)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_moverup(m,n,krank,a)
+-c
+-c       moves the krank x (n-krank) matrix in a(1:krank,krank+1:n),
+-c       where a is initially dimensioned m x n, to the beginning of a.
+-c       (This is not the most natural way to code the move,
+-c       but one of my usually well-behaved compilers chokes
+-c       on more natural ways.)
+-c
+-c       input:
+-c       m -- initial first dimension of a
+-c       n -- initial second dimension of a
+-c       krank -- number of rows to move
+-c       a -- m x n matrix whose krank x (n-krank) block
+-c            a(1:krank,krank+1:n) is to be moved
+-c
+-c       output:
+-c       a -- array starting with the moved krank x (n-krank) block
+-c
+-        implicit none
+-        integer m,n,krank,j,k
+-        complex*16 a(m*n)
+-c
+-c
+-        do k = 1,n-krank
+-          do j = 1,krank
+-            a(j+krank*(k-1)) = a(j+m*(krank+k-1))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,
+-     1                         col,x)
+-c
+-c       collects together the columns of the matrix a indexed by list
+-c       into the matrix col, where routine matvec applies a
+-c       to an arbitrary vector.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matvec -- routine which applies a to an arbitrary vector;
+-c                 this routine must have a calling sequence of the form
+-c
+-c                 matvec(m,x,n,y,p1,p2,p3,p4)
+-c
+-c                 where m is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 n is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       krank -- number of columns to be extracted
+-c       list -- indices of the columns to be extracted
+-c
+-c       output:
+-c       col -- columns of a indexed by list
+-c
+-c       work:
+-c       x -- must be at least n complex*16 elements long
+-c
+-        implicit none
+-        integer m,n,krank,list(krank),j,k
+-        complex*16 col(m,krank),x(n),p1,p2,p3,p4
+-        external matvec
+-c
+-c
+-        do j = 1,krank
+-c
+-          do k = 1,n
+-            x(k) = 0
+-          enddo ! k
+-c
+-          x(list(j)) = 1
+-c
+-          call matvec(n,x,m,col(1,j),p1,p2,p3,p4)
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_reconint(n,list,krank,proj,p)
+-c
+-c       constructs p in the ID a = b p,
+-c       where the columns of b are a subset of the columns of a,
+-c       and p is the projection coefficient matrix,
+-c       given list, krank, and proj output
+-c       by routines idzp_id or idzr_id.
+-c
+-c       input:
+-c       n -- part of the second dimension of proj and p
+-c       list -- list of columns retained from the original matrix
+-c               in the ID
+-c       krank -- rank of the ID
+-c       proj -- matrix of projection coefficients in the ID
+-c
+-c       output:
+-c       p -- projection matrix in the ID
+-c
+-        implicit none
+-        integer n,krank,list(n),j,k
+-        complex*16 proj(krank,n-krank),p(krank,n)
+-c
+-c
+-        do k = 1,krank
+-          do j = 1,n
+-c
+-            if(j .le. krank) then
+-              if(j .eq. k) p(k,list(j)) = 1
+-              if(j .ne. k) p(k,list(j)) = 0
+-            endif
+-c
+-            if(j .gt. krank) then
+-              p(k,list(j)) = proj(k,j-krank)
+-            endif
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_copycols(m,n,a,krank,list,col)
+-c
+-c       collects together the columns of the matrix a indexed by list
+-c       into the matrix col.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix whose columns are to be extracted
+-c       krank -- number of columns to be extracted
+-c       list -- indices of the columns to be extracted
+-c
+-c       output:
+-c       col -- columns of a indexed by list
+-c
+-        implicit none
+-        integer m,n,krank,list(krank),j,k
+-        complex*16 a(m,n),col(m,krank)
+-c
+-c
+-        do k = 1,krank
+-          do j = 1,m
+-c
+-            col(j,k) = a(j,list(k))
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_id2svd.f b/scipy/linalg/src/id_dist/src/idz_id2svd.f
+deleted file mode 100644
+index 55832e5d1..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_id2svd.f
++++ /dev/null
+@@ -1,389 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idz_id2svd converts an approximation to a matrix
+-c       in the form of an ID to an approximation in the form of an SVD.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_id2svd(m,krank,b,n,list,proj,u,v,s,ier,w)
+-c
+-c       converts an approximation to a matrix in the form of an ID
+-c       to an approximation in the form of an SVD.
+-c
+-c       input:
+-c       m -- first dimension of b
+-c       krank -- rank of the ID
+-c       b -- columns of the original matrix in the ID
+-c       list -- list of columns chosen from the original matrix
+-c               in the ID
+-c       n -- length of list and part of the second dimension of proj
+-c       proj -- projection coefficients in the ID
+-c
+-c       output:
+-c       u -- left singular vectors
+-c       v -- right singular vectors
+-c       s -- singular values
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       work:
+-c       w -- must be at least (krank+1)*(m+3*n+10)+9*krank**2
+-c            complex*16 elements long
+-c
+-c       _N.B._: This routine destroys b.
+-c
+-        implicit none
+-        integer m,krank,n,list(n),iwork,lwork,ip,lp,it,lt,ir,lr,
+-     1          ir2,lr2,ir3,lr3,iind,lind,iindt,lindt,lw,ier
+-        real*8 s(krank)
+-        complex*16 b(m,krank),proj(krank,n-krank),u(m,krank),
+-     1             v(n,krank),w((krank+1)*(m+3*n+10)+9*krank**2)
+-c
+-c
+-c       Allocate memory for idz_id2svd0.
+-c
+-        lw = 0
+-c
+-        iwork = lw+1
+-        lwork = 8*krank**2+10*krank
+-        lw = lw+lwork
+-c
+-        ip = lw+1
+-        lp = krank*n
+-        lw = lw+lp
+-c
+-        it = lw+1
+-        lt = n*krank
+-        lw = lw+lt
+-c
+-        ir = lw+1
+-        lr = krank*n
+-        lw = lw+lr
+-c
+-        ir2 = lw+1
+-        lr2 = krank*m
+-        lw = lw+lr2
+-c
+-        ir3 = lw+1
+-        lr3 = krank*krank
+-        lw = lw+lr3
+-c
+-        iind = lw+1
+-        lind = n/4+1
+-        lw = lw+1
+-c
+-        iindt = lw+1
+-        lindt = m/4+1
+-        lw = lw+1
+-c
+-c
+-        call idz_id2svd0(m,krank,b,n,list,proj,u,v,s,ier,
+-     1                   w(iwork),w(ip),w(it),w(ir),w(ir2),w(ir3),
+-     2                   w(iind),w(iindt))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_id2svd0(m,krank,b,n,list,proj,u,v,s,ier,
+-     1                         work,p,t,r,r2,r3,ind,indt)
+-c
+-c       routine idz_id2svd serves as a memory wrapper
+-c       for the present routine (please see routine idz_id2svd
+-c       for further documentation).
+-c
+-        implicit none
+-c
+-        character*1 jobz
+-        integer m,n,krank,list(n),ind(n),indt(m),ifadjoint,
+-     1          lwork,ldu,ldvt,ldr,info,j,k,ier
+-        real*8 s(krank)
+-        complex*16 b(m,krank),proj(krank,n-krank),p(krank,n),
+-     1             r(krank,n),r2(krank,m),t(n,krank),r3(krank,krank),
+-     2             u(m,krank),v(n,krank),work(8*krank**2+10*krank)
+-c
+-c
+-c
+-        ier = 0
+-c
+-c
+-c
+-c       Construct the projection matrix p from the ID.
+-c
+-        call idz_reconint(n,list,krank,proj,p)
+-c
+-c
+-c
+-c       Compute a pivoted QR decomposition of b.
+-c
+-        call idzr_qrpiv(m,krank,b,krank,ind,r)
+-c
+-c
+-c       Extract r from the QR decomposition.
+-c
+-        call idz_rinqr(m,krank,b,krank,r)
+-c
+-c
+-c       Rearrange r according to ind.
+-c
+-        call idz_rearr(krank,ind,krank,krank,r)
+-c
+-c
+-c
+-c       Take the adjoint of p to obtain t.
+-c
+-        call idz_matadj(krank,n,p,t)
+-c
+-c
+-c       Compute a pivoted QR decomposition of t.
+-c
+-        call idzr_qrpiv(n,krank,t,krank,indt,r2)
+-c
+-c
+-c       Extract r2 from the QR decomposition.
+-c
+-        call idz_rinqr(n,krank,t,krank,r2)
+-c
+-c
+-c       Rearrange r2 according to indt.
+-c
+-        call idz_rearr(krank,indt,krank,krank,r2)
+-c
+-c
+-c
+-c       Multiply r and r2^* to obtain r3.
+-c
+-        call idz_matmulta(krank,krank,r,krank,r2,r3)
+-c
+-c
+-c
+-c       Use LAPACK to SVD r3.
+-c
+-        jobz = 'S'
+-        ldr = krank
+-        lwork = 8*krank**2+10*krank
+-     1        - (krank**2+2*krank+3*krank**2+4*krank)
+-        ldu = krank
+-        ldvt = krank
+-c
+-        call zgesdd(jobz,krank,krank,r3,ldr,s,work,ldu,r,ldvt,
+-     1              work(krank**2+2*krank+3*krank**2+4*krank+1),lwork,
+-     2              work(krank**2+2*krank+1),work(krank**2+1),info)
+-c
+-        if(info .ne. 0) then
+-          ier = info
+-          return
+-        endif
+-c
+-c
+-c
+-c       Multiply the u from r3 from the left by the q from b
+-c       to obtain the u for a.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            u(j,k) = work(j+krank*(k-1))
+-          enddo ! j
+-c
+-          do j = krank+1,m
+-            u(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        ifadjoint = 0
+-        call idz_qmatmat(ifadjoint,m,krank,b,krank,krank,u,r2)
+-c
+-c
+-c
+-c       Take the adjoint of r to obtain r2.
+-c
+-        call idz_matadj(krank,krank,r,r2)
+-c
+-c
+-c       Multiply the v from r3 from the left by the q from p^*
+-c       to obtain the v for a.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            v(j,k) = r2(j,k)
+-          enddo ! j
+-c
+-          do j = krank+1,n
+-            v(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        ifadjoint = 0
+-        call idz_qmatmat(ifadjoint,n,krank,t,krank,krank,v,r2)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_matadj(m,n,a,aa)
+-c
+-c       Takes the adjoint of a to obtain aa.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of aa
+-c       n -- second dimension of a, and first dimension of aa
+-c       a -- matrix whose adjoint is to be taken
+-c
+-c       output:
+-c       aa -- adjoint of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        complex*16 a(m,n),aa(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            aa(k,j) = conjg(a(j,k))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_matmulta(l,m,a,n,b,c)
+-c
+-c       multiplies a and b^* to obtain c.
+-c
+-c       input:
+-c       l -- first dimension of a and c
+-c       m -- second dimension of a and b
+-c       a -- leftmost matrix in the product c = a b^*
+-c       n -- first dimension of b and second dimension of c
+-c       b -- rightmost matrix in the product c = a b^*
+-c
+-c       output:
+-c       c -- product of a and b^*
+-c
+-        implicit none
+-        integer l,m,n,i,j,k
+-        complex*16 a(l,m),b(n,m),c(l,n),sum
+-c
+-c
+-        do i = 1,l
+-          do k = 1,n
+-c
+-            sum = 0
+-c
+-            do j = 1,m
+-              sum = sum+a(i,j)*conjg(b(k,j))
+-            enddo ! j
+-c
+-            c(i,k) = sum
+-c
+-          enddo ! k
+-        enddo ! i
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_rearr(krank,ind,m,n,a)
+-c
+-c       rearranges a according to ind obtained
+-c       from routines idzr_qrpiv or idzp_qrpiv,
+-c       assuming that a = q r, where q and r are from idzr_qrpiv
+-c       or idzp_qrpiv.
+-c
+-c       input:
+-c       krank -- rank obtained from routine idzp_qrpiv,
+-c                or provided to routine idzr_qrpiv
+-c       ind -- indexing array obtained from routine idzr_qrpiv
+-c              or idzp_qrpiv
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be rearranged
+-c
+-c       output:
+-c       a -- rearranged matrix
+-c
+-        implicit none
+-        integer k,krank,m,n,j,ind(krank)
+-        complex*16 cswap,a(m,n)
+-c
+-c
+-        do k = krank,1,-1
+-          do j = 1,m
+-c
+-            cswap = a(j,k)
+-            a(j,k) = a(j,ind(k))
+-            a(j,ind(k)) = cswap
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_rinqr(m,n,a,krank,r)
+-c
+-c       extracts R in the QR decomposition specified by the output a
+-c       of the routine idzr_qrpiv or idzp_qrpiv.
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a and r
+-c       a -- output of routine idzr_qrpiv or idzp_qrpiv
+-c       krank -- rank output by routine idzp_qrpiv (or specified
+-c                to routine idzr_qrpiv)
+-c
+-c       output:
+-c       r -- triangular factor in the QR decomposition specified
+-c            by the output a of the routine idzr_qrpiv or idzp_qrpiv
+-c
+-        implicit none
+-        integer m,n,j,k,krank
+-        complex*16 a(m,n),r(krank,n)
+-c
+-c
+-c       Copy a into r and zero out the appropriate
+-c       Householder vectors that are stored in one triangle of a.
+-c
+-        do k = 1,n
+-          do j = 1,krank
+-            r(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-        do k = 1,n
+-          if(k .lt. krank) then
+-            do j = k+1,krank
+-              r(j,k) = 0
+-            enddo ! j
+-          endif
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_qrpiv.f b/scipy/linalg/src/id_dist/src/idz_qrpiv.f
+deleted file mode 100644
+index 3e7bcaf99..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_qrpiv.f
++++ /dev/null
+@@ -1,898 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_qrpiv computes the pivoted QR decomposition
+-c       of a matrix via Householder transformations,
+-c       stopping at a specified precision of the decomposition.
+-c
+-c       routine idzr_qrpiv computes the pivoted QR decomposition
+-c       of a matrix via Householder transformations,
+-c       stopping at a specified rank of the decomposition.
+-c
+-c       routine idz_qmatvec applies to a single vector
+-c       the Q matrix (or its adjoint) in the QR decomposition
+-c       of a matrix, as described by the output of idzp_qrpiv or
+-c       idzr_qrpiv. If you're concerned about efficiency and want
+-c       to apply Q (or its adjoint) to multiple vectors,
+-c       use idz_qmatmat instead.
+-c
+-c       routine idz_qmatmat applies
+-c       to multiple vectors collected together
+-c       as a matrix the Q matrix (or its adjoint)
+-c       in the QR decomposition of a matrix, as described
+-c       by the output of idzp_qrpiv. If you don't want to provide
+-c       a work array and want to apply Q (or its adjoint)
+-c       to a single vector, use idz_qmatvec instead.
+-c
+-c       routine idz_qinqr reconstructs the Q matrix
+-c       in a QR decomposition from the data generated by idzp_qrpiv
+-c       or idzr_qrpiv.
+-c
+-c       routine idz_permmult multiplies together a bunch
+-c       of permutations.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_permmult(m,ind,n,indprod)
+-c
+-c       multiplies together the series of permutations in ind.
+-c
+-c       input:
+-c       m -- length of ind
+-c       ind(k) -- number of the slot with which to swap
+-c                 the k^th slot
+-c       n -- length of indprod and indprodinv
+-c
+-c       output:
+-c       indprod -- product of the permutations in ind,
+-c                  with the permutation swapping 1 and ind(1)
+-c                  taken leftmost in the product,
+-c                  that swapping 2 and ind(2) taken next leftmost,
+-c                  ..., that swapping krank and ind(krank)
+-c                  taken rightmost; indprod(k) is the number
+-c                  of the slot with which to swap the k^th slot
+-c                  in the product permutation
+-c
+-        implicit none
+-        integer m,n,ind(m),indprod(n),k,iswap
+-c
+-c
+-        do k = 1,n
+-          indprod(k) = k
+-        enddo ! k
+-c
+-        do k = m,1,-1
+-c
+-c         Swap indprod(k) and indprod(ind(k)).
+-c
+-          iswap = indprod(k)
+-          indprod(k) = indprod(ind(k))
+-          indprod(ind(k)) = iswap
+-c
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_qinqr(m,n,a,krank,q)
+-c
+-c       constructs the matrix q from idzp_qrpiv or idzr_qrpiv
+-c       (see the routine idzp_qrpiv or idzr_qrpiv
+-c       for more information).
+-c
+-c       input:
+-c       m -- first dimension of a; also, right now, q is m x m
+-c       n -- second dimension of a
+-c       a -- matrix output by idzp_qrpiv or idzr_qrpiv
+-c            (and denoted the same there)
+-c       krank -- numerical rank output by idzp_qrpiv or idzr_qrpiv
+-c                (and denoted the same there)
+-c
+-c       output:
+-c       q -- unitary matrix implicitly specified by the data in a
+-c            from idzp_qrpiv or idzr_qrpiv
+-c
+-c       Note:
+-c       Right now, this routine simply multiplies
+-c       one after another the krank Householder matrices
+-c       in the full QR decomposition of a,
+-c       in order to obtain the complete m x m Q factor in the QR.
+-c       This routine should instead use the following
+-c       (more elaborate but more efficient) scheme
+-c       to construct a q dimensioned q(krank,m); this scheme
+-c       was introduced by Robert Schreiber and Charles Van Loan
+-c       in "A Storage-Efficient _WY_ Representation
+-c       for Products of Householder Transformations,"
+-c       _SIAM Journal on Scientific and Statistical Computing_,
+-c       Vol. 10, No. 1, pp. 53-57, January, 1989:
+-c
+-c       Theorem 1. Suppose that Q = _1_ + YTY^* is
+-c       an m x m unitary matrix,
+-c       where Y is an m x k matrix
+-c       and T is a k x k upper triangular matrix.
+-c       Suppose also that P = _1_ - 2 v v^* is
+-c       a Householder matrix and Q_+ = QP,
+-c       where v is an m x 1 real vector,
+-c       normalized so that v^* v = 1.
+-c       Then, Q_+ = _1_ + Y_+ T_+ Y_+^*,
+-c       where Y_+ = (Y v) is the m x (k+1) matrix
+-c       formed by adjoining v to the right of Y,
+-c                 ( T   z )
+-c       and T_+ = (       ) is
+-c                 ( 0  -2 )
+-c       the (k+1) x (k+1) upper triangular matrix
+-c       formed by adjoining z to the right of T
+-c       and the vector (0 ... 0 -2) with k zeroes below (T z),
+-c       where z = -2 T Y^* v.
+-c
+-c       Now, suppose that A is a (rank-deficient) matrix
+-c       whose complete QR decomposition has
+-c       the blockwise partioned form
+-c           ( Q_11 Q_12 ) ( R_11 R_12 )   ( Q_11 )
+-c       A = (           ) (           ) = (      ) (R_11 R_12).
+-c           ( Q_21 Q_22 ) (  0    0   )   ( Q_21 )
+-c       Then, the only blocks of the orthogonal factor
+-c       in the above QR decomposition of A that matter are
+-c                                                        ( Q_11 )
+-c       Q_11 and Q_21, _i.e._, only the block of columns (      )
+-c                                                        ( Q_21 )
+-c       interests us.
+-c       Suppose in addition that Q_11 is a k x k matrix,
+-c       Q_21 is an (m-k) x k matrix, and that
+-c       ( Q_11 Q_12 )
+-c       (           ) = _1_ + YTY^*, as in Theorem 1 above.
+-c       ( Q_21 Q_22 )
+-c       Then, Q_11 = _1_ + Y_1 T Y_1^*
+-c       and Q_21 = Y_2 T Y_1^*,
+-c       where Y_1 is the k x k matrix and Y_2 is the (m-k) x k matrix
+-c                   ( Y_1 )
+-c       so that Y = (     ).
+-c                   ( Y_2 )
+-c
+-c       So, you can calculate T and Y via the above recursions,
+-c       and then use these to compute the desired Q_11 and Q_21.
+-c
+-c
+-        implicit none
+-        integer m,n,krank,j,k,mm,ifrescal
+-        real*8 scal
+-        complex*16 a(m,n),q(m,m)
+-c
+-c
+-c       Zero all of the entries of q.
+-c
+-        do k = 1,m
+-          do j = 1,m
+-            q(j,k) = 0
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       Place 1's along the diagonal of q.
+-c
+-        do k = 1,m
+-          q(k,k) = 1
+-        enddo ! k
+-c
+-c
+-c       Apply the krank Householder transformations stored in a.
+-c
+-        do k = krank,1,-1
+-          do j = k,m
+-            mm = m-k+1
+-            ifrescal = 1
+-            if(k .lt. m) call idz_houseapp(mm,a(k+1,k),q(k,j),
+-     1                                     ifrescal,scal,q(k,j))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_qmatvec(ifadjoint,m,n,a,krank,v)
+-c
+-c       applies to a single vector the Q matrix (or its adjoint)
+-c       which the routine idzp_qrpiv or idzr_qrpiv has stored
+-c       in a triangle of the matrix it produces (stored, incidentally,
+-c       as data for applying a bunch of Householder reflections).
+-c       Use the routine idz_qmatmat to apply the Q matrix
+-c       (or its adjoint)
+-c       to a bunch of vectors collected together as a matrix,
+-c       if you're concerned about efficiency.
+-c
+-c       input:
+-c       ifadjoint -- set to 0 for applying Q;
+-c                    set to 1 for applying the adjoint of Q
+-c       m -- first dimension of a and length of v
+-c       n -- second dimension of a
+-c       a -- data describing the qr decomposition of a matrix,
+-c            as produced by idzp_qrpiv or idzr_qrpiv
+-c       krank -- numerical rank
+-c       v -- vector to which Q (or its adjoint) is to be applied
+-c
+-c       output:
+-c       v -- vector to which Q (or its adjoint) has been applied
+-c
+-        implicit none
+-        save
+-        integer m,n,krank,k,ifrescal,mm,ifadjoint
+-        real*8 scal
+-        complex*16 a(m,n),v(m)
+-c
+-c
+-        ifrescal = 1
+-c
+-c
+-        if(ifadjoint .eq. 0) then
+-c
+-          do k = krank,1,-1
+-            mm = m-k+1
+-            if(k .lt. m) call idz_houseapp(mm,a(k+1,k),v(k),
+-     1                                     ifrescal,scal,v(k))
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        if(ifadjoint .eq. 1) then
+-c
+-          do k = 1,krank
+-            mm = m-k+1
+-            if(k .lt. m) call idz_houseapp(mm,a(k+1,k),v(k),
+-     1                                     ifrescal,scal,v(k))
+-          enddo ! k
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_qmatmat(ifadjoint,m,n,a,krank,l,b,work)
+-c
+-c       applies to a bunch of vectors collected together as a matrix
+-c       the Q matrix (or its adjoint) which the routine idzp_qrpiv
+-c       or idzr_qrpiv has stored in a triangle of the matrix
+-c       it produces (stored, incidentally, as data
+-c       for applying a bunch of Householder reflections).
+-c       Use the routine idz_qmatvec to apply the Q matrix
+-c       (or its adjoint)
+-c       to a single vector, if you'd rather not provide a work array.
+-c
+-c       input:
+-c       ifadjoint -- set to 0 for applying Q;
+-c                    set to 1 for applying the adjoint of Q
+-c       m -- first dimension of both a and b
+-c       n -- second dimension of a
+-c       a -- data describing the qr decomposition of a matrix,
+-c            as produced by idzp_qrpiv or idzr_qrpiv
+-c       krank -- numerical rank
+-c       l -- second dimension of b
+-c       b -- matrix to which Q (or its adjoint) is to be applied
+-c
+-c       output:
+-c       b -- matrix to which Q (or its adjoint) has been applied
+-c
+-c       work:
+-c       work -- must be at least krank real*8 elements long
+-c
+-        implicit none
+-        save
+-        integer l,m,n,krank,j,k,ifrescal,mm,ifadjoint
+-        real*8 work(krank)
+-        complex*16 a(m,n),b(m,l)
+-c
+-c
+-        if(ifadjoint .eq. 0) then
+-c
+-c
+-c         Handle the first iteration, j = 1,
+-c         calculating all scals (ifrescal = 1).
+-c
+-          ifrescal = 1
+-c
+-          j = 1
+-c
+-          do k = krank,1,-1
+-            if(k .lt. m) then
+-              mm = m-k+1
+-              call idz_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                          work(k),b(k,j))
+-            endif
+-          enddo ! k
+-c
+-c
+-          if(l .gt. 1) then
+-c
+-c           Handle the other iterations, j > 1,
+-c           using the scals just computed (ifrescal = 0).
+-c
+-            ifrescal = 0
+-c
+-            do j = 2,l
+-c
+-              do k = krank,1,-1
+-                if(k .lt. m) then
+-                  mm = m-k+1
+-                  call idz_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                              work(k),b(k,j))
+-                endif
+-              enddo ! k
+-c
+-            enddo ! j
+-c
+-          endif ! j .gt. 1
+-c
+-c
+-        endif ! ifadjoint .eq. 0
+-c
+-c
+-        if(ifadjoint .eq. 1) then
+-c
+-c
+-c         Handle the first iteration, j = 1,
+-c         calculating all scals (ifrescal = 1).
+-c
+-          ifrescal = 1
+-c
+-          j = 1
+-c
+-          do k = 1,krank
+-            if(k .lt. m) then
+-              mm = m-k+1
+-              call idz_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                          work(k),b(k,j))
+-            endif
+-          enddo ! k
+-c
+-c
+-          if(l .gt. 1) then
+-c
+-c           Handle the other iterations, j > 1,
+-c           using the scals just computed (ifrescal = 0).
+-c
+-            ifrescal = 0
+-c
+-            do j = 2,l
+-c
+-              do k = 1,krank
+-                if(k .lt. m) then
+-                  mm = m-k+1
+-                  call idz_houseapp(mm,a(k+1,k),b(k,j),ifrescal,
+-     1                              work(k),b(k,j))
+-                endif
+-              enddo ! k
+-c
+-            enddo ! j
+-c
+-          endif ! j .gt. 1
+-c
+-c
+-        endif ! ifadjoint .eq. 1
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_qrpiv(eps,m,n,a,krank,ind,ss)
+-c
+-c       computes the pivoted QR decomposition
+-c       of the matrix input into a, using Householder transformations,
+-c       _i.e._, transforms the matrix a from its input value in
+-c       to the matrix out with entry
+-c
+-c                               m
+-c       out(j,indprod(k))  =  Sigma  q(l,j) * in(l,k),
+-c                              l=1
+-c
+-c       for all j = 1, ..., krank, and k = 1, ..., n,
+-c
+-c       where in = the a from before the routine runs,
+-c       out = the a from after the routine runs,
+-c       out(j,k) = 0 when j > k (so that out is triangular),
+-c       q(1:m,1), ..., q(1:m,krank) are orthonormal,
+-c       indprod is the product of the permutations given by ind,
+-c       (as computable via the routine permmult,
+-c       with the permutation swapping 1 and ind(1) taken leftmost
+-c       in the product, that swapping 2 and ind(2) taken next leftmost,
+-c       ..., that swapping krank and ind(krank) taken rightmost),
+-c       and with the matrix out satisfying
+-c
+-c                   krank
+-c       in(j,k)  =  Sigma  q(j,l) * out(l,indprod(k))  +  epsilon(j,k),
+-c                    l=1
+-c
+-c       for all j = 1, ..., m, and k = 1, ..., n,
+-c
+-c       for some matrix epsilon such that
+-c       the root-sum-square of the entries of epsilon
+-c       <= the root-sum-square of the entries of in * eps.
+-c       Well, technically, this routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       input:
+-c       eps -- relative precision of the resulting QR decomposition
+-c       m -- first dimension of a and q
+-c       n -- second dimension of a
+-c       a -- matrix whose QR decomposition gets computed
+-c
+-c       output:
+-c       a -- triangular (R) factor in the QR decompositon
+-c            of the matrix input into the same storage locations,
+-c            with the Householder vectors stored in the part of a
+-c            that would otherwise consist entirely of zeroes, that is,
+-c            in a(j,k) with m >= j > k >= 1
+-c       krank -- numerical rank
+-c       ind(k) -- index of the k^th pivot vector;
+-c                 the following code segment will correctly rearrange
+-c                 the product b of q and the upper triangle of out
+-c                 so that b matches the input matrix in
+-c                 to relative precision eps:
+-c
+-c                 copy the non-rearranged product of q and out into b
+-c                 set k to krank
+-c                 [start of loop]
+-c                   swap b(1:m,k) and b(1:m,ind(k))
+-c                   decrement k by 1
+-c                 if k > 0, then go to [start of loop]
+-c
+-c       work:
+-c       ss -- must be at least n real*8 words long
+-c
+-c       _N.B._: This routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        integer n,m,ind(n),krank,k,j,kpiv,mm,nupdate,ifrescal
+-        real*8 ss(n),eps,ssmax,scal,ssmaxin,rswap,feps
+-        complex*16 a(m,n),cswap
+-c
+-c
+-        feps = .1d-16
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of a,
+-c       the maximum of all such sums, and find the first pivot
+-c       (column with the greatest such sum).
+-c
+-        ssmax = 0
+-        kpiv = 1
+-c
+-        do k = 1,n
+-c
+-          ss(k) = 0
+-          do j = 1,m
+-            ss(k) = ss(k)+a(j,k)*conjg(a(j,k))
+-          enddo ! j
+-c
+-          if(ss(k) .gt. ssmax) then
+-            ssmax = ss(k)
+-            kpiv = k
+-          endif
+-c
+-        enddo ! k
+-c
+-        ssmaxin = ssmax
+-c
+-        nupdate = 0
+-c
+-c
+-c       While ssmax > eps**2*ssmaxin, krank < m, and krank < n,
+-c       do the following block of code,
+-c       which ends at the statement labeled 2000.
+-c
+-        krank = 0
+- 1000   continue
+-c
+-        if(ssmax .le. eps**2*ssmaxin
+-     1   .or. krank .ge. m .or. krank .ge. n) goto 2000
+-        krank = krank+1
+-c
+-c
+-          mm = m-krank+1
+-c
+-c
+-c         Perform the pivoting.
+-c
+-          ind(krank) = kpiv
+-c
+-c         Swap a(1:m,krank) and a(1:m,kpiv).
+-c
+-          do j = 1,m
+-            cswap = a(j,krank)
+-            a(j,krank) = a(j,kpiv)
+-            a(j,kpiv) = cswap
+-          enddo ! j
+-c
+-c         Swap ss(krank) and ss(kpiv).
+-c
+-          rswap = ss(krank)
+-          ss(krank) = ss(kpiv)
+-          ss(kpiv) = rswap
+-c
+-c
+-          if(krank .lt. m) then
+-c
+-c
+-c           Compute the data for the Householder transformation
+-c           which will zero a(krank+1,krank), ..., a(m,krank)
+-c           when applied to a, replacing a(krank,krank)
+-c           with the first entry of the result of the application
+-c           of the Householder matrix to a(krank:m,krank),
+-c           and storing entries 2 to mm of the Householder vector
+-c           in a(krank+1,krank), ..., a(m,krank)
+-c           (which otherwise would get zeroed upon application
+-c           of the Householder transformation).
+-c
+-            call idz_house(mm,a(krank,krank),a(krank,krank),
+-     1                     a(krank+1,krank),scal)
+-            ifrescal = 0
+-c
+-c
+-c           Apply the Householder transformation
+-c           to the lower right submatrix of a
+-c           with upper leftmost entry at position (krank,krank+1).
+-c
+-            if(krank .lt. n) then
+-              do k = krank+1,n
+-                call idz_houseapp(mm,a(krank+1,krank),a(krank,k),
+-     1                            ifrescal,scal,a(krank,k))
+-              enddo ! k
+-            endif
+-c
+-c
+-c           Update the sums-of-squares array ss.
+-c
+-            do k = krank,n
+-              ss(k) = ss(k)-a(krank,k)*conjg(a(krank,k))
+-            enddo ! k
+-c
+-c
+-c           Find the pivot (column with the greatest sum of squares
+-c           of its entries).
+-c
+-            ssmax = 0
+-            kpiv = krank+1
+-c
+-            if(krank .lt. n) then
+-c
+-              do k = krank+1,n
+-c
+-                if(ss(k) .gt. ssmax) then
+-                  ssmax = ss(k)
+-                  kpiv = k
+-                endif
+-c
+-              enddo ! k
+-c
+-            endif ! krank .lt. n
+-c
+-c
+-c           Recompute the sums-of-squares and the pivot
+-c           when ssmax first falls below
+-c           sqrt((1000*feps)^2) * ssmaxin
+-c           and when ssmax first falls below
+-c           ((1000*feps)^2) * ssmaxin.
+-c
+-            if(
+-     1       (ssmax .lt. sqrt((1000*feps)**2) * ssmaxin
+-     2        .and. nupdate .eq. 0) .or.
+-     3       (ssmax .lt. ((1000*feps)**2) * ssmaxin
+-     4        .and. nupdate .eq. 1)
+-     5      ) then
+-c
+-              nupdate = nupdate+1
+-c
+-              ssmax = 0
+-              kpiv = krank+1
+-c
+-              if(krank .lt. n) then
+-c
+-                do k = krank+1,n
+-c
+-                  ss(k) = 0
+-                  do j = krank+1,m
+-                    ss(k) = ss(k)+a(j,k)*conjg(a(j,k))
+-                  enddo ! j
+-c
+-                  if(ss(k) .gt. ssmax) then
+-                    ssmax = ss(k)
+-                    kpiv = k
+-                  endif
+-c
+-                enddo ! k
+-c
+-              endif ! krank .lt. n
+-c
+-            endif
+-c
+-c
+-          endif ! krank .lt. m
+-c
+-c
+-        goto 1000
+- 2000   continue
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_qrpiv(m,n,a,krank,ind,ss)
+-c
+-c       computes the pivoted QR decomposition
+-c       of the matrix input into a, using Householder transformations,
+-c       _i.e._, transforms the matrix a from its input value in
+-c       to the matrix out with entry
+-c
+-c                               m
+-c       out(j,indprod(k))  =  Sigma  q(l,j) * in(l,k),
+-c                              l=1
+-c
+-c       for all j = 1, ..., krank, and k = 1, ..., n,
+-c
+-c       where in = the a from before the routine runs,
+-c       out = the a from after the routine runs,
+-c       out(j,k) = 0 when j > k (so that out is triangular),
+-c       q(1:m,1), ..., q(1:m,krank) are orthonormal,
+-c       indprod is the product of the permutations given by ind,
+-c       (as computable via the routine permmult,
+-c       with the permutation swapping 1 and ind(1) taken leftmost
+-c       in the product, that swapping 2 and ind(2) taken next leftmost,
+-c       ..., that swapping krank and ind(krank) taken rightmost),
+-c       and with the matrix out satisfying
+-c
+-c                  min(m,n,krank)
+-c       in(j,k)  =     Sigma      q(j,l) * out(l,indprod(k))
+-c                       l=1
+-c
+-c                +  epsilon(j,k),
+-c
+-c       for all j = 1, ..., m, and k = 1, ..., n,
+-c
+-c       for some matrix epsilon whose norm is (hopefully) minimized
+-c       by the pivoting procedure.
+-c       Well, technically, this routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       input:
+-c       m -- first dimension of a and q
+-c       n -- second dimension of a
+-c       a -- matrix whose QR decomposition gets computed
+-c       krank -- desired rank of the output matrix
+-c                (please note that if krank > m or krank > n,
+-c                then the rank of the output matrix will be
+-c                less than krank)
+-c
+-c       output:
+-c       a -- triangular (R) factor in the QR decompositon
+-c            of the matrix input into the same storage locations,
+-c            with the Householder vectors stored in the part of a
+-c            that would otherwise consist entirely of zeroes, that is,
+-c            in a(j,k) with m >= j > k >= 1
+-c       ind(k) -- index of the k^th pivot vector;
+-c                 the following code segment will correctly rearrange
+-c                 the product b of q and the upper triangle of out
+-c                 so that b matches the input matrix in
+-c                 to relative precision eps:
+-c
+-c                 copy the non-rearranged product of q and out into b
+-c                 set k to krank
+-c                 [start of loop]
+-c                   swap b(1:m,k) and b(1:m,ind(k))
+-c                   decrement k by 1
+-c                 if k > 0, then go to [start of loop]
+-c
+-c       work:
+-c       ss -- must be at least n real*8 words long
+-c
+-c       _N.B._: This routine outputs the Householder vectors
+-c       (or, rather, their second through last entries)
+-c       in the part of a that is supposed to get zeroed, that is,
+-c       in a(j,k) with m >= j > k >= 1.
+-c
+-c       reference:
+-c       Golub and Van Loan, "Matrix Computations," 3rd edition,
+-c            Johns Hopkins University Press, 1996, Chapter 5.
+-c
+-        implicit none
+-        integer n,m,ind(n),krank,k,j,kpiv,mm,nupdate,ifrescal,
+-     1          loops,loop
+-        real*8 ss(n),ssmax,scal,ssmaxin,rswap,feps
+-        complex*16 a(m,n),cswap
+-c
+-c
+-        feps = .1d-16
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of a,
+-c       the maximum of all such sums, and find the first pivot
+-c       (column with the greatest such sum).
+-c
+-        ssmax = 0
+-        kpiv = 1
+-c
+-        do k = 1,n
+-c
+-          ss(k) = 0
+-          do j = 1,m
+-            ss(k) = ss(k)+a(j,k)*conjg(a(j,k))
+-          enddo ! j
+-c
+-          if(ss(k) .gt. ssmax) then
+-            ssmax = ss(k)
+-            kpiv = k
+-          endif
+-c
+-        enddo ! k
+-c
+-        ssmaxin = ssmax
+-c
+-        nupdate = 0
+-c
+-c
+-c       Set loops = min(krank,m,n).
+-c
+-        loops = krank
+-        if(m .lt. loops) loops = m
+-        if(n .lt. loops) loops = n
+-c
+-        do loop = 1,loops
+-c
+-c
+-          mm = m-loop+1
+-c
+-c
+-c         Perform the pivoting.
+-c
+-          ind(loop) = kpiv
+-c
+-c         Swap a(1:m,loop) and a(1:m,kpiv).
+-c
+-          do j = 1,m
+-            cswap = a(j,loop)
+-            a(j,loop) = a(j,kpiv)
+-            a(j,kpiv) = cswap
+-          enddo ! j
+-c
+-c         Swap ss(loop) and ss(kpiv).
+-c
+-          rswap = ss(loop)
+-          ss(loop) = ss(kpiv)
+-          ss(kpiv) = rswap
+-c
+-c
+-          if(loop .lt. m) then
+-c
+-c
+-c           Compute the data for the Householder transformation
+-c           which will zero a(loop+1,loop), ..., a(m,loop)
+-c           when applied to a, replacing a(loop,loop)
+-c           with the first entry of the result of the application
+-c           of the Householder matrix to a(loop:m,loop),
+-c           and storing entries 2 to mm of the Householder vector
+-c           in a(loop+1,loop), ..., a(m,loop)
+-c           (which otherwise would get zeroed upon application
+-c           of the Householder transformation).
+-c
+-            call idz_house(mm,a(loop,loop),a(loop,loop),
+-     1                     a(loop+1,loop),scal)
+-            ifrescal = 0
+-c
+-c
+-c           Apply the Householder transformation
+-c           to the lower right submatrix of a
+-c           with upper leftmost entry at position (loop,loop+1).
+-c
+-            if(loop .lt. n) then
+-              do k = loop+1,n
+-                call idz_houseapp(mm,a(loop+1,loop),a(loop,k),
+-     1                            ifrescal,scal,a(loop,k))
+-              enddo ! k
+-            endif
+-c
+-c
+-c           Update the sums-of-squares array ss.
+-c
+-            do k = loop,n
+-              ss(k) = ss(k)-a(loop,k)*conjg(a(loop,k))
+-            enddo ! k
+-c
+-c
+-c           Find the pivot (column with the greatest sum of squares
+-c           of its entries).
+-c
+-            ssmax = 0
+-            kpiv = loop+1
+-c
+-            if(loop .lt. n) then
+-c
+-              do k = loop+1,n
+-c
+-                if(ss(k) .gt. ssmax) then
+-                  ssmax = ss(k)
+-                  kpiv = k
+-                endif
+-c
+-              enddo ! k
+-c
+-            endif ! loop .lt. n
+-c
+-c
+-c           Recompute the sums-of-squares and the pivot
+-c           when ssmax first falls below
+-c           sqrt((1000*feps)^2) * ssmaxin
+-c           and when ssmax first falls below
+-c           ((1000*feps)^2) * ssmaxin.
+-c
+-            if(
+-     1       (ssmax .lt. sqrt((1000*feps)**2) * ssmaxin
+-     2        .and. nupdate .eq. 0) .or.
+-     3       (ssmax .lt. ((1000*feps)**2) * ssmaxin
+-     4        .and. nupdate .eq. 1)
+-     5      ) then
+-c
+-              nupdate = nupdate+1
+-c
+-              ssmax = 0
+-              kpiv = loop+1
+-c
+-              if(loop .lt. n) then
+-c
+-                do k = loop+1,n
+-c
+-                  ss(k) = 0
+-                  do j = loop+1,m
+-                    ss(k) = ss(k)+a(j,k)*conjg(a(j,k))
+-                  enddo ! j
+-c
+-                  if(ss(k) .gt. ssmax) then
+-                    ssmax = ss(k)
+-                    kpiv = k
+-                  endif
+-c
+-                enddo ! k
+-c
+-              endif ! loop .lt. n
+-c
+-            endif
+-c
+-c
+-          endif ! loop .lt. m
+-c
+-c
+-        enddo ! loop
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_sfft.f b/scipy/linalg/src/id_dist/src/idz_sfft.f
+deleted file mode 100644
+index c8dd9ab18..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_sfft.f
++++ /dev/null
+@@ -1,210 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idz_sffti initializes routine idz_sfft.
+-c
+-c       routine idz_sfft rapidly computes a subset of the entries
+-c       of the DFT of a vector, composed with permutation matrices
+-c       both on input and on output.
+-c
+-c       routine idz_ldiv finds the greatest integer less than or equal
+-c       to a specified integer, that is divisible by another (larger)
+-c       specified integer.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_ldiv(l,n,m)
+-c
+-c       finds the greatest integer less than or equal to l
+-c       that divides n.
+-c
+-c       input:
+-c       l -- integer at least as great as m
+-c       n -- integer divisible by m
+-c
+-c       output:
+-c       m -- greatest integer less than or equal to l that divides n
+-c
+-        implicit none
+-        integer n,l,m
+-c
+-c
+-        m = l
+-c
+- 1000   continue
+-        if(m*(n/m) .eq. n) goto 2000
+-c
+-          m = m-1
+-          goto 1000
+-c
+- 2000   continue
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_sffti(l,ind,n,wsave)
+-c
+-c       initializes wsave for use with routine idz_sfft.
+-c
+-c       input:
+-c       l -- number of entries in the output of idz_sfft to compute
+-c       ind -- indices of the entries in the output of idz_sfft
+-c              to compute
+-c       n -- length of the vector to be transformed
+-c
+-c       output:
+-c       wsave -- array needed by routine idz_sfft for processing
+-c
+-        implicit none
+-        integer l,ind(l),n,nblock,ii,m,idivm,imodm,i,j,k
+-        real*8 r1,twopi,fact
+-        complex*16 wsave(2*l+15+3*n),ci,twopii
+-c
+-        ci = (0,1)
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-        twopii = twopi*ci
+-c
+-c
+-c       Determine the block lengths for the FFTs.
+-c
+-        call idz_ldiv(l,n,nblock)
+-        m = n/nblock
+-c
+-c
+-c       Initialize wsave for use with routine zfftf.
+-c
+-        call zffti(nblock,wsave)
+-c
+-c
+-c       Calculate the coefficients in the linear combinations
+-c       needed for the direct portion of the calculation.
+-c
+-        fact = 1/sqrt(r1*n)
+-c
+-        ii = 2*l+15
+-c
+-        do j = 1,l
+-c
+-          i = ind(j)
+-c
+-          idivm = (i-1)/m
+-          imodm = (i-1)-m*idivm
+-c
+-          do k = 1,m
+-            wsave(ii+m*(j-1)+k) = exp(-twopii*imodm*(k-1)/(r1*m))
+-     1       * exp(-twopii*(k-1)*idivm/(r1*n)) * fact
+-          enddo ! k
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_sfft(l,ind,n,wsave,v)
+-c
+-c       computes a subset of the entries of the DFT of v,
+-c       composed with permutation matrices both on input and on output,
+-c       via a two-stage procedure (routine zfftf2 is supposed
+-c       to calculate the full vector from which idz_sfft returns
+-c       a subset of the entries, when zfftf2 has the same parameter
+-c       nblock as in the present routine).
+-c
+-c       input:
+-c       l -- number of entries in the output to compute
+-c       ind -- indices of the entries of the output to compute
+-c       n -- length of v
+-c       v -- vector to be transformed
+-c       wsave -- processing array initialized by routine idz_sffti
+-c
+-c       output:
+-c       v -- entries indexed by ind are given their appropriate
+-c            transformed values
+-c
+-c       _N.B._: The user has to boost the memory allocations
+-c               for wsave (and change iii accordingly) if s/he wishes
+-c               to use strange sizes of n; it's best to stick to powers
+-c               of 2.
+-c
+-c       references:
+-c       Sorensen and Burrus, "Efficient computation of the DFT with
+-c            only a subset of input or output points,"
+-c            IEEE Transactions on Signal Processing, 41 (3): 1184-1200,
+-c            1993.
+-c       Woolfe, Liberty, Rokhlin, Tygert, "A fast randomized algorithm
+-c            for the approximation of matrices," Applied and
+-c            Computational Harmonic Analysis, 25 (3): 335-366, 2008;
+-c            Section 3.3.
+-c
+-        implicit none
+-        integer n,m,l,k,j,ind(l),i,idivm,nblock,ii,iii
+-        real*8 r1,twopi
+-        complex*16 v(n),wsave(2*l+15+3*n),ci,sum
+-c
+-        ci = (0,1)
+-        r1 = 1
+-        twopi = 2*4*atan(r1)
+-c
+-c
+-c       Determine the block lengths for the FFTs.
+-c
+-        call idz_ldiv(l,n,nblock)
+-c
+-c
+-        m = n/nblock
+-c
+-c
+-c       FFT each block of length nblock of v.
+-c
+-        do k = 1,m
+-          call zfftf(nblock,v(nblock*(k-1)+1),wsave)
+-        enddo ! k
+-c
+-c
+-c       Transpose v to obtain wsave(2*l+15+2*n+1 : 2*l+15+3*n).
+-c
+-        iii = 2*l+15+2*n
+-c
+-        do k = 1,m
+-          do j = 1,nblock
+-            wsave(iii+m*(j-1)+k) = v(nblock*(k-1)+j)
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       Directly calculate the desired entries of v.
+-c
+-        ii = 2*l+15
+-        iii = 2*l+15+2*n
+-c
+-        do j = 1,l
+-c
+-          i = ind(j)
+-c
+-          idivm = (i-1)/m
+-c
+-          sum = 0
+-c
+-          do k = 1,m
+-            sum = sum + wsave(ii+m*(j-1)+k) * wsave(iii+m*idivm+k)
+-          enddo ! k
+-c
+-          v(i) = sum
+-c
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_snorm.f b/scipy/linalg/src/id_dist/src/idz_snorm.f
+deleted file mode 100644
+index 9fe713d47..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_snorm.f
++++ /dev/null
+@@ -1,407 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idz_snorm estimates the spectral norm
+-c       of a matrix specified by routines for applying the matrix
+-c       and its adjoint to arbitrary vectors. This routine uses
+-c       the power method with a random starting vector.
+-c
+-c       routine idz_diffsnorm estimates the spectral norm
+-c       of the difference between two matrices specified by routines
+-c       for applying the matrices and their adjoints
+-c       to arbitrary vectors. This routine uses
+-c       the power method with a random starting vector.
+-c
+-c       routine idz_enorm calculates the Euclidean norm of a vector.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idz_snorm(m,n,matveca,p1a,p2a,p3a,p4a,
+-     1                       matvec,p1,p2,p3,p4,its,snorm,v,u)
+-c
+-c       estimates the spectral norm of a matrix a specified
+-c       by a routine matvec for applying a to an arbitrary vector,
+-c       and by a routine matveca for applying a^*
+-c       to an arbitrary vector. This routine uses the power method
+-c       with a random starting vector.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matveca -- routine which applies the adjoint of a
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matveca(m,x,n,y,p1a,p2a,p3a,p4a),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint of a
+-c                  is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of a and x,
+-c                  and p1a, p2a, p3a, and p4a are user-specified
+-c                  parameters
+-c       p1a -- parameter to be passed to routine matveca
+-c       p2a -- parameter to be passed to routine matveca
+-c       p3a -- parameter to be passed to routine matveca
+-c       p4a -- parameter to be passed to routine matveca
+-c       matvec -- routine which applies the matrix a
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which a is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of a and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       its -- number of iterations of the power method to conduct
+-c
+-c       output:
+-c       snorm -- estimate of the spectral norm of a
+-c       v -- estimate of a normalized right singular vector
+-c            corresponding to the greatest singular value of a
+-c
+-c       work:
+-c       u -- must be at least m complex*16 elements long
+-c
+-c       reference:
+-c       Kuczynski and Wozniakowski, "Estimating the largest eigenvalue
+-c            by the power and Lanczos algorithms with a random start,"
+-c            SIAM Journal on Matrix Analysis and Applications,
+-c            13 (4): 1992, 1094-1122.
+-c
+-        implicit none
+-        integer m,n,its,it,n2,k
+-        real*8 snorm,enorm
+-        complex*16 p1a,p2a,p3a,p4a,p1,p2,p3,p4,u(m),v(n)
+-        external matveca,matvec
+-c
+-c
+-c       Fill the real and imaginary parts of each entry
+-c       of the initial vector v with i.i.d. random variables
+-c       drawn uniformly from [-1,1].
+-c
+-        n2 = 2*n
+-        call id_srand(n2,v)
+-c
+-        do k = 1,n
+-          v(k) = 2*v(k)-1
+-        enddo ! k
+-c
+-c
+-c       Normalize v.
+-c
+-        call idz_enorm(n,v,enorm)
+-c
+-        do k = 1,n
+-          v(k) = v(k)/enorm
+-        enddo ! k
+-c
+-c
+-        do it = 1,its
+-c
+-c         Apply a to v, obtaining u.
+-c
+-          call matvec(n,v,m,u,p1,p2,p3,p4)
+-c
+-c         Apply a^* to u, obtaining v.
+-c
+-          call matveca(m,u,n,v,p1a,p2a,p3a,p4a)
+-c
+-c         Normalize v.
+-c
+-          call idz_enorm(n,v,snorm)
+-c
+-          if(snorm .ne. 0) then
+-c
+-            do k = 1,n
+-              v(k) = v(k)/snorm
+-            enddo ! k
+-c
+-          endif
+-c
+-          snorm = sqrt(snorm)
+-c
+-        enddo ! it
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_enorm(n,v,enorm)
+-c
+-c       computes the Euclidean norm of v, the square root
+-c       of the sum of the squares of the absolute values
+-c       of the entries of v.
+-c
+-c       input:
+-c       n -- length of v
+-c       v -- vector whose Euclidean norm is to be calculated
+-c
+-c       output:
+-c       enorm -- Euclidean norm of v
+-c
+-        implicit none
+-        integer n,k
+-        real*8 enorm
+-        complex*16 v(n)
+-c
+-c
+-        enorm = 0
+-c
+-        do k = 1,n
+-          enorm = enorm+v(k)*conjg(v(k))
+-        enddo ! k
+-c
+-        enorm = sqrt(enorm)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_diffsnorm(m,n,matveca,p1a,p2a,p3a,p4a,
+-     1                           matveca2,p1a2,p2a2,p3a2,p4a2,
+-     2                           matvec,p1,p2,p3,p4,
+-     3                           matvec2,p12,p22,p32,p42,its,snorm,w)
+-c
+-c       estimates the spectral norm of the difference between matrices
+-c       a and a2, where a is specified by routines matvec and matveca
+-c       for applying a and a^* to arbitrary vectors,
+-c       and a2 is specified by routines matvec2 and matveca2
+-c       for applying a2 and (a2)^* to arbitrary vectors.
+-c       This routine uses the power method
+-c       with a random starting vector.
+-c
+-c       input:
+-c       m -- number of rows in a, as well as the number of rows in a2
+-c       n -- number of columns in a, as well as the number of columns
+-c            in a2
+-c       matveca -- routine which applies the adjoint of a
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matveca(m,x,n,y,p1a,p2a,p3a,p4a),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint of a
+-c                  is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of a and x,
+-c                  and p1a, p2a, p3a, and p4a are user-specified
+-c                  parameters
+-c       p1a -- parameter to be passed to routine matveca
+-c       p2a -- parameter to be passed to routine matveca
+-c       p3a -- parameter to be passed to routine matveca
+-c       p4a -- parameter to be passed to routine matveca
+-c       matveca2 -- routine which applies the adjoint of a2
+-c                   to an arbitrary vector; this routine must have
+-c                   a calling sequence of the form
+-c
+-c                   matveca2(m,x,n,y,p1a2,p2a2,p3a2,p4a2),
+-c
+-c                   where m is the length of x,
+-c                   x is the vector to which the adjoint of a2
+-c                   is to be applied,
+-c                   n is the length of y,
+-c                   y is the product of the adjoint of a2 and x,
+-c                   and p1a2, p2a2, p3a2, and p4a2 are user-specified
+-c                   parameters
+-c       p1a2 -- parameter to be passed to routine matveca2
+-c       p2a2 -- parameter to be passed to routine matveca2
+-c       p3a2 -- parameter to be passed to routine matveca2
+-c       p4a2 -- parameter to be passed to routine matveca2
+-c       matvec -- routine which applies the matrix a
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which a is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of a and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       matvec2 -- routine which applies the matrix a2
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matvec2(n,x,m,y,p12,p22,p32,p42),
+-c
+-c                  where n is the length of x,
+-c                  x is the vector to which a2 is to be applied,
+-c                  m is the length of y,
+-c                  y is the product of a2 and x, and
+-c                  p12, p22, p32, and p42 are user-specified parameters
+-c       p12 -- parameter to be passed to routine matvec2
+-c       p22 -- parameter to be passed to routine matvec2
+-c       p32 -- parameter to be passed to routine matvec2
+-c       p42 -- parameter to be passed to routine matvec2
+-c       its -- number of iterations of the power method to conduct
+-c
+-c       output:
+-c       snorm -- estimate of the spectral norm of a-a2
+-c
+-c       work:
+-c       w -- must be at least 3*m+3*n complex*16 elements long
+-c
+-c       reference:
+-c       Kuczynski and Wozniakowski, "Estimating the largest eigenvalue
+-c            by the power and Lanczos algorithms with a random start,"
+-c            SIAM Journal on Matrix Analysis and Applications,
+-c            13 (4): 1992, 1094-1122.
+-c
+-        implicit none
+-        integer m,n,its,lw,iu,lu,iu1,lu1,iu2,lu2,
+-     1          iv,lv,iv1,lv1,iv2,lv2
+-        real*8 snorm
+-        complex*16 p1a,p2a,p3a,p4a,p1a2,p2a2,p3a2,p4a2,
+-     1             p1,p2,p3,p4,p12,p22,p32,p42,w(3*m+3*n)
+-        external matveca,matvec,matveca2,matvec2
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iu = lw+1
+-        lu = m
+-        lw = lw+lu
+-c
+-        iu1 = lw+1
+-        lu1 = m
+-        lw = lw+lu1
+-c
+-        iu2 = lw+1
+-        lu2 = m
+-        lw = lw+lu2
+-c
+-        iv = lw+1
+-        lv = n
+-        lw = lw+1
+-c
+-        iv1 = lw+1
+-        lv1 = n
+-        lw = lw+lv1
+-c
+-        iv2 = lw+1
+-        lv2 = n
+-        lw = lw+lv2
+-c
+-c
+-        call idz_diffsnorm0(m,n,matveca,p1a,p2a,p3a,p4a,
+-     1                      matveca2,p1a2,p2a2,p3a2,p4a2,
+-     2                      matvec,p1,p2,p3,p4,
+-     3                      matvec2,p12,p22,p32,p42,
+-     4                      its,snorm,w(iu),w(iu1),w(iu2),
+-     5                      w(iv),w(iv1),w(iv2))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_diffsnorm0(m,n,matveca,p1a,p2a,p3a,p4a,
+-     1                            matveca2,p1a2,p2a2,p3a2,p4a2,
+-     2                            matvec,p1,p2,p3,p4,
+-     3                            matvec2,p12,p22,p32,p42,
+-     4                            its,snorm,u,u1,u2,v,v1,v2)
+-c
+-c       routine idz_diffsnorm serves as a memory wrapper
+-c       for the present routine. (Please see routine idz_diffsnorm
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,its,it,n2,k
+-        real*8 snorm,enorm
+-        complex*16 p1a,p2a,p3a,p4a,p1a2,p2a2,p3a2,p4a2,
+-     1             p1,p2,p3,p4,p12,p22,p32,p42,u(m),u1(m),u2(m),
+-     2             v(n),v1(n),v2(n)
+-        external matveca,matvec,matveca2,matvec2
+-c
+-c
+-c       Fill the real and imaginary parts of each entry
+-c       of the initial vector v with i.i.d. random variables
+-c       drawn uniformly from [-1,1].
+-c
+-        n2 = 2*n
+-        call id_srand(n2,v)
+-c
+-        do k = 1,n
+-          v(k) = 2*v(k)-1
+-        enddo ! k
+-c
+-c
+-c       Normalize v.
+-c
+-        call idz_enorm(n,v,enorm)
+-c
+-        do k = 1,n
+-          v(k) = v(k)/enorm
+-        enddo ! k
+-c
+-c
+-        do it = 1,its
+-c
+-c         Apply a and a2 to v, obtaining u1 and u2.
+-c
+-          call matvec(n,v,m,u1,p1,p2,p3,p4)
+-          call matvec2(n,v,m,u2,p12,p22,p32,p42)
+-c
+-c         Form u = u1-u2.
+-c
+-          do k = 1,m
+-            u(k) = u1(k)-u2(k)
+-          enddo ! k
+-c
+-c         Apply a^* and (a2)^* to u, obtaining v1 and v2.
+-c
+-          call matveca(m,u,n,v1,p1a,p2a,p3a,p4a)
+-          call matveca2(m,u,n,v2,p1a2,p2a2,p3a2,p4a2)
+-c
+-c         Form v = v1-v2.
+-c
+-          do k = 1,n
+-            v(k) = v1(k)-v2(k)
+-          enddo ! k
+-c
+-c         Normalize v.
+-c
+-          call idz_enorm(n,v,snorm)
+-c
+-          if(snorm .gt. 0) then
+-c
+-            do k = 1,n
+-              v(k) = v(k)/snorm
+-            enddo ! k
+-c
+-          endif
+-c
+-          snorm = sqrt(snorm)
+-c
+-        enddo ! it
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idz_svd.f b/scipy/linalg/src/id_dist/src/idz_svd.f
+deleted file mode 100644
+index e14cf66a0..000000000
+--- a/scipy/linalg/src/id_dist/src/idz_svd.f
++++ /dev/null
+@@ -1,438 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzr_svd computes an approximation of specified rank
+-c       to a given matrix, in the usual SVD form U S V^*,
+-c       where U has orthonormal columns, V has orthonormal columns,
+-c       and S is diagonal.
+-c
+-c       routine idzp_svd computes an approximation of specified
+-c       precision to a given matrix, in the usual SVD form U S V^*,
+-c       where U has orthonormal columns, V has orthonormal columns,
+-c       and S is diagonal.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzr_svd(m,n,a,krank,u,v,s,ier,r)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^*  approximating a,
+-c       where u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine combines a QR code
+-c       (which is based on plane/Householder reflections)
+-c       with the LAPACK routine zgesdd.
+-c
+-c       input:
+-c       m -- first dimension of a and u
+-c       n -- second dimension of a, and first dimension of v
+-c       a -- matrix to be SVD'd
+-c       krank -- desired rank of the approximation to a
+-c
+-c       output:
+-c       u -- left singular vectors of a corresponding
+-c            to the k greatest singular values of a
+-c       v -- right singular vectors of a corresponding
+-c            to the k greatest singular values of a
+-c       s -- k greatest singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero when the routine encounters an error
+-c
+-c       work:
+-c       r -- must be at least
+-c            (krank+2)*n+8*min(m,n)+6*krank**2+8*krank
+-c            complex*16 elements long
+-c
+-c       _N.B._: This routine destroys a. Also, please beware that
+-c               the source code for this routine could be clearer.
+-c
+-        implicit none
+-        character*1 jobz
+-        integer m,n,k,krank,ifadjoint,ldr,ldu,ldvadj,lwork,
+-     1          info,j,ier,io
+-        real*8 s(krank)
+-        complex*16 a(m,n),u(m,krank),v(n*krank),r(*)
+-c
+-c
+-        io = 8*min(m,n)
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Compute a pivoted QR decomposition of a.
+-c
+-        call idzr_qrpiv(m,n,a,krank,r,r(io+1))
+-c
+-c
+-c       Extract R from the QR decomposition.
+-c
+-        call idz_retriever(m,n,a,krank,r(io+1))
+-c
+-c
+-c       Rearrange R according to ind.
+-c
+-        call idz_permuter(krank,r,krank,n,r(io+1))
+-c
+-c
+-c       Use LAPACK to SVD r,
+-c       storing the krank (krank x 1) left singular vectors
+-c       in r(io+krank*n+1 : io+krank*n+krank*krank).
+-c
+-        jobz = 'S'
+-        ldr = krank
+-        lwork = 2*(krank**2+2*krank+n)
+-        ldu = krank
+-        ldvadj = krank
+-c
+-        call zgesdd(jobz,krank,n,r(io+1),ldr,s,r(io+krank*n+1),ldu,
+-     1              v,ldvadj,r(io+krank*n+krank*krank+1),lwork,
+-     2              r(io+krank*n+krank*krank+lwork+1),r,info)
+-c
+-        if(info .ne. 0) then
+-          ier = info
+-          return
+-        endif
+-c
+-c
+-c       Multiply the U from R from the left by Q to obtain the U
+-c       for A.
+-c
+-        do k = 1,krank
+-c
+-          do j = 1,krank
+-            u(j,k) = r(io+krank*n+j+krank*(k-1))
+-          enddo ! j
+-c
+-          do j = krank+1,m
+-            u(j,k) = 0
+-          enddo ! j
+-c
+-        enddo ! k
+-c
+-        ifadjoint = 0
+-        call idz_qmatmat(ifadjoint,m,n,a,krank,krank,u,r)
+-c
+-c
+-c       Take the adjoint of v to obtain r.
+-c
+-        call idz_adjer(krank,n,v,r)
+-c
+-c
+-c       Copy r into v.
+-c
+-        do k = 1,n*krank
+-          v(k) = r(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_svd(lw,eps,m,n,a,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^*  approximating a
+-c       to precision eps, where U is an m x krank matrix whose
+-c       columns are orthonormal, V is an n x krank matrix whose
+-c       columns are orthonormal, and Sigma is a diagonal krank x krank
+-c       matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine combines a QR code
+-c       (which is based on plane/Householder reflections)
+-c       with the LAPACK routine zgesdd.
+-c
+-c       input:
+-c       lw -- maximum usable length of w (in complex*16 elements)
+-c       eps -- precision to which the SVD approximates a
+-c       m -- first dimension of a and u
+-c       n -- second dimension of a, and first dimension of v
+-c       a -- matrix to be SVD'd
+-c
+-c       output:
+-c       krank -- rank of the approximation to a
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a; the singular values are stored
+-c             as complex*16 numbers whose imaginary parts are zeros
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            (krank+1)*(m+2*n+9)+8*min(m,n)+6*krank**2
+-c            complex*16 elements long, where krank is the rank
+-c            output by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when zgesdd bombs
+-c
+-c       _N.B._: This routine destroys a. Also, please beware that
+-c               the source code for this routine could be clearer.
+-c               w must be at least
+-c               (krank+1)*(m+2*n+9)+8*min(m,n)+6*krank**2
+-c               complex*16 elements long, where krank is the rank
+-c               output by the present routine.
+-c
+-        implicit none
+-        character*1 jobz
+-        integer m,n,k,krank,ifadjoint,ldr,ldu,ldvadj,lwork,
+-     1          info,j,ier,io,iu,iv,is,ivi,isi,lu,lv,ls,lw
+-        real*8 eps
+-        complex*16 a(m,n),w(*)
+-c
+-c
+-        io = 8*min(m,n)
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Compute a pivoted QR decomposition of a.
+-c
+-        call idzp_qrpiv(eps,m,n,a,krank,w,w(io+1))
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Extract R from the QR decomposition.
+-c
+-          call idz_retriever(m,n,a,krank,w(io+1))
+-c
+-c
+-c         Rearrange R according to ind.
+-c
+-          call idz_permuter(krank,w,krank,n,w(io+1))
+-c
+-c
+-c         Use LAPACK to SVD R,
+-c         storing the krank (krank x 1) left singular vectors
+-c         in w(io+krank*n+1 : io+krank*n+krank*krank).
+-c
+-          jobz = 'S'
+-          ldr = krank
+-          lwork = 2*(krank**2+2*krank+n)
+-          ldu = krank
+-          ldvadj = krank
+-c
+-          ivi = io+krank*n+krank*krank+lwork+3*krank**2+4*krank+1
+-          lv = n*krank
+-c
+-          isi = ivi+lv
+-          ls = krank
+-c
+-          if(lw .lt. isi+ls+m*krank-1) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-          call zgesdd(jobz,krank,n,w(io+1),ldr,w(isi),w(io+krank*n+1),
+-     1                ldu,w(ivi),ldvadj,w(io+krank*n+krank*krank+1),
+-     2                lwork,w(io+krank*n+krank*krank+lwork+1),w,info)
+-c
+-          if(info .ne. 0) then
+-            ier = info
+-            return
+-          endif
+-c
+-c
+-c         Take the adjoint of w(ivi:ivi+lv-1) to obtain V.
+-c
+-          iv = 1
+-          call idz_adjer(krank,n,w(ivi),w(iv))
+-c
+-c
+-c         Copy w(isi:isi+ls/2) into w(is:is+ls-1).
+-c
+-          is = iv+lv
+-c
+-          call idz_realcomp(ls,w(isi),w(is))
+-c
+-c
+-c         Multiply the U from R from the left by Q to obtain the U
+-c         for A.
+-c
+-          iu = is+ls
+-          lu = m*krank
+-c
+-          do k = 1,krank
+-c
+-            do j = 1,krank
+-              w(iu-1+j+krank*(k-1)) = w(io+krank*n+j+krank*(k-1))
+-            enddo ! j
+-c
+-          enddo ! k
+-c
+-          do k = krank,1,-1
+-c
+-            do j = m,krank+1,-1
+-              w(iu-1+j+m*(k-1)) = 0
+-            enddo ! j
+-c
+-            do j = krank,1,-1
+-              w(iu-1+j+m*(k-1)) = w(iu-1+j+krank*(k-1))
+-            enddo ! j
+-c
+-          enddo ! k
+-c
+-          ifadjoint = 0
+-          call idz_qmatmat(ifadjoint,m,n,a,krank,krank,w(iu),
+-     1                     w(iu+lu+1))
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_realcomp(n,a,b)
+-c
+-c       copies the real*8 array a into the complex*16 array b.
+-c
+-c       input:
+-c       n -- length of a and b
+-c       a -- real*8 array to be copied into b
+-c
+-c       output:
+-c       b -- complex*16 copy of a
+-c
+-        integer n,k
+-        real*8 a(n)
+-        complex*16 b(n)
+-c
+-c
+-        do k = 1,n
+-          b(k) = a(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_permuter(krank,ind,m,n,a)
+-c
+-c       permutes the columns of a according to ind obtained
+-c       from routine idzr_qrpiv or idzp_qrpiv, assuming that
+-c       a = q r from idzr_qrpiv or idzp_qrpiv.
+-c
+-c       input:
+-c       krank -- rank specified to routine idzr_qrpiv
+-c                or obtained from routine idzp_qrpiv
+-c       ind -- indexing array obtained from routine idzr_qrpiv
+-c              or idzp_qrpiv
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be rearranged
+-c
+-c       output:
+-c       a -- rearranged matrix
+-c
+-        implicit none
+-        integer k,krank,m,n,j,ind(krank)
+-        complex*16 cswap,a(m,n)
+-c
+-c
+-        do k = krank,1,-1
+-          do j = 1,m
+-c
+-            cswap = a(j,k)
+-            a(j,k) = a(j,ind(k))
+-            a(j,ind(k)) = cswap
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_retriever(m,n,a,krank,r)
+-c
+-c       extracts R in the QR decomposition specified by the output a
+-c       of the routine idzr_qrpiv or idzp_qrpiv
+-c
+-c       input:
+-c       m -- first dimension of a
+-c       n -- second dimension of a and r
+-c       a -- output of routine idzr_qrpiv or idzp_qrpiv
+-c       krank -- rank specified to routine idzr_qrpiv,
+-c                or output by routine idzp_qrpiv
+-c
+-c       output:
+-c       r -- triangular factor in the QR decomposition specified
+-c            by the output a of the routine idzr_qrpiv or idzp_qrpiv
+-c
+-        implicit none
+-        integer m,n,j,k,krank
+-        complex*16 a(m,n),r(krank,n)
+-c
+-c
+-c       Copy a into r and zero out the appropriate
+-c       Householder vectors that are stored in one triangle of a.
+-c
+-        do k = 1,n
+-          do j = 1,krank
+-            r(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-        do k = 1,n
+-          if(k .lt. krank) then
+-            do j = k+1,krank
+-              r(j,k) = 0
+-            enddo ! j
+-          endif
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_adjer(m,n,a,aa)
+-c
+-c       forms the adjoint aa of a.
+-c
+-c       input:
+-c       m -- first dimension of a and second dimension of aa
+-c       n -- second dimension of a and first dimension of aa
+-c       a -- matrix whose adjoint is to be taken
+-c
+-c       output:
+-c       aa -- adjoint of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        complex*16 a(m,n),aa(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            aa(k,j) = conjg(a(j,k))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzp_aid.f b/scipy/linalg/src/id_dist/src/idzp_aid.f
+deleted file mode 100644
+index 784b40cde..000000000
+--- a/scipy/linalg/src/id_dist/src/idzp_aid.f
++++ /dev/null
+@@ -1,390 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_aid computes the ID, to a specified precision,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c       routine idz_estrank estimates the numerical rank,
+-c       to a specified precision, of an arbitrary matrix.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzp_aid(eps,m,n,a,work,krank,list,proj)
+-c
+-c       computes the ID of the matrix a, i.e., lists in list
+-c       the indices of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c
+-c       input:
+-c       eps -- precision to which the ID is to be computed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix to be decomposed; the present routine does not
+-c            alter a
+-c       work -- initialization array that has been constructed
+-c               by routine idz_frmi
+-c
+-c       output:
+-c       krank -- numerical rank of a to precision eps
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               proj doubles as a work array in the present routine, so
+-c               proj must be at least n*(2*n2+1)+n2+1 complex*16
+-c               elements long, where n2 is the greatest integer
+-c               less than or equal to m, such that n2 is
+-c               a positive integer power of two.
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least n*(2*n2+1)+n2+1 complex*16
+-c               elements long, where n2 is the greatest integer
+-c               less than or equal to m, such that n2 is
+-c               a positive integer power of two.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,list(n),krank,kranki,n2
+-        real*8 eps
+-        complex*16 a(m,n),proj(*),work(17*m+70)
+-c
+-c
+-c       Allocate memory in proj.
+-c
+-        n2 = work(2)
+-c
+-c
+-c       Find the rank of a.
+-c
+-        call idz_estrank(eps,m,n,a,work,kranki,proj)
+-c
+-c
+-        if(kranki .eq. 0) call idzp_aid0(eps,m,n,a,krank,list,proj,
+-     1                                   proj(m*n+1))
+-c
+-        if(kranki .ne. 0) call idzp_aid1(eps,n2,n,kranki,proj,
+-     1                                   krank,list,proj(n2*n+1))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_aid0(eps,m,n,a,krank,list,proj,rnorms)
+-c
+-c       uses routine idzp_id to ID a without modifying its entries
+-c       (in contrast to the usual behavior of idzp_id).
+-c
+-c       input:
+-c       eps -- precision of the decomposition to be constructed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c
+-c       output:
+-c       krank -- numerical rank of the ID
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns in a;
+-c               proj doubles as a work array in the present routine, so
+-c               must be at least m*n complex*16 elements long
+-c
+-c       work:
+-c       rnorms -- must be at least n real*8 elements long
+-c
+-c       _N.B._: proj must be at least m*n complex*16 elements long
+-c
+-        implicit none
+-        integer m,n,krank,list(n),j,k
+-        real*8 eps,rnorms(n)
+-        complex*16 a(m,n),proj(m,n)
+-c
+-c
+-c       Copy a into proj.
+-c
+-        do k = 1,n
+-          do j = 1,m
+-            proj(j,k) = a(j,k)
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       ID proj.
+-c
+-        call idzp_id(eps,m,n,proj,krank,list,rnorms)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_aid1(eps,n2,n,kranki,proj,krank,list,rnorms)
+-c
+-c       IDs the uppermost kranki x n block of the n2 x n matrix
+-c       input as proj.
+-c
+-c       input:
+-c       eps -- precision of the decomposition to be constructed
+-c       n2 -- first dimension of proj as input
+-c       n -- second dimension of proj as input
+-c       kranki -- number of rows to extract from proj
+-c       proj -- matrix containing the kranki x n block to be ID'd
+-c
+-c       output:
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd
+-c       krank -- numerical rank of the ID
+-c       list -- indices of the columns in the ID
+-c
+-c       work:
+-c       rnorms -- must be at least n real*8 elements long
+-c
+-        implicit none
+-        integer n,n2,kranki,krank,list(n),j,k
+-        real*8 eps,rnorms(n)
+-        complex*16 proj(n2*n)
+-c
+-c
+-c       Move the uppermost kranki x n block of the n2 x n matrix proj
+-c       to the beginning of proj.
+-c
+-        do k = 1,n
+-          do j = 1,kranki
+-            proj(j+kranki*(k-1)) = proj(j+n2*(k-1))
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-c       ID proj.
+-c
+-        call idzp_id(eps,kranki,n,proj,krank,list,rnorms)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_estrank(eps,m,n,a,w,krank,ra)
+-c
+-c       estimates the numerical rank krank of an m x n matrix a
+-c       to precision eps. This routine applies n2 random vectors
+-c       to a, obtaining ra, where n2 is the greatest integer
+-c       less than or equal to m such that n2 is a positive integer
+-c       power of two. krank is typically about 8 higher than
+-c       the actual numerical rank.
+-c
+-c       input:
+-c       eps -- precision defining the numerical rank
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       a -- matrix whose rank is to be estimated
+-c       w -- initialization array that has been constructed
+-c            by routine idz_frmi
+-c
+-c       output:
+-c       krank -- estimate of the numerical rank of a;
+-c                this routine returns krank = 0 when the actual
+-c                numerical rank is nearly full (that is,
+-c                greater than n - 8 or n2 - 8)
+-c       ra -- product of an n2 x m random matrix and the m x n matrix
+-c             a, where n2 is the greatest integer less than or equal
+-c             to m such that n2 is a positive integer power of two;
+-c             ra doubles as a work array in the present routine, and so
+-c             must be at least n*n2+(n+1)*(n2+1) complex*16 elements
+-c             long
+-c
+-c       _N.B._: ra must be at least n*n2+(n2+1)*(n+1) complex*16
+-c               elements long for use in the present routine
+-c               (here, n2 is the greatest integer less than or equal
+-c               to m, such that n2 is a positive integer power of two).
+-c               This routine returns krank = 0 when the actual
+-c               numerical rank is nearly full.
+-c
+-        implicit none
+-        integer m,n,krank,n2,irat,lrat,iscal,lscal,ira,lra,lra2
+-        real*8 eps
+-        complex*16 a(m,n),ra(*),w(17*m+70)
+-c
+-c
+-c       Extract from the array w initialized by routine idz_frmi
+-c       the greatest integer less than or equal to m that is
+-c       a positive integer power of two.
+-c
+-        n2 = w(2)
+-c
+-c
+-c       Allocate memory in ra.
+-c
+-        lra = 0
+-c
+-        ira = lra+1
+-        lra2 = n2*n
+-        lra = lra+lra2
+-c
+-        irat = lra+1
+-        lrat = n*(n2+1)
+-        lra = lra+lrat
+-c
+-        iscal = lra+1
+-        lscal = n2+1
+-        lra = lra+lscal
+-c
+-        call idz_estrank0(eps,m,n,a,w,n2,krank,ra(ira),ra(irat),
+-     1                    ra(iscal))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_estrank0(eps,m,n,a,w,n2,krank,ra,rat,scal)
+-c
+-c       routine idz_estrank serves as a memory wrapper
+-c       for the present routine. (Please see routine idz_estrank
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,n2,krank,ifrescal,k,nulls,j
+-        real*8 eps,scal(n2+1),ss,ssmax
+-        complex*16 a(m,n),ra(n2,n),residual,w(17*m+70),rat(n,n2+1)
+-c
+-c
+-c       Apply the random matrix to every column of a, obtaining ra.
+-c
+-        do k = 1,n
+-          call idz_frm(m,n2,w,a(1,k),ra(1,k))
+-        enddo ! k
+-c
+-c
+-c       Compute the sum of squares of the entries in each column of ra
+-c       and the maximum of all such sums.
+-c
+-        ssmax = 0
+-c
+-        do k = 1,n
+-c
+-          ss = 0
+-          do j = 1,m
+-            ss = ss+a(j,k)*conjg(a(j,k))
+-          enddo ! j
+-c
+-          if(ss .gt. ssmax) ssmax = ss
+-c
+-        enddo ! k
+-c
+-c
+-c       Transpose ra to obtain rat.
+-c
+-        call idz_transposer(n2,n,ra,rat)
+-c
+-c
+-        krank = 0
+-        nulls = 0
+-c
+-c
+-c       Loop until nulls = 7, krank+nulls = n2, or krank+nulls = n.
+-c
+- 1000   continue
+-c
+-c
+-          if(krank .gt. 0) then
+-c
+-c           Apply the previous Householder transformations
+-c           to rat(:,krank+1).
+-c
+-            ifrescal = 0
+-c
+-            do k = 1,krank
+-              call idz_houseapp(n-k+1,rat(1,k),rat(k,krank+1),
+-     1                          ifrescal,scal(k),rat(k,krank+1))
+-            enddo ! k
+-c
+-          endif ! krank .gt. 0
+-c
+-c
+-c         Compute the Householder vector associated
+-c         with rat(krank+1:*,krank+1).
+-c
+-          call idz_house(n-krank,rat(krank+1,krank+1),
+-     1                   residual,rat(1,krank+1),scal(krank+1))
+-c
+-c
+-          krank = krank+1
+-          if(abs(residual) .le. eps*sqrt(ssmax)) nulls = nulls+1
+-c
+-c
+-        if(nulls .lt. 7 .and. krank+nulls .lt. n2
+-     1   .and. krank+nulls .lt. n)
+-     2   goto 1000
+-c
+-c
+-        if(nulls .lt. 7) krank = 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_transposer(m,n,a,at)
+-c
+-c       transposes a to obtain at.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of at
+-c       n -- second dimension of a, and first dimension of at
+-c       a -- matrix to be transposed
+-c
+-c       output:
+-c       at -- transpose of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        complex*16 a(m,n),at(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-c
+-            at(k,j) = a(j,k)
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzp_asvd.f b/scipy/linalg/src/id_dist/src/idzp_asvd.f
+deleted file mode 100644
+index 4704f5bbd..000000000
+--- a/scipy/linalg/src/id_dist/src/idzp_asvd.f
++++ /dev/null
+@@ -1,207 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_asvd computes the SVD, to a specified precision,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzp_asvd(lw,eps,m,n,a,winit,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^*  approximating a
+-c       to precision eps, where U is an m x krank matrix whose
+-c       columns are orthonormal, V is an n x krank matrix whose
+-c       columns are orthonormal, and Sigma is a diagonal krank x krank
+-c       matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       lw -- maximum usable length (in complex*16 elements)
+-c             of the array w
+-c       eps -- precision of the desired approximation
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be approximated; the present routine does not
+-c            alter a
+-c       winit -- initialization array that has been constructed
+-c                by routine idz_frmi
+-c
+-c       output:
+-c       krank -- rank of the SVD constructed
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            max( (krank+1)*(3*m+5*n+11)+8*krank**2, (2*n+1)*(n2+1) )
+-c            complex*16 elements long, where n2 is the greatest integer
+-c            less than or equal to m, such that n2 is
+-c            a positive integer power of two; krank is the rank output
+-c            by this routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when idz_id2svd bombs
+-c
+-c       _N.B._: w must be at least
+-c               max( (krank+1)*(3*m+5*n+11)+8*krank^2, (2*n+1)*(n2+1) )
+-c               complex*16 elements long, where n2 is
+-c               the greatest integer less than or equal to m,
+-c               such that n2 is a positive integer power of two;
+-c               krank is the rank output by this routine.
+-c               Also, the algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,k,ier,lw2,iu,iv,is,iui,ivi,isi,lu,lv,ls
+-        real*8 eps
+-        complex*16 a(m,n),winit(17*m+70),w(*)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw2 = 0
+-c
+-        ilist = lw2+1
+-        llist = n
+-        lw2 = lw2+llist
+-c
+-        iproj = lw2+1
+-c
+-c
+-c       ID a.
+-c
+-        call idzp_aid(eps,m,n,a,winit,krank,w(ilist),w(iproj))
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Allocate more memory in w.
+-c
+-          lproj = krank*(n-krank)
+-          lw2 = lw2+lproj
+-c
+-          icol = lw2+1
+-          lcol = m*krank
+-          lw2 = lw2+lcol
+-c
+-          iui = lw2+1
+-          lu = m*krank
+-          lw2 = lw2+lu
+-c
+-          ivi = lw2+1
+-          lv = n*krank
+-          lw2 = lw2+lv
+-c
+-          isi = lw2+1
+-          ls = krank
+-          lw2 = lw2+ls
+-c
+-          iwork = lw2+1
+-          lwork = (krank+1)*(m+3*n+10)+9*krank**2
+-          lw2 = lw2+lwork
+-c
+-c
+-          if(lw .lt. lw2) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-          call idzp_asvd0(m,n,a,krank,w(ilist),w(iproj),
+-     1                    w(iui),w(ivi),w(isi),ier,w(icol),w(iwork))
+-          if(ier .ne. 0) return
+-c
+-c
+-          iu = 1
+-          iv = iu+lu
+-          is = iv+lv
+-c
+-c
+-c         Copy the singular values and singular vectors
+-c         into their proper locations.
+-c
+-          do k = 1,lu
+-            w(iu+k-1) = w(iui+k-1)
+-          enddo ! k
+-c
+-          do k = 1,lv
+-            w(iv+k-1) = w(ivi+k-1)
+-          enddo ! k
+-c
+-          call idz_realcomplex(ls,w(isi),w(is))
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_asvd0(m,n,a,krank,list,proj,u,v,s,ier,
+-     1                        col,work)
+-c
+-c       routine idzp_asvd serves as a memory wrapper
+-c       for the present routine (please see routine idzp_asvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 s(krank)
+-        complex*16 a(m,n),u(m,krank),v(n,krank),
+-     1             proj(krank,n-krank),col(m,krank),
+-     2             work((krank+1)*(m+3*n+10)+9*krank**2)
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idz_copycols(m,n,a,krank,list,col)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idz_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_realcomplex(n,a,b)
+-c
+-c       copies the real*8 array a into the complex*16 array b.
+-c
+-c       input:
+-c       n -- length of a and b
+-c       a -- real*8 array to be copied into b
+-c
+-c       output:
+-c       b -- complex*16 copy of a
+-c
+-        integer n,k
+-        real*8 a(n)
+-        complex*16 b(n)
+-c
+-c
+-        do k = 1,n
+-          b(k) = a(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzp_rid.f b/scipy/linalg/src/id_dist/src/idzp_rid.f
+deleted file mode 100644
+index f12623aed..000000000
+--- a/scipy/linalg/src/id_dist/src/idzp_rid.f
++++ /dev/null
+@@ -1,379 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_rid computes the ID, to a specified precision,
+-c       of a matrix specified by a routine for applying its adjoint
+-c       to arbitrary vectors. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzp_rid(lproj,eps,m,n,matveca,p1,p2,p3,p4,
+-     1                      krank,list,proj,ier)
+-c
+-c       computes the ID of a, i.e., lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                        krank
+-c       a(j,list(k))  =  Sigma  a(j,list(l)) * proj(l,k-krank)       (*)
+-c                         l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon dimensioned epsilon(m,n-krank)
+-c       such that the greatest singular value of epsilon
+-c       <= the greatest singular value of a * eps.
+-c
+-c       input:
+-c       lproj -- maximum usable length (in complex*16 elements)
+-c                of the array proj
+-c       eps -- precision to which the ID is to be computed
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matveca -- routine which applies the adjoint
+-c                  of the matrix to be ID'd to an arbitrary vector;
+-c                  this routine must have a calling sequence
+-c                  of the form
+-c
+-c                  matveca(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of the matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matveca
+-c       p2 -- parameter to be passed to routine matveca
+-c       p3 -- parameter to be passed to routine matveca
+-c       p4 -- parameter to be passed to routine matveca
+-c
+-c       output:
+-c       krank -- numerical rank
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               the present routine uses proj as a work array, too, so
+-c               proj must be at least m+1 + 2*n*(krank+1) complex*16
+-c               elements long, where krank is the rank output
+-c               by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lproj is too small
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least m+1 + 2*n*(krank+1) complex*16
+-c               elements long, where krank is the rank output
+-c               by the present routine.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,list(n),krank,lw,iwork,lwork,ira,kranki,lproj,
+-     1          lra,ier,k
+-        real*8 eps
+-        complex*16 p1,p2,p3,p4,proj(*)
+-        external matveca
+-c
+-c
+-        ier = 0
+-c
+-c
+-c       Allocate memory in proj.
+-c
+-        lw = 0
+-c
+-        iwork = lw+1
+-        lwork = m+2*n+1
+-        lw = lw+lwork
+-c
+-        ira = lw+1
+-c
+-c
+-c       Find the rank of a.
+-c
+-        lra = lproj-lwork
+-        call idz_findrank(lra,eps,m,n,matveca,p1,p2,p3,p4,
+-     1                    kranki,proj(ira),ier,proj(iwork))
+-        if(ier .ne. 0) return
+-c
+-c
+-        if(lproj .lt. lwork+2*kranki*n) then
+-          ier = -1000
+-          return
+-        endif
+-c
+-c
+-c       Take the adjoint of ra.
+-c
+-        call idz_adjointer(n,kranki,proj(ira),proj(ira+kranki*n))
+-c
+-c
+-c       Move the adjoint thus obtained to the beginning of proj.
+-c
+-        do k = 1,kranki*n
+-          proj(k) = proj(ira+kranki*n+k-1)
+-        enddo ! k
+-c
+-c
+-c       ID the adjoint.
+-c
+-        call idzp_id(eps,kranki,n,proj,krank,list,proj(1+kranki*n))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_findrank(lra,eps,m,n,matveca,p1,p2,p3,p4,
+-     1                          krank,ra,ier,w)
+-c
+-c       estimates the numerical rank krank of a matrix a to precision
+-c       eps, where the routine matveca applies the adjoint of a
+-c       to an arbitrary vector. This routine applies the adjoint of a
+-c       to krank random vectors, and returns the resulting vectors
+-c       as the columns of ra.
+-c
+-c       input:
+-c       lra -- maximum usable length (in complex*16 elements)
+-c              of array ra
+-c       eps -- precision defining the numerical rank
+-c       m -- first dimension of a
+-c       n -- second dimension of a
+-c       matveca -- routine which applies the adjoint
+-c                  of the matrix whose rank is to be estimated
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matveca(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of the matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matveca
+-c       p2 -- parameter to be passed to routine matveca
+-c       p3 -- parameter to be passed to routine matveca
+-c       p4 -- parameter to be passed to routine matveca
+-c
+-c       output:
+-c       krank -- estimate of the numerical rank of a
+-c       ra -- product of the adjoint of a and a matrix whose entries
+-c             are pseudorandom realizations of i.i.d. random numbers,
+-c             uniformly distributed on [0,1];
+-c             ra must be at least 2*n*krank complex*16 elements long
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lra is too small
+-c
+-c       work:
+-c       w -- must be at least m+2*n+1 complex*16 elements long
+-c
+-c       _N.B._: ra must be at least 2*n*krank complex*16 elements long.
+-c               Also, the algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,lw,krank,ix,lx,iy,ly,iscal,lscal,lra,ier
+-        real*8 eps
+-        complex*16 p1,p2,p3,p4,ra(n,*),w(m+2*n+1)
+-        external matveca
+-c
+-c
+-        lw = 0
+-c
+-        ix = lw+1
+-        lx = m
+-        lw = lw+lx
+-c
+-        iy = lw+1
+-        ly = n
+-        lw = lw+ly
+-c
+-        iscal = lw+1
+-        lscal = n+1
+-        lw = lw+lscal
+-c
+-c
+-        call idz_findrank0(lra,eps,m,n,matveca,p1,p2,p3,p4,
+-     1                     krank,ra,ier,w(ix),w(iy),w(iscal))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_findrank0(lra,eps,m,n,matveca,p1,p2,p3,p4,
+-     1                           krank,ra,ier,x,y,scal)
+-c
+-c       routine idz_findrank serves as a memory wrapper
+-c       for the present routine. (Please see routine idz_findrank
+-c       for further documentation.)
+-c
+-        implicit none
+-        integer m,n,krank,ifrescal,k,lra,ier,m2
+-        real*8 eps,enorm
+-        complex*16 x(m),ra(n,2,*),p1,p2,p3,p4,scal(n+1),y(n),residual
+-        external matveca
+-c
+-c
+-        ier = 0
+-c
+-c
+-        krank = 0
+-c
+-c
+-c       Loop until the relative residual is greater than eps,
+-c       or krank = m or krank = n.
+-c
+- 1000   continue
+-c
+-c
+-          if(lra .lt. n*2*(krank+1)) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-c         Apply the adjoint of a to a random vector.
+-c
+-          m2 = m*2
+-          call id_srand(m2,x)
+-          call matveca(m,x,n,ra(1,1,krank+1),p1,p2,p3,p4)
+-c
+-          do k = 1,n
+-            y(k) = ra(k,1,krank+1)
+-          enddo ! k
+-c
+-c
+-          if(krank .eq. 0) then
+-c
+-c           Compute the Euclidean norm of y.
+-c
+-            enorm = 0
+-c
+-            do k = 1,n
+-              enorm = enorm + y(k)*conjg(y(k))
+-            enddo ! k
+-c
+-            enorm = sqrt(enorm)
+-c
+-          endif ! krank .eq. 0
+-c
+-c
+-          if(krank .gt. 0) then
+-c
+-c           Apply the previous Householder transformations to y.
+-c
+-            ifrescal = 0
+-c
+-            do k = 1,krank
+-              call idz_houseapp(n-k+1,ra(1,2,k),y(k),
+-     1                          ifrescal,scal(k),y(k))
+-            enddo ! k
+-c
+-          endif ! krank .gt. 0
+-c
+-c
+-c         Compute the Householder vector associated with y.
+-c
+-          call idz_house(n-krank,y(krank+1),
+-     1                   residual,ra(1,2,krank+1),scal(krank+1))
+-c
+-c
+-          krank = krank+1
+-c
+-c
+-        if(abs(residual) .gt. eps*enorm
+-     1   .and. krank .lt. m .and. krank .lt. n)
+-     2   goto 1000
+-c
+-c
+-c       Delete the Householder vectors from the array ra.
+-c
+-        call idz_crunch(n,krank,ra)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_crunch(n,l,a)
+-c
+-c       removes every other block of n entries from a vector.
+-c
+-c       input:
+-c       n -- length of each block to remove
+-c       l -- half of the total number of blocks
+-c       a -- original array
+-c
+-c       output:
+-c       a -- array with every other block of n entries removed
+-c
+-        implicit none
+-        integer j,k,n,l
+-        complex*16 a(n,2*l)
+-c
+-c
+-        do j = 2,l
+-          do k = 1,n
+-c
+-            a(k,j) = a(k,2*j-1)
+-c
+-          enddo ! k
+-        enddo ! j
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_adjointer(m,n,a,aa)
+-c
+-c       forms the adjoint aa of a.
+-c
+-c       input:
+-c       m -- first dimension of a, and second dimension of aa
+-c       n -- second dimension of a, and first dimension of aa
+-c       a -- matrix whose adjoint is to be taken
+-c
+-c       output:
+-c       aa -- adjoint of a
+-c
+-        implicit none
+-        integer m,n,j,k
+-        complex*16 a(m,n),aa(n,m)
+-c
+-c
+-        do k = 1,n
+-          do j = 1,m
+-c
+-            aa(k,j) = conjg(a(j,k))
+-c
+-          enddo ! j
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzp_rsvd.f b/scipy/linalg/src/id_dist/src/idzp_rsvd.f
+deleted file mode 100644
+index e34b3e374..000000000
+--- a/scipy/linalg/src/id_dist/src/idzp_rsvd.f
++++ /dev/null
+@@ -1,244 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzp_rsvd computes the SVD, to a specified precision,
+-c       of a matrix specified by routines for applying the matrix
+-c       and its adjoint to arbitrary vectors.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzp_rsvd(lw,eps,m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                       matvec,p1,p2,p3,p4,krank,iu,iv,is,w,ier)
+-c
+-c       constructs a rank-krank SVD  U Sigma V^*  approximating a
+-c       to precision eps, where matveca is a routine which applies a^*
+-c       to an arbitrary vector, and matvec is a routine
+-c       which applies a to an arbitrary vector; U is an m x krank
+-c       matrix whose columns are orthonormal, V is an n x krank
+-c       matrix whose columns are orthonormal, and Sigma is a diagonal
+-c       krank x krank matrix whose entries are all nonnegative.
+-c       The entries of U are stored in w, starting at w(iu);
+-c       the entries of V are stored in w, starting at w(iv).
+-c       The diagonal entries of Sigma are stored in w,
+-c       starting at w(is). This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       lw -- maximum usable length (in complex*16 elements)
+-c             of the array w
+-c       eps -- precision of the desired approximation
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matveca -- routine which applies the adjoint
+-c                  of the matrix to be SVD'd
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matveca(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of the matrix and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matveca
+-c       p2t -- parameter to be passed to routine matveca
+-c       p3t -- parameter to be passed to routine matveca
+-c       p4t -- parameter to be passed to routine matveca
+-c       matvec -- routine which applies the matrix to be SVD'd
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c
+-c       output:
+-c       krank -- rank of the SVD constructed
+-c       iu -- index in w of the first entry of the matrix
+-c             of orthonormal left singular vectors of a
+-c       iv -- index in w of the first entry of the matrix
+-c             of orthonormal right singular vectors of a
+-c       is -- index in w of the first entry of the array
+-c             of singular values of a; the singular values are stored
+-c             as complex*16 numbers whose imaginary parts are zeros
+-c       w -- array containing the singular values and singular vectors
+-c            of a; w doubles as a work array, and so must be at least
+-c            (krank+1)*(3*m+5*n+11)+8*krank^2 complex*16 elements long,
+-c            where krank is the rank returned by the present routine
+-c       ier -- 0 when the routine terminates successfully;
+-c              -1000 when lw is too small;
+-c              other nonzero values when idz_id2svd bombs
+-c
+-c       _N.B._: w must be at least (krank+1)*(3*m+5*n+11)+8*krank**2
+-c               complex*16 elements long, where krank is the rank
+-c               returned by the present routine. Also, the algorithm
+-c               used by the present routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,lw2,ilist,llist,iproj,icol,lcol,lp,
+-     1          iwork,lwork,ier,lproj,iu,iv,is,lu,lv,ls,iui,ivi,isi,k
+-        real*8 eps
+-        complex*16 p1t,p2t,p3t,p4t,p1,p2,p3,p4,w(*)
+-        external matveca,matvec
+-c
+-c
+-c       Allocate some memory.
+-c
+-        lw2 = 0
+-c
+-        ilist = lw2+1
+-        llist = n
+-        lw2 = lw2+llist
+-c
+-        iproj = lw2+1
+-c
+-c
+-c       ID a.
+-c
+-        lp = lw-lw2
+-        call idzp_rid(lp,eps,m,n,matveca,p1t,p2t,p3t,p4t,krank,
+-     1                w(ilist),w(iproj),ier)
+-        if(ier .ne. 0) return
+-c
+-c
+-        if(krank .gt. 0) then
+-c
+-c
+-c         Allocate more memory.
+-c
+-          lproj = krank*(n-krank)
+-          lw2 = lw2+lproj
+-c
+-          icol = lw2+1
+-          lcol = m*krank
+-          lw2 = lw2+lcol
+-c
+-          iui = lw2+1
+-          lu = m*krank
+-          lw2 = lw2+lu
+-c
+-          ivi = lw2+1
+-          lv = n*krank
+-          lw2 = lw2+lv
+-c
+-          isi = lw2+1
+-          ls = krank
+-          lw2 = lw2+ls
+-c
+-          iwork = lw2+1
+-          lwork = (krank+1)*(m+3*n+10)+9*krank**2
+-          lw2 = lw2+lwork
+-c
+-c
+-          if(lw .lt. lw2) then
+-            ier = -1000
+-            return
+-          endif
+-c
+-c
+-          call idzp_rsvd0(m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                    matvec,p1,p2,p3,p4,krank,w(iui),w(ivi),
+-     2                    w(isi),ier,w(ilist),w(iproj),w(icol),
+-     3                    w(iwork))
+-          if(ier .ne. 0) return
+-c
+-c
+-          iu = 1
+-          iv = iu+lu
+-          is = iv+lv
+-c
+-c
+-c         Copy the singular values and singular vectors
+-c         into their proper locations.
+-c
+-          do k = 1,lu
+-            w(iu+k-1) = w(iui+k-1)
+-          enddo ! k
+-c
+-          do k = 1,lv
+-            w(iv+k-1) = w(ivi+k-1)
+-          enddo ! k
+-c
+-          call idz_reco(ls,w(isi),w(is))
+-c
+-c
+-        endif ! krank .gt. 0
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzp_rsvd0(m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                        matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                        list,proj,col,work)
+-c
+-c       routine idzp_rsvd serves as a memory wrapper
+-c       for the present routine (please see routine idzp_rsvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 s(krank)
+-        complex*16 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1             proj(krank,n-krank),col(m*krank),
+-     2             work((krank+1)*(m+3*n+10)+9*krank**2)
+-        external matveca,matvec
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idz_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,col,work)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idz_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idz_reco(n,a,b)
+-c
+-c       copies the real*8 array a into the complex*16 array b.
+-c
+-c       input:
+-c       n -- length of a and b
+-c       a -- real*8 array to be copied into b
+-c
+-c       output:
+-c       b -- complex*16 copy of a
+-c
+-        integer n,k
+-        real*8 a(n)
+-        complex*16 b(n)
+-c
+-c
+-        do k = 1,n
+-          b(k) = a(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzr_aid.f b/scipy/linalg/src/id_dist/src/idzr_aid.f
+deleted file mode 100644
+index e8380ecd3..000000000
+--- a/scipy/linalg/src/id_dist/src/idzr_aid.f
++++ /dev/null
+@@ -1,209 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzr_aid computes the ID, to a specified rank,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c       routine idzr_aidi initializes routine idzr_aid.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzr_aid(m,n,a,krank,w,list,proj)
+-c
+-c       computes the ID of the matrix a, i.e., lists in list
+-c       the indices of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                       min(m,n,krank)
+-c       a(j,list(k))  =     Sigma      a(j,list(l)) * proj(l,k-krank)(*)
+-c                            l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be ID'd; the present routine does not alter a
+-c       krank -- rank of the ID to be constructed
+-c       w -- initialization array that routine idzr_aidi
+-c            has constructed
+-c
+-c       output:
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,krank,list(n),lw,ir,lr,lw2,iw
+-        complex*16 a(m,n),proj(krank*(n-krank)),
+-     1             w((2*krank+17)*n+21*m+80)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iw = lw+1
+-        lw2 = 21*m+80+n
+-        lw = lw+lw2
+-c
+-        ir = lw+1
+-        lr = (krank+8)*2*n
+-        lw = lw+lr
+-c
+-c
+-        call idzr_aid0(m,n,a,krank,w(iw),list,proj,w(ir))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_aid0(m,n,a,krank,w,list,proj,r)
+-c
+-c       routine idzr_aid serves as a memory wrapper
+-c       for the present routine
+-c       (see idzr_aid for further documentation).
+-c
+-        implicit none
+-        integer k,l,m,n2,n,krank,list(n),mn,lproj
+-        complex*16 a(m,n),r(krank+8,2*n),proj(krank,n-krank),
+-     1             w(21*m+80+n)
+-c
+-c       Please note that the second dimension of r is 2*n
+-c       (instead of n) so that if krank+8 >= m/2, then
+-c       we can copy the whole of a into r.
+-c
+-c
+-c       Retrieve the number of random test vectors
+-c       and the greatest integer less than m that is
+-c       a positive integer power of two.
+-c
+-        l = w(1)
+-        n2 = w(2)
+-c
+-c
+-        if(l .lt. n2 .and. l .le. m) then
+-c
+-c         Apply the random matrix.
+-c
+-          do k = 1,n
+-            call idz_sfrm(l,m,n2,w(11),a(1,k),r(1,k))
+-          enddo ! k
+-c
+-c         ID r.
+-c
+-          call idzr_id(l,n,r,krank,list,w(20*m+81))
+-c
+-c         Retrieve proj from r.
+-c
+-          lproj = krank*(n-krank)
+-          call idzr_copyzarr(lproj,r,proj)
+-c
+-        endif
+-c
+-c
+-        if(l .ge. n2 .or. l .gt. m) then
+-c
+-c         ID a directly.
+-c
+-          mn = m*n
+-          call idzr_copyzarr(mn,a,r)
+-          call idzr_id(m,n,r,krank,list,w(20*m+81))
+-c
+-c         Retrieve proj from r.
+-c
+-          lproj = krank*(n-krank)
+-          call idzr_copyzarr(lproj,r,proj)
+-c
+-        endif
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_copyzarr(n,a,b)
+-c
+-c       copies a into b.
+-c
+-c       input:
+-c       n -- length of a and b
+-c       a -- array to copy into b
+-c
+-c       output:
+-c       b -- copy of a
+-c
+-        implicit none
+-        integer n,k
+-        complex*16 a(n),b(n)
+-c
+-c
+-        do k = 1,n
+-          b(k) = a(k)
+-        enddo ! k
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_aidi(m,n,krank,w)
+-c
+-c       initializes the array w for using routine idzr_aid.
+-c
+-c       input:
+-c       m -- number of rows in the matrix to be ID'd
+-c       n -- number of columns in the matrix to be ID'd
+-c       krank -- rank of the ID to be constructed
+-c
+-c       output:
+-c       w -- initialization array for using routine idzr_aid
+-c
+-        implicit none
+-        integer m,n,krank,l,n2
+-        complex*16 w((2*krank+17)*n+21*m+80)
+-c
+-c
+-c       Set the number of random test vectors to 8 more than the rank.
+-c
+-        l = krank+8
+-        w(1) = l
+-c
+-c
+-c       Initialize the rest of the array w.
+-c
+-        n2 = 0
+-        if(l .le. m) call idz_sfrmi(l,m,n2,w(11))
+-        w(2) = n2
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzr_asvd.f b/scipy/linalg/src/id_dist/src/idzr_asvd.f
+deleted file mode 100644
+index 55ad61203..000000000
+--- a/scipy/linalg/src/id_dist/src/idzr_asvd.f
++++ /dev/null
+@@ -1,118 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzr_aid computes the SVD, to a specified rank,
+-c       of an arbitrary matrix. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzr_asvd(m,n,a,krank,w,u,v,s,ier)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^*  approximating a,
+-c       where u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       a -- matrix to be decomposed; the present routine does not
+-c            alter a
+-c       krank -- rank of the SVD being constructed
+-c       w -- initialization array that routine idzr_aidi
+-c            has constructed (for use in the present routine,
+-c            w must be at least
+-c            (2*krank+22)*m+(6*krank+21)*n+8*krank**2+10*krank+90
+-c            complex*16 elements long)
+-c
+-c       output:
+-c       u -- matrix of orthonormal left singular vectors of a
+-c       v -- matrix of orthonormal right singular vectors of a
+-c       s -- array of singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,iwinit,lwinit,ier
+-        real*8 s(krank)
+-        complex*16 a(m,n),u(m,krank),v(n,krank),
+-     1             w((2*krank+22)*m+(6*krank+21)*n+8*krank**2
+-     2              +10*krank+90)
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        iwinit = lw+1
+-        lwinit = (2*krank+17)*n+21*m+80
+-        lw = lw+lwinit
+-c
+-        ilist = lw+1
+-        llist = n
+-        lw = lw+llist
+-c
+-        iproj = lw+1
+-        lproj = krank*(n-krank)
+-        lw = lw+lproj
+-c
+-        icol = lw+1
+-        lcol = m*krank
+-        lw = lw+lcol
+-c
+-        iwork = lw+1
+-        lwork = (krank+1)*(m+3*n+10)+9*krank**2
+-        lw = lw+lwork
+-c
+-c
+-        call idzr_asvd0(m,n,a,krank,w(iwinit),u,v,s,ier,
+-     1                  w(ilist),w(iproj),w(icol),w(iwork))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_asvd0(m,n,a,krank,winit,u,v,s,ier,
+-     1                        list,proj,col,work)
+-c
+-c       routine idzr_asvd serves as a memory wrapper
+-c       for the present routine (please see routine idzr_asvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier
+-        real*8 s(krank)
+-        complex*16 a(m,n),u(m,krank),v(n,krank),
+-     1             proj(krank,n-krank),col(m*krank),
+-     2             winit((2*krank+17)*n+21*m+80),
+-     3             work((krank+1)*(m+3*n+10)+9*krank**2)
+-c
+-c
+-c       ID a.
+-c
+-        call idzr_aid(m,n,a,krank,winit,list,proj)
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idz_copycols(m,n,a,krank,list,col)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idz_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzr_rid.f b/scipy/linalg/src/id_dist/src/idzr_rid.f
+deleted file mode 100644
+index cf8fcaacf..000000000
+--- a/scipy/linalg/src/id_dist/src/idzr_rid.f
++++ /dev/null
+@@ -1,156 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzr_rid computes the ID, to a specified rank,
+-c       of a matrix specified by a routine for applying its adjoint
+-c       to arbitrary vectors. This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzr_rid(m,n,matveca,p1,p2,p3,p4,krank,list,proj)
+-c
+-c       computes the ID of a matrix "a" specified by
+-c       the routine matveca -- matveca must apply the adjoint
+-c       of the matrix being ID'd to an arbitrary vector --
+-c       i.e., the present routine lists in list the indices
+-c       of krank columns of a such that
+-c
+-c       a(j,list(k))  =  a(j,list(k))
+-c
+-c       for all j = 1, ..., m; k = 1, ..., krank, and
+-c
+-c                       min(m,n,krank)
+-c       a(j,list(k))  =     Sigma      a(j,list(l)) * proj(l,k-krank)(*)
+-c                            l=1
+-c
+-c                     +  epsilon(j,k-krank)
+-c
+-c       for all j = 1, ..., m; k = krank+1, ..., n,
+-c
+-c       for some matrix epsilon, dimensioned epsilon(m,n-krank),
+-c       whose norm is (hopefully) minimized by the pivoting procedure.
+-c
+-c       input:
+-c       m -- number of rows in the matrix to be ID'd
+-c       n -- number of columns in the matrix to be ID'd
+-c       matveca -- routine which applies the adjoint
+-c                  of the matrix to be ID'd to an arbitrary vector;
+-c                  this routine must have a calling sequence
+-c                  of the form
+-c
+-c                  matveca(m,x,n,y,p1,p2,p3,p4),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of the matrix and x,
+-c                  and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matveca
+-c       p2 -- parameter to be passed to routine matveca
+-c       p3 -- parameter to be passed to routine matveca
+-c       p4 -- parameter to be passed to routine matveca
+-c       krank -- rank of the ID to be constructed
+-c
+-c       output:
+-c       list -- indices of the columns in the ID
+-c       proj -- matrix of coefficients needed to interpolate
+-c               from the selected columns to the other columns
+-c               in the original matrix being ID'd;
+-c               proj doubles as a work array in the present routine, so
+-c               proj must be at least m+(krank+3)*n complex*16 elements
+-c               long
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c               proj must be at least m+(krank+3)*n complex*16 elements
+-c               long.
+-c
+-c       reference:
+-c       Halko, Martinsson, Tropp, "Finding structure with randomness:
+-c            probabilistic algorithms for constructing approximate
+-c            matrix decompositions," SIAM Review, 53 (2): 217-288,
+-c            2011.
+-c
+-        implicit none
+-        integer m,n,krank,list(n),lw,ix,lx,iy,ly,ir,lr
+-        complex*16 p1,p2,p3,p4,proj(m+(krank+3)*n)
+-        external matveca
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        ir = lw+1
+-        lr = (krank+2)*n
+-        lw = lw+lr
+-c
+-        ix = lw+1
+-        lx = m
+-        lw = lw+lx
+-c
+-        iy = lw+1
+-        ly = n
+-        lw = lw+ly
+-c
+-c
+-        call idzr_ridall0(m,n,matveca,p1,p2,p3,p4,krank,
+-     1                    list,proj(ir),proj(ix),proj(iy))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_ridall0(m,n,matveca,p1,p2,p3,p4,krank,
+-     1                          list,r,x,y)
+-c
+-c       routine idzr_ridall serves as a memory wrapper
+-c       for the present routine
+-c       (see idzr_ridall for further documentation).
+-c
+-        implicit none
+-        integer j,k,l,m,n,krank,list(n),m2
+-        complex*16 x(m),y(n),p1,p2,p3,p4,r(krank+2,n)
+-        external matveca
+-c
+-c
+-c       Set the number of random test vectors to 2 more than the rank.
+-c
+-        l = krank+2
+-c
+-c       Apply the adjoint of the original matrix to l random vectors.
+-c
+-        do j = 1,l
+-c
+-c         Generate a random vector.
+-c
+-          m2 = m*2
+-          call id_srand(m2,x)
+-c
+-c         Apply the adjoint of the matrix to x, obtaining y.
+-c
+-          call matveca(m,x,n,y,p1,p2,p3,p4)
+-c
+-c         Copy the conjugate of y into row j of r.
+-c
+-          do k = 1,n
+-            r(j,k) = conjg(y(k))
+-          enddo ! k
+-c
+-        enddo ! j
+-c
+-c
+-c       ID r.
+-c
+-        call idzr_id(l,n,r,krank,list,y)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/idzr_rsvd.f b/scipy/linalg/src/id_dist/src/idzr_rsvd.f
+deleted file mode 100644
+index d788e219b..000000000
+--- a/scipy/linalg/src/id_dist/src/idzr_rsvd.f
++++ /dev/null
+@@ -1,159 +0,0 @@
+-c       this file contains the following user-callable routines:
+-c
+-c
+-c       routine idzr_rsvd computes the SVD, to a specified rank,
+-c       of a matrix specified by routines for applying the matrix
+-c       and its adjoint to arbitrary vectors.
+-c       This routine is randomized.
+-c
+-c
+-ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+-c
+-c
+-c
+-c
+-        subroutine idzr_rsvd(m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                       matvec,p1,p2,p3,p4,krank,u,v,s,ier,w)
+-c
+-c       constructs a rank-krank SVD  u diag(s) v^*  approximating a,
+-c       where matveca is a routine which applies a^*
+-c       to an arbitrary vector, and matvec is a routine
+-c       which applies a to an arbitrary vector;
+-c       u is an m x krank matrix whose columns are orthonormal,
+-c       v is an n x krank matrix whose columns are orthonormal,
+-c       and diag(s) is a diagonal krank x krank matrix whose entries
+-c       are all nonnegative. This routine uses a randomized algorithm.
+-c
+-c       input:
+-c       m -- number of rows in a
+-c       n -- number of columns in a
+-c       matveca -- routine which applies the adjoint
+-c                  of the matrix to be SVD'd
+-c                  to an arbitrary vector; this routine must have
+-c                  a calling sequence of the form
+-c
+-c                  matveca(m,x,n,y,p1t,p2t,p3t,p4t),
+-c
+-c                  where m is the length of x,
+-c                  x is the vector to which the adjoint
+-c                  of the matrix is to be applied,
+-c                  n is the length of y,
+-c                  y is the product of the adjoint of the matrix and x,
+-c                  and p1t, p2t, p3t, and p4t are user-specified
+-c                  parameters
+-c       p1t -- parameter to be passed to routine matveca
+-c       p2t -- parameter to be passed to routine matveca
+-c       p3t -- parameter to be passed to routine matveca
+-c       p4t -- parameter to be passed to routine matveca
+-c       matvec -- routine which applies the matrix to be SVD'd
+-c                 to an arbitrary vector; this routine must have
+-c                 a calling sequence of the form
+-c
+-c                 matvec(n,x,m,y,p1,p2,p3,p4),
+-c
+-c                 where n is the length of x,
+-c                 x is the vector to which the matrix is to be applied,
+-c                 m is the length of y,
+-c                 y is the product of the matrix and x,
+-c                 and p1, p2, p3, and p4 are user-specified parameters
+-c       p1 -- parameter to be passed to routine matvec
+-c       p2 -- parameter to be passed to routine matvec
+-c       p3 -- parameter to be passed to routine matvec
+-c       p4 -- parameter to be passed to routine matvec
+-c       krank -- rank of the SVD being constructed
+-c
+-c       output:
+-c       u -- matrix of orthonormal left singular vectors of a
+-c       v -- matrix of orthonormal right singular vectors of a
+-c       s -- array of singular values of a
+-c       ier -- 0 when the routine terminates successfully;
+-c              nonzero otherwise
+-c
+-c       work:
+-c       w -- must be at least (krank+1)*(2*m+4*n+10)+8*krank**2
+-c            complex*16 elements long
+-c
+-c       _N.B._: The algorithm used by this routine is randomized.
+-c
+-        implicit none
+-        integer m,n,krank,lw,ilist,llist,iproj,lproj,icol,lcol,
+-     1          iwork,lwork,ier
+-        real*8 s(krank)
+-        complex*16 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1             w((krank+1)*(2*m+4*n+10)+8*krank**2)
+-        external matveca,matvec
+-c
+-c
+-c       Allocate memory in w.
+-c
+-        lw = 0
+-c
+-        ilist = lw+1
+-        llist = n
+-        lw = lw+llist
+-c
+-        iproj = lw+1
+-        lproj = krank*(n-krank)
+-        lw = lw+lproj
+-c
+-        icol = lw+1
+-        lcol = m*krank
+-        lw = lw+lcol
+-c
+-        iwork = lw+1
+-        lwork = (krank+1)*(m+3*n+10)+9*krank**2
+-        lw = lw+lwork
+-c
+-c
+-        call idzr_rsvd0(m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                  matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                  w(ilist),w(iproj),w(icol),w(iwork))
+-c
+-c
+-        return
+-        end
+-c
+-c
+-c
+-c
+-        subroutine idzr_rsvd0(m,n,matveca,p1t,p2t,p3t,p4t,
+-     1                        matvec,p1,p2,p3,p4,krank,u,v,s,ier,
+-     2                        list,proj,col,work)
+-c
+-c       routine idzr_rsvd serves as a memory wrapper
+-c       for the present routine (please see routine idzr_rsvd
+-c       for further documentation).
+-c
+-        implicit none
+-        integer m,n,krank,list(n),ier,k
+-        real*8 s(krank)
+-        complex*16 p1t,p2t,p3t,p4t,p1,p2,p3,p4,u(m,krank),v(n,krank),
+-     1             proj(krank*(n-krank)),col(m*krank),
+-     2             work((krank+1)*(m+3*n+10)+9*krank**2)
+-        external matveca,matvec
+-c
+-c
+-c       ID a.
+-c
+-        call idzr_rid(m,n,matveca,p1t,p2t,p3t,p4t,krank,list,work)
+-c
+-c
+-c       Retrieve proj from work.
+-c
+-        do k = 1,krank*(n-krank)
+-          proj(k) = work(k)
+-        enddo ! k
+-c
+-c
+-c       Collect together the columns of a indexed by list into col.
+-c
+-        call idz_getcols(m,n,matvec,p1,p2,p3,p4,krank,list,col,work)
+-c
+-c
+-c       Convert the ID to an SVD.
+-c
+-        call idz_id2svd(m,krank,col,n,list,proj,u,v,s,ier,work)
+-c
+-c
+-        return
+-        end
+diff --git a/scipy/linalg/src/id_dist/src/prini.f b/scipy/linalg/src/id_dist/src/prini.f
+deleted file mode 100644
+index 679590d84..000000000
+--- a/scipy/linalg/src/id_dist/src/prini.f
++++ /dev/null
+@@ -1,113 +0,0 @@
+-C
+-C
+-C
+-C
+-        SUBROUTINE PRINI(IP1,IQ1)
+-        save
+-        CHARACTER *1 MES(1), AA(1)
+-        REAL *4 A(1)
+-        REAL *8 A2(1)
+-        REAL *8 A4(1)
+-        INTEGER *4 IA(1)
+-        INTEGER *2 IA2(1)
+-        IP=IP1
+-        IQ=IQ1
+-
+-        RETURN
+-  
+-C
+-C
+-C
+-C
+-C
+-        ENTRY PRIN(MES,A,N)
+-        CALL  MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1200)(A(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1200)(A(J),J=1,N)
+- 1200 FORMAT(6(2X,E11.5))
+-         RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRIN2(MES,A2,N)
+-        CALL MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1400)(A2(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1400)(A2(J),J=1,N)
+- 1400 FORMAT(6(2X,E11.5))
+-        RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRIN2_long(MES,A2,N)
+-        CALL MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1450)(A2(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1450)(A2(J),J=1,N)
+- 1450 FORMAT(2(2X,E22.16))
+-        RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRINQ(MES,A4,N)
+-        CALL MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1500)(A4(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1500)(A4(J),J=1,N)
+- 1500 FORMAT(6(2X,e11.5))
+-        RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRINF(MES,IA,N)
+-        CALL MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1600)(IA(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1600)(IA(J),J=1,N)
+- 1600 FORMAT(10(1X,I7))
+-        RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRINF2(MES,IA2,N)
+-        CALL MESSPR(MES,IP,IQ)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,1600)(IA2(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,1600)(IA2(J),J=1,N)
+-        RETURN
+-C
+-C
+-C
+-C
+-        ENTRY PRINA(MES,AA,N)
+-        CALL MESSPR(MES,IP,IQ)
+- 2000 FORMAT(1X,80A1)
+-        IF(IP.NE.0 .AND. N.NE.0) WRITE(IP,2000)(AA(J),J=1,N)
+-        IF(IQ.NE.0 .AND. N.NE.0) WRITE(IQ,2000)(AA(J),J=1,N)
+-        RETURN
+-        END
+-c
+-c
+-c
+-c
+-c
+-        SUBROUTINE MESSPR(MES,IP,IQ)
+-        save
+-        CHARACTER *1 MES(1),AST
+-        DATA AST/'*'/
+-C
+-C         DETERMINE THE LENGTH OF THE MESSAGE
+-C
+-        I1=0
+-        DO 1400 I=1,10000
+-        IF(MES(I).EQ.AST) GOTO 1600
+-        I1=I
+- 1400 CONTINUE
+- 1600 CONTINUE
+-         IF ( (I1.NE.0) .AND. (IP.NE.0) )
+-     1     WRITE(IP,1800) (MES(I),I=1,I1)
+-         IF ( (I1.NE.0) .AND. (IQ.NE.0) )
+-     1     WRITE(IQ,1800) (MES(I),I=1,I1)
+- 1800 FORMAT(1X,80A1)
+-         RETURN
+-         END
+diff --git a/scipy/linalg/tests/test_interpolative.py b/scipy/linalg/tests/test_interpolative.py
+index ddc56f7c7..95b83dfad 100644
+--- a/scipy/linalg/tests/test_interpolative.py
++++ b/scipy/linalg/tests/test_interpolative.py
+@@ -1,4 +1,4 @@
+-#******************************************************************************
++#  ******************************************************************************
+ #   Copyright (C) 2013 Kenneth L. Ho
+ #   Redistribution and use in source and binary forms, with or without
+ #   modification, are permitted provided that the following conditions are met:
+@@ -24,7 +24,7 @@
+ #   CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ #   ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ #   POSSIBILITY OF SUCH DAMAGE.
+-#******************************************************************************
++#  ******************************************************************************
+ 
+ import scipy.linalg.interpolative as pymatrixid
+ import numpy as np
+@@ -36,8 +36,6 @@ from numpy.testing import (assert_, assert_allclose, assert_equal,
+                            assert_array_equal)
+ import pytest
+ from pytest import raises as assert_raises
+-import sys
+-_IS_32BIT = (sys.maxsize < 2**32)
+ 
+ 
+ @pytest.fixture()
+@@ -45,6 +43,12 @@ def eps():
+     yield 1e-12
+ 
+ 
++@pytest.fixture()
++def rng():
++    rng = np.random.default_rng(1718313768084012)
++    yield rng
++
++
+ @pytest.fixture(params=[np.float64, np.complex128])
+ def A(request):
+     # construct Hilbert matrix
+@@ -73,36 +77,32 @@ class TestInterpolativeDecomposition:
+     @pytest.mark.parametrize(
+         "rand,lin_op",
+         [(False, False), (True, False), (True, True)])
+-    def test_real_id_fixed_precision(self, A, L, eps, rand, lin_op):
+-        if _IS_32BIT and A.dtype == np.complex128 and rand:
+-            pytest.xfail("bug in external fortran code")
++    def test_real_id_fixed_precision(self, A, L, eps, rand, lin_op, rng):
+         # Test ID routines on a Hilbert matrix.
+         A_or_L = A if not lin_op else L
+ 
+-        k, idx, proj = pymatrixid.interp_decomp(A_or_L, eps, rand=rand)
++        k, idx, proj = pymatrixid.interp_decomp(A_or_L, eps, rand=rand, rng=rng)
+         B = pymatrixid.reconstruct_matrix_from_id(A[:, idx[:k]], idx, proj)
+         assert_allclose(A, B, rtol=eps, atol=1e-08)
+ 
+     @pytest.mark.parametrize(
+         "rand,lin_op",
+         [(False, False), (True, False), (True, True)])
+-    def test_real_id_fixed_rank(self, A, L, eps, rank, rand, lin_op):
+-        if _IS_32BIT and A.dtype == np.complex128 and rand:
+-            pytest.xfail("bug in external fortran code")
++    def test_real_id_fixed_rank(self, A, L, eps, rank, rand, lin_op, rng):
+         k = rank
+         A_or_L = A if not lin_op else L
+ 
+-        idx, proj = pymatrixid.interp_decomp(A_or_L, k, rand=rand)
++        idx, proj = pymatrixid.interp_decomp(A_or_L, k, rand=rand, rng=rng)
+         B = pymatrixid.reconstruct_matrix_from_id(A[:, idx[:k]], idx, proj)
+         assert_allclose(A, B, rtol=eps, atol=1e-08)
+ 
+     @pytest.mark.parametrize("rand,lin_op", [(False, False)])
+     def test_real_id_skel_and_interp_matrices(
+-            self, A, L, eps, rank, rand, lin_op):
++            self, A, L, eps, rank, rand, lin_op, rng):
+         k = rank
+         A_or_L = A if not lin_op else L
+ 
+-        idx, proj = pymatrixid.interp_decomp(A_or_L, k, rand=rand)
++        idx, proj = pymatrixid.interp_decomp(A_or_L, k, rand=rand, rng=rng)
+         P = pymatrixid.reconstruct_interp_matrix(idx, proj)
+         B = pymatrixid.reconstruct_skel_matrix(A, k, idx)
+         assert_allclose(B, A[:, idx[:k]], rtol=eps, atol=1e-08)
+@@ -111,25 +111,21 @@ class TestInterpolativeDecomposition:
+     @pytest.mark.parametrize(
+         "rand,lin_op",
+         [(False, False), (True, False), (True, True)])
+-    def test_svd_fixed_precison(self, A, L, eps, rand, lin_op):
+-        if _IS_32BIT and A.dtype == np.complex128 and rand:
+-            pytest.xfail("bug in external fortran code")
++    def test_svd_fixed_precision(self, A, L, eps, rand, lin_op, rng):
+         A_or_L = A if not lin_op else L
+ 
+-        U, S, V = pymatrixid.svd(A_or_L, eps, rand=rand)
++        U, S, V = pymatrixid.svd(A_or_L, eps, rand=rand, rng=rng)
+         B = U * S @ V.T.conj()
+         assert_allclose(A, B, rtol=eps, atol=1e-08)
+ 
+     @pytest.mark.parametrize(
+         "rand,lin_op",
+         [(False, False), (True, False), (True, True)])
+-    def test_svd_fixed_rank(self, A, L, eps, rank, rand, lin_op):
+-        if _IS_32BIT and A.dtype == np.complex128 and rand:
+-            pytest.xfail("bug in external fortran code")
++    def test_svd_fixed_rank(self, A, L, eps, rank, rand, lin_op, rng):
+         k = rank
+         A_or_L = A if not lin_op else L
+ 
+-        U, S, V = pymatrixid.svd(A_or_L, k, rand=rand)
++        U, S, V = pymatrixid.svd(A_or_L, k, rand=rand, rng=rng)
+         B = U * S @ V.T.conj()
+         assert_allclose(A, B, rtol=eps, atol=1e-08)
+ 
+@@ -141,59 +137,39 @@ class TestInterpolativeDecomposition:
+         B = U * S @ V.T.conj()
+         assert_allclose(A, B, rtol=eps, atol=1e-08)
+ 
+-    def test_estimate_spectral_norm(self, A):
++    def test_estimate_spectral_norm(self, A, rng):
+         s = svdvals(A)
+-        norm_2_est = pymatrixid.estimate_spectral_norm(A)
++        norm_2_est = pymatrixid.estimate_spectral_norm(A, rng=rng)
+         assert_allclose(norm_2_est, s[0], rtol=1e-6, atol=1e-8)
+ 
+-    def test_estimate_spectral_norm_diff(self, A):
++    def test_estimate_spectral_norm_diff(self, A, rng):
+         B = A.copy()
+         B[:, 0] *= 1.2
+         s = svdvals(A - B)
+-        norm_2_est = pymatrixid.estimate_spectral_norm_diff(A, B)
++        norm_2_est = pymatrixid.estimate_spectral_norm_diff(A, B, rng=rng)
+         assert_allclose(norm_2_est, s[0], rtol=1e-6, atol=1e-8)
+ 
+-    def test_rank_estimates_array(self, A):
++    def test_rank_estimates_array(self, A, rng):
+         B = np.array([[1, 1, 0], [0, 0, 1], [0, 0, 1]], dtype=A.dtype)
+ 
+         for M in [A, B]:
+             rank_tol = 1e-9
+             rank_np = np.linalg.matrix_rank(M, norm(M, 2) * rank_tol)
+-            rank_est = pymatrixid.estimate_rank(M, rank_tol)
++            rank_est = pymatrixid.estimate_rank(M, rank_tol, rng=rng)
+             assert_(rank_est >= rank_np)
+             assert_(rank_est <= rank_np + 10)
+ 
+-    def test_rank_estimates_lin_op(self, A):
++    def test_rank_estimates_lin_op(self, A, rng):
+         B = np.array([[1, 1, 0], [0, 0, 1], [0, 0, 1]], dtype=A.dtype)
+ 
+         for M in [A, B]:
+             ML = aslinearoperator(M)
+             rank_tol = 1e-9
+             rank_np = np.linalg.matrix_rank(M, norm(M, 2) * rank_tol)
+-            rank_est = pymatrixid.estimate_rank(ML, rank_tol)
++            rank_est = pymatrixid.estimate_rank(ML, rank_tol, rng=rng)
+             assert_(rank_est >= rank_np - 4)
+             assert_(rank_est <= rank_np + 4)
+ 
+-    def test_rand(self):
+-        pymatrixid.seed('default')
+-        assert_allclose(pymatrixid.rand(2), [0.8932059, 0.64500803],
+-                        rtol=1e-4, atol=1e-8)
+-
+-        pymatrixid.seed(1234)
+-        x1 = pymatrixid.rand(2)
+-        assert_allclose(x1, [0.7513823, 0.06861718], rtol=1e-4, atol=1e-8)
+-
+-        np.random.seed(1234)
+-        pymatrixid.seed()
+-        x2 = pymatrixid.rand(2)
+-
+-        np.random.seed(1234)
+-        pymatrixid.seed(np.random.rand(55))
+-        x3 = pymatrixid.rand(2)
+-
+-        assert_allclose(x1, x2)
+-        assert_allclose(x1, x3)
+-
+     def test_badcall(self):
+         A = hilbert(5).astype(np.float32)
+         with assert_raises(ValueError):
+@@ -228,8 +204,6 @@ class TestInterpolativeDecomposition:
+     @pytest.mark.parametrize("rand", [True, False])
+     @pytest.mark.parametrize("eps", [1, 0.1])
+     def test_bug_9793(self, dtype, rand, eps):
+-        if _IS_32BIT and dtype == np.complex128 and rand:
+-            pytest.xfail("bug in external fortran code")
+         A = np.array([[-1, -1, -1, 0, 0, 0],
+                       [0, 0, 0, 1, 1, 1],
+                       [1, 0, 0, 1, 0, 0],
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0008-Mark-mvndst-functions-recursive.patch b/integration_tests/recipes/scipy/patches/0008-Mark-mvndst-functions-recursive.patch
new file mode 100644
index 00000000..705d648d
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0008-Mark-mvndst-functions-recursive.patch
@@ -0,0 +1,38 @@
+From c11745d763407d9a2bb195a21e2a8afaf7635248 Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Sat, 6 Jul 2024 22:38:55 +0200
+Subject: [PATCH 8/18] Mark mvndst functions recursive
+
+---
+ scipy/stats/mvndst.f | 8 ++++----
+ 1 file changed, 4 insertions(+), 4 deletions(-)
+
+diff --git a/scipy/stats/mvndst.f b/scipy/stats/mvndst.f
+index 41afa7e74..5065a15ff 100644
+--- a/scipy/stats/mvndst.f
++++ b/scipy/stats/mvndst.f
+@@ -21,8 +21,8 @@
+ *          Pullman, WA 99164-3113
+ *          Email : alangenz@wsu.edu
+ *
+-      SUBROUTINE mvnun(d, n, lower, upper, means, covar, maxpts, 
+-     &                   abseps, releps, value, inform)
++      RECURSIVE SUBROUTINE mvnun(d, n, lower, upper, means, covar, 
++     &                   maxpts, abseps, releps, value, inform)
+ *  Parameters
+ *
+ *   d       integer, dimensionality of the data
+@@ -88,8 +88,8 @@
+       END 
+ 
+ 
+-      SUBROUTINE mvnun_weighted(d, n, lower, upper, means, weights,
+-     &                          covar, maxpts, abseps, releps, 
++      recursive SUBROUTINE mvnun_weighted(d, n, lower, upper, means, 
++     &                          weights, covar, maxpts, abseps, releps,
+      &                           value, inform)
+ *  Parameters
+ *
+-- 
+2.34.1
+
diff --git a/integration_tests/recipes/scipy/patches/0009-Make-sreorth-recursive.patch b/integration_tests/recipes/scipy/patches/0009-Make-sreorth-recursive.patch
new file mode 100644
index 00000000..0ca5929f
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0009-Make-sreorth-recursive.patch
@@ -0,0 +1,111 @@
+From e4d1a570fa8bd4c710e10400822f60232e6408eb Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Sat, 6 Jul 2024 22:33:51 +0200
+Subject: [PATCH 9/18] Make sreorth recursive
+
+---
+ complex16/zreorth.F | 6 +++---
+ complex8/creorth.F  | 6 +++---
+ double/dreorth.F    | 6 +++---
+ single/sreorth.F    | 6 +++---
+ 4 files changed, 12 insertions(+), 12 deletions(-)
+
+diff --git a/scipy/sparse/linalg/_propack/PROPACK/complex16/zreorth.F b/scipy/sparse/linalg/_propack/PROPACK/complex16/zreorth.F
+index ca74f7a..c447a6a 100644
+--- a/scipy/sparse/linalg/_propack/PROPACK/complex16/zreorth.F
++++ b/scipy/sparse/linalg/_propack/PROPACK/complex16/zreorth.F
+@@ -2,8 +2,8 @@ c
+ c     Rasmus Munk Larsen, Stanford University, 1999, 2004.
+ c
+ 
+-      subroutine zreorth(n,k,V,ldv,vnew,normvnew,index,alpha,work,
+-     c     iflag)
++      recursive subroutine zreorth(n,k,V,ldv,vnew,normvnew,index,alpha,
++     c  work, iflag)
+ c
+ c     Orthogonalize the N-vector VNEW against a subset of the columns of
+ c     the N-by-K matrix V(1:N,1:K) using iterated classical or modified
+@@ -103,7 +103,7 @@ c
+ c****************************************************************************
+ c
+ 
+-      subroutine zcgs(n,k,V,ldv,vnew,index,work)
++      recursive subroutine zcgs(n,k,V,ldv,vnew,index,work)
+ 
+ c     Block  Gram-Schmidt orthogonalization:
+ c     FOR i= 1:l
+diff --git a/scipy/sparse/linalg/_propack/PROPACK/complex8/creorth.F b/scipy/sparse/linalg/_propack/PROPACK/complex8/creorth.F
+index cd87247..e657a89 100644
+--- a/scipy/sparse/linalg/_propack/PROPACK/complex8/creorth.F
++++ b/scipy/sparse/linalg/_propack/PROPACK/complex8/creorth.F
+@@ -2,8 +2,8 @@ c
+ c     Rasmus Munk Larsen, Stanford University, 1999, 2004.
+ c
+ 
+-      subroutine creorth(n,k,V,ldv,vnew,normvnew,index,alpha,work,
+-     c     iflag)
++      recursive subroutine creorth(n,k,V,ldv,vnew,normvnew,index,alpha,
++     c  work, iflag)
+ c
+ c     Orthogonalize the N-vector VNEW against a subset of the columns of
+ c     the N-by-K matrix V(1:N,1:K) using iterated classical or modified
+@@ -103,7 +103,7 @@ c
+ c****************************************************************************
+ c
+ 
+-      subroutine ccgs(n,k,V,ldv,vnew,index,work)
++      recursive subroutine ccgs(n,k,V,ldv,vnew,index,work)
+ 
+ c     Block  Gram-Schmidt orthogonalization:
+ c     FOR i= 1:l
+diff --git a/scipy/sparse/linalg/_propack/PROPACK/double/dreorth.F b/scipy/sparse/linalg/_propack/PROPACK/double/dreorth.F
+index 841208a..fec923e 100644
+--- a/scipy/sparse/linalg/_propack/PROPACK/double/dreorth.F
++++ b/scipy/sparse/linalg/_propack/PROPACK/double/dreorth.F
+@@ -2,8 +2,8 @@ c
+ c     Rasmus Munk Larsen, Stanford University, 1999, 2004.
+ c
+ 
+-      subroutine dreorth(n,k,V,ldv,vnew,normvnew,index,alpha,work,
+-     c     iflag)
++      recursive subroutine dreorth(n,k,V,ldv,vnew,normvnew,index,alpha,
++     c  work, iflag)
+ c
+ c     Orthogonalize the N-vector VNEW against a subset of the columns of
+ c     the N-by-K matrix V(1:N,1:K) using iterated classical or modified
+@@ -103,7 +103,7 @@ c
+ c****************************************************************************
+ c
+ 
+-      subroutine dcgs(n,k,V,ldv,vnew,index,work)
++      recursive subroutine dcgs(n,k,V,ldv,vnew,index,work)
+ 
+ c     Block  Gram-Schmidt orthogonalization:
+ c     FOR i= 1:l
+diff --git a/scipy/sparse/linalg/_propack/PROPACK/single/sreorth.F b/scipy/sparse/linalg/_propack/PROPACK/single/sreorth.F
+index 644d404..61b6698 100644
+--- a/scipy/sparse/linalg/_propack/PROPACK/single/sreorth.F
++++ b/scipy/sparse/linalg/_propack/PROPACK/single/sreorth.F
+@@ -2,8 +2,8 @@ c
+ c     Rasmus Munk Larsen, Stanford University, 1999, 2004.
+ c
+ 
+-      subroutine sreorth(n,k,V,ldv,vnew,normvnew,index,alpha,work,
+-     c     iflag)
++      recursive subroutine sreorth(n,k,V,ldv,vnew,normvnew,index,alpha,
++     c  work, iflag)
+ c
+ c     Orthogonalize the N-vector VNEW against a subset of the columns of
+ c     the N-by-K matrix V(1:N,1:K) using iterated classical or modified
+@@ -103,7 +103,7 @@ c
+ c****************************************************************************
+ c
+ 
+-      subroutine scgs(n,k,V,ldv,vnew,index,work)
++      recursive subroutine scgs(n,k,V,ldv,vnew,index,work)
+ 
+ c     Block  Gram-Schmidt orthogonalization:
+ c     FOR i= 1:l
+-- 
+2.34.1
+
diff --git a/integration_tests/recipes/scipy/patches/0010-Link-openblas-with-modules-that-require-f2c.patch b/integration_tests/recipes/scipy/patches/0010-Link-openblas-with-modules-that-require-f2c.patch
new file mode 100644
index 00000000..ad975ccd
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0010-Link-openblas-with-modules-that-require-f2c.patch
@@ -0,0 +1,76 @@
+From ccbb0fa0884d567c6139eeed7dc2dc9f8db4db3a Mon Sep 17 00:00:00 2001
+From: ryanking13 
+Date: Sun, 28 Jul 2024 18:15:17 +0900
+Subject: [PATCH 10/18] Link openblas with modules that require f2c
+
+Some fortran modules require symbols from f2c, which is provided by
+openblas.
+This patch adds openblas as a dependency to the modules that require f2c
+symbols.
+
+Co-Developed-by: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+---
+ scipy/integrate/meson.build | 2 +-
+ scipy/optimize/meson.build  | 6 +++---
+ scipy/stats/meson.build     | 2 +-
+ 3 files changed, 5 insertions(+), 5 deletions(-)
+
+diff --git a/scipy/integrate/meson.build b/scipy/integrate/meson.build
+index 23a715dd58..e5cd9ad4c8 100644
+--- a/scipy/integrate/meson.build
++++ b/scipy/integrate/meson.build
+@@ -154,7 +154,7 @@ py3.extension_module('_dop',
+   f2py_gen.process('dop.pyf'),
+   link_with: [dop_lib],
+   c_args: [Wno_unused_variable],
+-  dependencies: [fortranobject_dep],
++  dependencies: [lapack, fortranobject_dep],
+   link_args: version_link_args,
+   install: true,
+   link_language: 'fortran',
+diff --git a/scipy/optimize/meson.build b/scipy/optimize/meson.build
+index d6c20d3d53..d7f0284b5b 100644
+--- a/scipy/optimize/meson.build
++++ b/scipy/optimize/meson.build
+@@ -125,7 +125,7 @@ py3.extension_module('_cobyla',
+   c_args: [Wno_unused_variable],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+-  dependencies: [fortranobject_dep],
++  dependencies: [lapack, fortranobject_dep],
+   install: true,
+   link_language: 'fortran',
+   subdir: 'scipy/optimize'
+@@ -135,7 +135,7 @@ py3.extension_module('_minpack2',
+   [f2py_gen.process('minpack2/minpack2.pyf'), 'minpack2/dcsrch.f', 'minpack2/dcstep.f'],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+-  dependencies: [fortranobject_dep],
++  dependencies: [lapack, fortranobject_dep],
+   override_options: ['b_lto=false'],
+   install: true,
+   link_language: 'fortran',
+@@ -146,7 +146,7 @@ py3.extension_module('_slsqp',
+   [f2py_gen.process('slsqp/slsqp.pyf'), 'slsqp/slsqp_optmz.f'],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+-  dependencies: [fortranobject_dep],
++  dependencies: [lapack, fortranobject_dep],
+   install: true,
+   link_language: 'fortran',
+   subdir: 'scipy/optimize'
+diff --git a/scipy/stats/meson.build b/scipy/stats/meson.build
+index bb43e3b2e9..358279a93b 100644
+--- a/scipy/stats/meson.build
++++ b/scipy/stats/meson.build
+@@ -36,7 +36,7 @@ py3.extension_module('_mvn',
+   # Wno-surprising is to suppress a pointless warning with GCC 10-12
+   # (see GCC bug 98411: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98411)
+   fortran_args: [fortran_ignore_warnings, _fflag_Wno_surprising],
+-  dependencies: [fortranobject_dep],
++  dependencies: [lapack, fortranobject_dep],
+   link_args: version_link_args,
+   install: true,
+   link_language: 'fortran',
+-- 
+2.39.3 (Apple Git-146)
diff --git a/integration_tests/recipes/scipy/patches/0011-Remove-fpchec-inline-if-then-endif-constructs.patch b/integration_tests/recipes/scipy/patches/0011-Remove-fpchec-inline-if-then-endif-constructs.patch
new file mode 100644
index 00000000..78272f58
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0011-Remove-fpchec-inline-if-then-endif-constructs.patch
@@ -0,0 +1,94 @@
+From b43a231f8326d6953929030131c3fb6b2cb163bd Mon Sep 17 00:00:00 2001
+From: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+Date: Wed, 15 May 2024 21:29:02 +0530
+Subject: [PATCH 11/18] Remove fpchec inline if-then-endif constructs
+
+This PR removes the single-line if-then-endif constructs in fpchec.f
+that were causing syntactical errors when compiling with f2c, possibly
+because fpchec uses some dated, punch-card FORTRAN syntax. It converts
+them to statements split over multiple lines.
+
+This patch has been upstreamed via https://github.com/scipy/scipy/pull/21365
+and it can be safely removed once SciPy v1.15.0 is released and is being
+integrated in Pyodide.
+
+---
+ scipy/interpolate/fitpack/fpchec.f | 42 +++++++++++++++++++++++-------
+ 1 file changed, 32 insertions(+), 10 deletions(-)
+
+diff --git a/scipy/interpolate/fitpack/fpchec.f b/scipy/interpolate/fitpack/fpchec.f
+index 75a58c40ec..215f38f31f 100644
+--- a/scipy/interpolate/fitpack/fpchec.f
++++ b/scipy/interpolate/fitpack/fpchec.f
+@@ -29,36 +29,58 @@ c  ..
+       nk2 = nk1+1
+       ier = 10
+ c  check condition no 1
+-      if(nk1.lt.k1 .or. nk1.gt.m)then; ier=10; go to 80; endif
++      if (nk1.lt.k1 .or. nk1.gt.m) then
++          ier = 10
++          go to 80
++      endif
+ c  check condition no 2
+       j = n
+       do 20 i=1,k
+-        if(t(i).gt.t(i+1))then; ier=20; go to 80; endif
+-        if(t(j).lt.t(j-1))then; ier=20; go to 80; endif
++        if (t(i) .gt. t(i+1)) then
++            ier = 20
++            go to 80
++        endif
++        if (t(j) .lt. t(j-1)) then
++            ier = 20
++            go to 80
++        endif
+         j = j-1
+   20  continue
+ c  check condition no 3
+       do 30 i=k2,nk2
+-        if(t(i).le.t(i-1))then; ier=30; go to 80; endif
++        if (t(i) .le. t(i-1)) then
++            ier = 30
++            go to 80
++        endif
+   30  continue
+ c  check condition no 4
+-      if(x(1).lt.t(k1) .or. x(m).gt.t(nk2))then; ier=40; go to 80;
++      if (x(1).lt.t(k1) .or. x(m).gt.t(nk2)) then
++          ier = 40
++          go to 80
+       endif
+ c  check condition no 5
+-      if(x(1).ge.t(k2) .or. x(m).le.t(nk1))then; ier=50; go to 80;
++      if (x(1).ge.t(k2) .or. x(m).le.t(nk1)) then
++          ier = 50
++          go to 80
+       endif
+       i = 1
+       l = k2
+       nk3 = nk1-1
+-      if(nk3.lt.2) go to 70
++      if (nk3 .lt. 2) go to 70
+       do 60 j=2,nk3
+         tj = t(j)
+         l = l+1
+         tl = t(l)
+   40    i = i+1
+-        if(i.ge.m)then; ier=50; go to 80; endif
+-        if(x(i).le.tj) go to 40
+-        if(x(i).ge.tl)then; ier=50; go to 80; endif
++        if (i .ge. m) then
++            ier = 50
++            go to 80
++        endif
++        if (x(i) .le. tj) go to 40
++        if (x(i) .ge. tl) then
++            ier = 50
++            go to 80
++        endif
+   60  continue
+   70  ier = 0
+   80  return
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0012-Remove-chla_transtype.patch b/integration_tests/recipes/scipy/patches/0012-Remove-chla_transtype.patch
new file mode 100644
index 00000000..c4afc190
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0012-Remove-chla_transtype.patch
@@ -0,0 +1,27 @@
+From 848c94e218e89d866978fbc883cbb2d919f56ce9 Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Wed, 31 Jul 2024 10:29:47 +0200
+Subject: [PATCH 12/18] Remove chla_transtype
+
+The signature should probably be `int chla_transtype(char* res, int *trans)`.
+This just deletes it entirely due to laziness.
+
+---
+ scipy/linalg/cython_lapack_signatures.txt | 1 -
+ 1 file changed, 1 deletion(-)
+
+diff --git a/scipy/linalg/cython_lapack_signatures.txt b/scipy/linalg/cython_lapack_signatures.txt
+index 1f3dc226ab..28aa8b8c22 100644
+--- a/scipy/linalg/cython_lapack_signatures.txt
++++ b/scipy/linalg/cython_lapack_signatures.txt
+@@ -108,7 +108,6 @@ void chetrs(char *uplo, int *n, int *nrhs, c *a, int *lda, int *ipiv, c *b, int
+ void chetrs2(char *uplo, int *n, int *nrhs, c *a, int *lda, int *ipiv, c *b, int *ldb, c *work, int *info)
+ void chfrk(char *transr, char *uplo, char *trans, int *n, int *k, s *alpha, c *a, int *lda, s *beta, c *c)
+ void chgeqz(char *job, char *compq, char *compz, int *n, int *ilo, int *ihi, c *h, int *ldh, c *t, int *ldt, c *alpha, c *beta, c *q, int *ldq, c *z, int *ldz, c *work, int *lwork, s *rwork, int *info)
+-char chla_transtype(int *trans)
+ void chpcon(char *uplo, int *n, c *ap, int *ipiv, s *anorm, s *rcond, c *work, int *info)
+ void chpev(char *jobz, char *uplo, int *n, c *ap, s *w, c *z, int *ldz, c *work, s *rwork, int *info)
+ void chpevd(char *jobz, char *uplo, int *n, c *ap, s *w, c *z, int *ldz, c *work, int *lwork, s *rwork, int *lrwork, int *iwork, int *liwork, int *info)
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0013-Set-wrapper-return-type-to-int.patch b/integration_tests/recipes/scipy/patches/0013-Set-wrapper-return-type-to-int.patch
new file mode 100644
index 00000000..c20be03f
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0013-Set-wrapper-return-type-to-int.patch
@@ -0,0 +1,25 @@
+From b5d05197de084ab3cab52241f163bae7519b6027 Mon Sep 17 00:00:00 2001
+From: Hood Chatham 
+Date: Wed, 31 Jul 2024 11:48:12 +0200
+Subject: [PATCH 13/18] Set wrapper return type to int
+
+---
+ scipy/linalg/_generate_pyx.py | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/scipy/linalg/_generate_pyx.py b/scipy/linalg/_generate_pyx.py
+index 8a00f5d279..aeb86e8926 100644
+--- a/scipy/linalg/_generate_pyx.py
++++ b/scipy/linalg/_generate_pyx.py
+@@ -520,7 +520,7 @@ def generate_decl_c(name, return_type, argnames, argtypes, accelerate):
+     if name in WRAPPED_FUNCS:
+         argnames = ['out'] + argnames
+         c_argtypes = [c_return_type] + c_argtypes
+-        c_return_type = 'void'
++        c_return_type = 'int'
+     blas_macro, blas_name = get_blas_macro_and_name(name, accelerate)
+     c_args = ', '.join(f'{t} *{n}' for t, n in zip(c_argtypes, argnames))
+     return f"{c_return_type} {blas_macro}({blas_name})({c_args});\n"
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0014-Skip-svd_gesdd-test.patch b/integration_tests/recipes/scipy/patches/0014-Skip-svd_gesdd-test.patch
new file mode 100644
index 00000000..b9e521f3
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0014-Skip-svd_gesdd-test.patch
@@ -0,0 +1,51 @@
+From 59d3efdf9e55958c6a3651e8eda2a9d6fe48e192 Mon Sep 17 00:00:00 2001
+From: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+Date: Fri, 9 Aug 2024 19:00:41 +0530
+Subject: [PATCH 14/18] Skip svd_gesdd test
+
+This patch excludes a test for gesdd which was introduced in this PR:
+https://github.com/scipy/scipy/pull/20349. It is not useful for Pyodide
+since it is a memory-intensive test and it is not expected to pass in
+a WASM environment where allocating memory for large arrays is tricky.
+
+This patch has been upstreamed in https://github.com/scipy/scipy/pull/21349
+and it can be safely removed once SciPy v1.15.0 is released and is being
+integrated in Pyodide.
+
+---
+ scipy/linalg/tests/test_decomp.py | 6 ++++++
+ 1 file changed, 6 insertions(+)
+
+diff --git a/scipy/linalg/tests/test_decomp.py b/scipy/linalg/tests/test_decomp.py
+index b43016c027..cbd80252b1 100644
+--- a/scipy/linalg/tests/test_decomp.py
++++ b/scipy/linalg/tests/test_decomp.py
+@@ -1,5 +1,6 @@
+ import itertools
+ import platform
++import sys
+ 
+ import numpy as np
+ from numpy.testing import (assert_equal, assert_almost_equal,
+@@ -37,6 +38,8 @@ try:
+ except ImportError:
+     CONFIG = None
+ 
++IS_WASM = (sys.platform == "emscripten" or platform.machine() in ["wasm32", "wasm64"])
++
+ 
+ def _random_hermitian_matrix(n, posdef=False, dtype=float):
+     "Generate random sym/hermitian array of the given size n"
+@@ -1179,6 +1182,9 @@ class TestSVD_GESVD(TestSVD_GESDD):
+     lapack_driver = 'gesvd'
+ 
+ 
++# Allocating an array of such a size leads to _ArrayMemoryError(s)
++# since the maximum memory that can be in 32-bit (WASM) is 4GB
++@pytest.mark.skipif(IS_WASM, reason="out of memory in WASM")
+ @pytest.mark.fail_slow(5)
+ def test_svd_gesdd_nofegfault():
+     # svd(a) with {U,VT}.size > INT_MAX does not segfault
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0015-Remove-f2py-generators.patch b/integration_tests/recipes/scipy/patches/0015-Remove-f2py-generators.patch
new file mode 100644
index 00000000..a80ca320
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0015-Remove-f2py-generators.patch
@@ -0,0 +1,304 @@
+From 9b670bd5330bd7834d157a9ec3087a97b71d6516 Mon Sep 17 00:00:00 2001
+From: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+Date: Fri, 16 Aug 2024 22:59:26 +0530
+Subject: [PATCH 15/18] Remove f2py generators
+MIME-Version: 1.0
+Content-Type: text/plain; charset=UTF-8
+Content-Transfer-Encoding: 8bit
+
+This patch reverts changes made in d85ba6b910ea9040b6a72bdc4ea87d151118f41d
+and is applied at the end, after the rest of the patches – the order is important.
+
+It removes the f2py generator and replaces it with custom targets mapping to
+f2py-generated wrappers. This is done to avoid the need for the f2py executable
+to be present in the environment where SciPy is built. Instead, the Python
+executable is used to run f2py as a module which is useful where f2py is not
+present on PATH.
+
+---
+ scipy/integrate/meson.build              | 32 +++++++++++++++++++++---
+ scipy/interpolate/meson.build            |  8 +++++-
+ scipy/io/meson.build                     |  8 +++++-
+ scipy/meson.build                        | 24 ------------------
+ scipy/optimize/meson.build               | 30 +++++++++++++++++++---
+ scipy/sparse/linalg/_propack/meson.build |  8 +++++-
+ scipy/stats/meson.build                  |  8 +++++-
+ tools/generate_f2pymod.py                |  3 ++-
+ 8 files changed, 85 insertions(+), 36 deletions(-)
+
+diff --git a/scipy/integrate/meson.build b/scipy/integrate/meson.build
+index cfaa927139..44c63fa526 100644
+--- a/scipy/integrate/meson.build
++++ b/scipy/integrate/meson.build
+@@ -128,8 +128,14 @@ py3.extension_module('_odepack',
+   subdir: 'scipy/integrate'
+ )
+ 
++vode_module = custom_target('vode_module',
++  output: ['_vode-f2pywrappers.f', '_vodemodule.c'],
++  input: 'vode.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_vode',
+-  f2py_gen.process('vode.pyf'),
++  vode_module,
+   link_with: [vode_lib],
+   c_args: [Wno_unused_variable],
+   link_args: version_link_args,
+@@ -139,8 +145,14 @@ py3.extension_module('_vode',
+   subdir: 'scipy/integrate'
+ )
+ 
++lsoda_module = custom_target('lsoda_module',
++  output: ['_lsoda-f2pywrappers.f', '_lsodamodule.c'],
++  input: 'lsoda.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_lsoda',
+-  f2py_gen.process('lsoda.pyf'),
++  lsoda_module,
+   link_with: [lsoda_lib, mach_lib],
+   c_args: [Wno_unused_variable],
+   dependencies: [lapack_dep, fortranobject_dep],
+@@ -150,8 +162,14 @@ py3.extension_module('_lsoda',
+   subdir: 'scipy/integrate'
+ )
+ 
++_dop_module = custom_target('_dop_module',
++  output: ['_dop-f2pywrappers.f', '_dopmodule.c'],
++  input: 'dop.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_dop',
+-  f2py_gen.process('dop.pyf'),
++  _dop_module,
+   link_with: [dop_lib],
+   c_args: [Wno_unused_variable],
+   dependencies: [lapack, fortranobject_dep],
+@@ -169,8 +187,14 @@ py3.extension_module('_test_multivariate',
+   install_tag: 'tests'
+ )
+ 
++_test_odeint_banded_module = custom_target('_test_odeint_banded_module',
++  output: ['_test_odeint_bandedmodule.c', '_test_odeint_banded-f2pywrappers.f'],
++  input: 'tests/test_odeint_banded.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_test_odeint_banded',
+-  ['tests/banded5x5.f', f2py_gen.process('tests/test_odeint_banded.pyf')],
++  ['tests/banded5x5.f', _test_odeint_banded_module],
+   link_with: [lsoda_lib, mach_lib],
+   fortran_args: _fflag_Wno_unused_dummy_argument,
+   link_args: version_link_args,
+diff --git a/scipy/interpolate/meson.build b/scipy/interpolate/meson.build
+index 69ec25f6af..38dd2a8cc3 100644
+--- a/scipy/interpolate/meson.build
++++ b/scipy/interpolate/meson.build
+@@ -143,9 +143,15 @@ py3.extension_module('_fitpack',
+   subdir: 'scipy/interpolate'
+ )
+ 
++dfitpack_module = custom_target('dfitpack_module',
++  output: ['_dfitpack-f2pywrappers.f', '_dfitpackmodule.c'],
++  input: 'src/dfitpack.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ # TODO: Add flags for 64 bit ints
+ py3.extension_module('_dfitpack',
+-  f2py_gen.process('src/dfitpack.pyf'),
++  dfitpack_module,
+   c_args: [Wno_unused_variable],
+   link_args: version_link_args,
+   dependencies: [lapack_dep, fortranobject_dep],
+diff --git a/scipy/io/meson.build b/scipy/io/meson.build
+index 60f71c6968..89a9cf69ba 100644
+--- a/scipy/io/meson.build
++++ b/scipy/io/meson.build
+@@ -1,6 +1,12 @@
++_test_fortran_module = custom_target('_test_fortran_module',
++  output: ['_test_fortranmodule.c'],
++  input: 'test_fortran.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_test_fortran',
+   [
+-    f2py_gen.process('test_fortran.pyf'),
++    _test_fortran_module,
+     '_test_fortran.f'
+   ],
+   c_args: [Wno_unused_variable],
+diff --git a/scipy/meson.build b/scipy/meson.build
+index a0857848a2..ff47bde52e 100644
+--- a/scipy/meson.build
++++ b/scipy/meson.build
+@@ -144,30 +144,6 @@ fortranobject_dep = declare_dependency(
+   compile_args: _f2py_c_args,
+ )
+ 
+-f2py = find_program('f2py')
+-# It should be quite rare for the `f2py` executable to not be the one from
+-# `numpy` installed in the Python env we are building for (unless we are
+-# cross-compiling). If it is from a different env, that is still fine as long
+-# as it's not too old. We are only using f2py as a code generator, and the
+-# output is not dependent on platform or Python version (see gh-20612 for more
+-# details).
+-# This should be robust enough. If not, we can make this more complex, using
+-# a fallback to `python -m f2py` rather than erroring out.
+-f2py_version = run_command([f2py, '-v'], check: true).stdout().strip()
+-if f2py_version.version_compare('<'+min_numpy_version)
+-  error(f'Found f2py executable is too old: @f2py_version@')
+-endif
+-
+-# Note: this generato cannot handle:
+-# 1. `.pyf.src` files, because `@BASENAME@` will still include .pyf
+-# 2. targets with #include's (due to no `depend_files` - see feature request
+-#    at meson#8295)
+-f2py_gen = generator(generate_f2pymod,
+-  arguments : ['@INPUT@', '-o', '@BUILD_DIR@'],
+-  output : ['_@BASENAME@module.c', '_@BASENAME@-f2pywrappers.f'],
+-)
+-
+-
+ # TODO: 64-bit BLAS and LAPACK
+ #
+ # Note that this works as long as BLAS and LAPACK are detected properly via
+diff --git a/scipy/optimize/meson.build b/scipy/optimize/meson.build
+index 50d62ef68b..6cef85027a 100644
+--- a/scipy/optimize/meson.build
++++ b/scipy/optimize/meson.build
+@@ -92,12 +92,18 @@ py3.extension_module('_zeros',
+   subdir: 'scipy/optimize'
+ )
+ 
++lbfgsb_module = custom_target('lbfgsb_module',
++  output: ['_lbfgsb-f2pywrappers.f', '_lbfgsbmodule.c'],
++  input: 'lbfgsb_src/lbfgsb.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_lbfgsb',
+   [
+     'lbfgsb_src/lbfgsb.f',
+     'lbfgsb_src/linpack.f',
+     'lbfgsb_src/timer.f',
+-    f2py_gen.process('lbfgsb_src/lbfgsb.pyf'),
++    lbfgsb_module,
+   ],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+@@ -120,6 +126,12 @@ py3.extension_module('_moduleTNC',
+   subdir: 'scipy/optimize'
+ )
+ 
++cobyla_module = custom_target('cobyla_module',
++  output: ['_cobylamodule.c'],
++  input: 'cobyla/cobyla.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_cobyla',
+-  [f2py_gen.process('cobyla/cobyla.pyf'), 'cobyla/cobyla2.f', 'cobyla/trstlp.f'],
++  [cobyla_module, 'cobyla/cobyla2.f', 'cobyla/trstlp.f'],
+   c_args: [Wno_unused_variable],
+@@ -131,8 +143,14 @@ py3.extension_module('_cobyla',
+   subdir: 'scipy/optimize'
+ )
+ 
++minpack2_module = custom_target('minpack2_module',
++  output: ['_minpack2module.c'],
++  input: 'minpack2/minpack2.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_minpack2',
+-  [f2py_gen.process('minpack2/minpack2.pyf'), 'minpack2/dcsrch.f', 'minpack2/dcstep.f'],
++  [minpack2_module, 'minpack2/dcsrch.f', 'minpack2/dcstep.f'],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+   dependencies: [lapack, fortranobject_dep],
+@@ -142,8 +160,14 @@ py3.extension_module('_minpack2',
+   subdir: 'scipy/optimize'
+ )
+ 
++slsqp_module = custom_target('slsqp_module',
++  output: ['_slsqpmodule.c'],
++  input: 'slsqp/slsqp.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_slsqp',
+-  [f2py_gen.process('slsqp/slsqp.pyf'), 'slsqp/slsqp_optmz.f'],
++  [slsqp_module, 'slsqp/slsqp_optmz.f'],
+   fortran_args: fortran_ignore_warnings,
+   link_args: version_link_args,
+   dependencies: [fortranobject_dep],
+diff --git a/scipy/sparse/linalg/_propack/meson.build b/scipy/sparse/linalg/_propack/meson.build
+index 6714724958..df358df651 100644
+--- a/scipy/sparse/linalg/_propack/meson.build
++++ b/scipy/sparse/linalg/_propack/meson.build
+@@ -97,8 +97,14 @@ foreach ele: elements
+     gnu_symbol_visibility: 'hidden',
+   )
+ 
++  propack_module = custom_target('propack_module' + ele[0],
++    output: [ele[0] + '-f2pywrappers.f', ele[0] + 'module.c'],
++    input: ele[2],
++    command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++  )
++
+   propacklib = py3.extension_module(ele[0],
+-    f2py_gen.process(ele[2]),
++    propack_module,
+     link_with: propack_lib,
+     c_args: ['-U_OPENMP', _cpp_Wno_cpp],
+     fortran_args: _fflag_Wno_maybe_uninitialized,
+diff --git a/scipy/stats/meson.build b/scipy/stats/meson.build
+index 358279a93b..7c973b1cf3 100644
+--- a/scipy/stats/meson.build
++++ b/scipy/stats/meson.build
+@@ -31,8 +31,14 @@ py3.extension_module('_ansari_swilk_statistics',
+   subdir: 'scipy/stats'
+ )
+ 
++mvn_module = custom_target('mvn_module',
++  output: ['_mvn-f2pywrappers.f', '_mvnmodule.c'],
++  input: 'mvn.pyf',
++  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
++)
++
+ py3.extension_module('_mvn',
+-  [f2py_gen.process('mvn.pyf'), 'mvndst.f'],
++  [mvn_module, 'mvndst.f'],
+   # Wno-surprising is to suppress a pointless warning with GCC 10-12
+   # (see GCC bug 98411: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=98411)
+   fortran_args: [fortran_ignore_warnings, _fflag_Wno_surprising],
+diff --git a/tools/generate_f2pymod.py b/tools/generate_f2pymod.py
+index b6bc02eb04..3da75c14d1 100644
+--- a/tools/generate_f2pymod.py
++++ b/tools/generate_f2pymod.py
+@@ -9,6 +9,7 @@ import argparse
+ import os
+ import re
+ import subprocess
++import sys
+ 
+ 
+ # START OF CODE VENDORED FROM `numpy.distutils.from_template`
+@@ -283,7 +284,7 @@ def main():
+ 
+     # Now invoke f2py to generate the C API module file
+     if args.infile.endswith(('.pyf.src', '.pyf')):
+-        p = subprocess.Popen(['f2py', fname_pyf,
++        p = subprocess.Popen([sys.executable, '-m', 'numpy.f2py', fname_pyf,
+                             '--build-dir', outdir_abs], #'--quiet'],
+                             stdout=subprocess.PIPE, stderr=subprocess.PIPE,
+                             cwd=os.getcwd())
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0016-Make-sf_error_state_lib-a-static-library.patch b/integration_tests/recipes/scipy/patches/0016-Make-sf_error_state_lib-a-static-library.patch
new file mode 100644
index 00000000..9f45ad86
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0016-Make-sf_error_state_lib-a-static-library.patch
@@ -0,0 +1,28 @@
+From 9d93ca19f4ad0ca327964b6234316547d774b17f Mon Sep 17 00:00:00 2001
+From: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+Date: Sat, 17 Aug 2024 01:12:28 +0530
+Subject: [PATCH 16/18] Make `sf_error_state_lib` a static library
+
+wasm.ld does not support linkage with shared libraries. This patch
+changes `sf_error_state_lib` to a static one.
+
+---
+ scipy/special/meson.build | 2 +-
+ 1 file changed, 1 insertion(+), 1 deletion(-)
+
+diff --git a/scipy/special/meson.build b/scipy/special/meson.build
+index 82b813ea85..24bee0a21c 100644
+--- a/scipy/special/meson.build
++++ b/scipy/special/meson.build
+@@ -33,7 +33,7 @@ else
+   scipy_import_dll_args = []
+ endif
+ 
+-sf_error_state_lib = shared_library('sf_error_state',
++sf_error_state_lib = static_library('sf_error_state',
+   ['sf_error_state.c'],
+   include_directories: ['../_lib', '../_build_utils/src'],
+   c_args: scipy_export_dll_args,
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0017-Remove-test-modules-that-fail-to-build.patch b/integration_tests/recipes/scipy/patches/0017-Remove-test-modules-that-fail-to-build.patch
new file mode 100644
index 00000000..56be63ec
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0017-Remove-test-modules-that-fail-to-build.patch
@@ -0,0 +1,74 @@
+From e21f33695da3275ec81b5f94685f0e4ac92c9ad5 Mon Sep 17 00:00:00 2001
+From: Gyeongjae Choi 
+Date: Mon, 30 Oct 2023 14:35:04 +0000
+Subject: [PATCH 17/18] Remove test modules that fail to build
+
+These are tests and they have both void vs int return value problems and implicit
+function argument cast problems. Not worth fixing for tests.
+
+---
+ scipy/integrate/meson.build | 18 ------------------
+ scipy/io/meson.build        | 21 ---------------------
+ 2 files changed, 39 deletions(-)
+
+diff --git a/scipy/integrate/meson.build b/scipy/integrate/meson.build
+index ae9e2466e1..e11626db0d 100644
+--- a/scipy/integrate/meson.build
++++ b/scipy/integrate/meson.build
+@@ -187,24 +187,6 @@ py3.extension_module('_test_multivariate',
+   install_tag: 'tests'
+ )
+ 
+-_test_odeint_banded_module = custom_target('_test_odeint_banded_module',
+-  output: ['_test_odeint_bandedmodule.c', '_test_odeint_banded-f2pywrappers.f'],
+-  input: 'tests/test_odeint_banded.pyf',
+-  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
+-)
+-
+-py3.extension_module('_test_odeint_banded',
+-  ['tests/banded5x5.f', _test_odeint_banded_module],
+-  link_with: [lsoda_lib, mach_lib],
+-  fortran_args: _fflag_Wno_unused_dummy_argument,
+-  link_args: version_link_args,
+-  dependencies: [lapack_dep, fortranobject_dep],
+-  install: true,
+-  link_language: 'fortran',
+-  subdir: 'scipy/integrate',
+-  install_tag: 'tests'
+-)
+-
+ subdir('_ivp')
+ subdir('tests')
+ 
+diff --git a/scipy/io/meson.build b/scipy/io/meson.build
+index d6fc6dc749..af04022208 100644
+--- a/scipy/io/meson.build
++++ b/scipy/io/meson.build
+@@ -1,24 +1,3 @@
+-_test_fortran_module = custom_target('_test_fortran_module',
+-  output: ['_test_fortranmodule.c'],
+-  input: 'test_fortran.pyf',
+-  command: [generate_f2pymod, '@INPUT@', '-o', '@OUTDIR@']
+-)
+-
+-py3.extension_module('_test_fortran',
+-  [
+-    _test_fortran_module,
+-    '_test_fortran.f'
+-  ],
+-  c_args: [Wno_unused_variable],
+-  fortran_args: fortran_ignore_warnings,
+-  link_args: version_link_args,
+-  dependencies: [lapack_dep, fortranobject_dep],
+-  install: true,
+-  link_language: 'fortran',
+-  subdir: 'scipy/io',
+-  install_tag: 'tests'
+-)
+-
+ py3.install_sources([
+     '__init__.py',
+     '_fortran.py',
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/patches/0018-Fix-lapack-larfg-function-signature.patch b/integration_tests/recipes/scipy/patches/0018-Fix-lapack-larfg-function-signature.patch
new file mode 100644
index 00000000..e2ffa67b
--- /dev/null
+++ b/integration_tests/recipes/scipy/patches/0018-Fix-lapack-larfg-function-signature.patch
@@ -0,0 +1,38 @@
+From 8b06e7fef50327f84140cb09a3d9237e18b38a35 Mon Sep 17 00:00:00 2001
+From: Agriya Khetarpal <74401230+agriyakhetarpal@users.noreply.github.com>
+Date: Thu, 5 Sep 2024 21:14:20 +0530
+Subject: [PATCH 18/18] Fix lapack larfg function signature
+
+This patch fixes the signature of the LAPACK routine larfg. Please
+see https://github.com/pyodide/pyodide/issues/3379 for more details.
+
+Co-authored-by: Ilhan Polat 
+Suggested-by: Hood Chatham 
+
+---
+ scipy/linalg/flapack_other.pyf.src | 5 ++---
+ 1 file changed, 2 insertions(+), 3 deletions(-)
+
+diff --git a/scipy/linalg/flapack_other.pyf.src b/scipy/linalg/flapack_other.pyf.src
+index 99d4886558..bf7256e605 100644
+--- a/scipy/linalg/flapack_other.pyf.src
++++ b/scipy/linalg/flapack_other.pyf.src
+@@ -2310,13 +2310,12 @@ function lange(norm,m,n,a,lda,work) result(n2)
+      dimension(m+1),intent(cache,hide) :: work
+ end function lange
+ 
+-subroutine larfg(n, alpha, x, incx, tau, lx)
++subroutine larfg(n, alpha, x, incx, tau)
+     integer intent(in), check(n>=1) :: n
+      intent(in,out) :: alpha
+-     intent(in,copy,out), dimension(lx) :: x
++     intent(in,copy,out), dimension(*), depend(n,incx), check(len(x) >= (n-2)*incx) :: x
+     integer intent(in), check(incx>0||incx<0) :: incx = 1
+      intent(out) :: tau
+-    integer intent(hide),depend(x,n,incx),check(lx > (n-2)*incx) :: lx = len(x)
+ end subroutine larfg
+ 
+ subroutine larf(side,m,n,v,incv,tau,c,ldc,work,lwork)
+-- 
+2.39.3 (Apple Git-146)
+
diff --git a/integration_tests/recipes/scipy/scipy-conftest.py b/integration_tests/recipes/scipy/scipy-conftest.py
new file mode 100644
index 00000000..e7adcc8b
--- /dev/null
+++ b/integration_tests/recipes/scipy/scipy-conftest.py
@@ -0,0 +1,283 @@
+import re
+
+import pytest
+
+xfail = pytest.mark.xfail
+skip = pytest.mark.skip
+
+fp_exception_msg = (
+    "no floating point exceptions, "
+    "see https://github.com/numpy/numpy/pull/21895#issuecomment-1311525881"
+)
+process_msg = "no process support"
+thread_msg = "no thread support"
+todo_signature_mismatch_msg = "TODO signature mismatch"
+todo_memory_corruption_msgt = "TODO memory corruption"
+todo_genuine_difference_msg = "TODO genuine difference to be investigated"
+todo_fp_exception_msg = "TODO did not raise maybe no floating point exception support?"
+
+
+tests_to_mark = [
+    # scipy/_lib/tests
+    (
+        "test__threadsafety.py::test_parallel_threads",
+        xfail,
+        thread_msg,
+    ),
+    ("test__threadsafety.py::test_parallel_threads", xfail, thread_msg),
+    ("test__util.py::test_pool", xfail, process_msg),
+    ("test__util.py::test_mapwrapper_parallel", xfail, process_msg),
+    ("test_ccallback.py::test_threadsafety", xfail, thread_msg),
+    ("test_import_cycles.py::test_modules_importable", xfail, process_msg),
+    ("test_import_cycles.py::test_public_modules_importable", xfail, process_msg),
+    # scipy/datasets/tests
+    ("test_data.py::TestDatasets", xfail, "TODO datasets not working right now"),
+    # scipy/fft/tests
+    (
+        r"test_basic.py::TestFFT1D.test_dtypes\[float32-numpy\]",
+        xfail,
+        "TODO small floating point difference on the CI but not locally",
+    ),
+    ("test_basic.py::TestFFTThreadSafe", xfail, thread_msg),
+    ("test_basic.py::test_multiprocess", xfail, process_msg),
+    ("test_fft_function.py::test_fft_function", xfail, process_msg),
+    ("test_multithreading.py::test_threaded_same", xfail, thread_msg),
+    (
+        "test_multithreading.py::test_mixed_threads_processes",
+        xfail,
+        thread_msg,
+    ),
+    # scipy/integrate tests
+    ("test__quad_vec.py::test_quad_vec_pool", xfail, process_msg),
+    (
+        "test_quadpack.py.+TestCtypesQuad.test_ctypes.*",
+        xfail,
+        "Test relying on finding libm.so shared library",
+    ),
+    (
+        "test_quadrature.py.+TestQMCQuad.test_basic",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_quadrature.py.+TestQMCQuad.test_sign",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    # scipy/interpolate
+    (
+        "test_fitpack.+test_kink",
+        xfail,
+        "TODO error not raised, maybe due to no floating point exception?",
+    ),
+    # scipy/io
+    (
+        "test_mmio.py::.+fast_matrix_market",
+        xfail,
+        thread_msg,
+    ),
+    (
+        "test_mmio.py::TestMMIOCoordinate.test_precision",
+        xfail,
+        thread_msg,
+    ),
+    (
+        "test_paths.py::TestPaths.test_mmio_(read|write)",
+        xfail,
+        thread_msg,
+    ),
+    # scipy/linalg tests
+    ("test_blas.+test_complex_dotu", skip, todo_signature_mismatch_msg),
+    ("test_cython_blas.+complex", skip, todo_signature_mismatch_msg),
+    ("test_lapack.py.+larfg_larf", skip, todo_signature_mismatch_msg),
+    # scipy/ndimage/tests
+    ("test_filters.py::TestThreading", xfail, thread_msg),
+    # scipy/optimize/tests
+    (
+        "test__differential_evolution.py::"
+        "TestDifferentialEvolutionSolver.test_immediate_updating",
+        xfail,
+        process_msg,
+    ),
+    (
+        "test__differential_evolution.py::TestDifferentialEvolutionSolver.test_parallel",
+        xfail,
+        process_msg,
+    ),
+    (
+        "test__shgo.py.+test_19_parallelization",
+        xfail,
+        process_msg,
+    ),
+    (
+        "test__shgo.py.+",
+        xfail,
+        "Test failing on 32bit (skipped on win32)",
+    ),
+    (
+        "test_linprog.py::TestLinprogSimplexNoPresolve.test_bounds_infeasible_2",
+        xfail,
+        "TODO no warnings emitted maybe due to no floating point exception?",
+    ),
+    ("test_minpack.py::TestFSolve.test_concurrent.+", xfail, process_msg),
+    ("test_minpack.py::TestLeastSq.test_concurrent+", xfail, process_msg),
+    ("test_optimize.py::test_cobyla_threadsafe", xfail, thread_msg),
+    ("test_optimize.py::TestBrute.test_workers", xfail, process_msg),
+    # scipy/signal/tests
+    (
+        "test_signaltools.py::TestMedFilt.test_medfilt2d_parallel",
+        xfail,
+        thread_msg,
+    ),
+    # scipy/sparse/tests
+    ("test_arpack.py::test_parallel_threads", xfail, thread_msg),
+    ("test_array_api.py::test_sparse_dense_divide", xfail, fp_exception_msg),
+    ("test_linsolve.py::TestSplu.test_threads_parallel", xfail, thread_msg),
+    ("test_propack", skip, todo_signature_mismatch_msg),
+    ("test_sparsetools.py::test_threads", xfail, thread_msg),
+    # scipy/sparse/csgraph/tests
+    ("test_shortest_path.py::test_gh_17782_segfault", xfail, thread_msg),
+    # scipy/sparse/linalg/tests
+    ("test_svds.py::Test_SVDS_PROPACK", skip, todo_signature_mismatch_msg),
+    # scipy/spatial/tests
+    (
+        "test_kdtree.py::test_query_ball_point_multithreading",
+        xfail,
+        thread_msg,
+    ),
+    ("test_kdtree.py::test_ckdtree_parallel", xfail, thread_msg),
+    # scipy/special/tests
+    (
+        "test_exponential_integrals.py::TestExp1.test_branch_cut",
+        xfail,
+        "TODO maybe float support since +0 and -0 difference",
+    ),
+    (
+        "test_round.py::test_add_round_(up|down)",
+        xfail,
+        "TODO small floating point difference, maybe due to lack of floating point "
+        "support for controlling rounding, see "
+        "https://github.com/WebAssembly/design/issues/1384",
+    ),
+    (
+        # This test is skipped for PyPy as well, maybe for a related reason?,
+        # see
+        # https://github.com/conda-forge/scipy-feedstock/pull/196#issuecomment-979317832
+        "test_distributions.py::TestBeta.test_boost_eval_issue_14606",
+        skip,
+        "TODO C++ exception that causes a Pyodide fatal error",
+    ),
+    # The following four tests do not raise the required
+    # 
+    (
+        "test_basic.py::test_error_raising",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_sf_error.py::test_errstate_pyx_basic",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_sf_error.py::test_errstate_cpp_scipy_special",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_sf_error.py::test_errstate_cpp_alt_ufunc_machinery",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_kdeoth.py::test_kde_[12]d",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateT.test_cdf_against_generic_integrators",
+        skip,
+        "TODO tplquad integration does not seem to converge",
+    ),
+    (
+        "test_multivariate.py::TestCovariance.test_mvn_with_covariance_cdf.+Precision-size1",
+        xfail,
+        "TODO small floating point difference 6e-7 relative diff instead of 1e-7",
+    ),
+    (
+        "test_multivariate.py::TestMultivariateNormal.test_logcdf_default_values",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateNormal.test_broadcasting",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateNormal.test_normal_1D",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateNormal.test_R_values",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateNormal.test_cdf_with_lower_limit",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    (
+        "test_multivariate.py::TestMultivariateT.test_cdf_against_multivariate_normal",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    ("test_qmc.py::TestVDC.test_van_der_corput", xfail, thread_msg),
+    ("test_qmc.py::TestHalton.test_workers", xfail, thread_msg),
+    ("test_qmc.py::TestUtils.test_discrepancy_parallel", xfail, thread_msg),
+    (
+        "test_qmc.py::TestMultivariateNormalQMC.test_validations",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_qmc.py::TestMultivariateNormalQMC.test_MultivariateNormalQMCDegenerate",
+        xfail,
+        todo_genuine_difference_msg,
+    ),
+    ("test_sampling.py::test_threading_behaviour", xfail, thread_msg),
+    ("test_stats.py::TestMGCStat.test_workers", xfail, process_msg),
+    (
+        "test_stats.py::TestKSTwoSamples.testLargeBoth",
+        skip,
+        "TODO test taking > 5 minutes after scipy 1.10.1 update",
+    ),
+    (
+        "test_stats.py::TestKSTwoSamples.test_some_code_paths",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_stats.py::TestGeometricStandardDeviation.test_raises_value_error",
+        xfail,
+        todo_fp_exception_msg,
+    ),
+    (
+        "test_stats.py::TestBrunnerMunzel.test_brunnermunzel_normal_dist",
+        xfail,
+        fp_exception_msg,
+    ),
+]
+
+
+def pytest_collection_modifyitems(config, items):
+    for item in items:
+        path, line, name = item.reportinfo()
+        path = str(path)
+        full_name = f"{path}::{name}"
+        for pattern, mark, reason in tests_to_mark:
+            if re.search(pattern, full_name):
+                # print(full_name)
+                item.add_marker(mark(reason=reason))
diff --git a/integration_tests/recipes/scipy/scipy-pytest.js b/integration_tests/recipes/scipy/scipy-pytest.js
new file mode 100644
index 00000000..6c3e54e5
--- /dev/null
+++ b/integration_tests/recipes/scipy/scipy-pytest.js
@@ -0,0 +1,84 @@
+const { opendir } = require("node:fs/promises");
+const { loadPyodide } = require("pyodide");
+
+async function main() {
+  let exit_code = 0;
+  try {
+    global.pyodide = await loadPyodide();
+    let pyodide = global.pyodide;
+    const FS = pyodide.FS;
+    const NODEFS = FS.filesystems.NODEFS;
+
+    let mountDir = "/mnt";
+    pyodide.FS.mkdir(mountDir);
+    pyodide.FS.mount(pyodide.FS.filesystems.NODEFS, { root: "." }, mountDir);
+
+    // Copy pytest-specific files dir if they exist
+    await pyodide.runPythonAsync(`
+       import shutil
+       import os
+
+       pytest_filenames = ["/mnt/conftest.py", "/mnt/pytest.ini"]
+
+       for filename in pytest_filenames:
+           if os.path.exists(filename):
+               shutil.copy(filename, ".")
+
+       conftest_filename = "/mnt/conftest.py"
+       if os.path.exists(conftest_filename):
+           shutil.copy(conftest_filename, ".")
+    `);
+
+    await pyodide.loadPackage(["micropip"]);
+    await pyodide.runPythonAsync(`
+       import micropip
+
+       await micropip.install('scipy')
+
+       try:
+           await micropip.install('scipy-tests')
+       except ValueError:
+           print('Hoping scipy tests are included in the scipy wheel')
+
+       pkg_list = micropip.list()
+       print(pkg_list)
+    `);
+
+    // XXX: some Fortran test modules are removed in Pyodide through a patch
+    // https://github.com/pyodide/pyodide/blob/main/packages/scipy/patches/0008-Remove-test-modules-that-fails-to-build.patch
+    // In order to avoid import errors during test discovery, we delete the
+    // problematic files. There seems to be no simpler way to do this with
+    // pytest, in particular --ignore-glob still imports the ignored file for
+    // some reason.
+    await pyodide.runPythonAsync(`
+      from pathlib import Path
+
+      import scipy.io.tests
+      path = Path(scipy.io.tests.__file__).parent / "test_fortran.py"
+      os.unlink(path)
+
+      import scipy.integrate.tests
+      path = Path(scipy.integrate.tests.__file__).parent / "test_odeint_jac.py"
+      os.unlink(path)
+    `);
+
+    await pyodide.runPythonAsync(
+      "import micropip; micropip.install(['pytest', 'hypothesis', 'pooch', 'lzma'])",
+    );
+    let pytest = pyodide.pyimport("pytest");
+    let args = process.argv.slice(2);
+    console.log("pytest args:", args);
+    exit_code = pytest.main(pyodide.toPy(args));
+  } catch (e) {
+    console.error(e);
+    // Arbitrary exit code here. I have seen this code reached instead of a
+    // Pyodide fatal error sometimes (I guess kind of similar to a random
+    // Python error). When there is a Pyodide fatal error we don't end up here
+    // somehow, and the exit code is 7
+    exit_code = 66;
+  } finally {
+    process.exit(exit_code);
+  }
+}
+
+main();
diff --git a/integration_tests/recipes/scipy/test_scipy.py b/integration_tests/recipes/scipy/test_scipy.py
new file mode 100644
index 00000000..ebd09bed
--- /dev/null
+++ b/integration_tests/recipes/scipy/test_scipy.py
@@ -0,0 +1,206 @@
+import pytest
+from pytest_pyodide import run_in_pyodide
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_scipy_linalg(selenium):
+    import numpy as np
+    import scipy.linalg
+    from numpy.testing import assert_allclose
+
+    N = 10
+    X = np.random.RandomState(42).rand(N, N)
+
+    X_inv = scipy.linalg.inv(X)
+
+    res = X.dot(X_inv)
+
+    assert_allclose(res, np.identity(N), rtol=1e-07, atol=1e-9)
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_brentq(selenium):
+    from scipy.optimize import brentq
+
+    brentq(lambda x: x, -1, 1)
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_dlamch(selenium):
+    from scipy.linalg import lapack
+
+    lapack.dlamch("Epsilon-Machine")
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_binom_ppf(selenium):
+    from scipy.stats import binom
+
+    assert binom.ppf(0.9, 1000, 0.1) == 112
+
+
+@pytest.mark.skip_pyproxy_check
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["pytest", "scipy-tests", "micropip"])
+async def test_scipy_pytest(selenium):
+    import pytest
+
+    import micropip
+
+    await micropip.install("hypothesis")
+
+    def runtest(module, filter):
+        result = pytest.main(
+            [
+                "--pyargs",
+                f"scipy.{module}",
+                "--continue-on-collection-errors",
+                "-vv",
+                "-k",
+                filter,
+            ]
+        )
+        assert result == 0
+
+    runtest("odr", "explicit")
+    runtest("stats.tests.test_multivariate", "haar")
+
+    # function signature mismatch with PROPACK, works with LOBPCG and ARPACK.
+    # Restore this when updating scipy
+    # runtest("sparse.linalg._eigen", "test_svds_parameter_k_which")
+    runtest(
+        "sparse.linalg._eigen.tests.test_svds",
+        "(not Test_SVDS_PROPACK) and test_svds_parameter_k_which",
+    )
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_cpp_exceptions(selenium):
+    import numpy as np
+    import pytest
+    from scipy.spatial.distance import cdist
+
+    out = np.ones((2, 2))
+    arr = np.array([[1, 2]])
+
+    with pytest.raises(ValueError, match="Output array has incorrect shape"):
+        cdist(arr, arr, out=out)
+    from scipy.sparse._sparsetools import test_throw_error
+
+    with pytest.raises(MemoryError):
+        test_throw_error()
+    from scipy.signal import lombscargle
+
+    with pytest.raises(ValueError):
+        lombscargle(x=[1], y=[1, 2], freqs=[1, 2, 3])
+
+
+# Regression test for LAPACK larfg signature mismatch
+# https://github.com/pyodide/pyodide/issues/3379
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy", "numpy"])
+def test_lapack_larfg(selenium):
+    import numpy as np
+    from scipy.linalg.lapack import get_lapack_funcs
+
+    a = np.arange(16).reshape(4, 4)
+    a = a.T.dot(a)
+
+    (larfg,) = get_lapack_funcs(["larfg"], dtype="float64")
+    alpha, x, tau = larfg(a.shape[0] - 1, a[1, 0], a[2:, 0])
+    return (alpha, x, tau) is not None
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_logm(selenium_standalone):
+    import numpy as np
+    from numpy import eye, random
+    from scipy.linalg import logm
+
+    random.seed(1234)
+    dtype = np.float64
+    n = 2
+    scale = 1e-4
+    A = (eye(n) + random.rand(n, n) * scale).astype(dtype)
+    logm(A)
+
+
+@pytest.mark.driver_timeout(40)
+@run_in_pyodide(packages=["scipy"])
+def test_dblquad(selenium):
+    import scipy.integrate
+
+    unit_square_area = scipy.integrate.dblquad(
+        lambda y, x: 1, 0, 1, lambda x: 0, lambda x: 1
+    )
+    assert (
+        abs(unit_square_area[0] - 1) < unit_square_area[1]
+    ), f"Unit square area calculated using scipy.integrate.dblquad of {unit_square_area[0]} (+- {unit_square_area[0]}) is too far from 1.0"
+
+
+import shutil
+import subprocess
+from contextlib import contextmanager
+from pathlib import Path
+from typing import TYPE_CHECKING, Any
+
+
+def check_emscripten():
+    if not shutil.which("emcc"):
+        pytest.skip("Needs Emscripten")
+
+
+@contextmanager
+def venv_ctxmgr(path):
+    check_emscripten()
+
+    if TYPE_CHECKING:
+        create_pyodide_venv: Any = None
+    else:
+        from pyodide_build.out_of_tree.venv import create_pyodide_venv
+
+    create_pyodide_venv(path)
+    try:
+        yield path
+    finally:
+        shutil.rmtree(path, ignore_errors=True)
+
+
+@pytest.fixture(scope="module")
+def venv(runtime):
+    if runtime != "node":
+        pytest.xfail("node only")
+    check_emscripten()
+    path = Path(".venv-pyodide-tmp-test")
+    with venv_ctxmgr(path) as venv:
+        yield venv
+
+
+def install_pkg(venv, pkgname):
+    return subprocess.run(
+        [
+            venv / "bin/pip",
+            "install",
+            pkgname,
+            "--disable-pip-version-check",
+        ],
+        capture_output=True,
+        encoding="utf8",
+    )
+
+
+def test_cmdline_runner(selenium, venv):
+    result = install_pkg(venv, "scipy")
+    assert result.returncode == 0
+    result = subprocess.run(
+        [venv / "bin/python", Path(__file__).parent / "cmdline_test_file.py"]
+    )
+    print(result.stdout)
+    print(result.stderr)
+    assert result.returncode == 0
diff --git a/pyodide_build/build_env.py b/pyodide_build/build_env.py
index cd2c89e7..e075f7ff 100644
--- a/pyodide_build/build_env.py
+++ b/pyodide_build/build_env.py
@@ -129,7 +129,6 @@ def get_build_environment_vars(pyodide_root: Path) -> dict[str, str]:
             "PYODIDE": "1",
             # This is the legacy environment variable used for the aforementioned purpose
             "PYODIDE_PACKAGE_ABI": "1",
-            "PYTHONPATH": env["HOSTSITEPACKAGES"],
         }
     )
 
@@ -169,24 +168,66 @@ def get_hostsitepackages() -> str:
 
 
 @functools.cache
-def get_unisolated_packages() -> list[str]:
+def get_unisolated_packages() -> dict[str, str]:
+    """
+    Get a map of unisolated packages.
+
+    Unisolated packages are packages that are used during the build process
+    and have some platform-specific files. When these packages are used
+    during the build process, we switch need to switch platform-specific files,
+    in order to build the package correctly.
+
+    Returns
+    -------
+    A dictionary of package names and versions.
+    """
+
     PYODIDE_ROOT = get_pyodide_root()
 
-    unisolated_file = PYODIDE_ROOT / "unisolated.txt"
-    if unisolated_file.exists():
-        # in xbuild env, read from file
-        unisolated_packages = unisolated_file.read_text().splitlines()
+    unisolated_packages = {}
+    if in_xbuildenv():
+        unisolated_packages_file = PYODIDE_ROOT / ".." / "requirements.txt"
+
+        for line in unisolated_packages_file.read_text().splitlines():
+            name, version = line.split("==")
+            unisolated_packages[name] = version
     else:
-        unisolated_packages = []
         recipe_dir = PYODIDE_ROOT / "packages"
         recipes = load_all_recipes(recipe_dir)
         for name, config in recipes.items():
             if config.build.cross_build_env:
-                unisolated_packages.append(name)
+                unisolated_packages[name] = config.package.version
 
     return unisolated_packages
 
 
+def get_unisolated_files(package_name: str) -> tuple[Path, list[str]]:
+    """
+    Get a list of unisolated files for a package.
+
+    Parameters
+    ----------
+    package_name
+        The name of the package
+
+    Returns
+    -------
+    A tuple of the package directory and a list of file paths relative to the package directory.
+    """
+    PYODIDE_ROOT = get_pyodide_root()
+
+    # TODO: unify libdir for in-tree and out-of-tree builds
+    if in_xbuildenv():
+        libdir = PYODIDE_ROOT / ".." / "site-packages-extras"
+    else:
+        libdir = Path(get_hostsitepackages())
+
+    package_dir = libdir / package_name
+    return libdir, [
+        str(f.relative_to(libdir)) for f in package_dir.rglob("*") if f.is_file()
+    ]
+
+
 def platform() -> str:
     emscripten_version = get_build_flag("PYODIDE_EMSCRIPTEN_VERSION")
     version = emscripten_version.replace(".", "_")
diff --git a/pyodide_build/buildpkg.py b/pyodide_build/buildpkg.py
index 22d227b1..5063f75d 100755
--- a/pyodide_build/buildpkg.py
+++ b/pyodide_build/buildpkg.py
@@ -460,17 +460,14 @@ def _package_wheel(
                 Path(self.build_args.host_install_dir)
                 / f"lib/{python_dir}/site-packages"
             )
-            if self.build_metadata.cross_build_env:
-                subprocess.run(
-                    ["pip", "install", "-t", str(host_site_packages), f"{name}=={ver}"],
-                    check=True,
-                )
 
+            # Copy cross build files to host site packages
             for cross_build_file in self.build_metadata.cross_build_files:
-                shutil.copy(
-                    (wheel_dir / cross_build_file),
-                    host_site_packages / cross_build_file,
-                )
+                src_file = wheel_dir / cross_build_file
+                dest_file = host_site_packages / cross_build_file
+                dest_file.parent.mkdir(parents=True, exist_ok=True)
+
+                shutil.copy(src_file, dest_file)
 
             try:
                 test_dir = self.src_dist_dir / "tests"
diff --git a/pyodide_build/pypabuild.py b/pyodide_build/pypabuild.py
index 5f7877bd..34776e26 100644
--- a/pyodide_build/pypabuild.py
+++ b/pyodide_build/pypabuild.py
@@ -6,7 +6,6 @@
 import traceback
 from collections.abc import Callable, Iterator, Mapping, Sequence
 from contextlib import contextmanager
-from itertools import chain
 from pathlib import Path
 from tempfile import TemporaryDirectory
 from typing import Literal, cast
@@ -18,8 +17,8 @@
 from pyodide_build import _f2c_fixes, common, pywasmcross
 from pyodide_build.build_env import (
     get_build_flag,
-    get_hostsitepackages,
     get_pyversion,
+    get_unisolated_files,
     get_unisolated_packages,
     platform,
 )
@@ -28,6 +27,7 @@
     _STYLES,
     _DefaultIsolatedEnv,
     _error,
+    _get_venv_paths,
     _handle_build_error,
     _ProjectBuilder,
 )
@@ -103,33 +103,114 @@ def symlink_unisolated_packages(env: DefaultIsolatedEnv) -> None:
 
     env_site_packages.mkdir(parents=True, exist_ok=True)
     shutil.copy(sysconfigdata_path, env_site_packages)
-    host_site_packages = Path(get_hostsitepackages())
-    for name in get_unisolated_packages():
-        for path in chain(
-            host_site_packages.glob(f"{name}*"), host_site_packages.glob(f"_{name}*")
-        ):
-            (env_site_packages / path.name).unlink(missing_ok=True)
-            (env_site_packages / path.name).symlink_to(path)
 
 
-def remove_avoided_requirements(
-    requires: set[str], avoided_requirements: set[str] | list[str]
+def _remove_avoided_requirements(
+    requires: set[str],
+    avoided_requirements: set[str] | list[str],
 ) -> set[str]:
+    """
+    Remove requirements that are in the list of avoided requirements.
+
+    Parameters
+    ----------
+    requires
+        The set of requirements to filter.
+    avoided_requirements
+        The set of requirements to avoid.
+
+    Returns
+    -------
+    The filtered set of requirements.
+    """
+    avoided_requirements = set(avoided_requirements)
     for reqstr in list(requires):
         req = Requirement(reqstr)
-        for avoid_name in set(avoided_requirements):
+        for avoid_name in avoided_requirements:
             if avoid_name in req.name.lower():
                 requires.remove(reqstr)
+                break
+
     return requires
 
 
+def _replace_unisolated_packages(
+    requires: set[str],
+    unisolated_packages: dict[str, str],
+) -> tuple[set[str], set[str]]:
+    """
+    Replace unisolated packages with the correct version.
+
+    Parameters
+    ----------
+    requires
+        The set of requirements to filter.
+    unisolated_packages
+        The dictionary of unisolated packages [name: version].
+
+    Returns
+    -------
+    tuple of (The filtered set of requirements, The set of unisolated requirements)
+    """
+    requires_new = requires.copy()
+    unisolated = set()
+    for reqstr in list(requires):
+        req = Requirement(reqstr)
+        for name, version in unisolated_packages.items():
+            if req.name == name:
+                # TODO: find a better way to handle this case
+                if not req.specifier.contains(version):
+                    print(
+                        f"WARNING: found build dependency {req} but the only supported cross-build version is {name}=={version}"
+                    )
+                    print(f"WARNING: using {name}=={version} instead")
+
+                requires_new.remove(reqstr)
+                requires_new.add(f"{name}=={version}")
+                unisolated.add(name)
+                break
+        else:
+            # oldest-supported-numpy is a meta package for numpy
+            # TODO: use dependency resolution instead of hardcoding this
+            if req.name == "oldest-supported-numpy" and "numpy" in unisolated_packages:
+                requires_new.remove(reqstr)
+                requires_new.add(f"numpy=={unisolated_packages['numpy']}")
+                unisolated.add("numpy")
+                break
+
+    return requires_new, unisolated
+
+
+def _install_cross_build_files(path: str, unisolated: set[str]) -> None:
+    """
+    Install the cross build files to the isolated environment.
+
+    Parameters
+    ----------
+    path
+        The path to the isolated environment.
+
+    unisolated
+        The set of unisolated packages.
+    """
+
+    sitepackagesdir = Path(_get_venv_paths(path)["purelib"])
+    for name in unisolated:
+        base, files = get_unisolated_files(name)
+        for cross_build_file in files:
+            shutil.copy(
+                base / cross_build_file,
+                sitepackagesdir / cross_build_file,
+            )
+
+
 def install_reqs(env: DefaultIsolatedEnv, reqs: set[str]) -> None:
-    env.install(
-        remove_avoided_requirements(
-            reqs,
-            get_unisolated_packages() + AVOIDED_REQUIREMENTS,
-        )
-    )
+    reqs = _remove_avoided_requirements(reqs, AVOIDED_REQUIREMENTS)
+    reqs, unisolated = _replace_unisolated_packages(reqs, get_unisolated_packages())
+
+    env.install(reqs)
+
+    _install_cross_build_files(env.path, unisolated)
 
 
 def _build_in_isolated_env(
diff --git a/pyodide_build/tests/conftest.py b/pyodide_build/tests/conftest.py
index 2a504831..176a08e1 100644
--- a/pyodide_build/tests/conftest.py
+++ b/pyodide_build/tests/conftest.py
@@ -97,7 +97,8 @@ def dummy_xbuildenv(dummy_xbuildenv_url, tmp_path, reset_env_vars, reset_cache):
 
     manager = CrossBuildEnvManager(tmp_path / xbuildenv_dirname())
     manager.install(
-        version=None, url=dummy_xbuildenv_url, skip_install_cross_build_packages=True
+        version=None,
+        url=dummy_xbuildenv_url,
     )
 
     cur_dir = os.getcwd()
diff --git a/pyodide_build/tests/test_build_env.py b/pyodide_build/tests/test_build_env.py
index 9a2a1f12..2ccd8894 100644
--- a/pyodide_build/tests/test_build_env.py
+++ b/pyodide_build/tests/test_build_env.py
@@ -66,7 +66,7 @@ def test_get_build_environment_vars(
         build_vars = build_env.get_build_environment_vars(manager.pyodide_root)
 
         # extra variables that does not come from config files.
-        extra_vars = set(["PYODIDE", "PYODIDE_PACKAGE_ABI", "PYTHONPATH"])
+        extra_vars = set(["PYODIDE", "PYODIDE_PACKAGE_ABI"])
 
         all_keys = set(BUILD_KEY_TO_VAR.values()) | extra_vars
         for var in build_vars:
@@ -124,6 +124,21 @@ def test_get_build_environment_vars_host_env(
         assert "HOME" not in e
         assert "RANDOM_ENV" not in e
 
+    def test_get_unisolated_packages(
+        self, dummy_xbuildenv, reset_env_vars, reset_cache
+    ):
+        expected = {"numpy", "scipy"}  # this relies on the dummy xbuildenv file
+        pkgs = build_env.get_unisolated_packages()
+        for pkg in expected:
+            assert pkg in pkgs
+
+    def test_get_unisolated_files(self, dummy_xbuildenv, reset_env_vars, reset_cache):
+        pkgs = build_env.get_unisolated_packages()
+
+        for pkg in pkgs:
+            files = build_env.get_unisolated_files(pkg)
+            assert files
+
 
 def test_check_emscripten_version(dummy_xbuildenv, monkeypatch):
     s = None
diff --git a/pyodide_build/tests/test_pypabuild.py b/pyodide_build/tests/test_pypabuild.py
index 7a0af3fa..7b53835f 100644
--- a/pyodide_build/tests/test_pypabuild.py
+++ b/pyodide_build/tests/test_pypabuild.py
@@ -12,7 +12,7 @@ def install(self, reqs):
 
 
 def test_remove_avoided_requirements():
-    assert pypabuild.remove_avoided_requirements(
+    assert pypabuild._remove_avoided_requirements(
         {"foo", "bar", "baz"},
         {"foo", "bar", "qux"},
     ) == {"baz"}
@@ -96,3 +96,50 @@ def test_get_build_env(tmp_path, dummy_xbuildenv):
         assert "ldflags" in wasmcross_args
         assert "exports" in wasmcross_args
         assert "builddir" in wasmcross_args
+
+
+def test_replace_unisolated_packages():
+    requires = {"foo", "bar<1.0", "baz==1.0", "qux"}
+    unisolated = {
+        "foo": "2.0",
+        "bar": "0.5",
+        "baz": "1.0",
+    }
+
+    new_requires, replaced = pypabuild._replace_unisolated_packages(
+        requires, unisolated
+    )
+    assert new_requires == {"foo==2.0", "bar==0.5", "baz==1.0", "qux"}
+    assert replaced == {"foo", "bar", "baz"}
+
+
+def test_replace_unisolated_packages_version_mismatch():
+    """
+    FIXME: This is not an ideal behavior, but for now wejust ignore the version mismatch.
+    """
+    requires = {"baz==1.0"}
+    unisolated = {
+        "baz": "1.1",
+    }
+
+    new_requires, replaced = pypabuild._replace_unisolated_packages(
+        requires, unisolated
+    )
+    assert new_requires == {"baz==1.1"}
+    assert replaced == {"baz"}
+
+
+def test_replace_unisoloated_packages_oldest_supported_numpy():
+    """
+    oldest-supported-numpy is a special case where we want to replace it with numpy instead.
+    """
+    requires = {"oldest-supported-numpy"}
+    unisolated = {
+        "numpy": "1.20",
+    }
+
+    new_requires, replaced = pypabuild._replace_unisolated_packages(
+        requires, unisolated
+    )
+    assert new_requires == {"numpy==1.20"}
+    assert replaced == {"numpy"}
diff --git a/pyodide_build/tests/test_xbuildenv.py b/pyodide_build/tests/test_xbuildenv.py
index 40933d6e..76c37426 100644
--- a/pyodide_build/tests/test_xbuildenv.py
+++ b/pyodide_build/tests/test_xbuildenv.py
@@ -205,33 +205,6 @@ def test_install_force(
         assert (tmp_path / version / ".installed").exists()
         assert manager.current_version == version
 
-    def test_install_cross_build_packages(
-        self, tmp_path, dummy_xbuildenv_url, monkeypatch_subprocess_run_pip
-    ):
-        pip_called_with = monkeypatch_subprocess_run_pip
-        manager = CrossBuildEnvManager(tmp_path)
-
-        download_path = tmp_path / "test"
-        manager._download(dummy_xbuildenv_url, download_path)
-
-        xbuildenv_root = download_path / "xbuildenv"
-        xbuildenv_pyodide_root = xbuildenv_root / "pyodide-root"
-        manager._install_cross_build_packages(xbuildenv_root, xbuildenv_pyodide_root)
-
-        assert len(pip_called_with) == 7
-        assert pip_called_with[0:4] == ["pip", "install", "--no-user", "-t"]
-        assert pip_called_with[4].startswith(
-            str(xbuildenv_pyodide_root)
-        )  # hostsitepackages
-        assert pip_called_with[5:7] == ["-r", str(xbuildenv_root / "requirements.txt")]
-
-        hostsitepackages = manager._host_site_packages_dir(xbuildenv_pyodide_root)
-        assert hostsitepackages.exists()
-
-        cross_build_files = xbuildenv_root / "site-packages-extras"
-        for file in cross_build_files.iterdir():
-            assert (hostsitepackages / file.name).exists()
-
     def test_create_package_index(self, tmp_path, dummy_xbuildenv_url):
         manager = CrossBuildEnvManager(tmp_path)
 
diff --git a/pyodide_build/vendor/_pypabuild.py b/pyodide_build/vendor/_pypabuild.py
index 1683e252..847c1542 100644
--- a/pyodide_build/vendor/_pypabuild.py
+++ b/pyodide_build/vendor/_pypabuild.py
@@ -24,6 +24,7 @@
 import os
 import subprocess
 import sys
+import sysconfig
 import traceback
 import warnings
 from collections.abc import Iterator
@@ -124,3 +125,47 @@ def _handle_build_error() -> Iterator[None]:
             tb = traceback.format_exc(-1)  # type: ignore[unreachable]
         _cprint("\n{dim}{}{reset}\n", tb.strip("\n"))
         _error(str(e))
+
+
+def _get_venv_paths(path: str) -> dict[str, str]:
+    """
+    Find the sysconfig paths for a virtual environment.
+
+    Copied from pypabuild (https://github.com/pypa/build/blob/562907e605c3becb135ac52b6eb2aa939e84bdda/src/build/env.py#L326)
+
+    Parameters
+    ----------
+    path
+        The root path of the virtual environment
+    """
+    config_vars = (
+        sysconfig.get_config_vars().copy()
+    )  # globally cached, copy before altering it
+    config_vars["base"] = path
+    scheme_names = sysconfig.get_scheme_names()
+    if "venv" in scheme_names:
+        # Python distributors with custom default installation scheme can set a
+        # scheme that can't be used to expand the paths in a venv.
+        # This can happen if build itself is not installed in a venv.
+        # The distributors are encouraged to set a "venv" scheme to be used for this.
+        # See https://bugs.python.org/issue45413
+        # and https://github.com/pypa/virtualenv/issues/2208
+        paths = sysconfig.get_paths(scheme="venv", vars=config_vars)
+    elif "posix_local" in scheme_names:
+        # The Python that ships on Debian/Ubuntu varies the default scheme to
+        # install to /usr/local
+        # But it does not (yet) set the "venv" scheme.
+        # If we're the Debian "posix_local" scheme is available, but "venv"
+        # is not, we use "posix_prefix" instead which is venv-compatible there.
+        paths = sysconfig.get_paths(scheme="posix_prefix", vars=config_vars)
+    elif "osx_framework_library" in scheme_names:
+        # The Python that ships with the macOS developer tools varies the
+        # default scheme depending on whether the ``sys.prefix`` is part of a framework.
+        # But it does not (yet) set the "venv" scheme.
+        # If the Apple-custom "osx_framework_library" scheme is available but "venv"
+        # is not, we use "posix_prefix" instead which is venv-compatible there.
+        paths = sysconfig.get_paths(scheme="posix_prefix", vars=config_vars)
+    else:
+        paths = sysconfig.get_paths(vars=config_vars)
+
+    return paths
diff --git a/pyodide_build/xbuildenv.py b/pyodide_build/xbuildenv.py
index 8ca01a6c..1ccd938a 100644
--- a/pyodide_build/xbuildenv.py
+++ b/pyodide_build/xbuildenv.py
@@ -1,6 +1,5 @@
 import json
 import shutil
-import subprocess
 import warnings
 from pathlib import Path
 from tempfile import NamedTemporaryFile
@@ -155,7 +154,7 @@ def install(
             as the current version of pyodide-build, make sure that the cross-build
             environment is compatible with the current version of Pyodide.
         skip_install_cross_build_packages
-            If True, skip installing the cross-build packages. This is mostly for testing purposes.
+            Deprecated, no longer used.
         force_install
             If True, force the installation even if the cross-build environment is not compatible
 
@@ -204,11 +203,6 @@ def install(
             if not install_marker.exists():
                 logger.info("Installing Pyodide cross-build environment")
 
-                if not skip_install_cross_build_packages:
-                    self._install_cross_build_packages(
-                        xbuildenv_root, xbuildenv_pyodide_root
-                    )
-
                 if not url:
                     # If installed from url, skip creating the PyPI index (version is not known)
                     self._create_package_index(xbuildenv_pyodide_root, version)
@@ -281,48 +275,6 @@ def _download(self, url: str, path: Path) -> None:
                 warnings.simplefilter("ignore")
                 shutil.unpack_archive(str(f_path), path)
 
-    def _install_cross_build_packages(
-        self, xbuildenv_root: Path, xbuildenv_pyodide_root: Path
-    ) -> None:
-        """
-        Install package that are used in the cross-build environment.
-
-        Parameters
-        ----------
-        xbuildenv_root
-            Path to the xbuildenv directory.
-        xbuildenv_pyodide_root
-            Path to the pyodide-root directory inside the xbuildenv directory.
-        """
-        host_site_packages = self._host_site_packages_dir(xbuildenv_pyodide_root)
-        host_site_packages.mkdir(exist_ok=True, parents=True)
-        result = subprocess.run(
-            [
-                "pip",
-                "install",
-                "--no-user",
-                "-t",
-                str(host_site_packages),
-                "-r",
-                str(xbuildenv_root / "requirements.txt"),
-            ],
-            capture_output=True,
-            encoding="utf8",
-        )
-
-        if result.returncode != 0:
-            raise RuntimeError(
-                f"Failed to install cross-build packages: {result.stderr}"
-            )
-
-        # Copy the site-packages-extras (coming from the cross-build-files meta.yaml
-        # key) over the site-packages directory with the newly installed packages.
-        shutil.copytree(
-            xbuildenv_root / "site-packages-extras",
-            host_site_packages,
-            dirs_exist_ok=True,
-        )
-
     def _host_site_packages_dir(
         self, xbuildenv_pyodide_root: Path | None = None
     ) -> Path: