//
//  mcrat.h
//  Global header file for all of MCRaT
//
//  Created by Tyler Parsotan on 7/23/21.
//

//define on and off for switches
#define ON  1
#define OFF 0

//define switches for MCRaT to continue a simulation 'c' or initalize a simulation
#define INITALIZE 'i'
#define CONTINUE  'c'

//define the codes for the different types of hydro simulations that we can use
#define FLASH           0
#define PLUTO_CHOMBO    1
#define PLUTO           2 //have separate compiler directive for file type
#define RIKEN           3 //need to replace this when done testing, just keeping it in the background for now and minimize its effect

//define PLUTO file types here
#define FILE_DBL         0
#define FILE_FLT         1
#define FILE_DBL_H5      2
#define FILE_FLT_H5      3
#define FILE_VTK         4

//define types of simulations that can be run
#define SCIENCE                         0
#define CYLINDRICAL_OUTFLOW             1
#define SPHERICAL_OUTFLOW               2
#define STRUCTURED_SPHERICAL_OUTFLOW    3

//define the geometries that we can handle
#define CARTESIAN   0 //2D, 3D
#define SPHERICAL   1 //2D, 3D
#define CYLINDRICAL 2 //2D
#define POLAR       3 //only in 3D, technically Cylindrical coordinates but PLUTO calls this POLAR

//define the hydro dimensions that we can handle
#define TWO                 0
#define TWO_POINT_FIVE      1
#define THREE               2

//define the types of things that we can assume for the thermal synchrotron emission and how we calculate the B field
#define INTERNAL_E  0
#define TOTAL_E     1
#define SIMULATION  2 //need to add this to statement below to take care of defaults

//define photon types
#define INJECTED_PHOTON 'i'
#define COMPTONIZED_PHOTON 'k'
#define CS_POOL_PHOTON 'p'
#define UNABSORBED_CS_PHOTON 'c'
#define REBINNED_PHOTON 'r'

extern const double C_LIGHT;
extern const double A_RAD;
extern const double PL_CONST;
extern const double K_B;
extern const double M_P;
extern const double THOM_X_SECT;
extern const double M_EL;
extern const double FINE_STRUCT;
extern const double CHARGE_EL;
extern const double R_EL;

#define STR_BUFFER 2000

struct photon
{
    char type; //was the photon injected as blackbody or wien, 'i', or was it emitted as cyclo-synchrotron or was it a cyclo-synchrotron photon that was compton scattered
    double p0; //E/c, 4 momentum is in lab frame
    double p1; // p_x
    double p2; //p_y
    double p3; //p_z
    double comv_p0; //E/c, 4 momentum is in comoving frame
    double comv_p1; // p_x
    double comv_p2; //p_y
    double comv_p3; //p_z
    double r0; //x in MCRaT coordinates these get saved
    double r1; //y
    double r2; //z
    double s0; //stokes I always 1
    double s1; //stokes Q/I +1 is in positive y_tilde coordinate (z_hat X photon 4 momentum)
    double s2; //stokes U/I
    double s3; //Stokes V/I
    double num_scatt;
    double weight; //each photon should have equal weight, sp this shouldnt matter, weight in mc.par file but across injections can have varying weights
    int nearest_block_index; //index that  allows for extraction of information of the hydro grid block that the photon si located within
} ; //structure to hold photon information

struct hydro_dataframe
{
    /*
     Coordinate System  |   Coordinate unit vector order (r0,r1,r2)/(v0,v1,v2)
     3D Cartesian       |       x, y, z
     3D Spherical       |       r, theta, phi
     3D Polar           |       r, phi, z
     2D Cartesian       |       x, z
     2D Cylindrical     |       r, z (phi) //in PLUTO its possible to save 3D vectors  in 2.5 dims where the final unit vector is phi hat
     2D Spherical       |       r, theta, (phi)
     */
    int num_elements; //number of elements in each array
    double *r0; //coodinates in hydro coodinate system that user provides,
    double *r1;
    double *r2;
    double *r0_size;//size of fluid elements
    double *r1_size;
    double *r2_size;
    double *r;//spherical coordinates of fluid elements for photon injection, mdifying fluid value purposes
    double *theta;
    double *v0; //velocity in hydro coordinate system
    double *v1;
    double *v2;
    double *dens;
    double *dens_lab;
    double *pres;
    double *temp;
    double *gamma;
    double *B0; //magentic field in hydro coordinate system
    double *B1;
    double *B2;

    //also hold global simulation information
    double r0_domain[2]; //holds min and max values of r0 coordinates for hydro sim
    double r1_domain[2];
    double r2_domain[2];
    double fps; //frames per second of the simulation
    int scatt_frame_number;
    int inj_frame_number;
    int last_frame;
    int increment_inj_frame; //the change in between each injection frame which may change if different number of fps is used in each portion of hydro code
    int increment_scatt_frame; //same as above expect for frames that photons are acattered in
}; // structure to hold all information for a given hydro simulation

//include all libraries needed
#include "hdf5.h"
#include "mpi.h"

#include <omp.h>
#include <gsl/gsl_errno.h>
#include <gsl/gsl_histogram.h>
#include <gsl/gsl_histogram2d.h>
#include <gsl/gsl_integration.h>
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <stdbool.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <glob.h>
#include <unistd.h>
#include <dirent.h>
#include <math.h>
#include <time.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>
#include <gsl/gsl_blas.h>
#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf_bessel.h>
#include <gsl/gsl_permutation.h>
#include <gsl/gsl_sort.h>
#include <gsl/gsl_sort_vector.h>

//include all other header files in mcrat
#include "mcrat_input.h"

#include "mclib.h"
#include "mclib_riken.h"
#include "mclib_pluto.h"
#include "mclib_flash.h"
#include "mc_cyclosynch.h"
#include "geometry.h"
#include "mcrat_scattering.h"
#include "mcrat_io.h"

//set default hydro v scale to be the speed of light
#define HYDRO_V_SCALE C_LIGHT

//take care of hydro scales in pressure, magnetic field, etc
#define HYDRO_P_SCALE   HYDRO_D_SCALE*HYDRO_V_SCALE*HYDRO_V_SCALE
#if B_FIELD_CALC==SIMULATION
    #define HYDRO_B_SCALE sqrt(4*M_PI*HYDRO_P_SCALE)
#endif

//take care of default PLUTO file types here
#ifdef PLUTO
    #ifndef PLUTO_FILETYPE
        #define PLUTO_FILETYPE  FILE_DBL
    #endif
#endif

//take care of synchrotron defaults here
#ifdef CYCLOSYNCHROTRON_SWITCH

    //if the percentage of max photon that will be used to create the energy bins isnt defined, define it to be 10%, also applies to emiting synch photons
    #ifndef CYCLOSYNCHROTRON_REBIN_E_PERC
        #define CYCLOSYNCHROTRON_REBIN_E_PERC 0.1
    #endif

    //if the polar angle bins that the rebinned synch photons isnt defined use 0.5 degree increments by default
    #ifndef CYCLOSYNCHROTRON_REBIN_ANG
        #define CYCLOSYNCHROTRON_REBIN_ANG 0.5
    #endif

    //if the azimuthal angle bins that the rebinned synch photons isnt defined use 0.5 degree increments by default
    #ifndef CYCLOSYNCHROTRON_REBIN_ANG_PHI
        #define CYCLOSYNCHROTRON_REBIN_ANG_PHI 10 //0.5
    #endif

    //if the user hasnt defined anything for how to calculate the B field, assume that they want it calculated from the total energy
    #ifndef B_FIELD_CALC
        #define B_FIELD_CALC TOTAL_E
    #endif
    //it is defined therefore see if EPSILON_B has been set and B_FIELD_CALC != SIMULATION
    #if B_FIELD_CALC == TOTAL_E || B_FIELD_CALC == INTERNAL_E
        //see if epsilon_b has been set
        #ifndef EPSILON_B
            //if not set it to be 0.5 by default
            #define EPSILON_B 0.5
        #endif
    #endif
#else
    //if its not defined set it to be off by default
    #define CYCLOSYNCHROTRON_SWITCH OFF

#endif

//take care of stokes switch and comv_switch and save_type defaults too
#ifndef STOKES_SWITCH
    #define STOKES_SWITCH   OFF
#endif

#ifndef COMV_SWITCH
    #define COMV_SWITCH   OFF
#endif

#ifndef SAVE_TYPE
    #define SAVE_TYPE   OFF
#endif

//throw errors during compilation if other switches are not defined
#ifndef SIM_SWITCH
#error Need to define hydro simulation type in mcrat_input.h file using SIM_SWITCH
#endif

#ifndef DIMENSIONS
#error Need to define hydro simulation dimensions in mcrat_input.h file using DIMENSIONS (should be set to two for this version of MCRaT)
#endif

#ifndef GEOMETRY
#error Need to define hydro simulation geometry in mcrat_input.h file using GEOMETRY
#endif

#ifndef HYDRO_L_SCALE
#error Need to define hydro simulation length scaling in mcrat_input.h file using HYDRO_L_SCALE
#endif

#ifndef HYDRO_D_SCALE
#error Need to define hydro simulation density scaling in mcrat_input.h file using HYDRO_D_SCALE
#endif

#ifndef MCPAR
#error Need to define name of MCRaT parameter file in mcrat_input.h file using MCPAR (it is typically called mc.par, see e.g. the MCRaT manual)
#endif


#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_cblas.h>
#include <gsl/gsl_sf.h>
#include "adkGSL.h"
#include "AFS.h"
#include "cs.h"
#include "adkCSparse.h"
#include "AFS_ctmc.h"
#include <pthread.h>

void coalMarkovChainTopologyMatrix_pthread(afsStateSpace *S,gsl_matrix *topol, gsl_matrix_int *moveType, int *dim1, int *dim2, int start, int stop, int *nnz);
void coalMarkovChainTopologyMatrix_sparse_pthread(afsStateSpace *S,double *topol, int *moveType, int *dim1, int *dim2, int start, int stop, int *nnz);

typedef struct matrixThreadObject
{
	int nnz,start, stop;
	int *dim1,*dim2;
	struct island_lik_params *island_params;
}
matrixThreadObject;

typedef struct matrixThreadObject_sparse
{
	int nnz,start, stop, nnzA;
	int *dim1,*dim2, *moveType;
	double *topol;
	struct im_lik_params *im_params;
}
matrixThreadObject_sparse;

//gonna try to use a global declared in island.c
void *threadDoRows(void* arg){
	matrixThreadObject *obj = (matrixThreadObject*)(arg);

	coalMarkovChainTopologyMatrix_pthread(obj->island_params->stateSpace,obj->island_params->topol, obj->island_params->moveType,
	obj->dim1,obj->dim2,obj->start,obj->stop,&(obj->nnz));
	//obj->nnz -= 1;

	pthread_exit((void* )obj);
}

//sparse matrix version
void *threadDoRows_sparse(void* arg){
	matrixThreadObject_sparse *obj = (matrixThreadObject_sparse*)(arg);

	coalMarkovChainTopologyMatrix_sparse_pthread(obj->im_params->stateSpace,obj->topol, obj->moveType,
	obj->dim1,obj->dim2,obj->start,obj->stop,&(obj->nnz));
	//obj->nnz -= 1;

	pthread_exit((void* )obj);
}

//sparse matrix version on reduced state space
void *threadDoRows_sparse_reduced(void* arg){
	matrixThreadObject_sparse *obj = (matrixThreadObject_sparse*)(arg);

	coalMarkovChainTopologyMatrix_sparse_pthread(obj->im_params->reducedStateSpace,obj->topol, obj->moveType,
	obj->dim1,obj->dim2,obj->start,obj->stop,&(obj->nnzA));
	//obj->nnz -= 1;

	pthread_exit((void* )obj);
}

void coalMarkovChainTopologyMatrix_pthread(afsStateSpace *S,gsl_matrix *topol, gsl_matrix_int *moveType, int *dim1, int *dim2, int start, int stop, int *nnz){
	int i,j,k,steps,x,y;
	double top,bottom;
	afsObject *delta;
	int **activePos1, **activePos2; //first dimension here relates to 2 popns
	int nlin1,nlin2,compat;
	int nonZeroCount, tot, tCount;
	int size = 200;
	nlin1 = nlin2 = 0;
	nonZeroCount = 0;
	if(S->nstates != topol->size1 || S->nstates != moveType->size1){
		fprintf(stderr,"Error: StateSpace and matrices are not of equal size\n");
		exit(1);
	}
	*nnz = 0;
	//arrays for finding positions of entries
	activePos1 = malloc(size*sizeof(int *));
	activePos2 = malloc(size*sizeof(int *));
	for(i=0;i<size;i++){
		activePos1[i] = malloc(2*sizeof(int));
		activePos1[i][0] = activePos1[i][1] = 0;
		activePos2[i] = malloc(2*sizeof(int));
		activePos2[i][0] = activePos2[i][1] = 0;

	}

	tot = S->nstates * S->nstates;
	tCount = 0;
	delta = afsObjectNewFrom(S->states[0]);
	for(i=start;i<stop;i++){
		for(j=0;j<S->nstates;j++){
			gsl_matrix_int_set(moveType,i,j,666);

			//is ith state root state?
			if(S->states[i]->nalleles == 1){
				//set correct absorbing conditions
				if(i==j){
					gsl_matrix_set(topol,i,j,1.0);
					gsl_matrix_int_set(moveType,i,j,-1);
					dim1[nonZeroCount] = i;
					dim2[nonZeroCount] = j;
					nonZeroCount += 1;
				}
				else{
					gsl_matrix_set(topol,i,j,0.0);
					gsl_matrix_int_set(moveType,i,j,-1);
				}
			}
			else{ //ith not root; what is the move?
				steps = S->states[i]->nalleles - S->states[j]->nalleles ;
				if(steps < 2){
				//	delta = afsObjectDelta(S->states[i],S->states[j]);
					afsObjectDeltaPre(S->states[i],S->states[j],delta);
					switch(steps){
						case 0:
						// 0 "steps", so no changes in nalleles between two
						//check counts and positions
						if(abs(matrixSum(delta->popMats[0])) == 1){
							nonZeroEntries(delta->popMats[0], activePos1, &nlin1);
							nonZeroEntries(delta->popMats[1], activePos2, &nlin2);

							//migration?
							if(nlin1 == nlin2 && activePos1[0][0] == activePos2[0][0] &&
								(gsl_matrix_int_min(delta->popMats[0]) >= 0 || gsl_matrix_int_min(delta->popMats[1]) >= 0))
							{

								//migration popn1?
								if(matrixSum(delta->popMats[0]) == 1){
									gsl_matrix_set(topol,i,j,
										(double) gsl_matrix_int_get(S->states[i]->popMats[0],
										activePos1[0][0], activePos1[0][1]) / S->states[i]->aCounts[0]);
									gsl_matrix_int_set(moveType,i,j,2);
									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
								else{ //migration popn2
									gsl_matrix_set(topol,i,j,
										(double) gsl_matrix_int_get(S->states[i]->popMats[1],
										activePos2[0][0],activePos2[0][1]) / S->states[i]->aCounts[1]);
									gsl_matrix_int_set(moveType,i,j,3);
									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
							}
						}
						break;

						case 1://coalescent?
						//coal popn1?
						if(matrixSum(delta->popMats[0]) == 1 && countNegativeEntries(delta->popMats[1]) == 0 && S->states[j]->aCounts[0] >= 1 ){
							entriesGreaterThan(delta->popMats[0], activePos1, &nlin1,0);//old lineages
							entriesLessThan(delta->popMats[0], activePos2, &nlin2,0);//new lineages
							if(nlin2 != 0 && nlin2 < 2){

								compat=0;
								if(nlin1 == 1){
									if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
										compat = 1;
								}
								if(nlin1==2){
									if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
										activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
										compat = 1;
								}
								if(compat != 1){
									gsl_matrix_set(topol,i,j,0.0);
									gsl_matrix_int_set(moveType,i,j,666);
								}
								else{

									top = 1.0;
									bottom = S->states[i]->aCounts[0] * (S->states[i]->aCounts[0]-1) /2.0 ;
									for(k=0;k<nlin1;k++){
										x = activePos1[k][0];
										y = activePos1[k][1];
										top *= (float) xchoosey(gsl_matrix_int_get(S->states[i]->popMats[0],x,y),
											gsl_matrix_int_get(delta->popMats[0],x,y));
									}
									gsl_matrix_set(topol,i,j,top/bottom);
									gsl_matrix_int_set(moveType,i,j,0);
									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
							}
						}
						else{
							if(matrixSum(delta->popMats[1]) == 1 && countNegativeEntries(delta->popMats[0]) == 0 && S->states[j]->aCounts[1] >= 1 ){
								entriesGreaterThan(delta->popMats[1], activePos1, &nlin1,0);//old lineages
								entriesLessThan(delta->popMats[1], activePos2, &nlin2,0);//new lineages
								if(nlin2 != 0 && nlin2 < 2){
									compat=0;
									if(nlin1 == 1){
										if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
											compat = 1;
									}
									if(nlin1==2){
										if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
											activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
											compat = 1;
									}
									if(compat != 1){

										gsl_matrix_set(topol,i,j,0.0);
										gsl_matrix_int_set(moveType,i,j,666);
									}
									else{
										top = 1.0;

										bottom = S->states[i]->aCounts[1] * (S->states[i]->aCounts[1]-1) /2.0 ;
										for(k=0;k<nlin1;k++){
											x = activePos1[k][0];
											y = activePos1[k][1];

											top *= xchoosey(gsl_matrix_int_get(S->states[i]->popMats[1],x,y),
												gsl_matrix_int_get(delta->popMats[1],x,y));
										}

										gsl_matrix_set(topol,i,j,top/bottom);
										gsl_matrix_int_set(moveType,i,j,1);
										dim1[nonZeroCount] = i;
										dim2[nonZeroCount] = j;
										nonZeroCount += 1;
									}
								}
							}
						}
						break;
					}
					//afsObjectFree(delta);
				}
			}
		}

	}
	//cleanup and free
	for(i=0;i<size;i++){
		free(activePos1[i]);
		free(activePos2[i]);
	}
	free(activePos1);
	free(activePos2);
	*nnz = nonZeroCount;
}

void coalMarkovChainTopologyMatrix_sparse_pthread(afsStateSpace *S,double *topol, int *moveType, int *dim1, int *dim2, int start, int stop, int *nnz){
	int i,j,k,steps,x,y;
	double top,bottom;
	afsObject *delta;
	int **activePos1, **activePos2; //first dimension here relates to 2 popns
	int nlin1,nlin2,compat;
	int nonZeroCount, tot, tCount;
	int size = 400;
	nlin1 = nlin2 = 0;

	nonZeroCount = 0;
	*nnz = 0;
	//arrays for finding positions of entries
	activePos1 = malloc(size*sizeof(int *));
	activePos2 = malloc(size*sizeof(int *));
	for(i=0;i<size;i++){
		activePos1[i] = malloc(2*sizeof(int));
		activePos1[i][0] = activePos1[i][1] = 0;
		activePos2[i] = malloc(2*sizeof(int));
		activePos2[i][0] = activePos2[i][1] = 0;
	}

	tot = S->nstates * S->nstates;
	tCount = 0;
	delta = afsObjectNewFrom(S->states[0]);
	for(i=start;i<stop;i++){
		for(j=0;j<S->nstates;j++){
		//	printf("nonzerocount=%d\n",nonZeroCount);

			if(S->states[i]->nalleles == 1){
				//set correct absorbing conditions
				if(i==j){
					topol[nonZeroCount] = 1.0;
					moveType[nonZeroCount] = -1;
					dim1[nonZeroCount] = i;
					dim2[nonZeroCount] = j;
					nonZeroCount += 1;
				}
			}

			else{ //ith not root; what is the move?
				steps = S->states[i]->nalleles - S->states[j]->nalleles ;
				if(steps < 2){
					delta = afsObjectDelta(S->states[i],S->states[j]);
					switch(steps){
						case 0:
						// 0 "steps", so no changes in nalleles between two
						//check counts and positions
						if(abs(matrixSum(delta->popMats[0])) == 1){
							nonZeroEntries(delta->popMats[0], activePos1, &nlin1);
							nonZeroEntries(delta->popMats[1], activePos2, &nlin2);

							//migration?
							if(nlin1 == nlin2 && activePos1[0][0] == activePos2[0][0] &&
								(gsl_matrix_int_min(delta->popMats[0]) >= 0 || gsl_matrix_int_min(delta->popMats[1]) >= 0)){

								//migration popn1?
								if(matrixSum(delta->popMats[0]) == 1){
									topol[nonZeroCount] = (double) gsl_matrix_int_get(S->states[i]->popMats[0],
										activePos1[0][0], activePos1[0][1]) / S->states[i]->aCounts[0];
									moveType[nonZeroCount] = 2;
									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
								else{ //migration popn2
									topol[nonZeroCount] = (double) gsl_matrix_int_get(S->states[i]->popMats[1],
										activePos2[0][0],activePos2[0][1]) / S->states[i]->aCounts[1];
									moveType[nonZeroCount] = 3;

									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
							}
						}
						break;

						case 1://coalescent?
								//coal popn1?
						if(matrixSum(delta->popMats[0]) == 1 && countNegativeEntries(delta->popMats[1]) == 0 && S->states[j]->aCounts[0] >= 1 ){
							entriesGreaterThan(delta->popMats[0], activePos1, &nlin1,0);//old lineages
							entriesLessThan(delta->popMats[0], activePos2, &nlin2,0);//new lineages
							if(nlin2 != 0 && nlin2 < 2){

								compat=0;
								if(nlin1 == 1){
									if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
										compat = 1;
								}
								if(nlin1==2){
									if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
										activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
										compat = 1;
								}
								if(compat == 1){
									top = 1.0;
									bottom = S->states[i]->aCounts[0] * (S->states[i]->aCounts[0]-1) /2.0 ;
									for(k=0;k<nlin1;k++){
										x = activePos1[k][0];
										y = activePos1[k][1];
										top *= (float) xchoosey(gsl_matrix_int_get(S->states[i]->popMats[0],x,y),
											gsl_matrix_int_get(delta->popMats[0],x,y));
									}

									topol[nonZeroCount] = top/bottom;
									moveType[nonZeroCount] = 0;
									dim1[nonZeroCount] = i;
									dim2[nonZeroCount] = j;
									nonZeroCount += 1;
								}
							}
						}
						else{
							if(matrixSum(delta->popMats[1]) == 1 && countNegativeEntries(delta->popMats[0]) == 0 && S->states[j]->aCounts[1] >= 1 ){
								entriesGreaterThan(delta->popMats[1], activePos1, &nlin1,0);//old lineages
								entriesLessThan(delta->popMats[1], activePos2, &nlin2,0);//new lineages
								if(nlin2 != 0 && nlin2 < 2){
									compat=0;
									if(nlin1 == 1){
										if(2*activePos1[0][0] == activePos2[0][0] && 2*activePos1[0][1] == activePos2[0][1])
											compat = 1;
									}
									if(nlin1==2){
										if(activePos1[0][0] + activePos1[1][0] == activePos2[0][0] &&
											activePos1[0][1] + activePos1[1][1] == activePos2[0][1])
											compat = 1;
									}
									if(compat == 1){
										top = 1.0;
										bottom = S->states[i]->aCounts[1] * (S->states[i]->aCounts[1]-1) /2.0 ;
										for(k=0;k<nlin1;k++){
											x = activePos1[k][0];
											y = activePos1[k][1];

											top *= xchoosey(gsl_matrix_int_get(S->states[i]->popMats[1],x,y),
												gsl_matrix_int_get(delta->popMats[1],x,y));
										}

										topol[nonZeroCount] = top/bottom;
										moveType[nonZeroCount] = 1;
										dim1[nonZeroCount] = i;
										dim2[nonZeroCount] = j;
										nonZeroCount += 1;
									}
								}
							}
						}
						break;
					}
					//afsObjectFree(delta);
				}
			}
		}
	}
	//cleanup and free
	for(i=0;i<size;i++){
		free(activePos1[i]);
		free(activePos2[i]);
	}
	free(activePos1);
	free(activePos2);
	*nnz = nonZeroCount;
}


#ifndef __REGIONAL_H_
#define __REGIONAL_H_

#include <gsl/gsl_rng.h>
#include <gsl/gsl_randist.h>

typedef struct stochasticity_grid {
    double *arr;
    int height, width;
    double weight_factor;
    double stddev;
    double mean;
    int depth;
    gsl_rng *rng;
    double *weights;
} t_stochasticity_grid;

t_stochasticity_grid *create_stochasticity_grid(double *arr, int height, int width, double weight_factor, double mean, double stddev, long int seed);
void free_stochasticity_grid(t_stochasticity_grid *g);
void generate_stochasticity(t_stochasticity_grid *g);

#endif /* __REGIONAL_H_ */


#include <gsl/gsl_math.h>
#include "gsl_cblas.h"
#include "cblas.h"

void
cblas_dspmv (const enum CBLAS_ORDER order, const enum CBLAS_UPLO Uplo,
	     const int N, const double alpha, const double *Ap,
	     const double *X, const int incX, const double beta, double *Y,
	     const int incY)
{
#define BASE double
#include "source_spmv.h"
#undef BASE
}


// Authors: David Blei (blei@cs.princeton.edu)
//          Sean Gerrish (sgerrish@cs.princeton.edu)
//
// Copyright 2011 Sean Gerrish and David Blei
// All Rights Reserved.
//
// See the README for this package for details about modifying or
// distributing this software.

#ifndef LDA_H
#define LDA_H

#include <gsl/gsl_vector.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_sf_gamma.h>
#include <gsl/gsl_sf_psi.h>
#include <gsl/gsl_sf_lambert.h>
#include <gsl/gsl_rng.h>

#include "param.h"
#include "data.h"
#include "gsl-wrappers.h"

/*
 * functions for posterior inference in the latent dirichlet
 * allocation model.
 *
 */

#define LDA_INFERENCE_CONVERGED 1e-8
#define LDA_SEED_INIT 1
#define LDA_INIT_SMOOTH 1.0
#define LDA_EM_CONVERGED 5e-5
#define LDA_USE_VAR_BAYES 0
#define LDA_TOPIC_DIR_PARAM 0.001

// lda model

typedef struct lda {
    int ntopics;         // number of topics
    int nterms;          // vocabulary size
    gsl_matrix* topics;  // each column is a topic (V X K)
    gsl_vector* alpha;   // dirichlet parameters
} lda;

// lda posterior

typedef struct lda_post {
    doc_t* doc;          // document associated to this posterior
    lda* model;          // lda model
    gsl_matrix* phi;     // variational mult parameters (nterms x K)
    gsl_matrix* log_phi; // convenient for computation (nterms x K)
    gsl_vector* gamma;   // variational dirichlet parameters (K)
    gsl_vector* lhood;   // a K+1 vector, sums to the lhood bound
    gsl_vector* doc_weight;  // Not owned by this structure.
    gsl_vector* renormalized_doc_weight;  // Not owned by this structure.
} lda_post;

// lda sufficient statistics

typedef struct lda_suff_stats {
  gsl_matrix* topics_ss;
} lda_suff_stats;

// new lda model and suff stats

lda* new_lda_model(int ntopics, int nterms);
void free_lda_model(lda* m);
lda_suff_stats* new_lda_suff_stats(lda* model);
void reset_lda_suff_stats(lda_suff_stats* ss);
lda_post* new_lda_post(int ntopics, int max_length);
void free_lda_post(lda_post* p);
void initialize_lda_ss_from_data(corpus_t* data, lda_suff_stats* ss);

// posterior inference

double fit_lda_post(int doc_number, int time,
		    lda_post* p, lda_seq* var,
		    gsl_matrix* g,
		    gsl_matrix* g3,
		    gsl_matrix* g4,
		    gsl_matrix* g5);
void init_lda_post(lda_post* p);
void update_gamma(lda_post* p);
void update_phi(int doc_number, int time,
		lda_post* p, lda_seq* var,
		gsl_matrix* g);
void update_phi_dim(int doc_number, int time,
		    lda_post* p, lda_seq* var,
		    gsl_matrix* g);
void update_phi_fixed(int doc_number, int time,
		      lda_post* p, lda_seq* var,
		      gsl_matrix* g3_matrix,
		      gsl_matrix* g4_matrix,
		      gsl_matrix* g5_matrix);
void update_phi_multiple(int doc_number, int time,
			 lda_post* p, lda_seq* var,
			 gsl_matrix* g);

// compute the likelihood bound

double compute_lda_lhood(lda_post* p);

// EM algorithm

double lda_e_step(lda* model, corpus_t* data, lda_suff_stats* ss);
double lda_m_step(lda* model, lda_suff_stats* ss);
void lda_em(lda* model,
	    lda_suff_stats* ss,
	    corpus_t* data,
	    int max_iter,
	    char* outname);

// reading and writing

lda_suff_stats* read_lda_suff_stats(char* filename, int ntopics, int nterms);
void write_lda(lda* model, char* name);
void write_lda_suff_stats(lda_suff_stats* ss, char* name);
lda* read_lda(int ntopics, int nterms, char* name);

void initialize_lda_ss_from_random(corpus_t* data, lda_suff_stats* ss);

#endif


/*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*
**                                                                                **
** This file forms part of the Underworld geophysics modelling application.         **
**                                                                                **
** For full license and copyright information, please refer to the LICENSE.md file  **
** located at the project root, or contact the authors.                             **
**                                                                                **
**~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*~*/
#include <petsc.h>
#include <petscmat.h>
#include <petscvec.h>

#include <StGermain/StGermain.h>
#include <StgDomain/StgDomain.h>

#include "common-driver-utils.h"
#include "stokes_block_scaling.h"
#include <StgFEM/StgFEM.h>
#include <PICellerator/PICellerator.h>
#include <Underworld/Underworld.h>
#include "Solvers/SLE/SLE.h" /* to give the AugLagStokes_SLE type */
#include "Solvers/KSPSolvers/KSPSolvers.h" /* for __KSP_COMMON */

#include "BSSCR.h"
#include "writeMatVec.h"

/* creates and builds the "checker-board" null-space vectors for pressure
   and sets the t and v "Vec pointers" on the bsscr struct to point to them */
#undef __FUNCT__
#define __FUNCT__ "KSPBuildPressure_CB_Nullspace_BSSCR"
PetscErrorCode KSPBuildPressure_CB_Nullspace_BSSCR(KSP ksp)
{
    KSP_BSSCR        *bsscr = (KSP_BSSCR *)ksp->data;
    FeEquationNumber *eq_num = bsscr->solver->st_sle->pSolnVec->eqNum;
    FeMesh           *feMesh = bsscr->solver->st_sle->pSolnVec->feVariable->feMesh; /* is the pressure mesh */
    unsigned          ijk[3];
    Vec               t, v;
    int numLocalNodes, globalNodeNumber, i, j, eq;
    MatStokesBlockScaling BA = bsscr->BA;
    PetscErrorCode ierr;
    Mat            Amat,Pmat, G;
    MatStructure   pflag;

    PetscFunctionBegin;
    /* get G matrix from Amat matrix operator on ksp */
    ierr=Stg_PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
    MatNestGetSubMat( Amat, 0,1, &G );/* G should always exist */
    /* now create Vecs t and v to match size of G: i.e. pressure */ /* NOTE: not using "h" vector from ksp->vec_rhs because this part of the block vector doesn't always exist */
    MatGetVecs( G, &t, PETSC_NULL );/* t and v are destroyed in KSPDestroy_BSSCR */
    MatGetVecs( G, &v, PETSC_NULL );/* t and v such that can do G*t */

    numLocalNodes = Mesh_GetLocalSize( feMesh,  MT_VERTEX); /* number of nodes on current proc not counting any shadow nodes */
    for(j=0;j<numLocalNodes;j++){
	i = globalNodeNumber = Mesh_DomainToGlobal( feMesh, MT_VERTEX, j);
	RegularMeshUtils_Element_1DTo3D(feMesh, i, ijk);
	eq = eq_num->mapNodeDof2Eq[j][0];/* get global equation number -- 2nd arg is always 0 because pressure has only one dof */
	if(eq != -1){
	    if( (ijk[0]+ijk[1]+ijk[2])%2 ==0 ){
		VecSetValue(t,eq,1.0,INSERT_VALUES);
	    }
	    else{
		VecSetValue(v,eq,1.0,INSERT_VALUES);	    }}}

    VecAssemblyBegin( t );
    VecAssemblyEnd( t );
    VecAssemblyBegin( v );
    VecAssemblyEnd( v );

    /* Scaling the null vectors here because it easier at the moment *//* maybe should do this in the original scaling function */
    if( BA->scaling_exists == PETSC_TRUE ){
	Vec R2;
	/* Get the scalings out the block mat data */
	VecNestGetSubVec( BA->Rz, 1, &R2 );
	VecPointwiseDivide( t, t, R2); /* x <- x * 1/R2 */
	VecPointwiseDivide( v, v, R2);
    }

    // bsscr_writeVec( t, "t", "Writing t vector");
    // bsscr_writeVec( v, "v", "Writing v vector");

    bsscr->t=t;
    bsscr->v=v;

    PetscFunctionReturn(0);
}
/* creates and builds the "constant" null-space vector for pressure
   and sets the t "Vec pointer" on the bsscr struct to point to it */
#undef __FUNCT__
#define __FUNCT__ "KSPBuildPressure_Const_Nullspace_BSSCR"
PetscErrorCode KSPBuildPressure_Const_Nullspace_BSSCR(KSP ksp)
{
    KSP_BSSCR        *bsscr = (KSP_BSSCR *)ksp->data;
    FeEquationNumber *eq_num = bsscr->solver->st_sle->pSolnVec->eqNum;
    FeMesh           *feMesh = bsscr->solver->st_sle->pSolnVec->feVariable->feMesh; /* is the pressure mesh */
    unsigned          ijk[3];
    Vec               t;
    int numLocalNodes, globalNodeNumber, i, eq;
    MatStokesBlockScaling BA = bsscr->BA;
    PetscErrorCode ierr;
    Mat            Amat,Pmat, G;
    MatStructure   pflag;

    PetscFunctionBegin;
    /* get G matrix from Amat matrix operator on ksp */
    ierr=Stg_PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
    MatNestGetSubMat( Amat, 0,1, &G );/* G should always exist */
    /* now create Vec t to match size of G: i.e. pressure */ /* NOTE: not using "h" vector from ksp->vec_rhs because this part of the block vector doesn't always exist */
    MatGetVecs( G, &t, PETSC_NULL );/* t is destroyed in KSPDestroy_BSSCR */

    VecSet(t, 1.0);

    VecAssemblyBegin( t );
    VecAssemblyEnd( t );

    /* Scaling the null vectors here because it easier at the moment */
    if( BA->scaling_exists == PETSC_TRUE ){
	Vec R2;
	/* Get the scalings out the block mat data */
	VecNestGetSubVec( BA->Rz, 1, &R2 );
	VecPointwiseDivide( t, t, R2); /* x <- x * 1/R2 */
    }
    // bsscr_writeVec( t, "t", "Writing t vector");
    bsscr->t=t;

    PetscFunctionReturn(0);
}

#undef __FUNCT__
#define __FUNCT__ "KSPRemovePressureNullspace_BSSCR"
PetscErrorCode KSPRemovePressureNullspace_BSSCR(KSP ksp, Vec h_hat)
{
    KSP_BSSCR            *bsscr = (KSP_BSSCR *)ksp->data;
    MatStokesBlockScaling BA    = bsscr->BA;
    PetscErrorCode ierr;
    PetscScalar norm, a, a1, a2, hnorm, pnorm, gnorm;
    Vec t2, t,v;
    Mat            Amat,Pmat, D;
    MatStructure   pflag;
    double nstol   = bsscr->nstol; /* set in KSPCreate_BSSCR */

    PetscFunctionBegin;
    t=bsscr->t;
    v=bsscr->v;
    /* get G matrix from Amat matrix operator on ksp */
    ierr=Stg_PCGetOperators(ksp->pc,&Amat,&Pmat,&pflag);CHKERRQ(ierr);
    //MatNestGetSubMat( Amat, 0,1, &G );/* G should always exist */
    MatNestGetSubMat( Amat, 1,0, &D );/* D should always exist */
    /* now create Vec t2 to match left hand size of G: i.e. velocity */
    MatGetVecs( D, &t2, PETSC_NULL );
    MatNorm(D,NORM_INFINITY,&gnorm); /* seems like not a bad estimate of the largest eigenvalue for this matrix */
    if(t){/* assumes that v and t are initially set to PETSC_NULL (in KSPCreate_BSSCR ) */
	MatMultTranspose( D, t, t2);
	VecNorm(t2, NORM_2, &norm);
	VecNorm(t, NORM_2, &a);
	norm=norm/a;/* so we are using unit null vector */
	if(norm < nstol*gnorm){/* then t in NS of G */
	    VecDot(t,h_hat, &a1);
	    VecDot(t,t, &a2);
	    a=-a1/a2;
	    VecAXPY(h_hat, a, t);
	    VecDot(t,h_hat, &a1);
	    PetscPrintf( PETSC_COMM_WORLD, "\n\t* Found t NS norm= %g : Dot = %g\n\n", norm, a1);
	}
    }
    if(v){
	MatMultTranspose( D, v, t2);
	VecNorm(t2, NORM_2, &norm);
	VecNorm(v, NORM_2, &a);
	norm=norm/a;/* so we are using unit null vector */
	if(norm < nstol*gnorm){/* then v in NS of G */
	    VecDot(v,h_hat, &a1);
	    VecDot(v,v, &a2);
	    a=-a1/a2;
	    VecAXPY(h_hat, a, v);
	    VecDot(v,h_hat, &a1);
	    PetscPrintf( PETSC_COMM_WORLD, "\n\t* Found v NS norm= %g : Dot = %g\n\n", norm, a1);
	}
    }
    // bsscr_writeVec( h_hat, "h", "Writing h_hat Vector in Solver");
    Stg_VecDestroy(&t2);

    PetscFunctionReturn(0);
}


// matrix.h

//  This matrix class is a C++ wrapper for the GNU Scientific Library
//  Copyright (C) 2001 Ramin Nakisa

//  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.

#if !defined( _matrix_int_h )
#define _matrix_int_h

#ifdef __HP_aCC //for aCC B3910B A.01.27
#include <iostream.h>
#include <fstream.h>
#include <iomanip.h>
#else //for gcc3
#include <iostream>
#include <fstream>
#include <iomanip>
#endif

#include <math.h>
#include <stdlib.h>
#include <assert.h>
///
#include <gsl/gsl_math.h>
#include <gsl/gsl_matrix_int.h>
#include <gsl/gsl_linalg.h>
#include <gslwrap/permutation.h>
#include <gslwrap/vector_int.h>

#define type_is_int
#ifdef  type_is
#define type_is_double
#endif

namespace gsl
{

///
class matrix_int
{
#ifdef type_is_double
	friend class matrix_float;
	friend class matrix_int;
#endif
public:
	typedef int value_type;
	typedef vector_int vector_type;

	///
	matrix_int();
	///
	matrix_int( size_t new_rows, size_t new_cols, bool clear = true );

	template<class oclass>
	void copy(const oclass &other)
	{
		if ( static_cast<const void *>( this ) == static_cast<const void *>( &other ) )
			return;

		set_dimensions( other.get_rows(), other.get_cols() );
		for ( size_t i = 0; i < get_rows(); i++ )
		{
			for ( size_t j = 0; j < get_cols(); j++ )
			{
				gsl_matrix_int_set( m, i, j, (int)other(i,j));
			}
		}
	}
/*    	template<>  */
/*    	void copy<matrix_int>(const matrix_int &other)  */
/*    	{  */
/*    		set_dimensions(other.size1(),other.size2());  */
/*    		gsl_matrix_int_memcpy( m, other.m );  */
/*    	}  */
	// copy constructor for type matrix_int
	matrix_int( const matrix_int &other ):m(NULL) {copy(other);}
	///
	template<class oclass>
	matrix_int( const oclass &other ):m(NULL) {copy(other);}

	///
	~matrix_int();
	///
//	matrix_int( const char *Filename );
	///
	size_t get_rows() const {return m->size1;}
	///
	size_t get_cols() const {return m->size2;}
	///
	size_t size1() const {return m->size1;}
	///
	size_t size2() const {return m->size2;}

	///
	void dimensions( size_t *num_rows, size_t *num_cols ) const;
	///
int        get_element ( size_t row, size_t col ) const {return  gsl_matrix_int_get( m, row, col ) ;}
	const int &operator()( size_t row, size_t col ) const {return *gsl_matrix_int_ptr( m, row, col ) ;}
int       &operator()( size_t row, size_t col )       {return *gsl_matrix_int_ptr( m, row, col ) ;}
	///
	void set_element( size_t row, size_t col, const int &v ){ gsl_matrix_int_set( m, row, col, v );}
	///
	void set_elements( const int & new_value );
	void set_all ( const int & new_value ) {gsl_matrix_int_set_all ( m, new_value );}
	void set_zero() {gsl_matrix_int_set_zero( m );}
	///
	void set_dimensions( size_t new_rows, size_t new_cols );
	///
	void load( const char *filename );
	///
	void save( const char *filename ) const;
	///
	friend ostream& operator<< ( ostream& os, const matrix_int& m );
	//This function writes the elements of the matrix m to the stream stream in binary format. The return value is 0 for success and GSL_EFAILED if there was a problem writing to the file. Since the data is written in the native binary format it may not be portable between different architectures.
	int fwrite (FILE * stream) const {return gsl_matrix_int_fwrite (stream, m);}

//This function reads into the matrix m from the open stream stream in binary format. The matrix m must be preallocated with the correct dimensions since the function uses the size of m to determine how many bytes to read. The return value is 0 for success and GSL_EFAILED if there was a problem reading from the file. The data is assumed to have been written in the native binary format on the same architecture.
	int fread (FILE * stream) {return gsl_matrix_int_fread (stream, m);}

    ///
	void load_binary( const char *filename );
	///
	void save_binary( const char *filename ) const;
	///
	bool operator==( const matrix_int &other ) const;
	bool operator!=( const matrix_int &other ) const {return !((*this)==other);}

	matrix_int& operator=( const matrix_int &other ) {copy( other );return *this;}
	/// converts from any other matrix type
	template<class omatrix>
	matrix_int &operator=( const omatrix& other )
	{
			copy(other);
			return *this;
	}
   ///
	matrix_int operator+( const matrix_int &other ) const;
	///
	matrix_int operator+( const int &f ) const;
	///
	friend matrix_int operator+( const int &f, const matrix_int &other );
	///
	matrix_int &operator+=( const int &f );
	///
	matrix_int &operator+=( const matrix_int &other );
	///
	matrix_int operator-( const matrix_int &other ) const;
	///
	matrix_int operator-( const int &f ) const;
	///
	friend matrix_int operator-( const int &f, const matrix_int &other );
	///
	matrix_int &operator-=( const int &f );
	///
	matrix_int &operator-=( const matrix_int &other );
	///
	matrix_int operator*( const matrix_int &other ) const;
	///
	matrix_int operator*( const int &f ) const;
	///
	friend matrix_int operator*( const int &f, const matrix_int &other );
	///
	matrix_int &operator*=( const int &f );
	///
	matrix_int &operator*=( const matrix_int &other );
	///
	matrix_int operator/( const int &) const;
	///
	matrix_int &operator/=( const int &);
	///
	matrix_int transpose() const;
	///
	matrix_int LU_decomp(gsl::permutation *perm=NULL,int *psign=NULL) const;
	///
	matrix_int LU_invert() const;

	// return a submatrix of the this from row_min to row_max (not included!)
	matrix_int submatrix(size_t row_min, size_t row_max, size_t col_min, size_t col_max) const
		{
			matrix_int m(row_max - row_min, col_max - col_min);
			for (size_t i = row_min ; i < row_max ; i++)
			{
				for (size_t j = col_min ; j < col_max ; j++)
				{
					m(i - row_min,j - col_min) = (*this)(i,j);
				}
			}
			return m;
		}
private:
	///
	void LU_decomp( gsl_matrix_int **a,
					gsl_permutation **permutation,
					int *sign ) const;
public:
	/** returns sum of all the matrix elements. */
    int sum() const;
	/** returns logarithm of the determinant of the matrix. */
	double LU_lndet() const;

	/** returns a vector_int_view of a single row of the matrix. */
	vector_int_view       row( size_t rowindex );
	const vector_int_view row( size_t rowindex ) const ;
	/** returns a vector_int_view of a single column of the matrix. */
	vector_int_view       column( size_t colindex );
	const vector_int_view column( size_t colindex ) const;
	/** returns a vector_int_view of the diagonal elements of the matrix. */
	vector_int_view       diagonal();
	const vector_int_view diagonal() const;

	/** returns a column matrix containing a single row of the matrix. */
	matrix_int get_row( size_t rowindex ) const;
	/** returns a column matrix containing a single column of the matrix. */
	matrix_int get_col( size_t colindex ) const;
	/** calculates sum of rows returned as a column matrix. */
	matrix_int row_sum() const;
	/** calculates sum of columns returned as a row matrix. */
	matrix_int column_sum() const;
	/** returns trace (diagonal sum) of a square matrix. */
	double trace() const;
	/** calculates cholesky decomposition of the matrix, returning success if matrix is positive definite. */
	int cholesky_decomp( matrix_int &a ) const;
//  	/** returns index of nearest row in matrix to vector argument. */
//  	int nearest_row_index( const matrix_int &v ) const;
	/** calculates covariance of the matrix columns. */
	matrix_int covariance() const;
	/** returns 1 if matrix is square, 0 otherwise. */
	bool is_square() const;
	/** diag operator (sets the diagonal elements of the matrix to the elements of v */
	void diag(const vector_int& v);
	/** set diagonal elements of a square matrix to f. */
	void set_diagonal( int f );
	/** sets matrix to a k dimensional unit matrix. */
	void identity( size_t k );
	/** returns sum of nth power of all elements. */
	double norm( double n ) const;

/*  Function: double gsl_matrix_max (const gsl_matrix * m)  */
/*      This function returns the maximum value in the matrix m.  */
	double max() const {return gsl_matrix_int_max(m);}
/*  Function: double gsl_matrix_min (const gsl_matrix * m)  */
/*      This function returns the minimum value in the matrix m.  */
	double min()const{return gsl_matrix_int_min(m);}

	/** This function returns 1 if all the elements of the matrix m are zero, and 0 otherwise. */
	bool isnull() const { return gsl_matrix_int_isnull(m);}
/*  Function: void gsl_matrix_minmax (const gsl_matrix * m, double * min_out, double * max_out)  */
/*      This function returns the minimum and maximum values in the matrix m, storing them in min_out and max_out.  */

/*  Function: void gsl_matrix_max_index (const gsl_matrix * m, size_t * imax, size_t * jmax)  */
/*      This function returns the indices of the maximum value in the matrix m, storing them in imax and jmax. When there are several equal maximum elements then the first element found */
/*      is returned.  */

/*  Function: void gsl_matrix_min_index (const gsl_matrix * m, size_t * imax, size_t * jmax)  */
/*      This function returns the indices of the minimum value in the matrix m, storing them in imax and jmax. When there are several equal minimum elements then the first element found */
/*      is returned.  */

/*  Function: void gsl_matrix_minmax_index (const gsl_matrix * m, size_t * imin, size_t * imax)  */
/*      This function returns the indices of the minimum and maximum values in the matrix m, storing them in (imin,jmin) and (imax,jmax). When there are several equal minimum or */
/*      maximum elements then the first elements found are returned.  */

	/** for interfacing with gsl c */
/*  	gsl_matrix_int       *gslobj()       {if (!m){cout << "matrix_int::gslobj ERROR, data not initialized!! " << endl; exit(-1);}return m;} */
/*  	const gsl_matrix_int *gslobj() const {if (!m){cout << "matrix_int::gslobj ERROR, data not initialized!! " << endl; exit(-1);}return m;} */
	gsl_matrix_int       *gslobj()       {assert(m);return m;}
	const gsl_matrix_int *gslobj() const {assert(m);return m;}
private:
	///
   gsl_matrix_int *m;

};
}
#undef type_is_int
#undef type_is_double

#endif // _matrix_int_h


/**
 *
 * @file core_ztsrfb.c
 *
 *  PLASMA core_blas kernel
 *  PLASMA is a software package provided by Univ. of Tennessee,
 *  Univ. of California Berkeley and Univ. of Colorado Denver
 *
 * @version 2.6.0
 * @author Hatem Ltaief
 * @author Mathieu Faverge
 * @author Azzam Haidar
 * @date 2010-11-15
 * @precisions normal z -> c d s
 *
 **/
#include <cblas.h>
#include <lapacke.h>
#include "common.h"

/***************************************************************************//**
 *
 * @ingroup CORE_PLASMA_Complex64_t
 *
 *  CORE_ztsrfb applies a complex block reflector H or its transpose H' to a
 *  complex rectangular matrix formed by coupling two tiles A1 and A2,
 *  from either the left or the right.
 *
 *******************************************************************************
 *
 * @param[in] side
 *         @arg PlasmaLeft  : apply Q or Q**H from the Left;
 *         @arg PlasmaRight : apply Q or Q**H from the Right.
 *
 * @param[in] trans
 *         @arg PlasmaNoTrans   : No transpose, apply Q;
 *         @arg PlasmaConjTrans : ConjTranspose, apply Q**H.
 *
 * @param[in] direct
 *         Indicates how H is formed from a product of elementary
 *         reflectors
 *         @arg PlasmaForward  : H = H(1) H(2) . . . H(k) (Forward)
 *         @arg PlasmaBackward : H = H(k) . . . H(2) H(1) (Backward)
 *
 * @param[in] storev
 *         Indicates how the vectors which define the elementary
 *         reflectors are stored:
 *         @arg PlasmaColumnwise
 *         @arg PlasmaRowwise
 *
 * @param[in] M1
 *         The number of columns of the tile A1. M1 >= 0.
 *
 * @param[in] N1
 *         The number of rows of the tile A1. N1 >= 0.
 *
 * @param[in] M2
 *         The number of columns of the tile A2. M2 >= 0.
 *
 * @param[in] N2
 *         The number of rows of the tile A2. N2 >= 0.
 *
 * @param[in] K
 *          The order of the matrix T (= the number of elementary
 *          reflectors whose product defines the block reflector).
 *
 * @param[in,out] A1
 *         On entry, the M1-by-N1 tile A1.
 *         On exit, A1 is overwritten by the application of Q.
 *
 * @param[in] LDA1
 *         The leading dimension of the array A1. LDA1 >= max(1,N1).
 *
 * @param[in,out] A2
 *         On entry, the M2-by-N2 tile A2.
 *         On exit, A2 is overwritten by the application of Q.
 *
 * @param[in] LDA2
 *         The leading dimension of the tile A2. LDA2 >= max(1,N2).
 *
 * @param[in] V
 *         (LDV,K) if STOREV = 'C'
 *         (LDV,M2) if STOREV = 'R' and SIDE = 'L'
 *         (LDV,N2) if STOREV = 'R' and SIDE = 'R'
 *         The matrix V.
 *
 * @param[in] LDV
 *         The leading dimension of the array V.
 *         If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M2);
 *         if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N2);
 *         if STOREV = 'R', LDV >= K.
 *
 * @param[out] T
 *         The triangular K-by-K matrix T in the representation of the
 *         block reflector.
 *         T is upper triangular by block (economic storage);
 *         The rest of the array is not referenced.
 *
 * @param[in] LDT
 *         The leading dimension of the array T. LDT >= K.
 *
 * @param[in,out] WORK
 *
 * @param[in] LDWORK
 *         The dimension of the array WORK.
 *
 *******************************************************************************
 *
 * @return
 *          \retval PLASMA_SUCCESS successful exit
 *          \retval <0 if -i, the i-th argument had an illegal value
 *
 ******************************************************************************/
#if defined(PLASMA_HAVE_WEAK)
#pragma weak CORE_ztsrfb = PCORE_ztsrfb
#define CORE_ztsrfb PCORE_ztsrfb
#endif
int
CORE_ztsrfb(PLASMA_enum side, PLASMA_enum trans, int direct, int storev,
            int M1, int N1, int M2, int N2, int K,
            PLASMA_Complex64_t *A1, int LDA1,
            PLASMA_Complex64_t *A2, int LDA2,
            const PLASMA_Complex64_t *V, int LDV,
            const PLASMA_Complex64_t *T, int LDT,
            PLASMA_Complex64_t *WORK, int LDWORK)
{
    static PLASMA_Complex64_t zone  =  1.0;
    static PLASMA_Complex64_t mzone = -1.0;

    int j;

    /* Check input arguments */
    if (M1 < 0) {
        coreblas_error(5, "Illegal value of M1");
        return -5;
    }
    if (N1 < 0) {
        coreblas_error(6, "Illegal value of N1");
        return -6;
    }
    if ( (M2 < 0) ||
         ( (M2 != M1) && (side == PlasmaRight) ) ){
        coreblas_error(7, "Illegal value of M2");
        return -7;
    }
    if ( (N2 < 0) ||
         ( (N2 != N1) && (side == PlasmaLeft) ) ){
        coreblas_error(8, "Illegal value of N2");
        return -8;
    }
    if (K < 0) {
        coreblas_error(9, "Illegal value of K");
        return -9;
    }

    /* Quick return */
    if ((M1 == 0) || (N1 == 0) || (M2 == 0) || (N2 == 0) || (K == 0))
        return PLASMA_SUCCESS;

    if (storev == PlasmaColumnwise) {
        if (direct == PlasmaForward) {
            if (side == PlasmaLeft) {
                /*
                 * B = A1 + V' * A2
                 */
                LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,
                    lapack_const(PlasmaUpperLower),
                    K, N1,
                    A1, LDA1, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasConjTrans, CblasNoTrans,
                    K, N2, M2,
                    CBLAS_SADDR(zone), V, LDV,
                    A2, LDA2,
                    CBLAS_SADDR(zone), WORK, LDWORK);
                /*
                 * A2 = A2 - V*T*B -> B = T*B, A2 = A2 - V*B
                 */
                cblas_ztrmm(
                    CblasColMajor, CblasLeft, CblasUpper,
                    (CBLAS_TRANSPOSE)trans, CblasNonUnit, K, N2,
                    CBLAS_SADDR(zone), T, LDT, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasNoTrans,
                    M2, N2, K,
                    CBLAS_SADDR(mzone), V, LDV,
                    WORK, LDWORK,
                    CBLAS_SADDR(zone), A2, LDA2);
                /*
                 * A1 = A1 - B
                 */
                for(j = 0; j < N1; j++) {
                    cblas_zaxpy(
                        K, CBLAS_SADDR(mzone),
                        &WORK[LDWORK*j], 1,
                        &A1[LDA1*j], 1);
                }
            }
            /*
             * Columnwise / Forward / Right
             */
            else {
                /*
                 * B = A1 + A2 * V
                 */
                LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,
                    lapack_const(PlasmaUpperLower),
                    M1, K,
                    A1, LDA1, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasNoTrans,
                    M2, K, N2,
                    CBLAS_SADDR(zone), A2, LDA2,
                    V, LDV,
                    CBLAS_SADDR(zone), WORK, LDWORK);
                /*
                 * A2 = A2 - B*T*V' -> B = B*T, A2 = A2 - B*V'
                 */
                cblas_ztrmm(
                    CblasColMajor, CblasRight, CblasUpper,
                    (CBLAS_TRANSPOSE)trans, CblasNonUnit, M1, K,
                    CBLAS_SADDR(zone), T, LDT, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasConjTrans,
                    M2, N2, K,
                    CBLAS_SADDR(mzone), WORK, LDWORK,
                    V, LDV,
                    CBLAS_SADDR(zone), A2, LDA2);
                /*
                 * A1 = A1 - B
                 */
                for(j = 0; j < K; j++) {
                    cblas_zaxpy(
                        M1, CBLAS_SADDR(mzone),
                        &WORK[LDWORK*j], 1,
                        &A1[LDA1*j], 1);
                }
            }
        }
        else {
            coreblas_error(3, "Not implemented (ColMajor / Backward / Left or Right)");
            return PLASMA_ERR_NOT_SUPPORTED;
        }
    }
    else {
        if (direct == PlasmaForward) {
            /*
             * Rowwise / Forward / Left
             */
            if (side == PlasmaLeft) {
                /*
                 * B = A1 + V * A2
                 */
                LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,
                    lapack_const(PlasmaUpperLower),
                    K, N1,
                    A1, LDA1, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasNoTrans,
                    K, N2, M2,
                    CBLAS_SADDR(zone), V, LDV,
                    A2, LDA2,
                    CBLAS_SADDR(zone), WORK, LDWORK);
                /*
                 * A2 = A2 - V'*T*B -> B = T*B, A2 = A2 - V'*B
                 */
                cblas_ztrmm(
                    CblasColMajor, CblasLeft, CblasUpper,
                    (CBLAS_TRANSPOSE)trans, CblasNonUnit, K, N2,
                    CBLAS_SADDR(zone), T, LDT, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasConjTrans, CblasNoTrans,
                    M2, N2, K,
                    CBLAS_SADDR(mzone), V, LDV,
                    WORK, LDWORK,
                    CBLAS_SADDR(zone), A2, LDA2);
                /*
                 * A1 = A1 - B
                 */
                for(j=0; j<N1; j++) {
                    cblas_zaxpy(
                        K, CBLAS_SADDR(mzone),
                        &WORK[LDWORK*j], 1,
                        &A1[LDA1*j], 1);
                }
            }
            /*
             * Rowwise / Forward / Right
             */
            else {
                /*
                 * B = A1 + A2 * V'
                 */
                LAPACKE_zlacpy_work(LAPACK_COL_MAJOR,
                    lapack_const(PlasmaUpperLower),
                    M1, K,
                    A1, LDA1, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasConjTrans,
                    M2, K, N2,
                    CBLAS_SADDR(zone), A2, LDA2,
                    V, LDV,
                    CBLAS_SADDR(zone), WORK, LDWORK);
                /*
                 * A2 = A2 - B*T*V -> B = B*T, A2 = A2 - B*V'
                 */
                cblas_ztrmm(
                    CblasColMajor, CblasRight, CblasUpper,
                    (CBLAS_TRANSPOSE)trans, CblasNonUnit, M1, K,
                    CBLAS_SADDR(zone), T, LDT, WORK, LDWORK);

                cblas_zgemm(
                    CblasColMajor, CblasNoTrans, CblasNoTrans,
                    M2, N2, K,
                    CBLAS_SADDR(mzone), WORK, LDWORK,
                    V, LDV,
                    CBLAS_SADDR(zone), A2, LDA2);
                /*
                 * A1 = A1 - B
                 */
                for(j = 0; j < K; j++) {
                    cblas_zaxpy(
                        M1, CBLAS_SADDR(mzone),
                        &WORK[LDWORK*j], 1,
                        &A1[LDA1*j], 1);
                }
            }
        }
        else {
            coreblas_error(3, "Not implemented (RowMajor / Backward / Left or Right)");
            return PLASMA_ERR_NOT_SUPPORTED;
        }
    }
    return PLASMA_SUCCESS;
}