/*
Matrix multiplication.

Based on the amazing:
https://github.com/HandsOnOpenCL/Exercises-Solutions/tree/a908ac3f0fadede29f2735eb1264b0db7f4311a0/Solutions/Exercise08

The most basic / useful application where OpenCL might be faster than CPU.

TODO: make a SERIOUS matrix implementation. Also compare with existing SERIOUS CPU and GPU implementations:

- http://stackoverflow.com/questions/1907557/optimized-matrix-multiplication-in-c
- http://stackoverflow.com/questions/12289235/simple-and-fast-matrix-vector-multiplication-in-c-c
- https://www.quora.com/What-is-the-best-way-to-multiply-two-matrices-in-C++
- http://stackoverflow.com/questions/25900312/optimizing-batched-matrix-multiplication-opencl-code

Serious CPU implementation means it considers:

- caching
- SIMD

Articles:

- http://www.netlib.org/utk/papers/autoblock/node2.html
- http://codereview.stackexchange.com/questions/101144/simd-matrix-multiplication
*/

#include "common.h"

#include <cblas.h>
#include <clBLAS.h>

#define NELEMS(a) sizeof(a)/sizeof(a[0])
#define UNUSED(x) (void)(x)

/* TODO how to auto tune this?
 * GCC 6 was not smart enough to use widest type automatically:
 * anything larger than the widest type just dropped perf drastically. */
#define VECTOR_NELEMS 4
#define VECTOR_SIZEOF (VECTOR_NELEMS * sizeof(F))

typedef cl_float F;
typedef F Vec __attribute__ ((vector_size(VECTOR_SIZEOF)));
/* Stuff reused across OpenCL calls.
 * It would not be fair to consider their alocation time for each call,
 * as the functions will be called millions of times.
 *
 * TODO: also factor out the kernel compile time.
 * Currently recompiled every time.
 * Implementations already cache compiled kernels, but we would need
 * to call each function multiple times.
 * */
typedef struct {
    Common common;
    /* We only factor out the allocation of those buffers.
     * Data transfer time with clEnqueueWriteBuffer must still be considered. */
    cl_mem buf_a, buf_b, buf_c;
} Cache;
typedef void (*MatMul)(const F *A, const F *B, F *C, size_t n, Cache *cache);

void cl_buf_init(Cache *cache, size_t mat_sizeof) {
    cache->buf_a = clCreateBuffer(cache->common.context, CL_MEM_READ_ONLY, mat_sizeof, NULL, NULL);
    cache->buf_b = clCreateBuffer(cache->common.context, CL_MEM_READ_ONLY, mat_sizeof, NULL, NULL);
    cache->buf_c = clCreateBuffer(cache->common.context, CL_MEM_WRITE_ONLY, mat_sizeof, NULL, NULL);
}

void cl_buf_deinit(Cache *cache) {
    clReleaseMemObject(cache->buf_a);
    clReleaseMemObject(cache->buf_b);
    clReleaseMemObject(cache->buf_c);
}

/* No, this was not created for debugging, my code is flawless from the first try. */
void mat_print(const F *A, size_t n) {
    size_t i, j;
    for (i = 0; i < n; ++i) {
        for (j = 0; j < n; ++j) {
            printf("%f ", A[i*n+j]);
        }
        puts("");
    }
}

/* Zero a matrix. */
void mat_zero(F *A, size_t n) {
    size_t i, n2;
    n2 = n*n;
    for (i = 0; i < n2; ++i) {
        A[i] = 0.0;
    }
}

/* Initialize a random matrix. */
void mat_rand(F *A, size_t n) {
    size_t i, n2;
    n2 = n*n;
    for (i = 0; i < n2; ++i) {
        A[i] = ((float)rand()) / ((float)RAND_MAX);
    }
}

/* Initialize a random matrix. */
void mat_trans(F *A, size_t n) {
    size_t i, j, i1, i2;
    F tmp;
    for (i = 0; i < n; ++i) {
        for (j = 0; j < i; ++j) {
            i1 = i*n+j;
            i2 = j*n+i;
            tmp = A[i1];
            A[i1] = A[i2];
            A[i2] = tmp;
        }
    }
}

/* Check if two matrices are equal with given mean squared err_maxor. */
int mat_eq(const F *A, const F *B, size_t n) {
    const F err_max = 10e-3;
    F err, diff, a, b;
    size_t i, i_max;

    err = 0.0;
    i_max = n*n;
    for (i = 0; i < i_max; ++i) {
        a = A[i];
        b = B[i];
        diff = a - b;
        err += diff * diff;
    }
    return (sqrt(err) / i_max) < err_max;
}

void mat_assert_eq(const F *A, const F *B, size_t n) {
    if (!mat_eq(A, B, n)) {
        puts("");
        mat_print(A, n);
        puts("");
        mat_print(B, n);
        assert(0);
    }
}

size_t zmin(size_t x, size_t y) {
    return (x < y) ? x : y;
}

/* C = A*B, width n, naive. */
void mat_mul_cpu(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    F tmp;
    size_t i, j, k;
    UNUSED(cache);

    for (i = 0; i < n; ++i) {
        for (j = 0; j < n; ++j) {
            tmp = 0.0;
            for (k = 0; k < n; ++k) {
                tmp += A[i*n+k] * B[k*n+j];
            }
            C[i*n+j] = tmp;
        }
    }
}

/* Transpose matrix B to increase cache hits. */
void mat_mul_cpu_trans(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    F tmp;
    size_t i, j, k;
    UNUSED(cache);

    mat_trans((F*)B, n);
    for (i = 0; i < n; ++i) {
        for (j = 0; j < n; ++j) {
            tmp = 0.0;
            for (k = 0; k < n; ++k) {
                tmp += A[i*n+k] * B[j*n+k];
            }
            C[i*n+j] = tmp;
        }
    }
    mat_trans((F*)B, n);
}

/* Zero vector. */
void vec_zero(Vec *vec, size_t vec_n) {
    size_t i;
    for (i = 0; i < vec_n; ++i) {
        (*vec)[i] = 0.0;
    }
}

/* Load vector from array. */
void vec_load(Vec *vec, size_t vec_n, const F* A, size_t A_base) {
    size_t i;
    for (i = 0; i < vec_n; ++i) {
        (*vec)[i] = A[A_base + i];
    }
}

/* Sum elements of the vector. */
F vec_sum(Vec vec, size_t vec_n) {
    size_t i;
    F sum;
    sum = 0.0;
    for (i = 0; i < vec_n; ++i) {
        sum += vec[i];
    }
    return sum;
}

/* Transpose matrix B to both:
 *
 * - increase cache hits
 * - simd GCC vector extensions which is made possible.
 *   by the transposition, to increase likelyhood of SIMDs.
 *
 * Note that GCC 6 O=3 is smart enough to use SIMD
 * even for the naive CPU method. However this was still way faster.
 * */
void mat_mul_cpu_trans_vec(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    F tmpf;
    size_t i, j, k, k_max, ai, bi;
    Vec tmp, a, b;
    UNUSED(cache);

    mat_trans((F*)B, n);
    k_max = (n / VECTOR_NELEMS) * VECTOR_NELEMS;
    for (i = 0; i < n; ++i) {
        for (j = 0; j < n; ++j) {
            vec_zero(&tmp, VECTOR_NELEMS);
            for (k = 0; k < k_max; k += VECTOR_NELEMS) {
                ai = i * n + k;
                bi = j * n + k;
                vec_load(&a, VECTOR_NELEMS, A, ai);
                vec_load(&b, VECTOR_NELEMS, B, bi);
                tmp += a * b;
            }
            tmpf = 0.0;
            for (; k < n; ++k) {
                tmpf += A[i*n+k] * B[j*n+k];
            }
            C[i*n+j] = vec_sum(tmp, VECTOR_NELEMS) + tmpf;
        }
    }
    mat_trans((F*)B, n);
}

/* Blocked matrix multiplication.
 * TODO slower than transpose, sometimes similar timing to naive.
 * Why do they say that this is better?
 * */
void mat_mul_cpu_block(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    size_t ib, jb, kb, i, j, k, i_max, j_max, k_max, nb ;
    F tmp;
    UNUSED(cache);

    nb = lround(sqrt(n));
    for (ib = 0; ib < n; ib += nb) {
        i_max = zmin(ib + nb, n);
        for (jb = 0; jb < n; jb += nb) {
            k_max = zmin(jb + nb, n);
            for (kb = 0; kb < n; kb += nb) {
                j_max = zmin(kb + nb, n);

                /* TODO would be cool to recurse here, but would require more offset parameters,
                 * likely similar to tose of CBLAS. */
                for (i = ib; i < i_max; ++i) {
                    for (j = kb; j < j_max; ++j) {
                        tmp = 0.0;
                        for (k = jb; k < k_max; ++k) {
                            tmp += A[i*n+k] * B[k*n+j];
                        }
                        C[i*n+j] += tmp;
                    }
                }
            }
        }
    }
}

/* The golden single thread CPU standard. */
void mat_mul_cpu_cblas(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    UNUSED(cache);
    cblas_sgemm(
        CblasRowMajor,
        CblasNoTrans,
        CblasNoTrans,
        n,
        n,
        n,
        1.0,
        A,
        n,
        B,
        n,
        0.0,
        C,
        n
    );
}

/* Simplest possible CL implementation. No speedup. */
void mat_mul_cl(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    cl_uint ncl;
    size_t global_work_size[2], mat_sizeof;

    /* Setup variables. */
    global_work_size[0] = n;
    global_work_size[1] = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    common_create_kernel_file(&cache->common, "matmul.cl", NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, sizeof(ncl), &ncl);
    clEnqueueNDRangeKernel(cache->common.command_queue, cache->common.kernel, 2, NULL, global_work_size, NULL, 0, NULL, NULL);
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

/* Cache rows in private memory. Drastic speedups expected over naive CPU. */
void mat_mul_cl_row_priv(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    char options[256];
    cl_uint ncl;
    size_t global_work_size, mat_sizeof;

    /* Setup variables. */
    global_work_size = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    snprintf(options, sizeof(options), "-DPRIV_ROW_SIZE=%ju", n);
    common_create_kernel_file(&cache->common, "matmul_row_priv.cl", options);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, sizeof(ncl), &ncl);
    clEnqueueNDRangeKernel(cache->common.command_queue, cache->common.kernel, 1, NULL, &global_work_size, NULL, 0, NULL, NULL);
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

/* Let's see if this is any different from local memory.
 * Outcome: much slower than private memory, slower than naive method. */
void mat_mul_cl_row_local(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    cl_uint ncl;
    size_t global_work_size, local_work_size, mat_sizeof;

    /* Setup variables. */
    /* Cannot be larger than 1 on this example, otherwise memory conflicts
     * will happen between work items. */
    local_work_size = 1;
    global_work_size = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    common_create_kernel_file(&cache->common, "matmul_row_local.cl", NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, n * sizeof(F), NULL);
    clSetKernelArg(cache->common.kernel, 4, sizeof(ncl), &ncl);
    clEnqueueNDRangeKernel(cache->common.command_queue, cache->common.kernel, 1, NULL, &global_work_size, &local_work_size, 0, NULL, NULL);
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

/* Like row private, but to reduce global memory accesses,
 * we copy only once per work group to local memory.
 *
 * Each work group contains a few rows of A.
 *
 * We load the first column, multiply all rows by that column, synrhconize,
 * load another column, and so on.
 *
 * This leads to a thread blockage / memory access tradeoff.
 *
 * We make work groups as large as possible to reload memory less times. */
void mat_mul_cl_row_priv_col_local(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    char options[256];
    cl_uint ncl;
    size_t global_work_size, local_work_size, mat_sizeof;

    /* Setup variables. */
    global_work_size = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    snprintf(options, sizeof(options), "-DPRIV_ROW_SIZE=%ju", n);
    common_create_kernel_file(&cache->common, "matmul_row_priv_col_local.cl", options);
    local_work_size = 0;
    clGetDeviceInfo(cache->common.device, CL_DEVICE_MAX_WORK_GROUP_SIZE, sizeof(local_work_size), &local_work_size, NULL);
    local_work_size = zmin(local_work_size, n);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, n * sizeof(F), NULL);
    clSetKernelArg(cache->common.kernel, 4, sizeof(ncl), &ncl);
    clEnqueueNDRangeKernel(cache->common.command_queue, cache->common.kernel, 1, NULL, &global_work_size, &local_work_size, 0, NULL, NULL);
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

/* Copy as many cols from B as possibl to the local memory, only then start multiplying.
 * This leads to less memory barrier hits.
 * How many rows we copy is limited by the local memory size, ideally the entire matrix will fit. */
void mat_mul_cl_row_priv_cols_local(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    char options[256];
    cl_uint ncl, n_local_cols;
    cl_ulong local_mem_size;
    size_t col_size, global_work_size, local_work_size, mat_sizeof;

    /* Setup variables. */
    col_size = n * sizeof(F);
    global_work_size = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    snprintf(options, sizeof(options), "-DPRIV_ROW_SIZE=%ju", n);
    common_create_kernel_file(&cache->common, "matmul_row_priv_cols_local.cl", options);
    local_work_size = 0;
    clGetDeviceInfo(cache->common.device, CL_DEVICE_MAX_WORK_GROUP_SIZE, sizeof(local_work_size), &local_work_size, NULL);
    local_work_size = zmin(local_work_size, n);
    local_mem_size = 0;
    clGetDeviceInfo(cache->common.device, CL_DEVICE_LOCAL_MEM_SIZE, sizeof(local_mem_size), &local_mem_size, NULL);
    /* TODO: can blow up without that - 1. Why?
     * It only reaches the max without it, not crosses, right?
     * So bug in the kernel? */
    n_local_cols = zmin(local_mem_size / col_size, n) - 1;
    /*puts("");*/
    /*printf("max memory %llu\n", (unsigned long long)local_mem_size);*/
    /*printf("n_local_cols %llu\n", (unsigned long long)n_local_cols);*/
    /*printf("memory %llu\n", (unsigned long long)n_local_cols * n * sizeof(F));*/
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, n_local_cols * col_size, NULL);
    clSetKernelArg(cache->common.kernel, 4, sizeof(ncl), &ncl);
    clSetKernelArg(cache->common.kernel, 5, sizeof(n_local_cols), &n_local_cols);
    clEnqueueNDRangeKernel(cache->common.command_queue, cache->common.kernel, 1, NULL, &global_work_size, &local_work_size, 0, NULL, NULL);
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

void mat_mul_cl_block(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    cl_uint ncl, nblkcl;
    size_t global_work_size[2], local_work_size[2], mat_sizeof, nblk;

    /* Setup variables. */
    global_work_size[0] = n;
    global_work_size[1] = n;
    mat_sizeof = n * n * sizeof(F);
    ncl = n;

    /* Run kernel. */
    common_create_kernel_file(&cache->common, "matmul_block.cl", NULL);
    clGetDeviceInfo(cache->common.device, CL_DEVICE_MAX_WORK_GROUP_SIZE, sizeof(nblk), &nblk, NULL);
    nblk = sqrt(zmin(nblk, n));
    nblk = zmin(nblk, 3);
    nblkcl = nblk;
    local_work_size[0] = nblk;
    local_work_size[1] = nblk;
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clSetKernelArg(cache->common.kernel, 0, sizeof(cache->buf_a), &cache->buf_a);
    clSetKernelArg(cache->common.kernel, 1, sizeof(cache->buf_b), &cache->buf_b);
    clSetKernelArg(cache->common.kernel, 2, sizeof(cache->buf_c), &cache->buf_c);
    clSetKernelArg(cache->common.kernel, 3, nblk * nblk * sizeof(F), NULL);
    printf("nblk = %llu\n", (unsigned long long)nblk);
    printf("local memory = %llu\n", (unsigned long long)2 * nblk * nblk * sizeof(F));
    clSetKernelArg(cache->common.kernel, 4, nblk * nblk * sizeof(F), NULL);
    clSetKernelArg(cache->common.kernel, 5, sizeof(ncl), &ncl);
    clSetKernelArg(cache->common.kernel, 6, sizeof(nblkcl), &nblkcl);
    clEnqueueNDRangeKernel(
        cache->common.command_queue, cache->common.kernel, 2, NULL,
        global_work_size, local_work_size, 0, NULL, NULL
    );
    clFlush(cache->common.command_queue);
    clFinish(cache->common.command_queue);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

void mat_mul_cl_clblas(const F *A, const F *B, F *C, size_t n, Cache *cache) {
    cl_event event;
    size_t mat_sizeof;

    mat_sizeof = n * n * sizeof(F);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_a, CL_TRUE, 0, mat_sizeof, (F*)A, 0, NULL, NULL);
    clEnqueueWriteBuffer(cache->common.command_queue, cache->buf_b, CL_TRUE, 0, mat_sizeof, (F*)B, 0, NULL, NULL);
    clblasSgemm(
        clblasRowMajor,
        clblasNoTrans,
        clblasNoTrans,

        n,
        n,
        n,
        1.0,

        cache->buf_a,
        0,
        n,

        cache->buf_b,
        0,
        n,

        0.0,
        cache->buf_c,
        0,
        n,

        1,
        &(cache->common.command_queue),
        0,
        NULL,
        &event
    );
    clWaitForEvents(1, &event);
    clEnqueueReadBuffer(cache->common.command_queue, cache->buf_c, CL_TRUE, 0, mat_sizeof, C, 0, NULL, NULL);
}

double bench(MatMul f, const F *A, const F *B, F *C, F *C_ref, size_t n, Cache *cache) {
    double dt, time;
    mat_zero(C, n);
    time = common_get_nanos();
    f(A, B, C, n, cache);
    dt = common_get_nanos() - time;
    if (C_ref != NULL)
        mat_assert_eq(C, C_ref, n);
    printf("%.3e ", dt);
    fflush(stdout);
    return dt;
}

int main(int argc, char **argv) {
    srand(time(NULL));
    Cache cache;
    double max_runtime;
    /* Overly slow ones commented out by default. */
    MatMul mat_mul_funcs[] = {
        /*mat_mul_cpu,*/
        mat_mul_cpu_trans,
        mat_mul_cpu_trans_vec,
        mat_mul_cpu_block,
        mat_mul_cpu_cblas,
        /*mat_mul_cl,*/
        mat_mul_cl_row_priv,
        mat_mul_cl_row_local,
        mat_mul_cl_row_priv_col_local,
        mat_mul_cl_row_priv_cols_local,
        /* TODO broken for larger matrics, some cells contain trash.
         * Likey some memory overflow problem. */
        /*mat_mul_cl_block,*/
        mat_mul_cl_clblas,
    };
    int first, func_done[NELEMS(mat_mul_funcs)] = {0};
    size_t f, i;
    size_t mat_sizeof;

    /* CLI args. */
    if (argc > 1) {
        max_runtime = strtod(argv[1], NULL);
    } else {
        max_runtime = 1.0;
    }

    common_init(&(cache.common), NULL);

    /* Unit test 2x2. */
    {
        const F A[] = {
            1.0, 2.0,
            3.0, 4.0
        };
        const F B[] = {
            5.0, 6.0,
            7.0, 8.0
        };
        enum N { n = 2 };
        F C[n*n];
        const F C_ref[] = {
            19.0, 22.0,
            43.0, 50.0
        };
        cl_buf_init(&cache, n * n * sizeof(F));
        for (f = 0; f < sizeof(mat_mul_funcs)/sizeof(mat_mul_funcs[0]); ++f) {
            mat_zero(C, n);
            mat_mul_funcs[f](A, B, C, n, &cache);
            mat_assert_eq(C, C_ref, n);
        }
        cl_buf_deinit(&cache);
    }

    /* Unit test 4x4. */
    {
        const F A[] = {
             1.0,  2.0,  3.0,  4.0,
             5.0,  6.0,  7.0,  8.0,
             9.0, 10.0, 11.0, 12.0,
            13.0, 14.0, 15.0, 16.0,
        };
        const F B[] = {
            17.0, 18.0, 19.0, 20.0,
            21.0, 22.0, 23.0, 24.0,
            25.0, 26.0, 27.0, 28.0,
            29.0, 30.0, 31.0, 32.0,
        };
        const F C_ref[] = {
             250.0,  260.0,  270.0,  280.0,
             618.0,  644.0,  670.0,  696.0,
             986.0, 1028.0, 1070.0, 1112.0,
            1354.0, 1412.0, 1470.0, 1528.0,
        };
        enum N { n = 4 };
        F C[n*n];
        cl_buf_init(&cache, n * n * sizeof(F));
        for (f = 0; f < NELEMS(mat_mul_funcs); ++f) {
            mat_zero(C, n);
            mat_mul_funcs[f](A, B, C, n, &cache);
            mat_assert_eq(C, C_ref, n);
        }
        cl_buf_deinit(&cache);
    }

    /* Benchmarks. */
    {
        double dt;
        F *A = NULL, *B = NULL, *C = NULL, *C_ref = NULL, *dst = NULL, *ref = NULL;
        int done;
        size_t n = 2;

        puts("#matmul");
        done = 0;
        while(1) {
            printf("%zu ", (size_t)log2(n));
            mat_sizeof = n * n * sizeof(F);

            /* CPU setup. */
            A = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
            B = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
            C = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
            C_ref = aligned_alloc(VECTOR_SIZEOF, mat_sizeof);
            if (NULL == A || NULL == B || NULL == C) {
                printf("error: could not allocate memory for n = %zu", n);
                break;
            }
            mat_rand(A, n);
            mat_rand(B, n);

            cl_buf_init(&cache, mat_sizeof);
            first = 1;
            for (f = 0; f < NELEMS(mat_mul_funcs); ++f) {
                if (func_done[f]) {
                    printf("%*s", 10, "");
                } else {
                    if (first) {
                        dst = C_ref;
                        ref = NULL;
                        first = 0;
                    } else {
                        dst = C;
                        ref = C_ref;
                    }
                    dt = bench(mat_mul_funcs[f], A, B, dst, ref, n, &cache);
                    if (dt > max_runtime)
                        func_done[f] = 1;
                }
            }
            puts("");
            done = 1;
            for (i = 0; i < NELEMS(mat_mul_funcs); ++i) {
                if (!func_done[i]) {
                    done = 0;
                    break;
                }
            }
            if (done)
                break;
            n *= 2;

            /* CPU deinit. */
            free(A);
            free(B);
            free(C);
            free(C_ref);

            cl_buf_deinit(&cache);
        }
        common_deinit(&cache.common);
    }

    return EXIT_SUCCESS;
}


#if !defined (RAND_H)
#define RAND_H

#include <cstdlib>
#include <iostream>
#include <cmath>
#include <vector>
#include <list>
#include <set>
#include <limits>
#include <algorithm>

#include <gsl/gsl_sf_zeta.h>

using namespace std;

const double TOLERANCE = numeric_limits<double>::epsilon();
const int    INTMAX    = numeric_limits<int>::max();

const int BIGPRIME = 899999963;
const double PI    = 3.1415926535897932384626433832795028841971693993751;

typedef double (*FUNC)(const double, const double, const double);
inline double fx(const double htilde, const double y, const double u)
{
  return (pow(htilde,y+1) - (y+1)*htilde + fabs(2*u-1)*y);
}

inline int Getnode(list<int>& X, int index)
{
  int pos=0;
  for(list<int>::iterator p = X.begin(); p!= X.end(); p++, pos++) {
    if(pos==index)
      return (*p);
  }

  return -1;
}

class Rand {
  double c,cd,cm,u[97];
  int i97,j97 ;
  bool outputReady;
  double output;

  int idum;

 public:
  Rand(int seed) {
    ranmarin(fabs(seed%BIGPRIME));
    outputReady=false;
    idum=-1*seed;

    flag_setFvector = false;
    flag_setPvector = false;
  }

  Rand() {
    ranmarin(1);
    outputReady=false;
    idum=-1;

    flag_setFvector = false;
    flag_setPvector = false;
  }

  void seed(int seed) {
    ranmarin(fabs(seed%BIGPRIME));
    outputReady=false;
    idum=-1*seed;

    flag_setFvector = false;
    flag_setPvector = false;
  }

  double ran() { return rand()/(double)RAND_MAX;}

  double uniform()
  {
    double uni;

    uni=u[i97]-u[j97];
    if (uni<0.0) uni+=1.0;
    u[i97]=uni;
    if (--i97<0) i97=96;
    if (--j97<0) j97=96;
    c-=cd;
    if (c<0.0) c+=cm;
    uni-=c;
    if (uni<0.0) uni+=1.0;
    return(uni);
  }

  double ran1()
  {
    const int IA=16807,IM=2147483647,IQ=127773,IR=2836,NTAB=32;
    const int NDIV=(1+(IM-1)/NTAB);
    const double EPS=3.0e-16,AM=1.0/IM,RNMX=(1.0-EPS);
    static int iy=0;
    static vector<int> iv(NTAB);
    int j,k;
    double temp;

    if (idum <= 0 || !iy) {
      if (-idum < 1) idum=1;
      else idum = -idum;
      for (j=NTAB+7;j>=0;j--) {
	k=idum/IQ;
	idum=IA*(idum-k*IQ)-IR*k;
	if (idum < 0) idum += IM;
	if (j < NTAB) iv[j] = idum;
      }
      iy=iv[0];
    }
    k=idum/IQ;
    idum=IA*(idum-k*IQ)-IR*k;
    if (idum < 0) idum += IM;
    j=iy/NDIV;
    iy=iv[j];
    iv[j] = idum;
    if ((temp=AM*iy) > RNMX) return RNMX;
    else return temp;
  }

  int discrete(int min, int max)
  {
    int ret= (int)(floor(ran1()*(max+1-min)+min));
    return ret;
  }

  void discrete(int min, int max, int& a, int& b)
  {
    a = (int)(floor(ran1()*(max+1-min)+min));

    do {
      b = (int)(floor(ran1()*(max+1-min)+min));
    } while (a==b);

  }

  void discrete(int min, int max, int& a, int& b, int& c)
  {
    a = (int)(floor(ran1()*(max+1-min)+min));

    do {
      b = (int)(floor(ran1()*(max+1-min)+min));
    } while (b==a);

    do {
      c = (int)(floor(ran1()*(max+1-min)+min));
    } while (c==b || c==a);

  }

  void discrete(int min, int max, int& a, int& b, int& c, int& d)
  {
    a = (int)(floor(ran1()*(max+1-min)+min));

    do {
      b = (int)(floor(ran1()*(max+1-min)+min));
    } while (b==a);

    do {
      c = (int)(floor(ran1()*(max+1-min)+min));
    } while (c==b || c==a);

    do {
      d = (int)(floor(ran1()*(max+1-min)+min));
    } while (d==c || d==b || d==a);

  }

  void discrete(int min, int max, int n, set<int>& Set)
  {
    Set.clear();
    for(int i=0; i<n; ) {
      int a = (int)(floor(ran1()*(max+1-min)+min));
      if(Set.find(a)==Set.end()) {
	Set.insert(a);
	i++;
      }
    }
  }

  void discrete(int min, int max, int n, vector<int>& Vec)
  {
    set<int> Set;

    Vec.clear();
    for(int i=0; i<n; ) {
      int a = (int)(floor(ran1()*(max+1-min)+min));
      if(Set.find(a)==Set.end()) {
	Set.insert(a);
	Vec.push_back(a);
	i++;
      }
    }
  }

  int discrete_logbin(int xmin, int xmax)
  {
    double ratio = 1.15;
    if (xmin==0)
      xmin=1;

    int Nbins = (int)(floor(log(xmax/xmin)/log(ratio))) + 1;
    int i = discrete(0, Nbins-1);
    int a = xmin * pow(ratio, (double)i);
    int b = a*ratio;
    if(b>xmax)
      b = xmax;

    int x = discrete(a,b);
    return x;
  }

  void randomsubset(int N, int Nc, vector<int>& S)
  {
    list<int> Lbig;
    for(int i=0; i<N; i++) {
      Lbig.push_back(i);
    }

    int N0= N;
    int M = (2*Nc>N0) ? (N0-Nc) : Nc;

    list<int> Lsmall;
    for(int i=0; i<M; i++) {
      int index = discrete(0, N-1);

      int j = Getnode(Lbig, index);
      Lsmall.push_back(j);
      Lbig.remove(j);
      N--;
    }

    S.clear();
    S.resize(Nc);

    if(2*Nc>N0)
      copy(Lbig.begin(), Lbig.end(), S.begin());
    else
      copy(Lsmall.begin(), Lsmall.end(), S.begin());

  }

  void randomsubset_knuth(int n, int m, vector<int>& S)
  {
    for (int i = 0; i < n; i++)
      if ((discrete(1,n) % (n-i)) < m) {
	S.push_back(i);
	m--;
      }
  }

  void randomsubset_shuf(int n, int m, vector<int>& S)
  {
    int i,j,t;
    vector<int> x(n);
    for (i = 0; i < n; i++)
      x[i] = i;
    for (i = 0; i < m; i++) {
      j = discrete(i, n-1);
      t = x[i];
      x[i] = x[j];
      x[j] = t;
    }
    sort(x.begin(), x.begin()+m);
    for (i = 0; i< m; i++)
      S.push_back(x[i]);
  }

  void randomsubset_shuffle(int n, int m, vector<int>& S)
  {
    vector<int> x(n);
    for(int i=0; i<n; i++)
      x[i] = i;

    random_shuffle(x.begin(), x.end());

    for (int i=0; i<m; i++)
      S.push_back(x[i]);
  }

  double gaussian(double sd)
  {
    double v1,v2,Rsq,z;
    if(outputReady)
      {
	outputReady = false;
	return output;
      }

    do
      {

	v1=(uniform()*2.0)-1.0;
	v2=(uniform()*2.0)-1.0;

	Rsq=v1*v1+v2*v2;
      } while (Rsq>=1.0);

    z=sqrt(-2.0*log(Rsq)/Rsq);
    output = v1*z*sd;
    outputReady=true;
    return v2*z*sd;
  }

  double lorentzian(double sd)
  {
    double v1,v2,z;
    do {
      v2 = uniform();
      v1 = 2.0 * uniform() - 1.0;
    } while ((v1*v1+v2*v2)>1.0);
    z = v2/v1;
    return sd*z/2.0;
  }

  double powerlaw_continuous(double alpha, double xmin)
  {
    return ( xmin*pow(1-ran1(), 1./(1-alpha) ) );
  }

  double powerlaw_continuous_interval(double a, double beta)
  {
    return pow( (1- (1-ran1())*(1-pow(a, 1-beta))), 1/(1-beta) );
  }

  int powerlaw_discrete_approximate(double alpha, double xmin)
  {
    double r = ran1();
    int k = (int)( (xmin-0.5)*pow(1-r, 1./(1-alpha) ) + 0.5 );
    if(k<0) {
      cout << 1-r << ',' << k << endl;
      k =  INTMAX;
    }
    return k;

  }

  int powerlaw_discrete(double alpha, int xmin)
  {
    if(!flag_setPvector)
      SetPvector(alpha,xmin);

    double r = ran1();
    int j = Findj(P, 1-r);
    return j;

  }

  int powerlaw_exponentialcutoff_discrete(double gamma, double kappa)
  {
    if(!flag_setPvector)
      SetPvector_SFEC(gamma, kappa);

    double r = ran1();

    int j = Findj(P, 1-r);
    return j;

  }

  int arbitrary_discrete(vector<double>& CDF)
  {
    double r = ran1();
    int j = Findj(CDF, r);
    return j+1;
  }

  int arbitrary_discrete(vector<long double>& CDF)
  {
    double r = ran1();
    int j = Findj(CDF, r);
    return j+1;
  }

  double lognormal(double sd)
  {
    double v1,v2,Rsq,z;
    if(outputReady)
      {
	outputReady = false;
	return output;
      }

    do
      {
	v1=(ran1()*2.0)-1.0;
	v2=(ran1()*2.0)-1.0;
	Rsq=v1*v1+v2*v2;
      } while (Rsq>=1.0);

    z=sqrt(-2.0*log(Rsq)/Rsq);
    output = exp(v1*z*sd);
    outputReady=true;
    return exp(v2*z*sd);
  }

  double bimodal(double R)
  {

    return (ran1()>0.5) ? (R) : (-R);
  }

  double rectangular(double R)
  {

    return ((ran1()*2-1)*R);
  }

  double parabolic(double R)
  {

    double x = ran1();

    int sign =  (x>0.5) ? (-1) : (+1);

    double R2 = R*R;
    double R3 = R2*R;

    double q     = 4*R3*(x-0.5);
    double p     = -3*R2;
    double Disc  = q*q/4. + p*p*p/27.;
    double r     = R3;
    double theta = atan(sqrt(-Disc)/(-q/2.));
    double ronethird = pow(r,1/3.);

    double h1 = sign * 2 * ronethird * cos(theta/3.);
    double h2 = sign * 2 * ronethird * cos((theta+2*PI)/3.);
    double h3 = sign * 2 * ronethird * cos((theta-2*PI)/3.);

    double y = 0;
    if(h1<R && h1>(-R))
      y = h1;
    else if(h2<R && h2>(-R))
      y = h2;
    else if(h3<R && h3>(-R))
      y = h3;
    else
      cout << "range is wrong!";

    return y;
  }

  double antiparabolic(double R)
  {

    double x = ran1();

    int sign =  (x>0.5) ? (+1) : (-1);

    double h = sign * pow(sign*(2*x-1),1./3.) * R;
    return h;
  }

  double DMI_lookuptable(double y, double R)

  {
    if(!flag_setFvector)
      SetFvector(y,R);

    double u = ran1();
    int j = Findj(F, u);
    double h = -R + j*dh;

    return h;
  }

  double DMI(double y, double R)
  {
    double u = ran1();
    int sign =  (u>0.5) ? (+1) : (-1);

    const double hacc = 1e-12;
    double htilde = rtbis(&fx, y, u, 0, 1, hacc);
    double h = sign*htilde*R;
    return h;
  }

  int exponential(double kappa)
  {
    double u = ran1();

    int k = -kappa * log(1-u);
    return k;
  }

 private:

  bool flag_setFvector;
  vector<double> F;
  double dh;

  double P_DMI(double h, double y, double R)
  {
    if(h<-R || h>R) return 0;
    else            return (y+1)/(2*y*R)*(1-pow(fabs(h)/R,y));
  }

  void SetFvector(double y, double R)
  {
    int N = 10000001;
    dh = R/(double)(N-1);
    F.resize(2*N-1,0);

    F[0]     = 0;
    F[2*N-2] = 1 - F[0];
    for(int i=1;i<N;i++)
      {
	double h1 = -R + i*dh;
	double h2 = h1 + dh;

	F[i]       = F[i-1] + 0.5* (P_DMI(h1,y,R)+P_DMI(h2,y,R))*dh;
	F[2*N-2-i] = 1- F[i];
      }

    flag_setFvector = true;
  }

  int Findj(vector<double>& xx, const double x)
  {
    int j,jl,jm,ju;
    int n=xx.size();

    jl=-1; ju=n;

    bool ascnd = (xx[n-1] >= xx[0]);
    while (ju-jl > 1)
      {
	jm=(ju+jl) >> 1;
	if ((x >= xx[jm]) == ascnd) jl=jm;
	else    	          ju=jm;
      }

    if (x == xx[0]) j=0;
    else if (x == xx[n-1]) j=n-2;
    else j=jl;

    return j;
  }

  int Findj(vector<long double>& xx, const double x)
  {
    int j,jl,jm,ju;
    int n=xx.size();

    jl=-1; ju=n;

    bool ascnd = (xx[n-1] >= xx[0]);
    while (ju-jl > 1)
      {
	jm=(ju+jl) >> 1;
	if ((x >= xx[jm]) == ascnd) jl=jm;
	else    	          ju=jm;
      }

    if (x == xx[0]) j=0;
    else if (x == xx[n-1]) j=n-2;
    else j=jl;

    return j;
  }

  double rtbis(FUNC func, const double y, const double u, const double x1, const double x2, const double xacc)
  {
    const int JMAX=40;
    int j;
    double dx,f,fmid,xmid,rtb;

    f=func(x1,y,u);
    fmid=func(x2,y,u);
    if (f*fmid >= 0.0)
      cout << "Root must be bracketed for bisection in rtbis\n";

    rtb = f < 0.0 ? (dx=x2-x1,x1) : (dx=x1-x2,x2);
    for (j=0;j<JMAX;j++) {
      fmid=func(xmid=rtb+(dx *= 0.5),y,u);
      if (fmid <= 0.0) rtb=xmid;
      if (fabs(dx) < xacc || fmid == 0.0) return rtb;
    }
    cout << "Too many bisections in rtbis\n";
    return 0.0;
  }

  void ranmarin(int ijkl)
  {
    int i,ii,j,jj,k,l,m ;
    double s,t ;

    int ij=ijkl/30082;
    int kl=ijkl-30082*ij;

    i=((ij/177)%177)+2 ;
    j=(ij%177)+2 ;
    k=((kl/169)%178)+1 ;
    l=kl%169 ;
    for (ii=0;ii<97;ii++) {
      s=0.0 ;
      t=0.5 ;
      for (jj=0;jj<24;jj++) {
	m=(((i*j)%179)*k)%179 ;
	i=j;
	j=k;
	k=m;
	l=(53*l+1)%169;
	if (((l*m)%64)>=32) s+=t;
	t*=0.5;
      }
      u[ii]=s;
    }
    c=362436.0/16777216.0;
    cd=7654321.0/16777216.0;
    cm=16777213.0/16777216.0;
    i97=96;
    j97=32;
  }

  bool flag_setPvector;
  vector<double> P;

  double Hzeta(double s, double q)
  {
    double sum = 0;
    double nterm = 0;
    int n;
    for(n=0; ;n++)
      {
	nterm = pow((n+q),-s);
	sum += nterm;

	if(fabs(nterm/sum) < TOLERANCE)
	  break;
      }
    cout << "nmax= " << n << endl;
    return sum;
  }

  void SetPvector(double alpha, int xmin)
  {

    double a = gsl_sf_hzeta(alpha, xmin);

    int N = 10000000+xmin;

    P.resize(N,2);

    P[xmin] = 1;
    for(int i=xmin;i<N-1;i++)
      {

	P[i+1] = P[i] - 1/(pow((double)i,alpha)*a);
      }

    flag_setPvector = true;
  }

double polylog(double s, double z)
{
  double sum = 0;
  double zn = z;
  int nmax = 1;
  for(int n=1; ; n++) {
    double term = zn/pow((double)n,s);
    sum += term;
    zn *= z;
    if(term < TOLERANCE) {
      nmax = n;
      break;
    }
  }

  return sum;
}

  void SetPvector_SFEC(double gamma, double kappa)
  {
    double enkappa= exp(-1/kappa);
    double C = polylog(gamma, enkappa);

    int N = 10000000;

    P.resize(N,2);

    P[1] = 1;
    double a = enkappa;
    for(int i=1;i<=N;i++) {
      P[i+1] = P[i] - pow((double)i,-gamma) * a/ C ;
      a *= enkappa;
    }

    flag_setPvector = true;
  }

};

#endif


/*
 * Library:  ransampl (random number sampling)
 *
 * File:     sampling1.c
 *
 * Contents: Draw samples from a given discrete probability distribution;
 *           specifically: draw representative inhabitants of the nine states
 *
 * Note:     Any modification of this example should be copied to
 *           the manual page source ransampl.pod and to the wiki.
 *
 * Author:   Joachim Wuttke 2013
 *
 * Licence:  see ../COPYING (FreeBSD)
 *
 * Homepage: apps.jcns.fz-juelich.de/ransampl
 */

#include <stdio.h>
#include <gsl/gsl_rng.h>
#include "ransampl.h"

#define RANSAMPL_SHALL_REVEAL_ITS_INTERNALS 1

int main()
{
    const int M=1000000;
    int i, m;

    // Discrete probability distribution example:
    const int n = 9;
    // states of Austria
    const char* names[] = {
        "Wien", "Niederoesterreich", "Oberoesterreich", "Tirol",
        "Kaernten", "Salzburg", "Vorarlberg", "Burgenland", "Steiermark" };
    // inhabitants in millions as of 2011 according to www.statistik.at
    double p[] = { 1.721573, 1.614661, 1.415020, .711161,
                   .558056, .532713, .370833, .285377, .1211506 };

    // Initialize random number generator:
    gsl_rng_env_setup();
    gsl_rng* rng = gsl_rng_alloc( gsl_rng_default );

    // Allocate workspace, and precompute tables:
    printf( "Precomputing tables ...\n" );
    ransampl_ws* ws = ransampl_alloc( n );
    ransampl_set( ws, p );

#ifdef RANSAMPL_SHALL_REVEAL_ITS_INTERNALS
    // Inspect tables:
    printf( "  %-3s  %-3s  %-9s\n", "i", "alias", "prob" );
    for ( int i=0; i<n; ++i )
        printf( "  %3i  %3i  %9.7f\n", i, ws->alias[i], ws->prob[i] );
#endif

    // Draw M random samples; accumulate statistic in histogram 'cumul':
    printf( "Drawing %i samples ...\n", M );
    double cumul[n];
    for ( i=0; i<n; ++i )
        cumul[i] = 0;
    for ( m=0; m<M; ++m ) {
        i = ransampl_draw( ws, gsl_rng_uniform(rng), gsl_rng_uniform(rng) );
        cumul[i] += 1;
    }

    // Print given probability and obtained frequency:
    printf( "Result (input->output):\n");
    double sum = 0;
    for ( int i=0; i<n; ++i )
        sum += p[i];
    printf( "  %-18s  %-9s  %-9s  %-9s\n", "state", "N (Mio.)", "rel", "sim" );
    for ( int i=0; i<n; ++i )
        printf( "  %-18s  %9.7f  %9.7f  %9.7f\n",
                names[i], p[i], p[i]/sum, ((double)cumul[i])/M );

    // Free workspace and terminate:
    ransampl_free( ws );
    return 0;
}


/* fft/gsl_fft_complex.h
 *
 * Copyright (C) 1996, 1997, 1998, 1999, 2000 Brian Gough
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or (at
 * your option) any later version.
 *
 * This program is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 */

#ifndef __GSL_FFT_COMPLEX_H__
#define __GSL_FFT_COMPLEX_H__

#include <stddef.h>

#include <gsl/gsl_math.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_fft.h>

#undef __BEGIN_DECLS
#undef __END_DECLS
#ifdef __cplusplus
# define __BEGIN_DECLS extern "C" {
# define __END_DECLS }
#else
# define __BEGIN_DECLS /* empty */
# define __END_DECLS /* empty */
#endif

__BEGIN_DECLS

/*  Power of 2 routines  */

int gsl_fft_complex_radix2_forward (gsl_complex_packed_array data,
                                    const size_t stride,
                                    const size_t n);

int gsl_fft_complex_radix2_backward (gsl_complex_packed_array data,
                                     const size_t stride,
                                     const size_t n);

int gsl_fft_complex_radix2_inverse (gsl_complex_packed_array data,
                                    const size_t stride,
                                    const size_t n);

int gsl_fft_complex_radix2_transform (gsl_complex_packed_array data,
                                      const size_t stride,
                                      const size_t n,
                                      const gsl_fft_direction sign);

int gsl_fft_complex_radix2_dif_forward (gsl_complex_packed_array data,
                                        const size_t stride,
                                        const size_t n);

int gsl_fft_complex_radix2_dif_backward (gsl_complex_packed_array data,
                                         const size_t stride,
                                         const size_t n);

int gsl_fft_complex_radix2_dif_inverse (gsl_complex_packed_array data,
                                        const size_t stride,
                                        const size_t n);

int gsl_fft_complex_radix2_dif_transform (gsl_complex_packed_array data,
                                          const size_t stride,
                                          const size_t n,
                                          const gsl_fft_direction sign);

int gsl_fft_complex_bitreverse_order (gsl_complex_packed_array data,
                                      size_t stride,
                                      size_t n,
                                      size_t n_bits);

/*  Mixed Radix general-N routines  */

typedef struct
  {
    size_t n;
    size_t nf;
    size_t factor[64];
    gsl_complex *twiddle[64];
    gsl_complex *trig;
  }
gsl_fft_complex_wavetable;

typedef struct
{
  size_t n;
  double *scratch;
}
gsl_fft_complex_workspace;

gsl_fft_complex_wavetable *gsl_fft_complex_wavetable_alloc (size_t n);

void gsl_fft_complex_wavetable_free (gsl_fft_complex_wavetable * wavetable);

gsl_fft_complex_workspace *gsl_fft_complex_workspace_alloc (size_t n);

void gsl_fft_complex_workspace_free (gsl_fft_complex_workspace * workspace);

int gsl_fft_complex_memcpy (gsl_fft_complex_wavetable * dest,
                            gsl_fft_complex_wavetable * src);

int gsl_fft_complex_forward (gsl_complex_packed_array data,
                             const size_t stride,
                             const size_t n,
                             const gsl_fft_complex_wavetable * wavetable,
                             gsl_fft_complex_workspace * work);

int gsl_fft_complex_backward (gsl_complex_packed_array data,
                              const size_t stride,
                              const size_t n,
                              const gsl_fft_complex_wavetable * wavetable,
                              gsl_fft_complex_workspace * work);

int gsl_fft_complex_inverse (gsl_complex_packed_array data,
                             const size_t stride,
                             const size_t n,
                             const gsl_fft_complex_wavetable * wavetable,
                             gsl_fft_complex_workspace * work);

int gsl_fft_complex_transform (gsl_complex_packed_array data,
                               const size_t stride, const size_t n,
                               const gsl_fft_complex_wavetable * wavetable,
                               gsl_fft_complex_workspace * work,
                               const gsl_fft_direction sign);

__END_DECLS

#endif /* __GSL_FFT_COMPLEX_H__ */


/**
* @file likelihood.c
* @brief base functions to calculate the likelihood for general multitype OU processes on a phylogenetic tree
* @author Carl Boettiger <cboettig@gmail.com>
* @version 0.1
* @date 2011-04-22
*
* @section LICENSE
*
* Copyright (C)
* 2011 - Carl Boettiger
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*
*/

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_linalg.h>
#include <gsl/gsl_errno.h>
#include "optimizers.h"
#include "mvn.h"

typedef struct {
	int n_nodes;
	size_t n_regimes;
	int * ancestor;
	int * regimes;
	double * branch_length;
	double * traits;
	double * alpha;
	double * theta;
	double * sigma;
	double * Xo;
	int * lca_matrix;
} tree;

int get_lca (int i, int j, int n_nodes, const int * ancestor,
             const double * branch_length, double * sep);

void simulate (const gsl_rng * rng, tree * mytree);

void calc_lik (const double *Xo, const double alpha[],
               const double theta[], const double sigma[],
               const int regimes[], const int ancestor[],
               const double branch_length[], const double traits[],
               int *n_nodes, int lca_matrix[], double *llik);


/**
 */
#include <math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_complex.h>
#include <gsl/gsl_complex_math.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_interp.h>
#include "aXe_utils.h"
#include "aXe_errors.h"
#include "fringe_conf.h"
#include "fringe_model.h"

#define MAX(x,y) (((x)>(y))?(x):(y))
#define MIN(x,y) (((x)<(y))?(x):(y))

/**
 * Function: compute_fringe_amplitude
 * The function computes the fringe image for a CCD setup stored
 * in a fringe configuration structure. This fringe configuration
 * structure completely describes the problem, and this function
 * executes the loops for every pixel over the wavelength
 * range spanned by the filter.
 *
 * Parameters
 * @param fconf - the fringe configuration structure
 *
 * Returns:
 * @return fringe_image - the image with the computed fringe amplitudes
 */
gsl_matrix  *
compute_fringe_amplitude(fringe_conf *fconf)
{
  gsl_matrix *fringe_image;

  gsl_vector **filter_vectors;

  int index=0;
  int ii=0;
  int jj=0;

  double lambda_mean;
  double pixel_ampl;
  //double phase_number;

  optical_property *optprops;

  // allocate the fringe image
  fringe_image = alloc_fringe_image(fconf->opt_layers);

  // allocate memory for the optical property structure
  optprops = alloc_optprops_list(fconf);

  // find the exact wavelength range,
  // and define the wavelength values and
  // normalized fiter throughput there
  filter_vectors = evaluate_wavelength_steps(fconf);
  //filter_vectors = get_PET_calibration_data();

  // compute the mean wavelength
  lambda_mean = gsl_vector_get(filter_vectors[0],filter_vectors[0]->size-1)/2.0
		 + gsl_vector_get(filter_vectors[0],0)/2.0;

  // initialize some values in the optical property list
  init_optprops_list(fconf, lambda_mean, optprops);

    for (ii=0; ii < (int)fringe_image->size1; ii++)
      //    for (ii=0; ii < 2; ii++)
    {
      fprintf(stderr, "Computing row No.: %i\n", ii);
            for (jj=0; jj < (int)fringe_image->size2; jj++)
	      //for (jj=0; jj < 2; jj++)
	{
	  // fill the optical thickness of the layers
	  // into the structure
	  fill_optprops_thickness(fconf->opt_layers, ii, jj, optprops);

	  pixel_ampl = 0.0;
	  for (index=0; index < (int)filter_vectors[0]->size; index++)
	    {
	      // fill all information in the optical
	      // property list
	      fill_optprops_all(fconf->opt_layers,
				gsl_vector_get(filter_vectors[0],index),
				optprops);

	      // compute and add the contribution at a wavelength
	      pixel_ampl += gsl_vector_get(filter_vectors[1],index)*
		fringe_contrib_single(optprops, fconf);
	    }

	  // finally set the pixel value
	  // in the output image
	  gsl_matrix_set(fringe_image, ii, jj,
			 fconf->fringe_amp * pixel_ampl + 1.0);
	}
    }

  // release the memory in the vectors
  gsl_vector_free(filter_vectors[0]);
  gsl_vector_free(filter_vectors[1]);
  free(filter_vectors);

  // free the optical property structure
  free_optprops_list(optprops);

  // return the fringe image
  return fringe_image;
}

/**
 * Function: alloc_fringe_image
 * The function browses through the the structure for the CCD layers
 * and extracts all information on image sizes stored there in
 * one or several thickness images. This information is checked
 * for consistency.
 * Finally, a matrix for a fringe image is allocated, initialized
 * and returned.
 *
 * Parameters:
 * @param opt_layers - the optical layers in the CCD
 *
 * Returns:
 * @return fringe_image - the allocated matrix for the fringe image
 */
gsl_matrix  *
alloc_fringe_image(const ccd_layers *opt_layers)
{
  int n1         = 0;
  int n2         = 0;
  int n1_new     = 0;
  int n2_new     = 0;
  int index      = 0;
  int is_defined = 0;

  gsl_matrix *fringe_image=NULL;
  // go through all CCD layers
  for (index=0; index < opt_layers->num_layers; index++)
    {
      // check whether the thickness information
      // is represented by an image
      if (opt_layers->opt_layer[index]->thickness2D != NULL)
	{

	  // mark that an image was found
	  is_defined=1;

	  // get the dimension of the image
	  n1_new = opt_layers->opt_layer[index]->thickness2D->size1;
	  n2_new = opt_layers->opt_layer[index]->thickness2D->size2;

	  // check the frst axix value against
	  // previous values, if possible
	  if (n1 && n1_new != n1)
	    // give an error if the new value is different
	    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
			 "Thickness image of layer %i "
			 "has %i pixels in first axis."
			 "This differs from the previous value %i\n",
			 index, n1_new, n1);
	  else
	    // store the new value
	    n1 = n1_new;

	  // check the frst axix value against
	  // previous values, if possible
	  if (n2 && n2_new != n2)
	    // give an error if the new value is different
	    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
			 "Thickness image of layer %i "
			 "has %i pixels in second axis."
			 "This differs from the previous value %i\n",
			 index, n2_new, n2);
	  else
	    // store the new value
	    n2 = n2_new;
	}
    }

#ifdef DEBUGFCONF
  fprintf(stdout, "Allocating an image with size: (%i, %i)\n", n1, n2);
#endif

  // check whether at least one image was
  // found as thickness information
  if (is_defined)
    {
      // allocate the image
      fringe_image =  gsl_matrix_alloc(n1, n2);

      // set all vallues to zero
      gsl_matrix_set_all(fringe_image, 0.0);
    }
  else
    {
      // no image found; report the error
      aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		   "The size of the fringe image is unknown\n"
		   "since none of the layers has an image "
		   "to specify its thickness!\n");
    }

  // return the image
  return fringe_image;
}

/**
 * Function: get_calibration_data()
 * This function is a data storage for filter throughput values
 * as computed by the orioginal program 'final.f' of J.Walsh.
 * The cubic spline routine used there turned out to give
 * (slightly) different results than the gsl-routine used
 * here. To be able making a in-depth comparison the throughuts
 * were computed for the filter 'ccd_ref.fits' and stored here.
 *
 * Parameters:
 *
 * Returns:
 * @return double_vector - interpolated standard filter throughputs
 */
gsl_vector **
get_calibration_data()
{
  gsl_vector *lambda_values;
  gsl_vector *through_values;

  gsl_vector **double_vector;

  // allocate space for the return vector
  double_vector  = (gsl_vector **)malloc(2*sizeof (gsl_vector *));

  // allocate the space for the vectors
  lambda_values  = gsl_vector_alloc(43);
  through_values = gsl_vector_alloc(43);

  // what follows is the wavelength steps as well as the normalized
  // filter throughputs which were computed in the original
  // program 'final.f' of J.Walsh.
  // The gsl-cubic spline routine yields slightly different values.
  // The values fixed here are good for a detailed cross-check
  // of the two programs.
  gsl_vector_set(through_values, 0, 0.0000000000000000);gsl_vector_set(lambda_values, 0,   0.9179);
  gsl_vector_set(through_values, 1, 0.0095066184313808);gsl_vector_set(lambda_values, 1,   0.9180);
  gsl_vector_set(through_values, 2, 0.0176006475945001);gsl_vector_set(lambda_values, 2,   0.9181);
  gsl_vector_set(through_values, 3, 0.0240259215044616);gsl_vector_set(lambda_values, 3,   0.9182);
  gsl_vector_set(through_values, 4, 0.0289185490230508);gsl_vector_set(lambda_values, 4,   0.9183);
  gsl_vector_set(through_values, 5, 0.0324146730103703);gsl_vector_set(lambda_values, 5,   0.9184);
  gsl_vector_set(through_values, 6, 0.0346504181940869);gsl_vector_set(lambda_values, 6,   0.9185);
  gsl_vector_set(through_values, 7, 0.0357619115684218);gsl_vector_set(lambda_values, 7,   0.9186);
  gsl_vector_set(through_values, 8, 0.0358852710613785);gsl_vector_set(lambda_values, 8,   0.9187);
  gsl_vector_set(through_values, 9, 0.0351566282002872);gsl_vector_set(lambda_values, 9,   0.9188);
  gsl_vector_set(through_values,10, 0.0337121099793692);gsl_vector_set(lambda_values,10,   0.9189);
  gsl_vector_set(through_values,11, 0.0316878433928458);gsl_vector_set(lambda_values,11,   0.9190);
  gsl_vector_set(through_values,12, 0.0292199509018293);gsl_vector_set(lambda_values,12,   0.9191);
  gsl_vector_set(through_values,13, 0.0264445572339866);gsl_vector_set(lambda_values,13,   0.9192);
  gsl_vector_set(through_values,14, 0.0234977916500934);gsl_vector_set(lambda_values,14,   0.9193);
  gsl_vector_set(through_values,15, 0.0205157811443709);gsl_vector_set(lambda_values,15,   0.9194);
  gsl_vector_set(through_values,16, 0.0176346504444861);gsl_vector_set(lambda_values,16,   0.9195);
  gsl_vector_set(through_values,17, 0.0149905288112146);gsl_vector_set(lambda_values,17,   0.9196);
  gsl_vector_set(through_values,18, 0.0127195375723916);gsl_vector_set(lambda_values,18,   0.9197);
  gsl_vector_set(through_values,19, 0.0109578003224067);gsl_vector_set(lambda_values,19,   0.9198);
  gsl_vector_set(through_values,20, 0.0098414542549762);gsl_vector_set(lambda_values,20,   0.9199);
  gsl_vector_set(through_values,21, 0.0095066184313808);gsl_vector_set(lambda_values,21,   0.9200);
  gsl_vector_set(through_values,22, 0.0100435357173845);gsl_vector_set(lambda_values,22,   0.9201);
  gsl_vector_set(through_values,23, 0.0113589226644173);gsl_vector_set(lambda_values,23,   0.9202);
  gsl_vector_set(through_values,24, 0.0133136264280558);gsl_vector_set(lambda_values,24,   0.9203);
  gsl_vector_set(through_values,25, 0.0157684646986687);gsl_vector_set(lambda_values,25,   0.9204);
  gsl_vector_set(through_values,26, 0.0185842800987238);gsl_vector_set(lambda_values,26,   0.9205);
  gsl_vector_set(through_values,27, 0.0216219095843027);gsl_vector_set(lambda_values,27,   0.9206);
  gsl_vector_set(through_values,28, 0.0247421844451007);gsl_vector_set(lambda_values,28,   0.9207);
  gsl_vector_set(through_values,29, 0.0278059450370313);gsl_vector_set(lambda_values,29,   0.9208);
  gsl_vector_set(through_values,30, 0.0306740203832353);gsl_vector_set(lambda_values,30,   0.9209);
  gsl_vector_set(through_values,31, 0.0332072463065172);gsl_vector_set(lambda_values,31,   0.9210);
  gsl_vector_set(through_values,32, 0.0352664608962358);gsl_vector_set(lambda_values,32,   0.9211);
  gsl_vector_set(through_values,33, 0.0367124999751954);gsl_vector_set(lambda_values,33,   0.9212);
  gsl_vector_set(through_values,34, 0.0374061970996460);gsl_vector_set(lambda_values,34,   0.9213);
  gsl_vector_set(through_values,35, 0.0372083835592830);gsl_vector_set(lambda_values,35,   0.9214);
  gsl_vector_set(through_values,36, 0.0359798997100196);gsl_vector_set(lambda_values,36,   0.9215);
  gsl_vector_set(through_values,37, 0.0335815745749970);gsl_vector_set(lambda_values,37,   0.9216);
  gsl_vector_set(through_values,38, 0.0298742553097917);gsl_vector_set(lambda_values,38,   0.9217);
  gsl_vector_set(through_values,39, 0.0247187709375447);gsl_vector_set(lambda_values,39,   0.9218);
  gsl_vector_set(through_values,40, 0.0179759414151792);gsl_vector_set(lambda_values,40,   0.9219);
  gsl_vector_set(through_values,41, 0.0095066184313808);gsl_vector_set(lambda_values,41,   0.9220);
  gsl_vector_set(through_values,42, 0.0000000000000000);gsl_vector_set(lambda_values,42,   0.9221);

  // build up the output array
  double_vector[0] = lambda_values;
  double_vector[1] = through_values;

  // return the two vectors
  return double_vector;
}

/**
 * Function: get_PET_calibration_data()
 */
gsl_vector **
get_PET_calibration_data()
{
  gsl_vector *lambda_values;
  gsl_vector *through_values;

  gsl_vector **double_vector;

  // allocate space for the return vector
  double_vector  = (gsl_vector **)malloc(2*sizeof (gsl_vector *));

  // allocate the space for the vectors
  lambda_values  = gsl_vector_alloc(21);
  through_values = gsl_vector_alloc(21);

  gsl_vector_set(lambda_values, 0,1.069460);  gsl_vector_set(through_values, 0, 0.000000);
  gsl_vector_set(lambda_values, 1,1.069653);  gsl_vector_set(through_values, 1, 0.012630);
  gsl_vector_set(lambda_values, 2,1.069846);  gsl_vector_set(through_values, 2, 0.025261);
  gsl_vector_set(lambda_values, 3,1.070039);  gsl_vector_set(through_values, 3, 0.037891);
  gsl_vector_set(lambda_values, 4,1.070232);  gsl_vector_set(through_values, 4,   0.050522);
  gsl_vector_set(lambda_values, 5,1.070424);  gsl_vector_set(through_values, 5,   0.063152);
  gsl_vector_set(lambda_values, 6,1.070617);  gsl_vector_set(through_values, 6,   0.069010);
  gsl_vector_set(lambda_values, 7,1.070810);  gsl_vector_set(through_values, 7,   0.069010);
  gsl_vector_set(lambda_values, 8,1.071003);  gsl_vector_set(through_values, 8,   0.069010);
  gsl_vector_set(lambda_values, 9,1.071196);  gsl_vector_set(through_values, 9,   0.069010);
  gsl_vector_set(lambda_values, 10,1.071389); gsl_vector_set(through_values, 10,   0.069010);
  gsl_vector_set(lambda_values, 11,1.071582); gsl_vector_set(through_values, 11,   0.069010);
  gsl_vector_set(lambda_values, 12,1.071775); gsl_vector_set(through_values, 12,   0.069010);
  gsl_vector_set(lambda_values, 13,1.071967); gsl_vector_set(through_values, 13,   0.069010);
  gsl_vector_set(lambda_values, 14,1.072160); gsl_vector_set(through_values, 14,   0.069010);
  gsl_vector_set(lambda_values, 15,1.072353); gsl_vector_set(through_values, 15,   0.063152);
  gsl_vector_set(lambda_values, 16,1.072546); gsl_vector_set(through_values, 16,   0.050522);
  gsl_vector_set(lambda_values, 17,1.072739); gsl_vector_set(through_values, 17,   0.037891);
  gsl_vector_set(lambda_values, 18,1.072932); gsl_vector_set(through_values, 18,   0.025261);
  gsl_vector_set(lambda_values, 19,1.073125); gsl_vector_set(through_values, 19,  0.012630);
  gsl_vector_set(lambda_values, 20,1.073318); gsl_vector_set(through_values, 20,   0.000000);

  //Wavelength: 10713.888672, fringe factor: 1.097945, (x,y): (18, 745)

  // build up the output array
  double_vector[0] = lambda_values;
  double_vector[1] = through_values;

  // return the two vectors
  return double_vector;
}

/**
 * Function: evaluate_wavelength_steps
 * The function defines and computes the wavelength steps and the
 * filter throughputs which are used to compute the fringe amplitude
 * for all pixels. The basis for the wavelength data are the
 * filter data and the general are where fringing is significant
 * and computed, which is defined in the fringe
 * configuration structure.
 * First all throughput values below a certain value are discarded
 * at the short and long wavelength edge. Then the final wavelength
 * range is determined using the fringing range. Then all wavelength
 * values and the filter throughputs are determined and returned
 * as two gsl-vectors.
 *
 * Parameters:
 * @param fconf - the fringe configuration structure
 *
 * Returns:
 * @return double_vector - a set of two gsl-vectors with wavlength
                           and throughput
 */
gsl_vector **
evaluate_wavelength_steps(fringe_conf *fconf)
{
  int index=0;
  int lower=0;
  int upper=0;

  int nsteps;

  double lambda_min;
  double lambda_max;
  double lambda_act;
  double through_act=0.0;
  double through_tot=0.0;

  gsl_vector *lambda_values;
  gsl_vector *through_values;

  gsl_vector **double_vector;

  // allocate space for the return vector
  double_vector  = (gsl_vector **)malloc(2*sizeof (gsl_vector *));

  // search through the filter data
  // to narrow the usable range from below
  lower=0;
  while (lower < fconf->filter_through->nvals
	 && fconf->filter_through->yvals[lower] < FILTER_THRESHOLD)
    lower++;
  lower = MAX(0,lower-1);

  // search through the filter data
  // to narrow the usable range from above
  upper=fconf->filter_through->nvals - 1;
  while (upper > -1
	 && fconf->filter_through->yvals[upper] < FILTER_THRESHOLD)
    upper--;
  upper = MIN(fconf->filter_through->nvals - 1, upper+1);

#ifdef DEBUGFCONF
  fprintf(stderr, "New lower range index: %i, new upper: %i, old number: %i\n",
	  lower, upper, fconf->filter_through->nvals);
#endif

  // replace the old filter interpolator
  // with a new one, if necessary
  if (lower != 0 || upper != (fconf->filter_through->nvals - 1))
    fconf->filter_through = redefine_filter_throughput(lower, upper, fconf);

  // compute the lower wavelength range by comparing
  // the filter throughput with the range important
  // for fringing; the latter is given in AA!!
  lambda_min = MAX(gsl_vector_get(fconf->fringe_range, 0),
		   fconf->filter_through->xmin);

  // compute the upper wavelength range by comparing
  // the filter throughput with the range important
  // for fringing; the latter is given in AA!!
  lambda_max = MIN(gsl_vector_get(fconf->fringe_range, 1),
		   fconf->filter_through->xmax);

  // find the number of steps to cover the wavelength range
  nsteps = (int)ceil((lambda_max-lambda_min)/(fconf->fringe_step)) + 1;

  // allocate the space for the vectors
  lambda_values  = gsl_vector_alloc(nsteps);
  through_values = gsl_vector_alloc(nsteps);

  // fill the vectors with the wavelength steps and the
  // filter throughput at those wavelengths.
  lambda_act = lambda_min;
  for (index=0; index < nsteps-1; index+=1)
    {
      gsl_vector_set(lambda_values, index, lambda_act);
      through_act = eval_interp(fconf->filter_through, lambda_act);
      through_tot += through_act;
      gsl_vector_set(through_values, index, through_act);
      lambda_act += fconf->fringe_step;
    }

  // add also the values at lambda_amax
  gsl_vector_set(lambda_values, nsteps-1, lambda_max);
  through_act = eval_interp(fconf->filter_through, lambda_max);
  through_tot += through_act;
  gsl_vector_set(through_values, nsteps-1, through_act);

  for (index=0; index < (int)through_values->size; index++)
    {
      // normalize the filter throughput values
      gsl_vector_set(through_values, index,
		     gsl_vector_get(through_values, index)/through_tot);

      // convert the wavelength from AA to micron
      gsl_vector_set(lambda_values, index,
		     gsl_vector_get(lambda_values, index)*1.0e-04);
    }
#ifdef DEBUGFCONF
  through_tot = 0.0;
  for (index=0; index < through_values->size; index++)
    {
      fprintf(stderr, "Wavelength: %f, Throughput: %f\n",
	      gsl_vector_get(lambda_values, index),
	      gsl_vector_get(through_values, index));
      through_tot += gsl_vector_get(through_values, index);
    }
  fprintf(stderr, "Total throughput: %f\n", through_tot);
#endif

  // build up the output array
  double_vector[0] = lambda_values;
  double_vector[1] = through_values;

  return double_vector;
}

/**
 * Function: redefine_filter_throughput
 * The function re-defines an existing interpolator using only the
 * existing data values in an index range given as parameters.
 *
 * Parameters:
 * @param lower - index with the lowest data point
 * @param upper - index with the highest data point
 *
 * Returns:
 * @return new_interp - the new interpolator
 */
interpolator *
redefine_filter_throughput(const int lower, const int upper,
			   fringe_conf *fconf)
{
  int new_nvals;
  int index;

  double *new_x;
  double *new_y;

  interpolator *new_interp;

   // allocate space for the return structure;
  // complain if this fails
  new_interp = (interpolator *)malloc (sizeof (interpolator));
  if (new_interp == NULL)
      aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		   "Could not allocate memory for interpolator");

  // compute the new length of the data arrays
  new_nvals = upper-lower+1;

  // allocate space for the new data arrays
  new_x = (double *)malloc(new_nvals*sizeof(double));
  new_y = (double *)malloc(new_nvals*sizeof(double));

  // transfer the data
  for (index=lower; index < upper+1; index++)
    {
      new_x[index-lower] = fconf->filter_through->xvals[index];
      new_y[index-lower] = fconf->filter_through->yvals[index];
    }

  // free the old structure
  free_interp(fconf->filter_through);

  // build up the interpolator structure
  new_interp->xmin    = new_x[0];
  new_interp->xmax    = new_x[new_nvals-1];
  new_interp->nvals   = new_nvals;
  new_interp->xvals   = new_x;
  new_interp->yvals   = new_y;
  new_interp->acc     = gsl_interp_accel_alloc();
  new_interp->interp  = gsl_interp_alloc(FILTER_INTERP_TYPE,
					 new_interp->nvals);

  // initialize the cubic spline
  gsl_interp_init(new_interp->interp, new_interp->xvals, new_interp->yvals,
		  new_interp->nvals);

  // return the new structure
  return new_interp;
}

/**
 * Function: eval_linear_interp
 * The function computes and returns the interpolated value
 * at a given position for a linear interpolator.
 *
 * Parameters:
 * @param lin_int - the linear interpolator
 * @param xval    - the position to evaluate the linear interpolator
 *
 * Returns:
 * @return (value) - the interpolated data value
 */
double
eval_linear_interp(linear_interp *lin_int, const double xval)
{

  double factor=0.0;

  // check whether the x-value is within
  // the range spanned by the data;
  // complain if the x-value is outside
  if (xval < lin_int->xmin || xval > lin_int->xmax)
    aXe_message (aXe_M_FATAL, __FILE__, __LINE__,
		 "independent linear interpolation value %f "
		 "is outside interval (%f, %f)\n", xval,
		 lin_int->xmin, lin_int->xmax);

  // check whether you have to search upwards or downwards
  if (xval >= gsl_vector_get(lin_int->xvals, lin_int->act_index))
    {

      // in case that you search upwards, go up
      // the independent values until you find the right interval
      lin_int->act_index += 1;
      while(xval > gsl_vector_get(lin_int->xvals, lin_int->act_index))
	lin_int->act_index++;
    }
  else
    {

      // in case that you search downwards, go down
      // the independent values  until you find the right interval
      //      while(wavelength < resp->spec[nact-1].lambda_mean)
      while(xval < gsl_vector_get(lin_int->xvals, lin_int->act_index-1))
	lin_int->act_index--;
    }

  // interpolate within the interval to calculate the
  // sensitivity
  factor = (xval - gsl_vector_get(lin_int->xvals, lin_int->act_index-1))/
    (gsl_vector_get(lin_int->xvals, lin_int->act_index) - gsl_vector_get(lin_int->xvals, lin_int->act_index-1));

  // compute and terutn the interpolated value
    return (gsl_vector_get(lin_int->yvals, lin_int->act_index-1)
    + factor * (gsl_vector_get(lin_int->yvals, lin_int->act_index)-gsl_vector_get(lin_int->yvals, lin_int->act_index-1)));
}

/**
 * Function: get_layer_thickness
 * The function determines the thickness of an individual layer
 * at a given pixel position.
 *
 * Parameters:
 * @param opt_layer - the optical layer
 * @param ii        - the first pixel index
 * @param jj        - the second pixel index
 *
 * Returns:
 * @return (value) - the thickness of the layer at the requested position
 */
double
get_layer_thickness(const ccd_layer *opt_layer, const int ii, const int jj)
{
  // check whether the thickness is 2D
  if (opt_layer->thickness2D)
    // return the 2D value
    return gsl_matrix_get(opt_layer->thickness2D, ii, jj);
  else
    // return the constant value
    return opt_layer->thickness;
}

/**
 * Function: get_complex_refindex
 * The function computes and returns the complex refraction index of
 * a given CCD layer at a given wavelength.
 *
 * Parameters:
 * @param opt_layer - the optical layer
 * @param lambda    - the wavelength
 *
 * Returns:
 * @return (value) - the complex refraction index
 */
gsl_complex
get_complex_refindex(const ccd_layer *opt_layer, const double lambda)
{
  double re;
  double im;

  // compute the real part
  re = eval_interp(opt_layer->re_refraction, lambda);

  // comute the imaginary part
  im = eval_interp(opt_layer->im_refraction, lambda);

  // return the complex number
  return gsl_complex_rect(re, im);
}

/**
 * Function: compute_reflection
 * The function computes and returns the reflection index (in %)
 * for two complex refraction indices  at a given wavelength.
 *
 * Parameters:
 * @param refract_l1 - refraction index of one layer
 * @param refract_l2 - refraction index of the second layer
 *
 * Returns:
 * @return (value) - the reflection index
 */
double
compute_reflection(const gsl_complex refract_l1,
		   const gsl_complex refract_l2)
{
  gsl_complex conj_l1;
  gsl_complex conj_l2;

  gsl_complex refl_compl;

  // get the comlex conjugated values of the input
  conj_l1 = gsl_complex_conjugate(refract_l1);
  conj_l2 = gsl_complex_conjugate(refract_l2);

  // compute the complex reflection
  refl_compl = gsl_complex_div(gsl_complex_sub(conj_l1, conj_l2),
			       gsl_complex_add(conj_l1, conj_l2));

  // return the magnitude of the complex reflection
  return gsl_complex_abs2(refl_compl);
}

/**
 * Function: compute_transmission
 * The function computes and returns the transmission index (in %)
 * for two complex refraction indices at a given wavelength.
 *
 * Parameters:
 * @param refract_l1 - refraction index of one layer
 * @param refract_l2 - refraction index of the second layer
 *
 * Returns:
 * @return (value) - the trnasmission index
 */
double
compute_transmission(const gsl_complex refract_l1,
		     const gsl_complex refract_l2)
{
  gsl_complex conj_l1;
  gsl_complex conj_l2;

  gsl_complex trans_compl;

  // get the comlex conjugated values of the input
  conj_l1 = gsl_complex_conjugate(refract_l1);
  conj_l2 = gsl_complex_conjugate(refract_l2);

  // compute the complex transmission
  trans_compl =
    gsl_complex_div(gsl_complex_sqrt(gsl_complex_mul(conj_l1, conj_l2)),
		    gsl_complex_add(conj_l1, conj_l2));

  // finish the computation of the complex transmission
  trans_compl = gsl_complex_mul_real (trans_compl, 2.0);

  // return the magnitude of the complex transmission
  return gsl_complex_abs2(trans_compl);
}

/**
 * Function: compute_attenuation
 * The function computes the attenuation/damping of a plane wave
 * with a given inverse wavelelength (phase number) traversing
 * TWO TIMES a layer of a given thickness and complex refraction
 * index.
 *
 * Parameters:
 * @param refract      - the complex refraction index
 * @param thickness    - the thickness of the layer
 * @param phase_number - the inverse wavelength
 *
 * Returns:
 * @return (value) - the attenuation
 */
double
compute_attenuation(const gsl_complex refract, const double thickness,
		    const double phase_number)
{
  // check if there is something to compute
  if (GSL_IMAG(refract))
    // compute and return the value
    return exp(-2.0*GSL_IMAG(refract)*thickness*phase_number);
  else
    // return the value for exp(0.0)
    return 1.0;
}

/**
 * Function: compute_pshift
 * The function computes the phase shift of a plane wave
 * with a given inverse wavelelength (phase number) traversing
 * TWO TIMES a layer of a given thickness and complex refraction
 * index.
 *
 * Parameters:
 * @param refract      - the complex refraction index
 * @param thickness    - the thickness of the layer
 * @param phase_number - the inverse wavelength
 *
 * Returns:
 * @return (value) - the complex phase shift
 */
gsl_complex
compute_pshift(const gsl_complex refract, const double thickness,
	       const double phase_number)
{
  // all in one line:
  return gsl_complex_exp(gsl_complex_rect(0.0,2.0*GSL_REAL(refract)*thickness*phase_number));
}

/**
 * Function: alloc_optprops_list
 * The function allocates space for a list of optical property
 * elements. the size of the list is derived from a fringe
 * configuration structure given in the input.
 *
 * Parameters:
 * @param fconf - the fringe configuration file
 *
 * Returns:
 * @return optprops - the list of optical properties
 */
optical_property *
alloc_optprops_list(const fringe_conf *fconf)
{
  optical_property *optprops;

  // allocate large enough memory
  optprops =
    (optical_property *)malloc(fconf->opt_layers->num_layers*sizeof(ap_pixel));

  // return the pointer
  return optprops;
}

/**
 * Function: print_optprops_list
 * The function prints the content of an optical property
 * list onto the screen.
 *
 * Parameters:
 * @param optprops - the optical property list
 *
 * Returns:
 * @return -
 */
void
print_optprops_list(const optical_property *optprops, const int num_entries)
{
  int index;

  for (index = 0; index < num_entries; index++)
    {
      fprintf(stdout, "#%i: %f %f %f %f %f %f \n",index,
	      optprops[index].trans_upper, optprops[index].reflect_upper,
	      GSL_REAL(optprops[index].double_phshift),
	      GSL_IMAG(optprops[index].double_phshift),
	      optprops[index].trans_lower, optprops[index].reflect_lower);
    }
}

/**
 * Function: free_optprops_list
 * The function releases the space allocated in an
 * optical property list.
 *
 * Parameters:
 * @param optprops - the optical property list
 *
 * Returns:
 * @return -
 */
void
free_optprops_list(optical_property *optprops)
{
  if (optprops != NULL)
    {
      // free the structure
      free(optprops);

      // set it to NULL
      optprops = NULL;
    }
}

/*
 * Function: init_optprops_list
 * The function initializes an optical property list. This means
 * it computes and stores values for the list elements. Here
 * only elements are fixed, which will not change during the
 * whole fringe computation and remain constant for all pixels
 * at all wavelengths.
 *
 * Parameters:
 * @params fconf       - the fringe configuration structure
 * @params lambda_mean - the mean wavelength of analyzed waveband
 * @params optprops    - the list of optical property elements
 *
 * Returns:
 * @return -
 */
void
init_optprops_list(const fringe_conf *fconf, const double lambda_mean,
		   optical_property *optprops)
{
  int num_layers;
  int index;

  double n1;
  double n2;

  // determine the number of layers
  num_layers = fconf->opt_layers->num_layers;

  if (num_layers > 0)
    {
      // set the transmission and reflection
      // vacuum -- first CCD layer
      // that's a bit heuristic, since
      // the true value using the true
      // refration index for vacuum would
      // give a different result
      optprops[0].trans_upper   = 1.0;
      optprops[0].reflect_upper = 0.0;

      // also that one is a bit heuristic
      // but assuming n(vacuum)=1.0 its also true
      optprops[0].sign_upper = 1.0;

      // set the sign of the lowest layer -- substrate
      // this is purely heuristic and works
      // only for the HRC/WFC fringing models!!
      optprops[num_layers-1].sign_lower = -1.0;
    }

  for (index=0; index < num_layers-1; index++)
    {
      // get the real part of the refraction index
      // of the upper layer
      n1 = GSL_REAL(get_complex_refindex(fconf->opt_layers->opt_layer[index],
					 lambda_mean));

      // get the real part of the refraction index
      // of the lower layer
      n2 = GSL_REAL(get_complex_refindex(fconf->opt_layers->opt_layer[index+1],
					 lambda_mean));

      // distribute the signs
      // for the upper and lower layer
      if (n1 < n2)
	{
	  optprops[index].sign_lower   =  1.0;
	  optprops[index+1].sign_upper = -1.0;
	}
      else
	{
	  optprops[index].sign_lower   = -1.0;
	  optprops[index+1].sign_upper =  1.0;
	}
    }
}

/*
 * Function: fill_optprops_thickness
 * The function fills the thickness of the optival layers
 * at a given pixel into a list of optical properties.
 *
 * Parameters:
 * @params opt_layers - the structure for the optical layers
 * @params ii         - the mean wavelength of analyzed waveband
 * @params jj         - the list of optical property elements
 * @params optprops   - the list of optical property elements
 *
 * Returns:
 * @return -
 */
void
fill_optprops_thickness(const ccd_layers *opt_layers, const int ii,
			const int jj, optical_property *optprops)
{
  int index;

  // go over all layers
  for (index=0; index < opt_layers->num_layers; index++)
    // get and store the thickness
    optprops[index].thickness =
      get_layer_thickness(opt_layers->opt_layer[index], ii, jj);
}

/*
 * Function: fill_optprops_all
 * This function computes and fills in all pixel AND wavelength
 * dependent values into a list of optical properties. The completely
 * filled list can then be used to determine the fringe contribution
 * at that wavelength according to a certain model which defines
 * the various light-paths.
 *
 * Parameters:
 * @params opt_layers - the structure for the optical layers
 * @params lambda     - the actual wavelength
 * @params optprops   - the list of optical property elements
 *
 * Returns:
 * @return -
 */
void
fill_optprops_all(const ccd_layers *opt_layers, const double lambda,
		  optical_property *optprops)
{
  int index;

  double phase_number;

  gsl_complex compl_upp;
  gsl_complex compl_low;

  int num_layers;

  // store the number of layers
  num_layers = opt_layers->num_layers;

  // compute the phase number
  phase_number = 2.0*M_PI / lambda;

  // get the complex refractive index for the first layer
  compl_upp =
    get_complex_refindex(opt_layers->opt_layer[0],lambda);

  for (index=0; index < num_layers-1; index++)
    {

      // get the refractive index for the next layer
      compl_low =
      	get_complex_refindex(opt_layers->opt_layer[index+1],lambda);

      // compute the reflection and transmission
      // to the lower layers
      optprops[index].reflect_lower =
	compute_reflection(compl_upp, compl_low);
      optprops[index].trans_lower   = 1.0 - optprops[index].reflect_lower;

      // compute the reflection and transmission
      // to the upper layers
      optprops[index+1].reflect_upper = optprops[index].reflect_lower;
      optprops[index+1].trans_upper   = 1.0 - optprops[index+1].reflect_upper;

      // compute the attenuation
      optprops[index].double_attenuation =
      	compute_attenuation(compl_upp,optprops[index].thickness,phase_number);

      // compute the phase shift
      optprops[index].double_phshift =
	compute_pshift(compl_upp, optprops[index].thickness, phase_number);

      // prepare the next iteration:
      // the now upper layer will then be the lower
      compl_upp = compl_low;
    }
  // compute the attenuation for the last layer
  optprops[num_layers-1].double_attenuation =
    compute_attenuation(compl_upp,optprops[num_layers-1].thickness,phase_number);

  // compute the phase shift for the last layer
  optprops[num_layers-1].double_phshift =
    compute_pshift(compl_upp, optprops[num_layers-1].thickness, phase_number);

  // compute the transmission of the last layer
  // towards the substrate
  optprops[num_layers-1].trans_lower =
    eval_interp(opt_layers->substrate, lambda);

  // compute the reflection of the last layer
  // towards the substrate
  optprops[num_layers-1].reflect_lower =
    1.0 - optprops[num_layers-1].trans_lower;

}

/*
 * Function: fill_contrib_single
 * The function computes the contribution to the fringe amplitude
 * on the basis of an appropriately filled list of optical properties.
 * In the properties the ingredients such as phase shifts and
 * attenuation and transmissions and reflections are defined.
 * This function just combines the ingredients using a model
 * which includes all single reflected beam combinations
 * as contributors to the fringing.
 *
 * Parameters:
 * @params optprops   - the list of optical property elements
 * @params fconf      - the fringe configuration structure
 *
 * Returns:
 * @return (value)    - the fringe contribution
 */
double
fringe_contrib_single(const optical_property *optprops,
		      const fringe_conf *fconf)
{
  int index=2;

  gsl_complex amp_tmp;
  gsl_complex amp_tot;

  // compute the initial phase at the top of the
  // first layer
  amp_tot =
    gsl_complex_mul_real(gsl_complex_exp(gsl_complex_rect(0.0,fconf->fringe_phase*M_PI/180.0)), 1.0);

  // transfer the intitial value
  // to the running variable
  amp_tmp = amp_tot;

  // pile up the amplitude,
  // also putting in the transmission
  amp_tmp =
    gsl_complex_mul(amp_tmp,
		    gsl_complex_mul_real(optprops[0].double_phshift,
					 1.0*1.0*optprops[0].double_attenuation));

  // compute the intermediate result
  // for the first layer
  amp_tot =
    gsl_complex_add(amp_tot,
		    gsl_complex_mul_real(amp_tmp,
					 optprops[0].sign_lower*optprops[0].reflect_lower));

  // go over layer 2 to the end
  for (index=1; index < fconf->opt_layers->num_layers; index++)
    {
      // pile up the amplitude
      // to that layer
      amp_tmp =
	gsl_complex_mul(amp_tmp,
			gsl_complex_mul_real(optprops[index].double_phshift,
					   optprops[index-1].trans_lower*optprops[index].trans_upper*optprops[index].double_attenuation));

      // compute the intermediate result
      // for the that layer
      amp_tot =
	gsl_complex_add(amp_tot,
			gsl_complex_mul_real(amp_tmp,
					     optprops[index].sign_lower*optprops[index].reflect_lower));
      //      if (index==3)
      //	fprintf(stdout,"ccc:%f, %f\n", GSL_REAL(amp_tmp),GSL_IMAG(amp_tmp) );

    }

  // return the final value
  return (GSL_REAL(amp_tot) - 1.0);
}


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

#include "tests.h"

void
test_swap (void) {
const double flteps = 1e-4, dbleps = 1e-6;
  {
   int N = 1;
   float X[] = { 0.539f };
   int incX = 1;
   float Y[] = { -0.262f };
   int incY = -1;
   float expected1[] = { -0.262f };
   float expected2[] = { 0.539f };
   cblas_sswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], flteps, "sswap(case 88)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], flteps, "sswap(case 89)");
     }
   };
  };

  {
   int N = 1;
   double X[] = { 0.906 };
   int incX = 1;
   double Y[] = { 0.373 };
   int incY = -1;
   double expected1[] = { 0.373 };
   double expected2[] = { 0.906 };
   cblas_dswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], dbleps, "dswap(case 90)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], dbleps, "dswap(case 91)");
     }
   };
  };

  {
   int N = 1;
   float X[] = { -0.316f, -0.529f };
   int incX = 1;
   float Y[] = { -0.313f, 0.363f };
   int incY = -1;
   float expected1[] = { -0.313f, 0.363f };
   float expected2[] = { -0.316f, -0.529f };
   cblas_cswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], flteps, "cswap(case 92) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], flteps, "cswap(case 92) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], flteps, "cswap(case 93) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], flteps, "cswap(case 93) imag");
     };
   };
  };

  {
   int N = 1;
   double X[] = { 0.512, -0.89 };
   int incX = 1;
   double Y[] = { -0.225, -0.511 };
   int incY = -1;
   double expected1[] = { -0.225, -0.511 };
   double expected2[] = { 0.512, -0.89 };
   cblas_zswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], dbleps, "zswap(case 94) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], dbleps, "zswap(case 94) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], dbleps, "zswap(case 95) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], dbleps, "zswap(case 95) imag");
     };
   };
  };

  {
   int N = 1;
   float X[] = { 0.336f };
   int incX = -1;
   float Y[] = { -0.431f };
   int incY = 1;
   float expected1[] = { -0.431f };
   float expected2[] = { 0.336f };
   cblas_sswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], flteps, "sswap(case 96)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], flteps, "sswap(case 97)");
     }
   };
  };

  {
   int N = 1;
   double X[] = { 0.764 };
   int incX = -1;
   double Y[] = { -0.293 };
   int incY = 1;
   double expected1[] = { -0.293 };
   double expected2[] = { 0.764 };
   cblas_dswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], dbleps, "dswap(case 98)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], dbleps, "dswap(case 99)");
     }
   };
  };

  {
   int N = 1;
   float X[] = { -0.239f, 0.361f };
   int incX = -1;
   float Y[] = { 0.149f, 0.347f };
   int incY = 1;
   float expected1[] = { 0.149f, 0.347f };
   float expected2[] = { -0.239f, 0.361f };
   cblas_cswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], flteps, "cswap(case 100) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], flteps, "cswap(case 100) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], flteps, "cswap(case 101) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], flteps, "cswap(case 101) imag");
     };
   };
  };

  {
   int N = 1;
   double X[] = { -0.171, -0.936 };
   int incX = -1;
   double Y[] = { 0.495, -0.835 };
   int incY = 1;
   double expected1[] = { 0.495, -0.835 };
   double expected2[] = { -0.171, -0.936 };
   cblas_zswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], dbleps, "zswap(case 102) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], dbleps, "zswap(case 102) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], dbleps, "zswap(case 103) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], dbleps, "zswap(case 103) imag");
     };
   };
  };

  {
   int N = 1;
   float X[] = { -0.405f };
   int incX = -1;
   float Y[] = { -0.213f };
   int incY = -1;
   float expected1[] = { -0.213f };
   float expected2[] = { -0.405f };
   cblas_sswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], flteps, "sswap(case 104)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], flteps, "sswap(case 105)");
     }
   };
  };

  {
   int N = 1;
   double X[] = { -0.761 };
   int incX = -1;
   double Y[] = { -0.585 };
   int incY = -1;
   double expected1[] = { -0.585 };
   double expected2[] = { -0.761 };
   cblas_dswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[i], expected1[i], dbleps, "dswap(case 106)");
     }
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[i], expected2[i], dbleps, "dswap(case 107)");
     }
   };
  };

  {
   int N = 1;
   float X[] = { 0.853f, 0.146f };
   int incX = -1;
   float Y[] = { 0.009f, -0.178f };
   int incY = -1;
   float expected1[] = { 0.009f, -0.178f };
   float expected2[] = { 0.853f, 0.146f };
   cblas_cswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], flteps, "cswap(case 108) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], flteps, "cswap(case 108) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], flteps, "cswap(case 109) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], flteps, "cswap(case 109) imag");
     };
   };
  };

  {
   int N = 1;
   double X[] = { -0.228, 0.386 };
   int incX = -1;
   double Y[] = { 0.988, -0.084 };
   int incY = -1;
   double expected1[] = { 0.988, -0.084 };
   double expected2[] = { -0.228, 0.386 };
   cblas_zswap(N, X, incX, Y, incY);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(X[2*i], expected1[2*i], dbleps, "zswap(case 110) real");
       gsl_test_rel(X[2*i+1], expected1[2*i+1], dbleps, "zswap(case 110) imag");
     };
   };
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(Y[2*i], expected2[2*i], dbleps, "zswap(case 111) real");
       gsl_test_rel(Y[2*i+1], expected2[2*i+1], dbleps, "zswap(case 111) imag");
     };
   };
  };

}


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include <assert.h>
#include <gsl/gsl_interp.h>
#include <gsl/gsl_interp.h>

typedef double (*eval_func)(const gsl_interp*,const double *x,const double *y,
                            double,gsl_interp_accel*);

static const double EPSILON = 0.00000001;
static const double EPS = 0.0001;
static const int PTS = 801;

static const double x_values[] = { 0, 1, 2, 3, 4, 5 };
static const double y_values[] = { 5, 0, 5, 2, 0, 5 };
static double x_range;

static const int N = sizeof(x_values)/sizeof(double);

static double* interpolate(const gsl_interp_type *type, const size_t order);
static void    check_discont(gsl_interp *interp, const eval_func func,
                             const char *dsym, const double x,
                             gsl_interp_accel *accel);

static inline double
scale_x(const int i)
{
  return x_values[0] + (double)i/(PTS-1)*x_range;
}

int
main(int argc, char *argv[])
{
  int i;
  double *cspline, *cspline_d, *cspline_dd;
  double *akima, *akima_d, *akima_dd;

  x_range = x_values[N-1] - x_values[0];

  akima = interpolate(gsl_interp_akima_periodic, 0);
  akima_d = interpolate(gsl_interp_akima_periodic, 1);
  akima_dd = interpolate(gsl_interp_akima_periodic, 2);
  cspline = interpolate(gsl_interp_cspline_periodic, 0);
  cspline_d = interpolate(gsl_interp_cspline_periodic, 1);
  cspline_dd = interpolate(gsl_interp_cspline_periodic, 2);

  puts("# x   akima  cspline  akima'  cspline'  akima''  cspline''");
  for (i = -PTS/2; i < PTS/2; i++)
    printf("%0.5f %0.5f %0.5f %0.5f %0.5f %0.5f %0.5f\n",
           scale_x(i),
           akima[(i + PTS)%PTS],
           cspline[(i + PTS)%PTS],
           akima_d[(i + PTS)%PTS],
           cspline_d[(i + PTS)%PTS],
           akima_dd[(i + PTS)%PTS],
           cspline_dd[(i + PTS)%PTS]);

  free(akima);
  free(akima_d);
  free(akima_dd);
  free(cspline);
  free(cspline_d);
  free(cspline_dd);
  return 0;
}

static double*
interpolate(const gsl_interp_type *type, const size_t order)
{
  static const eval_func DERIV_ORDERS[] = {
    gsl_interp_eval,
    gsl_interp_eval_deriv,
    gsl_interp_eval_deriv2
  };
  static const char *DERIV_SYMS[] = {
    "",
    "'",
    "''"
  };

  gsl_interp *interp = gsl_interp_alloc(type, N);
  gsl_interp_accel *accel = gsl_interp_accel_alloc();
  double *plotpts = (double*)malloc(PTS*sizeof(double));
  int i;

  assert(order < sizeof(DERIV_ORDERS));
  gsl_interp_init(interp, x_values, y_values, N);
  for (i = 0; i < PTS; i++)
    plotpts[i] = DERIV_ORDERS[order](interp, x_values, y_values,
                                     scale_x(i), accel);

  for (i = 0; i < N-1; i++)
    check_discont(interp, DERIV_ORDERS[order], DERIV_SYMS[order],
                  x_values[i], accel);

  gsl_interp_free(interp);
  gsl_interp_accel_free(accel);

  return plotpts;
}

static void
check_discont(gsl_interp *interp, const eval_func func, const char *dsym,
              const double x, gsl_interp_accel *accel)
{
  double xm, xp;
  double ym, yp;

  xm = fmod(x - EPSILON + x_range, x_range);
  xp = fmod(x + EPSILON, x_range);
  ym = func(interp, x_values, y_values, xm, accel);
  yp = func(interp, x_values, y_values, xp, accel);
  if (fabs(yp - ym) > EPS) {
    fprintf(stderr, "discontinuity in %s%s at %f:\n"
                    "\t left value: %f\n"
                    "\tright value: %f\n"
                    "\t difference: %f\n\n",
            gsl_interp_name(interp), dsym, x, ym, yp, yp-ym);
  }
}


// --------------------------------------------------------------------------
//                   OpenMS -- Open-Source Mass Spectrometry
// --------------------------------------------------------------------------
// Copyright The OpenMS Team -- Eberhard Karls University Tuebingen,
// ETH Zurich, and Freie Universitaet Berlin 2002-2013.
//
// This software is released under a three-clause BSD license:
//  * 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.
//  * Neither the name of any author or any participating institution
//    may be used to endorse or promote products derived from this software
//    without specific prior written permission.
// For a full list of authors, refer to the file AUTHORS.
// --------------------------------------------------------------------------
// 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 ANY OF THE AUTHORS OR THE CONTRIBUTING
// INSTITUTIONS 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.
//
// --------------------------------------------------------------------------
// $Maintainer: Andreas Bertsch $
// $Authors: $
// --------------------------------------------------------------------------
//

#ifndef OPENMS_MATH_STATISTICS_GAUSSFITTER_H
#define OPENMS_MATH_STATISTICS_GAUSSFITTER_H

#include <OpenMS/DATASTRUCTURES/String.h>
#include <OpenMS/DATASTRUCTURES/DPosition.h>

#include <vector>

// gsl includes
#include <gsl/gsl_rng.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_multifit_nlin.h>

namespace OpenMS
{
  namespace Math
  {
    /**
        @brief Implements a fitter for gaussian functions

        This class fits a gaussian distribution to a number of data points.
        The results as well as the initial guess are specified using the struct GaussFitResult.

        The complete gaussian formula with the fitted parameters can be transformed into a
        gnuplot formula using getGnuplotFormula after fitting.

        The fitting is implemented using GSL fitting algorithms.

        @ingroup Math
    */
    class OPENMS_DLLAPI GaussFitter
    {
public:

      /// struct of parameters of a gaussian distribution
      struct GaussFitResult
      {
public:

        /// parameter A of gaussian distribution (amplitude)
        double A;

        /// parameter x0 of gaussian distribution (left/right shift)
        double x0;

        /// parameter sigma of gaussian distribution (width)
        double sigma;
      };

      /// Default constructor
      GaussFitter();

      /// Destructor
      virtual ~GaussFitter();

      /// sets the initial parameters used by the fit method as initial guess for the gaussian
      void setInitialParameters(const GaussFitResult & result);

      /**
          @brief Fits a gaussian distribution to the given data points

          @param points the data points used for the gaussian fitting

          @exception Exception::UnableToFit is thrown if fitting cannot be performed
      */
      GaussFitResult fit(std::vector<DPosition<2> > & points);

      /// return the gnuplot formula of the gaussian
      const String & getGnuplotFormula() const;

protected:

      static int gaussFitterf_(const gsl_vector * x, void * params, gsl_vector * f);

      static int gaussFitterdf_(const gsl_vector * x, void * params, gsl_matrix * J);

      static int gaussFitterfdf_(const gsl_vector * x, void * params, gsl_vector * f, gsl_matrix * J);

      void printState_(size_t iter, gsl_multifit_fdfsolver * s);

      GaussFitResult init_param_;

      String gnuplot_formula_;

private:

      /// Copy constructor (not implemented)
      GaussFitter(const GaussFitter & rhs);

      /// Assignment operator (not implemented)
      GaussFitter & operator=(const GaussFitter & rhs);
    };
  }
}

#endif