#include <gsl/gsl_test.h>
#include <gsl/gsl_ieee_utils.h>
#include <gsl/gsl_math.h>
#include "gsl_cblas.h"

#include "tests.h"

void
test_her2 (void) {
const double flteps = 1e-4, dbleps = 1e-6;
  {
   int order = 101;
   int uplo = 121;
   int N = 1;
   int lda = 1;
   float alpha[2] = {-1.0f, 0.0f};
   float A[] = { -0.821f, 0.954f };
   float X[] = { 0.532f, 0.802f };
   int incX = -1;
   float Y[] = { 0.016f, -0.334f };
   int incY = -1;
   float A_expected[] = { -0.302288f, 0.0f };
   cblas_cher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cher2(case 1450) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cher2(case 1450) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int N = 1;
   int lda = 1;
   float alpha[2] = {-1.0f, 0.0f};
   float A[] = { -0.821f, 0.954f };
   float X[] = { 0.532f, 0.802f };
   int incX = -1;
   float Y[] = { 0.016f, -0.334f };
   int incY = -1;
   float A_expected[] = { -0.302288f, 0.0f };
   cblas_cher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cher2(case 1451) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cher2(case 1451) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int N = 1;
   int lda = 1;
   float alpha[2] = {-1.0f, 0.0f};
   float A[] = { -0.821f, 0.954f };
   float X[] = { 0.532f, 0.802f };
   int incX = -1;
   float Y[] = { 0.016f, -0.334f };
   int incY = -1;
   float A_expected[] = { -0.302288f, 0.0f };
   cblas_cher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cher2(case 1452) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cher2(case 1452) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int N = 1;
   int lda = 1;
   float alpha[2] = {-1.0f, 0.0f};
   float A[] = { -0.821f, 0.954f };
   float X[] = { 0.532f, 0.802f };
   int incX = -1;
   float Y[] = { 0.016f, -0.334f };
   int incY = -1;
   float A_expected[] = { -0.302288f, 0.0f };
   cblas_cher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cher2(case 1453) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cher2(case 1453) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 121;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-0.3, 0.1};
   double A[] = { -0.334, 0.286 };
   double X[] = { -0.14, -0.135 };
   int incX = -1;
   double Y[] = { 0.455, 0.358 };
   int incY = -1;
   double A_expected[] = { -0.264521, 0.0 };
   cblas_zher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zher2(case 1454) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zher2(case 1454) imag");
     };
   };
  };

  {
   int order = 101;
   int uplo = 122;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-0.3, 0.1};
   double A[] = { -0.334, 0.286 };
   double X[] = { -0.14, -0.135 };
   int incX = -1;
   double Y[] = { 0.455, 0.358 };
   int incY = -1;
   double A_expected[] = { -0.264521, 0.0 };
   cblas_zher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zher2(case 1455) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zher2(case 1455) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 121;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-0.3, 0.1};
   double A[] = { -0.334, 0.286 };
   double X[] = { -0.14, -0.135 };
   int incX = -1;
   double Y[] = { 0.455, 0.358 };
   int incY = -1;
   double A_expected[] = { -0.264521, 0.0 };
   cblas_zher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zher2(case 1456) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zher2(case 1456) imag");
     };
   };
  };

  {
   int order = 102;
   int uplo = 122;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-0.3, 0.1};
   double A[] = { -0.334, 0.286 };
   double X[] = { -0.14, -0.135 };
   int incX = -1;
   double Y[] = { 0.455, 0.358 };
   int incY = -1;
   double A_expected[] = { -0.264521, 0.0 };
   cblas_zher2(order, uplo, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zher2(case 1457) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zher2(case 1457) imag");
     };
   };
  };

}


#pragma once

#include <gsl-lite/gsl-lite.hpp>

#include <cuda/define_specifiers.hpp>
#include <cuda/runtime_api.hpp>

#include <thrustshift/math.h>

namespace thrustshift {

namespace device_function {

namespace explicit_unroll {

/*! \brief Fill range of length `N` with `x`.
 *
 *  \param N length of the range
 *  \param p pointer to the range
 *  \param x value
 *  \param tid ID of the thread which enters the function
 *  \param num_threads total amount of threads which enter the function
 */
template <typename T, int num_threads, int N>
CUDA_FD void fill(T* p, T x, int tid) {
	constexpr int num_elements_per_thread = N / num_threads;
#pragma unroll
	for (int i = 0; i < num_elements_per_thread; ++i) {
		p[i * num_threads + tid] = x;
	}
	constexpr int num_rest = N % num_threads;
	if (tid < num_rest) {
		p[num_elements_per_thread * num_threads + tid] = x;
	}
}

} // namespace explicit_unroll

namespace implicit_unroll {

template <typename T0, typename T1, typename I0, typename I1, typename I2>
CUDA_FD void fill(T0* p, T1 x, I0 tid, I1 num_threads, I2 N) {
	auto num_elements_per_thread = N / num_threads;
#pragma unroll
	for (int i = 0; i < num_elements_per_thread; ++i) {
		p[i * num_threads + tid] = x;
	}
	auto num_rest = N % num_threads;
	if (tid < num_rest) {
		p[num_elements_per_thread * num_threads + tid] = x;
	}
}

} // namespace implicit_unroll

} // namespace device_function

namespace kernel {
template <typename T, class Range>
__global__ void fill(Range r, T val) {

	const auto gtid = threadIdx.x + blockIdx.x * blockDim.x;
	if (gtid < r.size()) {
		r[gtid] = val;
	}
}

} // namespace kernel

namespace async {

template <typename T, class Range>
void fill(cuda::stream_t& stream, Range&& r, T val) {

	constexpr cuda::grid::block_dimension_t block_dim = 256;
	const cuda::grid::dimension_t grid_dim =
	    ceil_divide(r.size(), gsl_lite::narrow<decltype(r.size())>(block_dim));

	using RangeT = typename std::remove_reference<Range>::type::value_type;

	if (!r.empty()) {
		cuda::enqueue_launch(kernel::fill<T, gsl_lite::span<RangeT>>,
		                     stream,
		                     cuda::make_launch_config(grid_dim, block_dim),
		                     r,
		                     val);
	}
}

} // namespace async

} // namespace thrustshift


//**************************************************************************\
//* This file is property of and copyright by the ALICE Project            *\
//* ALICE Experiment at CERN, All rights reserved.                         *\
//*                                                                        *\
//* Primary Authors: Matthias Richter <Matthias.Richter@ift.uib.no>        *\
//*                  for The ALICE HLT Project.                            *\
//*                                                                        *\
//* Permission to use, copy, modify and distribute this software and its   *\
//* documentation strictly for non-commercial purposes is hereby granted   *\
//* without fee, provided that the above copyright notice appears in all   *\
//* copies and that both the copyright notice and this permission notice   *\
//* appear in the supporting documentation. The authors make no claims     *\
//* about the suitability of this software for any purpose. It is          *\
//* provided "as is" without express or implied warranty.                  *\
//**************************************************************************

/// \file GPUO2InterfaceRefit.h
/// \author David Rohr

#ifndef GPUO2INTERFACEREFIT_H
#define GPUO2INTERFACEREFIT_H

// Some defines denoting that we are compiling for O2
#ifndef HAVE_O2HEADERS
#define HAVE_O2HEADERS
#endif
#ifndef GPUCA_TPC_GEOMETRY_O2
#define GPUCA_TPC_GEOMETRY_O2
#endif
#ifndef GPUCA_O2_INTERFACE
#define GPUCA_O2_INTERFACE
#endif

#include <memory>
#include <vector>
#include <gsl/span>

namespace o2::base
{
template <typename value_T>
class PropagatorImpl;
using Propagator = PropagatorImpl<float>;
} // namespace o2::base
namespace o2::dataformats
{
template <typename FirstEntry, typename NElem>
class RangeReference;
}
namespace o2::tpc
{
using TPCClRefElem = uint32_t;
using TrackTPCClusRef = o2::dataformats::RangeReference<uint32_t, uint16_t>;
class TrackTPC;
struct ClusterNativeAccess;
} // namespace o2::tpc
namespace o2::track
{
template <typename value_T>
class TrackParametrizationWithError;
using TrackParCovF = TrackParametrizationWithError<float>;
using TrackParCov = TrackParCovF;
} // namespace o2::track

namespace o2::gpu
{
class GPUParam;
class GPUTrackingRefit;
class TPCFastTransform;
class GPUO2InterfaceRefit
{
 public:
  // Must initialize with:
  // - In any case: Cluster Native access structure (cl), TPC Fast Transformation instance (trans), solenoid field (bz), TPC Track hit references (trackRef)
  // - Either the shared cluster map (sharedmap) or the vector of tpc tracks (trks) to build the shared cluster map internally
  // - o2::base::Propagator (p) in case RefitTrackAsTrackParCov is to be used

  GPUO2InterfaceRefit(const o2::tpc::ClusterNativeAccess* cl, const TPCFastTransform* trans, float bz, const o2::tpc::TPCClRefElem* trackRef, const unsigned char* sharedmap = nullptr, const std::vector<o2::tpc::TrackTPC>* trks = nullptr, o2::base::Propagator* p = nullptr);
  ~GPUO2InterfaceRefit();

  int RefitTrackAsGPU(o2::tpc::TrackTPC& trk, bool outward = false, bool resetCov = false);
  int RefitTrackAsTrackParCov(o2::tpc::TrackTPC& trk, bool outward = false, bool resetCov = false);
  int RefitTrackAsGPU(o2::track::TrackParCov& trk, const o2::tpc::TrackTPCClusRef& clusRef, float time0, float* chi2 = nullptr, bool outward = false, bool resetCov = false);
  int RefitTrackAsTrackParCov(o2::track::TrackParCov& trk, const o2::tpc::TrackTPCClusRef& clusRef, float time0, float* chi2 = nullptr, bool outward = false, bool resetCov = false);
  void setGPUTrackFitInProjections(bool v = true);
  void setTrackReferenceX(float v);
  void setIgnoreErrorsAtTrackEnds(bool v);

  static void fillSharedClustersMap(const o2::tpc::ClusterNativeAccess* cl, const gsl::span<const o2::tpc::TrackTPC> trks, const o2::tpc::TPCClRefElem* trackRef, unsigned char* shmap);

 private:
  std::unique_ptr<GPUTrackingRefit> mRefit;
  std::unique_ptr<GPUParam> mParam;
  std::vector<unsigned char> mSharedMap;
};
} // namespace o2::gpu

#endif


///
/// @file This file contains the Schur reduction experiment.
///
/// @author Mirko Myllykoski (mirkom@cs.umu.se), Umeå University
///
/// @internal LICENSE
///
/// Copyright (c) 2019-2020, Umeå Universitet
///
/// Redistribution and use in source and binary forms, with or without
/// modification, are permitted provided that the following conditions are met:
///
/// 1. Redistributions of source code must retain the above copyright notice,
///    this list of conditions and the following disclaimer.
///
/// 2. 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.
///
/// 3. Neither the name of the copyright holder nor the names of its
///    contributors 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.
///

#include <starneig_test_config.h>
#include <starneig/configuration.h>
#include "experiment.h"
#include "solvers.h"
#include "../common/common.h"
#include "../common/threads.h"
#include "../common/parse.h"
#include "../common/init.h"
#include "../common/checks.h"
#include "../common/hooks.h"
#include "../common/local_pencil.h"
#ifdef STARNEIG_ENABLE_MPI
#include "../common/starneig_pencil.h"
#endif
#include "../common/io.h"
#include "../common/crawler.h"
#include "../common/complex_distr.h"
#include "../hessenberg/solvers.h"
#include <starneig/starneig.h>
#include <stdlib.h>
#include <stdio.h>
#include <unistd.h>
#ifdef GSL_FOUND
#include <gsl/gsl_randist.h>
#endif

#define DEFLATE         0x1
#define SET_TO_INF      0x2

static int deflate_and_place_infinities_crawler(
    int offset, int size, int m, int n, int count, size_t *lds,
    void **ptrs, void *arg)
{
    int const *sub = arg;

    double *A = ptrs[0];
    size_t ldA = lds[0];

    double *B = NULL; size_t ldB = 0;
    if (ptrs[1] != NULL) {
        B = ptrs[1];
        ldB = lds[1];
    }

    for (int i = 1; i < size; i++) {
        if (sub[offset+i] & DEFLATE)
            A[(i-1)*ldA+i] = 0.0;
        if (B != NULL && sub[offset+i] & SET_TO_INF)
            B[i*ldB+i] = 0.0;
    }

    return size;
}

///
/// @brief Modifies a matrix pencil such that it is decoupled to multiple
/// independent subproblems and adds
///
/// @param[in] cuts
///         The desired number of deflations.
///
/// @param[in] infinities
///         The desired number of infinities.
///
/// @param[in,out] pencil
///         The matrix pencil.
///
static void deflate_and_place_infinities(
    int cuts, int infinities, pencil_t pencil)
{
    int n = GENERIC_MATRIX_N(pencil->mat_a);
    int *sub = malloc(n*sizeof(int));
    memset(sub, 0, n*sizeof(int));

    cuts = MIN(cuts, n-1);
    for (int i = 0; i < cuts; i++) {
        int p = prand() % (n-1) + 1;
        while (sub[p] & DEFLATE)
            p = prand() % (n-1) + 1;
        sub[p] |= DEFLATE;
    }

    for (int i = 0; i < infinities; i++) {
        int p = prand() % (n-1) + 1;
        while (sub[p] & SET_TO_INF)
            p = prand() % (n-1) + 1;
        sub[p] |= SET_TO_INF;
    }

    crawl_matrices(CRAWLER_RW, CRAWLER_DIAG_WINDOW,
        &deflate_and_place_infinities_crawler, sub, 0,
        pencil->mat_a, pencil->mat_b, NULL);

    free(sub);

    free_matrix_descr(pencil->mat_ca);
    pencil->mat_ca = NULL;

    free_matrix_descr(pencil->mat_cb);
    pencil->mat_cb = NULL;

    fill_pencil(pencil);
}

////////////////////////////////////////////////////////////////////////////////

static void random_initializer_print_usage(int argc, char * const *argv)
{
    printf(
        "  --n (num) -- Problem dimension\n"
        "  --generalized -- Generalized problem\n"
        "  --decouple (num) -- Decouple the problem\n"
        "  --set-to-inf (num) -- Place infinities\n"
    );

    init_helper_print_usage("", INIT_HELPER_ALL, argc, argv);
}

static void random_initializer_print_args(int argc, char * const *argv)
{
    printf(" --n %d", read_int("--n", argc, argv, NULL, -1));
    if (read_opt("--generalized", argc, argv, NULL))
        printf(" --generalized");

    printf(" --decouple %d", read_int("--decouple", argc, argv, NULL, 0));
    printf(" --set-to-inf %d", read_int("--set-to-inf", argc, argv, NULL, 0));

    init_helper_print_args("", INIT_HELPER_ALL, argc, argv);
}

static int random_initializer_check_args(
    int argc, char * const *argv, int *argr)
{
    if (read_int("--n", argc, argv, argr, -1) < 1)
        return 1;

    read_opt("--generalized", argc, argv, argr);

    if (read_int("--decouple", argc, argv, argr, 0) < 0)
        return 1;

    if (read_int("--set-to-inf", argc, argv, argr, 0) < 0)
        return 1;

    return init_helper_check_args("", INIT_HELPER_ALL, argc, argv, argr);
}

static struct hook_data_env* random_initializer_init(
    hook_data_format_t format, int argc, char * const *argv)
{
    printf("INIT...\n");

    int n = read_int("--n", argc, argv, NULL, -1);
    int generalized = read_opt("--generalized", argc, argv, NULL);
    int decouple = read_int("--decouple", argc, argv, NULL, 0);
    int set_to_inf = read_int("--set-to-inf", argc, argv, NULL, 0);

    init_helper_t helper = init_helper_init_hook(
        "", format, n, n, PREC_DOUBLE | NUM_REAL, argc, argv);

    struct hook_data_env *env = malloc(sizeof(struct hook_data_env));
    env->format = format;
    env->copy_data = (hook_data_env_copy_t) copy_pencil;
    env->free_data = (hook_data_env_free_t) free_pencil;
    pencil_t data = env->data = init_pencil();

    data->mat_a = generate_random_hessenberg(n, n, helper);
    data->mat_q = generate_random_householder(n, helper);

    if (generalized) {
        data->mat_b = generate_random_uptriag(n, n, helper);
        data->mat_z = generate_random_householder(n, helper);
    }

    if (0 < decouple || 0 < set_to_inf)
        deflate_and_place_infinities(decouple, set_to_inf, data);

    init_helper_free(helper);

    return env;
}

static const struct hook_initializer_t random_initializer = {
    .name = "random",
    .desc = "Generates a random upper Hessenberg matrix",
    .formats = (hook_data_format_t[]) {
        HOOK_DATA_FORMAT_PENCIL_LOCAL,
#ifdef STARNEIG_ENABLE_MPI
        HOOK_DATA_FORMAT_PENCIL_STARNEIG,
#endif
#ifdef STARNEIG_ENABLE_BLACS
        HOOK_DATA_FORMAT_PENCIL_BLACS,
#endif
        0 },
    .print_usage = &random_initializer_print_usage,
    .print_args = &random_initializer_print_args,
    .check_args = &random_initializer_check_args,
    .init = &random_initializer_init
};

////////////////////////////////////////////////////////////////////////////////

static void known_initializer_print_usage(int argc, char * const *argv)
{
    printf(
        "  --n (num) -- Problem dimension\n"
        "  --generalized -- Generalized problem\n"
        "  --complex-distr (complex distribution) -- 2-by-2 block "
        "distribution module\n"
    );

    init_helper_print_usage("", INIT_HELPER_ALL, argc, argv);
}

static void known_initializer_print_args(int argc, char * const *argv)
{
    printf(" --n %d", read_int("--n", argc, argv, NULL, -1));

    int generalized = read_opt("--generalized", argc, argv, NULL);

    if (generalized)
        printf(" --generalized");

    struct complex_distr const *complex_distr =
        read_complex_distr("--complex-distr", argc, argv, NULL);

    printf(" --complex-distr %s", complex_distr->name);

    if (complex_distr->print_args != NULL)
        complex_distr->print_args(argc, argv);

    init_helper_print_args("", INIT_HELPER_ALL, argc, argv);
}

static int known_initializer_check_args(
    int argc, char * const *argv, int *argr)
{
    if (read_int("--n", argc, argv, argr, -1) < 1)
        return 1;

    read_opt("--generalized", argc, argv, argr);

    struct complex_distr const *complex_distr =
        read_complex_distr("--complex-distr", argc, argv, argr);
    if (complex_distr == NULL) {
        fprintf(stderr, "Invalid 2-by-2 block distribution module.\n");
        return -1;
    }

    if (complex_distr->check_args != NULL) {
        int ret = complex_distr->check_args(argc, argv, argr);
        if (ret)
            return ret;
    }

    return init_helper_check_args("", INIT_HELPER_ALL, argc, argv, argr);
}

static struct hook_data_env* known_initializer_init(
    hook_data_format_t format, int argc, char * const *argv)
{
    printf("INIT...\n");

    int n = read_int("--n", argc, argv, NULL, -1);

    int generalized = read_opt("--generalized", argc, argv, NULL);

    struct complex_distr const *complex_distr =
        read_complex_distr("--complex-distr", argc, argv, NULL);

    init_helper_t helper = init_helper_init_hook(
        "", format, n, n, PREC_DOUBLE | NUM_REAL, argc, argv);

    struct hook_data_env *env = malloc(sizeof(struct hook_data_env));
    env->format = format;
    env->copy_data = (hook_data_env_copy_t) copy_pencil;
    env->free_data = (hook_data_env_free_t) free_pencil;
    pencil_t pencil = env->data = init_pencil();

    double *real, *imag, *beta;
    init_supplementary_known_eigenvalues(n, &real, &imag, &beta, &pencil->supp);

    // generate (generalized) Schur form and multiply with Householder
    // reflectors from both sides

    if (generalized) {
        matrix_t mat_s = generate_random_uptriag(n, n, helper);
        matrix_t mat_t = generate_identity(n, n, helper);

        complex_distr->init(argc, argv, mat_s, mat_t);
        extract_eigenvalues(mat_s, mat_t, real, imag, beta);

        matrix_t mat_q = generate_random_householder(n, helper);
        matrix_t mat_z = generate_random_householder(n, helper);

        mul_QAZT(mat_q, mat_s, mat_z, &pencil->mat_a);
        mul_QAZT(mat_q, mat_t, mat_z, &pencil->mat_b);

        free_matrix_descr(mat_s);
        free_matrix_descr(mat_t);
        free_matrix_descr(mat_q);
        free_matrix_descr(mat_z);
    }
    else {
        matrix_t mat_s = generate_random_uptriag(n, n, helper);

        complex_distr->init(argc, argv, mat_s, NULL);
        extract_eigenvalues(mat_s, NULL, real, imag, beta);

        matrix_t mat_q = generate_random_householder(n, helper);

        mul_QAZT(mat_q, mat_s, mat_q, &pencil->mat_a);

        free_matrix_descr(mat_s);
        free_matrix_descr(mat_q);
    }

    // reduce the dense matrix (pencil) to Hessenberg(-triangular) form

    pencil->mat_q = generate_identity(n, n, helper);
    pencil->mat_ca = copy_matrix_descr(pencil->mat_a);
    if (generalized) {
        pencil->mat_z = generate_identity(n, n, helper);
        pencil->mat_cb = copy_matrix_descr(pencil->mat_b);
    }

#ifdef STARNEIG_ENABLE_BLACS
    if (format == HOOK_DATA_FORMAT_PENCIL_BLACS) {
        starneig_node_init(threads_get_workers(), STARNEIG_USE_ALL,
            STARNEIG_HINT_DM | STARNEIG_FXT_DISABLE);

        if (generalized) {
            starneig_GEP_DM_HessenbergTriangular(
                STARNEIG_MATRIX_HANDLE(pencil->mat_a),
                STARNEIG_MATRIX_HANDLE(pencil->mat_b),
                STARNEIG_MATRIX_HANDLE(pencil->mat_q),
                STARNEIG_MATRIX_HANDLE(pencil->mat_z));
        }
        else {
            starneig_SEP_DM_Hessenberg(
                STARNEIG_MATRIX_HANDLE(pencil->mat_a),
                STARNEIG_MATRIX_HANDLE(pencil->mat_q));
        }

        starneig_node_finalize();
    }
#endif

    if (format == HOOK_DATA_FORMAT_PENCIL_LOCAL) {
        starneig_node_init(threads_get_workers(), STARNEIG_USE_ALL,
            STARNEIG_HINT_SM | STARNEIG_FXT_DISABLE);

        if (generalized) {
            starneig_GEP_SM_HessenbergTriangular(LOCAL_MATRIX_N(pencil->mat_a),
                LOCAL_MATRIX_PTR(pencil->mat_a), LOCAL_MATRIX_LD(pencil->mat_a),
                LOCAL_MATRIX_PTR(pencil->mat_b), LOCAL_MATRIX_LD(pencil->mat_b),
                LOCAL_MATRIX_PTR(pencil->mat_q), LOCAL_MATRIX_LD(pencil->mat_q),
                LOCAL_MATRIX_PTR(pencil->mat_z), LOCAL_MATRIX_LD(pencil->mat_z)
            );
        }

        else {
            starneig_SEP_SM_Hessenberg(LOCAL_MATRIX_N(pencil->mat_a),
                LOCAL_MATRIX_PTR(pencil->mat_a), LOCAL_MATRIX_LD(pencil->mat_a),
                LOCAL_MATRIX_PTR(pencil->mat_q), LOCAL_MATRIX_LD(pencil->mat_q));
        }

        starneig_node_finalize();
    }

    init_helper_free(helper);

    return env;
}

static const struct hook_initializer_t known_initializer = {
    .name = "known",
    .desc = "Generates an upper Hessenberg matrix with known eigenvalues",
    .formats = (hook_data_format_t[]) {
        HOOK_DATA_FORMAT_PENCIL_LOCAL,
#ifdef STARNEIG_ENABLE_MPI
        HOOK_DATA_FORMAT_PENCIL_STARNEIG,
#endif
#ifdef STARNEIG_ENABLE_BLACS
        HOOK_DATA_FORMAT_PENCIL_BLACS,
#endif
        0 },
    .print_usage = &known_initializer_print_usage,
    .print_args = &known_initializer_print_args,
    .check_args = &known_initializer_check_args,
    .init = &known_initializer_init
};

////////////////////////////////////////////////////////////////////////////////

#ifdef GSL_FOUND

static void hessrand_initializer_print_usage(int argc, char * const *argv)
{
    printf(
        "  --n (num) -- Problem dimension\n"
        "  --generalized -- Generalized problem\n"
        "  --decouple (num) -- Decouple the problem\n"
        "  --set-to-inf (num) -- Place infinities\n"
    );

    init_helper_print_usage("", INIT_HELPER_ALL, argc, argv);
}

static void hessrand_initializer_print_args(int argc, char * const *argv)
{
    printf(" --n %d", read_int("--n", argc, argv, NULL, -1));
    if (read_opt("--generalized", argc, argv, NULL))
        printf(" --generalized");

    printf(" --decouple %d", read_int("--decouple", argc, argv, NULL, 0));
    printf(" --set-to-inf %d", read_int("--set-to-inf", argc, argv, NULL, 0));

    init_helper_print_args("", INIT_HELPER_ALL, argc, argv);
}

static int hessrand_initializer_check_args(
    int argc, char * const *argv, int *argr)
{
    if (read_int("--n", argc, argv, argr, -1) < 1)
        return 1;

    read_opt("--generalized", argc, argv, argr);

    if (read_int("--decouple", argc, argv, argr, 0) < 0)
        return 1;

    if (read_int("--set-to-inf", argc, argv, argr, 0) < 0)
        return 1;

    return init_helper_check_args("", INIT_HELPER_ALL, argc, argv, argr);
}

static int hessrand_crawler(
    int offset, int width, int m, int n, int count, size_t *lds,
    void **ptrs, void *arg)
{
    gsl_rng *r = arg;

    {
        double *A = ptrs[0];
        size_t ldA = lds[0];

        for (int i = 0; i < width; i++) {
            for (int j = 0; j < offset+i+1; j++)
                A[i*ldA+j] = gsl_ran_gaussian(r, 1.0);
            if (offset+i+1 < m)
                A[i*ldA+offset+i+1] = sqrt(gsl_ran_chisq(r, n-offset-i-1));
            for (int j = offset+i+2; j < m; j++)
                A[i*ldA+j] = 0.0;
        }
    }

    if (1 < count) {
        double *B = ptrs[1];
        size_t ldB = lds[1];

        for (int i = 0; i < width; i++) {
            for (int j = 0; j < offset+i; j++)
                B[i*ldB+j] = gsl_ran_gaussian(r, 1.0);
            B[i*ldB+offset+i] = sqrt(gsl_ran_chisq(r, offset+i));
            for (int j = offset+i+1; j < m; j++)
                B[i*ldB+j] = 0.0;
        }

        if (offset == 0)
            B[0] = sqrt(gsl_ran_chisq(r, n));
    }

    return width;
}

static struct hook_data_env* hessrand_initializer_init(
    hook_data_format_t format, int argc, char * const *argv)
{
    printf("INIT...\n");

    int n = read_int("--n", argc, argv, NULL, -1);
    int generalized = read_opt("--generalized", argc, argv, NULL);
    int decouple = read_int("--decouple", argc, argv, NULL, 0);
    int set_to_inf = read_int("--set-to-inf", argc, argv, NULL, 0);

    init_helper_t helper = init_helper_init_hook(
        "", format, n, n, PREC_DOUBLE | NUM_REAL, argc, argv);

    struct hook_data_env *env = malloc(sizeof(struct hook_data_env));
    env->format = format;
    env->copy_data = (hook_data_env_copy_t) copy_pencil;
    env->free_data = (hook_data_env_free_t) free_pencil;
    pencil_t data = env->data = init_pencil();

    data->mat_a = init_matrix(n, n, helper);
    if (generalized)
        data->mat_b = init_matrix(n, n, helper);

    gsl_rng_env_setup();

    const gsl_rng_type *T = gsl_rng_default;
    gsl_rng *r = gsl_rng_alloc(T);
    gsl_rng_set(r, prand());

    crawl_matrices(
        CRAWLER_W, CRAWLER_PANEL, &hessrand_crawler, r, 0,
        data->mat_a, data->mat_b, NULL);

    gsl_rng_free(r);

    data->mat_q = generate_random_householder(n, helper);
    if (generalized)
        data->mat_z = generate_random_householder(n, helper);

    if (0 < decouple || 0 < set_to_inf)
        deflate_and_place_infinities(decouple, set_to_inf, data);

    init_helper_free(helper);

    return env;
}

static const struct hook_initializer_t hessrand_initializer = {
    .name = "hessrand",
    .desc = "Generates a hessrand upper Hessenberg matrix",
    .formats = (hook_data_format_t[]) {
        HOOK_DATA_FORMAT_PENCIL_LOCAL,
#ifdef STARNEIG_ENABLE_MPI
        HOOK_DATA_FORMAT_PENCIL_STARNEIG,
#endif
#ifdef STARNEIG_ENABLE_BLACS
        HOOK_DATA_FORMAT_PENCIL_BLACS,
#endif
        0 },
    .print_usage = &hessrand_initializer_print_usage,
    .print_args = &hessrand_initializer_print_args,
    .check_args = &hessrand_initializer_check_args,
    .init = &hessrand_initializer_init
};

#endif

////////////////////////////////////////////////////////////////////////////////

static void generic_initializer_print_usage(int argc, char * const *argv)
{
    printf(
        "  --left-input (mtx filename) -- Left-hand side matrix input "
        "file name\n"
        "  --right-input (mtx filename) -- Right-hand side matrix input "
        "file name\n"
        "  --input-begin (num) -- First matrix row/column to be read\n"
        "  --input-end (num) -- Last matrix row/column to be read + 1\n"
        "  --n (num) -- Problem dimension\n"
        "  --generalized -- Generate a generalized problem\n"
        "  --decouple (num) -- Decouple the problem\n"
        "  --set-to-inf (num) -- Place infinities\n"
    );
    init_helper_print_usage("", INIT_HELPER_BLACS_PENCIL, argc, argv);
}

static void generic_initializer_print_args(int argc, char * const *argv)
{
    char const *left_input = read_str("--left-input", argc, argv, NULL, NULL);
    char const *right_input = read_str("--right-input", argc, argv, NULL, NULL);

    if (left_input != NULL) {
        printf(" --left-input %s", left_input);
        if (right_input)
            printf(" --right-input %s", right_input);
        int input_begin = read_int("--input-begin", argc, argv, NULL, -1);
        int input_end = read_int("--input-end", argc, argv, NULL, -1);
        if (0 <= input_begin && 0 <= input_end)
            printf(" --input-begin %d --input-end %d", input_begin, input_end);
    }
    else {
        printf(" --n %d", read_int("--n", argc, argv, NULL, -1));
        if (read_opt("--generalized", argc, argv, NULL))
            printf(" --generalized");
    }

    printf(" --decouple %d", read_int("--decouple", argc, argv, NULL, 0));
    printf(" --set-to-inf %d", read_int("--set-to-inf", argc, argv, NULL, 0));

    init_helper_print_args("", INIT_HELPER_BLACS_PENCIL, argc, argv);
}

static int generic_initializer_check_args(
    int argc, char * const *argv, int *argr)
{
    char const *left_input = read_str("--left-input", argc, argv, argr, NULL);
    char const *right_input = read_str("--right-input", argc, argv, argr, NULL);
    if (left_input != NULL) {
        if (access(left_input, R_OK) != 0) {
            fprintf(stderr, "Left-hand side input file does not exists.\n");
            return 1;
        }
        int input_begin = read_int("--input-begin", argc, argv, argr, -1);
        int input_end = read_int("--input-end", argc, argv, argr, -1);
        if (input_begin < 0 && input_end < input_begin)
            return 1;
    }
    else if (right_input != NULL) {
        fprintf(stderr, "Left-hand side input filename is missing.\n");
        return 1;
    }
    else {
        if (read_int("--n", argc, argv, argr, -1) < 1)
            return 1;
        read_opt("--generalized", argc, argv, argr);
    }

    if (read_int("--decouple", argc, argv, argr, 0) < 0)
        return 1;

    if (read_int("--set-to-inf", argc, argv, argr, 0) < 0)
        return 1;

    return init_helper_check_args(
        "", INIT_HELPER_BLACS_PENCIL, argc, argv, argr);
}

static struct hook_data_env* lapack_initializer_init(
    hook_data_format_t format, int argc, char * const *argv)
{
    printf("INIT...\n");

    int n = read_int("--n", argc, argv, NULL, -1);
    char const *left_input = read_str("--left-input", argc, argv, NULL, NULL);
    char const *right_input = read_str("--right-input", argc, argv, NULL, NULL);
    int input_begin = read_int("--input-begin", argc, argv, NULL, -1);
    int input_end = read_int("--input-end", argc, argv, NULL, -1);
    int generalized = read_opt("--generalized", argc, argv, NULL);
    int decouple = read_int("--decouple", argc, argv, NULL, 0);
    int set_to_inf = read_int("--set-to-inf", argc, argv, NULL, 0);

    if (left_input != NULL) {
        int m;
        read_mtx_dimensions_from_file(left_input, &m, &n);
    }

    if (input_begin == -1)
        input_begin = 0;
    if (input_end == -1)
        input_end = n;

    init_helper_t helper = init_helper_init_hook(
        "", format, n, n, PREC_DOUBLE | NUM_REAL, argc, argv);

    struct hook_data_env *env = malloc(sizeof(struct hook_data_env));
    env->format = HOOK_DATA_FORMAT_PENCIL_LOCAL;
    env->copy_data = (hook_data_env_copy_t) copy_pencil;
    env->free_data = (hook_data_env_free_t) free_pencil;
    pencil_t data = env->data = data = init_pencil();

    // initialize A

    if (left_input != NULL)
        data->mat_a = read_mtx_sub_matrix_from_file(
            input_begin, input_end, left_input, helper);
    else
        data->mat_a = generate_random_fullpos(n, n, helper);

    // initialize B

    if (right_input != NULL) {
        generalized = 1;
        data->mat_b = read_mtx_sub_matrix_from_file(
            input_begin, input_end, right_input, helper);
    }
    else if (generalized) {
        data->mat_b = generate_random_fullpos(n, n, helper);
    }

    // initialize Q and Z

    data->mat_q = generate_identity(n, n, helper);
    if (generalized)
        data->mat_z = generate_identity(n, n, helper);

    // prepare for decoupling

    if (decouple < 1) {
        data->mat_ca = copy_matrix_descr(data->mat_a);
        data->mat_cb = copy_matrix_descr(data->mat_b);
    }

    // reduce

    hook_solver_state_t state =
        hessenberg_lapack_solver.prepare(argc, argv, env);
    hessenberg_lapack_solver.run(state);
    hessenberg_lapack_solver.finalize(state, env);

    if (0 < decouple || 0 < set_to_inf)
        deflate_and_place_infinities(decouple, set_to_inf, data);

    init_helper_free(helper);

    printf("INIT FINISHED.\n");

    return env;
}

static struct hook_data_env* starpu_initializer_init(
    hook_data_format_t format, int argc, char * const *argv)
{
    printf("INIT...\n");

    int n = read_int("--n", argc, argv, NULL, -1);
    char const *left_input = read_str("--left-input", argc, argv, NULL, NULL);
    char const *right_input = read_str("--right-input", argc, argv, NULL, NULL);
    int input_begin = read_int("--input-begin", argc, argv, NULL, -1);
    int input_end = read_int("--input-end", argc, argv, NULL, -1);
    int generalized = read_opt("--generalized", argc, argv, NULL);
    int decouple = read_int("--decouple", argc, argv, NULL, 0);
    int set_to_inf = read_int("--set-to-inf", argc, argv, NULL, 0);

    if (left_input != NULL) {
        int m;
        read_mtx_dimensions_from_file(left_input, &m, &n);
    }

    init_helper_t helper =
        init_helper_init_hook("", format, n, n, PREC_DOUBLE | NUM_REAL, argc, argv);

    struct hook_data_env *env = malloc(sizeof(struct hook_data_env));
    env->format = format;
    env->copy_data = (hook_data_env_copy_t) copy_pencil;
    env->free_data = (hook_data_env_free_t) free_pencil;
    pencil_t data = env->data = data = init_pencil();

    // initialize A

    if (left_input != NULL) {
        if (0 <= input_begin)
            data->mat_a = read_mtx_sub_matrix_from_file(
                input_begin, input_end, left_input, helper);
        else
            data->mat_a = read_mtx_matrix_from_file(left_input, helper);
    }
    else {
        data->mat_a = generate_random_fullpos(n, n, helper);
    }

    // initialize B

    if (right_input != NULL) {
        generalized = 1;
        if (0 <= input_begin)
            data->mat_b = read_mtx_sub_matrix_from_file(
                input_begin, input_end, right_input, helper);
        else
            data->mat_b = read_mtx_matrix_from_file(right_input, helper);
    }
    else if (generalized) {
        data->mat_b = generate_random_fullpos(n, n, helper);
    }

    // initialize Q and Z

    data->mat_q = generate_identity(n, n, helper);
    if (generalized)
        data->mat_z = generate_identity(n, n, helper);

    // prepare for decoupling

    if (decouple < 1 && set_to_inf < 1) {
        data->mat_ca = copy_matrix_descr(data->mat_a);
        data->mat_cb = copy_matrix_descr(data->mat_b);
    }

    // reduce

    if (format == HOOK_DATA_FORMAT_PENCIL_LOCAL) {

        starneig_node_init(threads_get_workers(), STARNEIG_USE_ALL,
            STARNEIG_HINT_SM | STARNEIG_FXT_DISABLE);

        if (generalized)
            starneig_GEP_SM_HessenbergTriangular(LOCAL_MATRIX_N(data->mat_a),
                LOCAL_MATRIX_PTR(data->mat_a), LOCAL_MATRIX_LD(data->mat_a),
                LOCAL_MATRIX_PTR(data->mat_b), LOCAL_MATRIX_LD(data->mat_b),
                LOCAL_MATRIX_PTR(data->mat_q), LOCAL_MATRIX_LD(data->mat_q),
                LOCAL_MATRIX_PTR(data->mat_z), LOCAL_MATRIX_LD(data->mat_z));
        else
            starneig_SEP_SM_Hessenberg(LOCAL_MATRIX_N(data->mat_a),
                LOCAL_MATRIX_PTR(data->mat_a), LOCAL_MATRIX_LD(data->mat_a),
                LOCAL_MATRIX_PTR(data->mat_q), LOCAL_MATRIX_LD(data->mat_q));

        starneig_node_finalize();

    }

#ifdef STARNEIG_ENABLE_BLACS
    if (format == HOOK_DATA_FORMAT_PENCIL_BLACS) {

        starneig_node_init(threads_get_workers(), STARNEIG_USE_ALL,
            STARNEIG_HINT_DM | STARNEIG_FXT_DISABLE);

        if (generalized)
            starneig_GEP_DM_HessenbergTriangular(
                STARNEIG_MATRIX_HANDLE(data->mat_a),
                STARNEIG_MATRIX_HANDLE(data->mat_b),
                STARNEIG_MATRIX_HANDLE(data->mat_q),
                STARNEIG_MATRIX_HANDLE(data->mat_z));
        else
            starneig_SEP_DM_Hessenberg(
                STARNEIG_MATRIX_HANDLE(data->mat_a),
                STARNEIG_MATRIX_HANDLE(data->mat_q));

        starneig_node_finalize();
    }
#endif

    if (0 < decouple || 0 < set_to_inf)
        deflate_and_place_infinities(decouple, set_to_inf, data);

    init_helper_free(helper);

    printf("INIT FINISHED.\n");

    return env;
}

static const struct hook_initializer_t lapack_initializer = {
    .name = "lapack",
    .desc =
        "Reduces a matrix pencil to upper Hessenberg / Hessenberg-triangular "
        "form using a LAPACK algorithm",
    .formats = (hook_data_format_t[]) { HOOK_DATA_FORMAT_PENCIL_LOCAL, 0 },
    .print_usage = &generic_initializer_print_usage,
    .print_args = &generic_initializer_print_args,
    .check_args = &generic_initializer_check_args,
    .init = &lapack_initializer_init
};

static const struct hook_initializer_t starpu_initializer = {
    .name = "starneig",
    .desc =
        "Reduces a matrix pencil to upper Hessenberg / Hessenberg-triangular "
        "form using a StarPU based parallel algorithm",
    .formats = (hook_data_format_t[]) {
        HOOK_DATA_FORMAT_PENCIL_LOCAL,
#ifdef STARNEIG_ENABLE_BLACS
        HOOK_DATA_FORMAT_PENCIL_BLACS,
#endif
        0 },
    .print_usage = &generic_initializer_print_usage,
    .print_args = &generic_initializer_print_args,
    .check_args = &generic_initializer_check_args,
    .init = &starpu_initializer_init
};

////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////

static void print_usage(int argc, char * const *argv)
{
    print_avail_complex_distr();
    print_opt_complex_distr();
}

const struct hook_experiment_descr schur_experiment = {
    .print_usage = &print_usage,
    .initializers = (struct hook_initializer_t const *[])
    {
#ifdef GSL_FOUND
        &hessrand_initializer,
#endif
        &starpu_initializer,
        &lapack_initializer,
        &random_initializer,
        &known_initializer,
        &mtx_initializer,
        &raw_initializer,
        0
    },
    .supplementers = (struct hook_supplementer_t const *[])
    {
        0
    },
    .solvers = (struct hook_solver const *[])
    {
        &schur_starpu_solver,
        &schur_starpu_simple_solver,
        &schur_lapack_solver,
#ifdef PDLAHQR_FOUND
        &schur_pdlahqr_solver,
#endif
#ifdef PDHSEQR_FOUND
        &schur_pdhseqr_solver,
#endif
#ifdef CUSTOM_PDHSEQR
        &schur_custom_pdhseqr_solver,
#endif
#ifdef PDHGEQZ_FOUND
        &schur_pdhgeqz_solver,
#endif
        0
    },
    .hook_descrs = (struct hook_descr_t const *[])
    {
        &default_schur_test_descr,
        &default_eigenvalues_descr,
        &default_known_eigenvalues_descr,
        &default_analysis_descr,
        &default_residual_test_descr,
        &default_print_pencil_descr,
        &default_print_input_pencil_descr,
        &default_store_raw_pencil_descr,
        &default_store_raw_input_pencil_descr,
        0
    }
};


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <iniparser.h>
#include "prepmt/prepmt_hudson96.h"
#ifdef PARMT_USE_INTEL
#include <mkl_cblas.h>
#else
#include <cblas.h>
#endif
#include "cps.h"
#include "iscl/array/array.h"
#include "iscl/fft/fft.h"
#include "iscl/memory/memory.h"
#include "iscl/os/os.h"

/*!
 * @brief Reads the ini file for Computer Programs in Seismology hudson96
 *        forward modeling variables.
 *
 * @param[in] iniFile    Name of ini file.
 * @param[in] section    Section of ini file to read.
 *
 * @param[out] parms     The hudson96 parameters.
 *
 * @result 0 indicates success.
 *
 * @author Ben Baker, ISTI
 *
 */
int prepmt_hudson96_readHudson96Parameters(const char *iniFile,
                                           const char *section,
                                           struct hudson96_parms_struct *parms)
{
    const char *s;
    char vname[256];
    dictionary *ini;
    //------------------------------------------------------------------------//
    cps_setHudson96Defaults(parms);
    if (!os_path_isfile(iniFile))
    {
        fprintf(stderr, "%s: ini file: %s does not exist\n", __func__, iniFile);
        return -1;
    }
    ini = iniparser_load(iniFile);
    if (ini == NULL)
    {
        fprintf(stderr, "%s: Cannot parse ini file\n", __func__);
        return -1;
    }
    // Teleseismic model
    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:modeltel", section);
    s = iniparser_getstring(ini, vname, NULL);
    if (s != NULL)
    {
        strcpy(parms->modeltel, s);
    }
    else
    {
        strcpy(parms->modeltel, "tak135sph.mod\0");
    }
    // Receiver model
    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:modelrec", section);
    s = iniparser_getstring(ini, vname, NULL);
    if (s != NULL)
    {
        strcpy(parms->modelrec, s);
    }
    else
    {
        strcpy(parms->modelrec, parms->modelrec);
    }
    // Source model
    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:modelsrc", section);
    s = iniparser_getstring(ini, vname, NULL);
    if (s != NULL)
    {
        strcpy(parms->modelsrc, s);
    }
    else
    {
        strcpy(parms->modelsrc, parms->modelsrc);
    }
    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:hs", section);
    parms->hs = iniparser_getdouble(ini, vname, 0.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dt", section);
    parms->dt = iniparser_getdouble(ini, vname, 1.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:npts", section);
    parms->npts = iniparser_getint(ini, vname, 1024);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:gcarc", section);
    parms->gcarc = iniparser_getdouble(ini, vname, 50.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:offset", section);
    parms->offset = iniparser_getdouble(ini, vname, 10.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dosrc", section);
    parms->dosrc = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dorec", section);
    parms->dorec = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dotel", section);
    parms->dotel = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dop", section);
    parms->dop = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dokjar", section);
    parms->dokjar = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:loffsetdefault", section);
    parms->loffsetdefault = iniparser_getboolean(ini, vname, 1);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:verbose", section);
    parms->verbose = iniparser_getboolean(ini, vname, 0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:utstar", section);
    parms->utstar = iniparser_getdouble(ini, vname, -12345.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:dottonly", section);
    parms->dottonly = iniparser_getboolean(ini, vname, 0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:zsrc", section);
    parms->zsrc = iniparser_getdouble(ini, vname, 100.0);

    memset(vname, 0, 256*sizeof(char));
    sprintf(vname, "%s:zrec", section);
    parms->zrec = iniparser_getdouble(ini, vname, 60.0);
    // Free ini dictionary
    iniparser_freedict(ini);
    return 0;
}
//============================================================================//
/*!
 * @brief Computes the fundamental fault Green's functions for the teleseismic
 *        body waves with hudson96.
 *
 * @param[in] nobs            Number of observations.
 * @param[in] obs             Observations with source location and
 *                            receiver location.  This is an array of length
 *                            nobs.
 * @param[in] luseCrust1      If true then use crust1.0 models at source
 *                            and receiver.
 * @param[in] crust1Dir       If luseCrust1 is true then this is the name
 *                            of the crust1.0 directory.  If NULL and
 *                            luseCrust1 is used then it will default to
 *                            libcps configuration.
 * @param[in] luseSrcModel    If true then use the local source velocity
 *                            at the source.  This supersedes the crust1.0
 *                            source velocity if it is defined.
 * @param[in] sourceModel     If luseSrcModel is true then this is the name
 *                            of the CPS style source model to read.
 *
 * @param[out] telmod         Holds the teleseismic model (ak135).
 * @param[out] srcmod         Holds the local source model.
 * @param[in,out] recmod      On input contains sufficient space and should
 *                            be an array of length nobs.
 *                            On output holds the receiver models.
 *
 * @param[out] ierr           0 indicates success.
 *
 * @author Ben Baker, ISTI
 *
 * @bug I need better handling of the offset.
 *
 */
int hudson96_getModels(const int nobs, const struct sacData_struct *obs,
                       const bool luseCrust1, const char *crust1Dir,
                       const bool luseSrcModel, const char *sourceModel,
                       struct vmodel_struct *telmod,
                       struct vmodel_struct *srcmod,
                       struct vmodel_struct *recmod)
{
    double *lats, *lons, evla, evlo;
    int ierr, iobs;
    ierr = 0;
    // Set the teleseismic model
    memset(srcmod, 0, sizeof(struct vmodel_struct));
    memset(telmod, 0, sizeof(struct vmodel_struct));
    cps_globalModel_ak135f(telmod);
    if (luseCrust1)
    {
        fprintf(stdout, "%s: Reading crust1.0...\n", __func__);
        lats = memory_calloc64f(nobs);
        lons = memory_calloc64f(nobs);
        ierr = sacio_getFloatHeader(SAC_FLOAT_EVLA, obs[0].header, &evla);
        if (ierr != 0)
        {
            fprintf(stderr, "%s: Error - evla not set\n", __func__);
            return ierr;
        }
        ierr = sacio_getFloatHeader(SAC_FLOAT_EVLO, obs[0].header, &evlo);
        if (ierr != 0)
        {
            fprintf(stderr, "%s: Error - evlo not set\n", __func__);
            return ierr;
        }
        for (iobs=0; iobs<nobs; iobs++)
        {
            sacio_getFloatHeader(SAC_FLOAT_STLA, obs[iobs].header,
                                 &lats[iobs]);
            sacio_getFloatHeader(SAC_FLOAT_STLO, obs[iobs].header,
                                 &lons[iobs]);
        }
        ierr = cps_crust1_getCrust1ForHerrmann(crust1Dir, false,
                                               evla, evlo,
                                               lats, lons,
                                               nobs,
                                               srcmod, recmod);
        if (ierr != 0)
        {
            fprintf(stderr, "%s: Failed to load crust1.0 model\n", __func__);
            return ierr;
        }
        memory_free64f(&lats);
        memory_free64f(&lons);
    }
    // Use teleseismic model for receiver model
    else
    {
        fprintf(stdout, "%s: Setting receiver models to teleseismic model\n",
                __func__);
        for (iobs=0; iobs<nobs; iobs++)
        {
            cps_utils_copyVmodelStruct(*telmod, &recmod[iobs]);
        }
    }
    // Use source model
    if (luseSrcModel)
    {
        fprintf(stdout, "%s: Using source model: %s\n", __func__, sourceModel);
        cps_utils_freeVmodelStruct(srcmod);
        ierr = cps_getmod(sourceModel, srcmod);
        if (ierr != 0)
        {
            fprintf(stderr, "%s: Error loading srcmod\n", __func__);
            return ierr;
        }
    }
    fprintf(stdout, "%s: Computing Green's functions...\n", __func__);
    // Otherwise source to teleseismic model
    if (!luseSrcModel && !luseCrust1)
    {
        fprintf(stdout, "%s: Setting source model to teleseismic model\n",
                __func__);
        cps_utils_copyVmodelStruct(*telmod, srcmod);
    }
    return 0;
}
//============================================================================//
/*!
 * @brief Computes the fundamental fault Green's functions for the teleseismic
 *        body waves with hudson96.
 *
 * @param[in] hudson96Parms   hudson96 forward modeling parameters.
 * @param[in] hpulse96Parms   hpulse96 forward modeling parameters.
 * @param[in] telmod          Holds the teleseismic model (ak135).
 * @param[in] srcmod          Holds the local source model.
 * @param[in] recmod          Holds each receiver model.
 *                            This is an array of dimension [nobs].
 * @param[in] ntstar          Number of t*'s in grid.
 * @param[in] tstars          Array of dimension [ntstar] with the attenuation
 *                            factors.
 * @param[in] ndepth          Number of source depths in grid.
 * @param[in] depths          Array of dimension [ndepth] with the source
 *                            depths specified in (km).
 * @param[in] nobs            Number of observations.
 * @param[in] obs             Observed waveforms which contain the receiver
 *                            locations, components of motion, first
 *                            arrival time, sampling period, and number of
 *                            points in waveform.
 *
 * @param[out] ierr           0 indicates success.
 *
 * @author Ben Baker, ISTI
 *
 * @bug I need better handling of the offset.
 *
 */
struct sacData_struct *prepmt_hudson96_computeGreensFF(
    const struct hudson96_parms_struct hudson96Parms,
    const struct hpulse96_parms_struct hpulse96Parms,
    const struct vmodel_struct telmod,
    const struct vmodel_struct srcmod,
    const struct vmodel_struct *recmod,
    const int ntstar, const double *__restrict__ tstars,
    const int ndepth, const double *__restrict__ depths,
    const int nobs, const struct sacData_struct *obs, int *ierr)
{
    struct hudson96_parms_struct hudson96ParmsWork;
    struct hpulse96_parms_struct hpulse96ParmsWork;
    struct hpulse96_data_struct zresp;
    struct sacData_struct *sacFFGrns;
    struct hwave_greens_struct *ffGrns;
    char sncl[64], phaseName[8];
    double *dptr, cmpaz, cmpinc, dt, gcarc, offset0,
           pickTime, xnorm;
    int i, idep, ierrAll, ierr1, ierr2, indx, iobs, iobs0, ip, it,
        factor, kndx, nloop, npts;
    bool lzero[10], lfound, lsh;
    enum isclError_enum isclError;
    const enum sacHeader_enum pickVars[11]
       = {SAC_FLOAT_A,
          SAC_FLOAT_T0, SAC_FLOAT_T1, SAC_FLOAT_T2, SAC_FLOAT_T3,
          SAC_FLOAT_T4, SAC_FLOAT_T5, SAC_FLOAT_T6, SAC_FLOAT_T7,
          SAC_FLOAT_T8, SAC_FLOAT_T9};
    const enum sacHeader_enum pickTypes[11]
       = {SAC_CHAR_KA,
          SAC_CHAR_KT0, SAC_CHAR_KT1, SAC_CHAR_KT2, SAC_CHAR_KT3,
          SAC_CHAR_KT4, SAC_CHAR_KT5, SAC_CHAR_KT6, SAC_CHAR_KT7,
          SAC_CHAR_KT8, SAC_CHAR_KT9};
    // Here's the idea: I want to input magnitudes with units of N-m so:
    // N-m -> Dyne-dm (1.e+7)
    // CPS internally scales from Dyne-cm to cm (1.e+20)
    // Finally, I want outputs proprotional to m (1.e-2)
    const double xmom = 1.0;     // no confusing `relative' magnitudes
    const double xcps = 1.e-20;  // convert dyne-cm mt to output cm
    const double cm2m = 1.e-2;   // cm to meters
    const double dcm2nm = 1.e+7; // magnitudes intended to be specified in
                                 // Dyne-cm but I work in N-m
    // Given a M0 in Newton-meters get a seismogram in meters
    const double xscal = xmom*xcps*cm2m*dcm2nm;
    const char *cfaults[10] = {"ZDS\0", "ZSS\0", "ZDD", "ZEX\0",
                               "RDS\0", "RSS\0", "RDD", "REX\0",
                               "TDS\0", "TSS\0"};
    const int npTypes = 11;
    const int nrDist = 1;
    const int nrDepths = 1;
    const int nsDepths = 1;
    //------------------------------------------------------------------------//
    //
    // Quick error checks
    *ierr = 0;
    sacFFGrns = NULL;
    if (nobs < 1 || obs == NULL ||
        ntstar < 1 || tstars == NULL ||
        ndepth < 1 || depths == NULL)
    {
        *ierr = 1;
        if (nobs < 1){fprintf(stderr, "%s: Error no observations\n", __func__);}
        if (obs == NULL){fprintf(stderr, "%s: Error obs is NULL\n", __func__);}
        if (ntstar < 1){fprintf(stderr, "%s: Error no t*'s\n", __func__);}
        if (tstars == NULL)
        {
            fprintf(stderr, "%s: Error tstars is NULL\n", __func__);
        }
        if (ndepth < 1){fprintf(stderr, "%s: Error no depths\n", __func__);}
        if (depths == NULL)
        {
            fprintf(stderr, "%s: Error depths is NULL\n", __func__);
        }
        return sacFFGrns;
    }
    // Set the modeling structures
    memset(&hudson96ParmsWork, 0, sizeof(struct hudson96_parms_struct));
    memset(&hpulse96ParmsWork, 0, sizeof(struct hpulse96_parms_struct));
    cps_setHudson96Defaults(&hudson96ParmsWork);
    cps_setHpulse96Defaults(&hpulse96ParmsWork);
    cps_utils_copyHudson96ParmsStruct(hudson96Parms, &hudson96ParmsWork);
    cps_utils_copyHpulse96ParmsStruct(hpulse96Parms, &hpulse96ParmsWork);
    offset0 = hudson96Parms.offset;
    // Set space for output
    nloop = nobs*ndepth*ntstar;
    sacFFGrns = (struct sacData_struct *)
                 calloc((size_t) (10*nloop), sizeof(struct sacData_struct));
    // Loop on the distances, depths, t*'s and compute greens functions
    iobs0 =-1;
    ierrAll = 0;
    for (indx=0; indx<nloop; indx++)
    {
        ffGrns = NULL;
        // Convert 3D grid into loop indices (i->n1 is fast; k->n3 is slow)
        *ierr = prepmt_hudson96_grd2ijk(indx,
                                        ntstar, ndepth, nobs,
                                        &it, &idep, &iobs);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Failed to convert to grid\n", __func__);
            break;
        }
        // New observation (station) -> may need to update velocity model
        if (iobs != iobs0)
        {
            iobs0 = iobs;
        }
        *ierr = sacio_getFloatHeader(SAC_FLOAT_DELTA,
                                     obs[iobs].header, &dt);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Could not get sampling period\n", __func__);
            break;
        }
        *ierr = sacio_getFloatHeader(SAC_FLOAT_GCARC,
                                     obs[iobs].header, &gcarc);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Could not get gcarc\n", __func__);
            break;
        }
        *ierr = sacio_getIntegerHeader(SAC_INT_NPTS,
                                       obs[iobs].header, &npts);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Could not get npts\n", __func__);
            break;
        }
        // Tie waveform modeling to first pick type
        lfound = false;
        hudson96ParmsWork.dop = true;
        for (ip=0; ip<npTypes; ip++)
        {
            ierr1 = sacio_getCharacterHeader(pickTypes[ip],
                                             obs[iobs].header, phaseName);
            ierr2 = sacio_getFloatHeader(pickVars[ip],
                                         obs[iobs].header, &pickTime);
            if (ierr1 == 0 && ierr2 == 0)
            {
                lfound = true;
                if (strncasecmp(phaseName, "P", 1) == 0)
                {
                    hudson96ParmsWork.dop = true;
                }
                else if (strncasecmp(phaseName, "S", 1) == 0)
                {
                    hudson96ParmsWork.dop = false;
                }
                else
                {
                    fprintf(stderr, "%s: Can't classify phase: %s\n",
                            __func__, phaseName);
                    lfound = false;
                }
                break;
            }
        }
        if (!lfound)
        {
            fprintf(stdout, "%s: No pick available - won't be able to align\n",
                    __func__);
            continue;
        }
        memset(&zresp, 0, sizeof(struct hpulse96_data_struct));
        hudson96ParmsWork.hs = depths[idep];
        hudson96ParmsWork.dt = dt;
        hudson96ParmsWork.gcarc = gcarc;
        hudson96ParmsWork.utstar = tstars[it];
        factor = 2;
        if (hudson96ParmsWork.dt < 0.1){factor = 4;}
        hudson96ParmsWork.npts = MAX(256,
                                     MIN(2048,
                                         factor*fft_nextpow2(MAX(1, npts), ierr)));
        hudson96ParmsWork.offset = fmin(pickTime, offset0); //TODO: fmin or fmax?
//printf("%s %f\n", phaseName, pickTime);
        // Try to pad this out a little
        hudson96ParmsWork.offset = fmax(hudson96ParmsWork.offset,
                                  (double) (hudson96ParmsWork.npts - 1)*dt*0.2);
//        printf("%e %d\n", hudson96ParmsWork.offset/dt, npts);
/*
        if (pickTime < hudson96ParmsWork.offset)
        {
            hudson96ParmsWork.offset = (double) (int) (pickTime/dt + 0.5)*dt;
        }
*/
        zresp = hudson96_interface(hudson96ParmsWork,
                                   telmod, recmod[iobs], srcmod, ierr);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Error calling hudson96\n", __func__);
            ierrAll = ierrAll + 1;
            goto NEXT_OBS;
        }
        ffGrns = hpulse96_interface(nrDist, nrDepths, nsDepths,
                                    hpulse96ParmsWork,
                                    &zresp, ierr);
        if (*ierr != 0)
        {
            fprintf(stderr, "%s: Error calling hpulse96 interface\n", __func__);
            ierrAll = ierrAll + 1;
            goto NEXT_OBS;
        }
        // Set the fundamental fault Green's functions
        for (i=0; i<10; i++)
        {
            dptr = NULL;
            lsh = false;
            lzero[i] = false;
            if (i == 0)
            {
                dptr = ffGrns->zds;
            }
            else if (i == 1)
            {
                dptr = ffGrns->zss;
            }
            else if (i == 2)
            {
                dptr = ffGrns->zdd;
            }
            else if (i == 3)
            {
                dptr = ffGrns->zex;
            }
            else if (i == 4)
            {
                dptr = ffGrns->rds;
                cmpinc = 90.0;
            }
            else if (i == 5)
            {
                dptr = ffGrns->rss;
                cmpinc = 90.0;
            }
            else if (i == 6)
            {
                dptr = ffGrns->rdd;
                cmpinc = 90.0;
            }
            else if (i == 7)
            {
                dptr = ffGrns->rex;
                cmpinc = 90.0;
            }
            else if (i == 8)
            {
                dptr = ffGrns->tds;
                lsh = true;
                cmpaz = 90.0;
                cmpinc = 90.0;
            }
            else if (i == 9)
            {
                dptr = ffGrns->tss;
                lsh = true;
                cmpaz = 90.0;
                cmpinc = 90.0;
            }
            kndx = indx*10 + i;
            sacio_setDefaultHeader(&sacFFGrns[kndx].header);
            sacFFGrns[kndx].header.lhaveHeader = true;
            sacio_setIntegerHeader(SAC_INT_NPTS, ffGrns->npts,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZYEAR, 1970,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZJDAY, 1,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZHOUR, 0,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZMIN, 0,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZSEC, 0,
                                   &sacFFGrns[kndx].header);
            sacio_setIntegerHeader(SAC_INT_NZMSEC, 0,
                                   &sacFFGrns[kndx].header);
            sacio_setBooleanHeader(SAC_BOOL_LCALDA, false,
                                   &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_DELTA, ffGrns->dt,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_GCARC, ffGrns->dist/111.195,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_DIST, ffGrns->dist,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_EVDP, depths[idep],
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_STEL, ffGrns->stelel,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_AZ,  0.0,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_BAZ, 180.0,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_O, -ffGrns->t0,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_B, ffGrns->t0,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_CMPAZ, cmpaz,
                                 &sacFFGrns[kndx].header);
            sacio_setFloatHeader(SAC_FLOAT_CMPINC, cmpinc,
                                 &sacFFGrns[kndx].header);
            if (hudson96ParmsWork.dop)
            {
                sacio_setFloatHeader(SAC_FLOAT_A, ffGrns->timep,
                                     &sacFFGrns[kndx].header);
                sacio_setCharacterHeader(SAC_CHAR_KA, "P",
                                         &sacFFGrns[kndx].header);
            }
            else
            {
                if (!lsh)
                {
                    sacio_setFloatHeader(SAC_FLOAT_A, ffGrns->timesv,
                                         &sacFFGrns[kndx].header);
                }
                else
                {
                    sacio_setFloatHeader(SAC_FLOAT_A, ffGrns->timesh,
                                         &sacFFGrns[kndx].header);
                }
                sacio_setCharacterHeader(SAC_CHAR_KA, "S",
                                         &sacFFGrns[kndx].header);
            }
            sacio_setCharacterHeader(SAC_CHAR_KO, "O\0",
                                     &sacFFGrns[kndx].header);
            sacio_setCharacterHeader(SAC_CHAR_KEVNM, "SYNTHETIC\0",
                                     &sacFFGrns[kndx].header);
            sacio_setCharacterHeader(SAC_CHAR_KCMPNM, cfaults[i],
                                     &sacFFGrns[kndx].header);
            sacFFGrns[kndx].npts = ffGrns->npts;
            sacFFGrns[kndx].data = sacio_malloc64f(ffGrns->npts);
            if (dptr != NULL)
            {
                array_copy64f_work(ffGrns->npts, dptr, sacFFGrns[kndx].data);
            }
            else
            {
                array_set64f_work(ffGrns->npts, 0.0, sacFFGrns[kndx].data);
            }
            xnorm = cblas_dnrm2(sacFFGrns[kndx].npts, sacFFGrns[kndx].data, 1);
            if (xnorm == 0.0){lzero[i] = true;}
            // Handle scaling
            cblas_dscal(sacFFGrns[kndx].npts, xscal, sacFFGrns[kndx].data, 1);
            dptr = NULL;
        } // Loop on fundamnetal faults
        if (array_sum8l(10, lzero, &isclError) == 10)
        {
            memset(sncl, 0, 64*sizeof(char));
            sprintf(sncl, "%s.%s.%s.%s",
                    obs[iobs].header.knetwk, obs[iobs].header.kstnm,
                    obs[iobs].header.kcmpnm, obs[iobs].header.khole);
            fprintf(stdout,
                    "%s: Warning Greens fn %s w/ npts %d at gcarc=%e is zero\n",
                    __func__, sncl, hudson96ParmsWork.npts, gcarc);
        }
NEXT_OBS:;
        if (ffGrns != NULL)
        {
            cps_utils_freeHwaveGreensStruct(ffGrns);
            free(ffGrns);
        }
        cps_utils_freeHpulse96DataStruct(&zresp);
    }
    return sacFFGrns;
}
//============================================================================//
/*!
 * @brief Converts a 1D index to 3D grid indices:
 *
 *        Changes:
 *        for (igrd=0; igrd<n1*n2*n3; igrd++)
 *        {
 *
 *        }
 *        To:
 *        for (k=0; k<n3; k++)
 *        {
 *            for (j=0; j<n2; j++)
 *            {
 *                for (i=0; i<n1; i++)
 *                {
 *                    igrd = k*n2*n1 + j*n1 + i;
 *                }
 *            }
 *        }
 *
 * @param[in] igrd  Flattened C numbered grid index: igrd = k*n2*n1 + j*n1 + i.
 * @param[in] n1    This is the fastest loop iterator (innermost loop).
 * @param[in] n2    This is the middle loop iterator (intermediate loop).
 * @param[in] n3    This is the slowest loop iterator (outermost loop).
 * @param[out] i    C index in inner loop [0,n1).
 * @param[out] j    C index in intermediate loop [0,n2).
 * @param[out] k    C index in outermost loop [0,n3).
 *
 * @result 0 indicates success.
 *
 */
int prepmt_hudson96_grd2ijk(const int igrd,
                            const int n1, const int n2, const int n3,
                            int *i, int *j, int *k)
{
    int ierr, n12;
    ierr = 0;
    n12 = n1*n2;
    *k = (igrd)/n12;
    *j = (igrd - *k*n12)/n1;
    *i =  igrd - *k*n12 - *j*n1;
    if (*i < 0 || *i > n1 - 1){ierr = ierr + 1;}
    if (*j < 0 || *j > n2 - 1){ierr = ierr + 1;}
    if (*k < 0 || *k > n3 - 1){ierr = ierr + 1;}
    return ierr;
}
//============================================================================//
/*!
 * @brief Maps the observation, depth, and t* to the global index.
 *
 * @param[in] ndepth    Number of depths.
 * @param[in] ntstar    Number of t*'s.
 * @param[in] iobs      C indexed observation number [0,nobs-1]
 * @param[in] idep      C indexed depth number [0,ndepth-1]
 * @param[in] it        C indexed t* number [0,ntstar-1]
 *
 * @result If >= 0 then this (iobs, idep, it) index in the Green's functions
 *         table.
 *
 * @author Ben Baker, ISTI
 *
 */
int prepmt_hudson96_observationDepthTstarToIndex(
    const int ndepth, const int ntstar,
    const int iobs, const int idep, const int it)
{
    int indx;
    indx = iobs*ntstar*ndepth + idep*ntstar + it;
    return indx;
}


/* Starting from version 7.8, MATLAB BLAS expects ptrdiff_t arguments for integers */
#if MATLAB_VERSION >= 0x0708
#include <stddef.h>
#include <stdlib.h>
#endif
#include <string.h>

/* Define MX_HAS_INTERLEAVED_COMPLEX for version <9.4 */
#ifndef MX_HAS_INTERLEAVED_COMPLEX
#define MX_HAS_INTERLEAVED_COMPLEX 0
#endif

/* Starting from version 7.6, MATLAB BLAS is seperated */
#if MATLAB_VERSION >= 0x0705
#include <blas.h>
#else
#define dcabs1 FORTRAN_WRAPPER(dcabs1)
extern doublereal dcabs1(
        doublereal *z
        );
#endif
#include <lapack.h>
#include "f2c.h"

#define cgeqpb FORTRAN_WRAPPER(cgeqpb)
int cgeqpb(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *, integer *, integer *,
        real *, real *, integer *, real *, complex *, integer *,
        real *, integer *);

#define cgeqpc FORTRAN_WRAPPER(cgeqpc)
int cgeqpc(integer *, integer *, integer *, integer *, complex *,
        integer *, complex *, integer *, integer *, integer *, real *,
        integer *, integer *, complex *, complex *, real *, real *,
        complex *, integer *, real *);

#define cgeqpw FORTRAN_WRAPPER(cgeqpw)
int cgeqpw(integer *, integer *, integer *, integer *, integer *,
        complex *, integer *, integer *, real *, complex *, real *, real *,
        complex *, complex *, real *);

#define cgeqpx FORTRAN_WRAPPER(cgeqpx)
int cgeqpx(integer*, integer*, integer*, integer*, complex*,
        integer*, complex*, integer*, integer*, real*, real*, integer*,
        real*, complex*, integer*, real*, integer*);

#define cgeqpy FORTRAN_WRAPPER(cgeqpy)
int cgeqpy(integer*, integer*, integer*, integer*, complex*,
        integer*, complex*, integer*, integer*, real*, real*, integer*,
        real*, complex*, integer*, real*, integer*);

#define clasmx FORTRAN_WRAPPER(clasmx)
doublereal clasmx(integer *);

#define clauc1 FORTRAN_WRAPPER(clauc1)
logical clauc1(integer *, complex *, real *, complex *, complex *, real *);

#define ctrqpx FORTRAN_WRAPPER(ctrqpx)
int ctrqpx(integer *, integer *, integer *, integer *, complex *,
        integer *, complex *, integer *, integer *, real *, real *,
        integer *, real *, complex *, real *, integer *);

#define ctrqpy FORTRAN_WRAPPER(ctrqpy)
int ctrqpy(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *c, integer *, integer *,
        real *, real *, integer *, real *, complex *, real *, integer *);

#define ctrqxc FORTRAN_WRAPPER(ctrqxc)
int ctrqxc(integer *, integer *, integer *, integer *, complex *,
        integer *, complex *, integer *, integer *, integer *, real *,
        real *, real *, complex *, real *, integer *);

#define cglbif FORTRAN_WRAPPER(cglbif)
int cglbif(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *, integer *, integer *,
        real *, integer *, logical *, complex *, real *, integer *);

#define ccniif FORTRAN_WRAPPER(ccniif)
int ccniif(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *, integer *, integer *,
        real *, real *, integer *, logical *, complex *, real *, integer *);

#define cgret FORTRAN_WRAPPER(cgret)
int cgret(integer *, integer *, integer *, integer *,
       complex *, integer *, complex *, integer *, complex *,
       real *, integer *);

#define shess FORTRAN_WRAPPER(shess)
int chess(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *, integer *,
       complex *, real *, integer *);

#define ctrqyc FORTRAN_WRAPPER(ctrqyc)
int ctrqyc(integer *, integer *, integer *, integer *,
        complex *, integer *, complex *, integer *, integer *,
        integer *, real *, real *, real *, complex *, real *, integer *);

#define ctrrnk FORTRAN_WRAPPER(ctrrnk)
int ctrrnk(integer *, complex *, integer *, real *, integer *, complex *, integer *);

#define dgeqpb FORTRAN_WRAPPER(dgeqpb)
int dgeqpb(integer *, integer *, integer *,
        integer *, doublereal *, integer *, doublereal *, integer *,
        integer *, doublereal *, doublereal *, integer *, doublereal *,
        doublereal *, integer *, integer *);

#define dgeqpc FORTRAN_WRAPPER(dgeqpc)
int dgeqpc(integer *, integer *, integer *,
        integer *, doublereal *, integer *, doublereal *, integer *,
        integer *, integer *, doublereal *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublereal *,
        doublereal *, integer *);

#define dgeqpw FORTRAN_WRAPPER(dgeqpw)
int dgeqpw(integer *, integer *, integer *,
        integer *, integer *, doublereal *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublereal *,
        doublereal *, doublereal *);

#define dgeqpx FORTRAN_WRAPPER(dgeqpx)
int dgeqpx(integer*, integer*, integer*, integer*, doublereal*,
        integer*, doublereal*, integer*, integer*, doublereal*,
        doublereal*, integer*, doublereal*, doublereal*, integer*,
        integer*);

#define dgeqpy FORTRAN_WRAPPER(dgeqpy)
int dgeqpy(integer*, integer*, integer*, integer*, doublereal*,
        integer*, doublereal*, integer*, integer*, doublereal*,
        doublereal*, integer*, doublereal*, doublereal*, integer*,
        integer*);

#define dlasmx FORTRAN_WRAPPER(dlasmx)
doublereal dlasmx(integer *);

#define dlauc1 FORTRAN_WRAPPER(dlauc1)
logical dlauc1(integer *, doublereal *, doublereal *, doublereal *,
        doublereal *, doublereal *);

#define dtrqpx FORTRAN_WRAPPER(dtrqpx)
int dtrqpx(integer *, integer *, integer *, integer *,
        doublereal *, integer *, doublereal *, integer *, integer *,
        doublereal *, doublereal *, integer *, doublereal *, doublereal *,
        integer *, integer *);

#define dtrqpy FORTRAN_WRAPPER(dtrqpy)
int dtrqpy(integer *, integer *, integer *, integer *,
        doublereal *, integer *, doublereal *, integer *, integer *,
        doublereal *, doublereal *, integer *, doublereal *, doublereal *,
        integer *, integer *);

#define dtrqxc FORTRAN_WRAPPER(dtrqxc)
int dtrqxc(integer *, integer *, integer *, integer *, doublereal *,
        integer*, doublereal *, integer *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublereal *, integer *);

#define dcniif FORTRAN_WRAPPER(dcniif)
int dcniif(integer *, integer *, integer *, integer *,
        doublereal *, integer *, doublereal *, integer *, integer *,
        doublereal *, doublereal *, integer *, logical *, doublereal *,
        integer *);

#define dglbif FORTRAN_WRAPPER(dglbif)
int dglbif(integer *, integer *, integer *, integer *,
        doublereal *, integer *, doublereal *, integer *, integer *,
        doublereal *, integer *, logical *, doublereal *, integer *);

#define dgret FORTRAN_WRAPPER(dgret)
int dgret(integer *, integer *, integer *, integer *,
        doublereal *, integer *, doublereal *, integer *,
        doublereal *, integer *);

#define dhess FORTRAN_WRAPPER(dhess)
int dhess(integer *, integer *, integer *, integer *,
       doublereal *, integer *, doublereal *, integer *,
       doublereal *, integer *);

#define dtrqyc FORTRAN_WRAPPER(dtrqyc)
int dtrqyc(integer *, integer *, integer *, integer *, doublereal *,
        integer*, doublereal *, integer *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublereal *, integer *);

#define dtrrnk FORTRAN_WRAPPER(dtrrnk)
int dtrrnk(integer *, doublereal *, integer *,
        doublereal *, integer *, doublereal *, integer *);

#define sgeqpb FORTRAN_WRAPPER(sgeqpb)
int sgeqpb(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, real *, real *, integer *,
        real *, real *, integer *, integer *);

#define sgeqpc FORTRAN_WRAPPER(sgeqpc)
int sgeqpc(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, integer *, real *,
        integer *, integer *, real *, real *, real *, real *, real *, integer *);

#define sgeqpw FORTRAN_WRAPPER(sgeqpw)
int sgeqpw(integer *, integer *, integer *, integer *,
        integer *, real *, integer *, integer *, real *, real *, real *,
        real *, real *, real *);

#define sgeqpx FORTRAN_WRAPPER(sgeqpx)
int sgeqpx(integer*, integer*, integer*, integer*, real*, integer*,
        real*, integer*, integer*, real*, real*, integer*, real*, real*,
        integer*, integer*);

#define sgeqpy FORTRAN_WRAPPER(sgeqpy)
int sgeqpy(integer*, integer*, integer*, integer*, real*, integer*,
        real*, integer*, integer*, real*, real*, integer*, real*, real*,
        integer*, integer*);

#define slasmx FORTRAN_WRAPPER(slasmx)
doublereal slasmx(integer *);

#define slauc1 FORTRAN_WRAPPER(slauc1)
logical slauc1(integer *, real *, real *, real *, real *, real *);

#define strqpx FORTRAN_WRAPPER(strqpx)
int strqpx(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, real *, real *, integer *,
        real *, real *, integer *, integer *);

#define strqpy FORTRAN_WRAPPER(strqpy)
int strqpy(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, real *, real *, integer *,
        real *, real *, integer *, integer *);

#define strqxc FORTRAN_WRAPPER(strqxc)
int strqxc(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, integer *, real *,
        real *, real *, real *, integer *);

#define sglbif FORTRAN_WRAPPER(sglbif)
int sglbif(integer *, integer *, integer *, integer *,
        real *, integer *, real *, integer *, integer *,
        real *, integer *, logical *, real *, integer *);

#define scniif FORTRAN_WRAPPER(scniif)
int scniif(integer *, integer *, integer *, integer *,
        real *, integer *, real *, integer *, integer *,
        real *, real *, integer *, logical *, real *, integer *);

#define sgret FORTRAN_WRAPPER(sgret)
int sgret(integer *, integer *, integer *, integer *,
        real *, integer *, real *, integer *, real *, integer *);

#define shess FORTRAN_WRAPPER(shess)
int shess(integer *, integer *, integer *, integer *,
        real *, integer *, real *, integer *, real *, integer *);

#define strqyc FORTRAN_WRAPPER(strqyc)
int strqyc(integer *, integer *, integer *, integer *, real *,
        integer *, real *, integer *, integer *, integer *, real *,
        real *, real *, real *, integer *);

#define strrnk FORTRAN_WRAPPER(strrnk)
int strrnk(integer *, real *, integer *, real *,
        integer *, real *, integer *);

#define zgeqpb FORTRAN_WRAPPER(zgeqpb)
int zgeqpb(integer *, integer *, integer *, integer *, doublecomplex *,
        integer *, doublecomplex *, integer *, integer *, doublereal *,
        doublereal *, integer *, doublereal *, doublecomplex *, integer *,
        doublereal *, integer *);

#define zgeqpc FORTRAN_WRAPPER(zgeqpc)
int zgeqpc(integer *, integer *, integer *, integer *, doublecomplex *,
        integer *, doublecomplex *, integer *, integer *, integer *, doublereal *,
        integer *, integer *, doublecomplex *, doublecomplex *, doublereal *, doublereal *,
        doublecomplex *, integer *, doublereal *);

#define zgeqpw FORTRAN_WRAPPER(zgeqpw)
int zgeqpw(integer *, integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, integer *, doublereal *, doublecomplex *,
        doublereal *, doublereal *, doublecomplex *, doublecomplex *, doublereal *);

#define zgeqpx FORTRAN_WRAPPER(zgeqpx)
int zgeqpx(integer*, integer*, integer*, integer*, doublecomplex*,
        integer*, doublecomplex*, integer*, integer*, doublereal*,
        doublereal*, integer*, doublereal*, doublecomplex*, integer*,
        doublereal*, integer*);

#define zgeqpy FORTRAN_WRAPPER(zgeqpy)
int zgeqpy(integer*, integer*, integer*, integer*, doublecomplex*,
        integer*, doublecomplex*, integer*, integer*, doublereal*,
        doublereal*, integer*, doublereal*, doublecomplex*, integer*,
        doublereal*, integer*);

#define zlasmx FORTRAN_WRAPPER(zlasmx)
doublereal zlasmx(integer *i);

#define zlauc1 FORTRAN_WRAPPER(zlauc1)
logical zlauc1(integer *, doublecomplex *, doublereal *,
        doublecomplex *, doublecomplex *, doublereal *);

#define ztrqpx FORTRAN_WRAPPER(ztrqpx)
int ztrqpx(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, doublecomplex *, integer*,
        integer *, doublereal *, doublereal *, integer *, doublereal *,
        doublecomplex *, doublereal *, integer *);

#define ztrqpy FORTRAN_WRAPPER(ztrqpy)
int ztrqpy(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, doublecomplex *, integer*,
        integer *, doublereal *, doublereal *, integer *, doublereal *,
        doublecomplex *, doublereal *, integer *);

#define ztrqxc FORTRAN_WRAPPER(ztrqxc)
int ztrqxc(integer *, integer *, integer *, integer *, doublecomplex *,
        integer *, doublecomplex *, integer *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublecomplex *,
        doublereal *, integer *);

#define zcniif FORTRAN_WRAPPER(zcniif)
int zcniif(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, doublecomplex *, integer *, integer *,
        doublereal *, doublereal *, integer *, logical *, doublecomplex *,
        doublereal *, integer *);

#define zglbif FORTRAN_WRAPPER(zglbif)
int zglbif(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, doublecomplex *, integer *, integer *,
        doublereal *, integer *, logical *, doublecomplex *, doublereal *,
        integer *);

#define zgret FORTRAN_WRAPPER(zgret)
int zgret(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *,doublecomplex *, integer *,
        doublecomplex *, doublereal *, integer *);

#define dzhess FORTRAN_WRAPPER(dhess)
int zhess(integer *, integer *, integer *, integer *,
        doublecomplex *, integer *, doublecomplex *, integer *,
        doublecomplex *, doublereal *, integer *);

#define ztrqyc FORTRAN_WRAPPER(ztrqyc)
int ztrqyc(integer *, integer *, integer *, integer *, doublecomplex *,
        integer *, doublecomplex *, integer *, integer *, integer *,
        doublereal *, doublereal *, doublereal *, doublecomplex *,
        doublereal *, integer *);

#define ztrrnk FORTRAN_WRAPPER(ztrrnk)
int ztrrnk(integer *, doublecomplex *, integer *,
        doublereal *, integer *, doublecomplex *, integer *);