/*******************************************************************************
*
*  McStas, neutron ray-tracing package
*  Copyright(C) 2007 Risoe National Laboratory.
*
* %I
* Written by: Mads Bertelsen
* Date: 20.08.15
* Version: $Revision: 0.1 $
* Origin: University of Copenhagen
*
* Port of the Single_crystal component to the Union components
*
* %D
*
* This Union_process is based on the Single_crystal.comp component originally
*   written by Kristian Nielsen
*
* Part of the Union components, a set of components that work together and thus
*  sperates geometry and physics within McStas.
* The use of this component requires other components to be used.
*
* 1) One specifies a number of processes using process components like this one
* 2) These are gathered into material definitions using Union_make_material
* 3) Geometries are placed using Union_box / Union_cylinder, assigned a material
* 4) A Union_master component placed after all of the above
*
* Only in step 4 will any simulation happen, and per default all geometries
*  defined before the master, but after the previous will be simulated here.
*
* There is a dedicated manual available for the Union_components
*
* Algorithm:
* Described elsewhere
*
* %P
* INPUT PARAMETERS:
* packing_factor: [1]  How dense is the material compared to optimal 0-1
* interact_fraction: [1] How large a part of the scattering events should use this process 0-1 (sum of all processes in material = 1)
* delta_d_d: [1] Lattice spacing variance, gaussian RMS
* mosaic: [arc minutes] Crystal mosaic (isotropic), gaussian RMS. Puts the crystal in the isotropic mosaic model state, thus disregarding other mosaicity parameters.
* mosaic_a: [arc minutes]                                 Horizontal (rotation around lattice vector a) mosaic (anisotropic), gaussian RMS. Put the crystal in the anisotropic crystal vector state. I.e. model mosaicity through rotation around the crystal lattice vectors. Has precedence over in-plane mosaic model.
* mosaic_b: [arc minutes]                                 Vertical (rotation around lattice vector b) mosaic (anisotropic), gaussian RMS.
* mosaic_c: [arc minutes]                                 Out-of-plane (Rotation around lattice vector c) mosaic (anisotropic), gaussian RMS
* mosaic_AB: [arc_minutes, arc_minutes,1, 1, 1, 1, 1, 1]  In Plane mosaic rotation and plane vectors (anisotropic), mosaic_A, mosaic_B, A_h,A_k,A_l, B_h,B_k,B_l. Puts the crystal in the in-plane mosaic state. Vectors A and B define plane in which  the crystal roation is defined, and mosaic_A, mosaic_B, denotes the resp. mosaicities (gaussian RMS) with respect to the two reflections chosen by A and B (Miller indices).
* recip_cell: [1]                                         Choice of direct/reciprocal (0/1) unit cell definition
* ax: [AA or AA^-1]                                       Coordinates of first (direct/recip) unit cell vector
* ay: [AA or AA^-1]                                       a on y axis
* az: [AA or AA^-1]                                       a on z axis
* bx: [AA or AA^-1]                                       Coordinates of second (direct/recip) unit cell vector
* bz: [AA or AA^-1]                                       b on z axis
* by: [AA or AA^-1]                                       b on y axis
* cx: [AA or AA^-1]                                       Coordinates of third (direct/recip) unit cell vector
* cy: [AA or AA^-1]                                       c on y axis
* cz: [AA or AA^-1]                                       c on z axis
* reflections: [string]                                   File name containing structure factors of reflections. Use empty ("") or NULL for incoherent scattering only
* order: [1]                                              Limit multiple scattering up to given order (0: all, 1: first, 2: second, ...)
* p_transmit: [1]                                         Monte Carlo probability for neutrons to be transmitted without any scattering. Used to improve statistics from weak reflections
* sigma_abs: [barns]                                      Absorption cross-section per unit cell at 2200 m/s
* sigma_inc: [barns]                                      Incoherent scattering cross-section per unit cell Use -1 to unactivate
* aa: [deg]                                               Unit cell angles alpha, beta and gamma. Then uses norms of vectors a,b and c as lattice parameters
* bb: [deg]                                               Beta angle
* cc: [deg]                                               Gamma angle
* barns: [1]                                              Flag to indicate if |F|^2 from 'reflections' is in barns or fm^2. barns=1 for laz and isotropic constant elastic scattering (reflections=NULL), barns=0 for lau type files
* RX: [m]                                                 Radius of lattice curvature along X. flat when 0.
* RY: [m]                                                 Radius of lattice curvature along Y. flat when 0.
* RZ: [m]                                                 Radius of lattice curvature along Z. flat when 0.
* powder: [1]                                             Flag to indicate powder mode, for simulation of Debye-Scherrer cones via random crystallite orientation. A powder texture can be approximated with 0
* PG: [1]                                                 Flag to indicate "Pyrolytic Graphite" mode, only meaningful with choice of Graphite.lau, models PG crystal. A powder texture can be approximated with 0
*
* CALCULATED PARAMETERS:
* Template_storage          // Important to update this output paramter
* effective_my_scattering   // Variable used in initialize
*
* %L
*
* %E
******************************************************************************/

DEFINE COMPONENT Single_crystal_process // Remember to change the name of process here

SETTING PARAMETERS(string reflections=0, delta_d_d=1e-4,
            mosaic = -1, mosaic_a = -1, mosaic_b = -1, mosaic_c = -1, vector mosaic_AB={0,0, 0,0,0, 0,0,0},
            recip_cell=0, barns=0,
            ax = 0, ay = 0, az = 0,
            bx = 0, by = 0, bz = 0,
            cx = 0, cy = 0, cz = 0,
	    aa=0, bb=0, cc=0, order=0, RX=0, RY=0, RZ=0, powder=0, PG=0,
            interact_fraction=-1, packing_factor=1, string init="init")


SHARE
%{
#ifndef Union
#error "The Union_init component must be included before this Single_crystal_process component"
#endif

%include "read_table-lib"
%include "interoff-lib"

#ifndef SINGLE_CRYSTAL_PROCESS_DECL
#define SINGLE_CRYSTAL_PROCESS_DECL

#ifndef Mosaic_AB_Undefined
#define Mosaic_AB_Undefined {0,0, 0,0,0, 0,0,0}
#endif

    struct hkl_data_union
    {
      int h,k,l;                  /* Indices for this reflection */
      double F2;                  /* Value of structure factor */
      double tau_x, tau_y, tau_z; /* Coordinates in reciprocal space */
      double tau;                 /* Length of (tau_x, tau_y, tau_z) */
      double u1x, u1y, u1z;       /* First axis of local coordinate system */
      double u2x, u2y, u2z;       /* Second axis of local coordinate system */
      double u3x, u3y, u3z;       /* Third axis of local coordinate system */
      double sig123;              /* The product sig1*sig2*sig3 = volume of spot */
      double m1, m2, m3;          /* Diagonal matrix representation of Gauss */
      double cutoff;              /* Cutoff value for Gaussian tails */
    };
    
  struct tau_data_union
    {
      int index;                  /* Index into reflection table */
      double refl;
      double xsect;
      /* The following vectors are in local koordinates. */
      double rho_x, rho_y, rho_z; /* The vector ki - tau */
      double rho;                 /* Length of rho vector */
      double ox, oy, oz;          /* Origin of Ewald sphere tangent plane */
      double b1x, b1y, b1z;       /* Spanning vectors of Ewald sphere tangent */
      double b2x, b2y, b2z;
      double l11, l12, l22;       /* Cholesky decomposition L of 2D Gauss */
      double y0x, y0y;            /* 2D Gauss center in tangent plane */
    };

  struct hkl_info_struct_union
    {
      struct hkl_data_union *list;      /* Reflection array */
      int count;                  /* Number of reflections */
      struct tau_data_union *tau_list;  /* Reflections close to Ewald Sphere */
      double m_delta_d_d;         /* Delta-d/d FWHM */
      double m_ax,m_ay,m_az;      /* First unit cell axis (direct space, AA) */
      double m_bx,m_by,m_bz;      /* Second unit cell axis */
      double m_cx,m_cy,m_cz;      /* Third unit cell axis */
      double asx,asy,asz;         /* First reciprocal lattice axis (1/AA) */
      double bsx,bsy,bsz;         /* Second reciprocal lattice axis */
      double csx,csy,csz;         /* Third reciprocal lattice axis */
      double m_a, m_b, m_c;       /* length of lattice parameter lengths */
      double m_aa, m_bb, m_cc;    /* lattice angles */
      double sigma_a, sigma_i;    /* abs and inc X sect */
      double rho;                 /* density */
      double at_weight;           /* atomic weight */
      double at_nb;               /* nb of atoms in a cell */
      double V0;                  /* Unit cell volume (AA**3) */
      int    column_order[5];     /* column signification [h,k,l,F,F2] */
      int    recip;               /* Flag to indicate if recip or direct cell axes given */
      int    shape;               /* 0:cylinder, 1:box, 2:sphere 3:any shape*/
      int    flag_warning;        /* number of warnings */
      char   type;                /* type of last event: t=transmit,c=coherent or i=incoherent */
      int    h,k,l;               /* last coherent scattering momentum transfer indices */
      int    tau_count;           /* Number of reflections within cutoff */
      double coh_refl, coh_xsect; /* cross section computed with last tau_list */
      double kix, kiy, kiz;       /* last incoming neutron ki */
      int    nb_reuses, nb_refl, nb_refl_count;
    };

  int SX_list_compare_union (void const *a, void const *b)
  {
     struct hkl_data_union const *pa = a;
     struct hkl_data_union const *pb = b;
     double s = pa->tau - pb->tau;
     
     if (!s) return 0;
     else    return (s < 0 ? -1 : 1);
  } /* PN_list_compare */
  
  /* ------------------------------------------------------------------------ */
  int
  read_hkl_data_union(char *SC_file, struct hkl_info_struct_union *info,
      double SC_mosaic, double SC_mosaic_a, double SC_mosaic_b, double SC_mosaic_c, double *SC_mosaic_AB)
  {
    struct hkl_data_union *list = NULL;
    int size = 0;
    t_Table sTable; /* sample data table structure from SC_file */
    int i=0;
    double tmp_x, tmp_y, tmp_z;
    char **parsing;
    char flag=0;
    double nb_atoms=1;

    if (!SC_file || !strlen(SC_file) || !strcmp(SC_file,"NULL") || !strcmp(SC_file,"0")) {
      info->count = 0;
      flag=1;
    }
    if (!flag) {
      Table_Read(&sTable, SC_file, 1); /* read 1st block data from SC_file into sTable*/
      if (sTable.columns < 4) {
        fprintf(stderr, "Single_crystal: Error: The number of columns in %s should be at least %d for [h,k,l,F2]\n", SC_file, 4);
        return(0);
      }
      if (!sTable.rows) {
        fprintf(stderr, "Single_crystal: Error: The number of rows in %s should be at least %d\n", SC_file, 1);
        return(0);
      } else size = sTable.rows;

      /* parsing of header */
      parsing = Table_ParseHeader(sTable.header,
        "sigma_abs","sigma_a ",
        "sigma_inc","sigma_i ",
        "column_h",
        "column_k",
        "column_l",
        "column_F ",
        "column_F2",
        "Delta_d/d",
        "lattice_a ",
        "lattice_b ",
        "lattice_c ",
        "lattice_aa",
        "lattice_bb",
        "lattice_cc",
        "nb_atoms","multiplicity",
        NULL);

      if (parsing) {
        if (parsing[0] && !info->sigma_a) info->sigma_a=atof(parsing[0]);
        if (parsing[1] && !info->sigma_a) info->sigma_a=atof(parsing[1]);
        if (parsing[2] && !info->sigma_i) info->sigma_i=atof(parsing[2]);
        if (parsing[3] && !info->sigma_i) info->sigma_i=atof(parsing[3]);
        if (parsing[4])                   info->column_order[0]=atoi(parsing[4]);
        if (parsing[5])                   info->column_order[1]=atoi(parsing[5]);
        if (parsing[6])                   info->column_order[2]=atoi(parsing[6]);
        if (parsing[7])                   info->column_order[3]=atoi(parsing[7]);
        if (parsing[8])                   info->column_order[4]=atoi(parsing[8]);
        if (parsing[9] && info->m_delta_d_d <0) info->m_delta_d_d=atof(parsing[9]);
        if (parsing[10] && !info->m_a)    info->m_a =atof(parsing[10]);
        if (parsing[11] && !info->m_b)    info->m_b =atof(parsing[11]);
        if (parsing[12] && !info->m_c)    info->m_c =atof(parsing[12]);
        if (parsing[13] && !info->m_aa)   info->m_aa=atof(parsing[13]);
        if (parsing[14] && !info->m_bb)   info->m_bb=atof(parsing[14]);
        if (parsing[15] && !info->m_cc)   info->m_cc=atof(parsing[15]);
        if (parsing[16])   nb_atoms=atof(parsing[16]);
        if (parsing[17])   nb_atoms=atof(parsing[17]);
        for (i=0; i<=17; i++) if (parsing[i]) free(parsing[i]);
        free(parsing);
      }
    }
    
    if (nb_atoms > 1) { info->sigma_a *= nb_atoms; info->sigma_i *= nb_atoms; }

    /* special cases for the structure definition */
    if (info->m_ax || info->m_ay || info->m_az) info->m_a=0; /* means we specify by hand the vectors */
    if (info->m_bx || info->m_by || info->m_bz) info->m_b=0;
    if (info->m_cx || info->m_cy || info->m_cz) info->m_c=0;

    /* compute the norm from vector a if missing */
    if (info->m_ax || info->m_ay || info->m_az) {
      double as=sqrt(info->m_ax*info->m_ax+info->m_ay*info->m_ay+info->m_az*info->m_az);
      if (!info->m_bx && !info->m_by && !info->m_bz) info->m_a=info->m_b=as;
      if (!info->m_cx && !info->m_cy && !info->m_cz) info->m_a=info->m_c=as;
    }
    if (info->m_a && !info->m_b) info->m_b=info->m_a;
    if (info->m_b && !info->m_c) info->m_c=info->m_b;
    
    /* compute the lattive angles if not set from data file. Not used when in vector mode. */
    if (info->m_a && !info->m_aa) info->m_aa=90;
    if (info->m_aa && !info->m_bb) info->m_bb=info->m_aa;
    if (info->m_bb && !info->m_cc) info->m_cc=info->m_bb;
    
    /* parameters consistency checks */
    if (!info->m_ax && !info->m_ay && !info->m_az && !info->m_a) {
      fprintf(stderr,
              "Single_crystal: Error: Wrong a lattice vector definition\n");
      return(0);
    }
    if (!info->m_bx && !info->m_by && !info->m_bz && !info->m_b) {
      fprintf(stderr,
              "Single_crystal: Error: Wrong b lattice vector definition\n");
      return(0);
    }
    if (!info->m_cx && !info->m_cy && !info->m_cz && !info->m_c) {
      fprintf(stderr,
              "Single_crystal: Error: Wrong c lattice vector definition\n");
      return(0);
    }
    if (info->m_aa && info->m_bb && info->m_cc && info->recip) {
      fprintf(stderr,
              "Single_crystal: Error: Selecting reciprocal cell and angles is unmeaningful\n");
      return(0);
    }

    /* when lengths a,b,c + angles are given (instead of vectors a,b,c) */
    if (info->m_aa && info->m_bb && info->m_cc)
    {
      double as,bs,cs;
      if (info->m_a) as = info->m_a;
      else as = sqrt(info->m_ax*info->m_ax+info->m_ay*info->m_ay+info->m_az*info->m_az);
      if (info->m_b) bs = info->m_b;
      else bs = sqrt(info->m_bx*info->m_bx+info->m_by*info->m_by+info->m_bz*info->m_bz);
      if (info->m_c) cs = info->m_c;
      else cs =  sqrt(info->m_cx*info->m_cx+info->m_cy*info->m_cy+info->m_cz*info->m_cz);

      info->m_bz = as; info->m_by = 0; info->m_bx = 0;
      info->m_az = bs*cos(info->m_cc*DEG2RAD);
      info->m_ay = bs*sin(info->m_cc*DEG2RAD);
      info->m_ax = 0;
      info->m_cz = cs*cos(info->m_bb*DEG2RAD);
      info->m_cy = cs*(cos(info->m_aa*DEG2RAD)-cos(info->m_cc*DEG2RAD)*cos(info->m_bb*DEG2RAD))
                     /sin(info->m_cc*DEG2RAD);
      info->m_cx = sqrt(cs*cs - info->m_cz*info->m_cz - info->m_cy*info->m_cy);

      printf("Single_crystal: %s structure a=%g b=%g c=%g aa=%g bb=%g cc=%g ",
        (flag ? "INC" : SC_file), as, bs, cs, info->m_aa, info->m_bb, info->m_cc);
    } else {
      if (!info->recip) {
        printf("Single_crystal: %s structure a=[%g,%g,%g] b=[%g,%g,%g] c=[%g,%g,%g] ",
	       (flag ? "INC" : SC_file), info->m_ax ,info->m_ay ,info->m_az,
	       info->m_bx ,info->m_by ,info->m_bz,
	       info->m_cx ,info->m_cy ,info->m_cz);
      } else {
        printf("Single_crystal: %s structure a*=[%g,%g,%g] b*=[%g,%g,%g] c*=[%g,%g,%g] ",
	       (flag ? "INC" : SC_file), info->m_ax ,info->m_ay ,info->m_az,
	       info->m_bx ,info->m_by ,info->m_bz,
	       info->m_cx ,info->m_cy ,info->m_cz);
      }
    }
    /* Compute reciprocal or direct lattice vectors. */
    if (!info->recip) {
      vec_prod(tmp_x, tmp_y, tmp_z,
	       info->m_bx, info->m_by, info->m_bz,
	       info->m_cx, info->m_cy, info->m_cz);
      info->V0 = fabs(scalar_prod(info->m_ax, info->m_ay, info->m_az, tmp_x, tmp_y, tmp_z));
      printf("V0=%g\n", info->V0);
      
      info->asx = 2*PI/info->V0*tmp_x;
      info->asy = 2*PI/info->V0*tmp_y;
      info->asz = 2*PI/info->V0*tmp_z;
      vec_prod(tmp_x, tmp_y, tmp_z, info->m_cx, info->m_cy, info->m_cz, info->m_ax, info->m_ay, info->m_az);
      info->bsx = 2*PI/info->V0*tmp_x;
      info->bsy = 2*PI/info->V0*tmp_y;
      info->bsz = 2*PI/info->V0*tmp_z;
      vec_prod(tmp_x, tmp_y, tmp_z, info->m_ax, info->m_ay, info->m_az, info->m_bx, info->m_by, info->m_bz);
      info->csx = 2*PI/info->V0*tmp_x;
      info->csy = 2*PI/info->V0*tmp_y;
      info->csz = 2*PI/info->V0*tmp_z;
    } else {
      info->asx = info->m_ax;
      info->asy = info->m_ay;
      info->asz = info->m_az;
      info->bsx = info->m_bx;
      info->bsy = info->m_by;
      info->bsz = info->m_bz;
      info->csx = info->m_cx;
      info->csy = info->m_cy;
      info->csz = info->m_cz;
      
      vec_prod(tmp_x, tmp_y, tmp_z,
	       info->bsx/(2*PI), info->bsy/(2*PI), info->bsz/(2*PI),
	       info->csx/(2*PI), info->csy/(2*PI), info->csz/(2*PI));
      info->V0 = 1/fabs(scalar_prod(info->asx/(2*PI), info->asy/(2*PI), info->asz/(2*PI), tmp_x, tmp_y, tmp_z));
      printf("V0=%g\n", info->V0);
      
      /*compute the direct cell parameters, ofr completeness*/ 
      info->m_ax = tmp_x*info->V0;
      info->m_ay = tmp_y*info->V0;
      info->m_az = tmp_z*info->V0;
      vec_prod(tmp_x, tmp_y, tmp_z,info->csx/(2*PI), info->csy/(2*PI), info->csz/(2*PI),info->asx/(2*PI), info->asy/(2*PI), info->asz/(2*PI));
      info->m_bx = tmp_x*info->V0;
      info->m_by = tmp_y*info->V0;
      info->m_bz = tmp_z*info->V0;
      vec_prod(tmp_x, tmp_y, tmp_z,info->asx/(2*PI), info->asy/(2*PI), info->asz/(2*PI),info->bsx/(2*PI), info->bsy/(2*PI), info->bsz/(2*PI));
      info->m_cx = tmp_x*info->V0;
      info->m_cy = tmp_y*info->V0;
      info->m_cz = tmp_z*info->V0;
    }

    if (flag) return(-1);

    if (!info->column_order[0] || !info->column_order[1] || !info->column_order[2]) {
      fprintf(stderr,
              "Single_crystal: Error: Wrong h,k,l column definition\n");
      return(0);
    }
    if (!info->column_order[3] && !info->column_order[4]) {
      fprintf(stderr,
              "Single_crystal: Error: Wrong F,F2 column definition\n");
      return(0);
    }

    /* allocate hkl_data array */
    list = (struct hkl_data_union*)malloc(size*sizeof(struct hkl_data_union));

    for (i=0; i<size; i++)
    {
      double h=0, k=0, l=0, F2=0;
      double b1[3], b2[3];
      double sig1, sig2, sig3;

      /* get data from table */
      h = Table_Index(sTable, i, info->column_order[0]-1);
      k = Table_Index(sTable, i, info->column_order[1]-1);
      l = Table_Index(sTable, i, info->column_order[2]-1);
      if (info->column_order[3])
      { F2= Table_Index(sTable, i, info->column_order[3]-1); F2 *= F2; }
      else if (info->column_order[4])
        F2= Table_Index(sTable, i, info->column_order[4]-1);

      list[i].h = h;
      list[i].k = k;
      list[i].l = l;
      list[i].F2 = F2;
      
      /* Precompute some values */
      list[i].tau_x = h*info->asx + k*info->bsx + l*info->csx;
      list[i].tau_y = h*info->asy + k*info->bsy + l*info->csy;
      list[i].tau_z = h*info->asz + k*info->bsz + l*info->csz;
      list[i].tau = sqrt(list[i].tau_x*list[i].tau_x +
                         list[i].tau_y*list[i].tau_y +
                         list[i].tau_z*list[i].tau_z);
      list[i].u1x = list[i].tau_x/list[i].tau;
      list[i].u1y = list[i].tau_y/list[i].tau;
      list[i].u1z = list[i].tau_z/list[i].tau;
      sig1 = FWHM2RMS*info->m_delta_d_d*list[i].tau;

      /* Find two arbitrary axes perpendicular to tau and each other. */
      normal_vec(&b1[0], &b1[1], &b1[2],
                 list[i].u1x, list[i].u1y, list[i].u1z);
      vec_prod(b2[0], b2[1], b2[2],
               list[i].u1x, list[i].u1y, list[i].u1z,
               b1[0], b1[1], b1[2]);
               
      /* Find the two mosaic axes perpendicular to tau. */
      if(SC_mosaic > 0) {
        /* Use isotropic mosaic. */
        list[i].u2x = b1[0];
        list[i].u2y = b1[1];
        list[i].u2z = b1[2];
        sig2 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic;
        list[i].u3x = b2[0];
        list[i].u3y = b2[1];
        list[i].u3z = b2[2];
        sig3 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic;
      } else if(SC_mosaic_a > 0 && SC_mosaic_b > 0 && SC_mosaic_c > 0) {
        /* Use anisotropic mosaic. */
        fprintf(stderr,"Single_crystal: Warning: you are using an experimental feature:\n"
          "  anistropic mosaicity. Please examine your data carefully.\n");
        /* compute the jacobian of (tau_v,tau_n) from rotations around the unit cell vectors. */
        struct hkl_data_union *l =&(list[i]);
        double xia_x,xia_y,xia_z,xib_x,xib_y,xib_z,xic_x,xic_y,xic_z;
        /*input parameters are in arc minutes*/
        double sig_fi_a=SC_mosaic_a*MIN2RAD;
        double sig_fi_b=SC_mosaic_b*MIN2RAD;
        double sig_fi_c=SC_mosaic_c*MIN2RAD;
        if(info->m_a==0) info->m_a=sqrt(scalar_prod( info->m_ax,info->m_ay,info->m_az,info->m_ax,info->m_ay,info->m_az));
        if(info->m_b==0) info->m_b=sqrt(scalar_prod( info->m_bx,info->m_by,info->m_bz,info->m_bx,info->m_by,info->m_bz));
        if(info->m_c==0) info->m_c=sqrt(scalar_prod( info->m_cx,info->m_cy,info->m_cz,info->m_cx,info->m_cy,info->m_cz));

        l->u2x = b1[0];
        l->u2y = b1[1];
        l->u2z = b1[2];
        l->u3x = b2[0];
        l->u3y = b2[1];
        l->u3z = b2[2];
                                                                          
        xia_x=l->tau_x-(M_2_PI*h/info->m_a)*info->asx;
        xia_y=l->tau_y-(M_2_PI*h/info->m_a)*info->asy;
        xia_z=l->tau_z-(M_2_PI*h/info->m_a)*info->asz;
        xib_x=l->tau_x-(M_2_PI*h/info->m_b)*info->bsx;
        xib_y=l->tau_y-(M_2_PI*h/info->m_b)*info->bsy;
        xib_z=l->tau_z-(M_2_PI*h/info->m_b)*info->bsz;
        xic_x=l->tau_x-(M_2_PI*h/info->m_c)*info->csx;
        xic_y=l->tau_y-(M_2_PI*h/info->m_c)*info->csy;
        xic_z=l->tau_z-(M_2_PI*h/info->m_c)*info->csz;

        double xia=sqrt(xia_x*xia_x + xia_y*xia_y + xia_z*xia_z);
        double xib=sqrt(xib_x*xib_x + xib_y*xib_y + xib_z*xib_z);
        double xic=sqrt(xic_x*xic_x + xic_y*xic_y + xic_z*xic_z);

        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z);
        double J_n_fia= xia/info->m_a/l->tau*scalar_prod(info->asx,info->asy,info->asz,tmp_x,tmp_y,tmp_z);
        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z);
        double J_n_fib= xib/info->m_b/l->tau*scalar_prod(info->bsx,info->bsy,info->bsz,tmp_x,tmp_y,tmp_z);
        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z);
        double J_n_fic= xic/info->m_c/l->tau*scalar_prod(info->csx,info->csy,info->csz,tmp_x,tmp_y,tmp_z);

        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z);
        double J_v_fia= xia/info->m_a/l->tau*scalar_prod(info->asx,info->asy,info->asz,tmp_x,tmp_y,tmp_z);
        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z);
        double J_v_fib= xib/info->m_b/l->tau*scalar_prod(info->bsx,info->bsy,info->bsz,tmp_x,tmp_y,tmp_z);
        vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z);
        double J_v_fic= xic/info->m_c/l->tau*scalar_prod(info->csx,info->csy,info->csz,tmp_x,tmp_y,tmp_z);

        /*with the jacobian we can compute the sigmas in terms of the orthogonal vectors u2 and u3*/
        sig2=sig_fi_a*fabs(J_v_fia) + sig_fi_b*fabs(J_v_fib) + sig_fi_c*fabs(J_v_fic);
        sig3=sig_fi_a*fabs(J_n_fia) + sig_fi_b*fabs(J_n_fib) + sig_fi_c*fabs(J_n_fic);
      } else if (SC_mosaic_AB[0]!=0 && SC_mosaic_AB[1]!=0){
        if ( (SC_mosaic_AB[2]==0 && SC_mosaic_AB[3]==0 && SC_mosaic_AB[4]==0) || (SC_mosaic_AB[5]==0 && SC_mosaic_AB[6]==0 && SC_mosaic_AB[7]==0) ){
          fprintf(stderr,"Single_crystal: Error: in-plane mosaics are specified but one (or both)\n"
              "  in-plane reciprocal vector is the zero vector\n");
          return(0);
        }
        fprintf(stderr,"Single_crystal: Warning: you are using an experimental feature: \n"
              "  \"in-plane\" anistropic mosaicity. Please examine your data carefully.\n");
 
        /*for given reflection in list - compute linear comb of tau_a and tau_b*/
        /*check for not in plane - f.i. check if (tau_a X tau_b).tau_i)==0*/
        struct hkl_data_union *l =&(list[i]);
        double det,c1,c2,sig_tau_c;
        double em_x,em_y,em_z, tmp_x,tmp_y,tmp_z;
        double tau_a[3],tau_b[3];
        /*convert Miller indices to taus*/
        if(info->m_a==0) info->m_a=sqrt(scalar_prod( info->m_ax,info->m_ay,info->m_az,info->m_ax,info->m_ay,info->m_az));
        if(info->m_b==0) info->m_b=sqrt(scalar_prod( info->m_bx,info->m_by,info->m_bz,info->m_bx,info->m_by,info->m_bz));
        if(info->m_c==0) info->m_c=sqrt(scalar_prod( info->m_cx,info->m_cy,info->m_cz,info->m_cx,info->m_cy,info->m_cz));
        tau_a[0]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asx + (SC_mosaic_AB[3]/info->m_b)*info->bsx + (SC_mosaic_AB[4]/info->m_c)*info->csx );
        tau_a[1]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asy + (SC_mosaic_AB[3]/info->m_b)*info->bsy + (SC_mosaic_AB[4]/info->m_c)*info->csy );
        tau_a[2]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asz + (SC_mosaic_AB[3]/info->m_b)*info->bsz + (SC_mosaic_AB[4]/info->m_c)*info->csz );
        tau_b[0]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asx + (SC_mosaic_AB[6]/info->m_b)*info->bsx + (SC_mosaic_AB[7]/info->m_c)*info->csx );
        tau_b[1]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asy + (SC_mosaic_AB[6]/info->m_b)*info->bsy + (SC_mosaic_AB[7]/info->m_c)*info->csy );
        tau_b[2]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asz + (SC_mosaic_AB[6]/info->m_b)*info->bsz + (SC_mosaic_AB[7]/info->m_c)*info->csz );
        
        /*check determinants to see how we should compute the linear combination of a and b (to match c)*/
        if ((det=tau_a[0]*tau_b[1]-tau_a[1]*tau_b[0])!=0){
          c1= (l->tau_x*tau_b[1] - l->tau_y*tau_b[0])/det;
          c2= (tau_a[0]*l->tau_y - tau_a[1]*l->tau_x)/det;
        }else if ((det=tau_a[1]*tau_b[2]-tau_a[2]*tau_b[1])!=0){
          c1= (l->tau_y*tau_b[2] - l->tau_z*tau_b[1])/det;
          c2= (tau_a[1]*l->tau_z - tau_a[2]*l->tau_y)/det;
        }else if ((det=tau_a[0]*tau_b[2]-tau_a[2]*tau_b[0])!=0){
          c1= (l->tau_x*tau_b[2] - l->tau_z*tau_b[0])/det;
          c2= (tau_a[0]*l->tau_z - tau_a[2]*l->tau_x)/det;
        }
        if ((c1==0) && (c2==0)){
          fprintf(stderr,"Single_crystal: Warning: reflection tau[%i]=(%g %g %g) "
          "has no component in defined mosaic plane\n", 
          i, l->tau_x,l->tau_y,l->tau_z);
        }
        /*compute linear combination => sig_tau_i = | c1*sig_tau_a + c2*sig_tau_b |  - also add in the minute to radian scaling factor*/;
        sig_tau_c = MIN2RAD*sqrt(c1*SC_mosaic_AB[0]*c1*SC_mosaic_AB[0] + c2*SC_mosaic_AB[1]*c2*SC_mosaic_AB[1]);
        l->u2x = b1[0]; l->u2y = b1[1]; l->u2z = b1[2];
        l->u3x = b2[0]; l->u3y = b2[1]; l->u3z = b2[2];

        /*so now let's compute the rotation around planenormal tau_a X tau_b*/
        /*g_bar (unit normal of rotation plane) = tau_a X tau_b / norm(tau_a X tau_b)*/
        vec_prod(tmp_x,tmp_y,tmp_z, tau_a[0],tau_a[1],tau_a[2],tau_b[0],tau_b[1],tau_b[2]);
        vec_prod(em_x,em_y,em_z, l->tau_x, l->tau_y, l->tau_z, tmp_x,tmp_y,tmp_z);
        NORM(em_x,em_y,em_z);
        sig2 = l->tau*sig_tau_c*fabs(scalar_prod(em_x,em_y,em_z, l->u2x,l->u2y,l->u2z));
        sig3 = l->tau*sig_tau_c*fabs(scalar_prod(em_x,em_y,em_z, l->u3x,l->u3y,l->u3z));
        /*protect against collapsing gaussians. These seem to be sensible values.*/
        if (sig2<1e-5) sig2=1e-5;
        if (sig3<1e-5) sig3=1e-5;
      }
      else {
        fprintf(stderr,
                "Single_crystal: Error: EITHER mosaic OR (mosaic_a, mosaic_b, mosaic_c)\n"
                "  must be given and be >0.\n");
        return(0);
      }
      list[i].sig123 = sig1*sig2*sig3;
      list[i].m1 = 1/(2*sig1*sig1);
      list[i].m2 = 1/(2*sig2*sig2);
      list[i].m3 = 1/(2*sig3*sig3);
      /* Set Gauss cutoff to 5 times the maximal sigma. */
      if(sig1 > sig2)
        if(sig1 > sig3)
          list[i].cutoff = 5*sig1;
        else
          list[i].cutoff = 5*sig3;
      else
        if(sig2 > sig3)
          list[i].cutoff = 5*sig2;
        else
          list[i].cutoff = 5*sig3;
    }
    Table_Free(&sTable);
    
    /* sort the list with increasing tau */
    qsort(list, i, sizeof(struct hkl_data_union),  SX_list_compare_union);
    
    info->list = list;
    info->count = i;
    info->tau_list = malloc(i*sizeof(*info->tau_list));
    if(!info->tau_list)
    {
      fprintf(stderr, "Single_crystal: Error: Out of memory!\n");
      return(0);
    }
    return(info->count);
  } /* read_hkl_data */

  /* ------------------------------------------------------------------------ */
  /* hkl_search
    search the HKL reflections which are on the Ewald sphere
    input:
      L,T,count,V0: constants for all calls
      kix,kiy,kiz: may be different for each call
    this function returns:
      tau_count (return), coh_refl, coh_xsect, T (updated elements in the array up to [j])
   */
  int hkl_search_union(struct hkl_data_union *L, struct tau_data_union *T, int count, double V0,
    double kix, double kiy, double kiz, double tau_max,
    double *coh_refl, double *coh_xsect)
  {
    double rho, rho_x, rho_y, rho_z;
    double diff;
    int    i,j;
    double ox,oy,oz;
    double b1x,b1y,b1z, b2x,b2y,b2z, kx, ky, kz, nx, ny, nz;
    double n11, n22, n12, det_N, inv_n11, inv_n22, inv_n12, l11, l22, l12,  det_L;
    double Bt_D_O_x, Bt_D_O_y, y0x, y0y, alpha;
    
    double ki = sqrt(kix*kix+kiy*kiy+kiz*kiz);

    /* Common factor in coherent cross-section */
    double xsect_factor = pow(2*PI, 5.0/2.0)/(V0*ki*ki);
    
    for(i = j = 0; i < count; i++)
      {
    /* Assuming reflections are sorted, stop search when max tau exceeded. */
        if(L[i].tau > tau_max)
          break;
        /* Check if this reciprocal lattice point is close enough to the
           Ewald sphere to make scattering possible. */
        rho_x = kix - L[i].tau_x;
        rho_y = kiy - L[i].tau_y;
        rho_z = kiz - L[i].tau_z;
        rho = sqrt(rho_x*rho_x + rho_y*rho_y + rho_z*rho_z);
        diff = fabs(rho - ki);

        /* Check if scattering is possible (cutoff of Gaussian tails). */
        if(diff <= L[i].cutoff)
        {
          /* Store reflection. */
          T[j].index = i;
          /* Get ki vector in local coordinates. */
          kx = kix*L[i].u1x + kiy*L[i].u1y + kiz*L[i].u1z;
          ky = kix*L[i].u2x + kiy*L[i].u2y + kiz*L[i].u2z;
          kz = kix*L[i].u3x + kiy*L[i].u3y + kiz*L[i].u3z;
          T[j].rho_x = kx - L[i].tau;
          T[j].rho_y = ky;
          T[j].rho_z = kz;
          T[j].rho = rho;
          /* Compute the tangent plane of the Ewald sphere. */
          nx = T[j].rho_x/T[j].rho;
          ny = T[j].rho_y/T[j].rho;
          nz = T[j].rho_z/T[j].rho;
          ox = (ki - T[j].rho)*nx;
          oy = (ki - T[j].rho)*ny;
          oz = (ki - T[j].rho)*nz;
          T[j].ox = ox;
          T[j].oy = oy;
          T[j].oz = oz;
          /* Compute unit vectors b1 and b2 that span the tangent plane. */
          normal_vec(&b1x, &b1y, &b1z, nx, ny, nz);
          vec_prod(b2x, b2y, b2z, nx, ny, nz, b1x, b1y, b1z);
          T[j].b1x = b1x;
          T[j].b1y = b1y;
          T[j].b1z = b1z;
          T[j].b2x = b2x;
          T[j].b2y = b2y;
          T[j].b2z = b2z;
          /* Compute the 2D projection of the 3D Gauss of the reflection. */
          /* The symmetric 2x2 matrix N describing the 2D gauss. */
          n11 = L[i].m1*b1x*b1x + L[i].m2*b1y*b1y + L[i].m3*b1z*b1z;
          n12 = L[i].m1*b1x*b2x + L[i].m2*b1y*b2y + L[i].m3*b1z*b2z;
          n22 = L[i].m1*b2x*b2x + L[i].m2*b2y*b2y + L[i].m3*b2z*b2z;
          /* The (symmetric) inverse matrix of N. */
          det_N = n11*n22 - n12*n12;
          inv_n11 = n22/det_N;
          inv_n12 = -n12/det_N;
          inv_n22 = n11/det_N;
          /* The Cholesky decomposition of 1/2*inv_n (lower triangular L). */
          l11 = sqrt(inv_n11/2);
          l12 = inv_n12/(2*l11);
          l22 = sqrt(inv_n22/2 - l12*l12);
          T[j].l11 = l11;
          T[j].l12 = l12;
          T[j].l22 = l22;
          det_L = l11*l22;
          /* The product B^T D o. */
          Bt_D_O_x = b1x*L[i].m1*ox + b1y*L[i].m2*oy + b1z*L[i].m3*oz;
          Bt_D_O_y = b2x*L[i].m1*ox + b2y*L[i].m2*oy + b2z*L[i].m3*oz;
          /* Center of 2D Gauss in plane coordinates. */
          y0x = -(Bt_D_O_x*inv_n11 + Bt_D_O_y*inv_n12);
          y0y = -(Bt_D_O_x*inv_n12 + Bt_D_O_y*inv_n22);
          T[j].y0x = y0x;
          T[j].y0y = y0y;
          /* Factor alpha for the distance of the 2D Gauss from the origin. */
          alpha = L[i].m1*ox*ox + L[i].m2*oy*oy + L[i].m3*oz*oz -
                       (y0x*y0x*n11 + y0y*y0y*n22 + 2*y0x*y0y*n12);
          T[j].refl = xsect_factor*det_L*exp(-alpha)/L[i].sig123; /* intensity of that Bragg */
          *coh_refl += T[j].refl;                                  /* total scatterable intensity */
          T[j].xsect = T[j].refl*L[i].F2;
          *coh_xsect += T[j].xsect;
          j++;
        }
        
      } /* end for */
        return (j); // this is 'tau_count', i.e. number of reachable reflections
    } /* end hkl_search */
    
    int hkl_select_union(struct tau_data_union *T, int tau_count, double coh_refl, double *sum, _class_particle *_particle) {
      int j;
      double r = rand0max(coh_refl);
      *sum = 0;
      for(j = 0; j < tau_count; j++)
      {
        *sum += T[j].refl;
        if(*sum > r) break;
      }
      return j;
    }

    /* Functions for "reorientation", powder and PG modes */
    /* Powder, forward */
    void randrotate_union(double *nx, double *ny, double *nz, double a, double b, double c) {
      double x1, y1, z1, x2, y2, z2;
      rotate(x1, y1, z1, *nx,*ny,*nz, a, 1, 0, 0); /* <1> = rot(<n>,a) */
      rotate(x2, y2, z2,  x1, y1, z1, b, 0, 1, 0); /* <2> = rot(<1>,b) */
      rotate(*nx,*ny,*nz, x2, y2, z2, c, 0, 0, 1); /* <n> = rot(<2>,c) */
    }
    /* Powder, back */
    void randderotate_union(double *nx, double *ny, double *nz, double a, double b, double c) {
      double x1, y1, z1, x2, y2, z2;
      rotate(x1, y1, z1, *nx,*ny,*nz, -c, 0,0,1);
      rotate(x2, y2, z2,  x1, y1, z1, -b, 0,1,0);
      rotate(*nx,*ny,*nz, x2, y2, z2, -a, 1,0,0);
    }
    /* PG, forward */
    void PGrotate_union(double *nx, double *ny, double *nz, double a, double csx, double csy, double csz) {
      /* Currently assumes c-axis along 'x', ought to be generalized... */
      double nvx, nvy, nvz;
      rotate(nvx,nvy,nvz, *nx, *ny, *nz, a, csx, csy, csz);
      *nx = nvx; *ny = nvy; *nz = nvz;
    }
    /* PG, back */
    void PGderotate_union(double *nx, double *ny, double *nz, double a, double csx, double csy, double csz) {
      /* Currently assumes c-axis along 'x', ought to be generalized... */
      double nvx, nvy, nvz;
      rotate(nvx,nvy,nvz, *nx, *ny, *nz, -a, csx, csy, csz);
      *nx = nvx; *ny = nvy; *nz = nvz;
    }


#endif /* !SINGLE_CRYSTAL_PROCESS_DECL */

// Very important to add a pointer to this struct in the union-lib.c file
struct Single_crystal_physics_storage_struct{
    // Variables that needs to be transfered between any of the following places:
    // The initialize in this component
    // The function for calculating my
    // The function for calculating scattering
    
    // Avoid duplicates of output parameters and setting parameters in naming
    double PG_setting;     // 0 if PG mode is diabled, 1 if enabled. Values between apporximates texture?
    double powder_setting; // 0 if powder mode is disabled, 1 if enabled. Values between approximates texture?
    double Alpha;          // random angle between 0 and 2*Pi*powder
    double Beta;           // random angle between -Pi/2 and Pi/2
    double Gamma;           // random angle between -Pi and Pi
    
    struct hkl_info_struct_union *hkl_info_storage; // struct containing all necessary info for SC
    double pack; // packing factor
    double barns_setting; // Sets wether barns of fm^2 is used
};

// Function for calculating my, the inverse penetration depth (for only this scattering process).
// The input for this function and its order may not be changed, but the names may be updated.
int Single_crystal_physics_my(double *my, double *k_initial, union data_transfer_union data_transfer, struct focus_data_struct *focus_data, _class_particle *_particle) {
    // *k_initial is a pointer to a simple vector with 3 doubles, k[0], k[1], k[2] which describes the wavevector
    double kix = k_initial[0],kiy = k_initial[1],kiz = k_initial[2];
    double ki = sqrt(k_initial[0]*k_initial[0]+k_initial[1]*k_initial[1]+k_initial[2]*k_initial[2]);
    
    struct hkl_info_struct_union *hkl_info = data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->hkl_info_storage;
    
    // Taken from Single_crystal and changed hkl_info to a pointer.
    // The split optimization is less useful here than normally
    
    if (data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->powder_setting) {
      //orientation of crystallite is random
	  data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha = randpm1()*PI*data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->powder_setting;
	  data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Beta = randpm1()*PI/2;
      data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Gamma = randpm1()*PI;
      
	  randrotate_union(&kix, &kiy, &kiz,
        data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha,
        data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Beta,
        data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Gamma);
    }
    if (data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->PG_setting) {
      // orientation of crystallite is random
      data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha = rand01()*2*PI*data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->PG_setting;
	  PGrotate_union(&kix, &kiy, &kiz,
        data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha,
        hkl_info->csx, hkl_info->csy, hkl_info->csz);
    }
    
    /* in case we use 'SPLIT' then consecutive neutrons can be identical when entering here
         and we may skip the hkl_search call */
    if ( fabs(kix - hkl_info->kix) < 1e-6
        && fabs(kiy - hkl_info->kiy) < 1e-6
        && fabs(kiz - hkl_info->kiz) < 1e-6) {
        hkl_info->nb_reuses++;
      } else {
        /* Max possible tau for this ki with 5*sigma delta-d/d cutoff. */
        double tau_max   = 2*ki/(1 - 5*hkl_info->m_delta_d_d);
        double coh_xsect = 0, coh_refl = 0;
        
        /* call hkl_search */
        hkl_info->tau_count = hkl_search_union(hkl_info->list, hkl_info->tau_list, hkl_info->count, hkl_info->V0, kix, kiy, kiz, tau_max, &coh_refl, &coh_xsect); /* CPU consuming */
          
        // This is problematic as there is no way to know if this is the first scattering in this material or not with the current structure.
        // Need to do one of the following:
        //  remove this optimization
        //  find a way to set event_counter to 0 when a neutron enters a volume with a SC process
        //  pass the number of scatterings in this volume to all my functions
        // temporary solution: all events are considered the first
        int event_counter = 0;
        
        
        /* store ki so that we can check for further SPLIT iterations */
        if (event_counter == 0 ) { /* only for incoming neutron */
          hkl_info->kix = kix;
          hkl_info->kiy = kiy;
          hkl_info->kiz = kiz;
        }
        
        hkl_info->coh_refl  = coh_refl;
        hkl_info->coh_xsect = coh_xsect;
        hkl_info->nb_refl += hkl_info->tau_count;
        hkl_info->nb_refl_count++;
      }

      /* (3). Probabilities of the different possible interactions. */
      //tot_xsect = abs_xsect + inc_xsect + hkl_info.coh_xsect;
      /* Cross-sections are in barns = 10**-28 m**2, and unit cell volumes are
         in AA**3 = 10**-30 m**2. Hence a factor of 100 is used to convert
         scattering lengths to m**-1 */
      double coh_xlen = hkl_info->coh_xsect/hkl_info->V0;
      if (data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->barns_setting) {
        coh_xlen *= 100;
      }
    
      //printf("Single crystal process returned coh_xlen = %E \n",coh_xlen);
      *my = coh_xlen*data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->pack;
      int iterate;
      //if (hkl_info->tau_count == 0) printf("my: ki=%f, no reflections matched \n",ki);
      for (iterate=0;iterate<hkl_info->tau_count;iterate++)
        //printf("my: ki=%f, hkl_info->coh_xsect = %f, T[%d].refl = %f, coh_xlen = %f \n",ki,hkl_info->coh_xsect,iterate,hkl_info->tau_list[iterate].refl,coh_xlen);
      // Probably need to rotate back from Powder/PG/curvature mode, as another process than this one could be selected. Would just need to send the used rotation parameters to the process to repeat that rotation.
    
    return 1;
};

// Function that provides description of a basic scattering event.
// Do not change the
int Single_crystal_physics_scattering(double *k_final, double *k_initial, double *weight, union data_transfer_union data_transfer, struct focus_data_struct *focus_data, _class_particle *_particle) {

    int i;                        /* Index into structure factor list */
    struct hkl_data_union *L;     /* Structure factor list */
    int j;                        /* Index into reflection list */
    struct tau_data_union *T;     /* List of reflections close to Ewald sphere */
    //double ox, oy, oz;            /* Origin of Ewald sphere tangent plane */
    //double l11, l12, l22;         /* Cholesky decomposition L of 1/2*inv(N) */
    double b1x, b1y, b1z;         /* First vector spanning tangent plane */
    double b2x, b2y, b2z;         /* Second vector spanning tangent plane */
    double z1, z2, y1, y2;        /* Temporaries to choose kf from 2D Gauss */
    double adjust, r, sum;        /* Temporaries */
    double kfx, kfy, kfz;         /* Final wave vector */

    double kix = k_initial[0],kiy = k_initial[1],kiz = k_initial[2];
    double ki = sqrt(k_initial[0]*k_initial[0]+k_initial[1]*k_initial[1]+k_initial[2]*k_initial[2]);
    
    struct hkl_info_struct_union *hkl_info = data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->hkl_info_storage;
    
    L = hkl_info->list;
    T = hkl_info->tau_list;
    
    
    // Taken from Single_crystal.comp
    if(hkl_info->coh_refl <= 0){
          return 0; // Return 0 will use ABSORB in main component (as it is not allowed in a function)
    }
    sum = 0;
    j = hkl_select_union(T, hkl_info->tau_count, hkl_info->coh_refl, &sum, _particle);
    //printf("Selected j = %d with T[%d].refl = %f \n",j,j,T[j].refl);

    if(j >= hkl_info->tau_count)
    {
      #ifndef OPENACC
      if (hkl_info->flag_warning < 100)
        fprintf(stderr, "Single_crystal_process: Error: Illegal tau search "
          "(r=%g, sum=%g, j=%i, tau_count=%i).\n", r, sum, j , hkl_info->tau_count);
      #endif
      hkl_info->flag_warning++;
      j = hkl_info->tau_count - 1;
    }
    i = T[j].index;
    /* (8). Pick scattered wavevector kf from 2D Gauss distribution. */
    z1 = randnorm();
    z2 = randnorm();
    y1 = T[j].l11*z1 + T[j].y0x;
    y2 = T[j].l12*z1 + T[j].l22*z2 + T[j].y0y;
    kfx = T[j].rho_x + T[j].ox + T[j].b1x*y1 + T[j].b2x*y2;
    kfy = T[j].rho_y + T[j].oy + T[j].b1y*y1 + T[j].b2y*y2;
    kfz = T[j].rho_z + T[j].oz + T[j].b1z*y1 + T[j].b2z*y2;
    /* Normalize kf to length of ki, to account for planer
      approximation of the Ewald sphere. */
    adjust = ki/sqrt(kfx*kfx + kfy*kfy + kfz*kfz);
    kfx *= adjust;
    kfy *= adjust;
    kfz *= adjust;
    /* Adjust neutron weight (see manual for explanation). */
    *weight *= T[j].xsect*hkl_info->coh_refl/(hkl_info->coh_xsect*T[j].refl);
    //printf("SCATTERING: hkl_info->coh_refl=%f, hkl_info->coh_xsect = %f, T[%d].refl = %f, hkl_info->tau.count = %d \n",hkl_info->coh_refl,hkl_info->coh_xsect,j,T[j].refl,hkl_info->tau_count);

    // These is the returned final wavevector
    k_final[0] = L[i].u1x*kfx + L[i].u2x*kfy + L[i].u3x*kfz;
    k_final[1] = L[i].u1y*kfx + L[i].u2y*kfy + L[i].u3y*kfz;
    k_final[2] = L[i].u1z*kfx + L[i].u2z*kfy + L[i].u3z*kfz;
    
    if (data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->powder_setting) {
      // orientation of crystallite is no longer random
	  randderotate_union(&k_final[0], &k_final[1], &k_final[2],
                         data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha,
                         data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Beta,
                         data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Gamma);
    }
    if (data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->PG_setting) {
      // orientation of crystallite is longer random
	  PGderotate_union(&k_final[0], &k_final[1], &k_final[2], data_transfer.pointer_to_a_Single_crystal_physics_storage_struct->Alpha, hkl_info->csx, hkl_info->csy, hkl_info->csz);
    }

    hkl_info->type = 'c';
    hkl_info->h    = L[i].h;
    hkl_info->k    = L[i].k;
    hkl_info->l    = L[i].l;

    return 1;
};

#ifndef PROCESS_DETECTOR
    #define PROCESS_DETECTOR dummy
#endif

#ifndef PROCESS_SINGLE_CRYSTAL_DETECTOR
    #define PROCESS_SINGLE_CRYSTAL_DETECTOR dummy
#endif
%}

DECLARE
%{
// Declare for this component, to do calculations on the input / store in the transported data
struct Single_crystal_physics_storage_struct Single_crystal_storage;

// Variables needed in initialize of this function.
struct hkl_info_struct_union hkl_info_union;

// Needed for transport to the main component, will be the same for all processes
struct global_process_element_struct global_process_element;
struct scattering_process_struct This_process;
%}

INITIALIZE
%{
  // Single crystal initialize
  double as, bs, cs;
  int i=0;

  /* transfer input parameters */
  hkl_info_union.m_delta_d_d = delta_d_d;
  hkl_info_union.m_a  = 0;
  hkl_info_union.m_b  = 0;
  hkl_info_union.m_c  = 0;
  hkl_info_union.m_aa = aa;
  hkl_info_union.m_bb = bb;
  hkl_info_union.m_cc = cc;
  hkl_info_union.m_ax = ax;
  hkl_info_union.m_ay = ay;
  hkl_info_union.m_az = az;
  hkl_info_union.m_bx = bx;
  hkl_info_union.m_by = by;
  hkl_info_union.m_bz = bz;
  hkl_info_union.m_cx = cx;
  hkl_info_union.m_cy = cy;
  hkl_info_union.m_cz = cz;
  //hkl_info_union.sigma_a = sigma_abs;
  //hkl_info_union.sigma_i = sigma_inc;
  hkl_info_union.recip   = recip_cell;

  /* default format h,k,l,F,F2  */
  hkl_info_union.column_order[0]=1;
  hkl_info_union.column_order[1]=2;
  hkl_info_union.column_order[2]=3;
  hkl_info_union.column_order[3]=0;
  hkl_info_union.column_order[4]=7;
  hkl_info_union.kix = hkl_info_union.kiy = hkl_info_union.kiz = 0;
  hkl_info_union.nb_reuses = hkl_info_union.nb_refl = hkl_info_union.nb_refl_count = 0;
  hkl_info_union.tau_count = 0;

  /* ought to be cleaned up as mosaic_AB now is a proper vector/array and not a define */
  double* mosaic_ABin = mosaic_AB;
  /* Read in structure factors, and do some pre-calculations. */
  if (!read_hkl_data_union(reflections, &hkl_info_union, mosaic, mosaic_a, mosaic_b, mosaic_c, mosaic_ABin)) {
    printf("Single_crystal_process: %s: Error: Aborting.\n", NAME_CURRENT_COMP);
    exit(0);
  }
    
  if (hkl_info_union.sigma_a<0) hkl_info_union.sigma_a=0;
  if (hkl_info_union.sigma_i<0) hkl_info_union.sigma_i=0;
  
  if (hkl_info_union.count)
    printf("Single_crystal_process: %s: Read %d reflections from file '%s'\n",
      NAME_CURRENT_COMP, hkl_info_union.count, reflections);
  else printf("Single_crystal_process: %s: Using incoherent elastic scattering only sigma=%g.\n",
      NAME_CURRENT_COMP, hkl_info_union.sigma_i);
  
  /*
  hkl_info.shape=-1; // -1:no shape, 0:cyl, 1:box, 2:sphere, 3:any-shape
  if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) {
	  if (off_init(geometry, xwidth, yheight, zdepth, 0, &offdata)) {
      hkl_info.shape=3; 
    }
  }
  else if (xwidth && yheight && zdepth)  hkl_info.shape=1; // box
  else if (radius > 0 && yheight)        hkl_info.shape=0; // cylinder
  else if (radius > 0 && !yheight)       hkl_info.shape=2; // sphere

  if (hkl_info.shape < 0) 
    exit(fprintf(stderr,"Single_crystal: %s: sample has invalid dimensions.\n"
                        "ERROR           Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP));
  */
  
  printf("Single_crystal: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n",
      NAME_CURRENT_COMP, hkl_info_union.V0, hkl_info_union.sigma_a, hkl_info_union.sigma_i,
      reflections && strlen(reflections) ? reflections : "NULL");

  if (powder && PG) 
    exit(fprintf(stderr,"Single_crystal_process: %s: powder and PG modes can not be used together!\n"
	     "ERROR           Please use EITHER powder or PG mode.\n", NAME_CURRENT_COMP));

  if (powder && !(order==1)) {
    fprintf(stderr,"Single_crystal_process: %s: powder mode means implicit choice of no multiple scattering!\n"
	    "WARNING setting order=1\n", NAME_CURRENT_COMP);
    order=1;
  } 
  
  if (PG && !(order==1)) {
    fprintf(stderr,"Single_crystal_process: %s: PG mode means implicit choice of no multiple scattering!\n"
	    "WARNING setting order=1\n", NAME_CURRENT_COMP);
    order=1;
  } 

  // Temporary errors untill these features are either added or removed from input
  

  if (powder)
    exit(fprintf(stderr,"Single_crystal_process: %s: powder mode not supported yet!\n"
	     "ERROR           Please disable powder mode.\n", NAME_CURRENT_COMP));
  

  if (PG)
    exit(fprintf(stderr,"Single_crystal_process: %s: PG mode not supported yet!\n"
	     "ERROR           Please disable PG mode.\n", NAME_CURRENT_COMP));
   
  if (order)
    exit(fprintf(stderr,"Single_crystal_process: %s: Order control not supported yet!\n"
	     "ERROR           Please set order to zero.\n", NAME_CURRENT_COMP));
  
  // Initialize done in the component
  // Added for single crystal
  Single_crystal_storage.PG_setting = PG;
  Single_crystal_storage.powder_setting = powder;
  Single_crystal_storage.barns_setting = barns;
  Single_crystal_storage.pack = packing_factor;
  Single_crystal_storage.hkl_info_storage = &hkl_info_union;

  // Need to specify if this process is isotropic
  //This_process.non_isotropic_rot_index = -1; // Yes (powder)
  This_process.non_isotropic_rot_index =  1;  // No (single crystal)

  // The type of the process must be saved in the global enum process
  This_process.eProcess = Single_crystal;

  // Packing the data into a structure that is transported to the main component
  This_process.data_transfer.pointer_to_a_Single_crystal_physics_storage_struct = &Single_crystal_storage;
  This_process.probability_for_scattering_function = &Single_crystal_physics_my;
  This_process.scattering_function = &Single_crystal_physics_scattering;

  // This will be the same for all process's, and can thus be moved to an include.
  This_process.process_p_interact = interact_fraction;
  sprintf(This_process.name,"%s",NAME_CURRENT_COMP);
  rot_copy(This_process.rotation_matrix,ROT_A_CURRENT_COMP);
  sprintf(global_process_element.name,"%s",NAME_CURRENT_COMP);
  global_process_element.component_index = INDEX_CURRENT_COMP;
  global_process_element.p_scattering_process = &This_process;

if (_getcomp_index(init) < 0) {
fprintf(stderr,"Single_crystal_process:%s: Error identifying Union_init component, %s is not a known component name.\n",
NAME_CURRENT_COMP, init);
exit(-1);
}


struct pointer_to_global_process_list *global_process_list = COMP_GETPAR3(Union_init, init, global_process_list);
  add_element_to_process_list(global_process_list, global_process_element);
  
 %}

TRACE
%{
    // Trace should be empty, the simulation is done in Union_master
%}

END
