/* 生成sample for Regression */
/* theta12, m21 fixed */
/* theta23, theta13, m31 flat distribution in 3 sigma range */
/* deltacp flat distribution in 0~360 */

/* 使用方式(產100K組) :  ./sample_regression <filename.h5> <num> */
/* Caution: `num` should not greater than 1000. */

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include <sys/time.h>
#include <time.h>

#include <globes/globes.h>   /* GLoBES library */

#include <gsl/gsl_math.h>    /* GNU Scientific library (required for root finding) */
#include <gsl/gsl_roots.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_deriv.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_cdf.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_spline.h>
#include "hdf5.h"

#define degree M_PI/180

/***************************************************************************
 *                            M A I N   P R O G R A M                      *
 ***************************************************************************/

float keithRandom() {
	// Random number function based on the GNU Scientific Library
	// Returns a random float between 0 and 1, exclusive; e.g., (0,1)
	const 	gsl_rng_type * T;
	gsl_rng * r;
	gsl_rng_env_setup();
	struct 	timeval tv; // Seed generation based on time
	gettimeofday(&tv,0);
	unsigned long mySeed = tv.tv_sec + tv.tv_usec;
	T = gsl_rng_default; // Generator setup
	r = gsl_rng_alloc (T);
	gsl_rng_set(r, mySeed);
	double u = gsl_rng_uniform(r); // Generate it!
	gsl_rng_free (r);
	return (float)u;
}

double randn (double mu, double sigma) {
	/*mu is the central value, sigma is the width of gaussian distribution. */
	double U1, U2, W, mult;
	static double X1, X2;
	static int call = 0;

	if (call == 1) {
		call = !call;
		return (mu + sigma * (double) X2);
	}

	do{
		U1 = -1 + ((double) rand () / RAND_MAX) * 2;
		U2 = -1 + ((double) rand () / RAND_MAX) * 2;
		W = pow (U1, 2) + pow (U2, 2);
	} while (W >= 1 || W == 0);

	mult = sqrt ((-2 * log (W)) / W);
	X1 = U1 * mult;
	X2 = U2 * mult;

	call = !call;

	return (mu + sigma * (double) X1);
}

double TCRandom(double mu, double sigma) {
	// Random number function based on the GNU Scientific Library
	// Returns a random float between 0 and 1, exclusive; e.g., (0,1)
	const 	gsl_rng_type * T;
	gsl_rng * r;
	gsl_rng_env_setup();
	struct 	timeval tv; // Seed generation based on time
	gettimeofday(&tv,0);
	unsigned long mySeed = tv.tv_sec + tv.tv_usec;
	T = gsl_rng_default; // Generator setup
	r = gsl_rng_alloc (T);
	gsl_rng_set(r, mySeed);
	double u = mu + gsl_ran_gaussian(r, sigma); // Generate it!
	gsl_rng_free (r);

	return u;
}

int case_judger (int mode, double value) {
	/*
	 * mode 1: Octant;
	 * mode 2: CPV;
	 * mode 3: MO;
	 */
	int result;
	switch (mode){
		case 1:
			if ((value == 0) || (value==180)){
				result = 0;
			} else {
				result = 1;
			}
			break;
		case 2:
			if (value > 45) {
				result = 1;
			} else if (value == 45) {
				result = 0;
			} else {
				result = -1;
			}
			break;
	case 3:
		result = value > 0 ? 1 : -1;
		break;
	}
	return result;
}

int main(int argc, char *argv[]) {

	/* Initialize GLoBES and define chi^2 functions */
	glbInit(argv[0]);

	/*
	 * Read the prefix of file name and add suffix to two child string.
	 */
	char 	filename[32],
	 	 	Group_name[32],
		 	channel_info_dset_name[] = "/Spectrum/expr_0/channel_0\0",
		 	size_info_dset_name[] = "/Spectrum/expr_0/channel_0/Bin_ize\0",
		 	energy_info_dset_name[] = "/Spectrum/expr_0/channel_0/Bin_energy\0",
		 	expr_info_dset_name[] = "/Spectrum/expr_0\0";
	strcpy(filename, argv[1]);

	int  	TOTALsample = atof(argv[2]);

    /*
     * Declare the variables for hdf5.
     */
    hid_t	file_id,
			space_id,
			dset_id,
			group_id,
			sub_group_id,
			sub2_group_id,
			sub3_group_id;
    herr_t 	status;
    hsize_t	dims[2];

	/*
	 * Initialize experiment parameters.
	 */
	glbInitExperiment("./DUNE2021/DUNE_GLoBES.glb",&glb_experiment_list[0],&glb_num_of_exps);
	glbInitExperiment("./HK_globes/HK_combined_coarse.glb",&glb_experiment_list[0],&glb_num_of_exps);
	glb_params true_values = glbAllocParams();

	/* Set standard oscillation parameters (cf. hep-ph/0405172v5) */
	double theta12_c = 33.44;
	// double theta13_c = 8.57;
	// double theta23_c = 45;
	double sdm_c = 7.42;
	// double ldm_c = 2.514;

	double delta_12  = (35.86 - 31.27)/2;
	double delta_13  = (8.97 - 8.20)/2;
	double delta_23  = (51.80 - 39.60)/2;
	double delta_sdm = (8.04 - 6.82)/2;
	double delta_ldm = (2.598 - 2.431)/2;

	int    num_simulatiom;

	int    ew_low, ew_high;
	int    i, j, num_expriment, channel;

	file_id   = H5Fcreate(filename, H5F_ACC_TRUNC, H5P_DEFAULT, H5P_DEFAULT);
	group_id = H5Gcreate(file_id, "/Spectrum", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
	for ( num_expriment = 0;  num_expriment < 2;  num_expriment++){
		double *bin_c_energy  =   glbGetBinCentersListPtr( num_expriment );
		double *bin_size      =   glbGetBinSizeListPtr( num_expriment );
		int    channel_max    =   glbGetNumberOfRules( num_expriment );

		expr_info_dset_name[15] = num_expriment+'0';
		sub_group_id = H5Gcreate(file_id, expr_info_dset_name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
		for(channel=0;channel<channel_max;channel++){
			glbGetEnergyWindowBins( num_expriment, channel, &ew_low, &ew_high);
			int energy_window = ew_high - ew_low;
			hsize_t dims_s[1] = {energy_window};

			double dset_channel_eng[energy_window];
			double dset_channel_size[energy_window];

			j = 0;
			for ( i = ew_low; i <= ew_high; i++) {
				dset_channel_eng[j]  = bin_c_energy[i];
				dset_channel_size[j] = bin_size[i];
				j += 1;
			}

			channel_info_dset_name[15]  =  num_expriment+'0';
			channel_info_dset_name[25]  =  channel+'0';
			energy_info_dset_name[15]   =  num_expriment+'0';
			energy_info_dset_name[25]   =  channel+'0';
	 	    size_info_dset_name[15]   =  num_expriment+'0';
			size_info_dset_name[25]   =  channel+'0';

			sub2_group_id =  H5Gcreate(file_id, channel_info_dset_name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
			space_id  =  H5Screate_simple(1, dims_s, NULL);

			dset_id       =  H5Dcreate(sub2_group_id, energy_info_dset_name, H5T_NATIVE_DOUBLE, space_id, H5P_DEFAULT, H5P_DEFAULT,
						            H5P_DEFAULT);
			status        =  H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, H5P_DEFAULT, dset_channel_eng);
			status        =  H5Dclose(dset_id);
			dset_id       =  H5Dcreate(sub2_group_id, size_info_dset_name, H5T_NATIVE_DOUBLE, space_id, H5P_DEFAULT, H5P_DEFAULT,
						            H5P_DEFAULT);
			status        =  H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, H5P_DEFAULT, dset_channel_size);
			status        =  H5Dclose(dset_id);
			status        =  H5Sclose(space_id);
			status        =  H5Gclose(sub2_group_id);
		}
		status        =  H5Gclose(sub_group_id);
	}
	status        =  H5Gclose(group_id);

	double     dataset[TOTALsample][9],
			   TRUE_RATE[TOTALsample][2][4][8],
			   TRUE_RATE_PRIME[2][4][8][TOTALsample];
	for (num_simulatiom=0;num_simulatiom<TOTALsample;num_simulatiom++){

		// double theta12 = TCRandom (theta12_c, delta_12 );
		// double theta13 = TCRandom (theta13_c, delta_13 );
		// double theta23 = TCRandom (theta23_c, delta_23 );
		// double sdm     = TCRandom (    sdm_c, delta_sdm);  //eV^2
		// double ldm     = TCRandom (    ldm_c, delta_ldm);  //eV^2

		// double theta12 = (35.86+31.27)/2 + (keithRandom()-0.5)*(35.86-31.27);
		double theta13 = ( 8.97+ 8.20)/2 + (keithRandom()-0.5)*( 8.97- 8.20);
		double theta23 = (45 + 45)/2 + (keithRandom()-0.5)*(51.80-39.60);
		// double sdm = ( 8.04 + 6.82)/2 + (keithRandom()-0.5)*( 8.04- 6.82);
		double ldm = (2.598 + 2.431)/2 + (keithRandom()-0.5)*(2.598-2.431);

		double sign_ldm = 1;
		if ( keithRandom() < 0.5) sign_ldm = -1;
		ldm = sign_ldm * ldm;

		// if(keithRandom()<0.33) {theta23 = 45;}

		double deltacp = keithRandom()*360.0*2.0-180.0;
		if (deltacp<0){
			deltacp=0;
		}	else if (deltacp>360){
			deltacp=180;
		}

		//double deltacp = keithRandom() * 360.0;

		int octant = case_judger(1, theta23);
		int cpv    = case_judger(2, deltacp);
		int mo     = case_judger(3, ldm);

		glbDefineParams(true_values,theta12_c*degree,theta13*degree,theta23*degree,deltacp*degree,1e-5*sdm_c,1e-3*ldm);
		glbSetDensityParams(true_values,1.0,GLB_ALL);

		glbSetOscillationParameters(true_values);
		glbSetRates();

		num_expriment = 0;
		channel = 0;

		for ( num_expriment = 0; num_expriment < 2; num_expriment++){
			int channel_max = glbGetNumberOfRules( num_expriment );
			for ( channel = 0; channel < channel_max ; channel++){
				glbGetEnergyWindowBins( num_expriment, channel, &ew_low, &ew_high);
				double *true_rates = glbGetRuleRatePtr( num_expriment, channel );
				int count = 0;
				for (i=ew_low; i <= ew_high; i++){
					TRUE_RATE[num_simulatiom][num_expriment][channel][count] = true_rates[i];
					count += 1;
				}
			}
		}
	 	double tmp_array[9] = {theta12_c, theta13, theta23, deltacp, sdm_c, ldm, octant, cpv, mo};
		int  count = 0;
		for ( count = 0; count < 9; count++){
			dataset[num_simulatiom][count] = tmp_array[count];
		}
	}
	int k, l;
	for ( i = 0; i < TOTALsample; i++){
		for ( j = 0; j < 2; j++){
			for ( k = 0; k < 4; k++){
				for ( l = 0; l < 8; l++){
			   		TRUE_RATE_PRIME[j][k][l][i] = TRUE_RATE[i][j][k][l];
			   	}
			}
		}
	}

	char 	channel_spec_true_name[] = "/Parameter/true/expr_0/channel_0\0",
		 	expr_spec_true_name[]    = "/Parameter/true/expr_0\0",
		 	expr_spec_sim_name[]     = "/Parameter/simulation\0";

	hsize_t dims_s[2]    =  {TOTALsample, 8};
	group_id     		 =  H5Gcreate(file_id, "/Parameter", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
	sub_group_id 		 =  H5Gcreate(file_id, "/Parameter/true/", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
	for ( i = 0; i < 2; i ++){
		expr_spec_true_name[21] = i+'0';
		sub2_group_id =  H5Gcreate(file_id, expr_spec_true_name, H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
		for ( j = 0; j < 4; j++){
			channel_spec_true_name[21] = i+'0';
			channel_spec_true_name[31] = j+'0';
			space_id      =  H5Screate_simple(2, dims_s, NULL);
			dset_id       =  H5Dcreate(sub2_group_id, channel_spec_true_name, H5T_NATIVE_DOUBLE, space_id, H5P_DEFAULT, H5P_DEFAULT,
				                H5P_DEFAULT);
			status        =  H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, H5P_DEFAULT, TRUE_RATE_PRIME[i][j]);
			status        =  H5Dclose(dset_id);
			status        =  H5Sclose(space_id);
		}
		status        =  H5Gclose(sub2_group_id);
	}
    status        =  H5Gclose(sub_group_id);

	hsize_t dims_d[2]    = 	{TOTALsample, 9};
	sub_group_id  		 =  H5Gcreate(file_id, "/Parameter/simulation/", H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT);
	space_id      		 =  H5Screate_simple(2, dims_d, NULL);
	dset_id       		 =  H5Dcreate(sub_group_id, "/Parameter/simulation/dataset", H5T_NATIVE_DOUBLE, space_id, H5P_DEFAULT, H5P_DEFAULT,
		                        H5P_DEFAULT);
	status        		 =  H5Dwrite(dset_id, H5T_NATIVE_DOUBLE, H5S_ALL, H5S_ALL, H5P_DEFAULT, dataset);
	status        		 =  H5Dclose(dset_id);
	status        		 =  H5Sclose(space_id);
	status        		 =  H5Gclose(sub_group_id);
	status        		 =  H5Gclose(group_id);

	/* Clean up */
	glbFreeParams(true_values);

	status        =  H5Fclose(file_id);
	return 0;
}


#include <math.h>
#include <gsl/gsl_math.h>
#include <egsl/egsl_macros.h>

#include "icp.h"
#include "../csm_all.h"

val compute_C_k(val p_j1, val p_j2);
val dC_drho(val p1, val p2);

void compute_covariance_exact(
	LDP laser_ref, LDP laser_sens, const gsl_vector*x,
		val *cov0_x, val *dx_dy1, val *dx_dy2)
{
	egsl_push_named("compute_covariance_exact");

	val d2J_dxdy1 = zeros(3,(size_t)laser_ref ->nrays);
	val d2J_dxdy2 = zeros(3,(size_t)laser_sens->nrays);

	/* the three pieces of d2J_dx2 */
	val d2J_dt2       = zeros(2,2);
	val d2J_dt_dtheta = zeros(2,1);
	val d2J_dtheta2   = zeros(1,1);

	double theta = x->data[2];
	val t = egsl_vFa(2,x->data);

	int i;
	for(i=0;i<laser_sens->nrays;i++) {
		if(!ld_valid_corr(laser_sens,i)) continue;
		egsl_push_named("compute_covariance_exact iteration");

		int j1 = laser_sens->corr[i].j1;
		int j2 = laser_sens->corr[i].j2;

		val p_i  = egsl_vFa(2, laser_sens->points[i].p);
		val p_j1 = egsl_vFa(2, laser_ref ->points[j1].p);
		val p_j2 = egsl_vFa(2, laser_ref ->points[j2].p);

		/* v1 := rot(theta+M_PI/2)*p_i */
		val v1 = m(rot(theta+M_PI/2), p_i);
		/* v2 := (rot(theta)*p_i+t-p_j1) */
		val v2 = sum3( m(rot(theta),p_i), t, minus(p_j1));
		/* v3 := rot(theta)*v_i */
		val v3 = vers(theta + laser_sens->theta[i]);
		/* v4 := rot(theta+PI/2)*v_i; */
		val v4 = vers(theta + laser_sens->theta[i] + M_PI/2);

		val C_k = compute_C_k(p_j1, p_j2);

		val d2J_dt2_k = sc(2.0, C_k);
		val d2J_dt_dtheta_k = sc(2.0,m(C_k,v1));

		val v_new = m(rot(theta+M_PI), p_i);
		val d2J_dtheta2_k = sc(2.0, sum( m3(tr(v2),C_k, v_new), m3(tr(v1),C_k,v1)));
		add_to(d2J_dt2, d2J_dt2_k);
		add_to(d2J_dt_dtheta, d2J_dt_dtheta_k );
		add_to(d2J_dtheta2, d2J_dtheta2_k);

		/* for measurement rho_i  in the second scan */
		val d2Jk_dtdrho_i = sc(2.0, m(C_k,v3));
		val d2Jk_dtheta_drho_i = sc(2.0, sum( m3(tr(v2),C_k,v4),  m3(tr(v3),C_k,v1)));
 		add_to_col(d2J_dxdy2, (size_t)i, comp_col(d2Jk_dtdrho_i, d2Jk_dtheta_drho_i));

		/* for measurements rho_j1, rho_j2 in the first scan */

		val dC_drho_j1 = dC_drho(p_j1, p_j2);
		val dC_drho_j2 = dC_drho(p_j2, p_j1);

		val v_j1 = vers(laser_ref->theta[j1]);

		val d2Jk_dt_drho_j1 = sum(sc(-2.0,m(C_k,v_j1)), sc(2.0,m(dC_drho_j1,v2)));
		val d2Jk_dtheta_drho_j1 = sum( sc(-2.0, m3(tr(v_j1),C_k,v1)), m3(tr(v2),dC_drho_j1,v1));
		add_to_col(d2J_dxdy1, (size_t)j1, comp_col(d2Jk_dt_drho_j1, d2Jk_dtheta_drho_j1));

		/* for measurement rho_j2*/
		val d2Jk_dt_drho_j2 = sc(2.0, m( dC_drho_j2,v2));
		val d2Jk_dtheta_drho_j2 = sc(2.0, m3( tr(v2), dC_drho_j2, v1));
		add_to_col(d2J_dxdy1, (size_t)j2, comp_col(d2Jk_dt_drho_j2, d2Jk_dtheta_drho_j2));

		egsl_pop_named("compute_covariance_exact iteration");
	}

	/* composes matrix  d2J_dx2  from the pieces*/
	val d2J_dx2   = comp_col( comp_row(    d2J_dt2      ,   d2J_dt_dtheta),
	                          comp_row(tr(d2J_dt_dtheta),     d2J_dtheta2));

	val edx_dy1 = sc(-1.0, m(inv(d2J_dx2), d2J_dxdy1));
	val edx_dy2 = sc(-1.0, m(inv(d2J_dx2), d2J_dxdy2));

	val ecov0_x = sum(m(edx_dy1,tr(edx_dy1)),m(edx_dy2,tr(edx_dy2)) );

	/* With the egsl_promote we save the matrix in the previous
	   context */
	*cov0_x = egsl_promote(ecov0_x);
	*dx_dy1 = egsl_promote(edx_dy1);
	*dx_dy2 = egsl_promote(edx_dy2);

	egsl_pop_named("compute_covariance_exact");
	/* now edx_dy1 is not valid anymore, but *dx_dy1 is. */
}

val compute_C_k(val p_j1, val p_j2)  {
	val d = sub(p_j1, p_j2);
	double alpha = M_PI/2 + atan2( atv(d,1), atv(d,0));
	double c = cos(alpha); double s = sin(alpha);
	double m[2*2] = {
		c*c, c*s,
		c*s, s*s
	};
	return egsl_vFda(2,2,m);
}

val dC_drho(val p1, val p2) {
	double eps = 0.001;

	val C_k = compute_C_k(p1, p2);
	val p1b = sum(p1, sc(eps/egsl_norm(p1),p1));
	val C_k_eps = compute_C_k(p1b,p2);
	return sc(1/eps, sub(C_k_eps,C_k));
}


#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <stdarg.h>
#include <gbpLib.h>
#include <gbpMath.h>
#include <gbpCosmo_mass_functions.h>
#include <gsl/gsl_integration.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_spline.h>

// Compute cumulative comoving mass function
typedef struct mass_function_cumulative_params_struct mass_function_cumulative_params;
struct mass_function_cumulative_params_struct {
    cosmo_info **cosmo;
    double       z;
    int          mode;
    double *     P;
};
double mass_function_cumulative_integrand(double lM, void *params_in);
double mass_function_cumulative_integrand(double lM, void *params_in) {
    mass_function_cumulative_params *params;
    params       = (mass_function_cumulative_params *)params_in;
    double M     = take_alog10(lM);
    double r_val = mass_function(M, params->z, params->cosmo, params->mode, params->P);
    return (r_val);
}
double mass_function_cumulative(double M_interp, double z, cosmo_info **cosmo, int mode, ...) {
    va_list vargs;
    va_start(vargs, mode);

    // Get passed parameters (if mode specifies they are there).
    double *P = NULL;
    if(SID_CHECK_BITFIELD_SWITCH(mode, MF_PASS_PARAMS))
        P = (double *)va_arg(vargs, double *);

    // Initialize integral
    if(!ADaPS_exist((*cosmo), "lk_P"))
        init_power_spectrum_TF(cosmo);
    double *lk_P     = (double *)ADaPS_fetch((*cosmo), "lk_P");
    double  limit_lo = take_log10(M_interp);
    double  limit_hi = take_log10(M_of_k(take_alog10(lk_P[0]), (*cosmo)));

    // Perform integral
    int    n_int        = 5000;
    double rel_accuracy = 1e-4;
    double r_val        = 0.;
    if(limit_lo < limit_hi) {
        double                          abs_error;
        mass_function_cumulative_params params;
        gsl_function                    integrand;
        gsl_integration_workspace *     wspace;
        params.z           = z;
        params.cosmo       = cosmo;
        params.mode        = mode;
        params.P           = P;
        integrand.function = mass_function_cumulative_integrand;
        integrand.params   = (void *)(&params);
        wspace             = gsl_integration_workspace_alloc(n_int);

        // Integrate mass function
        gsl_integration_qag(&integrand, limit_lo, limit_hi, 0, rel_accuracy, n_int, GSL_INTEG_GAUSS61, wspace, &r_val, &abs_error);

        // Clean-up
        gsl_integration_workspace_free(wspace);
    }

    va_end(vargs);
    return (r_val);
}


#ifndef __COMPLEX_DEF_H__
#define __COMPLEX_DEF_H__

#include <complex>
#include <gsl/gsl_math.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_log.h>
#include <gsl/gsl_sf_zeta.h>
#include <gsl/gsl_sf_dilog.h>
#include <gsl/gsl_sf_result.h>

std::complex<long double> operator*(const std::complex<long double>& a, const double& b);

std::complex<long double> operator*(const double& a,const std::complex<long double>& b);

std::complex<long double> operator/(const std::complex<long double>& a, const double& b);

std::complex<long double> operator/(const double& a,const std::complex<long double>& b);

std::complex<long double> operator-(const std::complex<long double>& a, const double& b);

std::complex<long double> operator-(const double& a,const std::complex<long double>& b);

std::complex<long double> operator+(const std::complex<long double>& a, const double& b);

std::complex<long double> operator+(const double& a,const std::complex<long double>& b);

//Useful Math functions
long double log_r(long double x);
long double dilog_r(long double x);

const std::complex<long double> II(0.0,1.0);
std::complex<long double> log_c(std::complex<long double> z);
std::complex<long double> dilog_c(std::complex<long double> z);
#endif /* __COMPLEX_DEF_H__ */


//This does CELL (~soma) stage of GRU (gated recurrent unit) model.
//This requires each neuron to have 3 input time series, X, Xr, Xz,
//where X is the usual input and Xr, Xz the inputs for the reset and update gates,
//stacked into X = [X; Xr; Xz] for dim=0, or X = [X Xr Xz] for dim=1.

//For dim=0, R[:,t] = sig{Xr[:,t] + Ur*Y[:,t-1]} \n";
//           Z[:,t] = sig{Xz[:,t] + Uz*Y[:,t-1]} \n";
//           H[:,t] = R[:,t].*Y[:,t-1] \n";
//           Y[:,t] = Z[:,t].*Y[:,t-1] + (1-Z[:,t]).*tanh{X[:,t] + U*H[:,t]} \n";
//with sizes X, Xr, Xz: N x T \n";
//           U, Ur, Uz: N x N \n";
//           Y        : N x T \n";
//
//For dim=1, R[t,:] = sig{Xr[t,:] + Y[t-1,:]*Ur} \n";
//           Z[t,:] = sig{Xz[t,:] + Y[t-1,:]*Uz} \n";
//           H[t,:] = R[t,:].*Y[t-1,:] \n";
//           Y[t,:] = Z[t,:].*Y[t-1,:] + (1-Z[t,:]).*tanh{X[t,:] + H[t,:]*U} \n";
//with sizes X, Xr, Xz: T x N \n";
//           U, Ur, Uz: N x N \n";
//           Y        : T x N \n";
//
//where sig is the logistic (sigmoid) nonlinearity = 1/(1+exp(-x)),
//R is the reset gate, Z is the update gate, H is an intermediate (hidden) vector,
//U, Ur, Uz are NxN matrices, and Y is the output.

//Note that, the neurons of a layer are independent only if U, Ur, Uz are diagonal matrices.
//This is only really a CELL (~soma) stage in that case.

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <cblas.h>

#ifdef __cplusplus
namespace codee {
extern "C" {
#endif

int gru_s (float *Y, const float *X, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);
int gru_d (double *Y, const double *X, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);

int gru_inplace_s (float *X, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);
int gru_inplace_d (double *X, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim);

int gru_s (float *Y, const float *X, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const float o = 1.0f;
    const size_t N2 = 2*N, NT = N*T, NT2 = 2*N*T;
    size_t nT, tN, tN3;

    float *R, *Z, *H;
    if (!(R=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_s: problem with malloc. "); perror("malloc"); return 1; }

    if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                //R[n] = 1.0f / (1.0f+expf(-X[N+n]));
                Z[n] = 1.0f / (1.0f+expf(-X[N2+n]));
                Y[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_scopy((int)N,&X[tN3+N],1,R,1); cblas_scopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    //R[n] = 1.0f / (1.0f+expf(-R[n]));
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    //H[n] = R[n] * Y[tN-N+n];
                    H[n] = Y[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[tN3],1,&Y[tN],1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0f-Z[n])*tanhf(Y[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-X[NT2+nT]));
                Y[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&X[NT+t],(int)T,R,1); cblas_scopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0f-Z[n])*tanhf(Y[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-X[NT2+nT]));
                Y[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&X[NT+t],(int)T,R,1); cblas_scopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0f-Z[n])*tanhf(Y[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0f / (1.0f+expf(-X[N2+n]));
                Y[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_scopy((int)N,&X[tN3+N],1,R,1); cblas_scopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0f+expf(-R[n]));
                }
                cblas_scopy((int)N,&X[tN3],1,&Y[tN],1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0f-Z[n])*tanhf(Y[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru_s: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru_d (double *Y, const double *X, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const double o = 1.0;
    const size_t N2 = 2*N, NT = N*T, NT2 = 2*N*T;
    size_t nT, tN, tN3;

    double *R, *Z, *H;
    if (!(R=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_d: problem with malloc. "); perror("malloc"); return 1; }

    if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-X[N2+n]));
                Y[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_dcopy((int)N,&X[tN3+N],1,R,1); cblas_dcopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[tN3],1,&Y[tN],1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0-Z[n])*tanh(Y[tN+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-X[NT2+nT]));
                Y[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&X[NT+t],(int)T,R,1); cblas_dcopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0-Z[n])*tanh(Y[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-X[NT2+nT]));
                Y[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&X[NT+t],(int)T,R,1); cblas_dcopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[t],(int)T,&Y[t],(int)T);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    Y[t+nT] = Z[n]*Y[t-1+nT] + (1.0-Z[n])*tanh(Y[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-X[N2+n]));
                Y[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_dcopy((int)N,&X[tN3+N],1,R,1); cblas_dcopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&Y[tN-N],1,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&Y[tN-N],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = Y[tN-N+n] / (1.0+exp(-R[n]));
                }
                cblas_dcopy((int)N,&X[tN3],1,&Y[tN],1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&Y[tN],1);
                for (size_t n=0u; n<N; ++n)
                {
                    Y[tN+n] = Z[n]*Y[tN-N+n] + (1.0-Z[n])*tanh(Y[tN+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru_d: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru_inplace_s (float *X, const float *U, const float *Ur, const float *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const float o = 1.0f;
    const size_t N2 = 2*N, N3 = 3*N, NT = N*T, NT2 = 2*N*T;
    size_t nT, tN, tN3;

    float *R, *Z, *H;
    if (!(R=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_inplace_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_inplace_s: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(float *)malloc(N*sizeof(float)))) { fprintf(stderr,"error in gru_inplace_s: problem with malloc. "); perror("malloc"); return 1; }

    //clock_gettime(CLOCK_REALTIME,&tic);
    if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0f / (1.0f+expf(-X[N2+n]));
                X[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_scopy((int)N,&X[tN3+N],1,R,1); cblas_scopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN3-N3],1,o,R,1);
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN3-N3],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[tN3-N3+n] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN3],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN3+n] = Z[n]*X[tN-N3+n] + (1.0f-Z[n])*tanhf(X[tN3+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-X[NT2+nT]));
                X[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&X[NT+t],(int)T,R,1); cblas_scopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0f-Z[n])*tanhf(X[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0f / (1.0f+expf(-X[NT2+nT]));
                X[nT] = (1.0f-Z[n]) * tanhf(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_scopy((int)N,&X[NT+t],(int)T,R,1); cblas_scopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0f-Z[n])*tanhf(X[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0f / (1.0f+expf(-X[N2+n]));
                X[n] = (1.0f-Z[n]) * tanhf(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_scopy((int)N,&X[tN3+N],1,R,1); cblas_scopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN3-N3],1,o,R,1);
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN3-N3],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0f / (1.0f+expf(-Z[n]));
                    H[n] = X[tN3-N3+n] / (1.0f+expf(-R[n]));
                }
                cblas_sgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN3],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN3+n] = Z[n]*X[tN-N3+n] + (1.0f-Z[n])*tanhf(X[tN3+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru_inplace_s: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

int gru_inplace_d (double *X, const double *U, const double *Ur, const double *Uz, const size_t N, const size_t T, const char iscolmajor, const size_t dim)
{
    const double o = 1.0;
    const size_t N2 = 2*N, N3 = 3*N, NT = N*T, NT2 = 2*N*T;
    size_t nT, tN, tN3;

    double *R, *Z, *H;
    if (!(R=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_inplace_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(Z=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_inplace_d: problem with malloc. "); perror("malloc"); return 1; }
    if (!(H=(double *)malloc(N*sizeof(double)))) { fprintf(stderr,"error in gru_inplace_d: problem with malloc. "); perror("malloc"); return 1; }

    if (dim==0u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-X[N2+n]));
                X[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_dcopy((int)N,&X[tN3+N],1,R,1); cblas_dcopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN3-N3],1,o,R,1);
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN3-N3],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[tN3-N3+n] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasColMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN3],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN3+n] = Z[n]*X[tN-N3+n] + (1.0-Z[n])*tanh(X[tN3+n]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-X[NT2+nT]));
                X[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&X[NT+t],(int)T,R,1); cblas_dcopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,Uz,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasRowMajor,CblasNoTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0-Z[n])*tanh(X[t+nT]);
                }
            }
        }
    }
    else if (dim==1u)
    {
        if (iscolmajor)
        {
            for (size_t n=0u; n<N; ++n)
            {
                nT = n*T;
                Z[n] = 1.0 / (1.0+exp(-X[NT2+nT]));
                X[nT] = (1.0-Z[n]) * tanh(X[nT]);
            }
            for (size_t t=1; t<T; ++t)
            {
                cblas_dcopy((int)N,&X[NT+t],(int)T,R,1); cblas_dcopy((int)N,&X[NT2+t],(int)T,Z,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[t-1],(int)T,o,R,1);
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[t-1],(int)T,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[t-1+n*T] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasColMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[t],(int)T);
                for (size_t n=0u; n<N; ++n)
                {
                    nT = n*T;
                    X[t+nT] = Z[n]*X[t-1+nT] + (1.0-Z[n])*tanh(X[t+nT]);
                }
            }
        }
        else
        {
            for (size_t n=0u; n<N; ++n)
            {
                Z[n] = 1.0 / (1.0+exp(-X[N2+n]));
                X[n] = (1.0-Z[n]) * tanh(X[n]);
            }
            for (size_t t=1; t<T; ++t)
            {
                tN = t*N; tN3 = 3*tN;
                cblas_dcopy((int)N,&X[tN3+N],1,R,1); cblas_dcopy((int)N,&X[tN3+N2],1,Z,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Ur,(int)N,&X[tN3-N3],1,o,R,1);
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,Uz,(int)N,&X[tN3-N3],1,o,Z,1);
                for (size_t n=0u; n<N; ++n)
                {
                    Z[n] = 1.0 / (1.0+exp(-Z[n]));
                    H[n] = X[tN3-N3+n] / (1.0+exp(-R[n]));
                }
                cblas_dgemv(CblasRowMajor,CblasTrans,(int)N,(int)N,o,U,(int)N,H,1,o,&X[tN3],1);
                for (size_t n=0u; n<N; ++n)
                {
                    X[tN3+n] = Z[n]*X[tN-N3+n] + (1.0-Z[n])*tanh(X[tN3+n]);
                }
            }
        }
    }
    else
    {
        fprintf(stderr,"error in gru_inplace_d: dim must be 0 or 1.\n"); return 1;
    }

    return 0;
}

#ifdef __cplusplus
}
}
#endif


#include "asf.h"
#include "asf_meta.h"
#include <unistd.h>

#include <gsl/gsl_errno.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_multiroots.h>

struct refine_offset_params {
        meta_parameters *meta;
        double x_off, y_off;
};

static double err_at_pixel(struct refine_offset_params *p, double off_t,
                           double off_x, double line, double samp)
{
    const double huge_err = 999999.9;

    meta_parameters *meta = p->meta;
    double line_out, samp_out;
    double lat, lon;
    int bad=0;

    double saved_timeOffset = meta->sar->time_shift;
    double saved_slant = meta->sar->slant_shift;

    // converting the pixel's location back to lat/lon is done before
    // applying the prospective slant and range shifts.
    bad = meta_get_latLon(meta, line, samp, 0.0, &lat, &lon);
    if (bad) { printf("bad: meta_get_latLon\n"); return huge_err; }

    meta->sar->time_shift += off_t;
    meta->sar->slant_shift += off_x;

    bad = meta_get_lineSamp(meta, lat, lon, 0.0, &line_out, &samp_out);

    meta->sar->time_shift = saved_timeOffset;
    meta->sar->slant_shift = saved_slant;

    // meta_get_lineSamp returns a non-zero value if, for the specified
    // lat&lon, we weren't able to determine a line & sample.  In this case,
    // we just return a giant error value.
    if (bad) { printf("bad: meta_get_lineSamp\n"); return huge_err; }

    //printf("trying %f,%f\n",off_t,off_x);
    //printf("at %7.3f,%7.3f,%7.3f,%7.3f,%7.3f,%7.3f,%7.3f,%7.3f -> %7.3f\n",
    //       off_t, off_x, line, samp, line_out, samp_out, p->y_off, p->x_off,
    //       fabs(line-line_out-p->y_off)+fabs(samp-samp_out-p->x_off));
    double xdiff = line_out - line - p->y_off;
    double ydiff = samp_out - samp - p->x_off;
    return sqrt(xdiff*xdiff + ydiff*ydiff);
}

static int
getObjective(const gsl_vector *x, void *params, gsl_vector *f)
{
    double off_t = gsl_vector_get(x,0);
    double off_x = gsl_vector_get(x,1);

    if (!meta_is_valid_double(off_x) ||
        !meta_is_valid_double(off_t)) {
        // This does happen sometimes, when we've already found the root
	return GSL_FAILURE;
    }

    struct refine_offset_params *p = (struct refine_offset_params *)params;
    meta_parameters *meta = p->meta;

    int nl = meta->general->line_count;
    int ns = meta->general->sample_count;

    double err = 0.0;

    err += err_at_pixel(p, off_t, off_x, nl/8, ns/8);
    err += err_at_pixel(p, off_t, off_x, 7*nl/8, ns/8);
    err += err_at_pixel(p, off_t, off_x, nl/8, 7*ns/8);
    err += err_at_pixel(p, off_t, off_x, 7*nl/8, 7*ns/8);

    err += err_at_pixel(p, off_t, off_x, nl/8, ns/2);
    err += err_at_pixel(p, off_t, off_x, 7*nl/8, ns/2);
    err += err_at_pixel(p, off_t, off_x, nl/2, 7*ns/8);
    err += err_at_pixel(p, off_t, off_x, nl/2, ns/8);

    err += err_at_pixel(p, off_t, off_x, nl/2, ns/2);

    gsl_vector_set(f,0,err);
    gsl_vector_set(f,1,err);
    return GSL_SUCCESS;
}

/*
static void print_state(int iter, gsl_multiroot_fsolver *s)
{
    printf("iter = %3d   x = (%.3f %.3f)   f(x) = %.8f\n", iter,
           gsl_vector_get(s->x, 0), gsl_vector_get(s->x, 1),
           gsl_vector_get(s->f, 0));
}
*/

static void coarse_search(double t_extent_min, double t_extent_max,
                          double x_extent_min, double x_extent_max,
                          double *t_min, double *x_min,
                          struct refine_offset_params *params)
{
    double the_min = 9999999;
    double min_t=99, min_x=99;
    int i,j,k=6;
    double t_extent = t_extent_max - t_extent_min;
    double x_extent = x_extent_max - x_extent_min;
    gsl_vector *v = gsl_vector_alloc(2);
    gsl_vector *u = gsl_vector_alloc(2);
    //printf("           ");
    //for (j = 0; j <= k; ++j) {
    //    double x = x_extent_min + ((double)j)/k*x_extent;
    //    printf("%9.3f ", x);
    //}
    //printf("\n           ");
    //for (j = 0; j <= k; ++j)
    //    printf("--------- ");
    //printf("\n");
    for (i = 0; i <= k; ++i) {
        double t = t_extent_min + ((double)i)/k*t_extent;
        //printf("%9.3f | ", t);

        for (j = 0; j <= k; ++j) {
            double x = x_extent_min + ((double)j)/k*x_extent;

            gsl_vector_set(v, 0, t);
            gsl_vector_set(v, 1, x);
            getObjective(v,(void*)params, u);
            double n = gsl_vector_get(u,0);
            //printf("%9.3f ", n);
            if (n<the_min) {
                the_min=n;
                min_t=gsl_vector_get(v,0);
                min_x=gsl_vector_get(v,1);
            }
        }
        //printf("\n");
    }

    *t_min = min_t;
    *x_min = min_x;

    gsl_vector_free(v);
    gsl_vector_free(u);
}

static void generate_start(struct refine_offset_params *params,
                           double *start_t, double *start_x)
{
    int i;

    double extent_t_min = -10;
    double extent_t_max = 10;

    double extent_x_min = -5000;
    double extent_x_max = 5000;

    double t_range = extent_t_max - extent_t_min;
    double x_range = extent_x_max - extent_x_min;

    for (i = 0; i < 12; ++i)
    {
        coarse_search(extent_t_min, extent_t_max, extent_x_min, extent_x_max,
                      start_t, start_x, params);

        t_range /= 3;
        x_range /= 3;

        extent_t_min = *start_t - t_range/2;
        extent_t_max = *start_t + t_range/2;

        extent_x_min = *start_x - x_range/2;
        extent_x_max = *start_x + x_range/2;

        //printf("refining search to region: (%9.3f,%9.3f)\n"
        //       "                           (%9.3f,%9.3f)\n",
        //       extent_t_min, extent_t_max,
        //       extent_x_min, extent_x_max);
    }

}

void refine_offset(double x_off, double y_off, meta_parameters *meta,
                   double *out_t, double *out_x)
{
    int status;
    int iter = 0, max_iter = 1000;
    const gsl_multiroot_fsolver_type *T;
    gsl_multiroot_fsolver *s;
    gsl_error_handler_t *prev;
    struct refine_offset_params params;
    const size_t n = 2;

    params.meta = meta;
    params.x_off = x_off;
    params.y_off = y_off;

    gsl_multiroot_function F = {&getObjective, n, &params};
    gsl_vector *x = gsl_vector_alloc(n);

    double start_t, start_x;
    generate_start(&params, &start_t, &start_x);
    //printf("Starting point at (%f,%f)\n", start_t, start_x);

    gsl_vector_set (x, 0, start_t);
    gsl_vector_set (x, 1, start_x);

    T = gsl_multiroot_fsolver_hybrid;
    s = gsl_multiroot_fsolver_alloc(T, n);
    gsl_multiroot_fsolver_set(s, &F, x);

    prev = gsl_set_error_handler_off();

    do {
        ++iter;
        status = gsl_multiroot_fsolver_iterate(s);

        //print_state(iter, s);

        // abort if stuck
        if (status) break;

        status = gsl_multiroot_test_residual (s->f, 1e-8);
    } while (status == GSL_CONTINUE && iter < max_iter);

    *out_t = gsl_vector_get(s->x, 0);
    *out_x = gsl_vector_get(s->x, 1);

    gsl_vector *retrofit = gsl_vector_alloc(n);
    gsl_vector_set(retrofit, 0, *out_t);
    gsl_vector_set(retrofit, 1, *out_x);
    gsl_vector *output = gsl_vector_alloc(n);
    getObjective(retrofit, (void*)&params, output);
    //double val= gsl_vector_get(output,0);
    //printf("GSL Result: %f at (%f,%f)\n", val, *out_t, *out_x);
    gsl_vector_free(retrofit);
    gsl_vector_free(output);

    gsl_multiroot_fsolver_free(s);
    gsl_vector_free(x);
    gsl_set_error_handler(prev);
}


#ifndef VolViz_Types_h
#define VolViz_Types_h

#include <Eigen/Core>
#include <Eigen/Geometry>
#include <gsl/gsl>
#include <phys/units/quantity.hpp>

#include <array>

namespace VolViz {

using namespace gsl;

using Vector3f = Eigen::Vector3f;

using Matrix3 = Eigen::Matrix3f;
using Matrix4 = Eigen::Matrix4f;

/// Position in 3D euclidean space
using Position = Eigen::Vector3f;
/// Position in homogenous coordinates
using PositionH = Eigen::Vector4f;

/// Position in 2D space
using Position2 = Eigen::Vector2f;

using Size2 = Eigen::Matrix<std::size_t, 2, 1>;
using Size3 = Eigen::Matrix<std::size_t, 3, 1>;

using Size3f = Eigen::Vector3f;

/// An 1D range
template <class T> struct Range {
  T min, max;
  constexpr auto length() const noexcept { return max - min; }
};

/// Normalized RGB color
using Color = Eigen::Vector3f;

namespace Colors {
inline auto Black() noexcept { return Color::Zero(); }
inline auto White() noexcept { return Color::Ones(); }
inline auto Red() noexcept { return Color::UnitX(); }
inline auto Green() noexcept { return Color::UnitY(); }
inline auto Blue() noexcept { return Color::UnitZ(); }
inline auto Yellow() noexcept { return Red() + Green(); }
inline auto Magenta() noexcept { return Red() + Blue(); }
inline auto Cyan() noexcept { return Blue() + Green(); }
}

/// 6-DOF orientation, represented as a quaternion
using Orientation = Eigen::Quaternionf;

struct DepthRange {
  float near{1.f}, far{-1.f};
};

enum class Axis { X, Y, Z };

using Scale = float;

using Length = phys::units::quantity<phys::units::length_d>;
using Angle = double;
using PhysicalPosition = Eigen::Matrix<Length, 3, 1>;

using phys::units::meter;
using phys::units::rad;
using phys::units::degree_angle;

using phys::units::centi;
using phys::units::milli;
using phys::units::micro;
using phys::units::nano;

using phys::units::abs;

namespace literals = phys::units::literals;

using VoxelSize = std::array<Length, 3>;

/// @brief Conveniance wrapper for span<>
/// @{
template <class T>
inline constexpr auto as_span(T *ptr,
                              typename span<T>::index_type size) noexcept {
  return span<T>(ptr, size);
}

template <
    class Container,
    class = std::enable_if_t<
        !details::is_span<Container>::value &&
        !details::is_std_array<Container>::value &&
        std::is_convertible<typename Container::pointer,
                            decltype(std::declval<Container>().data())>::value>>
inline constexpr auto as_span(Container &c) {
  return span<typename Container::value_type>(c);
}

template <
    class Container,
    class = std::enable_if_t<
        !details::is_span<Container>::value &&
        !details::is_std_array<Container>::value &&
        std::is_convertible<typename Container::pointer,
                            decltype(std::declval<Container>().data())>::value>>
inline constexpr auto as_span(Container const &c) {
  return span<typename Container::value_type const>(c);
}
///@}

} // namespace VolViz

#if __cplusplus < 201703L

namespace std {

template<class T>
constexpr const T& clamp( const T& v, const T& lo, const T& hi ) {
    return clamp( v, lo, hi, std::less<>() );
}

template<class T, class Compare>
constexpr const T& clamp( const T& v, const T& lo, const T& hi, Compare comp ) {
      return assert( !comp(hi, lo) ),
             comp(v, lo) ? lo : comp(hi, v) ? hi : v;
  }

}

#endif

#endif // VolViz_Types_h


/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
/*                                                                  */
/* Linear Algebra Data and Routines File                            */
/*                                                                  */
/* Generated by KPP-2.2 symbolic chemistry Kinetics PreProcessor    */
/*       (http://www.cs.vt.edu/~asandu/Software/KPP)                */
/* KPP is distributed under GPL, the general public licence         */
/*       (http://www.gnu.org/copyleft/gpl.html)                     */
/* (C) 1995-1997, V. Damian & A. Sandu, CGRER, Univ. Iowa           */
/* (C) 1997-2005, A. Sandu, Michigan Tech, Virginia Tech            */
/*     With important contributions from:                           */
/*        M. Damian, Villanova University, USA                      */
/*        R. Sander, Max-Planck Institute for Chemistry, Mainz, Germany */
/*                                                                  */
/* File                 : saprc99_LinearAlgebra.c                   */
/* Time                 : Wed Jun 11 10:09:48 2008                  */
/* Working directory    : /Users/jlinford/workspace/saprc99         */
/* Equation file        : saprc99.kpp                               */
/* Output root filename : saprc99                                   */
/*                                                                  */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

#define USE_SDK_BLAS    0

#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include "saprc99_Parameters.h"
#include "saprc99_Global.h"
#include "saprc99_Sparse.h"

#if DO_CHEMISTRY == 1

/* For SPU-optimized BLAS */
#if USE_SDK_BLAS == 1
#include <blas.h>
#endif

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
/*                                                                  */
/* SPARSE_UTIL - SPARSE utility functions                           */
/*   Arguments :                                                    */
/*                                                                  */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

int KppDecomp( double *JVS )
{
double W[74];
double a;
int k, kk, j, jj;

  for( k = 0; k < 74; k++ ) {
    if( JVS[ LU_DIAG[k] ] == 0.0 ) return k+1;
    for( kk = LU_CROW[k]; kk < LU_CROW[k+1]; kk++ )
      W[ LU_ICOL[kk] ] = JVS[kk];
    for( kk = LU_CROW[k]; kk < LU_DIAG[k]; kk++ ) {
      j = LU_ICOL[kk];
      a = -W[j] / JVS[ LU_DIAG[j] ];
      W[j] = -a;
      for( jj = LU_DIAG[j]+1; jj < LU_CROW[j+1]; jj++ )
        W[ LU_ICOL[jj] ] += a*JVS[jj];
    }
    for( kk = LU_CROW[k]; kk < LU_CROW[k+1]; kk++ )
      JVS[kk] = W[ LU_ICOL[kk] ];
  }
  return 0;
}

/* End of SPARSE_UTIL function                                      */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
/*                                                                  */
/* KppSolve - sparse back substitution                              */
/*   Arguments :                                                    */
/*      JVS       - sparse Jacobian of variables                    */
/*      X         - Vector for variables                            */
/*                                                                  */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

void KppSolve(
  double JVS[],                           /* sparse Jacobian of variables */
  double X[]                              /* Vector for variables */
)
{
  X[21] = X[21]-JVS[91]*X[20];
  X[31] = X[31]-JVS[125]*X[23]-JVS[126]*X[30];
  X[32] = X[32]-JVS[129]*X[23]-JVS[130]*X[30];
  X[33] = X[33]-JVS[133]*X[23]-JVS[134]*X[30];
  X[34] = X[34]-JVS[138]*X[23]-JVS[139]*X[30];
  X[35] = X[35]-JVS[143]*X[27];
  X[37] = X[37]-JVS[154]*X[23]-JVS[155]*X[30];
  X[38] = X[38]-JVS[161]*X[30];
  X[39] = X[39]-JVS[167]*X[19]-JVS[168]*X[29]-JVS[169]*X[31]-JVS[170]
         *X[32]-JVS[171]*X[34];
  X[40] = X[40]-JVS[190]*X[23]-JVS[191]*X[30]-JVS[192]*X[31]-JVS[193]
         *X[32]-JVS[194]*X[33];
  X[41] = X[41]-JVS[202]*X[19]-JVS[203]*X[20]-JVS[204]*X[21]-JVS[205]
         *X[22]-JVS[206]*X[29];
  X[42] = X[42]-JVS[216]*X[17]-JVS[217]*X[33]-JVS[218]*X[35]-JVS[219]
         *X[37]-JVS[220]*X[38]-JVS[221]*X[40];
  X[44] = X[44]-JVS[242]*X[19]-JVS[243]*X[23]-JVS[244]*X[30]-JVS[245]
         *X[31]-JVS[246]*X[32]-JVS[247]*X[34]-JVS[248]*X[38]-JVS[249]
         *X[43];
  X[45] = X[45]-JVS[259]*X[33]-JVS[260]*X[38];
  X[47] = X[47]-JVS[276]*X[20]-JVS[277]*X[22]-JVS[278]*X[29]-JVS[279]
         *X[31]-JVS[280]*X[32]-JVS[281]*X[41]-JVS[282]*X[46];
  X[49] = X[49]-JVS[310]*X[46];
  X[51] = X[51]-JVS[322]*X[46];
  X[53] = X[53]-JVS[334]*X[46]-JVS[335]*X[52];
  X[54] = X[54]-JVS[341]*X[10]-JVS[342]*X[20]-JVS[343]*X[22]-JVS[344]
         *X[29]-JVS[345]*X[43]-JVS[346]*X[50]-JVS[347]*X[51]-JVS[348]
         *X[52];
  X[55] = X[55]-JVS[363]*X[19]-JVS[364]*X[20]-JVS[365]*X[22]-JVS[366]
         *X[25]-JVS[367]*X[26]-JVS[368]*X[28]-JVS[369]*X[29]-JVS[370]
         *X[41]-JVS[371]*X[43]-JVS[372]*X[44]-JVS[373]*X[45]-JVS[374]
         *X[46]-JVS[375]*X[48]-JVS[376]*X[49]-JVS[377]*X[50]-JVS[378]
         *X[51]-JVS[379]*X[52]-JVS[380]*X[53];
  X[56] = X[56]-JVS[399]*X[21]-JVS[400]*X[48]-JVS[401]*X[50]-JVS[402]
         *X[51]-JVS[403]*X[52];
  X[57] = X[57]-JVS[412]*X[9]-JVS[413]*X[43]-JVS[414]*X[46]-JVS[415]
         *X[48]-JVS[416]*X[49]-JVS[417]*X[50]-JVS[418]*X[52]-JVS[419]
         *X[53];
  X[58] = X[58]-JVS[426]*X[19]-JVS[427]*X[20]-JVS[428]*X[22]-JVS[429]
         *X[29]-JVS[430]*X[31]-JVS[431]*X[32]-JVS[432]*X[34]-JVS[433]
         *X[36]-JVS[434]*X[43]-JVS[435]*X[48]-JVS[436]*X[49]-JVS[437]
         *X[50]-JVS[438]*X[51]-JVS[439]*X[52]-JVS[440]*X[53]-JVS[441]
         *X[56]-JVS[442]*X[57];
  X[59] = X[59]-JVS[454]*X[20]-JVS[455]*X[22]-JVS[456]*X[29]-JVS[457]
         *X[49]-JVS[458]*X[50]-JVS[459]*X[51]-JVS[460]*X[52]-JVS[461]
         *X[53]-JVS[462]*X[56]-JVS[463]*X[57];
  X[60] = X[60]-JVS[474]*X[22]-JVS[475]*X[29]-JVS[476]*X[30]-JVS[477]
         *X[46]-JVS[478]*X[48]-JVS[479]*X[50]-JVS[480]*X[51]-JVS[481]
         *X[52]-JVS[482]*X[53]-JVS[483]*X[56]-JVS[484]*X[57];
  X[61] = X[61]-JVS[497]*X[34]-JVS[498]*X[43]-JVS[499]*X[46]-JVS[500]
         *X[48]-JVS[501]*X[49]-JVS[502]*X[50]-JVS[503]*X[51]-JVS[504]
         *X[52]-JVS[505]*X[53]-JVS[506]*X[57];
  X[62] = X[62]-JVS[517]*X[8]-JVS[518]*X[16]-JVS[519]*X[18]-JVS[520]
         *X[19]-JVS[521]*X[23]-JVS[522]*X[24]-JVS[523]*X[25]-JVS[524]
         *X[26]-JVS[525]*X[27]-JVS[526]*X[28]-JVS[527]*X[30]-JVS[528]
         *X[31]-JVS[529]*X[32]-JVS[530]*X[34]-JVS[531]*X[35]-JVS[532]
         *X[36]-JVS[533]*X[39]-JVS[534]*X[40]-JVS[535]*X[43]-JVS[536]
         *X[44]-JVS[537]*X[45]-JVS[538]*X[46]-JVS[539]*X[48]-JVS[540]
         *X[49]-JVS[541]*X[50]-JVS[542]*X[51]-JVS[543]*X[52]-JVS[544]
         *X[53]-JVS[545]*X[54]-JVS[546]*X[55]-JVS[547]*X[56]-JVS[548]
         *X[57]-JVS[549]*X[58]-JVS[550]*X[59]-JVS[551]*X[60]-JVS[552]
         *X[61];
  X[63] = X[63]-JVS[565]*X[19]-JVS[566]*X[20]-JVS[567]*X[22]-JVS[568]
         *X[23]-JVS[569]*X[29]-JVS[570]*X[30]-JVS[571]*X[46]-JVS[572]
         *X[48]-JVS[573]*X[50]-JVS[574]*X[51]-JVS[575]*X[52]-JVS[576]
         *X[53]-JVS[577]*X[56]-JVS[578]*X[57]-JVS[579]*X[58]-JVS[580]
         *X[59]-JVS[581]*X[60]-JVS[582]*X[61]-JVS[583]*X[62];
  X[64] = X[64]-JVS[595]*X[15]-JVS[596]*X[46]-JVS[597]*X[49]-JVS[598]
         *X[51]-JVS[599]*X[52]-JVS[600]*X[53]-JVS[601]*X[57]-JVS[602]
         *X[61]-JVS[603]*X[62]-JVS[604]*X[63];
  X[65] = X[65]-JVS[615]*X[21]-JVS[616]*X[25]-JVS[617]*X[29]-JVS[618]
         *X[41]-JVS[619]*X[43]-JVS[620]*X[46]-JVS[621]*X[48]-JVS[622]
         *X[50]-JVS[623]*X[52]-JVS[624]*X[53]-JVS[625]*X[54]-JVS[626]
         *X[56]-JVS[627]*X[57]-JVS[628]*X[58]-JVS[629]*X[59]-JVS[630]
         *X[60]-JVS[631]*X[61]-JVS[632]*X[62]-JVS[633]*X[63]-JVS[634]
         *X[64];
  X[66] = X[66]-JVS[644]*X[14]-JVS[645]*X[37]-JVS[646]*X[52]-JVS[647]
         *X[57]-JVS[648]*X[61]-JVS[649]*X[62]-JVS[650]*X[63]-JVS[651]
         *X[64]-JVS[652]*X[65];
  X[67] = X[67]-JVS[661]*X[10]-JVS[662]*X[19]-JVS[663]*X[20]-JVS[664]
         *X[22]-JVS[665]*X[23]-JVS[666]*X[29]-JVS[667]*X[30]-JVS[668]
         *X[31]-JVS[669]*X[32]-JVS[670]*X[33]-JVS[671]*X[34]-JVS[672]
         *X[36]-JVS[673]*X[38]-JVS[674]*X[43]-JVS[675]*X[45]-JVS[676]
         *X[46]-JVS[677]*X[48]-JVS[678]*X[49]-JVS[679]*X[50]-JVS[680]
         *X[51]-JVS[681]*X[52]-JVS[682]*X[53]-JVS[683]*X[56]-JVS[684]
         *X[57]-JVS[685]*X[58]-JVS[686]*X[59]-JVS[687]*X[60]-JVS[688]
         *X[61]-JVS[689]*X[62]-JVS[690]*X[63]-JVS[691]*X[64]-JVS[692]
         *X[65]-JVS[693]*X[66];
  X[68] = X[68]-JVS[701]*X[18]-JVS[702]*X[26]-JVS[703]*X[47]-JVS[704]
         *X[48]-JVS[705]*X[50]-JVS[706]*X[52]-JVS[707]*X[53]-JVS[708]
         *X[55]-JVS[709]*X[56]-JVS[710]*X[57]-JVS[711]*X[59]-JVS[712]
         *X[60]-JVS[713]*X[61]-JVS[714]*X[62]-JVS[715]*X[63]-JVS[716]
         *X[64]-JVS[717]*X[65]-JVS[718]*X[66]-JVS[719]*X[67];
  X[69] = X[69]-JVS[726]*X[12]-JVS[727]*X[13]-JVS[728]*X[14]-JVS[729]
         *X[15]-JVS[730]*X[17]-JVS[731]*X[18]-JVS[732]*X[21]-JVS[733]
         *X[24]-JVS[734]*X[26]-JVS[735]*X[27]-JVS[736]*X[35]-JVS[737]
         *X[42]-JVS[738]*X[44]-JVS[739]*X[45]-JVS[740]*X[46]-JVS[741]
         *X[47]-JVS[742]*X[48]-JVS[743]*X[49]-JVS[744]*X[50]-JVS[745]
         *X[51]-JVS[746]*X[52]-JVS[747]*X[53]-JVS[748]*X[54]-JVS[749]
         *X[55]-JVS[750]*X[56]-JVS[751]*X[57]-JVS[752]*X[58]-JVS[753]
         *X[59]-JVS[754]*X[60]-JVS[755]*X[61]-JVS[756]*X[62]-JVS[757]
         *X[63]-JVS[758]*X[64]-JVS[759]*X[65]-JVS[760]*X[66]-JVS[761]
         *X[67]-JVS[762]*X[68];
  X[70] = X[70]-JVS[768]*X[17]-JVS[769]*X[24]-JVS[770]*X[33]-JVS[771]
         *X[35]-JVS[772]*X[37]-JVS[773]*X[38]-JVS[774]*X[40]-JVS[775]
         *X[42]-JVS[776]*X[43]-JVS[777]*X[44]-JVS[778]*X[45]-JVS[779]
         *X[46]-JVS[780]*X[47]-JVS[781]*X[48]-JVS[782]*X[49]-JVS[783]
         *X[50]-JVS[784]*X[51]-JVS[785]*X[52]-JVS[786]*X[53]-JVS[787]
         *X[54]-JVS[788]*X[55]-JVS[789]*X[56]-JVS[790]*X[57]-JVS[791]
         *X[58]-JVS[792]*X[59]-JVS[793]*X[60]-JVS[794]*X[61]-JVS[795]
         *X[62]-JVS[796]*X[63]-JVS[797]*X[64]-JVS[798]*X[65]-JVS[799]
         *X[66]-JVS[800]*X[67]-JVS[801]*X[68]-JVS[802]*X[69];
  X[71] = X[71]-JVS[807]*X[11]-JVS[808]*X[12]-JVS[809]*X[23]-JVS[810]
         *X[29]-JVS[811]*X[31]-JVS[812]*X[32]-JVS[813]*X[40]-JVS[814]
         *X[41]-JVS[815]*X[48]-JVS[816]*X[49]-JVS[817]*X[50]-JVS[818]
         *X[51]-JVS[819]*X[52]-JVS[820]*X[53]-JVS[821]*X[54]-JVS[822]
         *X[56]-JVS[823]*X[57]-JVS[824]*X[58]-JVS[825]*X[59]-JVS[826]
         *X[60]-JVS[827]*X[61]-JVS[828]*X[62]-JVS[829]*X[63]-JVS[830]
         *X[64]-JVS[831]*X[65]-JVS[832]*X[66]-JVS[833]*X[67]-JVS[834]
         *X[68]-JVS[835]*X[69]-JVS[836]*X[70];
  X[72] = X[72]-JVS[840]*X[13]-JVS[841]*X[44]-JVS[842]*X[45]-JVS[843]
         *X[48]-JVS[844]*X[49]-JVS[845]*X[51]-JVS[846]*X[52]-JVS[847]
         *X[53]-JVS[848]*X[57]-JVS[849]*X[58]-JVS[850]*X[59]-JVS[851]
         *X[60]-JVS[852]*X[61]-JVS[853]*X[62]-JVS[854]*X[63]-JVS[855]
         *X[64]-JVS[856]*X[65]-JVS[857]*X[66]-JVS[858]*X[67]-JVS[859]
         *X[68]-JVS[860]*X[69]-JVS[861]*X[70]-JVS[862]*X[71];
  X[73] = X[73]-JVS[865]*X[8]-JVS[866]*X[9]-JVS[867]*X[10]-JVS[868]
         *X[16]-JVS[869]*X[18]-JVS[870]*X[19]-JVS[871]*X[20]-JVS[872]
         *X[22]-JVS[873]*X[23]-JVS[874]*X[24]-JVS[875]*X[25]-JVS[876]
         *X[28]-JVS[877]*X[29]-JVS[878]*X[30]-JVS[879]*X[31]-JVS[880]
         *X[32]-JVS[881]*X[33]-JVS[882]*X[34]-JVS[883]*X[36]-JVS[884]
         *X[37]-JVS[885]*X[38]-JVS[886]*X[39]-JVS[887]*X[40]-JVS[888]
         *X[41]-JVS[889]*X[42]-JVS[890]*X[43]-JVS[891]*X[44]-JVS[892]
         *X[45]-JVS[893]*X[46]-JVS[894]*X[48]-JVS[895]*X[49]-JVS[896]
         *X[50]-JVS[897]*X[51]-JVS[898]*X[52]-JVS[899]*X[53]-JVS[900]
         *X[54]-JVS[901]*X[55]-JVS[902]*X[56]-JVS[903]*X[57]-JVS[904]
         *X[58]-JVS[905]*X[59]-JVS[906]*X[60]-JVS[907]*X[61]-JVS[908]
         *X[62]-JVS[909]*X[63]-JVS[910]*X[64]-JVS[911]*X[65]-JVS[912]
         *X[66]-JVS[913]*X[67]-JVS[914]*X[68]-JVS[915]*X[69]-JVS[916]
         *X[70]-JVS[917]*X[71]-JVS[918]*X[72];
  X[73] = X[73]/JVS[919];
  X[72] = (X[72]-JVS[864]*X[73])/(JVS[863]);
  X[71] = (X[71]-JVS[838]*X[72]-JVS[839]*X[73])/(JVS[837]);
  X[70] = (X[70]-JVS[804]*X[71]-JVS[805]*X[72]-JVS[806]*X[73])
         /(JVS[803]);
  X[69] = (X[69]-JVS[764]*X[70]-JVS[765]*X[71]-JVS[766]*X[72]-JVS[767]
         *X[73])/(JVS[763]);
  X[68] = (X[68]-JVS[721]*X[69]-JVS[722]*X[70]-JVS[723]*X[71]-JVS[724]
         *X[72]-JVS[725]*X[73])/(JVS[720]);
  X[67] = (X[67]-JVS[695]*X[68]-JVS[696]*X[69]-JVS[697]*X[70]-JVS[698]
         *X[71]-JVS[699]*X[72]-JVS[700]*X[73])/(JVS[694]);
  X[66] = (X[66]-JVS[654]*X[67]-JVS[655]*X[68]-JVS[656]*X[69]-JVS[657]
         *X[70]-JVS[658]*X[71]-JVS[659]*X[72]-JVS[660]*X[73])
         /(JVS[653]);
  X[65] = (X[65]-JVS[636]*X[66]-JVS[637]*X[67]-JVS[638]*X[68]-JVS[639]
         *X[69]-JVS[640]*X[70]-JVS[641]*X[71]-JVS[642]*X[72]-JVS[643]
         *X[73])/(JVS[635]);
  X[64] = (X[64]-JVS[606]*X[65]-JVS[607]*X[66]-JVS[608]*X[67]-JVS[609]
         *X[68]-JVS[610]*X[69]-JVS[611]*X[70]-JVS[612]*X[71]-JVS[613]
         *X[72]-JVS[614]*X[73])/(JVS[605]);
  X[63] = (X[63]-JVS[585]*X[64]-JVS[586]*X[65]-JVS[587]*X[66]-JVS[588]
         *X[67]-JVS[589]*X[68]-JVS[590]*X[69]-JVS[591]*X[70]-JVS[592]
         *X[71]-JVS[593]*X[72]-JVS[594]*X[73])/(JVS[584]);
  X[62] = (X[62]-JVS[554]*X[63]-JVS[555]*X[64]-JVS[556]*X[65]-JVS[557]
         *X[66]-JVS[558]*X[67]-JVS[559]*X[68]-JVS[560]*X[69]-JVS[561]
         *X[70]-JVS[562]*X[71]-JVS[563]*X[72]-JVS[564]*X[73])
         /(JVS[553]);
  X[61] = (X[61]-JVS[508]*X[62]-JVS[509]*X[64]-JVS[510]*X[66]-JVS[511]
         *X[68]-JVS[512]*X[69]-JVS[513]*X[70]-JVS[514]*X[71]-JVS[515]
         *X[72]-JVS[516]*X[73])/(JVS[507]);
  X[60] = (X[60]-JVS[486]*X[61]-JVS[487]*X[63]-JVS[488]*X[65]-JVS[489]
         *X[66]-JVS[490]*X[67]-JVS[491]*X[68]-JVS[492]*X[69]-JVS[493]
         *X[70]-JVS[494]*X[71]-JVS[495]*X[72]-JVS[496]*X[73])
         /(JVS[485]);
  X[59] = (X[59]-JVS[465]*X[60]-JVS[466]*X[61]-JVS[467]*X[63]-JVS[468]
         *X[65]-JVS[469]*X[67]-JVS[470]*X[68]-JVS[471]*X[69]-JVS[472]
         *X[70]-JVS[473]*X[73])/(JVS[464]);
  X[58] = (X[58]-JVS[444]*X[59]-JVS[445]*X[60]-JVS[446]*X[61]-JVS[447]
         *X[62]-JVS[448]*X[63]-JVS[449]*X[67]-JVS[450]*X[68]-JVS[451]
         *X[69]-JVS[452]*X[70]-JVS[453]*X[73])/(JVS[443]);
  X[57] = (X[57]-JVS[421]*X[61]-JVS[422]*X[68]-JVS[423]*X[69]-JVS[424]
         *X[70]-JVS[425]*X[73])/(JVS[420]);
  X[56] = (X[56]-JVS[405]*X[57]-JVS[406]*X[61]-JVS[407]*X[63]-JVS[408]
         *X[68]-JVS[409]*X[69]-JVS[410]*X[70]-JVS[411]*X[73])
         /(JVS[404]);
  X[55] = (X[55]-JVS[382]*X[56]-JVS[383]*X[57]-JVS[384]*X[59]-JVS[385]
         *X[60]-JVS[386]*X[61]-JVS[387]*X[62]-JVS[388]*X[63]-JVS[389]
         *X[64]-JVS[390]*X[65]-JVS[391]*X[66]-JVS[392]*X[67]-JVS[393]
         *X[68]-JVS[394]*X[69]-JVS[395]*X[70]-JVS[396]*X[71]-JVS[397]
         *X[72]-JVS[398]*X[73])/(JVS[381]);
  X[54] = (X[54]-JVS[350]*X[56]-JVS[351]*X[57]-JVS[352]*X[58]-JVS[353]
         *X[59]-JVS[354]*X[60]-JVS[355]*X[61]-JVS[356]*X[64]-JVS[357]
         *X[66]-JVS[358]*X[68]-JVS[359]*X[70]-JVS[360]*X[71]-JVS[361]
         *X[72]-JVS[362]*X[73])/(JVS[349]);
  X[53] = (X[53]-JVS[337]*X[57]-JVS[338]*X[61]-JVS[339]*X[70]-JVS[340]
         *X[73])/(JVS[336]);
  X[52] = (X[52]-JVS[330]*X[57]-JVS[331]*X[61]-JVS[332]*X[70]-JVS[333]
         *X[73])/(JVS[329]);
  X[51] = (X[51]-JVS[324]*X[52]-JVS[325]*X[57]-JVS[326]*X[61]-JVS[327]
         *X[70]-JVS[328]*X[73])/(JVS[323]);
  X[50] = (X[50]-JVS[318]*X[57]-JVS[319]*X[61]-JVS[320]*X[70]-JVS[321]
         *X[73])/(JVS[317]);
  X[49] = (X[49]-JVS[312]*X[52]-JVS[313]*X[57]-JVS[314]*X[61]-JVS[315]
         *X[70]-JVS[316]*X[73])/(JVS[311]);
  X[48] = (X[48]-JVS[306]*X[57]-JVS[307]*X[61]-JVS[308]*X[70]-JVS[309]
         *X[73])/(JVS[305]);
  X[47] = (X[47]-JVS[284]*X[48]-JVS[285]*X[50]-JVS[286]*X[52]-JVS[287]
         *X[53]-JVS[288]*X[56]-JVS[289]*X[57]-JVS[290]*X[59]-JVS[291]
         *X[60]-JVS[292]*X[61]-JVS[293]*X[62]-JVS[294]*X[63]-JVS[295]
         *X[64]-JVS[296]*X[65]-JVS[297]*X[66]-JVS[298]*X[67]-JVS[299]
         *X[68]-JVS[300]*X[69]-JVS[301]*X[70]-JVS[302]*X[71]-JVS[303]
         *X[72]-JVS[304]*X[73])/(JVS[283]);
  X[46] = (X[46]-JVS[272]*X[57]-JVS[273]*X[61]-JVS[274]*X[70]-JVS[275]
         *X[73])/(JVS[271]);
  X[45] = (X[45]-JVS[262]*X[62]-JVS[263]*X[64]-JVS[264]*X[66]-JVS[265]
         *X[68]-JVS[266]*X[69]-JVS[267]*X[70]-JVS[268]*X[71]-JVS[269]
         *X[72]-JVS[270]*X[73])/(JVS[261]);
  X[44] = (X[44]-JVS[251]*X[45]-JVS[252]*X[48]-JVS[253]*X[51]-JVS[254]
         *X[57]-JVS[255]*X[61]-JVS[256]*X[62]-JVS[257]*X[70]-JVS[258]
         *X[73])/(JVS[250]);
  X[43] = (X[43]-JVS[238]*X[57]-JVS[239]*X[61]-JVS[240]*X[70]-JVS[241]
         *X[73])/(JVS[237]);
  X[42] = (X[42]-JVS[223]*X[44]-JVS[224]*X[45]-JVS[225]*X[49]-JVS[226]
         *X[51]-JVS[227]*X[52]-JVS[228]*X[53]-JVS[229]*X[54]-JVS[230]
         *X[55]-JVS[231]*X[58]-JVS[232]*X[61]-JVS[233]*X[62]-JVS[234]
         *X[69]-JVS[235]*X[70]-JVS[236]*X[73])/(JVS[222]);
  X[41] = (X[41]-JVS[208]*X[48]-JVS[209]*X[50]-JVS[210]*X[52]-JVS[211]
         *X[56]-JVS[212]*X[61]-JVS[213]*X[69]-JVS[214]*X[70]-JVS[215]
         *X[73])/(JVS[207]);
  X[40] = (X[40]-JVS[196]*X[49]-JVS[197]*X[51]-JVS[198]*X[53]-JVS[199]
         *X[61]-JVS[200]*X[70]-JVS[201]*X[73])/(JVS[195]);
  X[39] = (X[39]-JVS[173]*X[40]-JVS[174]*X[43]-JVS[175]*X[44]-JVS[176]
         *X[46]-JVS[177]*X[48]-JVS[178]*X[49]-JVS[179]*X[50]-JVS[180]
         *X[51]-JVS[181]*X[52]-JVS[182]*X[53]-JVS[183]*X[54]-JVS[184]
         *X[55]-JVS[185]*X[57]-JVS[186]*X[58]-JVS[187]*X[61]-JVS[188]
         *X[70]-JVS[189]*X[73])/(JVS[172]);
  X[38] = (X[38]-JVS[163]*X[45]-JVS[164]*X[62]-JVS[165]*X[70]-JVS[166]
         *X[73])/(JVS[162]);
  X[37] = (X[37]-JVS[157]*X[52]-JVS[158]*X[61]-JVS[159]*X[70]-JVS[160]
         *X[73])/(JVS[156]);
  X[36] = (X[36]-JVS[150]*X[62]-JVS[151]*X[63]-JVS[152]*X[67]-JVS[153]
         *X[73])/(JVS[149]);
  X[35] = (X[35]-JVS[145]*X[45]-JVS[146]*X[62]-JVS[147]*X[69]-JVS[148]
         *X[70])/(JVS[144]);
  X[34] = (X[34]-JVS[141]*X[61]-JVS[142]*X[73])/(JVS[140]);
  X[33] = (X[33]-JVS[136]*X[70]-JVS[137]*X[73])/(JVS[135]);
  X[32] = (X[32]-JVS[132]*X[73])/(JVS[131]);
  X[31] = (X[31]-JVS[128]*X[73])/(JVS[127]);
  X[30] = (X[30]-JVS[124]*X[73])/(JVS[123]);
  X[29] = (X[29]-JVS[122]*X[73])/(JVS[121]);
  X[28] = (X[28]-JVS[117]*X[63]-JVS[118]*X[65]-JVS[119]*X[67]-JVS[120]
         *X[73])/(JVS[116]);
  X[27] = (X[27]-JVS[112]*X[35]-JVS[113]*X[62]-JVS[114]*X[69]-JVS[115]
         *X[70])/(JVS[111]);
  X[26] = (X[26]-JVS[108]*X[55]-JVS[109]*X[62]-JVS[110]*X[68])
         /(JVS[107]);
  X[25] = (X[25]-JVS[104]*X[62]-JVS[105]*X[65]-JVS[106]*X[73])
         /(JVS[103]);
  X[24] = (X[24]-JVS[100]*X[62]-JVS[101]*X[69]-JVS[102]*X[73])
         /(JVS[99]);
  X[23] = (X[23]-JVS[98]*X[73])/(JVS[97]);
  X[22] = (X[22]-JVS[96]*X[73])/(JVS[95]);
  X[21] = (X[21]-JVS[93]*X[69]-JVS[94]*X[73])/(JVS[92]);
  X[20] = (X[20]-JVS[90]*X[73])/(JVS[89]);
  X[19] = (X[19]-JVS[88]*X[73])/(JVS[87]);
  X[18] = (X[18]-JVS[85]*X[68]-JVS[86]*X[73])/(JVS[84]);
  X[17] = (X[17]-JVS[82]*X[69]-JVS[83]*X[70])/(JVS[81]);
  X[16] = (X[16]-JVS[79]*X[62]-JVS[80]*X[73])/(JVS[78]);
  X[15] = (X[15]-JVS[76]*X[64]-JVS[77]*X[69])/(JVS[75]);
  X[14] = (X[14]-JVS[73]*X[66]-JVS[74]*X[69])/(JVS[72]);
  X[13] = (X[13]-JVS[70]*X[69]-JVS[71]*X[72])/(JVS[69]);
  X[12] = (X[12]-JVS[67]*X[69]-JVS[68]*X[71])/(JVS[66]);
  X[11] = (X[11]-JVS[62]*X[23]-JVS[63]*X[48]-JVS[64]*X[61]-JVS[65]
         *X[73])/(JVS[61]);
  X[10] = (X[10]-JVS[60]*X[73])/(JVS[59]);
  X[9] = (X[9]-JVS[58]*X[61])/(JVS[57]);
  X[8] = (X[8]-JVS[56]*X[73])/(JVS[55]);
  X[7] = (X[7]-JVS[52]*X[27]-JVS[53]*X[37]-JVS[54]*X[69])/(JVS[51]);
  X[6] = (X[6]-JVS[49]*X[27]-JVS[50]*X[69])/(JVS[48]);
  X[5] = (X[5]-JVS[44]*X[62]-JVS[45]*X[64]-JVS[46]*X[66]-JVS[47]*X[72])
        /(JVS[43]);
  X[4] = (X[4]-JVS[41]*X[62]-JVS[42]*X[71])/(JVS[40]);
  X[3] = (X[3]-JVS[27]*X[46]-JVS[28]*X[48]-JVS[29]*X[50]-JVS[30]*X[51]
        -JVS[31]*X[52]-JVS[32]*X[61]-JVS[33]*X[62]-JVS[34]*X[63]
        -JVS[35]*X[64]-JVS[36]*X[65]-JVS[37]*X[66]-JVS[38]*X[67]
        -JVS[39]*X[72])/(JVS[26]);
  X[2] = (X[2]-JVS[18]*X[50]-JVS[19]*X[52]-JVS[20]*X[61]-JVS[21]*X[62]
        -JVS[22]*X[63]-JVS[23]*X[65]-JVS[24]*X[67]-JVS[25]*X[71])
        /(JVS[17]);
  X[1] = (X[1]-JVS[4]*X[19]-JVS[5]*X[26]-JVS[6]*X[43]-JVS[7]*X[46]
        -JVS[8]*X[48]-JVS[9]*X[49]-JVS[10]*X[50]-JVS[11]*X[51]-JVS[12]
        *X[52]-JVS[13]*X[53]-JVS[14]*X[61]-JVS[15]*X[68]-JVS[16]*X[73])
        /(JVS[3]);
  X[0] = (X[0]-JVS[1]*X[8]-JVS[2]*X[73])/(JVS[0]);
}

/* End of KppSolve function                                         */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
/*                                                                  */
/* BLAS_UTIL - BLAS-LIKE utility functions                          */
/*   Arguments :                                                    */
/*                                                                  */
/* ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */

/*--------------------------------------------------------------

  BLAS/LAPACK-like subroutines used by the integration algorithms
  It is recommended to replace them by calls to the optimized
       BLAS/LAPACK library for your machine

   (C) Adrian Sandu, Aug. 2004

--------------------------------------------------------------*/

#define ZERO  (double)0.0
#define ONE   (double)1.0
#define HALF  (double)0.5
#define TWO   (double)2.0
#define MOD(A,B) (int)((A)%(B))

/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
void WCOPY(int N, double X[], int incX, volatile double Y[], int incY)
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    copies a vector, x, to a vector, y:  y <- x
    only for incX=incY=1
    after BLAS
    replace this by the function from the optimized BLAS implementation:
        CALL  SCOPY(N,X,1,Y,1)   or   CALL  DCOPY(N,X,1,Y,1)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
{
#if USE_SDK_BLAS == 1
    dcopy_spu(X, Y, N);
#else
      int i, M;
      if (N <= 0) return;

      M = MOD(N,8);
      if( M != 0 ) {
        for ( i = 0; i < M; i++ )
          Y[i] = X[i];
        if( N < 8 ) return;
      }
      for ( i = M; i<N; i+=8 ) {
        Y[i] = X[i];
        Y[i + 1] = X[i + 1];
        Y[i + 2] = X[i + 2];
        Y[i + 3] = X[i + 3];
        Y[i + 4] = X[i + 4];
        Y[i + 5] = X[i + 5];
        Y[i + 6] = X[i + 6];
        Y[i + 7] = X[i + 7];
      }
#endif
} /* end function WCOPY */

/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
void WAXPY(int N, double Alpha, double X[], int incX, double Y[], int incY )
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    constant times a vector plus a vector: y <- y + Alpha*x
    only for incX=incY=1
    after BLAS
    replace this by the function from the optimized BLAS implementation:
        CALL SAXPY(N,Alpha,X,1,Y,1) or  CALL DAXPY(N,Alpha,X,1,Y,1)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
{
#if USE_SDK_BLAS == 1
    daxpy_spu(X, Y, Alpha, N);
#else
      int i, M;

      if (Alpha == ZERO) return;
      if (N  <=  0) return;

      M = MOD(N,4);
      if( M != 0 ) {
        for ( i = 0; i < M; i++ )
          Y[i] = Y[i] + Alpha*X[i];
        if ( N < 4 ) return;
      }

      for ( i = M; i < N; i += 4 ) {
        Y[i] = Y[i] + Alpha*X[i];
        Y[i + 1] = Y[i + 1] + Alpha*X[i + 1];
        Y[i + 2] = Y[i + 2] + Alpha*X[i + 2];
        Y[i + 3] = Y[i + 3] + Alpha*X[i + 3];
      }
#endif

} /* end function  WAXPY */

/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
void WSCAL(int N, double Alpha, double X[], int incX)
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    constant times a vector: x(1:N) <- Alpha*x(1:N)
    only for incX=incY=1
    after BLAS
    replace this by the function from the optimized BLAS implementation:
        CALL SSCAL(N,Alpha,X,1) or  CALL DSCAL(N,Alpha,X,1)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
{
#if USE_SDK_BLAS == 1
    dscal_spu(X, Alpha, N);
#else
      int i, M;

      if (Alpha == ONE) return;
      if (N  <=  0) return;

      M = MOD(N,5);
      if( M  !=  0 ) {
        if (Alpha == (-ONE))
          for ( i = 0; i < M; i++ )  X[i] = -X[i];
        else {
	  if (Alpha == ZERO)
            for ( i = 0; i < M; i++ ) X[i] = ZERO;
          else
            for ( i = 0; i < M; i++ ) X[i] = Alpha*X[i];
        } // end else
        if( N < 5 ) return;
      } // end if

      if (Alpha == (-ONE))
        for ( i = M; i<N; i+=5 ) {
          X[i]     = -X[i];
          X[i + 1] = -X[i + 1];
          X[i + 2] = -X[i + 2];
          X[i + 3] = -X[i + 3];
          X[i + 4] = -X[i + 4];
        } // end for
      else {
        if (Alpha == ZERO)
          for ( i = M; i < N; i += 5 ) {
            X[i]     = ZERO;
            X[i + 1] = ZERO;
            X[i + 2] = ZERO;
            X[i + 3] = ZERO;
            X[i + 4] = ZERO;
          } // end for
        else
          for ( i = M; i < N; i += 5 ) {
            X[i]     = Alpha*X[i];
            X[i + 1] = Alpha*X[i + 1];
            X[i + 2] = Alpha*X[i + 2];
            X[i + 3] = Alpha*X[i + 3];
            X[i + 4] = Alpha*X[i + 4];
           } // end for
      }  // else
#endif

} /* end function WSCAL */

/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
double WLAMCH( char C )
/*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    returns epsilon machine
    after LAPACK
    replace this by the function from the optimized LAPACK implementation:
         CALL SLAMCH('E') or CALL DLAMCH('E')
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
{
      int i;
      double Suma;
      static double Eps;
      static char First = 1;

      if (First) {
        First = 0;
        Eps = pow(HALF,16);
        for ( i = 17; i <= 80; i++ ) {
          Eps = Eps*HALF;
	  Suma = ONE + Eps;
	  if (Suma <= ONE) break;
        } /* end for */
        if (i==80) {
	   printf("\nERROR IN WLAMCH. Very small EPS = %g\n",Eps);
           return (double)2.2e-16;
	}
        Eps *= TWO; i--;
      } /* end if First */

      return Eps;

} /* end function WLAMCH */

#endif