From 962d0469064f01416bc0e24c07b1594f679f64cb Mon Sep 17 00:00:00 2001 From: Peter Willendrup Date: Tue, 17 Feb 2026 19:13:59 +0100 Subject: [PATCH 1/2] Apply formatter to misc --- mcstas-comps/contrib/PSD_Detector.comp | 1863 ++++++++++++------------ 1 file changed, 959 insertions(+), 904 deletions(-) diff --git a/mcstas-comps/contrib/PSD_Detector.comp b/mcstas-comps/contrib/PSD_Detector.comp index 0693ceb78..2ac6756c8 100644 --- a/mcstas-comps/contrib/PSD_Detector.comp +++ b/mcstas-comps/contrib/PSD_Detector.comp @@ -184,17 +184,19 @@ string FN_Conv="He3inHe.table", string FN_Stop="He3inCF4.table") SHARE %{ -%include "read_table-lib" -%include "monitor_nd-lib" - -#ifndef PSD_Detector_SHARE -#define PSD_Detector_SHARE -#pragma acc routine seq -double PSD_He_interp1value(double *array_x,double *array_y,long n_elements,double interp_x) { + %include "read_table-lib" + %include "monitor_nd-lib" + + #ifndef PSD_Detector_SHARE + #define PSD_Detector_SHARE + #pragma acc routine seq + double + PSD_He_interp1value (double* array_x, double* array_y, long n_elements, double interp_x) { long cnt1 = 0; double a; // while (interp_x > array_x[++cnt1]); - while (cnt1 < n_elements-1 && interp_x >= array_x[++cnt1]); + while (cnt1 < n_elements - 1 && interp_x >= array_x[++cnt1]) + ; a = (interp_x - array_x[cnt1 - 1]) / (array_x[cnt1] - array_x[cnt1 - 1]); return array_y[cnt1 - 1] + a * (array_y[cnt1] - array_y[cnt1 - 1]); @@ -204,699 +206,774 @@ double PSD_He_interp1value(double *array_x,double *array_y,long n_elements,doubl DECLARE %{ - MonitornD_Defines_type DEFS; /* for event files */ - MonitornD_Variables_type Vars; - - DArray2d PSD_N; - DArray2d PSD_p; - DArray2d PSD_p2; - - double *EAP; // Array of energies for the proton from the list, with zero added on top - double *EAT; // Array of energies for the triton from the list, with zero added on top - double *M1P1; // Centers Of Gravity of transfer of energy by proton - double *M1T1; // Centers Of Gravity of transfer of energy by triton - double *PosAP; // positions of each packet of energy from the list, in m - double *PosAT; // positions of each packet of energy from the list, in m - double *PHSpectrum0; // 1 for each neutron - double *PHSpectrum; // Pulse height spectrum procuced in the detector, 1 keV/channel - double *PHSpectrum2; // 2nd order moments - long PHSpectrum_n; - double CrossSectionHe; // cross section for 0.18 nm neutrons in the converter - - double CountNeutrons; // counter over all neutrons to pass the component - double GeomCumul; /* 'geometric' cumulative probability that - simulated neutrons will encounter the detector on their path */ - double AbsCumul; /* cumulative probability that - simulated neutrons that encounter the detector on their path - will be absorbed */ - double SensVolCumul; /* cumulative probability that - simulated neutrons that encounter the detector on their path - will produce a signal (perhaps small) with COG in the - sensitive volume of the detector */ - double DetCumul; /* cumulative probability that - simulated neutrons will be absorbed *and* produce a signal - that will cross the threshold */ - long nH_p; // number of table elements for the proton in Helium-3 - long nH_t; // number of table elements for the triton in Helium-3 - double FullEnergyP; - double FullEnergyT; - long VariousErrors; /* container for the occurrence of various - errors, so that the algorithm gives the matching error - messages only once each */ - long DetectorType; // 1 for box, 2 for tube, 4 for cylinder ('banana'). Anything else gives an error. - double rb; // radius of the back plane of the detector + MonitornD_Defines_type DEFS; /* for event files */ + MonitornD_Variables_type Vars; + + DArray2d PSD_N; + DArray2d PSD_p; + DArray2d PSD_p2; + + double* EAP; // Array of energies for the proton from the list, with zero added on top + double* EAT; // Array of energies for the triton from the list, with zero added on top + double* M1P1; // Centers Of Gravity of transfer of energy by proton + double* M1T1; // Centers Of Gravity of transfer of energy by triton + double* PosAP; // positions of each packet of energy from the list, in m + double* PosAT; // positions of each packet of energy from the list, in m + double* PHSpectrum0; // 1 for each neutron + double* PHSpectrum; // Pulse height spectrum procuced in the detector, 1 keV/channel + double* PHSpectrum2; // 2nd order moments + long PHSpectrum_n; + double CrossSectionHe; // cross section for 0.18 nm neutrons in the converter + + double CountNeutrons; // counter over all neutrons to pass the component + double GeomCumul; /* 'geometric' cumulative probability that + simulated neutrons will encounter the detector on their path */ + double AbsCumul; /* cumulative probability that + simulated neutrons that encounter the detector on their path + will be absorbed */ + double SensVolCumul; /* cumulative probability that + simulated neutrons that encounter the detector on their path + will produce a signal (perhaps small) with COG in the + sensitive volume of the detector */ + double DetCumul; /* cumulative probability that + simulated neutrons will be absorbed *and* produce a signal + that will cross the threshold */ + long nH_p; // number of table elements for the proton in Helium-3 + long nH_t; // number of table elements for the triton in Helium-3 + double FullEnergyP; + double FullEnergyT; + long VariousErrors; /* container for the occurrence of various + errors, so that the algorithm gives the matching error + messages only once each */ + long DetectorType; // 1 for box, 2 for tube, 4 for cylinder ('banana'). Anything else gives an error. + double rb; // radius of the back plane of the detector %} INITIALIZE %{ - CountNeutrons=0; - GeomCumul=0; - AbsCumul=0; - SensVolCumul=0; - DetCumul=0; - VariousErrors=0; - DetectorType=0; + CountNeutrons = 0; + GeomCumul = 0; + AbsCumul = 0; + SensVolCumul = 0; + DetCumul = 0; + VariousErrors = 0; + DetectorType = 0; - long i,j; + long i, j; t_Table Part_He_3_p; t_Table Part_Stop_p; long nS_p; // number of table elements for the proton in the stopping gas t_Table Part_He_3_t; t_Table Part_Stop_t; - long nS_t; // number of table elements for the triton in the stopping gas - t_Table Part_He_3_n,Part_Stop_n; // third entry in the file, containing cross section only - - double *E_p; // energies from the table for protons, for which stopping powers are given - double *dEdx_p; // resulting stopping powers of the counting gas mixture + long nS_t; // number of table elements for the triton in the stopping gas + t_Table Part_He_3_n, Part_Stop_n; // third entry in the file, containing cross section only + double* E_p; // energies from the table for protons, for which stopping powers are given + double* dEdx_p; // resulting stopping powers of the counting gas mixture - double *DAP; // Delta Array of energies for the proton from the list - double *MuAP; // Distances in mu traversed for each delta energy in the list + double* DAP; // Delta Array of energies for the proton from the list + double* MuAP; // Distances in mu traversed for each delta energy in the list - double *TempVar34; - double *ETP1; // Energy transferred by proton - double *PTP1; // Positions of transfer of energy by proton + double* TempVar34; + double* ETP1; // Energy transferred by proton + double* PTP1; // Positions of transfer of energy by proton - double *E_t; // energies from the table for tritons, for which stopping powers are given - double *dEdx_t; // resulting stopping powers of the counting gas mixture + double* E_t; // energies from the table for tritons, for which stopping powers are given + double* dEdx_t; // resulting stopping powers of the counting gas mixture + double* DAT; // Delta Array of energies for the triton from the list + double* MuAT; // Distances in mu traversed for each delta energy in the list - double *DAT; // Delta Array of energies for the triton from the list - double *MuAT; // Distances in mu traversed for each delta energy in the list - - double *TempVar35; - double *ETT1; // Energy transferred by triton - double *PTT1; // Positions of transfer of energy by triton + double* TempVar35; + double* ETT1; // Energy transferred by triton + double* PTT1; // Positions of transfer of energy by triton /* GEOMETRY stuff ********************************************************* */ - if (borderx==-2) borderx = xwidth/nx; - else if (borderx==-1) borderx = zdepth; - else if (borderx<0) { - fprintf(stderr,"PSD_Detector: %s: Negative x border zone specified. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); - } - if (bordery==-2) bordery = yheight/ny; - else if (bordery==-1) bordery = zdepth; - else if (bordery<0) { - fprintf(stderr,"PSD_Detector: %s: Negative y border zone specified. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); - } - - if (xwidth>0) { /* panel */ - DetectorType+=1; - if (zdepth<0) { - fprintf(stderr,"PSD_Detector: %s: Detector box has no zdepth. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (borderx == -2) + borderx = xwidth / nx; + else if (borderx == -1) + borderx = zdepth; + else if (borderx < 0) { + fprintf (stderr, "PSD_Detector: %s: Negative x border zone specified. Exit.\n", NAME_CURRENT_COMP); + exit (-1); + } + if (bordery == -2) + bordery = yheight / ny; + else if (bordery == -1) + bordery = zdepth; + else if (bordery < 0) { + fprintf (stderr, "PSD_Detector: %s: Negative y border zone specified. Exit.\n", NAME_CURRENT_COMP); + exit (-1); + } + + if (xwidth > 0) { /* panel */ + DetectorType += 1; + if (zdepth < 0) { + fprintf (stderr, "PSD_Detector: %s: Detector box has no zdepth. Exit.\n", NAME_CURRENT_COMP); + exit (-1); } } - if (radius && angle>0) awidth=angle/360*2*PI*radius; - else if (radius && awidth>0) angle = awidth*360/2/PI/radius; - if (radius>0 && !awidth) { - DetectorType+=2; /* cylinder */ - } - if (awidth>0 && radius) { - DetectorType+=4; /* banana */ - if (zdepth<=0) { - fprintf(stderr,"PSD_Detector: %s: Detector 'banana' has no zdepth. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (radius && angle > 0) + awidth = angle / 360 * 2 * PI * radius; + else if (radius && awidth > 0) + angle = awidth * 360 / 2 / PI / radius; + if (radius > 0 && !awidth) { + DetectorType += 2; /* cylinder */ + } + if (awidth > 0 && radius) { + DetectorType += 4; /* banana */ + if (zdepth <= 0) { + fprintf (stderr, "PSD_Detector: %s: Detector 'banana' has no zdepth. Exit.\n", NAME_CURRENT_COMP); + exit (-1); } - if (radius<=0) { - fprintf(stderr,"PSD_Detector: %s: Non-positive radial distance to the sample was specified. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (radius <= 0) { + fprintf (stderr, "PSD_Detector: %s: Non-positive radial distance to the sample was specified. Exit.\n", NAME_CURRENT_COMP); + exit (-1); } - if (!dc && zdepth && LensOn) dc = zdepth/2; - if (((dc>zdepth) || (dc<0)) && (LensOn==1)) { - fprintf(stderr,"PSD_Detector: %s: Electrostatic lens was turned on, but\n" - " no valid zdepth of the cathode plane was specified. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (!dc && zdepth && LensOn) + dc = zdepth / 2; + if (((dc > zdepth) || (dc < 0)) && (LensOn == 1)) { + fprintf (stderr, + "PSD_Detector: %s: Electrostatic lens was turned on, but\n" + " no valid zdepth of the cathode plane was specified. Exit.\n", + NAME_CURRENT_COMP); + exit (-1); } - if (awidth+2*borderx>2*PI*radius) { - fprintf(stderr,"PSD_Detector: %s: Detector comes perilously close to encompassing 2pi. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (awidth + 2 * borderx > 2 * PI * radius) { + fprintf (stderr, "PSD_Detector: %s: Detector comes perilously close to encompassing 2pi. Exit.\n", NAME_CURRENT_COMP); + exit (-1); } } - if (yheight<=0) { - fprintf(stderr,"PSD_Detector: %s: Detector has no height (yheight). Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if (yheight <= 0) { + fprintf (stderr, "PSD_Detector: %s: Detector has no height (yheight). Exit.\n", NAME_CURRENT_COMP); + exit (-1); } - if ( (DetectorType!=1) && (DetectorType!=2) &&(DetectorType!=4) ) { - fprintf(stderr,"PSD_Detector: %s: Detector has conflicting size\n" - " specifications, i.e. combinations of xwidth, radius\n" - " or awidth, or none at all. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + if ((DetectorType != 1) && (DetectorType != 2) && (DetectorType != 4)) { + fprintf (stderr, + "PSD_Detector: %s: Detector has conflicting size\n" + " specifications, i.e. combinations of xwidth, radius\n" + " or awidth, or none at all. Exit.\n", + NAME_CURRENT_COMP); + exit (-1); } if (verbose) { - printf("PSD_Detector: %s: Geometry is ", NAME_CURRENT_COMP); + printf ("PSD_Detector: %s: Geometry is ", NAME_CURRENT_COMP); switch (DetectorType) { - case 1: printf("box\n"); break; - case 2: printf("tube\n"); break; - case 4: printf("cylinder ('banana') opening angle=%g [deg] arc length=%g [m]\n", angle, awidth); break; + case 1: + printf ("box\n"); + break; + case 2: + printf ("tube\n"); + break; + case 4: + printf ("cylinder ('banana') opening angle=%g [deg] arc length=%g [m]\n", angle, awidth); + break; default: - printf("not defined\n"); + printf ("not defined\n"); } } -/* Gas tables ************************************************************** */ - PSD_N = create_darr2d(nx, ny); - PSD_p = create_darr2d(nx, ny); - PSD_p2 = create_darr2d(nx, ny); + /* Gas tables ************************************************************** */ + PSD_N = create_darr2d (nx, ny); + PSD_p = create_darr2d (nx, ny); + PSD_p2 = create_darr2d (nx, ny); - Table_Read(&Part_He_3_p,FN_Conv,1); + Table_Read (&Part_He_3_p, FN_Conv, 1); nH_p = Part_He_3_p.rows; - Table_Read(&Part_Stop_p,FN_Stop,1); + Table_Read (&Part_Stop_p, FN_Stop, 1); nS_p = Part_Stop_p.rows; - Table_Read(&Part_He_3_t,FN_Conv,2); - nH_t = Part_He_3_t.rows; - Table_Read(&Part_Stop_t,FN_Stop,2); + Table_Read (&Part_He_3_t, FN_Conv, 2); + nH_t = Part_He_3_t.rows; + Table_Read (&Part_Stop_t, FN_Stop, 2); nS_t = Part_Stop_t.rows; /* if Gas tables can not be found, try by pre-pending Gas_tables */ char tmp[256]; if (!nH_p) { - sprintf(tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Conv); - Table_Read(&Part_He_3_p,tmp,1); + sprintf (tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Conv); + Table_Read (&Part_He_3_p, tmp, 1); nH_p = Part_He_3_p.rows; } if (!nS_p) { - sprintf(tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Stop); - Table_Read(&Part_Stop_p,tmp,1); + sprintf (tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Stop); + Table_Read (&Part_Stop_p, tmp, 1); nS_p = Part_Stop_p.rows; } if (!nH_t) { - sprintf(tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Conv); - Table_Read(&Part_He_3_t,tmp,2); - nH_t = Part_He_3_t.rows; + sprintf (tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Conv); + Table_Read (&Part_He_3_t, tmp, 2); + nH_t = Part_He_3_t.rows; } if (!nS_t) { - sprintf(tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Stop); - Table_Read(&Part_Stop_t,tmp,2); + sprintf (tmp, "Gas_tables%s%s", MC_PATHSEP_S, FN_Stop); + Table_Read (&Part_Stop_t, tmp, 2); nS_t = Part_Stop_t.rows; } - if (nH_p != nS_p || nH_t != nS_t) { - fprintf(stderr,"PSD_Detector: %s: Data files for helium %s and stopping gas %s\n" - " have different number of entries. Exit.\n", - NAME_CURRENT_COMP, FN_Conv, FN_Stop); - exit(-1); } - - E_p = (double *) malloc(nH_p*sizeof(double)); - - dEdx_p = (double *) malloc(nH_p*sizeof(double)); - if(!E_p || !dEdx_p) { - fprintf(stderr, "PSD_Detector %s: malloc() failure E_p or dEdx_p arrays. Exit!\n", NAME_CURRENT_COMP); - exit(-1); - } - for (i=0; i1) p_interact=1; + if (p_interact > 1) + p_interact = 1; -/* handle event files as in Virtual_output, with bufsize=0 ****************** */ - long element_size=1e6; - if (type && strlen(type) && strcmp(type, "NULL") && strcmp(type, "0")) { - printf("PSD_Detector: %s: saving detector signal as events\n", NAME_CURRENT_COMP); + /* handle event files as in Virtual_output, with bufsize=0 ****************** */ + long element_size = 1e6; + if (type && strlen (type) && strcmp (type, "NULL") && strcmp (type, "0")) { + printf ("PSD_Detector: %s: saving detector signal as events\n", NAME_CURRENT_COMP); - strcpy(Vars.compcurname, NAME_CURRENT_COMP); - if (bufsize > 0) sprintf(Vars.option, "list=%15g", bufsize); - else strcpy(Vars.option, "list all"); - strcat(Vars.option,", borders, x y z vx vy vz t sx sy sz"); + strcpy (Vars.compcurname, NAME_CURRENT_COMP); + if (bufsize > 0) + sprintf (Vars.option, "list=%15g", bufsize); + else + strcpy (Vars.option, "list all"); + strcat (Vars.option, ", borders, x y z vx vy vz t sx sy sz"); - Monitor_nD_Init(&DEFS, &Vars, 0.1, 0.1, 0, 0,0,0,0,0,0,0); /* dims for mcdisplay */ - if (filename && strlen(filename) && strcmp(filename, "0") && strcmp(filename, "NULL")) - strncpy(Vars.Mon_File, filename, 128); + Monitor_nD_Init (&DEFS, &Vars, 0.1, 0.1, 0, 0, 0, 0, 0, 0, 0, 0); /* dims for mcdisplay */ + if (filename && strlen (filename) && strcmp (filename, "0") && strcmp (filename, "NULL")) + strncpy (Vars.Mon_File, filename, 128); if (bufsize > 0) - printf("Warning: PSD_Detector: %s: buffer size=%g not recommended\n", NAME_CURRENT_COMP, bufsize); - if (bufsize > 0) printf( - "PSD_Detector: %s: Beware virtual output generated file size (max %g Mo)\n" - "WARNING Memory required is %g Mo\n", NAME_CURRENT_COMP, - bufsize*element_size/1e6, bufsize*sizeof(double)/1e6); + printf ("Warning: PSD_Detector: %s: buffer size=%g not recommended\n", NAME_CURRENT_COMP, bufsize); + if (bufsize > 0) + printf ("PSD_Detector: %s: Beware virtual output generated file size (max %g Mo)\n" + "WARNING Memory required is %g Mo\n", + NAME_CURRENT_COMP, bufsize * element_size / 1e6, bufsize * sizeof (double) / 1e6); } - rb=radius+zdepth; // radius of the back plane of the detector + rb = radius + zdepth; // radius of the back plane of the detector %} TRACE %{ - long i,j; - double RangeProton,RangeTriton; - double NAvogadro,MolVolume,v,vt,mu; - double length,GM,ZB,pa,RandomNumber,la,ta; - double phi,theta; // direction of emission of the particles - double vxp,vyp,vzp; // normalized speed of the particles - double mlp,mlt; // 1st moment (COG) of energy deposition of the particles - double xCOG,yCOG,zCOG,aCOG,rCOG,Energy; - double tin,tout,tine,toute,tinb,toutb; // times in and out of cylindrical entrance window and back plane boxes - long ISe,ISb; // type of intersection with a cylindrical box - double EnergyP,EnergyT,SigmaEnergy; - double lp,lt; // length proton- and triton tracks - long intersect; - long Impossibility; // used to check for impossible collisions - double alimit; // borders of the sensitive volume + edges - double aa; // alpha coordinate (along the arc of the detector) of the absorption - double t1,t2; // time for the first and second charged particles to the next wall + long i, j; + double RangeProton, RangeTriton; + double NAvogadro, MolVolume, v, vt, mu; + double length, GM, ZB, pa, RandomNumber, la, ta; + double phi, theta; // direction of emission of the particles + double vxp, vyp, vzp; // normalized speed of the particles + double mlp, mlt; // 1st moment (COG) of energy deposition of the particles + double xCOG, yCOG, zCOG, aCOG, rCOG, Energy; + double tin, tout, tine, toute, tinb, toutb; // times in and out of cylindrical entrance window and back plane boxes + long ISe, ISb; // type of intersection with a cylindrical box + double EnergyP, EnergyT, SigmaEnergy; + double lp, lt; // length proton- and triton tracks + long intersect; + long Impossibility; // used to check for impossible collisions + double alimit; // borders of the sensitive volume + edges + double aa; // alpha coordinate (along the arc of the detector) of the absorption + double t1, t2; // time for the first and second charged particles to the next wall #ifndef HUGE_VAL #define HUGE_VAL DBL_MAX #endif - - #pragma acc atomic + + #pragma acc atomic CountNeutrons = CountNeutrons + p; RangeProton = PosAP[nH_p]; RangeTriton = PosAT[nH_t]; - v = sqrt(vx*vx + vy*vy + vz*vz) ; // speed of the neutron - if (v>440000 && !(VariousErrors&1) ) { - fprintf(stderr,"PSD_Detector: %s: Component cannot deal with\n" - " high-energy neutrons. Absorbing.\n", - NAME_CURRENT_COMP); - #pragma acc atomic - VariousErrors = VariousErrors + 1; - ABSORB; } - vt = sqrt( 2*0.025243*1.60218e-19 / ( 1.0086649 * 1.66053886e-27 ) ); // speed of 25.243 meV neutron (0.18 nm) - NAvogadro = 6.022045e23; // Number of atoms per mol - MolVolume = 24.7796e-3; // in m3, 24.7796 liter per mol at 1 bar at T=298 K - mu = (NAvogadro*PressureConv*CrossSectionHe* vt ) / (MolVolume* v ); // in inverse m - - switch(DetectorType) { - case 1: - intersect = box_intersect(&tin,&tout,x,y,z,vx,vy,vz,xwidth+2*borderx,yheight+2*bordery,zdepth); - if (tin==tout) intersect=0; - break; - case 2: - intersect = cylinder_intersect(&tin,&tout,x,y,z,vx,vy,vz,radius,yheight+2*bordery); - if (tin==tout) intersect=0; - break; - case 4: - if (cylinder_intersect(&tine,&toute,x,y,z,vx,vy,vz,radius,yheight+2*bordery)==0 ) { - ISe=4; } // case for no intersection with the entrance-window-cylinder - else { - if (tine<=0 && toute<=0) { - ISe=1; // case for neutron outside the volume and moving away - } - if (tine<=0 && toute>0) { - ISe=2; // case for neutron inside the volume and moving (obviously) out - } - if (tine>0 && toute>0) { - ISe=3; // case for neutron outside the volume and moving towards it - } - if (tine>toute && !(VariousErrors&2) ) { - fprintf(stderr,"PSD_Detector: %s: Something is seriously wrong.\n" - " cylinder_intersect reported a later time\n" - " for entering the cylinder than for leaving it.\n", - NAME_CURRENT_COMP); - #pragma acc atomic - VariousErrors = VariousErrors + 2; - ABSORB; - } - } - if (cylinder_intersect(&tinb,&toutb,x,y,z,vx,vy,vz,rb,yheight+2*bordery)==0 || tinb==toutb) { - ISb=4; } // case for no intersection with the back-plane-cylinder - else { - if (tinb<=0 && toutb<=0) { - ISb=1; // case for neutron outside the volume and moving away - } - if (tinb<=0 && toutb>0) { - ISb=2; // case for neutron inside the volume and moving (obviously) out - } - if (tinb>0 && toutb>0) { - ISb=3; // case for neutron outside the volume and moving towards it - } - if (tinb>toutb && !(VariousErrors&2) ) { - fprintf(stderr,"PSD_Detector: %s: Something is seriously wrong.\n" - " cylinder_intersect reported a later time\n" - " for entering the cylinder than for leaving it.\n", - NAME_CURRENT_COMP); - #pragma acc atomic - VariousErrors = VariousErrors + 2; - ABSORB; - } + v = sqrt (vx * vx + vy * vy + vz * vz); // speed of the neutron + if (v > 440000 && !(VariousErrors & 1)) { + fprintf (stderr, + "PSD_Detector: %s: Component cannot deal with\n" + " high-energy neutrons. Absorbing.\n", + NAME_CURRENT_COMP); + #pragma acc atomic + VariousErrors = VariousErrors + 1; + ABSORB; + } + vt = sqrt (2 * 0.025243 * 1.60218e-19 / (1.0086649 * 1.66053886e-27)); // speed of 25.243 meV neutron (0.18 nm) + NAvogadro = 6.022045e23; // Number of atoms per mol + MolVolume = 24.7796e-3; // in m3, 24.7796 liter per mol at 1 bar at T=298 K + mu = (NAvogadro * PressureConv * CrossSectionHe * vt) / (MolVolume * v); // in inverse m + + switch (DetectorType) { + case 1: + intersect = box_intersect (&tin, &tout, x, y, z, vx, vy, vz, xwidth + 2 * borderx, yheight + 2 * bordery, zdepth); + if (tin == tout) + intersect = 0; + break; + case 2: + intersect = cylinder_intersect (&tin, &tout, x, y, z, vx, vy, vz, radius, yheight + 2 * bordery); + if (tin == tout) + intersect = 0; + break; + case 4: + if (cylinder_intersect (&tine, &toute, x, y, z, vx, vy, vz, radius, yheight + 2 * bordery) == 0) { + ISe = 4; + } // case for no intersection with the entrance-window-cylinder + else { + if (tine <= 0 && toute <= 0) { + ISe = 1; // case for neutron outside the volume and moving away } - /******************************************************************** - * Schematic representations of the possibilities for the path of the neutron - * ----------------------------------------------------------------- - * | ISb=1 ISb=2 ISb=3 ISb=4 - * ----------------------------------------------------------------- - * ISe=1 | Gone already in Impossible Impossible - * | out thr. back - * ----------------------------------------------------------------- - * ISe=2 | Impossible in thr. entr. Impossible Impossible - * | out thr. back - * ----------------------------------------------------------------- - * ISe=3 | Impossible already in in thr. back Impossible - * | out thr. entr. out thr. entr. - * ----------------------------------------------------------------- - * ISe=4 | Gone already in in thr. back Gone - * | out thr. back out thr. back - * ----------------------------------------------------------------- - * All we have to do is choose the appropriate entrance and exit times - * from the tin and tout of both the entrance window cylinder and the - * back plane cylinder. - * There is a problem on the left and right sides of the detector. - * We cannot check entrance or exit using cylinder_intersect there, so - * we simply find interaction points in 2pi cylinder wall, and then - * reject events that are too far from the sensitive volume. - *********************************************************************/ - - - Impossibility=1; // set this to 1: if it is not subsequently set to 0, an impossible neutron track has occurred - if ( ((ISb==1) && ((ISe==1)||(ISe==4))) || ((ISb==4)&&(ISe==4)) ) { - Impossibility=0; // these represent the cases that the neutron misses the detector - intersect=0; + if (tine <= 0 && toute > 0) { + ISe = 2; // case for neutron inside the volume and moving (obviously) out } - if ( (ISe==1)&&(ISb==2) ) { - Impossibility = 0; - intersect=1; - tin=0; // neutron is already located within the sensitive volume - tout=toutb; // neutron flies out the sensitive volume into the back plane + if (tine > 0 && toute > 0) { + ISe = 3; // case for neutron outside the volume and moving towards it } - if ( (ISe==2)&&(ISb==2) ) { - Impossibility = 0; - intersect=1; - tin=toute; // neutron comes in through the entrance window - tout=toutb; // and flies out through the back plane + if (tine > toute && !(VariousErrors & 2)) { + fprintf (stderr, + "PSD_Detector: %s: Something is seriously wrong.\n" + " cylinder_intersect reported a later time\n" + " for entering the cylinder than for leaving it.\n", + NAME_CURRENT_COMP); + #pragma acc atomic + VariousErrors = VariousErrors + 2; + ABSORB; } - if ( (ISe==3)&&(ISb==2) ) { - Impossibility = 0; - intersect=1; - tin=0; // neutron is already located within the sensitive volume - tout=tine; // neutron flies out the sensitive volume into the entrance window + } + if (cylinder_intersect (&tinb, &toutb, x, y, z, vx, vy, vz, rb, yheight + 2 * bordery) == 0 || tinb == toutb) { + ISb = 4; + } // case for no intersection with the back-plane-cylinder + else { + if (tinb <= 0 && toutb <= 0) { + ISb = 1; // case for neutron outside the volume and moving away } - if ( (ISe==3)&&(ISb==3) ) { - Impossibility = 0; - intersect=1; - tin=tinb; // neutron comes in through the back plane - tout=tine; // and flies out through the entrance window + if (tinb <= 0 && toutb > 0) { + ISb = 2; // case for neutron inside the volume and moving (obviously) out } - if ( (ISe==4)&&(ISb==2) ) { - Impossibility = 0; - intersect=1; - tin=0; // neutron is already located within the sensitive volume - tout=toutb; // neutron flies out the sensitive volume into the back plane + if (tinb > 0 && toutb > 0) { + ISb = 3; // case for neutron outside the volume and moving towards it } - if ( (ISe==4)&&(ISb==3) ) { - Impossibility = 0; - intersect=1; - tin=tinb; // neutron comes in through the back plane - tout=toutb; // and flies out through the back plane + if (tinb > toutb && !(VariousErrors & 2)) { + fprintf (stderr, + "PSD_Detector: %s: Something is seriously wrong.\n" + " cylinder_intersect reported a later time\n" + " for entering the cylinder than for leaving it.\n", + NAME_CURRENT_COMP); + #pragma acc atomic + VariousErrors = VariousErrors + 2; + ABSORB; } - if ( tin==tout ) { - intersect=0; /* This happens for instance when the neutron flies along + } + /******************************************************************** + * Schematic representations of the possibilities for the path of the neutron + * ----------------------------------------------------------------- + * | ISb=1 ISb=2 ISb=3 ISb=4 + * ----------------------------------------------------------------- + * ISe=1 | Gone already in Impossible Impossible + * | out thr. back + * ----------------------------------------------------------------- + * ISe=2 | Impossible in thr. entr. Impossible Impossible + * | out thr. back + * ----------------------------------------------------------------- + * ISe=3 | Impossible already in in thr. back Impossible + * | out thr. entr. out thr. entr. + * ----------------------------------------------------------------- + * ISe=4 | Gone already in in thr. back Gone + * | out thr. back out thr. back + * ----------------------------------------------------------------- + * All we have to do is choose the appropriate entrance and exit times + * from the tin and tout of both the entrance window cylinder and the + * back plane cylinder. + * There is a problem on the left and right sides of the detector. + * We cannot check entrance or exit using cylinder_intersect there, so + * we simply find interaction points in 2pi cylinder wall, and then + * reject events that are too far from the sensitive volume. + *********************************************************************/ + + Impossibility = 1; // set this to 1: if it is not subsequently set to 0, an impossible neutron track has occurred + if (((ISb == 1) && ((ISe == 1) || (ISe == 4))) || ((ISb == 4) && (ISe == 4))) { + Impossibility = 0; // these represent the cases that the neutron misses the detector + intersect = 0; + } + if ((ISe == 1) && (ISb == 2)) { + Impossibility = 0; + intersect = 1; + tin = 0; // neutron is already located within the sensitive volume + tout = toutb; // neutron flies out the sensitive volume into the back plane + } + if ((ISe == 2) && (ISb == 2)) { + Impossibility = 0; + intersect = 1; + tin = toute; // neutron comes in through the entrance window + tout = toutb; // and flies out through the back plane + } + if ((ISe == 3) && (ISb == 2)) { + Impossibility = 0; + intersect = 1; + tin = 0; // neutron is already located within the sensitive volume + tout = tine; // neutron flies out the sensitive volume into the entrance window + } + if ((ISe == 3) && (ISb == 3)) { + Impossibility = 0; + intersect = 1; + tin = tinb; // neutron comes in through the back plane + tout = tine; // and flies out through the entrance window + } + if ((ISe == 4) && (ISb == 2)) { + Impossibility = 0; + intersect = 1; + tin = 0; // neutron is already located within the sensitive volume + tout = toutb; // neutron flies out the sensitive volume into the back plane + } + if ((ISe == 4) && (ISb == 3)) { + Impossibility = 0; + intersect = 1; + tin = tinb; // neutron comes in through the back plane + tout = toutb; // and flies out through the back plane + } + if (tin == tout) { + intersect = 0; /* This happens for instance when the neutron flies along the axis of the cylinders. The two cylinders overlap there, so zero time is spent in the gas volume, therefore no absorption. */ - } - if ( tin>tout && !(VariousErrors&4) ) { - intersect=0; - fprintf(stderr,"PSD_Detector: %s: A serious error occurred.\n" - " A later time for entering the detector was calculated\n" - " than for leaving it.\n", - NAME_CURRENT_COMP); - #pragma acc atomic - VariousErrors = VariousErrors + 4; - } - if ( Impossibility==1 && !(VariousErrors&8) ) { - fprintf(stderr,"PSD_Detector: %s: Something strange happened. A neutron\n" - " followed a path deemed impossible in the algorithm.\n", - NAME_CURRENT_COMP); - intersect=0; - #pragma acc atomic - VariousErrors = VariousErrors + 8; - } + } + if (tin > tout && !(VariousErrors & 4)) { + intersect = 0; + fprintf (stderr, + "PSD_Detector: %s: A serious error occurred.\n" + " A later time for entering the detector was calculated\n" + " than for leaving it.\n", + NAME_CURRENT_COMP); + #pragma acc atomic + VariousErrors = VariousErrors + 4; + } + if (Impossibility == 1 && !(VariousErrors & 8)) { + fprintf (stderr, + "PSD_Detector: %s: Something strange happened. A neutron\n" + " followed a path deemed impossible in the algorithm.\n", + NAME_CURRENT_COMP); + intersect = 0; + #pragma acc atomic + VariousErrors = VariousErrors + 8; + } /* NB: at this point the neutron does not yet have to be absorbed within the sensitive volume of the detector - we still have to check polar angle to see if the event falls within the part of the cylinder wall that is covered by the detector. */ - - break; /* end switch case DetectorType==4 */ - default: - exit(-1); + break; /* end switch case DetectorType==4 */ + default: + exit (-1); } // end switch DetectorType (1) - if (intersect && tout<=0) { - intersect=0; + if (intersect && tout <= 0) { + intersect = 0; /* This is the case that the intersection along the trajectory was in the past, which is probably a common occurrance in a simulation, e.g. backscattering off the entrance window, and which should not be interpreted as a new detector event.*/ } - if (intersect && tin<=0 && !(VariousErrors&16) ) { - tin=0; - fprintf(stderr,"PSD_Detector: %s: Warning: a neutron has been found\n" - " 'tunneled' into the detector, rather than just entering\n" - " through the entrance window or one of the other sides.\n", - NAME_CURRENT_COMP); + if (intersect && tin <= 0 && !(VariousErrors & 16)) { + tin = 0; + fprintf (stderr, + "PSD_Detector: %s: Warning: a neutron has been found\n" + " 'tunneled' into the detector, rather than just entering\n" + " through the entrance window or one of the other sides.\n", + NAME_CURRENT_COMP); #pragma acc atomic VariousErrors = VariousErrors + 16; } @@ -905,188 +982,193 @@ TRACE /* there is intersection, not 'grazing' of the detector. What kind of trajectory is followed is not important, since we have in- and out-going time. */ - length = v*(tout-tin); // length (in m) of the trajectory through the sensitive volume - GM = mu*length ; // number of radiation lengths in the gap thickness - ZB = exp( -GM ); // zone boundary for generating uniformly distributed random numbers [ZB,1] - pa = 1 - ZB; // Probability of absorption somewhere along the length of the trajectory through the sensitive volume - - if ( (p_interact <= 0 && (pa >= 1 || rand01() < pa)) - || (p_interact > 0 && (p_interact >= 1 || rand01() < p_interact)) ) { - if (p_interact > 0 && p_interact < 1) pa /= p_interact; - if (p_interact <= 0) pa=1; - RandomNumber = (1-ZB)*rand01() + ZB; // uniformly distributed random number between ZB and 1 - la = -log(RandomNumber) / mu; // (in m) Absorption location (along trajectory), distributed exponentially declining - ta = tin + la/v; // Absorption time - alimit= (0.5*awidth + borderx)/radius; /* we take the gas-filled volume a bit larger - than the sensitive volume alone, which is realistic. Later we throw away events - that do not end up in the sensitive volume. */ - aa=atan2(x+vx*ta,z+vz*ta); - if ( DetectorType==1 || DetectorType==2 || - (DetectorType==4 && aa>-alimit && aa= 1 || rand01 () < pa)) || (p_interact > 0 && (p_interact >= 1 || rand01 () < p_interact))) { + if (p_interact > 0 && p_interact < 1) + pa /= p_interact; + if (p_interact <= 0) + pa = 1; + RandomNumber = (1 - ZB) * rand01 () + ZB; // uniformly distributed random number between ZB and 1 + la = -log (RandomNumber) / mu; // (in m) Absorption location (along trajectory), distributed exponentially declining + ta = tin + la / v; // Absorption time + alimit = (0.5 * awidth + borderx) / radius; /* we take the gas-filled volume a bit larger + than the sensitive volume alone, which is realistic. Later we throw away events + that do not end up in the sensitive volume. */ + aa = atan2 (x + vx * ta, z + vz * ta); + if (DetectorType == 1 || DetectorType == 2 || (DetectorType == 4 && aa > -alimit && aa < alimit)) { /* this is always executed for a box or a tube, but for a banana only when the interaction position is not too far left or right of the sensitive volume (in order to account for border effects) */ - GeomCumul += p/(1-ZB); /* Cumulative probability of neutrons to encounter the - detector is incremented by the weight of the neutron. Corrected for - the fact that this part of the algorithm is only executed with - probability pa=1-ZB. - By later dividing by the total sum of weights, we will find the - 'geometric efficiency'. - This part of the algorithm cannot be executed before this point, - because we are not sure yet if it falls within the detector. */ - AbsCumul += p; /* Cumulative probability of absorption. */ - PROP_DT(ta); + GeomCumul += p / (1 - ZB); /* Cumulative probability of neutrons to encounter the + detector is incremented by the weight of the neutron. Corrected for + the fact that this part of the algorithm is only executed with + probability pa=1-ZB. + By later dividing by the total sum of weights, we will find the + 'geometric efficiency'. + This part of the algorithm cannot be executed before this point, + because we are not sure yet if it falls within the detector. */ + AbsCumul += p; /* Cumulative probability of absorption. */ + PROP_DT (ta); SCATTER; // show point of creation of charges // select random direction in 4 PI - theta = acos( rand01()*2-1 ); // polar angle, distributed like a sine from 0 to pi - phi = rand01() *2*PI; // azimuth angle, uniformly distributed from 0 to 2pi + theta = acos (rand01 () * 2 - 1); // polar angle, distributed like a sine from 0 to pi + phi = rand01 () * 2 * PI; // azimuth angle, uniformly distributed from 0 to 2pi - vxp = sin(theta) * cos(phi); // unit vector, interpreted as normalized speed (1 m/s) of the emitted proton. - vyp = sin(theta) * sin(phi); // this is used to obtain both proton and triton track end points. - vzp = cos(theta); + vxp = sin (theta) * cos (phi); // unit vector, interpreted as normalized speed (1 m/s) of the emitted proton. + vyp = sin (theta) * sin (phi); // this is used to obtain both proton and triton track end points. + vzp = cos (theta); // check intersection of charge trajectory - switch(DetectorType) { - case 1: - box_intersect(&tin,&tout,x,y,z,vxp,vyp,vzp,xwidth+2*borderx,yheight+2*bordery,zdepth); - if (tin>=0) { - t1=tin; - t2=tout; - } else { - t1=tout; - t2=tin; - } - break; - case 2: - intersect=cylinder_intersect(&tin,&tout,x,y,z,vxp,vyp,vzp,radius,yheight+2*bordery); - if (tin>=0) { - t1=tin; - t2=tout; - } else { - t1=tout; - t2=tin; - } - break; - case 4: - /****************************************************************** - * What we have now is an absorption point somewhere between the two - * cylinder walls, with distance 'zdepth' of the sensitive volume, and - * a direction of emission of the reaction products. - * What we need is very simple: for the first reaction product (the - * proton for absorption in He-3) we need the smallest positive time, - * for the second reaction product (triton) we choose the smallest - * negative time. - ******************************************************************/ - if (cylinder_intersect(&tinb,&toutb,x,y,z,vxp,vyp,vzp,rb,yheight+2*bordery)==0 && - !(VariousErrors&32) ) { - fprintf(stderr,"PSD_Detector: %s: Oops. A neutron absorbed in the detector" - " failed to send its reaction products towards the detector walls.\n", - NAME_CURRENT_COMP); - #pragma acc atomic - VariousErrors = VariousErrors + 32; - ABSORB; - } - if (cylinder_intersect(&tine,&toute,x,y,z,vxp,vyp,vzp,radius,yheight+2*bordery) ==0) { - tine=-HUGE_VAL; // ugly fix for cases where the inner cylinder is missed - toute=HUGE_VAL; - } - t1=tine; - if (t1<0) { - t1=toute; - /* We are looking for a positive number. If t1 is negative, then - choose the next number, toute, no matter what it is. */ - } else { - if ((toute=0)) { - t1=toute; - /* If the next number, toute, is positive yet smaller than t1, - we want it. */ - } - } - if (t1<0) { - t1=tinb; - /* We are looking for a positive number. If t1 is negative, then - choose the next number, tinb, no matter what it is. */ - } else { - if ((tinb=0)) { - t1=tinb; - /* If the next number, tinb, is positive yet smaller than t1, - we want it. */ - } + switch (DetectorType) { + case 1: + box_intersect (&tin, &tout, x, y, z, vxp, vyp, vzp, xwidth + 2 * borderx, yheight + 2 * bordery, zdepth); + if (tin >= 0) { + t1 = tin; + t2 = tout; + } else { + t1 = tout; + t2 = tin; + } + break; + case 2: + intersect = cylinder_intersect (&tin, &tout, x, y, z, vxp, vyp, vzp, radius, yheight + 2 * bordery); + if (tin >= 0) { + t1 = tin; + t2 = tout; + } else { + t1 = tout; + t2 = tin; + } + break; + case 4: + /****************************************************************** + * What we have now is an absorption point somewhere between the two + * cylinder walls, with distance 'zdepth' of the sensitive volume, and + * a direction of emission of the reaction products. + * What we need is very simple: for the first reaction product (the + * proton for absorption in He-3) we need the smallest positive time, + * for the second reaction product (triton) we choose the smallest + * negative time. + ******************************************************************/ + if (cylinder_intersect (&tinb, &toutb, x, y, z, vxp, vyp, vzp, rb, yheight + 2 * bordery) == 0 && !(VariousErrors & 32)) { + fprintf (stderr, + "PSD_Detector: %s: Oops. A neutron absorbed in the detector" + " failed to send its reaction products towards the detector walls.\n", + NAME_CURRENT_COMP); + #pragma acc atomic + VariousErrors = VariousErrors + 32; + ABSORB; + } + if (cylinder_intersect (&tine, &toute, x, y, z, vxp, vyp, vzp, radius, yheight + 2 * bordery) == 0) { + tine = -HUGE_VAL; // ugly fix for cases where the inner cylinder is missed + toute = HUGE_VAL; + } + t1 = tine; + if (t1 < 0) { + t1 = toute; + /* We are looking for a positive number. If t1 is negative, then + choose the next number, toute, no matter what it is. */ + } else { + if ((toute < t1) && (toute >= 0)) { + t1 = toute; + /* If the next number, toute, is positive yet smaller than t1, + we want it. */ } - if (t1<0) { - t1=toutb; - /* We are looking for a positive number. If t1 is negative, then - choose the next number, toutb, no matter what it is. */ - } else { - if ((toutb=0)) { - t1=toutb; - /* If the next number, toutb, is positive yet smaller than t1, - we want it. */ - } + } + if (t1 < 0) { + t1 = tinb; + /* We are looking for a positive number. If t1 is negative, then + choose the next number, tinb, no matter what it is. */ + } else { + if ((tinb < t1) && (tinb >= 0)) { + t1 = tinb; + /* If the next number, tinb, is positive yet smaller than t1, + we want it. */ } - t2=tine; - if (t2>0) { - t2=toute; - /* We are looking for a negative number. If t2 is positive, then - choose the next number, toute, no matter what it is. */ + } + if (t1 < 0) { + t1 = toutb; + /* We are looking for a positive number. If t1 is negative, then + choose the next number, toutb, no matter what it is. */ + } else { + if ((toutb < t1) && (toutb >= 0)) { + t1 = toutb; + /* If the next number, toutb, is positive yet smaller than t1, + we want it. */ } - else { - if ((toute>t2)&&(toute<=0)) { - t2=toute; - /* If the next number, toute, is negative yet larger than t2, - we want it. */ - } + } + t2 = tine; + if (t2 > 0) { + t2 = toute; + /* We are looking for a negative number. If t2 is positive, then + choose the next number, toute, no matter what it is. */ + } else { + if ((toute > t2) && (toute <= 0)) { + t2 = toute; + /* If the next number, toute, is negative yet larger than t2, + we want it. */ } - if (t2>0) { - t2=tinb; - /* We are looking for a negative number. If t2 is positive, then - choose the next number, tinb, no matter what it is. */ - } else { - if ((tinb>t2)&&(tinb<=0)) { - t2=tinb; - /* If the next number, tinb, is negative yet larger than t2, - we want it. */ - } + } + if (t2 > 0) { + t2 = tinb; + /* We are looking for a negative number. If t2 is positive, then + choose the next number, tinb, no matter what it is. */ + } else { + if ((tinb > t2) && (tinb <= 0)) { + t2 = tinb; + /* If the next number, tinb, is negative yet larger than t2, + we want it. */ } - if (t2>0) { - t2=toutb; - /* We are looking for a negative number. If t2 is positive, then - choose the next number, toutb, no matter what it is. */ - } else { - if ((toutb>t2)&&(toutb<=0)) { - t2=toutb; - /* If the next number, toutb, is negative yet larger than t2, - we want it. */ - } + } + if (t2 > 0) { + t2 = toutb; + /* We are looking for a negative number. If t2 is positive, then + choose the next number, toutb, no matter what it is. */ + } else { + if ((toutb > t2) && (toutb <= 0)) { + t2 = toutb; + /* If the next number, toutb, is negative yet larger than t2, + we want it. */ } - break; - default: - fprintf(stderr,"PSD_Detector: %s: Detector has conflicting size\n" - " specifications, i.e. combinations of xwidth, radius\n" - " or awidth, or none at all. Exit.\n", - NAME_CURRENT_COMP); - exit(-1); + } + break; + default: + fprintf (stderr, + "PSD_Detector: %s: Detector has conflicting size\n" + " specifications, i.e. combinations of xwidth, radius\n" + " or awidth, or none at all. Exit.\n", + NAME_CURRENT_COMP); + exit (-1); } // end switch detectortype (2) - if (t1*t2>=0 && !(VariousErrors&64) ) { - fprintf(stderr,"PSD_Detector: %s: t1 was %g and t2 was %g.\n" - " One is supposed to be negative, the other positive,\n" - " neither zero.\n", - NAME_CURRENT_COMP,t1,t2); - #pragma acc atomic - VariousErrors = VariousErrors + 64; + if (t1 * t2 >= 0 && !(VariousErrors & 64)) { + fprintf (stderr, + "PSD_Detector: %s: t1 was %g and t2 was %g.\n" + " One is supposed to be negative, the other positive,\n" + " neither zero.\n", + NAME_CURRENT_COMP, t1, t2); + #pragma acc atomic + VariousErrors = VariousErrors + 64; } - if ( t1= 0 && i < nx && j >= 0 && j < ny ) { - SensVolCumul += p*pa; /* probability that a signal was produced in the - sensitive volume, though not necessarily above the threshold. - Note that, AT THIS POINT, the p has not been multiplied by pa yet. */ - if (Energy>threshold) { + if (i == -1) + i = 0; + if (i == nx) + i = nx - 1; + if (j == -1) + j = 0; + if (j == ny) + j = ny - 1; + if (i >= 0 && i < nx && j >= 0 && j < ny) { + SensVolCumul += p * pa; /* probability that a signal was produced in the + sensitive volume, though not necessarily above the threshold. + Note that, AT THIS POINT, the p has not been multiplied by pa yet. */ + if (Energy > threshold) { // if the particles have deposited sufficient energy to be // recognised as a neutron event (and not a gamma event) - double P = p*pa; - double P2 = P*P; - x = xCOG; y = yCOG; z = zCOG; - SCATTER; // show point of detection for 3D view - #pragma acc atomic - PSD_N[i][j] = PSD_N[i][j] + 1; // one neutron tallied in the appropriate pixel - #pragma acc atomic - PSD_p[i][j] = PSD_p[i][j] + P; // incremented by neutron weight - #pragma acc atomic - PSD_p2[i][j] = PSD_p2[i][j] + P2; // 2nd order moments - + double P = p * pa; + double P2 = P * P; + x = xCOG; + y = yCOG; + z = zCOG; + SCATTER; // show point of detection for 3D view + #pragma acc atomic + PSD_N[i][j] = PSD_N[i][j] + 1; // one neutron tallied in the appropriate pixel + #pragma acc atomic + PSD_p[i][j] = PSD_p[i][j] + P; // incremented by neutron weight + #pragma acc atomic + PSD_p2[i][j] = PSD_p2[i][j] + P2; // 2nd order moments + DetCumul += P; /* probability that a signal was produced in the sensitive volume above the energy threshold */ - i = (long)floor(Energy); - if (i >= 0 && i < PHSpectrum_n ) { - double P2 = P*P; - #pragma acc atomic - PHSpectrum0[i] = PHSpectrum0[i] + 1; // one neutron tallied per pixel - #pragma acc atomic + i = (long)floor (Energy); + if (i >= 0 && i < PHSpectrum_n) { + double P2 = P * P; + #pragma acc atomic + PHSpectrum0[i] = PHSpectrum0[i] + 1; // one neutron tallied per pixel + #pragma acc atomic PHSpectrum[i] = PHSpectrum[i] + P; // energy bin in pulse height spectrum incremented by neutron weight - #pragma acc atomic - PHSpectrum2[i] = PHSpectrum2[i] + P2; // 2nd order moments + #pragma acc atomic + PHSpectrum2[i] = PHSpectrum2[i] + P2; // 2nd order moments } /* save event file if activated */ - if (type && strlen(type) && strcmp(type, "NULL") && strcmp(type, "0")) { - double pp,P2; + if (type && strlen (type) && strcmp (type, "NULL") && strcmp (type, "0")) { + double pp, P2; /* Vars.cp = P; - Vars.cx = x; + Vars.cx = x; Vars.cvx = vx; Vars.csx = sx; Vars.cy = y; @@ -1191,194 +1281,159 @@ TRACE Vars.cvz = vz; Vars.csz = sz; Vars.ct = t; */ - - P2=P*P; - pp = Monitor_nD_Trace(&DEFS, &Vars, _particle); - #pragma acc atomic + P2 = P * P; + + pp = Monitor_nD_Trace (&DEFS, &Vars, _particle); + #pragma acc atomic Vars.Nsum = Vars.Nsum + 1; - #pragma acc atomic + #pragma acc atomic Vars.psum = Vars.psum + P; - #pragma acc atomic + #pragma acc atomic Vars.p2sum = Vars.p2sum + P2; } // initial version ABSORB detected neutrons. // This was removed if user wants to analyze the behaviour of the detector } } /* storage */ - p *= 1-pa; + p *= 1 - pa; } // end if absorption in case of border effects (left and right) in the banana } /* end if p_interact */ } /* end if (intersect) */ if (restore_neutron) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } - %} SAVE %{ - char file[128]; - if (type && strlen(type) && strcmp(type, "NULL") && strcmp(type, "0")) { + char file[128]; + if (type && strlen (type) && strcmp (type, "NULL") && strcmp (type, "0")) { /* event file */ - Monitor_nD_Save(&DEFS, &Vars); - DETECTOR_OUT(Vars.Nsum, Vars.psum, Vars.p2sum); + Monitor_nD_Save (&DEFS, &Vars); + DETECTOR_OUT (Vars.Nsum, Vars.psum, Vars.p2sum); } else { double width; - if (xwidth>0) width=xwidth; - if (radius>0) width=2*radius; - if (awidth>0) width=awidth; - if (filename && strlen(filename) && strcmp(filename, "0") && strcmp(filename, "NULL")) - strncpy(file, filename, 128); + if (xwidth > 0) + width = xwidth; + if (radius > 0) + width = 2 * radius; + if (awidth > 0) + width = awidth; + if (filename && strlen (filename) && strcmp (filename, "0") && strcmp (filename, "NULL")) + strncpy (file, filename, 128); else - sprintf(file, "%s.dat", NAME_CURRENT_COMP); + sprintf (file, "%s.dat", NAME_CURRENT_COMP); if (nx > 1 && ny > 1) - DETECTOR_OUT_2D( - "PSD Detector", - "X position [m]", - "Y position [m]", - -width/2, width/2, -yheight/2, yheight/2, - (double)nx, (double)ny, - &PSD_N[0][0],&PSD_p[0][0],&PSD_p2[0][0], - file); + DETECTOR_OUT_2D ("PSD Detector", "X position [m]", "Y position [m]", -width / 2, width / 2, -yheight / 2, yheight / 2, (double)nx, (double)ny, &PSD_N[0][0], + &PSD_p[0][0], &PSD_p2[0][0], file); else if (nx == 1) - DETECTOR_OUT_1D( - "PSD Detector", - "Y position [m]","Counts","Y", - -yheight/2, yheight/2, (double)ny, - &PSD_N[0][0],&PSD_p[0][0],&PSD_p2[0][0], - file); + DETECTOR_OUT_1D ("PSD Detector", "Y position [m]", "Counts", "Y", -yheight / 2, yheight / 2, (double)ny, &PSD_N[0][0], &PSD_p[0][0], &PSD_p2[0][0], file); else if (ny == 1) - DETECTOR_OUT_1D( - "PSD Detector", - "X position [m]","Counts","X", - -width/2, width/2, (double)nx, - &PSD_N[0][0],&PSD_p[0][0],&PSD_p2[0][0], - file); + DETECTOR_OUT_1D ("PSD Detector", "X position [m]", "Counts", "X", -width / 2, width / 2, (double)nx, &PSD_N[0][0], &PSD_p[0][0], &PSD_p2[0][0], file); } if (verbose) { char xlabelstr[64]; - snprintf(file, 128, "%s.en", - filename && strlen(filename) && strcmp(filename,"0") && strcmp(filename,"NULL") ? - filename : NAME_CURRENT_COMP); - fprintf(stdout,"PSD_Detector: %s: statistics\n", NAME_CURRENT_COMP); - fprintf(stdout," %g neutrons in the simulation, %g encounter the detector.\n", - CountNeutrons, GeomCumul ); - fprintf(stdout," Probability for a neutron to be absorbed in the detector is %g percent.\n", - 100*AbsCumul/CountNeutrons ); - fprintf(stdout," Probability for a neutron to be detected is %g percent.\n", - 100*DetCumul/CountNeutrons ); - fprintf(stdout," Fraction of neutrons not counted because their COG is outside\n" - "the sensitive volume is %g.\n", - 1-SensVolCumul/AbsCumul ); - fprintf(stdout," Fraction of neutrons not counted because their signal is reduced below\n" - "%g keV due to the wall effect is %g.\n", - threshold,1-DetCumul/SensVolCumul ); - fprintf(stdout," Theoretical limit to the position resolution in this gas is %g m FWHM\n" - " (of the rectangular distribution). This implies a sigma of %g m.\n", - 2*(M1P1[nH_p]-M1T1[nH_t]),(M1P1[nH_p]-M1T1[nH_t])/sqrt(3) ); - - snprintf(xlabelstr,64,"Energy [keV], threshold set to %g keV",threshold); - DETECTOR_OUT_1D( - "Pulse Height Spectrum", - xlabelstr, - "Counts [a.u]", - "E", - 0.0, (double)(PHSpectrum_n-1), PHSpectrum_n, - PHSpectrum0, PHSpectrum, PHSpectrum2, - file); + snprintf (file, 128, "%s.en", filename && strlen (filename) && strcmp (filename, "0") && strcmp (filename, "NULL") ? filename : NAME_CURRENT_COMP); + fprintf (stdout, "PSD_Detector: %s: statistics\n", NAME_CURRENT_COMP); + fprintf (stdout, " %g neutrons in the simulation, %g encounter the detector.\n", CountNeutrons, GeomCumul); + fprintf (stdout, " Probability for a neutron to be absorbed in the detector is %g percent.\n", 100 * AbsCumul / CountNeutrons); + fprintf (stdout, " Probability for a neutron to be detected is %g percent.\n", 100 * DetCumul / CountNeutrons); + fprintf (stdout, + " Fraction of neutrons not counted because their COG is outside\n" + "the sensitive volume is %g.\n", + 1 - SensVolCumul / AbsCumul); + fprintf (stdout, + " Fraction of neutrons not counted because their signal is reduced below\n" + "%g keV due to the wall effect is %g.\n", + threshold, 1 - DetCumul / SensVolCumul); + fprintf (stdout, + " Theoretical limit to the position resolution in this gas is %g m FWHM\n" + " (of the rectangular distribution). This implies a sigma of %g m.\n", + 2 * (M1P1[nH_p] - M1T1[nH_t]), (M1P1[nH_p] - M1T1[nH_t]) / sqrt (3)); + + snprintf (xlabelstr, 64, "Energy [keV], threshold set to %g keV", threshold); + DETECTOR_OUT_1D ("Pulse Height Spectrum", xlabelstr, "Counts [a.u]", "E", 0.0, (double)(PHSpectrum_n - 1), PHSpectrum_n, PHSpectrum0, PHSpectrum, PHSpectrum2, + file); } %} FINALLY %{ /* free pointers */ - if (type && strlen(type) && strcmp(type, "NULL") && strcmp(type, "0")) { - Monitor_nD_Finally(&DEFS, &Vars); + if (type && strlen (type) && strcmp (type, "NULL") && strcmp (type, "0")) { + Monitor_nD_Finally (&DEFS, &Vars); if (bufsize) { - printf("PSD_Detector: %s: Saved %lld events (from buffer) in file %s\n", - NAME_CURRENT_COMP, Vars.Nsum, Vars.Mon_File); + printf ("PSD_Detector: %s: Saved %lld events (from buffer) in file %s\n", NAME_CURRENT_COMP, Vars.Nsum, Vars.Mon_File); if (bufsize < Vars.Nsum) - printf("WARNING When using this source, intensities must be multiplied\n" - " by a factor %g\n", (double)Vars.Nsum/bufsize); + printf ("WARNING When using this source, intensities must be multiplied\n" + " by a factor %g\n", + (double)Vars.Nsum / bufsize); } else - printf("PSD_Detector: %s: Saved %lld events (all) in file %s\n", NAME_CURRENT_COMP, Vars.Nsum, Vars.Mon_File); + printf ("PSD_Detector: %s: Saved %lld events (all) in file %s\n", NAME_CURRENT_COMP, Vars.Nsum, Vars.Mon_File); } - destroy_darr2d(PSD_N); - destroy_darr2d(PSD_p); - destroy_darr2d(PSD_p2); + destroy_darr2d (PSD_N); + destroy_darr2d (PSD_p); + destroy_darr2d (PSD_p2); %} MCDISPLAY %{ double h; - h=yheight; - - if (xwidth>0) { /* box */ - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zdepth; - double zmax = 0.5*zdepth; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); - } - if (radius>0) { - if (!awidth) { /* cylinder */ - circle("xz", 0, h/2.0, 0, radius); - circle("xz", 0, -h/2.0, 0, radius); - line(-radius, -h/2.0, 0, -radius, +h/2.0, 0); - line(+radius, -h/2.0, 0, +radius, +h/2.0, 0); - line(0, -h/2.0, -radius, 0, +h/2.0, -radius); - line(0, -h/2.0, +radius, 0, +h/2.0, +radius); - if (borderx>0){ - circle("xz", 0, h/2.0, 0, radius+borderx); - circle("xz", 0, -h/2.0, 0, radius+borderx); - } + h = yheight; + + if (xwidth > 0) { /* box */ + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zdepth; + double zmax = 0.5 * zdepth; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); + } + if (radius > 0) { + if (!awidth) { /* cylinder */ + circle ("xz", 0, h / 2.0, 0, radius); + circle ("xz", 0, -h / 2.0, 0, radius); + line (-radius, -h / 2.0, 0, -radius, +h / 2.0, 0); + line (+radius, -h / 2.0, 0, +radius, +h / 2.0, 0); + line (0, -h / 2.0, -radius, 0, +h / 2.0, -radius); + line (0, -h / 2.0, +radius, 0, +h / 2.0, +radius); + if (borderx > 0) { + circle ("xz", 0, h / 2.0, 0, radius + borderx); + circle ("xz", 0, -h / 2.0, 0, radius + borderx); + } } else { - int NH=24; + int NH = 24; int ih; - - for(ih = 0; ih < NH; ih++) { - double phi0, phi1; - double x0,y0,z0,x1,y1,z1,x2,y2,z2,x3,y3,z3; - phi0 = (-angle/2+(angle/NH)*ih) *DEG2RAD; /* in xz plane */ - phi1 = (-angle/2+(angle/NH)*(ih+1))*DEG2RAD; - - z0 = radius*cos(phi0); - x0 = radius*sin(phi0); - y0 = -yheight/2; - z1 = radius*cos(phi0); - x1 = radius*sin(phi0); - y1 = yheight/2; - z2 = radius*cos(phi1); - x2 = radius*sin(phi1); - y2 = y1; - z3 = radius*cos(phi1); - x3 = radius*sin(phi1); - y3 = y0; - mcdis_multiline(5, - x0,y0,z0, - x1,y1,z1, - x2,y2,z2, - x3,y3,z3, - x0,y0,z0); - } + + for (ih = 0; ih < NH; ih++) { + double phi0, phi1; + double x0, y0, z0, x1, y1, z1, x2, y2, z2, x3, y3, z3; + phi0 = (-angle / 2 + (angle / NH) * ih) * DEG2RAD; /* in xz plane */ + phi1 = (-angle / 2 + (angle / NH) * (ih + 1)) * DEG2RAD; + + z0 = radius * cos (phi0); + x0 = radius * sin (phi0); + y0 = -yheight / 2; + z1 = radius * cos (phi0); + x1 = radius * sin (phi0); + y1 = yheight / 2; + z2 = radius * cos (phi1); + x2 = radius * sin (phi1); + y2 = y1; + z3 = radius * cos (phi1); + x3 = radius * sin (phi1); + y3 = y0; + mcdis_multiline (5, x0, y0, z0, x1, y1, z1, x2, y2, z2, x3, y3, z3, x0, y0, z0); + } } } %} From ce3830c043b1110c36681c4f369c69817345cdf2 Mon Sep 17 00:00:00 2001 From: Peter Willendrup Date: Tue, 17 Feb 2026 19:18:47 +0100 Subject: [PATCH 2/2] Apply formatting to remainder of contrib --- mcstas-comps/contrib/Al_window.comp | 73 +- mcstas-comps/contrib/CavitiesIn.comp | 43 +- mcstas-comps/contrib/CavitiesOut.comp | 39 +- mcstas-comps/contrib/Collimator_ROC.comp | 79 +- mcstas-comps/contrib/Commodus_I3.comp | 226 +- mcstas-comps/contrib/Conics_EH.comp | 182 +- mcstas-comps/contrib/Conics_HE.comp | 181 +- mcstas-comps/contrib/Conics_PH.comp | 185 +- mcstas-comps/contrib/Conics_PP.comp | 180 +- mcstas-comps/contrib/E_4PI.comp | 46 +- mcstas-comps/contrib/Exact_radial_coll.comp | 308 +- mcstas-comps/contrib/FermiChopper_ILL.comp | 705 ++-- mcstas-comps/contrib/Fermi_chop2a.comp | 399 +- mcstas-comps/contrib/Filter_graphite.comp | 167 +- .../contrib/FlatEllipse_finite_mirror.comp | 257 +- mcstas-comps/contrib/Foil_flipper_magnet.comp | 338 +- mcstas-comps/contrib/GISANS_sample.comp | 3422 ++++++++-------- mcstas-comps/contrib/Guide_anyshape_r.comp | 104 +- mcstas-comps/contrib/Guide_curved.comp | 128 +- mcstas-comps/contrib/Guide_four_side.comp | 3585 +++++++++-------- mcstas-comps/contrib/Guide_gravity_psd.comp | 935 +++-- mcstas-comps/contrib/Guide_honeycomb.comp | 605 +-- mcstas-comps/contrib/Guide_m.comp | 242 +- mcstas-comps/contrib/Guide_multichannel.comp | 526 +-- mcstas-comps/contrib/ISIS_moderator.comp | 1905 ++++----- mcstas-comps/contrib/Lens.comp | 1074 ++--- mcstas-comps/contrib/Lens_simple.comp | 107 +- .../contrib/Mirror_Curved_Bispectral.comp | 1225 +++--- mcstas-comps/contrib/Mirror_Elliptic.comp | 257 +- .../contrib/Mirror_Elliptic_Bispectral.comp | 768 ++-- mcstas-comps/contrib/Mirror_Parabolic.comp | 212 +- mcstas-comps/contrib/Monochromator_2foc.comp | 333 +- mcstas-comps/contrib/Monochromator_bent.comp | 3290 +++++++-------- .../contrib/Monochromator_bent_complex.comp | 670 ++- mcstas-comps/contrib/MultiDiskChopper.comp | 469 ++- mcstas-comps/contrib/Multilayer_Sample.comp | 679 ++-- .../contrib/NPI_tof_dhkl_detector.comp | 762 ++-- .../contrib/NPI_tof_theta_monitor.comp | 141 +- mcstas-comps/contrib/PSD_Pol_monitor.comp | 358 +- mcstas-comps/contrib/PSD_monitor_rad.comp | 72 +- mcstas-comps/contrib/PSD_spinDmon.comp | 98 +- mcstas-comps/contrib/PSD_spinUmon.comp | 100 +- mcstas-comps/contrib/PerfectCrystal.comp | 1216 +++--- mcstas-comps/contrib/Pol_bender_tapering.comp | 900 +++-- mcstas-comps/contrib/Pol_pi_2_rotator.comp | 37 +- mcstas-comps/contrib/Pol_triafield.comp | 103 +- mcstas-comps/contrib/Radial_div.comp | 74 +- mcstas-comps/contrib/SANSCurve.comp | 301 +- mcstas-comps/contrib/SANSCylinders.comp | 194 +- .../contrib/SANSEllipticCylinders.comp | 224 +- mcstas-comps/contrib/SANSLiposomes.comp | 324 +- mcstas-comps/contrib/SANSNanodiscs.comp | 239 +- mcstas-comps/contrib/SANSNanodiscsFast.comp | 315 +- .../contrib/SANSNanodiscsWithTags.comp | 264 +- .../contrib/SANSNanodiscsWithTagsFast.comp | 263 +- mcstas-comps/contrib/SANSPDB.comp | 284 +- mcstas-comps/contrib/SANSPDBFast.comp | 925 +++-- mcstas-comps/contrib/SANSQMonitor.comp | 212 +- mcstas-comps/contrib/SANSShells.comp | 198 +- mcstas-comps/contrib/SANSSpheres.comp | 164 +- .../contrib/SANSSpheresPolydisperse.comp | 164 +- mcstas-comps/contrib/SANS_AnySamp.comp | 148 +- mcstas-comps/contrib/SANS_DebyeS.comp | 100 +- mcstas-comps/contrib/SANS_Guinier.comp | 112 +- mcstas-comps/contrib/SANS_Liposomes_Abs.comp | 201 +- mcstas-comps/contrib/SANS_benchmark2.comp | 1380 ++++--- mcstas-comps/contrib/SNS_source.comp | 277 +- mcstas-comps/contrib/SNS_source_analytic.comp | 1623 ++++---- mcstas-comps/contrib/Sans_liposomes_new.comp | 140 +- mcstas-comps/contrib/Sapphire_Filter.comp | 43 +- mcstas-comps/contrib/SiC.comp | 46 +- .../contrib/Single_crystal_inelastic.comp | 1177 +++--- mcstas-comps/contrib/Source_custom.comp | 221 +- mcstas-comps/contrib/Source_gen4.comp | 623 ++- .../contrib/Source_multi_surfaces.comp | 476 ++- mcstas-comps/contrib/Source_pulsed.comp | 557 ++- .../Spherical_Backscattering_Analyser.comp | 271 +- mcstas-comps/contrib/Spin_random.comp | 27 +- mcstas-comps/contrib/Spot_sample.comp | 182 +- mcstas-comps/contrib/StatisticalChopper.comp | 225 +- .../contrib/StatisticalChopper_Monitor.comp | 153 +- mcstas-comps/contrib/SupermirrorFlat.comp | 427 +- mcstas-comps/contrib/TOF2Q_cyl_monitor.comp | 171 +- mcstas-comps/contrib/TOFSANSdet.comp | 1323 +++--- mcstas-comps/contrib/TOF_PSDmonitor.comp | 94 +- mcstas-comps/contrib/TOF_PSDmonitor_toQ.comp | 134 +- .../contrib/Transmission_V_polarisator.comp | 603 +-- .../Transmission_polarisatorABSnT.comp | 703 ++-- mcstas-comps/contrib/Vertical_Bender.comp | 472 +-- mcstas-comps/contrib/Vertical_T0a.comp | 283 +- mcstas-comps/contrib/ViewModISIS.comp | 1814 ++++----- mcstas-comps/contrib/multi_pipe.comp | 501 ++- 92 files changed, 23333 insertions(+), 23050 deletions(-) diff --git a/mcstas-comps/contrib/Al_window.comp b/mcstas-comps/contrib/Al_window.comp index 66db0a3bd..215c87e31 100644 --- a/mcstas-comps/contrib/Al_window.comp +++ b/mcstas-comps/contrib/Al_window.comp @@ -44,60 +44,59 @@ SETTING PARAMETERS (thickness=0.001) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -/* ToDo: Should be component local names. */ -#ifndef AL_WINDOW -#define avogadro 6.022 /* 10E23 Atoms per mole (mol-1) */ -#define Al_sigma_a .231 /* Absorption cross section per atom (barns) at 2200m/s */ -#define Al_sigma_i .0082 /* Incoherent scattering cross section per atom (barns) */ -#define Al_rho 2.7 /* density (gcm-3) */ -#define Al_mmol 27 /* molar mass Al (gmol-1) */ -#define Al_my_s (Al_rho / Al_mmol * Al_sigma_i * avogadro * 10) /* inc. XS (barn) */ -#define Al_my_a_v (Al_rho / Al_mmol * Al_sigma_a * avogadro * 10 * 2200 ) -/* Define Constants for Polynomial Fit of - sigma_tot(lambda)=A+B1*X+B2*X^2+B3*X^3+B4*X^4+... */ -#define Al_pf_A 1.34722 -#define Al_pf_B1 .12409 -#define Al_pf_B2 .01078 -#define Al_pf_B3 -3.25895e-5 -#define Al_pf_B4 3.74731e-6 -#define AL_WINDOW -#endif + /* ToDo: Should be component local names. */ + #ifndef AL_WINDOW + #define avogadro 6.022 /* 10E23 Atoms per mole (mol-1) */ + #define Al_sigma_a .231 /* Absorption cross section per atom (barns) at 2200m/s */ + #define Al_sigma_i .0082 /* Incoherent scattering cross section per atom (barns) */ + #define Al_rho 2.7 /* density (gcm-3) */ + #define Al_mmol 27 /* molar mass Al (gmol-1) */ + #define Al_my_s (Al_rho / Al_mmol * Al_sigma_i * avogadro * 10) /* inc. XS (barn) */ + #define Al_my_a_v (Al_rho / Al_mmol * Al_sigma_a * avogadro * 10 * 2200 ) + /* Define Constants for Polynomial Fit of + sigma_tot(lambda)=A+B1*X+B2*X^2+B3*X^3+B4*X^4+... */ + #define Al_pf_A 1.34722 + #define Al_pf_B1 .12409 + #define Al_pf_B2 .01078 + #define Al_pf_B3 -3.25895e-5 + #define Al_pf_B4 3.74731e-6 + #define AL_WINDOW + #endif %} TRACE %{ - double v; /* Neutron velocity */ - double dt0; /* Flight times through sample */ + double v; /* Neutron velocity */ + double dt0; /* Flight times through sample */ double dist; - double Al_s_tot_lambda,Al_my_tot,Al_my_a ; /* total XS (barn), total scattering length (m-1), absorption scat. length */ - double lambda; /* neutrons wavelength */ + double Al_s_tot_lambda, Al_my_tot, Al_my_a; /* total XS (barn), total scattering length (m-1), absorption scat. length */ + double lambda; /* neutrons wavelength */ PROP_Z0; - dt0=thickness/vz; - v=sqrt(vx*vx+vy*vy+vz*vz); - PROP_DT(dt0); - dist=v*dt0; + dt0 = thickness / vz; + v = sqrt (vx * vx + vy * vy + vz * vz); + PROP_DT (dt0); + dist = v * dt0; - lambda=sqrt(81.81/(VS2E*v*v)); - Al_s_tot_lambda= Al_pf_A+Al_pf_B1*lambda+ Al_pf_B2*lambda*lambda+ Al_pf_B3*lambda*lambda*lambda; - Al_s_tot_lambda+=Al_pf_B4*lambda*lambda*lambda*lambda; - Al_my_tot=Al_rho / Al_mmol * Al_s_tot_lambda * avogadro * 10; - Al_my_a = Al_my_a_v/v; + lambda = sqrt (81.81 / (VS2E * v * v)); + Al_s_tot_lambda = Al_pf_A + Al_pf_B1 * lambda + Al_pf_B2 * lambda * lambda + Al_pf_B3 * lambda * lambda * lambda; + Al_s_tot_lambda += Al_pf_B4 * lambda * lambda * lambda * lambda; + Al_my_tot = Al_rho / Al_mmol * Al_s_tot_lambda * avogadro * 10; + Al_my_a = Al_my_a_v / v; - p *=exp(-Al_my_a*dist);/* neutron passes window without any interaction */ + p *= exp (-Al_my_a * dist); /* neutron passes window without any interaction */ /* TODO: scatter in Debye-Scherrer cone */ - %} MCDISPLAY %{ /* A bit ugly; hard-coded dimensions. */ - - line(0,0,0,0.2,0,0); - line(0,0,0,0,0.2,0); - line(0,0,0,0,0,0.2); + + line (0, 0, 0, 0.2, 0, 0); + line (0, 0, 0, 0, 0.2, 0); + line (0, 0, 0, 0, 0, 0.2); %} END diff --git a/mcstas-comps/contrib/CavitiesIn.comp b/mcstas-comps/contrib/CavitiesIn.comp index 6672bb196..6d4088acc 100644 --- a/mcstas-comps/contrib/CavitiesIn.comp +++ b/mcstas-comps/contrib/CavitiesIn.comp @@ -49,10 +49,12 @@ DECLARE INITIALIZE %{ - xcc = floor(fabs(xc)); - ycc = floor(fabs(yc)); - if (xcc==0) xcc=1; - if (ycc==0) ycc=1; + xcc = floor (fabs (xc)); + ycc = floor (fabs (yc)); + if (xcc == 0) + xcc = 1; + if (ycc == 0) + ycc = 1; mcs_xc = 0; mcs_yc = 0; %} @@ -60,33 +62,24 @@ INITIALIZE TRACE %{ PROP_Z0; - if (x<-0.5*xw || x>0.5*xw || y<-0.5*yw || y>0.5*yw) + if (x < -0.5 * xw || x > 0.5 * xw || y < -0.5 * yw || y > 0.5 * yw) ABSORB; - else - { + else { SCATTER; - mcs_xc = floor((x+0.5*xw)*xcc/xw); - mcs_yc = floor((y+0.5*yw)*ycc/yw); - x = x+(-mcs_xc-0.5+0.5*xcc)*xw/xcc; - y = y+(-mcs_yc-0.5+0.5*ycc)*yw/ycc; - } + mcs_xc = floor ((x + 0.5 * xw) * xcc / xw); + mcs_yc = floor ((y + 0.5 * yw) * ycc / yw); + x = x + (-mcs_xc - 0.5 + 0.5 * xcc) * xw / xcc; + y = y + (-mcs_yc - 0.5 + 0.5 * ycc) * yw / ycc; + } %} MCDISPLAY %{ - - multiline(3, -(double)xw, 0.5*yw, 0.0, - -0.5*xw, 0.5*yw, 0.0, - -0.5*xw, (double)yw, 0.0); - multiline(3, (double)xw, 0.5*yw, 0.0, - 0.5*xw, 0.5*yw, 0.0, - 0.5*xw, (double)yw, 0.0); - multiline(3, -(double)xw,-0.5*yw, 0.0, - -0.5*xw, -0.5*yw, 0.0, - -0.5*xw,-(double)yw, 0.0); - multiline(3, (double)xw,-0.5*yw, 0.0, - 0.5*xw, -0.5*yw, 0.0, - 0.5*xw,-(double)yw, 0.0); + + multiline (3, -(double)xw, 0.5 * yw, 0.0, -0.5 * xw, 0.5 * yw, 0.0, -0.5 * xw, (double)yw, 0.0); + multiline (3, (double)xw, 0.5 * yw, 0.0, 0.5 * xw, 0.5 * yw, 0.0, 0.5 * xw, (double)yw, 0.0); + multiline (3, -(double)xw, -0.5 * yw, 0.0, -0.5 * xw, -0.5 * yw, 0.0, -0.5 * xw, -(double)yw, 0.0); + multiline (3, (double)xw, -0.5 * yw, 0.0, 0.5 * xw, -0.5 * yw, 0.0, 0.5 * xw, -(double)yw, 0.0); %} END diff --git a/mcstas-comps/contrib/CavitiesOut.comp b/mcstas-comps/contrib/CavitiesOut.comp index dfd13f2c4..eaa710745 100644 --- a/mcstas-comps/contrib/CavitiesOut.comp +++ b/mcstas-comps/contrib/CavitiesOut.comp @@ -48,10 +48,12 @@ DECLARE INITIALIZE %{ - xcc = floor(fabs(xc)); - ycc = floor(fabs(yc)); - if (xcc==0) xcc=1; - if (ycc==0) ycc=1; + xcc = floor (fabs (xc)); + ycc = floor (fabs (yc)); + if (xcc == 0) + xcc = 1; + if (ycc == 0) + ycc = 1; mcs_xc = 0; mcs_yc = 0; %} @@ -59,31 +61,22 @@ INITIALIZE TRACE %{ PROP_Z0; - if (x<-0.5*xw/xcc || x>0.5*xw/xcc || y<-0.5*yw/ycc || y>0.5*yw/ycc) + if (x < -0.5 * xw / xcc || x > 0.5 * xw / xcc || y < -0.5 * yw / ycc || y > 0.5 * yw / ycc) ABSORB; - else - { + else { SCATTER; - x = x+(mcs_xc+0.5-0.5*xcc)*xw/xcc; - y = y+(mcs_yc+0.5-0.5*ycc)*yw/ycc; - } + x = x + (mcs_xc + 0.5 - 0.5 * xcc) * xw / xcc; + y = y + (mcs_yc + 0.5 - 0.5 * ycc) * yw / ycc; + } %} MCDISPLAY %{ - - multiline(3, -(double)xw, 0.5*yw, 0.0, - -0.5*xw, 0.5*yw, 0.0, - -0.5*xw, (double)yw, 0.0); - multiline(3, (double)xw, 0.5*yw, 0.0, - 0.5*xw, 0.5*yw, 0.0, - 0.5*xw, (double)yw, 0.0); - multiline(3, -(double)xw,-0.5*yw, 0.0, - -0.5*xw, -0.5*yw, 0.0, - -0.5*xw,-(double)yw, 0.0); - multiline(3, (double)xw,-0.5*yw, 0.0, - 0.5*xw, -0.5*yw, 0.0, - 0.5*xw,-(double)yw, 0.0); + + multiline (3, -(double)xw, 0.5 * yw, 0.0, -0.5 * xw, 0.5 * yw, 0.0, -0.5 * xw, (double)yw, 0.0); + multiline (3, (double)xw, 0.5 * yw, 0.0, 0.5 * xw, 0.5 * yw, 0.0, 0.5 * xw, (double)yw, 0.0); + multiline (3, -(double)xw, -0.5 * yw, 0.0, -0.5 * xw, -0.5 * yw, 0.0, -0.5 * xw, -(double)yw, 0.0); + multiline (3, (double)xw, -0.5 * yw, 0.0, 0.5 * xw, -0.5 * yw, 0.0, 0.5 * xw, -(double)yw, 0.0); %} END diff --git a/mcstas-comps/contrib/Collimator_ROC.comp b/mcstas-comps/contrib/Collimator_ROC.comp index 42bdb6b28..4d06dd2b5 100644 --- a/mcstas-comps/contrib/Collimator_ROC.comp +++ b/mcstas-comps/contrib/Collimator_ROC.comp @@ -64,64 +64,53 @@ ROC_ttmin=0, ROC_ttmax=100, ROC_sign=1) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ INITIALIZE %{ -if (ROC_pitch <= 0 || ROC_ri > ROC_ro || ROC_ro <= 0 -|| ROC_h <=0 || ROC_ttmin > ROC_ttmax) - fprintf(stderr,"Collimator_ROC: error: %s: Invalid geometrical parameters.\n", NAME_CURRENT_COMP); + if (ROC_pitch <= 0 || ROC_ri > ROC_ro || ROC_ro <= 0 || ROC_h <= 0 || ROC_ttmin > ROC_ttmax) + fprintf (stderr, "Collimator_ROC: error: %s: Invalid geometrical parameters.\n", NAME_CURRENT_COMP); %} TRACE %{ - double ROC_angle,x0,z0,x1,z1,a,r,xp,zp; - double d,dt,pi,t0,t1,t2,t3,twotheta; + double ROC_angle, x0, z0, x1, z1, a, r, xp, zp; + double d, dt, pi, t0, t1, t2, t3, twotheta; - if (cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, ROC_ri, ROC_h) && t1 > 0) - { + if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, ROC_ri, ROC_h) && t1 > 0) { int MyAbsorb = 0; - if (t0 < 0) t0 = t1; - twotheta = -atan2(x+vx*t0,z+vz*t0); - if (( (double)ROC_sign*twotheta*RAD2DEG >= ROC_ttmin ) && ( (double)ROC_sign*twotheta*RAD2DEG <= ROC_ttmax )) - { - if (cylinder_intersect(&t2, &t3, x, y, z, vx, vy, vz, ROC_ro, ROC_h) && t3 >0) - { - dt=(x*vz-z*vx)/(vx*vx+vz*vz); - xp=vz*dt; - zp=-vx*dt; - d=sqrt(xp*xp+zp*zp); - pi=1.0-RAD2DEG*fabs(asin(d/ROC_ro)-asin(d/ROC_ri))/ROC_pitch; - if (pi>0) - p*=pi; - else MyAbsorb = 1; - } - else MyAbsorb = 1; - } - else MyAbsorb = 1; - if (MyAbsorb) - { - PROP_DT(t0); + if (t0 < 0) + t0 = t1; + twotheta = -atan2 (x + vx * t0, z + vz * t0); + if (((double)ROC_sign * twotheta * RAD2DEG >= ROC_ttmin) && ((double)ROC_sign * twotheta * RAD2DEG <= ROC_ttmax)) { + if (cylinder_intersect (&t2, &t3, x, y, z, vx, vy, vz, ROC_ro, ROC_h) && t3 > 0) { + dt = (x * vz - z * vx) / (vx * vx + vz * vz); + xp = vz * dt; + zp = -vx * dt; + d = sqrt (xp * xp + zp * zp); + pi = 1.0 - RAD2DEG * fabs (asin (d / ROC_ro) - asin (d / ROC_ri)) / ROC_pitch; + if (pi > 0) + p *= pi; + else + MyAbsorb = 1; + } else + MyAbsorb = 1; + } else + MyAbsorb = 1; + if (MyAbsorb) { + PROP_DT (t0); ABSORB; } - } - else ABSORB; - + } else + ABSORB; %} MCDISPLAY %{ - double ROC_angle,x0,z0,x1,z1; + double ROC_angle, x0, z0, x1, z1; - - for (ROC_angle=ROC_ttmin; ROC_angle <= ROC_ttmax; ROC_angle += ROC_pitch) - { - x0=ROC_ri*sin(ROC_angle*DEG2RAD); - z0=ROC_ri*cos(ROC_angle*DEG2RAD); - x1=x0/ROC_ri*ROC_ro; - z1=z0/ROC_ri*ROC_ro; - multiline(5, - x0, ROC_h/2, z0, - x0, -ROC_h/2, z0, - x1, -ROC_h/2, z1, - x1, ROC_h/2, z1, - x0, ROC_h/2, z0); + for (ROC_angle = ROC_ttmin; ROC_angle <= ROC_ttmax; ROC_angle += ROC_pitch) { + x0 = ROC_ri * sin (ROC_angle * DEG2RAD); + z0 = ROC_ri * cos (ROC_angle * DEG2RAD); + x1 = x0 / ROC_ri * ROC_ro; + z1 = z0 / ROC_ri * ROC_ro; + multiline (5, x0, ROC_h / 2, z0, x0, -ROC_h / 2, z0, x1, -ROC_h / 2, z1, x1, ROC_h / 2, z1, x0, ROC_h / 2, z0); } %} END diff --git a/mcstas-comps/contrib/Commodus_I3.comp b/mcstas-comps/contrib/Commodus_I3.comp index 05b54f01f..85cf06042 100644 --- a/mcstas-comps/contrib/Commodus_I3.comp +++ b/mcstas-comps/contrib/Commodus_I3.comp @@ -1,115 +1,111 @@ -/******************************************************************************* -* -* McStas, neutron ray-tracing package -* Copyright (C) 1997-2008, All rights reserved -* Risoe National Laboratory, Roskilde, Denmark -* Institut Laue Langevin, Grenoble, France -* -* Component: Commodus_I3 -* -* -* %I -* Written by: G. Skoro, based on ViewModerator4 from S. Ansell -* Date: July 2022 -* Origin: ISIS -* -* ISIS Moderators (Tested with McStas 3.1 (Windows)) -* -* %D -* Produces a neutron distribution at the ISIS TS1 or TS2 corresponding moderator front face position. -* The Face argument determines which TS1 or TS2 beamline is to be sampled by using corresponding file. -* Neutrons are created having a range of energies determined by the E0 and E1 arguments. -* Trajectories are produced such that they pass through the moderator face (defined by -* modXsize and modZsize) and a focusing rectangle (defined by xw, yh and dist). -* --- HOW TO USE --- -* -* Example: Commodus_I3(Face="TS1verBase2016_LH8020_newVM-var_South04_Merlin.mcstas", E0 = E_min, E1 = E_max, -* modXsize = 0.12, modZsize = 0.12, xw = 0.094, yh = 0.094, dist = 1.6) -* -* MERLIN simulation; TS1 baseline model. -* In this example, xw and yh are chosen to be identical to the shutter opening dimension. -* dist = 1.6 is the real distance to the shutter front face: -* (This is TimeOffset value (=160 [cm]) from TS1verBase2016_LH8020_newVM-var_South04_Merlin.mcstas file.) -* -* N.B. Absolute normalization: The result of the Mc-Stas simulation will show neutron intensity for beam current of 1 uA. -* -* -* %P -* INPUT PARAMETERS: -* -* Face: [string] TS1 (or TS2) instrument McStas filename -* E0: [meV] Lower edge of energy distribution -* E1: [meV] Upper edge of energy distribution -* modXsize: [m] Moderator width -* modZsize: [m] Moderator height -* xw: [m] Width of focusing rectangle -* yh: [m] Height of focusing rectangle -* dist: [m] Distance from moderator surface to the focusing rectangle -* verbose: [int] Flag to output debugging information -* beamcurrent: [uA] ISIS beam current -* -* %E -*******************************************************************************/ -DEFINE COMPONENT Commodus_I3 -SETTING PARAMETERS (string Face="TS1_S04_Merlin.mcstas",E0, E1, modPosition=0, - dist=1.7, int verbose=0, beamcurrent=1, - modXsize=0.12,modZsize=0.12,xw=0.094,yh=0.094) - -SHARE INHERIT ViewModISIS - -DECLARE INHERIT ViewModISIS EXTEND -%{ - double xwidth; - double yheight; - double focus_xw; - double focus_yh; -%} - -INITIALIZE -%{ - xwidth=modXsize; - yheight=modZsize; - focus_xw=xw; - focus_yh=yh; - - /* READ IN THE ENERGY FILE */ - FILE* Tfile; - - Nsim=mcget_ncount(); // Number of points requested. - - Tfile=openFile(Face); // Get open file - rtE0=convertEnergy(E0); - rtE1=convertEnergy(E1); - orderEnergy(&rtE0,&rtE1); - - readHtable(Tfile,rtE0,rtE1, &TS, modPosition, xwidth, yheight, verbose); - fclose(Tfile); - // Below pragma was needed with PGI 19.x, compilation fails with NVC 20.7 - //#pragma acc declare create( TS ) - /**********************************************************************/ - - Tnpts=0; - Ncount=0; - - fprintf(stderr,"Face == %s \n",Face); - fprintf(stderr,"Number of Energy Points == %d\n",TS.nEnergy); - if (dist<0) - { - dist=TS.rdumMid; - fprintf(stderr,"Setting distance to moderator surface == %g\n", - dist); - } - /* Do solid angle correction */ - angleArea= strArea(TS, focus_xw, focus_yh, dist); - // Below pragma was needed with PGI 19.x, compilation fails with NVC 20.7 - //#pragma acc update host( TS ) - fprintf(stderr,"Totals:: %g %d %d \n",TS.Total,TS.nEnergy,TS.nTime); - - -%} - -TRACE INHERIT ViewModISIS - -MCDISPLAY INHERIT ViewModISIS - -END +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright (C) 1997-2008, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Component: Commodus_I3 +* +* +* %I +* Written by: G. Skoro, based on ViewModerator4 from S. Ansell +* Date: July 2022 +* Origin: ISIS +* +* ISIS Moderators (Tested with McStas 3.1 (Windows)) +* +* %D +* Produces a neutron distribution at the ISIS TS1 or TS2 corresponding moderator front face position. +* The Face argument determines which TS1 or TS2 beamline is to be sampled by using corresponding file. +* Neutrons are created having a range of energies determined by the E0 and E1 arguments. +* Trajectories are produced such that they pass through the moderator face (defined by +* modXsize and modZsize) and a focusing rectangle (defined by xw, yh and dist). +* --- HOW TO USE --- +* +* Example: Commodus_I3(Face="TS1verBase2016_LH8020_newVM-var_South04_Merlin.mcstas", E0 = E_min, E1 = E_max, +* modXsize = 0.12, modZsize = 0.12, xw = 0.094, yh = 0.094, dist = 1.6) +* +* MERLIN simulation; TS1 baseline model. +* In this example, xw and yh are chosen to be identical to the shutter opening dimension. +* dist = 1.6 is the real distance to the shutter front face: +* (This is TimeOffset value (=160 [cm]) from TS1verBase2016_LH8020_newVM-var_South04_Merlin.mcstas file.) +* +* N.B. Absolute normalization: The result of the Mc-Stas simulation will show neutron intensity for beam current of 1 uA. +* +* +* %P +* INPUT PARAMETERS: +* +* Face: [string] TS1 (or TS2) instrument McStas filename +* E0: [meV] Lower edge of energy distribution +* E1: [meV] Upper edge of energy distribution +* modXsize: [m] Moderator width +* modZsize: [m] Moderator height +* xw: [m] Width of focusing rectangle +* yh: [m] Height of focusing rectangle +* dist: [m] Distance from moderator surface to the focusing rectangle +* verbose: [int] Flag to output debugging information +* beamcurrent: [uA] ISIS beam current +* +* %E +*******************************************************************************/ +DEFINE COMPONENT Commodus_I3 +SETTING PARAMETERS (string Face="TS1_S04_Merlin.mcstas",E0, E1, modPosition=0, + dist=1.7, int verbose=0, beamcurrent=1, + modXsize=0.12,modZsize=0.12,xw=0.094,yh=0.094) + +SHARE INHERIT ViewModISIS + +DECLARE INHERIT ViewModISIS EXTEND +%{ + double xwidth; + double yheight; + double focus_xw; + double focus_yh; +%} + +INITIALIZE +%{ + xwidth = modXsize; + yheight = modZsize; + focus_xw = xw; + focus_yh = yh; + + /* READ IN THE ENERGY FILE */ + FILE* Tfile; + + Nsim = mcget_ncount (); // Number of points requested. + + Tfile = openFile (Face); // Get open file + rtE0 = convertEnergy (E0); + rtE1 = convertEnergy (E1); + orderEnergy (&rtE0, &rtE1); + + readHtable (Tfile, rtE0, rtE1, &TS, modPosition, xwidth, yheight, verbose); + fclose (Tfile); + // Below pragma was needed with PGI 19.x, compilation fails with NVC 20.7 + // #pragma acc declare create( TS ) + /**********************************************************************/ + + Tnpts = 0; + Ncount = 0; + + fprintf (stderr, "Face == %s \n", Face); + fprintf (stderr, "Number of Energy Points == %d\n", TS.nEnergy); + if (dist < 0) { + dist = TS.rdumMid; + fprintf (stderr, "Setting distance to moderator surface == %g\n", dist); + } + /* Do solid angle correction */ + angleArea = strArea (TS, focus_xw, focus_yh, dist); + // Below pragma was needed with PGI 19.x, compilation fails with NVC 20.7 + // #pragma acc update host( TS ) + fprintf (stderr, "Totals:: %g %d %d \n", TS.Total, TS.nEnergy, TS.nTime); +%} + +TRACE INHERIT ViewModISIS + +MCDISPLAY INHERIT ViewModISIS + +END diff --git a/mcstas-comps/contrib/Conics_EH.comp b/mcstas-comps/contrib/Conics_EH.comp index fb6d97fbf..fbb9a6d5c 100644 --- a/mcstas-comps/contrib/Conics_EH.comp +++ b/mcstas-comps/contrib/Conics_EH.comp @@ -62,67 +62,65 @@ SHARE DECLARE %{ - //Scene where all geometry is added to - Scene s; + // Scene where all geometry is added to + Scene s; %} INITIALIZE %{ - ConicSurf *pm; - double th_c, alpha_p, alpha_h, fp2, dr,rr, cH, theta_1, theta_2, theta_i; - int i; - - s=makeScene(); - /* Mode a, vector of radii */ - if (radii) { - for (i=0;i1?(rmax-rmin)/(nshells-1):0; - - double constant, quadratic; - quadratic = (rmax-rmin)/(rmax*rmax - rmin*rmin); - constant = rmax - quadratic*rmax*rmax; - - for (i=0;i 1 ? (rmax - rmin) / (nshells - 1) : 0; - } - if (disk) { - addDisk(pm->zs,0.0,rConic(pm->ze,*pm),&s); - } + double constant, quadratic; + quadratic = (rmax - rmin) / (rmax * rmax - rmin * rmin); + constant = rmax - quadratic * rmax * rmax; + + for (i = 0; i < nshells; i++) { + rr = rmax - dr * i; + rr = constant + quadratic * rr * rr; // Quadratic distribution of radius covers angular space better + // printf("--------------------------------------------------------------------"); + printf ("rr = %lf\n", rr); + // printf("--------------------------------------------------------------------"); + + Point pi = makePoint (0, rr, 0); + // pm=addEllipsoid(-focal_length_u, focal_length_d , pi, -le, 0, m,R0,Qc,W,alpha,&s); + // addHyperboloid( focal_length_d, focal_length_d*2, pi, 0, lh, m,R0,Qc,W,alpha,&s); + + theta_1 = atan (rr / focal_length_u); + theta_2 = atan (rr / focal_length_d); + theta_i = 0.25 * (theta_1 + theta_2); + + cH = fabs (0.5 * (rr / tan (theta_2 - 2.0 * theta_i) - focal_length_d)); + pm = addEllipsoid (focal_length_d + 2.0 * cH, -focal_length_u, pi, -le, 0, m, R0, Qc, W, alpha, &s); + addHyperboloid (focal_length_d, focal_length_d + 2.0 * cH, pi, 0, lh, m, R0, Qc, W, alpha, &s); + } + } + if (disk) { + addDisk (pm->zs, 0.0, rConic (pm->ze, *pm), &s); + } %} TRACE %{ /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=0; - traceSingleNeutron(_particle,s); + _mctmp_a = 0; + traceSingleNeutron (_particle, s); if (!_particle->_absorbed) { SCATTER; @@ -136,50 +134,52 @@ FINALLY %{ MCDISPLAY %{ - double zz = 0; - //Enlarge xy-plane when mcdisplay is ran with --zoom - magnify("xy"); - - //Draw xy-axis contour for Conic Surfaces - int i; - for (i = 0; i < s.num_c; i++) { - double step = (s.c[i].ze-s.c[i].zs)/100; - double cz; - int draw=-1; - for (cz = s.c[i].zs+step; cz <= s.c[i].ze; cz+= step) { - draw++; - double rp = rConic(cz-step,s.c[i]); - double rc = rConic(cz, s.c[i]); - double rx,ry; - int j; - double theta; - for (j = 0; j < 12; j++) { - theta = 2.0*PI*j/12.0; - rx = rp*cos(theta); - ry = rp*sin(theta); - line(rx,ry,cz-step-zz,rx,ry,cz-zz); - } - if (draw==0) { - circle("xy", 0, 0, cz-step-zz, rp); - } - if (draw==19) draw=-1; - } + double zz = 0; + // Enlarge xy-plane when mcdisplay is ran with --zoom + magnify ("xy"); + + // Draw xy-axis contour for Conic Surfaces + int i; + for (i = 0; i < s.num_c; i++) { + double step = (s.c[i].ze - s.c[i].zs) / 100; + double cz; + int draw = -1; + for (cz = s.c[i].zs + step; cz <= s.c[i].ze; cz += step) { + draw++; + double rp = rConic (cz - step, s.c[i]); + double rc = rConic (cz, s.c[i]); + double rx, ry; + int j; + double theta; + for (j = 0; j < 12; j++) { + theta = 2.0 * PI * j / 12.0; + rx = rp * cos (theta); + ry = rp * sin (theta); + line (rx, ry, cz - step - zz, rx, ry, cz - zz); + } + if (draw == 0) { + circle ("xy", 0, 0, cz - step - zz, rp); + } + if (draw == 19) + draw = -1; } + } - //Draw xy-axis cross hairs for Disks - //Local variables to control maximal display-size of cross-hairs - for (i = 0; i < s.num_di; i++) { - double r0=s.di[i].r0; - double r1=s.di[i].r1; - double z0=s.di[i].z0; - if (r0>1.0) r0=1.0; - if (r1>1.0) r1=1.0; - line(r0, 0, z0-zz, r1, 0, z0-zz); - line(-r0, 0, z0-zz, -r1, 0, z0-zz); - line(0, r0, z0-zz, 0, r1,z0-zz); - line(0, -r0, z0-zz, 0, -r1,z0-zz); - } - + // Draw xy-axis cross hairs for Disks + // Local variables to control maximal display-size of cross-hairs + for (i = 0; i < s.num_di; i++) { + double r0 = s.di[i].r0; + double r1 = s.di[i].r1; + double z0 = s.di[i].z0; + if (r0 > 1.0) + r0 = 1.0; + if (r1 > 1.0) + r1 = 1.0; + line (r0, 0, z0 - zz, r1, 0, z0 - zz); + line (-r0, 0, z0 - zz, -r1, 0, z0 - zz); + line (0, r0, z0 - zz, 0, r1, z0 - zz); + line (0, -r0, z0 - zz, 0, -r1, z0 - zz); + } %} END diff --git a/mcstas-comps/contrib/Conics_HE.comp b/mcstas-comps/contrib/Conics_HE.comp index 33b40963a..c7770854a 100644 --- a/mcstas-comps/contrib/Conics_HE.comp +++ b/mcstas-comps/contrib/Conics_HE.comp @@ -62,66 +62,65 @@ SHARE DECLARE %{ - //Scene where all geometry is added to - Scene s; + // Scene where all geometry is added to + Scene s; %} INITIALIZE %{ - ConicSurf *pm; - double th_c, alpha_p, alpha_h, fp2, dr,rr, cH, theta_1, theta_2, theta_i; - int i; - - s=makeScene(); - /* Mode a, vector of radii */ - if (radii) { - for (i=0;i1?(rmax-rmin)/(nshells-1):0; - - double constant, quadratic; - quadratic = (rmax-rmin)/(rmax*rmax - rmin*rmin); - constant = rmax - quadratic*rmax*rmax; - - for (i=0;i 1 ? (rmax - rmin) / (nshells - 1) : 0; - } - if (disk) { - addDisk(pm->zs,0.0,rConic(pm->ze,*pm),&s); - } + double constant, quadratic; + quadratic = (rmax - rmin) / (rmax * rmax - rmin * rmin); + constant = rmax - quadratic * rmax * rmax; + + for (i = 0; i < nshells; i++) { + rr = rmax - dr * i; + rr = constant + quadratic * rr * rr; // Quadratic distribution of radius covers angular space better + // printf("--------------------------------------------------------------------"); + printf ("rr = %lf\n", rr); + // printf("--------------------------------------------------------------------"); + + Point pi = makePoint (0, rr, 0); // f-1); + // pm=addEllipsoid(-focal_length_u, focal_length_d , pi, -le, 0, m,R0,Qc,W,alpha,&s); + // addHyperboloid( focal_length_d, focal_length_d*2, pi, 0, lh, m,R0,Qc,W,alpha,&s); + + theta_1 = atan (rr / focal_length_u); + theta_2 = atan (rr / focal_length_d); + theta_i = 0.25 * (theta_1 + theta_2); + + cH = fabs (0.5 * (rr / tan (theta_2 - 2.0 * theta_i) - focal_length_d)); + pm = addHyperboloid (-focal_length_u - 2.0 * cH, -focal_length_u, pi, -lh, 0, m, R0, Qc, W, alpha, &s); + addEllipsoid (-focal_length_u - 2.0 * cH, focal_length_d, pi, 0, le, m, R0, Qc, W, alpha, &s); + } + } + if (disk) { + addDisk (pm->zs, 0.0, rConic (pm->ze, *pm), &s); + } %} TRACE %{ /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=0; - traceSingleNeutron(_particle,s); + _mctmp_a = 0; + traceSingleNeutron (_particle, s); if (!_particle->_absorbed) { SCATTER; @@ -135,50 +134,52 @@ FINALLY %{ MCDISPLAY %{ - double zz = 0; - //Enlarge xy-plane when mcdisplay is ran with --zoom - magnify("xy"); - - //Draw xy-axis contour for Conic Surfaces - int i; - for (i = 0; i < s.num_c; i++) { - double step = (s.c[i].ze-s.c[i].zs)/100; - double cz; - int draw=-1; - for (cz = s.c[i].zs+step; cz <= s.c[i].ze; cz+= step) { - draw++; - double rp = rConic(cz-step,s.c[i]); - double rc = rConic(cz, s.c[i]); - double rx,ry; - int j; - double theta; - for (j = 0; j < 12; j++) { - theta = 2.0*PI*j/12.0; - rx = rp*cos(theta); - ry = rp*sin(theta); - line(rx,ry,cz-step-zz,rx,ry,cz-zz); - } - if (draw==0) { - circle("xy", 0, 0, cz-step-zz, rp); - } - if (draw==19) draw=-1; - } + double zz = 0; + // Enlarge xy-plane when mcdisplay is ran with --zoom + magnify ("xy"); + + // Draw xy-axis contour for Conic Surfaces + int i; + for (i = 0; i < s.num_c; i++) { + double step = (s.c[i].ze - s.c[i].zs) / 100; + double cz; + int draw = -1; + for (cz = s.c[i].zs + step; cz <= s.c[i].ze; cz += step) { + draw++; + double rp = rConic (cz - step, s.c[i]); + double rc = rConic (cz, s.c[i]); + double rx, ry; + int j; + double theta; + for (j = 0; j < 12; j++) { + theta = 2.0 * PI * j / 12.0; + rx = rp * cos (theta); + ry = rp * sin (theta); + line (rx, ry, cz - step - zz, rx, ry, cz - zz); + } + if (draw == 0) { + circle ("xy", 0, 0, cz - step - zz, rp); + } + if (draw == 19) + draw = -1; } + } - //Draw xy-axis cross hairs for Disks - //Local variables to control maximal display-size of cross-hairs - for (i = 0; i < s.num_di; i++) { - double r0=s.di[i].r0; - double r1=s.di[i].r1; - double z0=s.di[i].z0; - if (r0>1.0) r0=1.0; - if (r1>1.0) r1=1.0; - line(r0, 0, z0-zz, r1, 0, z0-zz); - line(-r0, 0, z0-zz, -r1, 0, z0-zz); - line(0, r0, z0-zz, 0, r1,z0-zz); - line(0, -r0, z0-zz, 0, -r1,z0-zz); - } - + // Draw xy-axis cross hairs for Disks + // Local variables to control maximal display-size of cross-hairs + for (i = 0; i < s.num_di; i++) { + double r0 = s.di[i].r0; + double r1 = s.di[i].r1; + double z0 = s.di[i].z0; + if (r0 > 1.0) + r0 = 1.0; + if (r1 > 1.0) + r1 = 1.0; + line (r0, 0, z0 - zz, r1, 0, z0 - zz); + line (-r0, 0, z0 - zz, -r1, 0, z0 - zz); + line (0, r0, z0 - zz, 0, r1, z0 - zz); + line (0, -r0, z0 - zz, 0, -r1, z0 - zz); + } %} END diff --git a/mcstas-comps/contrib/Conics_PH.comp b/mcstas-comps/contrib/Conics_PH.comp index 745453063..0b39fe7e5 100644 --- a/mcstas-comps/contrib/Conics_PH.comp +++ b/mcstas-comps/contrib/Conics_PH.comp @@ -63,67 +63,66 @@ SHARE DECLARE %{ - //Scene where all geometry is added to - Scene s; + // Scene where all geometry is added to + Scene s; %} INITIALIZE %{ - ConicSurf *pm; - double th_c, alpha_p, alpha_h, fp2, dr,rr, cH, theta_1, theta_2, theta_i; - int i; - - s=makeScene(); - /* Mode a, vector of radii */ - if (radii) { - for (i=0;i1?(rmax-rmin)/(nshells-1):0; - for (i=0;izs,0.0,rConic(pm->ze,*pm),&s); + ConicSurf* pm; + double th_c, alpha_p, alpha_h, fp2, dr, rr, cH, theta_1, theta_2, theta_i; + int i; + + s = makeScene (); + /* Mode a, vector of radii */ + if (radii) { + for (i = 0; i < nshells; i++) { + rr = radii[i]; + + th_c = tan (rr / focal_length); + alpha_p = th_c / 4.0; + alpha_h = 3 * alpha_p; + + Point pi = makePoint (0, rr, 0); // f-1); + pm = addParaboloid (focal_length, pi, -lp, 0, m, R0, Qc, W, alpha, &s); + addHyperboloid (focal_length, focal_length, pi, 0, lh, m, R0, Qc, W, alpha, &s); } + } else { + /* Mode b, use quadratic law to distribute the shells */ + double constant, quadratic; + quadratic = (rmax - rmin) / (rmax * rmax - rmin * rmin); + constant = rmax - quadratic * rmax * rmax; + dr = nshells > 1 ? (rmax - rmin) / (nshells - 1) : 0; + for (i = 0; i < nshells; i++) { + rr = rmax - dr * i; + rr = constant + quadratic * rr * rr; // Quadratic distribution of radius covers angular space better + + th_c = tan (rr / focal_length); + alpha_p = th_c / 4.0; + alpha_h = 3 * alpha_p; + + Point pi = makePoint (0, rr, 0); // f-1); + + theta_1 = 0.0; + theta_2 = atan (rr / focal_length); + theta_i = 0.25 * (theta_1 + theta_2); + cH = fabs (0.5 * (rr / tan (theta_2 - 2.0 * theta_i) - focal_length)); + + pm = addParaboloid (focal_length + 2.0 * cH, pi, -lp, 0, m, R0, Qc, W, alpha, &s); + addHyperboloid (focal_length, focal_length + 2.0 * cH, pi, 0, lh, m, R0, Qc, W, alpha, &s); + } + } + if (disk) { + addDisk (pm->zs, 0.0, rConic (pm->ze, *pm), &s); + } %} TRACE %{ /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=0; - traceSingleNeutron(_particle,s); + _mctmp_a = 0; + traceSingleNeutron (_particle, s); if (!_particle->_absorbed) { SCATTER; @@ -137,50 +136,52 @@ FINALLY %{ MCDISPLAY %{ - double zz = 0; - //Enlarge xy-plane when mcdisplay is ran with --zoom - magnify("xy"); - - //Draw xy-axis contour for Conic Surfaces - int i; - for (i = 0; i < s.num_c; i++) { - double step = (s.c[i].ze-s.c[i].zs)/100; - double cz; - int draw=-1; - for (cz = s.c[i].zs+step; cz <= s.c[i].ze; cz+= step) { - draw++; - double rp = rConic(cz-step,s.c[i]); - double rc = rConic(cz, s.c[i]); - double rx,ry; - int j; - double theta; - for (j = 0; j < 12; j++) { - theta = 2.0*PI*j/12.0; - rx = rp*cos(theta); - ry = rp*sin(theta); - line(rx,ry,cz-step-zz,rx,ry,cz-zz); - } - if (draw==0) { - circle("xy", 0, 0, cz-step-zz, rp); - } - if (draw==19) draw=-1; - } - } + double zz = 0; + // Enlarge xy-plane when mcdisplay is ran with --zoom + magnify ("xy"); - //Draw xy-axis cross hairs for Disks - //Local variables to control maximal display-size of cross-hairs - for (i = 0; i < s.num_di; i++) { - double r0=s.di[i].r0; - double r1=s.di[i].r1; - double z0=s.di[i].z0; - if (r0>1.0) r0=1.0; - if (r1>1.0) r1=1.0; - line(r0, 0, z0-zz, r1, 0, z0-zz); - line(-r0, 0, z0-zz, -r1, 0, z0-zz); - line(0, r0, z0-zz, 0, r1,z0-zz); - line(0, -r0, z0-zz, 0, -r1,z0-zz); + // Draw xy-axis contour for Conic Surfaces + int i; + for (i = 0; i < s.num_c; i++) { + double step = (s.c[i].ze - s.c[i].zs) / 100; + double cz; + int draw = -1; + for (cz = s.c[i].zs + step; cz <= s.c[i].ze; cz += step) { + draw++; + double rp = rConic (cz - step, s.c[i]); + double rc = rConic (cz, s.c[i]); + double rx, ry; + int j; + double theta; + for (j = 0; j < 12; j++) { + theta = 2.0 * PI * j / 12.0; + rx = rp * cos (theta); + ry = rp * sin (theta); + line (rx, ry, cz - step - zz, rx, ry, cz - zz); + } + if (draw == 0) { + circle ("xy", 0, 0, cz - step - zz, rp); + } + if (draw == 19) + draw = -1; } - + } + + // Draw xy-axis cross hairs for Disks + // Local variables to control maximal display-size of cross-hairs + for (i = 0; i < s.num_di; i++) { + double r0 = s.di[i].r0; + double r1 = s.di[i].r1; + double z0 = s.di[i].z0; + if (r0 > 1.0) + r0 = 1.0; + if (r1 > 1.0) + r1 = 1.0; + line (r0, 0, z0 - zz, r1, 0, z0 - zz); + line (-r0, 0, z0 - zz, -r1, 0, z0 - zz); + line (0, r0, z0 - zz, 0, r1, z0 - zz); + line (0, -r0, z0 - zz, 0, -r1, z0 - zz); + } %} END diff --git a/mcstas-comps/contrib/Conics_PP.comp b/mcstas-comps/contrib/Conics_PP.comp index 585d693e9..13415d575 100644 --- a/mcstas-comps/contrib/Conics_PP.comp +++ b/mcstas-comps/contrib/Conics_PP.comp @@ -62,66 +62,64 @@ SHARE DECLARE %{ - //Scene where all geometry is added to - Scene s; + // Scene where all geometry is added to + Scene s; %} INITIALIZE %{ - ConicSurf *pm; - double th_c, alpha_p, alpha_h, fp2, dr,rr, cH, theta_1, theta_2, theta_i; - int i; - - s=makeScene(); - /* Mode a, vector of radii */ - if (radii) { - for (i=0;i1?(rmax-rmin)/(nshells-1):0; - - double constant, quadratic; - quadratic = (rmax-rmin)/(rmax*rmax - rmin*rmin); - constant = rmax - quadratic*rmax*rmax; - - for (i=0;izs,0.0,rConic(pm->ze,*pm),&s); - } + } else { + /* Mode b, use quadratic law to distribute the shells */ + dr = nshells > 1 ? (rmax - rmin) / (nshells - 1) : 0; + + double constant, quadratic; + quadratic = (rmax - rmin) / (rmax * rmax - rmin * rmin); + constant = rmax - quadratic * rmax * rmax; + + for (i = 0; i < nshells; i++) { + rr = rmax - dr * i; + rr = constant + quadratic * rr * rr; // Quadratic distribution of radius covers angular space better + // printf("--------------------------------------------------------------------"); + printf ("rr = %lf\n", rr); + // printf("--------------------------------------------------------------------"); + + Point pi = makePoint (0, rr, 0); + // pm=addEllipsoid(-focal_length_u, focal_length_d , pi, -le, 0, m,R0,Qc,W,alpha,&s); + // addHyperboloid( focal_length_d, focal_length_d*2, pi, 0, lh, m,R0,Qc,W,alpha,&s); + + theta_1 = atan (rr / focal_length_u); + theta_2 = atan (rr / focal_length_d); + theta_i = 0.25 * (theta_1 + theta_2); + cH = fabs (0.5 * (rr / tan (theta_2 - 2.0 * theta_i) - focal_length_d)); + pm = addParaboloid (focal_length_u + 2.0 * cH, pi, -lp, 0, m, R0, Qc, W, alpha, &s); + addParaboloid (-focal_length_d + 2.0 * cH, pi, 0, lp2, mR0, Qc, W, alpha, &s); + } + } + if (disk) { + addDisk (pm->zs, 0.0, rConic (pm->ze, *pm), &s); + } %} TRACE %{ /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=0; - traceSingleNeutron(_particle,s); + _mctmp_a = 0; + traceSingleNeutron (_particle, s); if (!_particle->_absorbed) { SCATTER; @@ -135,50 +133,52 @@ FINALLY %{ MCDISPLAY %{ - double zz = 0; - //Enlarge xy-plane when mcdisplay is ran with --zoom - magnify("xy"); - - //Draw xy-axis contour for Conic Surfaces - int i; - for (i = 0; i < s.num_c; i++) { - double step = (s.c[i].ze-s.c[i].zs)/100; - double cz; - int draw=-1; - for (cz = s.c[i].zs+step; cz <= s.c[i].ze; cz+= step) { - draw++; - double rp = rConic(cz-step,s.c[i]); - double rc = rConic(cz, s.c[i]); - double rx,ry; - int j; - double theta; - for (j = 0; j < 12; j++) { - theta = 2.0*PI*j/12.0; - rx = rp*cos(theta); - ry = rp*sin(theta); - line(rx,ry,cz-step-zz,rx,ry,cz-zz); - } - if (draw==0) { - circle("xy", 0, 0, cz-step-zz, rp); - } - if (draw==19) draw=-1; - } - } + double zz = 0; + // Enlarge xy-plane when mcdisplay is ran with --zoom + magnify ("xy"); - //Draw xy-axis cross hairs for Disks - //Local variables to control maximal display-size of cross-hairs - for (i = 0; i < s.num_di; i++) { - double r0=s.di[i].r0; - double r1=s.di[i].r1; - double z0=s.di[i].z0; - if (r0>1.0) r0=1.0; - if (r1>1.0) r1=1.0; - line(r0, 0, z0-zz, r1, 0, z0-zz); - line(-r0, 0, z0-zz, -r1, 0, z0-zz); - line(0, r0, z0-zz, 0, r1,z0-zz); - line(0, -r0, z0-zz, 0, -r1,z0-zz); + // Draw xy-axis contour for Conic Surfaces + int i; + for (i = 0; i < s.num_c; i++) { + double step = (s.c[i].ze - s.c[i].zs) / 100; + double cz; + int draw = -1; + for (cz = s.c[i].zs + step; cz <= s.c[i].ze; cz += step) { + draw++; + double rp = rConic (cz - step, s.c[i]); + double rc = rConic (cz, s.c[i]); + double rx, ry; + int j; + double theta; + for (j = 0; j < 12; j++) { + theta = 2.0 * PI * j / 12.0; + rx = rp * cos (theta); + ry = rp * sin (theta); + line (rx, ry, cz - step - zz, rx, ry, cz - zz); + } + if (draw == 0) { + circle ("xy", 0, 0, cz - step - zz, rp); + } + if (draw == 19) + draw = -1; } - + } + + // Draw xy-axis cross hairs for Disks + // Local variables to control maximal display-size of cross-hairs + for (i = 0; i < s.num_di; i++) { + double r0 = s.di[i].r0; + double r1 = s.di[i].r1; + double z0 = s.di[i].z0; + if (r0 > 1.0) + r0 = 1.0; + if (r1 > 1.0) + r1 = 1.0; + line (r0, 0, z0 - zz, r1, 0, z0 - zz); + line (-r0, 0, z0 - zz, -r1, 0, z0 - zz); + line (0, r0, z0 - zz, 0, r1, z0 - zz); + line (0, -r0, z0 - zz, 0, -r1, z0 - zz); + } %} END diff --git a/mcstas-comps/contrib/E_4PI.comp b/mcstas-comps/contrib/E_4PI.comp index 887ca1d95..18cd7bf30 100644 --- a/mcstas-comps/contrib/E_4PI.comp +++ b/mcstas-comps/contrib/E_4PI.comp @@ -55,29 +55,29 @@ DECLARE INITIALIZE %{ - PSD_N = create_darr1d(ne); - PSD_p = create_darr1d(ne); - PSD_p2 = create_darr1d(ne); - + PSD_N = create_darr1d (ne); + PSD_p = create_darr1d (ne); + PSD_p2 = create_darr1d (ne); + // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ double t0, t1, phi, theta, E; - int i,j,k; + int i, j, k; - if(sphere_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius) && t1 > 0) - { - if(t0 < 0) + if (sphere_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius) && t1 > 0) { + if (t0 < 0) t0 = t1; /* t0 is now time of intersection with the sphere. */ - PROP_DT(t0); + PROP_DT (t0); - E=VS2E*(vx*vx+vy*vy+vz*vz); - if(E<=Emax && E>=Emin) { - k = floor((E - Emin)*ne/(Emax - Emin)); - double p2 = p*p; + E = VS2E * (vx * vx + vy * vy + vz * vz); + if (E <= Emax && E >= Emin) { + k = floor ((E - Emin) * ne / (Emax - Emin)); + double p2 = p * p; #pragma acc atomic PSD_N[k] = PSD_N[k] + 1; #pragma acc atomic @@ -88,19 +88,13 @@ TRACE SCATTER; } if (restore_neutron) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } %} SAVE %{ - DETECTOR_OUT_1D( - "4Pi Energy monitor", - "E_F [meV]","Intensity","E", - Emin, Emax, - ne, - &PSD_N[0],&PSD_p[0],&PSD_p2[0], - filename); + DETECTOR_OUT_1D ("4Pi Energy monitor", "E_F [meV]", "Intensity", "E", Emin, Emax, ne, &PSD_N[0], &PSD_p[0], &PSD_p2[0], filename); %} FINALLY %{ @@ -111,10 +105,10 @@ FINALLY %{ MCDISPLAY %{ - magnify(""); - circle("xy",0,0,0,radius); - circle("xz",0,0,0,radius); - circle("yz",0,0,0,radius); + magnify (""); + circle ("xy", 0, 0, 0, radius); + circle ("xz", 0, 0, 0, radius); + circle ("yz", 0, 0, 0, radius); %} END diff --git a/mcstas-comps/contrib/Exact_radial_coll.comp b/mcstas-comps/contrib/Exact_radial_coll.comp index 80c0a3654..379978a56 100644 --- a/mcstas-comps/contrib/Exact_radial_coll.comp +++ b/mcstas-comps/contrib/Exact_radial_coll.comp @@ -55,231 +55,215 @@ d=0.0001, verbose=0) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ DECLARE %{ -double alpha_in; -double alpha_out; -double beta_in; -double beta_out; -double theta; - double out_radius; -double iw; -double ow; -double divergence; + double alpha_in; + double alpha_out; + double beta_in; + double beta_out; + double theta; + double out_radius; + double iw; + double ow; + double divergence; %} INITIALIZE %{ -/* check for input parameters */ -if (radius <= 0) exit(printf("Exact_radial_coll: %s: radius must be positive\n", NAME_CURRENT_COMP)); - if (h_in <= 0) exit(printf("Exact_radial_coll: %s: h_in must be positive\n", NAME_CURRENT_COMP)); - if (h_out <= 0) exit(printf("Exact_radial_coll: %s: h_out must be positive\n", NAME_CURRENT_COMP)); - if (d <= 0) exit(printf("Exact_radial_coll: %s: d must be positive\n", NAME_CURRENT_COMP)); - if (nslit <= 0) exit(printf("Exact_radial_coll: %s: number of channels must be positive\n", NAME_CURRENT_COMP)); - if ((nslit - floor (nslit)) > 0) exit(printf("Exact_radial_coll: %s: number of channels must be an integer\n", NAME_CURRENT_COMP)); - if (length <= 0) exit(printf("Exact_radial_coll: %s: collimator length must be positive\n", NAME_CURRENT_COMP)); - if (theta_max <= theta_min) exit(printf("Exact_radial_coll: %s: theta_max must be greater than theta_min\n", NAME_CURRENT_COMP)); + /* check for input parameters */ + if (radius <= 0) + exit (printf ("Exact_radial_coll: %s: radius must be positive\n", NAME_CURRENT_COMP)); + if (h_in <= 0) + exit (printf ("Exact_radial_coll: %s: h_in must be positive\n", NAME_CURRENT_COMP)); + if (h_out <= 0) + exit (printf ("Exact_radial_coll: %s: h_out must be positive\n", NAME_CURRENT_COMP)); + if (d <= 0) + exit (printf ("Exact_radial_coll: %s: d must be positive\n", NAME_CURRENT_COMP)); + if (nslit <= 0) + exit (printf ("Exact_radial_coll: %s: number of channels must be positive\n", NAME_CURRENT_COMP)); + if ((nslit - floor (nslit)) > 0) + exit (printf ("Exact_radial_coll: %s: number of channels must be an integer\n", NAME_CURRENT_COMP)); + if (length <= 0) + exit (printf ("Exact_radial_coll: %s: collimator length must be positive\n", NAME_CURRENT_COMP)); + if (theta_max <= theta_min) + exit (printf ("Exact_radial_coll: %s: theta_max must be greater than theta_min\n", NAME_CURRENT_COMP)); theta_max *= DEG2RAD; theta_min *= DEG2RAD; theta = theta_max - theta_min; out_radius = radius + length; - beta_in = 2*asin(d / (2 * radius)); - beta_out= 2*asin(d / (2 * out_radius)); - if (theta < nslit*beta_in) exit(printf("Exact_radial_coll: %s: the %6.0f foils of %g [meter]\n" - "do not fit within the angular range theta = %4.2f [deg]\n", - NAME_CURRENT_COMP, nslit, d, theta*RAD2DEG)); - alpha_in = (theta - nslit*beta_in)/nslit; - alpha_out = (theta - nslit*beta_out)/nslit; - iw = 2*radius*sin((alpha_in/2)); - ow = 2*out_radius*sin((alpha_out/2)); - divergence=(iw+ow)/(sqrt(4*length*length-(ow-iw)*(ow-iw))); + beta_in = 2 * asin (d / (2 * radius)); + beta_out = 2 * asin (d / (2 * out_radius)); + if (theta < nslit * beta_in) + exit (printf ("Exact_radial_coll: %s: the %6.0f foils of %g [meter]\n" + "do not fit within the angular range theta = %4.2f [deg]\n", + NAME_CURRENT_COMP, nslit, d, theta* RAD2DEG)); + alpha_in = (theta - nslit * beta_in) / nslit; + alpha_out = (theta - nslit * beta_out) / nslit; + iw = 2 * radius * sin ((alpha_in / 2)); + ow = 2 * out_radius * sin ((alpha_out / 2)); + divergence = (iw + ow) / (sqrt (4 * length * length - (ow - iw) * (ow - iw))); if (verbose) { - printf("Exact_radial_coll: %s: foil thickness is %.2g [millimeter]\n", NAME_CURRENT_COMP, d*1000); - printf(" opening each input slit [%.3g:%.0f] [millimeter]\n", iw*1000, h_in*1000); - printf(" opening each output slit [%.3g:%.0f] [millimeter]\n", ow*1000, h_out*1000); - printf(" divergence per channel is %g [min] \n", divergence*RAD2MIN); + printf ("Exact_radial_coll: %s: foil thickness is %.2g [millimeter]\n", NAME_CURRENT_COMP, d * 1000); + printf (" opening each input slit [%.3g:%.0f] [millimeter]\n", iw * 1000, h_in * 1000); + printf (" opening each output slit [%.3g:%.0f] [millimeter]\n", ow * 1000, h_out * 1000); + printf (" divergence per channel is %g [min] \n", divergence * RAD2MIN); } %} TRACE %{ double phi, t0, t1, t2, t3; - int intersect; - long input_chan, output_chan; + int intersect; + long input_chan, output_chan; double input_theta, output_theta; - double input_center,output_center; + double input_center, output_center; double window_theta; - char ok=0; + char ok = 0; /* first compute intersection time with input cylinder */ - intersect=cylinder_intersect(&t0,&t3,x,y,z,vx,vy,vz,radius,h_in); - if (!intersect) ABSORB; - else if (t3 > t0) t0 = t3; - - intersect=cylinder_intersect(&t1,&t2,x,y,z,vx,vy,vz,out_radius,h_out); - if (!intersect) ABSORB; - else if (t2 > t1) t1 = t2; + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, h_in); + if (!intersect) + ABSORB; + else if (t3 > t0) + t0 = t3; + + intersect = cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, out_radius, h_out); + if (!intersect) + ABSORB; + else if (t2 > t1) + t1 = t2; /* get index of input slit */ if (t0 > 0 && t1 > t0) { - PROP_DT(t0); - input_theta = atan2(x, z); - /* channel number (start at 0) */ - window_theta = (theta_max - theta_min)/nslit; - input_chan = floor((input_theta - theta_min)/window_theta); - if (input_chan >= 0 && input_chan < nslit && fabs(y) < h_in/2) ok=1; + PROP_DT (t0); + input_theta = atan2 (x, z); + /* channel number (start at 0) */ + window_theta = (theta_max - theta_min) / nslit; + input_chan = floor ((input_theta - theta_min) / window_theta); + if (input_chan >= 0 && input_chan < nslit && fabs (y) < h_in / 2) + ok = 1; if (ok) { - input_center= theta_min + input_chan*window_theta + (window_theta)/2; - /* are we outside the soller or in the foil? */ - phi = input_theta - input_center; - if (fabs(phi) > alpha_in/2) ABSORB; /* inside the foil*/ - SCATTER; + input_center = theta_min + input_chan * window_theta + (window_theta) / 2; + /* are we outside the soller or in the foil? */ + phi = input_theta - input_center; + if (fabs (phi) > alpha_in / 2) + ABSORB; /* inside the foil*/ + SCATTER; /* propagate to output radius */ - PROP_DT(t1-t0); + PROP_DT (t1 - t0); SCATTER; - output_theta = atan2(x, z); - /* channel number (start at 0) */ - output_chan = floor((output_theta - theta_min)/window_theta); - /* did we change channel ? */ - if (output_chan != input_chan) ABSORB; /* changed slit */ - output_center= theta_min + output_chan*window_theta - + (window_theta)/2; - /* are we outside the soller */ - phi = output_theta -output_center; - if (fabs(phi) > alpha_out/2 || fabs(y) > h_out/2) ABSORB; /* outside output slit */ + output_theta = atan2 (x, z); + /* channel number (start at 0) */ + output_chan = floor ((output_theta - theta_min) / window_theta); + /* did we change channel ? */ + if (output_chan != input_chan) + ABSORB; /* changed slit */ + output_center = theta_min + output_chan * window_theta + (window_theta) / 2; + /* are we outside the soller */ + phi = output_theta - output_center; + if (fabs (phi) > alpha_out / 2 || fabs (y) > h_out / 2) + ABSORB; /* outside output slit */ } /* else we pass aside the entrance window of radial collimator */ else { /* propagate to output radius */ - PROP_DT(t1-t0); + PROP_DT (t1 - t0); SCATTER; - output_theta = atan2(x, z); - /* channel number (start at 0) */ - output_chan = floor((output_theta - theta_min)/window_theta); - /* are we come from outside into the soller or in the foil?*/ - if (output_chan >= 0 || output_chan < nslit) ABSORB; + output_theta = atan2 (x, z); + /* channel number (start at 0) */ + output_chan = floor ((output_theta - theta_min) / window_theta); + /* are we come from outside into the soller or in the foil?*/ + if (output_chan >= 0 || output_chan < nslit) + ABSORB; } /* else we pass aside the exit window of radial collimator */ - } /* else did not encounter collimator */ - + } /* else did not encounter collimator */ %} MCDISPLAY %{ int i; double theta1, theta2, theta3, theta4; - double x_in_l, z_in_l, x_in_r, z_in_r; + double x_in_l, z_in_l, x_in_r, z_in_r; double x_out_l, z_out_l, x_out_r, z_out_r; double window_theta, y1, y2; - window_theta = alpha_in + beta_in; - y1 = h_in/2; - y2 = h_out/2; + y1 = h_in / 2; + y2 = h_out / 2; theta1 = theta_min; - theta3 = theta1+beta_in/2; - theta4 = theta1+beta_out/2; + theta3 = theta1 + beta_in / 2; + theta4 = theta1 + beta_out / 2; - z_in_l = radius*cos(theta1); - x_in_l = radius*sin(theta1); - z_in_r = radius*cos(theta3); - x_in_r = radius*sin(theta3); + z_in_l = radius * cos (theta1); + x_in_l = radius * sin (theta1); + z_in_r = radius * cos (theta3); + x_in_r = radius * sin (theta3); - z_out_l = out_radius*cos(theta1); - x_out_l = out_radius*sin(theta1); - z_out_r = out_radius*cos(theta4); - x_out_r = out_radius*sin(theta4); + z_out_l = out_radius * cos (theta1); + x_out_l = out_radius * sin (theta1); + z_out_r = out_radius * cos (theta4); + x_out_r = out_radius * sin (theta4); - multiline(5, - x_in_l, -y1, z_in_l, - x_in_l, y1, z_in_l, - x_out_l, y2, z_out_l, - x_out_l,-y2, z_out_l, - x_in_l, -y1, z_in_l); + multiline (5, x_in_l, -y1, z_in_l, x_in_l, y1, z_in_l, x_out_l, y2, z_out_l, x_out_l, -y2, z_out_l, x_in_l, -y1, z_in_l); - line(x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); - line(x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); - line(x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); - line(x_out_l, -y2, z_out_l, x_out_r,-y2, z_out_r); + line (x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); + line (x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); + line (x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); + line (x_out_l, -y2, z_out_l, x_out_r, -y2, z_out_r); - multiline(5, - x_in_r, -y1, z_in_r, - x_in_r, y1, z_in_r, - x_out_r, y2, z_out_r, - x_out_r,-y2, z_out_r, - x_in_r, -y1, z_in_r); + multiline (5, x_in_r, -y1, z_in_r, x_in_r, y1, z_in_r, x_out_r, y2, z_out_r, x_out_r, -y2, z_out_r, x_in_r, -y1, z_in_r); for (i = 1; i < nslit; i++) { - theta1 = i*window_theta+theta_min-beta_in/2; - theta2 = i*window_theta+theta_min+beta_in/2; - theta3 = i*window_theta+theta_min-beta_out/2; - theta4 = i*window_theta+theta_min+beta_out/2; - - z_in_l = radius*cos(theta1); - x_in_l = radius*sin(theta1); - z_in_r = radius*cos(theta2); - x_in_r = radius*sin(theta2); - - z_out_l = out_radius*cos(theta3); - x_out_l = out_radius*sin(theta3); - z_out_r = out_radius*cos(theta4); - x_out_r = out_radius*sin(theta4); + theta1 = i * window_theta + theta_min - beta_in / 2; + theta2 = i * window_theta + theta_min + beta_in / 2; + theta3 = i * window_theta + theta_min - beta_out / 2; + theta4 = i * window_theta + theta_min + beta_out / 2; + + z_in_l = radius * cos (theta1); + x_in_l = radius * sin (theta1); + z_in_r = radius * cos (theta2); + x_in_r = radius * sin (theta2); + + z_out_l = out_radius * cos (theta3); + x_out_l = out_radius * sin (theta3); + z_out_r = out_radius * cos (theta4); + x_out_r = out_radius * sin (theta4); /* left side */ - multiline(5, - x_in_l, -y1, z_in_l, - x_in_l, y1, z_in_l, - x_out_l, y2, z_out_l, - x_out_l,-y2, z_out_l, - x_in_l, -y1, z_in_l); - /* left -> right lines */ - line(x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); - line(x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); - line(x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); - line(x_out_l, -y2, z_out_l, x_out_r,-y2, z_out_r); - /* right side */ - multiline(5, - x_in_r, -y1, z_in_r, - x_in_r, y1, z_in_r, - x_out_r, y2, z_out_r, - x_out_r,-y2, z_out_r, - x_in_r, -y1, z_in_r); + multiline (5, x_in_l, -y1, z_in_l, x_in_l, y1, z_in_l, x_out_l, y2, z_out_l, x_out_l, -y2, z_out_l, x_in_l, -y1, z_in_l); + /* left -> right lines */ + line (x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); + line (x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); + line (x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); + line (x_out_l, -y2, z_out_l, x_out_r, -y2, z_out_r); + /* right side */ + multiline (5, x_in_r, -y1, z_in_r, x_in_r, y1, z_in_r, x_out_r, y2, z_out_r, x_out_r, -y2, z_out_r, x_in_r, -y1, z_in_r); } /* remaining bits */ theta1 = theta_max; - theta3 = theta1-beta_in/2; - theta4 = theta1-beta_out/2; - - z_in_l = radius*cos(theta1); - x_in_l = radius*sin(theta1); - z_in_r = radius*cos(theta3); - x_in_r = radius*sin(theta3); + theta3 = theta1 - beta_in / 2; + theta4 = theta1 - beta_out / 2; - z_out_l = out_radius*cos(theta1); - x_out_l = out_radius*sin(theta1); - z_out_r = out_radius*cos(theta4); - x_out_r = out_radius*sin(theta4); + z_in_l = radius * cos (theta1); + x_in_l = radius * sin (theta1); + z_in_r = radius * cos (theta3); + x_in_r = radius * sin (theta3); - multiline(5, - x_in_l, -y1, z_in_l, - x_in_l, y1, z_in_l, - x_out_l, y2, z_out_l, - x_out_l,-y2, z_out_l, - x_in_l, -y1, z_in_l); + z_out_l = out_radius * cos (theta1); + x_out_l = out_radius * sin (theta1); + z_out_r = out_radius * cos (theta4); + x_out_r = out_radius * sin (theta4); - line(x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); - line(x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); - line(x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); - line(x_out_l, -y2, z_out_l, x_out_r,-y2, z_out_r); + multiline (5, x_in_l, -y1, z_in_l, x_in_l, y1, z_in_l, x_out_l, y2, z_out_l, x_out_l, -y2, z_out_l, x_in_l, -y1, z_in_l); - multiline(5, - x_in_r, -y1, z_in_r, - x_in_r, y1, z_in_r, - x_out_r, y2, z_out_r, - x_out_r,-y2, z_out_r, - x_in_r, -y1, z_in_r); + line (x_in_l, y1, z_in_l, x_in_r, y1, z_in_r); + line (x_in_l, -y1, z_in_l, x_in_r, -y1, z_in_r); + line (x_out_l, y2, z_out_l, x_out_r, y2, z_out_r); + line (x_out_l, -y2, z_out_l, x_out_r, -y2, z_out_r); + multiline (5, x_in_r, -y1, z_in_r, x_in_r, y1, z_in_r, x_out_r, y2, z_out_r, x_out_r, -y2, z_out_r, x_in_r, -y1, z_in_r); %} END diff --git a/mcstas-comps/contrib/FermiChopper_ILL.comp b/mcstas-comps/contrib/FermiChopper_ILL.comp index 072664af7..466df7e50 100644 --- a/mcstas-comps/contrib/FermiChopper_ILL.comp +++ b/mcstas-comps/contrib/FermiChopper_ILL.comp @@ -96,142 +96,148 @@ zero_time=0, xwidth=0, verbose=0) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -#ifndef FCILL_TimeAccuracy -#define FCILL_TimeAccuracy 1e-8 -#define FCILL_MAXITER 10 -/* Definition of internal variable structure: all counters */ -struct FermiChopper_ILL_struct { - -/** other variables ********************************/ -double omega, t0; /* chopper rotation */ -}; - - -/**************** DECLARING FUNCTIONS ***************************************/ - -/*********** ORTHOGONAL TRANSFORMATION INTO ROTATING FRAME ******************/ - -/************ X - component ********************/ -#pragma acc routine seq -double xstrich(double X, double Z, double T, double omega, double t0){ - return( X*cos(omega*(T-t0))+Z*sin(omega*(T-t0)) ); -} - -/************ Z - component ********************/ -#pragma acc routine seq -double zstrich(double X, double Z, double T, double omega, double t0){ - return( Z*cos(omega*(T-t0))-X*sin(omega*(T-t0)) ); -} - -/*************************NUMERICAL METHODS *********************************/ - -/*************************** SECANT METHOD FOR... ***************************/ - -/****************************...X-component *********************************/ -#pragma acc routine seq -double xsecant(double x, double z, double vx, double vz, - double t, double dt, double d, double omega, double t0){ - - double dt1 = 1; - double counter = 0; - double t1 = 0; - double t2 = dt; - double xr1 = xstrich(x,z,t, omega, t0)-d; - double xr2 = xstrich(x+vx*t2,z+vz*t2,t+t2, omega, t0)-d; - double sign; - - while ((fabs(dt1) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER) && (xr2-xr1)){ - counter++; - dt1 = (t2-t1)*xr2/(xr2-xr1); - t2 = t1; - xr1 = xr2; - t1 += dt1; - xr2 = xstrich(x+vx*t1,z+vz*t1,t+t1, omega, t0)-d; - } - - if(counter >= FCILL_MAXITER) t1 = -2; - - return(t1); -} + #ifndef FCILL_TimeAccuracy + #define FCILL_TimeAccuracy 1e-8 + #define FCILL_MAXITER 10 + /* Definition of internal variable structure: all counters */ + struct FermiChopper_ILL_struct { + /** other variables ********************************/ + double omega, t0; /* chopper rotation */ + }; -/****************************...Z-component *********************************/ -#pragma acc routine seq -double zsecant(double x, double z, double vx, double vz, - double t, double dt, double d, double omega, double t0) { + /**************** DECLARING FUNCTIONS ***************************************/ - double t1 = 0; - double t2 = dt; - double dt1 = 1; - double counter = 0; - double zr1 = zstrich(x,z,t, omega, t0)-d; - double zr2 = zstrich(x+vx*t2,z+vz*t2,t+t2, omega, t0)-d; + /*********** ORTHOGONAL TRANSFORMATION INTO ROTATING FRAME ******************/ - while ((fabs(dt1) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER) && (zr2-zr1)){ - counter++; - dt1 = (t2-t1)*zr2/(zr2-zr1); - t2 = t1; - zr1 = zr2; - t1 += dt1; - zr2 = zstrich(x+vx*t1,z+vz*t1,t+t1, omega, t0)-d; + /************ X - component ********************/ + #pragma acc routine seq + double + xstrich (double X, double Z, double T, double omega, double t0) { + return (X * cos (omega * (T - t0)) + Z * sin (omega * (T - t0))); } - if(counter >= FCILL_MAXITER) t1=-1; + /************ Z - component ********************/ + #pragma acc routine seq + double + zstrich (double X, double Z, double T, double omega, double t0) { + return (Z * cos (omega * (T - t0)) - X * sin (omega * (T - t0))); + } - return(t1); -} + /*************************NUMERICAL METHODS *********************************/ + + /*************************** SECANT METHOD FOR... ***************************/ + + /****************************...X-component *********************************/ + #pragma acc routine seq + double + xsecant (double x, double z, double vx, double vz, double t, double dt, double d, double omega, double t0) { + + double dt1 = 1; + double counter = 0; + double t1 = 0; + double t2 = dt; + double xr1 = xstrich (x, z, t, omega, t0) - d; + double xr2 = xstrich (x + vx * t2, z + vz * t2, t + t2, omega, t0) - d; + double sign; + + while ((fabs (dt1) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER) && (xr2 - xr1)) { + counter++; + dt1 = (t2 - t1) * xr2 / (xr2 - xr1); + t2 = t1; + xr1 = xr2; + t1 += dt1; + xr2 = xstrich (x + vx * t1, z + vz * t1, t + t1, omega, t0) - d; + } + if (counter >= FCILL_MAXITER) + t1 = -2; -/*************************** INTERPOLATION METHOD FOR... ********************/ + return (t1); + } -/****************************...X-component *********************************/ -#pragma acc routine seq -double xinterpolation(double x, double z, double vx, double vz, - double t, double dt, double d, double omega, double t0){ + /****************************...Z-component *********************************/ + #pragma acc routine seq + double + zsecant (double x, double z, double vx, double vz, double t, double dt, double d, double omega, double t0) { + + double t1 = 0; + double t2 = dt; + double dt1 = 1; + double counter = 0; + double zr1 = zstrich (x, z, t, omega, t0) - d; + double zr2 = zstrich (x + vx * t2, z + vz * t2, t + t2, omega, t0) - d; + + while ((fabs (dt1) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER) && (zr2 - zr1)) { + counter++; + dt1 = (t2 - t1) * zr2 / (zr2 - zr1); + t2 = t1; + zr1 = zr2; + t1 += dt1; + zr2 = zstrich (x + vx * t1, z + vz * t1, t + t1, omega, t0) - d; + } - double sign; - double xr3=1, t3=0, t1=0, t2=dt, dt1=dt; - double counter = 0; - double xr1 = xstrich(x,z,t, omega, t0)-d; - double xr2 = xstrich(x+vx*dt,z+vz*dt,t+dt, omega, t0)-d; + if (counter >= FCILL_MAXITER) + t1 = -1; - while ((fabs(xr3) > FCILL_TimeAccuracy)&&(counter < FCILL_MAXITER)){ - counter++; - t3 = (t1+t2)*0.5; - xr3 = xstrich(x+(vx*(t3)),z+(vz*(t3)),t+t3, omega, t0)-d; - xr2 = xstrich(x+(vx*(t2)),z+(vz*(t2)),t+t2, omega, t0)-d; - if(xr2*xr3<0) t1=t3; - else t2=t3; + return (t1); } - if(counter >= FCILL_MAXITER) t3=-1; + /*************************** INTERPOLATION METHOD FOR... ********************/ + + /****************************...X-component *********************************/ + #pragma acc routine seq + double + xinterpolation (double x, double z, double vx, double vz, double t, double dt, double d, double omega, double t0) { + + double sign; + double xr3 = 1, t3 = 0, t1 = 0, t2 = dt, dt1 = dt; + double counter = 0; + double xr1 = xstrich (x, z, t, omega, t0) - d; + double xr2 = xstrich (x + vx * dt, z + vz * dt, t + dt, omega, t0) - d; + + while ((fabs (xr3) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER)) { + counter++; + t3 = (t1 + t2) * 0.5; + xr3 = xstrich (x + (vx * (t3)), z + (vz * (t3)), t + t3, omega, t0) - d; + xr2 = xstrich (x + (vx * (t2)), z + (vz * (t2)), t + t2, omega, t0) - d; + if (xr2 * xr3 < 0) + t1 = t3; + else + t2 = t3; + } - return(t3); -} + if (counter >= FCILL_MAXITER) + t3 = -1; + return (t3); + } -/****************************...Z-component *********************************/ -#pragma acc routine seq -double zinterpolation(double x, double z, double vx, double vz, - double t, double dt, double d, double omega, double t0){ + /****************************...Z-component *********************************/ + #pragma acc routine seq + double + zinterpolation (double x, double z, double vx, double vz, double t, double dt, double d, double omega, double t0) { + + double counter = 0; + double zr3 = 1, zr2 = 0, t3 = 0, t1 = 0, t2 = dt; + + while ((fabs (zr3) > FCILL_TimeAccuracy) && (counter < FCILL_MAXITER)) { + counter++; + t3 = (t1 + t2) * 0.5; + zr3 = zstrich (x + (vx * (t3)), z + (vz * (t3)), t + t3, omega, t0) - d; + zr2 = zstrich (x + (vx * (t2)), z + (vz * (t2)), t + t2, omega, t0) - d; + if (zr2 * zr3 < 0) + t1 = t3; + else + t2 = t3; + } - double counter = 0; - double zr3=1,zr2=0,t3=0,t1=0,t2=dt; + if (counter >= FCILL_MAXITER) + t3 = -1; - while ((fabs(zr3)>FCILL_TimeAccuracy)&&(counter= FCILL_MAXITER) t3=-1; - - return(t3); -} -#endif + #endif %} DECLARE @@ -242,52 +248,62 @@ DECLARE INITIALIZE %{ -/************************* INITIALIZE COUNTERS ******************************/ + /************************* INITIALIZE COUNTERS ******************************/ int i; -/************************ CALCULATION CONSTANTS *****************************/ - FCVars.omega = 2*PI*nu; - if (nu && phase) FCVars.t0 = -phase/360.0/nu; + /************************ CALCULATION CONSTANTS *****************************/ + FCVars.omega = 2 * PI * nu; + if (nu && phase) + FCVars.t0 = -phase / 360.0 / nu; /* check of input parameters */ - if (m < 0) m == 0; + if (m < 0) + m == 0; if (radius <= 0) { - printf("FermiChopper_ILL: %s: FATAL: unrealistic cylinder radius radius=%g [m]\n", NAME_CURRENT_COMP, radius); - exit(-1); + printf ("FermiChopper_ILL: %s: FATAL: unrealistic cylinder radius radius=%g [m]\n", NAME_CURRENT_COMP, radius); + exit (-1); } - if (yheight <= 0) - exit(printf("FermiChopper_ILL: %s: FATAL: unrealistic cylinder yheight =%g [m]\n", NAME_CURRENT_COMP, yheight)); - if (xwidth > 0 && xwidth < radius*2 && nslit > 0) { - w = xwidth/nslit; + if (yheight <= 0) + exit (printf ("FermiChopper_ILL: %s: FATAL: unrealistic cylinder yheight =%g [m]\n", NAME_CURRENT_COMP, yheight)); + if (xwidth > 0 && xwidth < radius * 2 && nslit > 0) { + w = xwidth / nslit; } if (w <= 0) { - printf("FermiChopper_ILL: %s: FATAL: Slits in the package have unrealistic width w=%g [m]\n", NAME_CURRENT_COMP, w); - exit(-1); + printf ("FermiChopper_ILL: %s: FATAL: Slits in the package have unrealistic width w=%g [m]\n", NAME_CURRENT_COMP, w); + exit (-1); } - if (nslit*w > radius*2) { - nslit = floor(radius/w); - printf("FermiChopper_ILL: %s: Too many slits to fit in the cylinder\n" - "Adjusting nslit=%f\n", NAME_CURRENT_COMP, nslit); + if (nslit * w > radius * 2) { + nslit = floor (radius / w); + printf ("FermiChopper_ILL: %s: Too many slits to fit in the cylinder\n" + "Adjusting nslit=%f\n", + NAME_CURRENT_COMP, nslit); } - if (length > radius*2) { - length = sqrt(radius*radius - nslit*w*nslit*w/4); - printf("FermiChopper_ILL: %s: Slit package is longer than the whole\n" - "chopper cylinder. Adjusting length=%g [m]\n", NAME_CURRENT_COMP, length); + if (length > radius * 2) { + length = sqrt (radius * radius - nslit * w * nslit * w / 4); + printf ("FermiChopper_ILL: %s: Slit package is longer than the whole\n" + "chopper cylinder. Adjusting length=%g [m]\n", + NAME_CURRENT_COMP, length); } if (eff <= 0 || eff > 1) { eff = 0.95; - printf("FermiChopper_ILL: %s: Efficiency is unrealistic\n" - "Adjusting eff=%f\n", NAME_CURRENT_COMP, eff); + printf ("FermiChopper_ILL: %s: Efficiency is unrealistic\n" + "Adjusting eff=%f\n", + NAME_CURRENT_COMP, eff); + } + if (Qc <= 0) { + Qc = 0.02176; + m = 0; + R0 = 0; } - if (Qc <= 0) { Qc = 0.02176; m = 0; R0=0; } - if (W <= 0) W=1e-6; - + if (W <= 0) + W = 1e-6; + if (verbose && nu) - printf("FermiChopper_ILL: %s: frequency nu=%g [Hz] %g [rpm], time frame=%g [s] phase=%g [deg]\n" - , NAME_CURRENT_COMP, nu, nu*60, 2/nu, -FCVars.t0*360*nu); - + printf ("FermiChopper_ILL: %s: frequency nu=%g [Hz] %g [rpm], time frame=%g [s] phase=%g [deg]\n", NAME_CURRENT_COMP, nu, nu * 60, 2 / nu, + -FCVars.t0 * 360 * nu); + /* fix for the wrong coordinate frame orientation to come back to McStas XYZ system */ FCVars.omega *= -1; %} @@ -298,17 +314,17 @@ TRACE /** local CALCULATION VARIABLES**************************************/ /** Interaction with slitpacket ***************************/ - double slit_input; /* length of the slits */ - double zr1,zr2; /* distance to slitpacket entrance/exit in rotating frame */ - double xr1,xr2; /* X entrance/exit position in rotating frame */ + double slit_input; /* length of the slits */ + double zr1, zr2; /* distance to slitpacket entrance/exit in rotating frame */ + double xr1, xr2; /* X entrance/exit position in rotating frame */ /** Variables for calculating interaction with blades ***************/ - double m1,m2; /* slope of the tangents */ - double b1,b2; /* y-intersection of tangent */ + double m1, m2; /* slope of the tangents */ + double b1, b2; /* y-intersection of tangent */ /** Reflections ***********************************************/ double t3a, t3b, distance_Wa, distance_Wb; - double n1,n2,n3,n4; + double n1, n2, n3, n4; /** variables used for calculating new velocities after reflection **/ double q; @@ -316,371 +332,346 @@ TRACE double arg; /** Multiple Reflections ******************************/ - int loopcounter=0; /* How many reflections happen? */ + int loopcounter = 0; /* How many reflections happen? */ /** Time variables *********************************/ - double t3; /* interaction time */ - double dt; /* interaction intervals */ - double t1,t2; /* cylinder intersection time */ + double t3; /* interaction time */ + double dt; /* interaction intervals */ + double t1, t2; /* cylinder intersection time */ - -/************** test, if the neutron interacts with the cylinder ***/ + /************** test, if the neutron interacts with the cylinder ***/ if (cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius, yheight)) { if (t1 <= 0) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron started inside the cylinder, t1=%g (enter)\n", - NAME_CURRENT_COMP, t1); - ABSORB; /* Neutron started inside the cylinder */ + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron started inside the cylinder, t1=%g (enter)\n", NAME_CURRENT_COMP, t1); + ABSORB; /* Neutron started inside the cylinder */ } - dt=t2-t1; /* total time of flight inside the cylinder */ - PROP_DT(t1); /* Propagates neutron to entrance of the cylinder */ - + dt = t2 - t1; /* total time of flight inside the cylinder */ + PROP_DT (t1); /* Propagates neutron to entrance of the cylinder */ + if (verbose > 2) - printf("FermiChopper_ILL: %s: PROP_DT t1=%8.3g t2=%8.3g xyz=[%8.3g %8.3g %8.3g] v=[%8.3g %8.3g %8.3g] t=%8.3g (IN cyl).\n", - NAME_CURRENT_COMP, t1, t2, x,y,z,vx,vy,vz,t); + printf ("FermiChopper_ILL: %s: PROP_DT t1=%8.3g t2=%8.3g xyz=[%8.3g %8.3g %8.3g] v=[%8.3g %8.3g %8.3g] t=%8.3g (IN cyl).\n", NAME_CURRENT_COMP, t1, t2, x, + y, z, vx, vy, vz, t); - if(dt > fabs(0.5/FCVars.omega*2*PI) && verbose) { - printf("FermiChopper_ILL: %s: Frequency too low. Method will fail.\n" - " Absorbing neutron\n", NAME_CURRENT_COMP); + if (dt > fabs (0.5 / FCVars.omega * 2 * PI) && verbose) { + printf ("FermiChopper_ILL: %s: Frequency too low. Method will fail.\n" + " Absorbing neutron\n", + NAME_CURRENT_COMP); ABSORB; } - /* Checks if neutron enters or leaves from top or bottom of cylinder. */ - if ( fabs(y) > yheight/2 || - fabs(y+vy*dt) > yheight/2 ) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron hits top/bottom of cylinder, y=%8.3g (enter)\n", - NAME_CURRENT_COMP, y); + /* Checks if neutron enters or leaves from top or bottom of cylinder. */ + if (fabs (y) > yheight / 2 || fabs (y + vy * dt) > yheight / 2) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron hits top/bottom of cylinder, y=%8.3g (enter)\n", NAME_CURRENT_COMP, y); ABSORB; } - /* checking wether the neutron can enter the chopper (slit channel) */ - xr1 = xstrich(x,z,t, FCVars.omega, FCVars.t0); - if(fabs(xr1)>=nslit*w/2) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron X is outside cylinder aperture, xp1=%8.3g (enter)\n", - NAME_CURRENT_COMP, xr1); + /* checking wether the neutron can enter the chopper (slit channel) */ + xr1 = xstrich (x, z, t, FCVars.omega, FCVars.t0); + if (fabs (xr1) >= nslit * w / 2) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron X is outside cylinder aperture, xp1=%8.3g (enter)\n", NAME_CURRENT_COMP, xr1); ABSORB; } - /*********************** PROPAGATE TO SLIT PACKAGE **************************/ - + /*********************** PROPAGATE TO SLIT PACKAGE **************************/ /* Checking on which side of the Chopper the Neutron enters******/ - slit_input = 0.5*length; - zr1 = zstrich(x,z,t, FCVars.omega, FCVars.t0); - zr2 = zstrich(x+vx*dt,z+vz*dt,t+dt, FCVars.omega, FCVars.t0); - if(zr1 < 0) slit_input *= -1; + slit_input = 0.5 * length; + zr1 = zstrich (x, z, t, FCVars.omega, FCVars.t0); + zr2 = zstrich (x + vx * dt, z + vz * dt, t + dt, FCVars.omega, FCVars.t0); + if (zr1 < 0) + slit_input *= -1; /* Checking if the Neutron will hit the slits (Z) */ - zr1 -= slit_input; - zr2 -= slit_input; + zr1 -= slit_input; + zr2 -= slit_input; - if (zr2*zr1>0) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron Z does not change sign, zr1=%8.3g zr2=%8.3g (enter)\n", - NAME_CURRENT_COMP, zr1,zr2); + if (zr2 * zr1 > 0) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron Z does not change sign, zr1=%8.3g zr2=%8.3g (enter)\n", NAME_CURRENT_COMP, zr1, zr2); ABSORB; } /* Calculating where/when Neutron hits the slits (Z) */ - t3 = zsecant(x,z,vx,vz,t,dt,slit_input, FCVars.omega, FCVars.t0); + t3 = zsecant (x, z, vx, vz, t, dt, slit_input, FCVars.omega, FCVars.t0); - if((t3 < 0)||(t3 > dt)) { - t3 = zinterpolation(x,z,vx,vz,t,dt,slit_input, FCVars.omega, FCVars.t0); + if ((t3 < 0) || (t3 > dt)) { + t3 = zinterpolation (x, z, vx, vz, t, dt, slit_input, FCVars.omega, FCVars.t0); } - if((t3 < 0)||(t3 > dt)) { - if (verbose) - printf("FermiChopper_ILL: %s: Can not reach entrance of slits. dt=%g t3=%g\n", NAME_CURRENT_COMP, dt, t3); + if ((t3 < 0) || (t3 > dt)) { + if (verbose) + printf ("FermiChopper_ILL: %s: Can not reach entrance of slits. dt=%g t3=%g\n", NAME_CURRENT_COMP, dt, t3); ABSORB; } /* Propagating whole system to that point */ - PROP_DT(t3); + PROP_DT (t3); dt -= t3; SCATTER; - + if (verbose > 2) - printf("FermiChopper_ILL: %s: PROP_DT t3=%8.3g dt=%8.3g xyz=[%8.3g %8.3g %8.3g] length=%g (slit enter).\n", - NAME_CURRENT_COMP, t3, dt, x,y,z, slit_input); + printf ("FermiChopper_ILL: %s: PROP_DT t3=%8.3g dt=%8.3g xyz=[%8.3g %8.3g %8.3g] length=%g (slit enter).\n", NAME_CURRENT_COMP, t3, dt, x, y, z, + slit_input); /* Checking if neutron hits the slits entrance window (X) */ - xr1 = xstrich(x,z,t, FCVars.omega, FCVars.t0); - if(fabs(xr1) >= nslit*w/2) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron X is outside slit package, xp1=%8.3g (enter)\n", - NAME_CURRENT_COMP, xr1); + xr1 = xstrich (x, z, t, FCVars.omega, FCVars.t0); + if (fabs (xr1) >= nslit * w / 2) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron X is outside slit package, xp1=%8.3g (enter)\n", NAME_CURRENT_COMP, xr1); ABSORB; } /* Calculating where/when Neutron leaves the slits (Z) */ - t3 = zsecant(x,z,vx,vz,t,dt,-slit_input, FCVars.omega, FCVars.t0); - if((t3 < 0) || (t3 > dt)){ - t3 = zinterpolation(x,z,vx,vz,t,dt,-slit_input, FCVars.omega, FCVars.t0); + t3 = zsecant (x, z, vx, vz, t, dt, -slit_input, FCVars.omega, FCVars.t0); + if ((t3 < 0) || (t3 > dt)) { + t3 = zinterpolation (x, z, vx, vz, t, dt, -slit_input, FCVars.omega, FCVars.t0); } - if((t3 <= 0) || (t3 > dt)){ - if (verbose) - printf("FermiChopper_ILL: %s: Can not reach exit of slits. dt=%8.3g t3=%8.3g\n", NAME_CURRENT_COMP, dt, t3); + if ((t3 <= 0) || (t3 > dt)) { + if (verbose) + printf ("FermiChopper_ILL: %s: Can not reach exit of slits. dt=%8.3g t3=%8.3g\n", NAME_CURRENT_COMP, dt, t3); ABSORB; - } else dt=t3; + } else + dt = t3; - /********************* PROPAGATION INSIDE THE SLIT PACKET *******************/ + /********************* PROPAGATION INSIDE THE SLIT PACKET *******************/ /* Which slit was hit ? */ - n1 = floor(xr1/w); + n1 = floor (xr1 / w); + /******************* BEGIN LOOP FOR MULTIPLE REFLECTIONS ********************/ - /******************* BEGIN LOOP FOR MULTIPLE REFLECTIONS ********************/ + for (loopcounter; loopcounter <= FCILL_MAXITER; loopcounter++) { + double dt_to_tangent = 0; /* time shift to go to tangent intersection */ - for(loopcounter; loopcounter<=FCILL_MAXITER;loopcounter++){ - double dt_to_tangent=0; /* time shift to go to tangent intersection */ + /* Calculate most probable time for interaction with blades by using tangents */ + m1 = xstrich (vx, vz, t, FCVars.omega, FCVars.t0) + FCVars.omega * zstrich (x, z, t, FCVars.omega, FCVars.t0); + m2 = xstrich (vx, vz, t + dt, FCVars.omega, FCVars.t0) + FCVars.omega * zstrich (x + vx * dt, z + vz * dt, t + dt, FCVars.omega, FCVars.t0); - /* Calculate most probable time for interaction with blades by using tangents */ - m1 = xstrich(vx,vz,t, FCVars.omega, FCVars.t0) - + FCVars.omega * zstrich(x,z,t, FCVars.omega, FCVars.t0); - m2 = xstrich(vx,vz,t+dt, FCVars.omega, FCVars.t0) - + FCVars.omega * zstrich(x+vx*dt,z+vz*dt,t+dt,FCVars.omega,FCVars.t0); + b1 = xstrich (x, z, t, FCVars.omega, FCVars.t0) - m1 * t; + b2 = xstrich (x + vx * dt, z + vz * dt, t + dt, FCVars.omega, FCVars.t0) - m2 * (t + dt); - b1 = xstrich(x,z,t, FCVars.omega, FCVars.t0) - m1*t; - b2 = xstrich(x+vx*dt,z+vz*dt,t+dt, FCVars.omega, FCVars.t0) - m2*(t+dt); - - if (m1-m2) dt_to_tangent = ((b2-b1)/(m1-m2))-t; - else dt_to_tangent = -1; + if (m1 - m2) + dt_to_tangent = ((b2 - b1) / (m1 - m2)) - t; + else + dt_to_tangent = -1; /* If method with tangents doesn't succeed, just take the middle of the interval */ - if((dt_to_tangent < 0)||(dt_to_tangent > dt)) dt_to_tangent=dt*0.5; + if ((dt_to_tangent < 0) || (dt_to_tangent > dt)) + dt_to_tangent = dt * 0.5; /* Calculate different positions for the neutron to determine interaction. */ /*...at the end of the slit: */ - n2 = floor(xstrich(x+(vx*dt),z+(vz*dt),t+dt, FCVars.omega, FCVars.t0)/w); + n2 = floor (xstrich (x + (vx * dt), z + (vz * dt), t + dt, FCVars.omega, FCVars.t0) / w); /*...at the before calculated t3: tangent intersection point */ - n3 = floor(xstrich(x+(vx*dt_to_tangent),z+(vz*dt_to_tangent),t+dt_to_tangent, FCVars.omega, FCVars.t0)/w); + n3 = floor (xstrich (x + (vx * dt_to_tangent), z + (vz * dt_to_tangent), t + dt_to_tangent, FCVars.omega, FCVars.t0) / w); if (verbose > 2) - printf("FermiChopper_ILL: %s: t3=%8.3g n=[%g %g %g] (time at tangent intersection).\n", - NAME_CURRENT_COMP, dt_to_tangent, n1, n2, n3); + printf ("FermiChopper_ILL: %s: t3=%8.3g n=[%g %g %g] (time at tangent intersection).\n", NAME_CURRENT_COMP, dt_to_tangent, n1, n2, n3); /* Does the neutron stay in the same slit ? */ - if((n2!=n1)||(n3!=n1)){ + if ((n2 != n1) || (n3 != n1)) { /* Choosing the first time it isn't in the slit anymore */ - if(n3!=n1){ + if (n3 != n1) { n2 = n3; } - /************ABSORB to save calculation time ******************/ + /************ABSORB to save calculation time ******************/ if (m == 0 || R0 == 0) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (change slit).\n", - NAME_CURRENT_COMP); + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (change slit).\n", NAME_CURRENT_COMP); ABSORB; } - - /********************** WHEN DOES IT HIT THE BLADE? *************************/ + /********************** WHEN DOES IT HIT THE BLADE? *************************/ /*********** SECANT METHOD ****************************/ /* get position of slit wall towards which neutron is propagating */ - if (n2 > n1) { /* X' positive side of slit is in principle the first intersection to test*/ - distance_Wa = n1*w+w; - distance_Wb = n1*w; - } else { /* X' negative side of slit */ - distance_Wb = n1*w+w; - distance_Wa = n1*w; + if (n2 > n1) { /* X' positive side of slit is in principle the first intersection to test*/ + distance_Wa = n1 * w + w; + distance_Wb = n1 * w; + } else { /* X' negative side of slit */ + distance_Wb = n1 * w + w; + distance_Wa = n1 * w; } /* time shift to reach slit wall point in [0,dt_to_tangent]: X'=distance_W slit_wall */ - t3a = xsecant(x,z,vx,vz,t,dt,distance_Wa, FCVars.omega, FCVars.t0); - t3b = xsecant(x,z,vx,vz,t,dt,distance_Wb, FCVars.omega, FCVars.t0); - if (t3b < 0) t3 = t3a; - else if (t3a < 0 && t3b > 0) t3 = t3b; - else t3 = (t3a < t3b ? t3a : t3b); + t3a = xsecant (x, z, vx, vz, t, dt, distance_Wa, FCVars.omega, FCVars.t0); + t3b = xsecant (x, z, vx, vz, t, dt, distance_Wb, FCVars.omega, FCVars.t0); + if (t3b < 0) + t3 = t3a; + else if (t3a < 0 && t3b > 0) + t3 = t3b; + else + t3 = (t3a < t3b ? t3a : t3b); /***** INTERPOLATION USED WHEN SECANT METHOD FAILS ****/ /* try second intersection method in case of failure */ if ((t3 < 0) || (t3 > dt)) { - t3a = xinterpolation(x,z,vx,vz,t,dt,distance_Wa, FCVars.omega, FCVars.t0); - t3b = xinterpolation(x,z,vx,vz,t,dt,distance_Wb, FCVars.omega, FCVars.t0); - if (t3b < 0) t3 = t3a; - else if (t3a < 0 && t3b > 0) t3 = t3b; - else t3 = (t3a < t3b ? t3a : t3b); + t3a = xinterpolation (x, z, vx, vz, t, dt, distance_Wa, FCVars.omega, FCVars.t0); + t3b = xinterpolation (x, z, vx, vz, t, dt, distance_Wb, FCVars.omega, FCVars.t0); + if (t3b < 0) + t3 = t3a; + else if (t3a < 0 && t3b > 0) + t3 = t3b; + else + t3 = (t3a < t3b ? t3a : t3b); } /* Check for errors in calculation*******/ if ((t3 < 0) || (t3 > dt)) { - if (verbose) - printf("FermiChopper_ILL: %s: Reflecting interpolation Problem. dt=%8.3g t3=%8.3g\n", - NAME_CURRENT_COMP, dt, t3); + if (verbose) + printf ("FermiChopper_ILL: %s: Reflecting interpolation Problem. dt=%8.3g t3=%8.3g\n", NAME_CURRENT_COMP, dt, t3); ABSORB; } /* Propagate whole system to that point */ - PROP_DT(t3); dt -= t3; + PROP_DT (t3); + dt -= t3; if (verbose > 2) - printf("FermiChopper_ILL: %s: PROP_DT t3=%8.3g dt=%8.3g xyz=[%8.3g %8.3g %8.3g] (on wall).\n", - NAME_CURRENT_COMP, t3, dt, x,y,z); + printf ("FermiChopper_ILL: %s: PROP_DT t3=%8.3g dt=%8.3g xyz=[%8.3g %8.3g %8.3g] (on wall).\n", NAME_CURRENT_COMP, t3, dt, x, y, z); /* Check if this point is inside the slit packet */ - if(fabs(zstrich(x,z,t, FCVars.omega, FCVars.t0)) > fabs(slit_input)){ - if (verbose > 2) - printf("FermiChopper_ILL: %s: Neutron is outside slit pack (on slit wall).\n", - NAME_CURRENT_COMP); + if (fabs (zstrich (x, z, t, FCVars.omega, FCVars.t0)) > fabs (slit_input)) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: Neutron is outside slit pack (on slit wall).\n", NAME_CURRENT_COMP); break; } - /******************** REFLECTION ALGORITHM ********************************/ - vper = xstrich(vx,vz,t, FCVars.omega, FCVars.t0); /* perpendicular velocity (to blade) */ - vpar = zstrich(vx,vz,t, FCVars.omega, FCVars.t0); /* parallel velocity (to blade) */ - q = 2*MS2AA*(fabs(vper)); + /******************** REFLECTION ALGORITHM ********************************/ + vper = xstrich (vx, vz, t, FCVars.omega, FCVars.t0); /* perpendicular velocity (to blade) */ + vpar = zstrich (vx, vz, t, FCVars.omega, FCVars.t0); /* parallel velocity (to blade) */ + q = 2 * MS2AA * (fabs (vper)); - if (q > Qc && W){ - arg = (q-m*Qc)/W; - if (arg < 10.0) p *= 0.5*(1-tanh(arg))*(1-alpha*(q-Qc)); + if (q > Qc && W) { + arg = (q - m * Qc) / W; + if (arg < 10.0) + p *= 0.5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc)); else { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (on slit wall).\n", - NAME_CURRENT_COMP); + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (on slit wall).\n", NAME_CURRENT_COMP); ABSORB; } } - if (R0 != 0.0){ + if (R0 != 0.0) { p *= R0; - vper *= (-1); /* Mirroring perpendicular velocity */ + vper *= (-1); /* Mirroring perpendicular velocity */ /**************SET NEW VELOCITIES***********/ - vx = vper*cos(FCVars.omega*(t-FCVars.t0)) - - vpar*sin(FCVars.omega*(t-FCVars.t0)); - vz = vper*sin(FCVars.omega*(t-FCVars.t0)) - + vpar*cos(FCVars.omega*(t-FCVars.t0)); + vx = vper * cos (FCVars.omega * (t - FCVars.t0)) - vpar * sin (FCVars.omega * (t - FCVars.t0)); + vz = vper * sin (FCVars.omega * (t - FCVars.t0)) + vpar * cos (FCVars.omega * (t - FCVars.t0)); SCATTER; } else { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (R0=0).\n", - NAME_CURRENT_COMP); - ABSORB; + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron hits absorbing coating (R0=0).\n", NAME_CURRENT_COMP); + ABSORB; } - /* Recalculating when Neutron will leave the slitpacket */ - t3 = zsecant(x,z,vx,vz,t,dt,-slit_input,FCVars.omega,FCVars.t0); - if((t3 < 0) || (t3 > dt)) { - t3=zinterpolation(x,z,vx,vz,t,dt,-slit_input, - FCVars.omega,FCVars.t0); + t3 = zsecant (x, z, vx, vz, t, dt, -slit_input, FCVars.omega, FCVars.t0); + if ((t3 < 0) || (t3 > dt)) { + t3 = zinterpolation (x, z, vx, vz, t, dt, -slit_input, FCVars.omega, FCVars.t0); } /* Check for errors in calculation*******/ if ((t3 < 0) || (t3 > dt)) { - if (verbose) - printf("FermiChopper_ILL: %s: Reflecting interpolation Problem. dt=%8.3g t3=%8.3g\n", - NAME_CURRENT_COMP, dt, t3); + if (verbose) + printf ("FermiChopper_ILL: %s: Reflecting interpolation Problem. dt=%8.3g t3=%8.3g\n", NAME_CURRENT_COMP, dt, t3); ABSORB; - } else dt=t3; + } else + dt = t3; } /* end if n2 != n2 != n3 */ - else break; + else + break; } /* end for */ - /********************* END OF THE FOR LOOP **********************************/ + /********************* END OF THE FOR LOOP **********************************/ /****New time of cylinder intersection will be calculated**********/ if (!cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius, yheight)) { - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron has unexpectidely exited cylinder ! (exiting)\n", - NAME_CURRENT_COMP); - ABSORB; + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron has unexpectidely exited cylinder ! (exiting)\n", NAME_CURRENT_COMP); + ABSORB; } if (t1 > 0 && verbose) { - printf("FermiChopper_ILL: %s: Neutrons are leaving chopper in the wrong direction! \n", NAME_CURRENT_COMP); + printf ("FermiChopper_ILL: %s: Neutrons are leaving chopper in the wrong direction! \n", NAME_CURRENT_COMP); } if (t2 <= 0 && verbose) { - printf("FermiChopper_ILL: %s: Neutrons are leaving chopper without any control\n", NAME_CURRENT_COMP); + printf ("FermiChopper_ILL: %s: Neutrons are leaving chopper without any control\n", NAME_CURRENT_COMP); } - /*********** PROPAGATE TO CYLINDER SURFACE ***********************************/ - PROP_DT(t2); + /*********** PROPAGATE TO CYLINDER SURFACE ***********************************/ + PROP_DT (t2); SCATTER; - + if (verbose > 2) - printf("FermiChopper_ILL: %s: t1=%8.3g PROP_DT t2=%8.3g xyz=[%8.3g %8.3g %8.3g] (OUT cyl).\n", - NAME_CURRENT_COMP, t1, t2, x,y,z); + printf ("FermiChopper_ILL: %s: t1=%8.3g PROP_DT t2=%8.3g xyz=[%8.3g %8.3g %8.3g] (OUT cyl).\n", NAME_CURRENT_COMP, t1, t2, x, y, z); /*****Checking if the neutron left the cylinder by his top or bottom **/ - if ( fabs(y) > yheight/2 ){ - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron hits top/bottom of cylinder, y=%8.3g (exiting)\n", - NAME_CURRENT_COMP, y); + if (fabs (y) > yheight / 2) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron hits top/bottom of cylinder, y=%8.3g (exiting)\n", NAME_CURRENT_COMP, y); ABSORB; } - /*****Checking if neutron hits chopper exit ***/ - if(fabs(xstrich(x,z,t,FCVars.omega,FCVars.t0))>=nslit*w/2){ - if (verbose > 2) - printf("FermiChopper_ILL: %s: ABSORB Neutron X is outside slit package cylinder, xp1=%8.3g (exiting)\n", - NAME_CURRENT_COMP, xstrich(x,z,t,FCVars.omega,FCVars.t0)); + if (fabs (xstrich (x, z, t, FCVars.omega, FCVars.t0)) >= nslit * w / 2) { + if (verbose > 2) + printf ("FermiChopper_ILL: %s: ABSORB Neutron X is outside slit package cylinder, xp1=%8.3g (exiting)\n", NAME_CURRENT_COMP, + xstrich (x, z, t, FCVars.omega, FCVars.t0)); ABSORB; } /**** Transmission coefficent******/ - p = p*eff; //finite cross section + transmission + p = p * eff; // finite cross section + transmission } /* end if cylinder_intersect */ else { - if (verbose > 2 && 0) - printf("FermiChopper_ILL: %s: ABSORB Neutron has not interacted with FC\n", - NAME_CURRENT_COMP); + if (verbose > 2 && 0) + printf ("FermiChopper_ILL: %s: ABSORB Neutron has not interacted with FC\n", NAME_CURRENT_COMP); ABSORB; } -/************************ TIME OF FLIGHT RESET ************************/ + /************************ TIME OF FLIGHT RESET ************************/ if (zero_time && nu) - t -= (((int)((t+1/(4*nu))/(1/(2*nu))))*(1/(2*nu))); + t -= (((int)((t + 1 / (4 * nu)) / (1 / (2 * nu)))) * (1 / (2 * nu))); %} MCDISPLAY %{ - double index=0; + double index = 0; double xpos, zpos; - double ymax = yheight/2; + double ymax = yheight / 2; double ymin = -ymax; - + /* cylinder top/center/bottom */ - circle("xz", 0,ymax,0,radius); - circle("xz", 0,0 ,0,radius); - circle("xz", 0,ymin,0,radius); + circle ("xz", 0, ymax, 0, radius); + circle ("xz", 0, 0, 0, radius); + circle ("xz", 0, ymin, 0, radius); /* vertical lines to make a kind of volume */ - line( 0 ,ymin,-radius, 0 ,ymax,-radius); - line( 0 ,ymin, radius, 0 ,ymax, radius); - line(-radius,ymin, 0 ,-radius,ymax, 0 ); - line( radius,ymin, 0 , radius,ymax, 0 ); + line (0, ymin, -radius, 0, ymax, -radius); + line (0, ymin, radius, 0, ymax, radius); + line (-radius, ymin, 0, -radius, ymax, 0); + line (radius, ymin, 0, radius, ymax, 0); /* slit package */ - index = -nslit/2; - zpos = length/2; - for (index = -nslit/2; index < nslit/2; index++) { - xpos = index*w; - multiline(5, xpos, ymin, -zpos, - xpos, ymax, -zpos, - xpos, ymax, +zpos, - xpos, ymin, +zpos, - xpos, ymin, -zpos); + index = -nslit / 2; + zpos = length / 2; + for (index = -nslit / 2; index < nslit / 2; index++) { + xpos = index * w; + multiline (5, xpos, ymin, -zpos, xpos, ymax, -zpos, xpos, ymax, +zpos, xpos, ymin, +zpos, xpos, ymin, -zpos); } /* cylinder inner sides containing slit package */ - xpos = nslit*w/2; - zpos = sqrt(radius*radius - xpos*xpos); - multiline(5, xpos, ymin, -zpos, - xpos, ymax, -zpos, - xpos, ymax, +zpos, - xpos, ymin, +zpos, - xpos, ymin, -zpos); + xpos = nslit * w / 2; + zpos = sqrt (radius * radius - xpos * xpos); + multiline (5, xpos, ymin, -zpos, xpos, ymax, -zpos, xpos, ymax, +zpos, xpos, ymin, +zpos, xpos, ymin, -zpos); xpos *= -1; - multiline(5, xpos, ymin, -zpos, - xpos, ymax, -zpos, - xpos, ymax, +zpos, - xpos, ymin, +zpos, - xpos, ymin, -zpos); + multiline (5, xpos, ymin, -zpos, xpos, ymax, -zpos, xpos, ymax, +zpos, xpos, ymin, +zpos, xpos, ymin, -zpos); %} END diff --git a/mcstas-comps/contrib/Fermi_chop2a.comp b/mcstas-comps/contrib/Fermi_chop2a.comp index 9ed0ee834..0f687997e 100644 --- a/mcstas-comps/contrib/Fermi_chop2a.comp +++ b/mcstas-comps/contrib/Fermi_chop2a.comp @@ -39,231 +39,238 @@ SETTING PARAMETERS (len, w, nu, delta, tc, ymin, ymax, nchan, bw, blader) SHARE %{ -#ifndef FERMI_CHOP_DEFS -#define FERMI_CHOP_DEFS - /* routine to calculate acos in proper quadrant range = 0 to 2PI*/ - #pragma acc routine - double acos0_2pi(double x,double y) - { - if (y>0.0){ - return acos(x); - } - return 2.0*PI-acos(x); - } - - /*routine to calculate x and y positions of a neutron in a fermi chopper */ - #pragma acc routine - void neutxypos(double *x, double *y, double phi, double inrad, double* c) - { - *x=c[0]+inrad*cos(phi); - *y=c[1]+inrad*sin(phi); + #ifndef FERMI_CHOP_DEFS + #define FERMI_CHOP_DEFS + /* routine to calculate acos in proper quadrant range = 0 to 2PI*/ + #pragma acc routine + double + acos0_2pi (double x, double y) { + if (y > 0.0) { + return acos (x); } + return 2.0 * PI - acos (x); + } - /* routine to calculate the origin of a circle that describes the neutron path through the chopper */ - #pragma acc routine - void calccenter(double* c, double* zr, double* xr){ - double denom, A,B,C,D,a,b; - denom=2*(-zr[0]*xr[2] +zr[0]*xr[1]+ zr[1]*xr[2]+xr[0]*zr[2]-xr[0]*zr[1] - xr[1]*zr[2]); - A=xr[1]-xr[2];B=xr[0]-xr[1];C=zr[2]-zr[1];D=zr[1]-zr[0]; - a=zr[0]*zr[0]-zr[1]*zr[1]+xr[0]*xr[0]-xr[1]*xr[1]; - b=zr[2]*zr[2]-zr[1]*zr[1]+xr[2]*xr[2]-xr[1]*xr[1]; - c[0]=1.0/denom*(A*a+B*b); - c[1]=1.0/denom*(C*a+D*b); - } + /*routine to calculate x and y positions of a neutron in a fermi chopper */ + #pragma acc routine + void + neutxypos (double* x, double* y, double phi, double inrad, double* c) { + *x = c[0] + inrad * cos (phi); + *y = c[1] + inrad * sin (phi); + } -#endif + /* routine to calculate the origin of a circle that describes the neutron path through the chopper */ + #pragma acc routine + void + calccenter (double* c, double* zr, double* xr) { + double denom, A, B, C, D, a, b; + denom = 2 * (-zr[0] * xr[2] + zr[0] * xr[1] + zr[1] * xr[2] + xr[0] * zr[2] - xr[0] * zr[1] - xr[1] * zr[2]); + A = xr[1] - xr[2]; + B = xr[0] - xr[1]; + C = zr[2] - zr[1]; + D = zr[1] - zr[0]; + a = zr[0] * zr[0] - zr[1] * zr[1] + xr[0] * xr[0] - xr[1] * xr[1]; + b = zr[2] * zr[2] - zr[1] * zr[1] + xr[2] * xr[2] - xr[1] * xr[1]; + c[0] = 1.0 / denom * (A * a + B * b); + c[1] = 1.0 / denom * (C * a + D * b); + } -/* function that describes the shape of the blades */ - #pragma acc routine - double blades(double zin,double rin,double off){ - if (rin!=0.0) - return rin*(1-cos(asin(zin/fabs(rin))))+off; - else - return 0; - } + #endif -/* function to calculate which channel the neturon is in and to check if it is in a blade - * or outside the slit package - * return 0 if neutron does not transmit return 1 with channel number if neutron will pass*/ - #pragma acc routine - int checkabsorb(double phi,int *chan_num, double inrad,double inw, double insw, - double inbw, double blader, double off, double* c){ - double xtmp,neuzr,neuxr; - neutxypos(&neuzr,&neuxr,phi,inrad,c); - // printf("xr:%g zr:%g phi: %g r: %g c[0]: %g c[1]: %g\n",neuxr,neuzr,phi,inrad,c[0],c[1]); - if (fabs(neuxr)>inw/2.0) // check if neutron x position is outside of slit package - return 0; - xtmp=neuxr+inw/2.0; // move origin to side of slit package - *chan_num=ceil((xtmp-blades(neuzr,blader,off))/(inbw+insw)); //calculate channel number - //check if neutron is in blade - if (xtmp >*chan_num*(inbw+insw)+blades(neuzr,blader,off)) - return 0; - return 1; - } + /* function that describes the shape of the blades */ + #pragma acc routine + double + blades (double zin, double rin, double off) { + if (rin != 0.0) + return rin * (1 - cos (asin (zin / fabs (rin)))) + off; + else + return 0; + } + /* function to calculate which channel the neturon is in and to check if it is in a blade + * or outside the slit package + * return 0 if neutron does not transmit return 1 with channel number if neutron will pass*/ + #pragma acc routine + int + checkabsorb (double phi, int* chan_num, double inrad, double inw, double insw, double inbw, double blader, double off, double* c) { + double xtmp, neuzr, neuxr; + neutxypos (&neuzr, &neuxr, phi, inrad, c); + // printf("xr:%g zr:%g phi: %g r: %g c[0]: %g c[1]: %g\n",neuxr,neuzr,phi,inrad,c[0],c[1]); + if (fabs (neuxr) > inw / 2.0) // check if neutron x position is outside of slit package + return 0; + xtmp = neuxr + inw / 2.0; // move origin to side of slit package + *chan_num = ceil ((xtmp - blades (neuzr, blader, off)) / (inbw + insw)); // calculate channel number + // check if neutron is in blade + if (xtmp > *chan_num * (inbw + insw) + blades (neuzr, blader, off)) + return 0; + return 1; + } %} DECLARE %{ - double omega; - double off; - double splen; - double rad; - double sw; - double tw; - + double omega; + double off; + double splen; + double rad; + double sw; + double tw; %} INITIALIZE %{ - splen=len/2.0; - omega=2.0*PI*nu; - off=blader*(1-cos(asin(splen/fabs(blader))));// the additional width needed to accomodate the curvature of the blade - tw=(w+2.0*off); //the total width needed to contain the slit package - rad=sqrt(tw*tw/4.0+splen*splen); //radius of cylinder containing slit package. - sw=(w-bw)/nchan-bw; - printf("sw: %g rad: %g\n",sw,rad); - + splen = len / 2.0; + omega = 2.0 * PI * nu; + off = blader * (1 - cos (asin (splen / fabs (blader)))); // the additional width needed to accomodate the curvature of the blade + tw = (w + 2.0 * off); // the total width needed to contain the slit package + rad = sqrt (tw * tw / 4.0 + splen * splen); // radius of cylinder containing slit package. + sw = (w - bw) / nchan - bw; + printf ("sw: %g rad: %g\n", sw, rad); %} TRACE %{ - - double t0,t1,dphi,dt2,tneuzr,tneuxr,nrad; - double phivec[200],tpt[3],xpt[3],ypt[3],zpt[3],zr[3],xr[3],yr[3],theta[3],c[2]; - int chan_num,chan_num0,idx1,idx3; - if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, rad, ymax-ymin)){ - if (t0 < 0) /*Neutron started inside cylinder */ - ABSORB; - dt2=t1-t0; - PROP_DT(t0); /*propagate neutron to edge of chopper*/ - /*calculate neutron position and velocity in chopper frame + + double t0, t1, dphi, dt2, tneuzr, tneuxr, nrad; + double phivec[200], tpt[3], xpt[3], ypt[3], zpt[3], zr[3], xr[3], yr[3], theta[3], c[2]; + int chan_num, chan_num0, idx1, idx3; + if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, rad, ymax - ymin)) { + if (t0 < 0) /*Neutron started inside cylinder */ + ABSORB; + dt2 = t1 - t0; + PROP_DT (t0); /*propagate neutron to edge of chopper*/ + /*calculate neutron position and velocity in chopper frame calculate 3 points in the instrument frame and put them into the - chopper frame inorder to determine the radius and center of a circle + chopper frame inorder to determine the radius and center of a circle that describes the path of the neutron in the chopper frame. */ - tpt[1]=t; - tpt[2]=t+dt2; - tpt[0]=t+dt2/2.0; - //set local 0 in time as tc and calculate angle of rotation for each point - for(idx3=0;idx3<3;idx3++){ - theta[idx3]=(tpt[idx3]-tc)*omega; + tpt[1] = t; + tpt[2] = t + dt2; + tpt[0] = t + dt2 / 2.0; + // set local 0 in time as tc and calculate angle of rotation for each point + for (idx3 = 0; idx3 < 3; idx3++) { + theta[idx3] = (tpt[idx3] - tc) * omega; } - zpt[1]=-sqrt(rad*rad-x*x); xpt[1]=x; ypt[1]=y; /* point where neutron intersects chopper */ - zpt[2]=zpt[1]+vz*(dt2); xpt[2]=xpt[1]+vx*(dt2); ypt[2]=ypt[1]+vy*(dt2); /* point where neutron leaves the chopper */ - xpt[0]=xpt[1]+vx*(dt2/2.0); ypt[0]=ypt[1]+vy*(dt2/2.0); zpt[0]=zpt[1]+vz*(dt2/2.0); /*point half way between in time */ - /* do the rotation */ - for(idx3=0;idx3<3;idx3++){ - rotate(xr[idx3],yr[idx3],zr[idx3],xpt[idx3],ypt[idx3],zpt[idx3],theta[idx3],0,1,0); - } - calccenter(c,zr,xr); /* calculate the center */ - nrad=sqrt((zr[0]-c[0])*(zr[0]-c[0])+(xr[0]-c[1])*(xr[0]-c[1])); /*calculate the radius of curvature for the neutron path */ - /* calculate points along path of neutron through cylinder quit on absorption - * or transmit neutron if 200 points are calculated - * calculate phi for first and last points */ - phivec[0]=acos0_2pi((zr[1]-c[0])/nrad,xr[1]-c[1]);phivec[1]=acos0_2pi((zr[2]-c[0])/nrad,xr[2]-c[1]); - neutxypos(&tneuzr,&tneuxr,phivec[0],nrad,c); - /* reset phi[0] and phi[1] to match the length of the slit package rather than cylinder radius*/ - if(tneuzr<-splen){ - phivec[0]=acos0_2pi((-c[0]-splen)/nrad,-c[1]); + zpt[1] = -sqrt (rad * rad - x * x); + xpt[1] = x; + ypt[1] = y; /* point where neutron intersects chopper */ + zpt[2] = zpt[1] + vz * (dt2); + xpt[2] = xpt[1] + vx * (dt2); + ypt[2] = ypt[1] + vy * (dt2); /* point where neutron leaves the chopper */ + xpt[0] = xpt[1] + vx * (dt2 / 2.0); + ypt[0] = ypt[1] + vy * (dt2 / 2.0); + zpt[0] = zpt[1] + vz * (dt2 / 2.0); /*point half way between in time */ + /* do the rotation */ + for (idx3 = 0; idx3 < 3; idx3++) { + rotate (xr[idx3], yr[idx3], zr[idx3], xpt[idx3], ypt[idx3], zpt[idx3], theta[idx3], 0, 1, 0); } - neutxypos(&tneuzr,&tneuxr,phivec[1],nrad,c); - if(tneuzr>splen){ - phivec[1]=acos0_2pi((-c[0]+splen/2.0)/nrad,-c[1]); + calccenter (c, zr, xr); /* calculate the center */ + nrad = sqrt ((zr[0] - c[0]) * (zr[0] - c[0]) + (xr[0] - c[1]) * (xr[0] - c[1])); /*calculate the radius of curvature for the neutron path */ + /* calculate points along path of neutron through cylinder quit on absorption + * or transmit neutron if 200 points are calculated + * calculate phi for first and last points */ + phivec[0] = acos0_2pi ((zr[1] - c[0]) / nrad, xr[1] - c[1]); + phivec[1] = acos0_2pi ((zr[2] - c[0]) / nrad, xr[2] - c[1]); + neutxypos (&tneuzr, &tneuxr, phivec[0], nrad, c); + /* reset phi[0] and phi[1] to match the length of the slit package rather than cylinder radius*/ + if (tneuzr < -splen) { + phivec[0] = acos0_2pi ((-c[0] - splen) / nrad, -c[1]); } - dphi=phivec[1]-phivec[0]; /* initial dphi */ - idx1=2; - phivec[idx1]=phivec[0]+dphi/2.0; /* calculate center point */ - if (!checkabsorb(phivec[idx1],&chan_num,nrad,tw,sw,bw,blader,off,c)) - ABSORB; - chan_num0=chan_num; - while (idx1<129){ - dphi=phivec[1]-phivec[idx1]; - idx1++; - phivec[idx1]=phivec[0]+dphi/2.0; - if (!checkabsorb(phivec[idx1],&chan_num,nrad,tw,sw,bw,blader,off,c)) + neutxypos (&tneuzr, &tneuxr, phivec[1], nrad, c); + if (tneuzr > splen) { + phivec[1] = acos0_2pi ((-c[0] + splen / 2.0) / nrad, -c[1]); + } + dphi = phivec[1] - phivec[0]; /* initial dphi */ + idx1 = 2; + phivec[idx1] = phivec[0] + dphi / 2.0; /* calculate center point */ + if (!checkabsorb (phivec[idx1], &chan_num, nrad, tw, sw, bw, blader, off, c)) ABSORB; - if ((chan_num!=chan_num0) || (chan_num>nchan)) - ABSORB; - /* If the current dphi is positive calculate points until a point is beyond phivec[1] - Check to see if the point is absorbed after each new point is generated stop if more than 129 iterations are performed - */ - if (dphi>0){ - while ((phivec[idx1]nchan)) - ABSORB; - - } - if (phivec[idx1]>=phivec[1]) idx1--; //remove the point that is beyond phivec[1] - } - /* If the current dphi is negative calculate points until a point is beyond phivec[1] - Check to see if the point is absorbed after each new point is generated stop if more than 129 iterations are performed - */ - else if (dphi<0){ - while ((phivec[idx1]>phivec[1])&&(idx1<129)){ - /* printf("phivec[%i]: %g\n", idx1,phivec[idx1]);*/ - idx1++; - phivec[idx1]=phivec[idx1-1]+dphi; - if (!checkabsorb(phivec[idx1],&chan_num,nrad,tw,sw,bw,blader,off,c)) - ABSORB; - // printf("chan_num0: %i chan_num: %i\n",chan_num0,chan_num); - if ((chan_num!=chan_num0) || (chan_num>nchan)) - ABSORB; - } - if (phivec[idx1]<=phivec[1]) idx1--; //remove the point that is beyond phivec[1] - } - else + chan_num0 = chan_num; + while (idx1 < 129) { + dphi = phivec[1] - phivec[idx1]; + idx1++; + phivec[idx1] = phivec[0] + dphi / 2.0; + if (!checkabsorb (phivec[idx1], &chan_num, nrad, tw, sw, bw, blader, off, c)) + ABSORB; + if ((chan_num != chan_num0) || (chan_num > nchan)) + ABSORB; + /* If the current dphi is positive calculate points until a point is beyond phivec[1] + Check to see if the point is absorbed after each new point is generated stop if more than 129 iterations are performed + */ + if (dphi > 0) { + while ((phivec[idx1] < phivec[1]) && (idx1 < 129)) { + /* printf("phivec[%i]: %g dphi: %g phivec[1]: %g\n", idx1,phivec[idx1],dphi,phivec[1]);*/ + idx1++; + phivec[idx1] = phivec[idx1 - 1] + dphi; + if (!checkabsorb (phivec[idx1], &chan_num, nrad, tw, sw, bw, blader, off, c)) + ABSORB; + // printf("chan_num0: %i chan_num: %i\n",chan_num0,chan_num); + if ((chan_num != chan_num0) || (chan_num > nchan)) + ABSORB; + } + if (phivec[idx1] >= phivec[1]) + idx1--; // remove the point that is beyond phivec[1] + } + /* If the current dphi is negative calculate points until a point is beyond phivec[1] + Check to see if the point is absorbed after each new point is generated stop if more than 129 iterations are performed + */ + else if (dphi < 0) { + while ((phivec[idx1] > phivec[1]) && (idx1 < 129)) { + /* printf("phivec[%i]: %g\n", idx1,phivec[idx1]);*/ + idx1++; + phivec[idx1] = phivec[idx1 - 1] + dphi; + if (!checkabsorb (phivec[idx1], &chan_num, nrad, tw, sw, bw, blader, off, c)) + ABSORB; + // printf("chan_num0: %i chan_num: %i\n",chan_num0,chan_num); + if ((chan_num != chan_num0) || (chan_num > nchan)) + ABSORB; + } + if (phivec[idx1] <= phivec[1]) + idx1--; // remove the point that is beyond phivec[1] + } else ABSORB; /* dphi =0? */ - } - } - else /* The neutron failed to even hit the chopper */ + } + } else /* The neutron failed to even hit the chopper */ ABSORB; - %} MCDISPLAY %{ -double zstep,x1,x2,x3,x4,z1,z2; -int idx, idx2; -line(tw/2.0,ymin,splen,tw/2.0,ymax,splen); -line(tw/2.0,ymin,-splen,tw/2.0,ymax,-splen); -line(-tw/2.0,ymin,splen,-tw/2.0,ymax,splen); -line(-tw/2.0,ymin,-splen,-tw/2.0,ymax,-splen); -line(tw/2.0,ymax,splen,tw/2.0,ymax,-splen); -line(-tw/2.0,ymax,splen,-tw/2.0,ymax,-splen); -line(tw/2.0,ymin,splen,tw/2.0,ymin,-splen); -line(-tw/2.0,ymin,splen,-tw/2.0,ymin,-splen); -circle("zx",0,ymin,0,rad); -circle("zx",0,ymax,0,rad); -zstep=2.0*splen/10.0; -for(idx=0;idx 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } - - if (xmin == 0 && xmax == 0 && ymin == 0 & ymax == 0) - { fprintf(stderr,"Filter_graphite: %s: Error: give geometry\n", NAME_CURRENT_COMP); exit(-1); } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } + + if (xmin == 0 && xmax == 0 && ymin == 0 & ymax == 0) { + fprintf (stderr, "Filter_graphite: %s: Error: give geometry\n", NAME_CURRENT_COMP); + exit (-1); + } %} TRACE %{ - double L,L1,L0,T1,T0, Filt_T; + double L, L1, L0, T1, T0, Filt_T; double dt; PROP_Z0; - L = (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); - if (xxmax || yymax) ABSORB; - dt = length/vz; - PROP_DT(dt); - if (xxmax || yymax) ABSORB; - if (L>2.60) {L1= L ;L0=2.60;T1=0.06;T0=0.06;}; - if (L<2.60 && L>=2.40) {L1=2.60;L0=2.40;T1=0.06;T0=0.05;}; - if (L<2.40 && L>=2.30) {L1=2.40;L0=2.30;T1=0.05;T0=0.09;}; - if (L<2.30 && L>=2.20) {L1=2.30;L0=2.20;T1=0.09;T0=0.22;}; - if (L<2.20 && L>=2.00) {L1=2.20;L0=2.00;T1=0.22;T0=0.34;}; - if (L<2.00 && L>=1.90) {L1=2.00;L0=1.90;T1=0.34;T0=0.61;}; - if (L<1.90 && L>=1.80) {L1=1.90;L0=1.80;T1=0.61;T0=0.23;}; - if (L<1.80 && L>=1.60) {L1=1.80;L0=1.60;T1=0.23;T0=0.25;}; - if (L<1.60 && L>=1.40) {L1=1.60;L0=1.40;T1=0.25;T0=0.27;}; - if (L<1.40 && L>=1.30) {L1=1.40;L0=1.30;T1=0.27;T0=0.53;}; - if (L<1.30 && L>=1.20) {L1=1.30;L0=1.20;T1=0.53;T0=0.98;}; - if (L<1.20 && L>=1.10) {L1=1.20;L0=1.10;T1=0.98;T0=0.89;}; - if (L<1.10 && L>=1.00) {L1=1.10;L0=1.00;T1=0.89;T0=0.52;}; - if (L<1.00 && L>=0.87) {L1=1.00;L0=0.87;T1=0.52;T0=0.47;}; - if (L<0.87) {L1=0.87;L0= L ;T1=0.47;T0=0.47;}; - Filt_T=(T0+(L-L0)/(L1-L0)*(T1-T0))*100.0; - Filt_T = exp(-Filt_T*length); - p*=Filt_T; + L = (2 * PI / V2K) / sqrt (vx * vx + vy * vy + vz * vz); + if (x < xmin || x > xmax || y < ymin || y > ymax) + ABSORB; + dt = length / vz; + PROP_DT (dt); + if (x < xmin || x > xmax || y < ymin || y > ymax) + ABSORB; + if (L > 2.60) { + L1 = L; + L0 = 2.60; + T1 = 0.06; + T0 = 0.06; + }; + if (L < 2.60 && L >= 2.40) { + L1 = 2.60; + L0 = 2.40; + T1 = 0.06; + T0 = 0.05; + }; + if (L < 2.40 && L >= 2.30) { + L1 = 2.40; + L0 = 2.30; + T1 = 0.05; + T0 = 0.09; + }; + if (L < 2.30 && L >= 2.20) { + L1 = 2.30; + L0 = 2.20; + T1 = 0.09; + T0 = 0.22; + }; + if (L < 2.20 && L >= 2.00) { + L1 = 2.20; + L0 = 2.00; + T1 = 0.22; + T0 = 0.34; + }; + if (L < 2.00 && L >= 1.90) { + L1 = 2.00; + L0 = 1.90; + T1 = 0.34; + T0 = 0.61; + }; + if (L < 1.90 && L >= 1.80) { + L1 = 1.90; + L0 = 1.80; + T1 = 0.61; + T0 = 0.23; + }; + if (L < 1.80 && L >= 1.60) { + L1 = 1.80; + L0 = 1.60; + T1 = 0.23; + T0 = 0.25; + }; + if (L < 1.60 && L >= 1.40) { + L1 = 1.60; + L0 = 1.40; + T1 = 0.25; + T0 = 0.27; + }; + if (L < 1.40 && L >= 1.30) { + L1 = 1.40; + L0 = 1.30; + T1 = 0.27; + T0 = 0.53; + }; + if (L < 1.30 && L >= 1.20) { + L1 = 1.30; + L0 = 1.20; + T1 = 0.53; + T0 = 0.98; + }; + if (L < 1.20 && L >= 1.10) { + L1 = 1.20; + L0 = 1.10; + T1 = 0.98; + T0 = 0.89; + }; + if (L < 1.10 && L >= 1.00) { + L1 = 1.10; + L0 = 1.00; + T1 = 0.89; + T0 = 0.52; + }; + if (L < 1.00 && L >= 0.87) { + L1 = 1.00; + L0 = 0.87; + T1 = 0.52; + T0 = 0.47; + }; + if (L < 0.87) { + L1 = 0.87; + L0 = L; + T1 = 0.47; + T0 = 0.47; + }; + Filt_T = (T0 + (L - L0) / (L1 - L0) * (T1 - T0)) * 100.0; + Filt_T = exp (-Filt_T * length); + p *= Filt_T; SCATTER; %} MCDISPLAY %{ - - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); - multiline(5, (double)xmin, (double)ymin, (double)length, - (double)xmax, (double)ymin, (double)length, - (double)xmax, (double)ymax, (double)length, - (double)xmin, (double)ymax, (double)length, - (double)xmin, (double)ymin, (double)length); - line(xmin, ymin, 0.0, xmin, ymin, length); - line(xmax, ymin, 0.0, xmax, ymin, length); - line(xmin, ymax, 0.0, xmin, ymax, length); - line(xmax, ymax, 0.0, xmax, ymax, length); + + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); + multiline (5, (double)xmin, (double)ymin, (double)length, (double)xmax, (double)ymin, (double)length, (double)xmax, (double)ymax, (double)length, (double)xmin, + (double)ymax, (double)length, (double)xmin, (double)ymin, (double)length); + line (xmin, ymin, 0.0, xmin, ymin, length); + line (xmax, ymin, 0.0, xmax, ymin, length); + line (xmin, ymax, 0.0, xmin, ymax, length); + line (xmax, ymax, 0.0, xmax, ymax, length); %} END diff --git a/mcstas-comps/contrib/FlatEllipse_finite_mirror.comp b/mcstas-comps/contrib/FlatEllipse_finite_mirror.comp index 685a03b99..0f5e43796 100644 --- a/mcstas-comps/contrib/FlatEllipse_finite_mirror.comp +++ b/mcstas-comps/contrib/FlatEllipse_finite_mirror.comp @@ -64,34 +64,35 @@ SETTING PARAMETERS ( SHARE %{ - %include "ref-lib" - %include "conic.h" - %include "read_table-lib" + %include "ref-lib" + %include "conic.h" + %include "read_table-lib" -/* Function originally defined in file "calciterativemirrors.h" - -/*! \brief Function to return an array of distances for a nested mirror assembly, see attached files. Also works reasonably well for parabolic mirrors -see + /* Function originally defined in file "calciterativemirrors.h" -@param number number of entries in the array = number of mirrros -@param z_0 z-coordinate of the initial point on the mirror -@param r_0 r-coordinate of the initial point on the mirror -@param z_extract z-coordinate at which the distances are extracted -@param LStart z-coordinate of the left focal point -@param LEnd z-coordinate of the right focal point -@param lStart z-coordinate at which the mirrors begin -@param lEnd z-coordinate at which the mirrros end -@return pointer to array with number of distances -*/ -double * get_r_at_z0(int number, double z_0, double r_0, double z_extract, double LStart, double LEnd, double lStart, double lEnd) { + /*! \brief Function to return an array of distances for a nested mirror assembly, see attached files. Also works reasonably well for parabolic mirrors + see + + @param number number of entries in the array = number of mirrros + @param z_0 z-coordinate of the initial point on the mirror + @param r_0 r-coordinate of the initial point on the mirror + @param z_extract z-coordinate at which the distances are extracted + @param LStart z-coordinate of the left focal point + @param LEnd z-coordinate of the right focal point + @param lStart z-coordinate at which the mirrors begin + @param lEnd z-coordinate at which the mirrros end + @return pointer to array with number of distances + */ + double* + get_r_at_z0 (int number, double z_0, double r_0, double z_extract, double LStart, double LEnd, double lStart, double lEnd) { int n = number; - double *r_zExtracts = malloc(n*sizeof(double_t)); /* n is an array of 10 integers */ + double* r_zExtracts = malloc (n * sizeof (double_t)); /* n is an array of 10 integers */ if (!r_zExtracts) { - fprintf(stderr,"NMO comp function get_r_at_z0: malloc() failed. Exit! \n"); - exit(-1); + fprintf (stderr, "NMO comp function get_r_at_z0: malloc() failed. Exit! \n"); + exit (-1); } - r_zExtracts[0] = r_0; - //helper variables as in conic_finite_mirror.h and explained in swissneutronics_überlegungen + r_zExtracts[0] = r_0; + // helper variables as in conic_finite_mirror.h and explained in swissneutronics_überlegungen double k1; double k2; double k3; @@ -100,145 +101,140 @@ double * get_r_at_z0(int number, double z_0, double r_0, double z_extract, doubl double a; double r_lEnd; double r_lStart; - //initial mirror is calculated from the initial point z0, r0 - c = (LEnd - LStart)/2; + // initial mirror is calculated from the initial point z0, r0 + c = (LEnd - LStart) / 2; u = (z_0 + c - LEnd); - a = sqrt((u*u+c*c+r_0*r_0+sqrt(pow(u*u+c*c+r_0*r_0, 2)-4*c*c*u*u))/2); - k3 = c*c/(a*a)-1; - k2 = 2*k3*(c-LEnd); - k1 = k3*(c-LEnd)*(c-LEnd)-c*c+a*a; - printf("k1 %f k2 %f k3 %f\n", k1, k2, k3); - //next mirror will be calculated with the point on the surface being lStart, r_lStart - for( int k = 0; k < number;++k){ - r_zExtracts[k] = sqrt(k1 + k2*z_extract + k3*z_extract*z_extract); - r_lEnd = sqrt(k1+ k2*lEnd + k3*lEnd*lEnd);//calculate the radius at the end - r_lStart = r_lEnd*(lStart-LStart)/(lEnd-LStart);// - - c = (LEnd - LStart)/2; - u = (lStart + c - LEnd); - a = sqrt((u*u+c*c+r_lStart*r_lStart+sqrt(pow(u*u+c*c+r_lStart*r_lStart, 2)-4*c*c*u*u))/2); - k3 = c*c/(a*a)-1; - k2 = 2*k3*(c-LEnd); - k1 = k3*(c-LEnd)*(c-LEnd)-c*c+a*a; - printf("k1 %f k2 %f k3 %f\n", k1, k2, k3); - //r_lEnd = sqrt(k1+ k2*lEnd + k3*lEnd*lEnd); - //r_lStart = r_lEnd*(lStart-LStart)/(lEnd-LStart); - }; - return r_zExtracts; -} - + a = sqrt ((u * u + c * c + r_0 * r_0 + sqrt (pow (u * u + c * c + r_0 * r_0, 2) - 4 * c * c * u * u)) / 2); + k3 = c * c / (a * a) - 1; + k2 = 2 * k3 * (c - LEnd); + k1 = k3 * (c - LEnd) * (c - LEnd) - c * c + a * a; + printf ("k1 %f k2 %f k3 %f\n", k1, k2, k3); + // next mirror will be calculated with the point on the surface being lStart, r_lStart + for (int k = 0; k < number; ++k) { + r_zExtracts[k] = sqrt (k1 + k2 * z_extract + k3 * z_extract * z_extract); + r_lEnd = sqrt (k1 + k2 * lEnd + k3 * lEnd * lEnd); // calculate the radius at the end + r_lStart = r_lEnd * (lStart - LStart) / (lEnd - LStart); // + c = (LEnd - LStart) / 2; + u = (lStart + c - LEnd); + a = sqrt ((u * u + c * c + r_lStart * r_lStart + sqrt (pow (u * u + c * c + r_lStart * r_lStart, 2) - 4 * c * c * u * u)) / 2); + k3 = c * c / (a * a) - 1; + k2 = 2 * k3 * (c - LEnd); + k1 = k3 * (c - LEnd) * (c - LEnd) - c * c + a * a; + printf ("k1 %f k2 %f k3 %f\n", k1, k2, k3); + // r_lEnd = sqrt(k1+ k2*lEnd + k3*lEnd*lEnd); + // r_lStart = r_lEnd*(lStart-LStart)/(lEnd-LStart); + }; + return r_zExtracts; + } %} DECLARE %{ - //Scene where all geometry is added to - Scene s; - //point structure - Point p1; - //Function to handle Conic-Neutron collisions with reflectivity from McStas Tables - double *rfront_inner;//all r-distances at lStart for all mirror surfaces - int silicon; // +1: neutron in silicon, -1: neutron in air, 0: mirrorwidth is 0; neutron cannot be in silicon and also does not track mirror transitions - t_Table rsTable; + // Scene where all geometry is added to + Scene s; + // point structure + Point p1; + // Function to handle Conic-Neutron collisions with reflectivity from McStas Tables + double* rfront_inner; // all r-distances at lStart for all mirror surfaces + int silicon; // +1: neutron in silicon, -1: neutron in air, 0: mirrorwidth is 0; neutron cannot be in silicon and also does not track mirror transitions + t_Table rsTable; %} INITIALIZE %{ - if (rfront_inner_file && strlen(rfront_inner_file) && strcmp(rfront_inner_file,"NULL") && strcmp(rfront_inner_file,"0")) { - if (Table_Read(&rsTable, rfront_inner_file, 1) <= 0){ /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"FlatEllipse_finite_mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, rfront_inner_file)); - } - //read the data from the file into an array and point rfron_inner to it - nummirror = rsTable.rows; - rfront_inner = malloc(sizeof(double)*nummirror); - if (!rfront_inner) { - fprintf(stderr,"Component %s: malloc() failed in INIT. Exit! \n", NAME_CURRENT_COMP); - exit(-1); - } - for (int i = 0; i < nummirror; i++){ - - rfront_inner[i] = Table_Index(rsTable, i, 1);//reads the value of the second col where i sits in the first col - } - } else {//proceed as usual calculating the values from the outermost mirror and the number of mirrors - printf("automatic calulation\n"); - rfront_inner = get_r_at_z0(nummirror, 0, r_0, lStart, sourceDist, LEnd, lStart, lEnd); - //calculate the r-distances of all mirrors at the entry of the NMO, we will need this later + if (rfront_inner_file && strlen (rfront_inner_file) && strcmp (rfront_inner_file, "NULL") && strcmp (rfront_inner_file, "0")) { + if (Table_Read (&rsTable, rfront_inner_file, 1) <= 0) { /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "FlatEllipse_finite_mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, rfront_inner_file)); } - if (sourceDist == 0){//obsolete? - sourceDist = LStart; + // read the data from the file into an array and point rfron_inner to it + nummirror = rsTable.rows; + rfront_inner = malloc (sizeof (double) * nummirror); + if (!rfront_inner) { + fprintf (stderr, "Component %s: malloc() failed in INIT. Exit! \n", NAME_CURRENT_COMP); + exit (-1); } - silicon = (mirror_width==0) ? 0 : -1; //neutron starts in air by default + for (int i = 0; i < nummirror; i++) { - //Load Reflectivity Data File TODO - //Make new scene - s = makeScene(); + rfront_inner[i] = Table_Index (rsTable, i, 1); // reads the value of the second col where i sits in the first col + } + } else { // proceed as usual calculating the values from the outermost mirror and the number of mirrors + printf ("automatic calulation\n"); + rfront_inner = get_r_at_z0 (nummirror, 0, r_0, lStart, sourceDist, LEnd, lStart, lEnd); + // calculate the r-distances of all mirrors at the entry of the NMO, we will need this later + } + if (sourceDist == 0) { // obsolete? + sourceDist = LStart; + } + silicon = (mirror_width == 0) ? 0 : -1; // neutron starts in air by default + // Load Reflectivity Data File TODO + // Make new scene + s = makeScene (); - //Set Scene to use custom trace function for conic - //s.traceNeutronConic = traceNeutronConicWithTables; + // Set Scene to use custom trace function for conic + // s.traceNeutronConic = traceNeutronConicWithTables; - //Add Geometry Here + // Add Geometry Here + for (int i = 0; i < nummirror; i++) { + p1 = makePoint (rfront_inner[i], 0, lStart); + addFlatEllipse (LStart, LEnd, p1, lStart, lEnd, -mirror_sidelength / 2, mirror_sidelength / 2, mf, R0, Qc, alpha, W, &s); // inner side of the mirror + printf ("b[%d] = %f\n", i, rfront_inner[i]); + } + if (mirror_width > 0) { for (int i = 0; i < nummirror; i++) { - p1 = makePoint(rfront_inner[i], 0, lStart); - addFlatEllipse(LStart, LEnd, p1, lStart, lEnd, -mirror_sidelength/2, mirror_sidelength/2, mf, R0,Qc,alpha,W, &s); //inner side of the mirror - printf("b[%d] = %f\n", i, rfront_inner[i]); + p1 = makePoint (rfront_inner[i] + mirror_width, 0, lStart); + addFlatEllipse (LStart, LEnd, p1, lStart, lEnd, -mirror_sidelength / 2, mirror_sidelength / 2, mb, R0, Qc, alpha, W, + &s); // backside of the above mirror shifted by mirror_width } - if (mirror_width > 0){ - for (int i = 0; i < nummirror; i++){ - p1 = makePoint(rfront_inner[i]+mirror_width, 0, lStart); - addFlatEllipse(LStart, LEnd, p1, lStart, lEnd, -mirror_sidelength/2, mirror_sidelength/2, mb, R0,Qc,alpha,W, &s); //backside of the above mirror shifted by mirror_width - } - } - addEndDisk(lEnd, 0.0, 2000, &s); //neutrons will be propagated to the end of the assembly, important if they still have to move through silicon to be refracted at the correct position - //addEllipsoid(-L, L,p1, -l,+l, 40,&s); + } + addEndDisk (lEnd, 0.0, 2000, &s); // neutrons will be propagated to the end of the assembly, important if they still have to move through silicon to be + // refracted at the correct position addEllipsoid(-L, L,p1, -l,+l, 40,&s); %} TRACE %{ - double dt; - double x_check; - - dt = (-z + lStart)/vz; - if (dt < 0) { - printf("negative time\n"); - } - PROP_DT(dt); //propagate neutron to the entrance window of the NMO + double dt; + double x_check; - /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=silicon; + dt = (-z + lStart) / vz; + if (dt < 0) { + printf ("negative time\n"); + } + PROP_DT (dt); // propagate neutron to the entrance window of the NMO - if (mirror_width>0){ // if the width of the mirrors is finite neutrons have to know whether they are in silicon or not - x_check = fabs(x);//lateral component of the neutron which determines whether the neutron arrives in silicon - for (int i = 0; i < nummirror; i++){ - dt = fabs(rfront_inner[i]); //make sure the mirror distance to check against is positive, repeated use of same variable don't do this at home - if (dt +mirror_width >= x_check){ //backside of the substrate further out than neutron - if (dt <= x_check) { // mirror itself closer to the optical axis than the neutrons, i.e., we arrive in silicon - /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ - _mctmp_a=1; - //First we have to refract at the entrance - Vec nStart = makeVec(0, 0, 1); //surface normal is oriented in beam direction hopefully - Vec init_vec = get_class_particleVel(*_particle); - refractNeutronFlat(_particle, nStart, 0, 0.478);//m_{silicon} = 0.478 laut Peter - break; - } - } - else{ //backside of the mirror is closer to optical axis than neutron; as all further mirrors are even closer we can break here - break; - } + /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ + _mctmp_a = silicon; + if (mirror_width > 0) { // if the width of the mirrors is finite neutrons have to know whether they are in silicon or not + x_check = fabs (x); // lateral component of the neutron which determines whether the neutron arrives in silicon + for (int i = 0; i < nummirror; i++) { + dt = fabs (rfront_inner[i]); // make sure the mirror distance to check against is positive, repeated use of same variable don't do this at home + if (dt + mirror_width >= x_check) { // backside of the substrate further out than neutron + if (dt <= x_check) { // mirror itself closer to the optical axis than the neutrons, i.e., we arrive in silicon + /* "_mctmp_a" defines a "silicon" state variable in underlying conic.h functions */ + _mctmp_a = 1; + // First we have to refract at the entrance + Vec nStart = makeVec (0, 0, 1); // surface normal is oriented in beam direction hopefully + Vec init_vec = get_class_particleVel (*_particle); + refractNeutronFlat (_particle, nStart, 0, 0.478); // m_{silicon} = 0.478 laut Peter + break; } + } else { // backside of the mirror is closer to optical axis than neutron; as all further mirrors are even closer we can break here + break; + } } + } - traceSingleNeutron(_particle,s); - Vec nEnd = makeVec(0, 0, 1); - if (_mctmp_a==1){//if the neutron arrives at the end of the mirror assembly while still in silicon, it will refract again at the end of the mirror - refractNeutronFlat(_particle, nEnd, 0.478, 0);//TODO add functionality to put whatever critical angle - } + traceSingleNeutron (_particle, s); + Vec nEnd = makeVec (0, 0, 1); + if (_mctmp_a == 1) { // if the neutron arrives at the end of the mirror assembly while still in silicon, it will refract again at the end of the mirror + refractNeutronFlat (_particle, nEnd, 0.478, 0); // TODO add functionality to put whatever critical angle + } if (!_particle->_absorbed) { SCATTER; } - %} FINALLY %{ @@ -278,7 +274,6 @@ MCDISPLAY//TODO this does not work as of now does not show the orientation of th /* line(0, s.di[i].r0, s.di[i].z0, 0, s.di[i].r1,s.di[i].z0); */ /* line(0, -s.di[i].r0, s.di[i].z0, 0, -s.di[i].r1,s.di[i].z0); */ /* } */ - %} END diff --git a/mcstas-comps/contrib/Foil_flipper_magnet.comp b/mcstas-comps/contrib/Foil_flipper_magnet.comp index b5a7a59ac..6bcc44bf7 100644 --- a/mcstas-comps/contrib/Foil_flipper_magnet.comp +++ b/mcstas-comps/contrib/Foil_flipper_magnet.comp @@ -61,80 +61,85 @@ SETTING PARAMETERS(stray_field=1,xwidth, yheight, zdepth, Bxwidth=-1, Byheight=- SHARE %{ -/* Declare structures and functions only once in each instrument. */ -#ifndef POL_LIB_H -%include "pol-lib" -#endif + /* Declare structures and functions only once in each instrument. */ + #ifndef POL_LIB_H + %include "pol-lib" + #endif -#pragma acc routine -void foil_spin_rot(double *sx, double *sy, double *sz, double *vx, double *vy, double *vz, double phi, double th, double b){ - /*the spin flip is actually a precession around the field vector - in this case this vector is - * in the foil plane, perp. to X, i.e. Z rotated by phi.*/ - double ux,uy,uz,s,cx,cy,cz; - double theta,v,lamb,teff; + #pragma acc routine + void + foil_spin_rot (double* sx, double* sy, double* sz, double* vx, double* vy, double* vz, double phi, double th, double b) { + /*the spin flip is actually a precession around the field vector - in this case this vector is + * in the foil plane, perp. to X, i.e. Z rotated by phi.*/ + double ux, uy, uz, s, cx, cy, cz; + double theta, v, lamb, teff; - /*now use (0,0,1) as a vector to rotate (flip) around to mimic the use of correction coils.*/ - ux=uy=0;uz=1; - //ux=0;uy=sin(phi);uz=cos(phi); - if (b < 0) { - uy = -uy; - uz = -uz; - } - v=sqrt(*vx * *vx + *vy * *vy + *vz * *vz); - lamb = 2*PI*K2V/v; - teff = th/sin(phi); - /* Calculate the flipping angle theta by c*t*Bs*lambda - * where c is the neutron precession constant [T^-1*m^-2], t is the - * foil thickness [um], Bs is the induced magnetic field strength - * in the foil [T] and lambda is the neutron wavelength [m] */ - theta = 4.6368*1e14*teff*1e-6*1*lamb*1e-10; - /*Rodigues formula for roatating a vector around a unit vector. - * v_rot=v*cos(theta) + uxv * sin(theta) + (u dot v)u(1-cos(theta)*/ - - cx=*sz*uy-*sy*uz; - cy=*sx*uz-*sz*ux; - cz=*sy*ux-*sx*uy; - s=scalar_prod(ux,uy,uz,*sx,*sy,*sz); - *sx=*sx*cos(theta) + cx*sin(theta) + s*ux*(1-cos(theta)); - *sy=*sy*cos(theta) + cy*sin(theta) + s*uy*(1-cos(theta)); - *sz=*sz*cos(theta) + cz*sin(theta) + s*uz*(1-cos(theta)); -} + /*now use (0,0,1) as a vector to rotate (flip) around to mimic the use of correction coils.*/ + ux = uy = 0; + uz = 1; + // ux=0;uy=sin(phi);uz=cos(phi); + if (b < 0) { + uy = -uy; + uz = -uz; + } + v = sqrt (*vx * *vx + *vy * *vy + *vz * *vz); + lamb = 2 * PI * K2V / v; + teff = th / sin (phi); + /* Calculate the flipping angle theta by c*t*Bs*lambda + * where c is the neutron precession constant [T^-1*m^-2], t is the + * foil thickness [um], Bs is the induced magnetic field strength + * in the foil [T] and lambda is the neutron wavelength [m] */ + theta = 4.6368 * 1e14 * teff * 1e-6 * 1 * lamb * 1e-10; + /*Rodigues formula for roatating a vector around a unit vector. + * v_rot=v*cos(theta) + uxv * sin(theta) + (u dot v)u(1-cos(theta)*/ -#pragma acc routine -void foil_spin_flip(double *sx, double *sy, double *sz, double lamb, double phi){ - /*the spin flip is actually a precession around the field vector - in this case this vector is - * in the foil plane, perp. to X, i.e. Z rotated by phi.*/ - double ux,uy,uz,s; - ux=0;uy=sin(phi);uz=cos(phi); - /*Rodigues formula for roatating a vector around a unit vector. - * v_rot=v*cos(theta) + uxv * sin(theta) + (u dot v)u(1-cos(theta) - * theta=180 deg. => v_rot =-v + 2*(u dot v)u*/ - s=scalar_prod(ux,uy,uz,*sx,*sy,*sz); - *sx=-*sx+2*s*ux; - *sy=-*sy+2*s*uy; - *sz=-*sz+2*s*uz; -} + cx = *sz * uy - *sy * uz; + cy = *sx * uz - *sz * ux; + cz = *sy * ux - *sx * uy; + s = scalar_prod (ux, uy, uz, *sx, *sy, *sz); + *sx = *sx * cos (theta) + cx * sin (theta) + s * ux * (1 - cos (theta)); + *sy = *sy * cos (theta) + cy * sin (theta) + s * uy * (1 - cos (theta)); + *sz = *sz * cos (theta) + cz * sin (theta) + s * uz * (1 - cos (theta)); + } -int exp_dec_magnetic_field (double x, double y, double z, double t, double *Bx, double *By, double *Bz, void *data){ - double *prms = (double *)data; - double b; - /*parameters are in the order, Bx0,By0,Bz0,z0, where z0 is the point from which B is decaying*/ - if(z v_rot =-v + 2*(u dot v)u*/ + s = scalar_prod (ux, uy, uz, *sx, *sy, *sz); + *sx = -*sx + 2 * s * ux; + *sy = -*sy + 2 * s * uy; + *sz = -*sz + 2 * s * uz; } - *Bx=prms[0]*b; - *By=prms[1]*b; - *Bz=prms[2]*b; -} + int + exp_dec_magnetic_field (double x, double y, double z, double t, double* Bx, double* By, double* Bz, void* data) { + double* prms = (double*)data; + double b; + /*parameters are in the order, Bx0,By0,Bz0,z0, where z0 is the point from which B is decaying*/ + if (z < prms[3]) { + b = 1; + } else { + b = exp (-fabs (z - prms[3])); + } + *Bx = prms[0] * b; + *By = prms[1] * b; + *Bz = prms[2] * b; + } %} DECLARE %{ /*Declarations of variables used in the whole of the component*/ - void *magnet_prms; + void* magnet_prms; double foil_n[3]; Rotation spin_flip; double inside_magnet[3]; @@ -147,156 +152,171 @@ INITIALIZE %{ /*default is to have the foil horizontal*/ Rotation foil_rot; - Coords n,tmp; + Coords n, tmp; - n.x=0;n.y=1;n.z=0; - rot_set_rotation(foil_rot,phi,0,0); - tmp=rot_apply(foil_rot,n); - foil_n[0]=tmp.x;foil_n[1]=tmp.y; foil_n[2]=tmp.z; + n.x = 0; + n.y = 1; + n.z = 0; + rot_set_rotation (foil_rot, phi, 0, 0); + tmp = rot_apply (foil_rot, n); + foil_n[0] = tmp.x; + foil_n[1] = tmp.y; + foil_n[2] = tmp.z; /*setup spin-flip rotation. This is equivalent to mirroring in the foil plane.*/ - if(verbose){ - printf("INFO: (%s) Foil normal: (%g %g %g)\n",NAME_CURRENT_COMP, foil_n[0],foil_n[1],foil_n[2]); + if (verbose) { + printf ("INFO: (%s) Foil normal: (%g %g %g)\n", NAME_CURRENT_COMP, foil_n[0], foil_n[1], foil_n[2]); } /*copy-paste from simpleBfield.comp*/ /*this should be a store_magnet type function in pol-lib i think*/ - Coords localG = rot_apply(ROT_A_CURRENT_COMP, coords_set(0,-GRAVITY,0)); - + Coords localG = rot_apply (ROT_A_CURRENT_COMP, coords_set (0, -GRAVITY, 0)); + /*initialize magnet parameters*/ - instray_magnet[1]=By; - instray_magnet[2]=Bz; - instray_magnet[3]=-zdepth/2.0; - - outstray_magnet[0]=Bx; - outstray_magnet[1]=By; - outstray_magnet[2]=Bz; - outstray_magnet[3]=zdepth/2.0; + instray_magnet[1] = By; + instray_magnet[2] = Bz; + instray_magnet[3] = -zdepth / 2.0; + + outstray_magnet[0] = Bx; + outstray_magnet[1] = By; + outstray_magnet[2] = Bz; + outstray_magnet[3] = zdepth / 2.0; - inside_magnet[0]=Bx; - inside_magnet[1]=By; - inside_magnet[2]=Bz; + inside_magnet[0] = Bx; + inside_magnet[1] = By; + inside_magnet[2] = Bz; /*if the magnetic field dimensions are not given, we assume there are no stray fields. I.e. the magnetic field does not extend beyond the magnet gap*/ -/* if (Bxwidth!=-1 && Byheight!=-1 && Bzdepth!=-1){*/ -/* stray_field=1;*/ -/* }*/ - if (Bxwidth==-1) Bxwidth=xwidth; - if (Byheight==-1) Byheight=yheight; - if (Bzdepth==-1) Bzdepth=zdepth; - if (verbose){ - printf("INFO (%s): xw,yh,zd=(%g %g %g), (Bxw,Byh,Bzd)=(%g %g %g)\n",NAME_CURRENT_COMP,xwidth,yheight,zdepth,Bxwidth,Byheight,Bzdepth); - if (foil_in) printf("INFO (%s): Foil is IN\n",NAME_CURRENT_COMP); - else printf("INFO (%s): Foil is OUT\n", NAME_CURRENT_COMP); + /* if (Bxwidth!=-1 && Byheight!=-1 && Bzdepth!=-1){*/ + /* stray_field=1;*/ + /* }*/ + if (Bxwidth == -1) + Bxwidth = xwidth; + if (Byheight == -1) + Byheight = yheight; + if (Bzdepth == -1) + Bzdepth = zdepth; + if (verbose) { + printf ("INFO (%s): xw,yh,zd=(%g %g %g), (Bxw,Byh,Bzd)=(%g %g %g)\n", NAME_CURRENT_COMP, xwidth, yheight, zdepth, Bxwidth, Byheight, Bzdepth); + if (foil_in) + printf ("INFO (%s): Foil is IN\n", NAME_CURRENT_COMP); + else + printf ("INFO (%s): Foil is OUT\n", NAME_CURRENT_COMP); } %} TRACE %{ - double t1,t2,t3,t4,dt; - double sp,v; - mcmagnet_field_info *old_magnet,*outer_magnet; - double *dd; - v=sqrt(vx*vx + vy*vy + vz*vz); + double t1, t2, t3, t4, dt; + double sp, v; + mcmagnet_field_info *old_magnet, *outer_magnet; + double* dd; + v = sqrt (vx * vx + vy * vy + vz * vz); /*check if we hit component at all*/ - if (plane_intersect(&t1,x,y,z,vx,vy,vz,0,0,1,0,0,-Bzdepth/2.0)==0){ - if(verbose) fprintf(stderr,"INFO: (%s) Missed the magnetic field plane.\n",NAME_CURRENT_COMP); - ABSORB; + if (plane_intersect (&t1, x, y, z, vx, vy, vz, 0, 0, 1, 0, 0, -Bzdepth / 2.0) == 0) { + if (verbose) + fprintf (stderr, "INFO: (%s) Missed the magnetic field plane.\n", NAME_CURRENT_COMP); + ABSORB; } - if ( (box_intersect(&t1, &t2, x, y, z, vx, vy, vz, Bxwidth, Byheight, Bzdepth))==0){ - /*propagate to the start of the component (which is -Bzdepth/2)*/ - if(verbose) fprintf(stderr,"INFO: (%s) Missed the magnetic field.\n",NAME_CURRENT_COMP); - ABSORB; + if ((box_intersect (&t1, &t2, x, y, z, vx, vy, vz, Bxwidth, Byheight, Bzdepth)) == 0) { + /*propagate to the start of the component (which is -Bzdepth/2)*/ + if (verbose) + fprintf (stderr, "INFO: (%s) Missed the magnetic field.\n", NAME_CURRENT_COMP); + ABSORB; } - if (t1<0){ - if(verbose) fprintf(stderr,"WARNING (%s): Neutron is already inside component on entry.\n",NAME_CURRENT_COMP); - }else{ - PROP_DT(t1); - t2=t2-t1; + if (t1 < 0) { + if (verbose) + fprintf (stderr, "WARNING (%s): Neutron is already inside component on entry.\n", NAME_CURRENT_COMP); + } else { + PROP_DT (t1); + t2 = t2 - t1; } /*There is an implicit assumption here that the neutron has entered at z1e-9){ - PROP_DT(t3); - t4=t4-t3; - t2=t2-t3; + if (t3 > 1e-9) { + PROP_DT (t3); + t4 = t4 - t3; + t2 = t2 - t3; } /*pop out the stray field description if necessary*/ - if(stray_field) mcmagnet_pop(_particle);//this could be done with a stop bit in the magnet parameters - + if (stray_field) + mcmagnet_pop (_particle); // this could be done with a stop bit in the magnet parameters + /*inject another field description for the magnetic field betweeen pole shoes.*/ - mcmagnet_push(_particle,constant,&(ROT_A_CURRENT_COMP),&(POS_A_CURRENT_COMP),1,inside_magnet); - + mcmagnet_push (_particle, constant, &(ROT_A_CURRENT_COMP), &(POS_A_CURRENT_COMP), 1, inside_magnet); + /*see if we hit the magnet walls before we exit*/ - if (plane_intersect(&dt,x,y,z,vx,vy,vz,0,0,1,0,0,zdepth/2.0)==0){ - fprintf(stdout,"INFO: (%s) Missed the end plane of the magnet - this should not be\n",NAME_CURRENT_COMP); + if (plane_intersect (&dt, x, y, z, vx, vy, vz, 0, 0, 1, 0, 0, zdepth / 2.0) == 0) { + fprintf (stdout, "INFO: (%s) Missed the end plane of the magnet - this should not be\n", NAME_CURRENT_COMP); ABSORB; } - if (fabs(dt-t4)>FLT_EPSILON) { - if(verbose) fprintf(stdout,"INFO: (%s) hit magnet from inside gap.\n",NAME_CURRENT_COMP); - mcmagnet_pop(_particle); + if (fabs (dt - t4) > FLT_EPSILON) { + if (verbose) + fprintf (stdout, "INFO: (%s) hit magnet from inside gap.\n", NAME_CURRENT_COMP); + mcmagnet_pop (_particle); ABSORB; } /*neutron is inside magnet gap - propagate to the foil plane or leave the neutron if it does not hit the plane while inside the gap*/ - if (foil_in){ - if (plane_intersect(&dt,x,y,z,vx,vy,vz,foil_n[0],foil_n[1],foil_n[2],0,0,0)==0 || dt<0 || dt>t4 ){ - if(verbose) fprintf(stderr,"INFO: (%s) Missed the foil flipper plane, (dt=%g).\n",NAME_CURRENT_COMP,dt); - dt=dt; - hit_foil=0; - } - else{ - PROP_DT(dt); - t4=t4-dt; - t2=t2-dt; + if (foil_in) { + if (plane_intersect (&dt, x, y, z, vx, vy, vz, foil_n[0], foil_n[1], foil_n[2], 0, 0, 0) == 0 || dt < 0 || dt > t4) { + if (verbose) + fprintf (stderr, "INFO: (%s) Missed the foil flipper plane, (dt=%g).\n", NAME_CURRENT_COMP, dt); + dt = dt; + hit_foil = 0; + } else { + PROP_DT (dt); + t4 = t4 - dt; + t2 = t2 - dt; /* at the foil - so flip spin/polarization*/ - if (foilthick == 0.0){ - foil_spin_flip(&sx,&sy,&sz,0.0,phi); - }else{ - foil_spin_rot(&sx , &sy , &sz , &vx , &vy , &vz , phi , foilthick, By); + if (foilthick == 0.0) { + foil_spin_flip (&sx, &sy, &sz, 0.0, phi); + } else { + foil_spin_rot (&sx, &sy, &sz, &vx, &vy, &vz, phi, foilthick, By); } - hit_foil=1; + hit_foil = 1; } } /*propagate to the other end of the magnet gap*/ - PROP_DT(t4); - t2=t2-t4; + PROP_DT (t4); + t2 = t2 - t4; /*pop the "inner" magnetic field*/ - mcmagnet_pop(_particle); - - if(stray_field) - mcmagnet_push(_particle,0,&(ROT_A_CURRENT_COMP),&(POS_A_CURRENT_COMP),0,outstray_magnet); - if (t2>1e-9){ + mcmagnet_pop (_particle); + + if (stray_field) + mcmagnet_push (_particle, 0, &(ROT_A_CURRENT_COMP), &(POS_A_CURRENT_COMP), 0, outstray_magnet); + if (t2 > 1e-9) { /*propagate to the end of the component*/ - PROP_DT(t2); + PROP_DT (t2); } /*pop the 2nd stray field*/ - if(stray_field){ - mcmagnet_pop(_particle); + if (stray_field) { + mcmagnet_pop (_particle); } - %} MCDISPLAY %{ - double y=atan(phi)*zdepth/2.0; - - box(0.0,0.0,0.0,Bxwidth,Byheight,Bzdepth,0, 0, 1, 0); - if (Bxwidth!=xwidth || Byheight!=yheight || Bzdepth!=zdepth){ - box(0,0,0,xwidth,yheight,zdepth,0, 0, 1, 0); + double y = atan (phi) * zdepth / 2.0; + + box (0.0, 0.0, 0.0, Bxwidth, Byheight, Bzdepth, 0, 0, 1, 0); + if (Bxwidth != xwidth || Byheight != yheight || Bzdepth != zdepth) { + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); } /*draw the foil plane*/ - multiline(5,-xwidth/2.0,-y,-zdepth/2.0, xwidth/2.0,-y,-zdepth/2.0, xwidth/2.0,y,zdepth/2.0, -xwidth/2.0,y,zdepth/2.0, -xwidth/2.0,-y,-zdepth/2.0); + multiline (5, -xwidth / 2.0, -y, -zdepth / 2.0, xwidth / 2.0, -y, -zdepth / 2.0, xwidth / 2.0, y, zdepth / 2.0, -xwidth / 2.0, y, zdepth / 2.0, -xwidth / 2.0, + -y, -zdepth / 2.0); %} END diff --git a/mcstas-comps/contrib/GISANS_sample.comp b/mcstas-comps/contrib/GISANS_sample.comp index e8ee7a89f..3665c3d64 100644 --- a/mcstas-comps/contrib/GISANS_sample.comp +++ b/mcstas-comps/contrib/GISANS_sample.comp @@ -81,1634 +81,1841 @@ phiPS = 0.1, Rad = 370.0, phirot=0.0, sc_aim=0.98, sans_aim=0.98 SHARE %{ -double gs_min(double A, double B) { -if (AB) return A; else return B; -}; - -double complsqrt(double re, double im, double *imsqrt) { - double resqrt; - double ratio; - if (re==0.0) {ratio=1e32;} else {ratio = fabs(im/re);}; - if (ratio<0.027) { - if (re>0) {resqrt = sqrt(0.5*(sqrt(re*re+im*im)+re)); - *imsqrt = 0.5*sqrt( re)*ratio*(1.0-0.125*ratio*ratio*(1.0-0.4375*ratio*ratio));} - else {resqrt = 0.5*sqrt(-re)*ratio*(1.0-0.125*ratio*ratio*(1.0-0.4375*ratio*ratio)); - *imsqrt = sqrt(0.5*(sqrt(re*re+im*im)-re));} } - else { resqrt = sqrt(0.5*(sqrt(re*re+im*im)+re)); - *imsqrt = sqrt(0.5*(sqrt(re*re+im*im)-re)); }; - if (im<0) *imsqrt = -*imsqrt; - return resqrt; -}; - -double calclayers(double xiref, double bref, double vz, double vzi, double v, - double* zt, - double* xi, double* beta, - double* v2re, double* v2im, - double* Ot1, double* Ot2, - double* In1, double* In2 - ) { -/* vz und vzi haben beide das Vorzeichen der Richtung */ -int i; -double t11re[7], t11im[7]; -double t12re[7], t12im[7]; -double d11re[8], d11im[8]; -double d22re[8], d22im[8]; -double vv1re,vv1im,vv2re,vv2im; -double vs1re[8],vs1im[8],vs2re[8],vs2im[8]; -double vb1re[8],vb1im[8],vb2re[8],vb2im[8]; -double www, wwi; -double sintheta; -double cmpabs; -double argre,argim; -double sign; -double limit; - -/*limit=59.09079715;*/ -limit=18.42; - -/* fprintf(stderr, "%e %e\n", vz, vzi); */ -sintheta = fabs(vz)/v; -sign = 1.0; -if (vz<0.0) {sign=-1.0;}; - -for (i=0; i<=7; i++) { - www = complsqrt(xiref-xi[i]+(1.0-xiref)*sintheta*sintheta,beta[i]-bref*(1.0-sintheta*sintheta),&wwi); - cmpabs = sqrt(vz*vz+vzi*vzi); -/*if (wwi>=0.0) { */ - v2re[i] = v * ( www * vz - wwi * vzi ) / cmpabs; - v2im[i] = v * ( wwi * vz + www * vzi ) / cmpabs; /*} else { + double + gs_min (double A, double B) { + if (A < B) + return A; + else + return B; + }; + + double + gs_max (double A, double B) { + if (A > B) + return A; + else + return B; + }; + + double + complsqrt (double re, double im, double* imsqrt) { + double resqrt; + double ratio; + if (re == 0.0) { + ratio = 1e32; + } else { + ratio = fabs (im / re); + }; + if (ratio < 0.027) { + if (re > 0) { + resqrt = sqrt (0.5 * (sqrt (re * re + im * im) + re)); + *imsqrt = 0.5 * sqrt (re) * ratio * (1.0 - 0.125 * ratio * ratio * (1.0 - 0.4375 * ratio * ratio)); + } else { + resqrt = 0.5 * sqrt (-re) * ratio * (1.0 - 0.125 * ratio * ratio * (1.0 - 0.4375 * ratio * ratio)); + *imsqrt = sqrt (0.5 * (sqrt (re * re + im * im) - re)); + } + } else { + resqrt = sqrt (0.5 * (sqrt (re * re + im * im) + re)); + *imsqrt = sqrt (0.5 * (sqrt (re * re + im * im) - re)); + }; + if (im < 0) + *imsqrt = -*imsqrt; + return resqrt; + }; + + double + calclayers (double xiref, double bref, double vz, double vzi, double v, double* zt, double* xi, double* beta, double* v2re, double* v2im, double* Ot1, + double* Ot2, double* In1, double* In2) { + /* vz und vzi haben beide das Vorzeichen der Richtung */ + int i; + double t11re[7], t11im[7]; + double t12re[7], t12im[7]; + double d11re[8], d11im[8]; + double d22re[8], d22im[8]; + double vv1re, vv1im, vv2re, vv2im; + double vs1re[8], vs1im[8], vs2re[8], vs2im[8]; + double vb1re[8], vb1im[8], vb2re[8], vb2im[8]; + double www, wwi; + double sintheta; + double cmpabs; + double argre, argim; + double sign; + double limit; + + /*limit=59.09079715;*/ + limit = 18.42; + + /* fprintf(stderr, "%e %e\n", vz, vzi); */ + sintheta = fabs (vz) / v; + sign = 1.0; + if (vz < 0.0) { + sign = -1.0; + }; + + for (i = 0; i <= 7; i++) { + www = complsqrt (xiref - xi[i] + (1.0 - xiref) * sintheta * sintheta, beta[i] - bref * (1.0 - sintheta * sintheta), &wwi); + cmpabs = sqrt (vz * vz + vzi * vzi); + /*if (wwi>=0.0) { */ + v2re[i] = v * (www * vz - wwi * vzi) / cmpabs; + v2im[i] = v * (wwi * vz + www * vzi) / cmpabs; /*} else { v2re[i] =-v * ( www * vz - wwi * vzi ) / cmpabs; v2im[i] =-v * ( wwi * vz + www * vzi ) / cmpabs; };*/ -/* if(v2re[i]<0.0){v2re[i]=-v2re[i];v2im[i]=-v2im[i];}; */ -/* fprintf(stderr, "%i %e %e\n", i, v2re[i], v2im[i]); */ - argre = v2re[i]*zt[i]*sign*1e10/K2V; - argim = v2im[i]*zt[i]*sign*1e10/K2V; -/*if (fabs(argre)>3.141592654e6) {argre=2.0*PI*rand01();}; */ /* no interferences anymore ---- IS THIS NEEDED ???????? */ - if (argim> limit) {argim = limit;} else { - if (argim<-limit) {argim =-limit;}; }; /* truncate large exponents to approx. float precision */ - d11re[i] = cos(argre)*exp( argim); - d11im[i] =-sin(argre)*exp( argim); - d22re[i] = cos(argre)*exp(-argim); - d22im[i] = sin(argre)*exp(-argim); -}; -for (i=0; i<=6; i++) { -if ((vz>=0.0 && i<6) || (vz<0.0 && i<1)) { -cmpabs = 2.0*(v2re[i]*v2re[i]+v2im[i]*v2im[i]); -t11re[i] = (v2re[i+1]*v2re[i]+v2im[i+1]*v2im[i])/cmpabs; -t11im[i] = (v2im[i+1]*v2re[i]-v2re[i+1]*v2im[i])/cmpabs; - } else { -cmpabs = 2.0*(v2re[i+1]*v2re[i+1]+v2im[i+1]*v2im[i+1]); -t11re[i] = (v2re[i]*v2re[i+1]+v2im[i]*v2im[i+1])/cmpabs; -t11im[i] = (v2im[i]*v2re[i+1]-v2re[i]*v2im[i+1])/cmpabs; -}; -t12re[i] = 0.5-t11re[i]; -t12im[i] = -t11im[i]; -t11re[i]+= 0.5; -}; - -vv1re = 0.0; -vv1im = 0.0; -vv2re = exp(-3.0*limit); -vv2im = 0.0; - -if (vz>=0) { -vb1re[7] = vv1re; -vb1im[7] = vv1im; -vb2re[7] = vv2re; -vb2im[7] = vv2im; -vs1re[7] = t11re[6]*vv1re - t11im[6]*vv1im + t12re[6]*vv2re - t12im[6]*vv2im; -vs1im[7] = t11re[6]*vv1im + t11im[6]*vv1re + t12re[6]*vv2im + t12im[6]*vv2re; -vs2re[7] = t12re[6]*vv1re - t12im[6]*vv1im + t11re[6]*vv2re - t11im[6]*vv2im; -vs2im[7] = t12re[6]*vv1im + t12im[6]*vv1re + t11re[6]*vv2im + t11im[6]*vv2re; -for (i=6; i>=1; i--) { -vs1re[i] = d11re[i]*vv1re - d11im[i]*vv1im; -vs1im[i] = d11re[i]*vv1im + d11im[i]*vv1re; -vs2re[i] = d22re[i]*vv2re - d22im[i]*vv2im; -vs2im[i] = d22re[i]*vv2im + d22im[i]*vv2re; -vv1re = vs1re[i]; -vv1im = vs1im[i]; -vv2re = vs2re[i]; -vv2im = vs2im[i]; -vb1re[i] = t11re[i-1]*vv1re - t11im[i-1]*vv1im + t12re[i-1]*vv2re - t12im[i-1]*vv2im; -vb1im[i] = t11re[i-1]*vv1im + t11im[i-1]*vv1re + t12re[i-1]*vv2im + t12im[i-1]*vv2re; -vb2re[i] = t12re[i-1]*vv1re - t12im[i-1]*vv1im + t11re[i-1]*vv2re - t11im[i-1]*vv2im; -vb2im[i] = t12re[i-1]*vv1im + t12im[i-1]*vv1re + t11re[i-1]*vv2im + t11im[i-1]*vv2re; -vv1re = vb1re[i]; -vv1im = vb1im[i]; -vv2re = vb2re[i]; -vv2im = vb2im[i]; -}; -vs1re[0] = 0.0; -vs1im[0] = 0.0; -vs2re[0] = 0.0; -vs2im[0] = 0.0; -vb1re[0] = 0.0; -vb1im[0] = 0.0; -vb2re[0] = 0.0; -vb2im[0] = 0.0; -} else { -vb1re[0] = vv1re; -vb1im[0] = vv1im; -vb2re[0] = vv2re; -vb2im[0] = vv2im; -vs1re[0] = t11re[0]*vv1re - t11im[0]*vv1im + t12re[0]*vv2re - t12im[0]*vv2im; -vs1im[0] = t11re[0]*vv1im + t11im[0]*vv1re + t12re[0]*vv2im + t12im[0]*vv2re; -vs2re[0] = t12re[0]*vv1re - t12im[0]*vv1im + t11re[0]*vv2re - t11im[0]*vv2im; -vs2im[0] = t12re[0]*vv1im + t12im[0]*vv1re + t11re[0]*vv2im + t11im[0]*vv2re; -for (i=1; i<=6; i++) { -vs1re[i] = d11re[i]*vv1re - d11im[i]*vv1im; -vs1im[i] = d11re[i]*vv1im + d11im[i]*vv1re; -vs2re[i] = d22re[i]*vv2re - d22im[i]*vv2im; -vs2im[i] = d22re[i]*vv2im + d22im[i]*vv2re; -vv1re = vs1re[i]; -vv1im = vs1im[i]; -vv2re = vs2re[i]; -vv2im = vs2im[i]; -vb1re[i] = t11re[i]*vv1re - t11im[i]*vv1im + t12re[i]*vv2re - t12im[i]*vv2im; -vb1im[i] = t11re[i]*vv1im + t11im[i]*vv1re + t12re[i]*vv2im + t12im[i]*vv2re; -vb2re[i] = t12re[i]*vv1re - t12im[i]*vv1im + t11re[i]*vv2re - t11im[i]*vv2im; -vb2im[i] = t12re[i]*vv1im + t12im[i]*vv1re + t11re[i]*vv2im + t11im[i]*vv2re; -vv1re = vb1re[i]; -vv1im = vb1im[i]; -vv2re = vb2re[i]; -vv2im = vb2im[i]; -}; -vs1re[7] = 0.0; -vs1im[7] = 0.0; -vs2re[7] = 0.0; -vs2im[7] = 0.0; -vb1re[7] = 0.0; -vb1im[7] = 0.0; -vb2re[7] = 0.0; -vb2im[7] = 0.0; -}; - -for (i=0; i<=7; i++) { -Ot1[i] = vb1re[i]*vb1re[i] + vb1im[i]*vb1im[i]; -Ot2[i] = vb2re[i]*vb2re[i] + vb2im[i]*vb2im[i]; -In1[i] = vs1re[i]*vs1re[i] + vs1im[i]*vs1im[i]; -In2[i] = vs2re[i]*vs2re[i] + vs2im[i]*vs2im[i]; -}; -return 0.0; -}; /* end subroutine calclayers */ - - - -/* NEUTRON CROSS SECTIONS (SANS) */ - -double dSigdW(double phi, double Rad, double drho, double rotphi, - double dvx, double dvy, double dvz, double dvzi, double sign, - double zthck ) { - -double ac,a111,d111,dpln; -double phi0; -int i; -double vec1x,vec1y,vec1z,vec2x,vec2y,vec2z,vec3x,vec3y,vec3z,vec4x,vec4y,vec4z; -double Qx,Qy,Qz,QRre,QRim,QR2re,QR2im,QRQR,Q2xy,Q2z; -double QR1,QR2,QR3,QR4,QRz; -double Sig; -double snx,arg; -int NN; -double SF1,SF2,SF3,SFa; -double SF3re,SF3im,Sp3re,Sp3im; -double FFre,FFim,FF; -double epre,epim,emre,emim; -double dex,ddw,fnc,dmp; -double number; -double corrlen; -double xidwfxy,xidwfz; -double limit; -double fudgef; -int Nlz; -int Nz; -int Nxy; - -/*limit=59.09079715;*/ -limit=18.42; -fudgef=0.0250; - -xidwfxy = 180.0; /* Aangstroem, local precision for Debye Waller factor */ -xidwfz = 125.0; /* Aangstroem, local precision for Debye Waller factor */ - -/* these parameters are actually linked to wavelength resolution, so Nz = Nxy ~ (lambda / delta lambda) */ -/* the exact prefactor remains to be determined */ -Nlz= 3; /* number of different planes in z-direction, 3 for fcc lattice, 2 for hex with 2 different planes */ -Nz = 6; /* limited number of planes in z-direction, should be relatively small and multiples of 6: so 6 or 12 (or at least multiple of Nlz) */ -Nxy= 3; /* limited number of planes in xy-direction, should be relatively small, let's say between 4 and 12 */ - -corrlen = 3e4; /* additional correlation length in z-direction would limit the maximum correlation length, if not needed make it big, i.e. 1e6 */ - /* corrlen not really important */ - -ac = pow(PI/0.1875/fabs(phi),1.0/3.0)*fabs(Rad); /* units Aangstroem */ -a111 = sqrt(3.0)*ac; -d111 = a111/3.0; -dpln = sqrt(0.5)*ac; - -if (dvx==0.0) { phi0 = 0.5*PI; } - else { phi0 = atan(dvy/dvx); }; - -vec1x=dpln*cos(rotphi-phi0); -vec1y=dpln*sin(rotphi-phi0); -vec1z=0.0; -vec2x=dpln*cos(rotphi-phi0+PI/3.0); -vec2y=dpln*sin(rotphi-phi0+PI/3.0); -vec2z=0.0; -vec3x=(vec1x+vec2x)/3.0; -vec3y=(vec1y+vec2y)/3.0; -vec3z=d111; -vec4x=-vec3x; -vec4y=-vec3y; -vec4z=2.0*d111; - -QR1 = (dvx*vec1x+dvy*vec1y)/K2V; -QR2 = (dvx*vec2x+dvy*vec2y)/K2V; -QR3 = (dvx*vec3x+dvy*vec3y+sign*dvz*vec3z)/K2V; -QR4 = (dvx*vec4x+dvy*vec4y+sign*dvz*vec4z)/K2V; -QRz = sign*dvz*d111*Nlz/K2V; -QR2re = (dvx*dvx+dvy*dvy+dvz*dvz-dvzi*dvzi)*Rad*Rad/(K2V*K2V); -QR2im = 2.0*dvz*dvzi*Rad*Rad/(K2V*K2V); -QRQR = (dvx*dvx+dvy*dvy+dvz*dvz+dvzi*dvzi)*Rad*Rad/(K2V*K2V); -Q2xy = (dvx*dvx+dvy*dvy)/(K2V*K2V); -Q2z = (dvz*dvz+dvzi*dvzi)/(K2V*K2V); - -QR1 *= 0.5; -snx = sin(QR1); -if (fabs(snx)<0.01) { -arg = QR1-floor(QR1/PI+0.5)*PI; -arg*= arg; -NN = Nxy*Nxy; -SF1 = NN*(1.0-(NN-1)*arg/3.0+(2*NN*NN-5*NN+3)*arg*arg/45.0); -} else { -SF1 = sin(Nxy*QR1)/snx; -SF1 *= SF1; -}; - -QR2 *= 0.5; -snx = sin(QR2); -if (fabs(snx)<0.01) { -arg = QR2-floor(QR2/PI+0.5)*PI; -arg*= arg; -NN = Nxy*Nxy; -SF2 = NN*(1.0-(NN-1)*arg/3.0+(2*NN*NN-5*NN+3)*arg*arg/45.0); -} else { -SF2 = sin(Nxy*QR2)/snx; -SF2 *= SF2; -}; - -dex = sign*dvzi*vec3z/K2V; /* this is called s in calculations */ -if (fabs(dex)<1e-9) dex=1e-9; -ddw = 0.5*vec3z/corrlen; /* here correlation length for sigma */ -arg = sqrt(0.25*PI)*dex/ddw; - -if (arg>7.0) { -arg *= arg; -fnc = 1.0-(4.0-(40.0-(592.0-(11296.0-(261184.0-7066240.0/arg)/arg)/arg)/arg)/arg)/arg; -} else { -if (arg>1.0) { -arg -= 4.0; -fnc = 0.83632161198882839595+arg*( - 0.056582086644761999922+arg*( - -0.013426901882714073489+arg*( - 0.0026036629558670416522+arg*( - -0.00043493947025108071631+arg*( - 0.000063696401659655369894+arg*( - -8.15571922810475175216e-6+arg*( - 8.88360569009343837213e-7+arg*( - -7.53231914564623106045e-8+arg*( - 3.18537731810442393942e-9+arg* - 4.48953122905093423545e-10))))))))); -} else { -fnc = arg*(0.56418958354775628695+arg*( - -0.18169011381620932846+arg*( - 0.038539726238227489952+arg*( - -0.0047821117522591190687+arg*( - -0.000032686662549066312807+arg*( - 0.000159019306085059302185+arg*( - -0.000032272354631649569110+arg*( - 8.08407359778557261765e-7+arg*( - 1.13411148402714999777e-6-arg* - 2.90801221215845255891e-7))))))))); -}; }; -dex /= fnc; -if (dex> limit) dex = limit; -if (dex<-limit) dex = -limit; -dmp = exp(-dex); - -SF3re = 1.0; -SF3im = 0.0; -if (Nlz==2) { -SF3re += cos(QR3)*dmp; -SF3im += sin(QR3)*dmp; -} else { -SF3re += cos(QR3)*dmp+cos(QR4)*dmp*dmp; -SF3im += sin(QR3)*dmp+sin(QR4)*dmp*dmp; -}; -SF3re *= sqrt(dmp); -SF3im *= sqrt(dmp); - -if (Nlz==2) {dmp *= dmp;} else {dmp *= dmp*dmp;}; -Sp3re = 1.0; -Sp3im = 0.0; -for (i=1; i 0 */ - -if (QR2im> limit) QR2im = limit; -if (QR2im<-limit) QR2im = -limit; -if (QRQR<0.01) { -FFre = 1.0 -0.1*QR2re + (QR2re*QR2re-QR2im*QR2im)/280.0; -FFim = -0.1*QR2im + (QR2re*QR2im) /140.0; -FF = FFre*FFre + FFim*FFim; -} else { -QRre = complsqrt(QR2re,QR2im,&QRim); -epre = cos(QRre)*exp(-QRim); -epim = sin(QRre)*exp(-QRim); -emre = cos(QRre)*exp( QRim); -emim =-sin(QRre)*exp( QRim); -FFre = epim-emim-QRre*(epre+emre)+QRim*(epim+emim); -FFim = emre-epre-QRim*(epre+emre)-QRre*(epim+emim); -FF = 2.25*(FFre*FFre + FFim*FFim)/(QRQR*QRQR*QRQR); -}; - -dex = sign*Nz*dvzi*vec3z/K2V; /* this is called s in calculations */ -if (fabs(dex)<1e-9) dex=1e-9; -number = zthck*1e10/(d111*Nz); -/* berechne (1-exp(-number*dex))/(1-exp(-dex)) / (number) */ -arg = number*dex; -if (arg> limit) arg = limit; -if (arg<-limit) arg =-limit; -if (fabs(arg)<0.055) { -epre = arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*0.125)/7.0)/6.0)*0.2)*0.25)/3.0)*0.5); -} else { -epre = 1.0-exp(-arg); }; -arg = dex; -if (arg> limit) arg = limit; -if (arg<-limit) arg =-limit; -if (fabs(arg)<0.055) { -emre = arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*(1.0-arg*0.125)/7.0)/6.0)*0.2)*0.25)/3.0)*0.5); -} else { -emre = 1.0-exp(-arg); }; - -/* fprintf(stderr,"%e\n",fabs(fudgef*phi*drho*drho*PI/0.75e-8*Rad*Rad*Rad*FF*SFa*epre/emre/number)); */ -return fabs(fudgef*phi*drho*drho*PI/0.75e-8*Rad*Rad*Rad*FF*SFa*epre/emre/number); - -}; /* END OF SUBROUTINE CROSS SECTION */ - - -char outofthebox(double *t0, double *t1, double x, double y, double z, double vx, double vy, double vz, double xwidth, double yheight, double zthick -) { -double tt[2]; -char i; -double t,xx,yy,zz; - -i = 0; -tt[0] = 0.0; -tt[1] = 0.0; - -t = -z/vz; -xx = x + vx*t; -yy = y + vy*t; -if (fabs(x-xx)<=xwidth && fabs(y-yy)<=yheight) {tt[i]=t; i++;}; -if (i>=2) goto stop; - -t = (zthick-z)/vz; -xx = x + vx*t; -yy = y + vy*t; -if (fabs(x-xx)<=xwidth && fabs(y-yy)<=yheight) {tt[i]=t; i++;}; -if (i>=2) goto stop; - -t = (-0.5*xwidth-x)/vx; -yy = y + vy*t; -zz = z + vz*t; -if (fabs(y-yy)<=yheight && zz>=0.0 && zz<=zthick) {tt[i]=t; i++;}; -if (i>=2) goto stop; - -t = ( 0.5*xwidth-x)/vx; -yy = y + vy*t; -zz = z + vz*t; -if (fabs(y-yy)<=yheight && zz>=0.0 && zz<=zthick) {tt[i]=t; i++;}; -if (i>=2) goto stop; - -t = (-0.5*yheight-y)/vy; -xx = x + vx*t; -zz = z + vz*t; -if (fabs(x-xx)<=xwidth && zz>=0.0 && zz<=zthick) {tt[i]=t; i++;}; -if (i>=2) goto stop; - -t = ( 0.5*yheight-y)/vy; -xx = x + vx*t; -zz = z + vz*t; -if (fabs(x-xx)<=xwidth && zz>=0.0 && zz<=zthick) {tt[i]=t; i++;}; - -stop: - -*t0 = gs_min(tt[0],tt[1]); -*t1 = gs_max(tt[0],tt[1]); - -return i; -}; - - -char propbyt(double t, double *x, double *y, double *z, double vx, double vy, double vz -) { -*x += vx*t; -*y += vy*t; -*z += vz*t; -return 0; -}; + /* if(v2re[i]<0.0){v2re[i]=-v2re[i];v2im[i]=-v2im[i];}; */ + /* fprintf(stderr, "%i %e %e\n", i, v2re[i], v2im[i]); */ + argre = v2re[i] * zt[i] * sign * 1e10 / K2V; + argim = v2im[i] * zt[i] * sign * 1e10 / K2V; + /*if (fabs(argre)>3.141592654e6) {argre=2.0*PI*rand01();}; */ /* no interferences anymore ---- IS THIS NEEDED ???????? */ + if (argim > limit) { + argim = limit; + } else { + if (argim < -limit) { + argim = -limit; + }; + }; /* truncate large exponents to approx. float precision */ + d11re[i] = cos (argre) * exp (argim); + d11im[i] = -sin (argre) * exp (argim); + d22re[i] = cos (argre) * exp (-argim); + d22im[i] = sin (argre) * exp (-argim); + }; + for (i = 0; i <= 6; i++) { + if ((vz >= 0.0 && i < 6) || (vz < 0.0 && i < 1)) { + cmpabs = 2.0 * (v2re[i] * v2re[i] + v2im[i] * v2im[i]); + t11re[i] = (v2re[i + 1] * v2re[i] + v2im[i + 1] * v2im[i]) / cmpabs; + t11im[i] = (v2im[i + 1] * v2re[i] - v2re[i + 1] * v2im[i]) / cmpabs; + } else { + cmpabs = 2.0 * (v2re[i + 1] * v2re[i + 1] + v2im[i + 1] * v2im[i + 1]); + t11re[i] = (v2re[i] * v2re[i + 1] + v2im[i] * v2im[i + 1]) / cmpabs; + t11im[i] = (v2im[i] * v2re[i + 1] - v2re[i] * v2im[i + 1]) / cmpabs; + }; + t12re[i] = 0.5 - t11re[i]; + t12im[i] = -t11im[i]; + t11re[i] += 0.5; + }; + + vv1re = 0.0; + vv1im = 0.0; + vv2re = exp (-3.0 * limit); + vv2im = 0.0; + + if (vz >= 0) { + vb1re[7] = vv1re; + vb1im[7] = vv1im; + vb2re[7] = vv2re; + vb2im[7] = vv2im; + vs1re[7] = t11re[6] * vv1re - t11im[6] * vv1im + t12re[6] * vv2re - t12im[6] * vv2im; + vs1im[7] = t11re[6] * vv1im + t11im[6] * vv1re + t12re[6] * vv2im + t12im[6] * vv2re; + vs2re[7] = t12re[6] * vv1re - t12im[6] * vv1im + t11re[6] * vv2re - t11im[6] * vv2im; + vs2im[7] = t12re[6] * vv1im + t12im[6] * vv1re + t11re[6] * vv2im + t11im[6] * vv2re; + for (i = 6; i >= 1; i--) { + vs1re[i] = d11re[i] * vv1re - d11im[i] * vv1im; + vs1im[i] = d11re[i] * vv1im + d11im[i] * vv1re; + vs2re[i] = d22re[i] * vv2re - d22im[i] * vv2im; + vs2im[i] = d22re[i] * vv2im + d22im[i] * vv2re; + vv1re = vs1re[i]; + vv1im = vs1im[i]; + vv2re = vs2re[i]; + vv2im = vs2im[i]; + vb1re[i] = t11re[i - 1] * vv1re - t11im[i - 1] * vv1im + t12re[i - 1] * vv2re - t12im[i - 1] * vv2im; + vb1im[i] = t11re[i - 1] * vv1im + t11im[i - 1] * vv1re + t12re[i - 1] * vv2im + t12im[i - 1] * vv2re; + vb2re[i] = t12re[i - 1] * vv1re - t12im[i - 1] * vv1im + t11re[i - 1] * vv2re - t11im[i - 1] * vv2im; + vb2im[i] = t12re[i - 1] * vv1im + t12im[i - 1] * vv1re + t11re[i - 1] * vv2im + t11im[i - 1] * vv2re; + vv1re = vb1re[i]; + vv1im = vb1im[i]; + vv2re = vb2re[i]; + vv2im = vb2im[i]; + }; + vs1re[0] = 0.0; + vs1im[0] = 0.0; + vs2re[0] = 0.0; + vs2im[0] = 0.0; + vb1re[0] = 0.0; + vb1im[0] = 0.0; + vb2re[0] = 0.0; + vb2im[0] = 0.0; + } else { + vb1re[0] = vv1re; + vb1im[0] = vv1im; + vb2re[0] = vv2re; + vb2im[0] = vv2im; + vs1re[0] = t11re[0] * vv1re - t11im[0] * vv1im + t12re[0] * vv2re - t12im[0] * vv2im; + vs1im[0] = t11re[0] * vv1im + t11im[0] * vv1re + t12re[0] * vv2im + t12im[0] * vv2re; + vs2re[0] = t12re[0] * vv1re - t12im[0] * vv1im + t11re[0] * vv2re - t11im[0] * vv2im; + vs2im[0] = t12re[0] * vv1im + t12im[0] * vv1re + t11re[0] * vv2im + t11im[0] * vv2re; + for (i = 1; i <= 6; i++) { + vs1re[i] = d11re[i] * vv1re - d11im[i] * vv1im; + vs1im[i] = d11re[i] * vv1im + d11im[i] * vv1re; + vs2re[i] = d22re[i] * vv2re - d22im[i] * vv2im; + vs2im[i] = d22re[i] * vv2im + d22im[i] * vv2re; + vv1re = vs1re[i]; + vv1im = vs1im[i]; + vv2re = vs2re[i]; + vv2im = vs2im[i]; + vb1re[i] = t11re[i] * vv1re - t11im[i] * vv1im + t12re[i] * vv2re - t12im[i] * vv2im; + vb1im[i] = t11re[i] * vv1im + t11im[i] * vv1re + t12re[i] * vv2im + t12im[i] * vv2re; + vb2re[i] = t12re[i] * vv1re - t12im[i] * vv1im + t11re[i] * vv2re - t11im[i] * vv2im; + vb2im[i] = t12re[i] * vv1im + t12im[i] * vv1re + t11re[i] * vv2im + t11im[i] * vv2re; + vv1re = vb1re[i]; + vv1im = vb1im[i]; + vv2re = vb2re[i]; + vv2im = vb2im[i]; + }; + vs1re[7] = 0.0; + vs1im[7] = 0.0; + vs2re[7] = 0.0; + vs2im[7] = 0.0; + vb1re[7] = 0.0; + vb1im[7] = 0.0; + vb2re[7] = 0.0; + vb2im[7] = 0.0; + }; + + for (i = 0; i <= 7; i++) { + Ot1[i] = vb1re[i] * vb1re[i] + vb1im[i] * vb1im[i]; + Ot2[i] = vb2re[i] * vb2re[i] + vb2im[i] * vb2im[i]; + In1[i] = vs1re[i] * vs1re[i] + vs1im[i] * vs1im[i]; + In2[i] = vs2re[i] * vs2re[i] + vs2im[i] * vs2im[i]; + }; + return 0.0; + }; /* end subroutine calclayers */ + + /* NEUTRON CROSS SECTIONS (SANS) */ + + double + dSigdW (double phi, double Rad, double drho, double rotphi, double dvx, double dvy, double dvz, double dvzi, double sign, double zthck) { + + double ac, a111, d111, dpln; + double phi0; + int i; + double vec1x, vec1y, vec1z, vec2x, vec2y, vec2z, vec3x, vec3y, vec3z, vec4x, vec4y, vec4z; + double Qx, Qy, Qz, QRre, QRim, QR2re, QR2im, QRQR, Q2xy, Q2z; + double QR1, QR2, QR3, QR4, QRz; + double Sig; + double snx, arg; + int NN; + double SF1, SF2, SF3, SFa; + double SF3re, SF3im, Sp3re, Sp3im; + double FFre, FFim, FF; + double epre, epim, emre, emim; + double dex, ddw, fnc, dmp; + double number; + double corrlen; + double xidwfxy, xidwfz; + double limit; + double fudgef; + int Nlz; + int Nz; + int Nxy; + + /*limit=59.09079715;*/ + limit = 18.42; + fudgef = 0.0250; + + xidwfxy = 180.0; /* Aangstroem, local precision for Debye Waller factor */ + xidwfz = 125.0; /* Aangstroem, local precision for Debye Waller factor */ + + /* these parameters are actually linked to wavelength resolution, so Nz = Nxy ~ (lambda / delta lambda) */ + /* the exact prefactor remains to be determined */ + Nlz = 3; /* number of different planes in z-direction, 3 for fcc lattice, 2 for hex with 2 different planes */ + Nz = 6; /* limited number of planes in z-direction, should be relatively small and multiples of 6: so 6 or 12 (or at least multiple of Nlz) */ + Nxy = 3; /* limited number of planes in xy-direction, should be relatively small, let's say between 4 and 12 */ + + corrlen = 3e4; /* additional correlation length in z-direction would limit the maximum correlation length, if not needed make it big, i.e. 1e6 */ + /* corrlen not really important */ + + ac = pow (PI / 0.1875 / fabs (phi), 1.0 / 3.0) * fabs (Rad); /* units Aangstroem */ + a111 = sqrt (3.0) * ac; + d111 = a111 / 3.0; + dpln = sqrt (0.5) * ac; + + if (dvx == 0.0) { + phi0 = 0.5 * PI; + } else { + phi0 = atan (dvy / dvx); + }; + + vec1x = dpln * cos (rotphi - phi0); + vec1y = dpln * sin (rotphi - phi0); + vec1z = 0.0; + vec2x = dpln * cos (rotphi - phi0 + PI / 3.0); + vec2y = dpln * sin (rotphi - phi0 + PI / 3.0); + vec2z = 0.0; + vec3x = (vec1x + vec2x) / 3.0; + vec3y = (vec1y + vec2y) / 3.0; + vec3z = d111; + vec4x = -vec3x; + vec4y = -vec3y; + vec4z = 2.0 * d111; + + QR1 = (dvx * vec1x + dvy * vec1y) / K2V; + QR2 = (dvx * vec2x + dvy * vec2y) / K2V; + QR3 = (dvx * vec3x + dvy * vec3y + sign * dvz * vec3z) / K2V; + QR4 = (dvx * vec4x + dvy * vec4y + sign * dvz * vec4z) / K2V; + QRz = sign * dvz * d111 * Nlz / K2V; + QR2re = (dvx * dvx + dvy * dvy + dvz * dvz - dvzi * dvzi) * Rad * Rad / (K2V * K2V); + QR2im = 2.0 * dvz * dvzi * Rad * Rad / (K2V * K2V); + QRQR = (dvx * dvx + dvy * dvy + dvz * dvz + dvzi * dvzi) * Rad * Rad / (K2V * K2V); + Q2xy = (dvx * dvx + dvy * dvy) / (K2V * K2V); + Q2z = (dvz * dvz + dvzi * dvzi) / (K2V * K2V); + + QR1 *= 0.5; + snx = sin (QR1); + if (fabs (snx) < 0.01) { + arg = QR1 - floor (QR1 / PI + 0.5) * PI; + arg *= arg; + NN = Nxy * Nxy; + SF1 = NN * (1.0 - (NN - 1) * arg / 3.0 + (2 * NN * NN - 5 * NN + 3) * arg * arg / 45.0); + } else { + SF1 = sin (Nxy * QR1) / snx; + SF1 *= SF1; + }; + + QR2 *= 0.5; + snx = sin (QR2); + if (fabs (snx) < 0.01) { + arg = QR2 - floor (QR2 / PI + 0.5) * PI; + arg *= arg; + NN = Nxy * Nxy; + SF2 = NN * (1.0 - (NN - 1) * arg / 3.0 + (2 * NN * NN - 5 * NN + 3) * arg * arg / 45.0); + } else { + SF2 = sin (Nxy * QR2) / snx; + SF2 *= SF2; + }; + + dex = sign * dvzi * vec3z / K2V; /* this is called s in calculations */ + if (fabs (dex) < 1e-9) + dex = 1e-9; + ddw = 0.5 * vec3z / corrlen; /* here correlation length for sigma */ + arg = sqrt (0.25 * PI) * dex / ddw; + + if (arg > 7.0) { + arg *= arg; + fnc = 1.0 - (4.0 - (40.0 - (592.0 - (11296.0 - (261184.0 - 7066240.0 / arg) / arg) / arg) / arg) / arg) / arg; + } else { + if (arg > 1.0) { + arg -= 4.0; + fnc = 0.83632161198882839595 + + arg + * (0.056582086644761999922 + + arg + * (-0.013426901882714073489 + + arg + * (0.0026036629558670416522 + + arg + * (-0.00043493947025108071631 + + arg + * (0.000063696401659655369894 + + arg + * (-8.15571922810475175216e-6 + + arg + * (8.88360569009343837213e-7 + + arg + * (-7.53231914564623106045e-8 + + arg + * (3.18537731810442393942e-9 + + arg * 4.48953122905093423545e-10))))))))); + } else { + fnc = arg + * (0.56418958354775628695 + + arg + * (-0.18169011381620932846 + + arg + * (0.038539726238227489952 + + arg + * (-0.0047821117522591190687 + + arg + * (-0.000032686662549066312807 + + arg + * (0.000159019306085059302185 + + arg + * (-0.000032272354631649569110 + + arg + * (8.08407359778557261765e-7 + + arg * (1.13411148402714999777e-6 - arg * 2.90801221215845255891e-7))))))))); + }; + }; + dex /= fnc; + if (dex > limit) + dex = limit; + if (dex < -limit) + dex = -limit; + dmp = exp (-dex); + + SF3re = 1.0; + SF3im = 0.0; + if (Nlz == 2) { + SF3re += cos (QR3) * dmp; + SF3im += sin (QR3) * dmp; + } else { + SF3re += cos (QR3) * dmp + cos (QR4) * dmp * dmp; + SF3im += sin (QR3) * dmp + sin (QR4) * dmp * dmp; + }; + SF3re *= sqrt (dmp); + SF3im *= sqrt (dmp); + + if (Nlz == 2) { + dmp *= dmp; + } else { + dmp *= dmp * dmp; + }; + Sp3re = 1.0; + Sp3im = 0.0; + for (i = 1; i < Nz / Nlz; i++) { + Sp3re += cos (QRz * i) * pow (dmp, i); + Sp3im += sin (QRz * i) * pow (dmp, i); + }; + + SF3re = SF3re * Sp3re - SF3im * Sp3im; + SF3im = SF3re * Sp3im + SF3im * Sp3re; + SF3 = SF3re * SF3re + SF3im * SF3im; + SFa = SF1 * SF2 * SF3 * exp (-xidwfxy * xidwfxy * Q2xy - xidwfz * xidwfz * Q2z); /* here proportional to (Nxy^2 * Nz)^2 for Q -> 0 */ + + if (QR2im > limit) + QR2im = limit; + if (QR2im < -limit) + QR2im = -limit; + if (QRQR < 0.01) { + FFre = 1.0 - 0.1 * QR2re + (QR2re * QR2re - QR2im * QR2im) / 280.0; + FFim = -0.1 * QR2im + (QR2re * QR2im) / 140.0; + FF = FFre * FFre + FFim * FFim; + } else { + QRre = complsqrt (QR2re, QR2im, &QRim); + epre = cos (QRre) * exp (-QRim); + epim = sin (QRre) * exp (-QRim); + emre = cos (QRre) * exp (QRim); + emim = -sin (QRre) * exp (QRim); + FFre = epim - emim - QRre * (epre + emre) + QRim * (epim + emim); + FFim = emre - epre - QRim * (epre + emre) - QRre * (epim + emim); + FF = 2.25 * (FFre * FFre + FFim * FFim) / (QRQR * QRQR * QRQR); + }; + + dex = sign * Nz * dvzi * vec3z / K2V; /* this is called s in calculations */ + if (fabs (dex) < 1e-9) + dex = 1e-9; + number = zthck * 1e10 / (d111 * Nz); + /* berechne (1-exp(-number*dex))/(1-exp(-dex)) / (number) */ + arg = number * dex; + if (arg > limit) + arg = limit; + if (arg < -limit) + arg = -limit; + if (fabs (arg) < 0.055) { + epre = arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * 0.125) / 7.0) / 6.0) * 0.2) * 0.25) / 3.0) * 0.5); + } else { + epre = 1.0 - exp (-arg); + }; + arg = dex; + if (arg > limit) + arg = limit; + if (arg < -limit) + arg = -limit; + if (fabs (arg) < 0.055) { + emre = arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * (1.0 - arg * 0.125) / 7.0) / 6.0) * 0.2) * 0.25) / 3.0) * 0.5); + } else { + emre = 1.0 - exp (-arg); + }; + + /* fprintf(stderr,"%e\n",fabs(fudgef*phi*drho*drho*PI/0.75e-8*Rad*Rad*Rad*FF*SFa*epre/emre/number)); */ + return fabs (fudgef * phi * drho * drho * PI / 0.75e-8 * Rad * Rad * Rad * FF * SFa * epre / emre / number); + + }; /* END OF SUBROUTINE CROSS SECTION */ + + char + outofthebox (double* t0, double* t1, double x, double y, double z, double vx, double vy, double vz, double xwidth, double yheight, double zthick) { + double tt[2]; + char i; + double t, xx, yy, zz; + + i = 0; + tt[0] = 0.0; + tt[1] = 0.0; + + t = -z / vz; + xx = x + vx * t; + yy = y + vy * t; + if (fabs (x - xx) <= xwidth && fabs (y - yy) <= yheight) { + tt[i] = t; + i++; + }; + if (i >= 2) + goto stop; + + t = (zthick - z) / vz; + xx = x + vx * t; + yy = y + vy * t; + if (fabs (x - xx) <= xwidth && fabs (y - yy) <= yheight) { + tt[i] = t; + i++; + }; + if (i >= 2) + goto stop; + + t = (-0.5 * xwidth - x) / vx; + yy = y + vy * t; + zz = z + vz * t; + if (fabs (y - yy) <= yheight && zz >= 0.0 && zz <= zthick) { + tt[i] = t; + i++; + }; + if (i >= 2) + goto stop; + + t = (0.5 * xwidth - x) / vx; + yy = y + vy * t; + zz = z + vz * t; + if (fabs (y - yy) <= yheight && zz >= 0.0 && zz <= zthick) { + tt[i] = t; + i++; + }; + if (i >= 2) + goto stop; + + t = (-0.5 * yheight - y) / vy; + xx = x + vx * t; + zz = z + vz * t; + if (fabs (x - xx) <= xwidth && zz >= 0.0 && zz <= zthick) { + tt[i] = t; + i++; + }; + if (i >= 2) + goto stop; + + t = (0.5 * yheight - y) / vy; + xx = x + vx * t; + zz = z + vz * t; + if (fabs (x - xx) <= xwidth && zz >= 0.0 && zz <= zthick) { + tt[i] = t; + i++; + }; + + stop: + + *t0 = gs_min (tt[0], tt[1]); + *t1 = gs_max (tt[0], tt[1]); + + return i; + }; + char + propbyt (double t, double* x, double* y, double* z, double vx, double vy, double vz) { + *x += vx * t; + *y += vy * t; + *z += vz * t; + return 0; + }; %} DECLARE %{ -DArray2d phase; /* Table of different orientations in bulk phase */ -DArray2d SigB; /* Table of total cross sections from integral */ -double z1[8]; -double z2[8]; -double zt[8]; - -double Qmin; -double Qminl; -double l10; -double sc_a; -double sans_a; -double zthick; -double poserr; - + DArray2d phase; /* Table of different orientations in bulk phase */ + DArray2d SigB; /* Table of total cross sections from integral */ + double z1[8]; + double z2[8]; + double zt[8]; + + double Qmin; + double Qminl; + double l10; + double sc_a; + double sans_a; + double zthick; + double poserr; %} INITIALIZE %{ -double rhosamp,abslensamp,inclensamp,drho; + double rhosamp, abslensamp, inclensamp, drho; -double ac; + double ac; -int i; + int i; -double Qmaxo, Qmax, Qstp; -double qmaxl; -int Qno; + double Qmaxo, Qmax, Qstp; + double qmaxl; + int Qno; -int xii,yii,zii; -int phii, phimax; -double rotphi; -double Sig; -double sign; + int xii, yii, zii; + int phii, phimax; + double rotphi; + double Sig; + double sign; -double vzi; -double phi0; + double vzi; + double phi0; -int li,lj,phij; -double lf, phif; + int li, lj, phij; + double lf, phif; -double phirrr; + double phirrr; -double dvx,dvy,dvz,dvzi; -double Qx,Qy,Qz; + double dvx, dvy, dvz, dvzi; + double Qx, Qy, Qz; -phase = create_darr2d(10,10); -SigB = create_darr2d(21,182); + phase = create_darr2d (10, 10); + SigB = create_darr2d (21, 182); -Qmin = 1e-5; /* reasonable smallest SANS Q, should be close to zero, but finite */ -Qminl= log10(1e-5); /* logarithm of Qmin */ -l10 = log(10.0); /* constant ln(10) */ + Qmin = 1e-5; /* reasonable smallest SANS Q, should be close to zero, but finite */ + Qminl = log10 (1e-5); /* logarithm of Qmin */ + l10 = log (10.0); /* constant ln(10) */ -sc_a = gs_max(0.01,gs_min(0.99,sc_aim)); -sans_a = gs_max(0.01,gs_min(0.99,sans_aim)); + sc_a = gs_max (0.01, gs_min (0.99, sc_aim)); + sans_a = gs_max (0.01, gs_min (0.99, sans_aim)); -zthick = zsapph + zsamp + zsilicon; + zthick = zsapph + zsamp + zsilicon; -poserr = 1e-10; + poserr = 1e-10; - if (xwidth<=0.0 || yheight<=0.0 || zsapph<=0.0 || zsamp<=0.0 || zsilicon<=0.0 || zsampsurf<=0.0 || zsiliconsurf<=0.0) - { exit(fprintf(stderr,"%s: sample dimensions negative, so no reasonable size \n", NAME_CURRENT_COMP)); + if (xwidth <= 0.0 || yheight <= 0.0 || zsapph <= 0.0 || zsamp <= 0.0 || zsilicon <= 0.0 || zsampsurf <= 0.0 || zsiliconsurf <= 0.0) { + exit (fprintf (stderr, "%s: sample dimensions negative, so no reasonable size \n", NAME_CURRENT_COMP)); }; - if (zsampsurf>0.1*zsamp || zsiliconsurf>0.1*zsilicon) - { exit(fprintf(stderr,"%s: sample surface layers too thick \n", NAME_CURRENT_COMP)); + if (zsampsurf > 0.1 * zsamp || zsiliconsurf > 0.1 * zsilicon) { + exit (fprintf (stderr, "%s: sample surface layers too thick \n", NAME_CURRENT_COMP)); }; - if (phiPS<0.01 || phiPS>0.2 || Rad<100.0 || Rad>1000.0) - { exit(fprintf(stderr,"%s: check phi and Rad parameters, not reasonably chosen \n", NAME_CURRENT_COMP)); + if (phiPS < 0.01 || phiPS > 0.2 || Rad < 100.0 || Rad > 1000.0) { + exit (fprintf (stderr, "%s: check phi and Rad parameters, not reasonably chosen \n", NAME_CURRENT_COMP)); }; -phirrr = (phirot/PI-floor(phirot/PI))*PI; - -z1[0] = -1e32; /* positions of the layer bottom and top */ -z2[0] = 0.0; -zt[0] = 1e32; -z1[1] = z2[0]; -z2[1] = zsapph; -zt[1] = zsapph; -z1[2] = z2[1]; -z2[2] = z2[1]+zsampsurf; -zt[2] = zsampsurf; -z1[3] = z2[2]; -z2[3] = z2[1]+zsamp-zsampsurf; -zt[3] = zsamp-2.0*zsampsurf; -z1[4] = z2[3]; -z2[4] = z2[1]+zsamp; -zt[4] = zsampsurf; -z1[5] = z2[4]; -z2[5] = z2[4]+zsiliconsurf; -zt[5] = zsiliconsurf; -z1[6] = z2[5]; -z2[6] = zthick; -zt[6] = zsilicon-zsiliconsurf; -z1[7] = z2[6]; -z2[7] = z2[6]+1e32; -zt[7] = 1e32; - -for (xii = 0; xii<10; xii++) { -for (yii = 0; yii<10; yii++) { -phase[xii][yii]=PI*rand01(); }; }; - -rhosamp = phiPS*rhoPS + (1.0-phiPS)*rhoD2O; -abslensamp = 1.0/(phiPS/abslenPS+(1.0-phiPS)/abslenD2O); -inclensamp = 1.0/(phiPS/inclenPS+(1.0-phiPS)/inclenD2O); -drho = rhoPS-rhoD2O; - -/* CALCULATE TABLE OF NEUTRON CROSS SECTIONS (SANS) FOR 'ALL' WAVELENGTHS */ - -sign = 1.0; -ac = pow(PI/0.1875/fabs(phiPS),1.0/3.0)*fabs(Rad); /* units Aangstroem */ - -Qmaxo = 1e10; -for (li = 1; li<=20; li++) { -Qmax = gs_min(25.9/fabs(Rad),PI/li); -if (Qmax=0.0) { /* intersect check */ - PROP_DT(t00); - SCATTER; - propbyt(t00,&X,&Y,&Z,VX,VY,VZ); -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; - iscatt = 1; - - v = sqrt(VX*VX + VY*VY + VZ*VZ); - k0 = v / K2V; - lambda = 2.0*PI / k0; - vzi = 0.0; - VZI = 0.0; - layerno= 0; - - cmpabs = 0.0; - - if (fabs(Z)=20.0) { li =19; lf = 1.0; } else { -li = (int)(lambda); -lf = lambda-li; }; }; -lj = li+1; - -xii = (int)((100.0*X-floor(100.0*X))*10.0); -yii = (int)((100.0*Y-floor(100.0*Y))*10.0); - -if (VY==0.0) { phi0 = 0.5*PI; } /* perpendicular vector in x,y-plane */ - else { phi0 = atan(-VX/VY); }; - -phi0 -= phirrr; -if (phi0<=-0.5*PI) {phi0+=PI;}; - -phi1 = (phase[xii][yii]-phi0)*180.0/PI; /* later rotphi = phase[xi,yi] */ - -phi0 *= -180.0/PI; -if (phi0<0.0) {phi0 += 180.0;}; -phii = (int)(phi0); -phij = phii+1; -if (phij>180) {phij -= 180;}; -phif = phi0-phii; - -SigSsurf = ((SigB[li][phii]*(1.0-phif)+SigB[li][phij]*phif)*(1.0-lf)+(SigB[lj][phii]*(1.0-phif)+SigB[lj][phij]*phif)*lf)*(1.0-cos2z) - + (SigB[li][181]*(1.0-lf)+SigB[lj][181]*lf)*cos2z; -SigSsurf*= 200.0*PI/(k0*k0); - -if (phi1< 0.0) {phi1 += 180.0;}; -if (phi1>=180.0) {phi1 -= 180.0;}; -phii = (int)(phi1); -phij = phii+1; -if (phij>180) {phij -= 180;}; -phif = phi1-phii; - -SigSamp = ((SigB[li][phii]*(1.0-phif)+SigB[li][phij]*phif)*(1.0-lf)+(SigB[lj][phii]*(1.0-phif)+SigB[lj][phij]*phif)*lf)*(1.0-cos2z) - + (SigB[li][181]*(1.0-lf)+SigB[lj][181]*lf)*cos2z; -SigSamp *= 200.0*PI/(k0*k0); - -/* fprintf(stderr,"%e %e %e %e %e %e %e %e %e %e %e %e\n",xi[1],beta[1],xi[2],beta[2],xi[3],beta[3],xi[4],beta[4],xi[5],beta[5],xi[6],beta[6]); */ - -xi[0] = 0.0; /* 0 to 7, 0 and 7 are air */ -beta[0] = 0.0; /* rho in units A^-2, abslen in units cm (see NIST SLD calculator) */ -xi[1] = lambda*lambda*rhosapph/PI; -beta[1] = lambda*5e-9*(lambda/abslensapph + 1.0/inclensapph)/PI; -xi[2] = lambda*lambda*rhosamp/PI; -beta[2] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSsurf)/PI; -xi[3] = lambda*lambda*rhosamp/PI; -beta[3] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSamp )/PI; -xi[4] = lambda*lambda*rhosamp/PI; -beta[4] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSsurf)/PI; -xi[5] = lambda*lambda*rhosiliconsurf/PI; -beta[5] = lambda*5e-9*(lambda/abslensiliconsurf + 1.0/inclensiliconsurf)/PI; -xi[6] = lambda*lambda*rhosilicon/PI; -beta[6] = lambda*5e-9*(lambda/abslensilicon + 1.0/inclensilicon )/PI; -xi[7] = 0.0; -beta[7] = 0.0; - -/* - fprintf(stderr,"%e %e\n",SigSsurf,SigSamp); - fprintf(stderr,"%e %e %e %e %e %e %e %e %e %e %e %e\n",xi[1],beta[1],xi[2],beta[2],xi[3],beta[3],xi[4],beta[4],xi[5],beta[5],xi[6],beta[6]); -*/ - - if (fabs(Z)=0.0) {VZ=-1e3*poserr;}; - sintheta = -VZ / v; - www = complsqrt(-xi[layerno]+sintheta*sintheta,beta[layerno],&wwi); - VZI = -v * wwi; - VZ = -v * www; - goto insample; -}; - - if (fabs(X+0.5*xwidth)=0.0) {VX=-1e3*poserr;}; - sintheta = -VX / v; - www = complsqrt(-xi[layerno]+sintheta*sintheta,beta[layerno],&wwi); - VZI = -v * wwi * VX / VZ; - VX = -v * www; - goto insample; -}; - - if (fabs(Y+0.5*yheight)=0.0) {VY=-1e3*poserr;}; - sintheta = -VY / v; - www = complsqrt(-xi[layerno]+sintheta*sintheta,beta[layerno],&wwi); - VZI = -v * wwi * VY / VZ; - VY = -v * www; -/* fprintf(stderr, "%e %e \n", vy,v); - fprintf(stderr, "%e %e %e \n", x,y,z); */ - goto insample; -}; - - if (fabs(Z)=0.0) {VZ=-1e3*poserr;}; - sintheta = -VZ / v; - www = complsqrt(-xi[layerno]+sintheta*sintheta,beta[layerno],&wwi); - VZI = -v * wwi; - VZ = -v * www; - goto insample; -}; - ABSORB; - -insample: -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; - - v = sqrt(VX*VX + VY*VY + VZ*VZ + VZI*VZI); - k0 = v / K2V; - lambda = 2.0*PI / k0; - - cmpabs = (sintheta+www)*(sintheta+www)+wwi*wwi; - p *= 4.0*sintheta*sintheta/cmpabs; - - sign = 1.0; - xiref = -2.0*fabs(VZ) / v; - beref = 2.0* VZI / v; - if (VZ<0.0) {beref=-beref; sign=-1.0;}; - -/*intersect = box_inteRsect(&t0, &t1, x, y, z-z1[layerno], vx, vy, vz, xwidth, yheight, zt[layerno]); */ - intersect = outofthebox(&t0, &t1, X, Y, Z-z1[layerno], VX, VY, VZ, xwidth, yheight, zt[layerno]); - -/*fprintf(stderr, "%e %e %e \n", t0, t1, z1[layerno]);*/ -/*if (fabs(fabs(X)-0.5*xwidth)>poserr && fabs(fabs(Y)-0.5*yheight)>poserr && fabs(Z-z1[layerno])>poserr && fabs(Z-z2[layerno])>poserr) ABSORB; */ - if (fabs(t0*v)>poserr) ABSORB; - PROP_DT(t1-t0); - SCATTER; - propbyt(t1-t0,&X,&Y,&Z,VX,VY,VZ); -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; - iscatt++; - p *= exp(-VZI*VZ*(t1-t0)/K2V); - -/*fprintf(stderr, "%e %e %e %e %i %e %e %e\n", t0, t1, z1[layerno], t, layerno, X,Y,Z); */ -/*fprintf(stderr, "%e %e %e %e %e %e %i\n", X,Y,Z,VX,VY,VZ,layerno); */ - - if (fabs(fabs(X)-0.5*xwidth)=20.0) { li =19; lf = 1.0; } else { -li = (int)(lambda); -lf = lambda-li; }; }; -lj = li+1; - -xii = (int)((100.0*X-floor(100.0*X))*10.0); -yii = (int)((100.0*Y-floor(100.0*Y))*10.0); - -if (VY==0.0) { phi0 = 0.5*PI; } /* perpendicular vector in x,y-plane */ - else { phi0 = atan(-VX/VY); }; - -phi0 -= phirrr; -if (phi0<=-0.5*PI) {phi0+=PI;}; - -phi1 = (phase[xii][yii]-phi0)*180.0/PI; /* later rotphi = phase[xi,yi] */ - -phi0 *= -180.0/PI; -if (phi0<0.0) {phi0 += 180.0;}; -phii = (int)(phi0); -phij = phii+1; -if (phij>180) {phij -= 180;}; -phif = phi0-phii; - -SigSsurf = ((SigB[li][phii]*(1.0-phif)+SigB[li][phij]*phif)*(1.0-lf)+(SigB[lj][phii]*(1.0-phif)+SigB[lj][phij]*phif)*lf)*(1.0-cos2z) - + (SigB[li][181]*(1.0-lf)+SigB[lj][181]*lf)*cos2z; -SigSsurf*= 200.0*PI/(k0*k0); - -if (phi1< 0.0) {phi1 += 180.0;}; -if (phi1>=180.0) {phi1 -= 180.0;}; -phii = (int)(phi1); -phij = phii+1; -if (phij>180) {phij -= 180;}; -phif = phi1-phii; - -SigSamp = ((SigB[li][phii]*(1.0-phif)+SigB[li][phij]*phif)*(1.0-lf)+(SigB[lj][phii]*(1.0-phif)+SigB[lj][phij]*phif)*lf)*(1.0-cos2z) - + (SigB[li][181]*(1.0-lf)+SigB[lj][181]*lf)*cos2z; -SigSamp *= 200.0*PI/(k0*k0); - -xi[0] = 0.0; /* 0 to 7, 0 and 7 are air */ -beta[0] = 0.0; /* rho in units A^-2, abslen in units cm (see NIST SLD calculator) */ -xi[1] = lambda*lambda*rhosapph/PI; -beta[1] = lambda*5e-9*(lambda/abslensapph + 1.0/inclensapph)/PI; -xi[2] = lambda*lambda*rhosamp/PI; -beta[2] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSsurf)/PI; -xi[3] = lambda*lambda*rhosamp/PI; -beta[3] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSamp )/PI; -xi[4] = lambda*lambda*rhosamp/PI; -beta[4] = lambda*5e-9*(lambda/abslensamp + 1.0/inclensamp + SigSsurf)/PI; -xi[5] = lambda*lambda*rhosiliconsurf/PI; -beta[5] = lambda*5e-9*(lambda/abslensiliconsurf + 1.0/inclensiliconsurf)/PI; -xi[6] = lambda*lambda*rhosilicon/PI; -beta[6] = lambda*5e-9*(lambda/abslensilicon + 1.0/inclensilicon )/PI; -xi[7] = 0.0; -beta[7] = 0.0; - -Qmax = gs_min(25.9/fabs(Rad),PI/lambda); /* resonably small angle */ -qmaxl= log10(Qmax); -Ymax = 0.25*Qmax*Qmax/(k0*k0); -if (Ymax>=0.9999) Ymax = 1.0; /* avoid rounding errors */ -Xmax = 1.0 - 2.0*Ymax; - -/* -Scoh = SigSsuf oder SigSamp; */ -Sinc = 0.25/PI/inclensamp; /* inclensamp in cm, 1/4pi solid angle normalization */ -/* -Sinc1= 400.0*PI* Ymax *Sinc; -Sinc2= 400.0*PI*(1.0-Ymax)*Sinc; */ -/* -S1 = Sinc1 + Scoh; -Stot = Sinc2 + S1; */ - -if (rand01()<=sc_a) { - -fcut = gs_max(Ymax,sans_a); - -if (rand01()<=fcut) { - -Qxy = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); -if (rand01()<0.5) Qxy = -Qxy; -p *= fabs(Qxy/k0*(qmaxl-Qminl))*l10*2.0; -/* fprintf(stderr,"%e\n",p); */ - -Qcnt= fabs(2.6*cosz*k0); /* in positive coordinates */ - -if (2.0*Qcnt > Qmax || Qcnt==0.0) { /* total reflection out of window */ -Qz = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); -if (rand01()>0.5) Qz = -Qz; -p *= fabs(Qz /k0*(qmaxl-Qminl))*l10*2.0; -} else { - -if (Qcntwind) { -Qm2 = Qmax-Qcnt; -Qm2l= log10(Qm2); -Qzd = pow(10.0,Qminl+(Qm2l -Qminl)*rand01()); -p *= fabs(Qzd/k0*(Qm2l -Qminl))*l10*2.0*Qmax/(Qmax-Qcnt); -Qz = Qcnt+Qzd; -} else { -if (0.5*(Qmax-0.5*Qcnt)/Qmax>wind) { -Qm2 = 0.5*Qcnt; -Qm2l= log10(Qm2); -Qzd = pow(10.0,Qminl+(Qm2l -Qminl)*rand01()); -p *= fabs(Qzd/k0*(Qm2l -Qminl))*l10*4.0*Qmax/Qcnt; -Qz = Qcnt-Qzd; -} else { -if (0.5 >wind) { -Qm2 = 0.5*Qcnt; -Qm2l= log10(Qm2); -Qzd = pow(10.0,Qminl+(Qm2l -Qminl)*rand01()); -p *= fabs(Qzd/k0*(Qm2l -Qminl))*l10*4.0*Qmax/Qcnt; -Qz = Qzd; -} else { -Qz =-pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); -p *= fabs(Qz /k0*(qmaxl-Qminl))*l10*2.0; - -}; }; }; } else { /* part in */ -wind= rand01(); -if (0.5*(Qmax-0.5*Qcnt)/Qmax>wind) { -Qm2 = 0.5*Qcnt; -Qm2l= log10(Qm2); -Qm3 = Qmax-0.5*Qcnt; -Qm3l= log10(Qm3); -Qzd = pow(10.0,Qm3l +(Qm2l -Qm3l )*rand01()); -p *= fabs(Qzd/k0*(Qm2l -Qm3l ))*l10*2.0*Qmax/(Qmax-0.5*Qcnt); -Qz = Qcnt-Qzd; -} else { -if (0.5 >wind) { -Qm2 = 0.5*Qcnt; -Qm2l= log10(Qm2); -Qzd = pow(10.0,Qminl+(Qm2l -Qminl)*rand01()); -p *= fabs(Qzd/k0*(Qm2l -Qminl))*l10*4.0*Qmax/Qcnt; -Qz = Qzd; -} else { -Qz =-pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); -p *= fabs(Qz /k0*(qmaxl-Qminl))*l10*2.0; -}; }; }; }; - -Sincin = 0.0; -QQ = Qxy*Qxy+Qz*Qz; -if (QQ0.0) { -if (vout_z<0.0) { - vx = 0.0; - vy = 0.0; - vz = -1e5; - if (Zz1[6]) vz = -1e5; - PROP_DT(fabs((Z-z1[6])/vz)); - SCATTER; - Scoh /= Ot1[layerno+1]*Ott1[2]*Ott1[2]*Snorm/Inn2[6]; - Z = z1[6]; - VX = vout_x; - VY = vout_y; - VZ = fabs(vv2re[6]); - VZI= fabs(vv2im[6]); - layerno = 6; -}; } else { -if (vout_z>0.0) { - vx = 0.0; - vy = 0.0; - vz = 1e5; - if (Z>z1[6]) vz = -1e5; - PROP_DT(fabs((Z-z1[6])/vz)); - SCATTER; - Scoh /= Ot1[layerno-1]*Ott1[5]*Snorm; - Z = z1[6]; - VX = vout_x; - VY = vout_y; - VZ = fabs(vv2re[6]); - VZI= fabs(vv2im[6]); - layerno = 6; -} else { - vx = 0.0; - vy = 0.0; - vz = -1e5; - if (Z0.0) { -if (vout_z<0.0) { - vx = 0.0; - vy = 0.0; - vz = -1e5; - if (Zz1[6]) vz = -1e5; - PROP_DT(fabs((Z-z1[6])/vz)); - SCATTER; - Scoh /= Ot1[layerno+1]*Ott1[2]*Ott1[2]*zsamp/Inn2[6]; - Z = z1[6]; - VX = vout_x; - VY = vout_y; - VZ = fabs(vv2re[6]); - VZI= fabs(vv2im[6]); - layerno = 6; -}; } else { -if (vout_z>0.0) { - vx = 0.0; - vy = 0.0; - vz = 1e5; - if (Z>z1[6]) vz = -1e5; - PROP_DT(fabs((Z-z1[6])/vz)); - SCATTER; - Scoh /= Ot1[layerno-1]*Ott1[5]*zsamp; - Z = z1[6]; - VX = vout_x; - VY = vout_y; - VZ = fabs(vv2re[6]); - VZI= fabs(vv2im[6]); - layerno = 6; -} else { - vx = 0.0; - vy = 0.0; - vz = -1e5; - if (Z0.0) { - vx = 0.0; - vy = 0.0; - vz = -1e5; - if (Zz1[6]) vz = -1e5; - PROP_DT(fabs((Z-z1[6])/vz)); - SCATTER; - p *= Ot2[5]/Ot1[layerno-1]/(1.0-sc_a); - Z = z1[6]; - VZ = fabs(v2re[6]); - VZI= fabs(v2im[6]); - layerno = 6; -}; - -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; - SCATTER; - iscatt++; - -}; - - -/*fprintf(stderr, "after1 %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ - -/*fprintf(stderr, "%e %e %e %e %e %e %e %e %i \n", X,Y,Z,VX,VY,VZ,VZI,p,layerno); */ -/*fprintf(stderr, "on leave 1\n"); */ - - v = sqrt(VX*VX + VY*VY + VZ*VZ + VZI*VZI); - -/*intersect = box_intersect(&t0, &t1, x, y, z-z1[layerno], vx, vy, vz, xwidth, yheight, zt[layerno]); */ - intersect = outofthebox(&t0, &t1, X, Y, Z-z1[layerno], VX, VY, VZ, xwidth, yheight, zt[layerno]); -/*if (fabs(fabs(X)-0.5*xwidth)>poserr && fabs(fabs(Y)-0.5*yheight)>poserr && fabs(Z-z1[layerno])>poserr && fabs(Z-z2[layerno])>poserr) ABSORB; */ -/* fprintf(stderr, "after2 %i %e %e %e\n", layerno,t0,t1,v); */ - if (fabs(t0*v)>poserr) ABSORB; - PROP_DT(t1-t0); - SCATTER; - propbyt(t1-t0,&X,&Y,&Z,VX,VY,VZ); -/* fprintf(stderr, "after3 %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; - iscatt++; - p *= exp(-VZI*VZ*(t1-t0)/K2V); - -leave: - -/* fprintf(stderr, "on leave 2\n"); */ - - v = sqrt(VX*VX + VY*VY + VZ*VZ + VZI*VZI); - - if (fabs(Z)=0.0) {VZ=-1e3*poserr; vz=VZ;}; - sintheta = -VZ / v; - www = complsqrt(xi[layerno]+sintheta*sintheta,-beta[layerno],&wwi); - cmpabs = sqrt(VZ*VZ+VZI*VZI); - if (wwi>=0.0) { - VZ =-v * (www * vz - wwi * vzi) / cmpabs; - VZI = v * (wwi * vz + www * vzi) / cmpabs; } else { - VZ = v * (www * vz - wwi * vzi) / cmpabs; - VZI =-v * (wwi * vz + www * vzi) / cmpabs; }; - goto outsample; -}; - - if (fabs(Z-zthick)=0.0) { - VZ =-v * (www * vz - wwi * vzi) / cmpabs; - VZI = v * (wwi * vz + www * vzi) / cmpabs; } else { - VZ = v * (www * vz - wwi * vzi) / cmpabs; - VZI =-v * (wwi * vz + www * vzi) / cmpabs; }; - goto outsample; -}; - - if (fabs(X+0.5*xwidth)=0.0) {VX=-1e3*poserr; vx=VX;}; - sintheta = -VX / v; - www = complsqrt(xi[layerno]+sintheta*sintheta,-beta[layerno],&wwi); - cmpabs = sqrt(VX*VX+VZI*VZI*VZ*VZ/(VX*VX)); - if (wwi>=0.0) { - VX =-v * (www * vx - wwi * vzi * vz / vx) / cmpabs; - VZI = v * (wwi * vx + www * vzi * vz / vx) * vx / (vz*cmpabs); } else { - VX = v * (www * vx - wwi * vzi * vz / vx) / cmpabs; - VZI =-v * (wwi * vx + www * vzi * vz / vx) * vx / (vz*cmpabs); }; - goto outsample; -}; - - if (fabs(X-0.5*xwidth)=0.0) { - VX =-v * (www * vx - wwi * vzi * vz / vx) / cmpabs; - VZI = v * (wwi * vx + www * vzi * vz / vx) * vx / (vz*cmpabs); } else { - VX = v * (www * vx - wwi * vzi * vz / vx) / cmpabs; - VZI =-v * (wwi * vx + www * vzi * vz / vx) * vx / (vz*cmpabs); }; - goto outsample; -}; - - if (fabs(Y+0.5*yheight)=0.0) {VY=-1e3*poserr; vy=VY;}; - sintheta = -VY / v; - www = complsqrt(xi[layerno]+sintheta*sintheta,-beta[layerno],&wwi); - cmpabs = sqrt(VY*VY+VZI*VZI*VZ*VZ/(VY*VY)); - if (wwi>=0.0) { - VY =-v * (www * vy - wwi * vzi * vz / vy) / cmpabs; - VZI = v * (wwi * vy + www * vzi * vz / vy) * vy / (vz*cmpabs); } else { - VY = v * (www * vy - wwi * vzi * vz / vy) / cmpabs; - VZI =-v * (wwi * vy + www * vzi * vz / vy) * vy / (vz*cmpabs); }; - goto outsample; -}; - - if (fabs(Y-0.5*yheight)=0.0) { - VY =-v * (www * vy - wwi * vzi * vz / vy) / cmpabs; - VZI = v * (wwi * vy + www * vzi * vz / vy) * vy / (vz*cmpabs); } else { - VY = v * (www * vy - wwi * vzi * vz / vy) / cmpabs; - VZI =-v * (wwi * vy + www * vzi * vz / vy) * vy / (vz*cmpabs); }; - goto outsample; -}; - - if (fabs(Z)=0.0) {VZ=-1e3*poserr; vz=VZ;}; - sintheta = -VZ / v; - www = complsqrt(xi[layerno]+sintheta*sintheta,-beta[layerno],&wwi); - cmpabs = sqrt(VZ*VZ+VZI*VZI); - if (wwi>=0.0) { - VZ =-v * (www * vz - wwi * vzi) / cmpabs; - VZI =-v * (wwi * vz + www * vzi) / cmpabs; } else { - VZ = v * (www * vz - wwi * vzi) / cmpabs; - VZI = v * (wwi * vz + www * vzi) / cmpabs; }; - goto outsample; -}; - - if (fabs(Z-zthick)=0.0) { - VZ =-v * (www * vz - wwi * vzi) / cmpabs; - VZI =-v * (wwi * vz + www * vzi) / cmpabs; } else { - VZ = v * (www * vz - wwi * vzi) / cmpabs; - VZI = v * (wwi * vz + www * vzi) / cmpabs; }; - goto outsample; -}; -ABSORB; - -outsample: -/*fprintf(stderr, "%e %e %e %e %e %e %i \n", X,Y,Z,VX,VY,VZ,layerno); */ -/*x = X; - y = Y; - z = Z; */ - vx = VX; - vy = VY; - vz = VZ; - vzi= VZI; -/*SCATTER; */ -/*i=0; */ -}; /* end intersect check */ - - + double rhosamp, abslensamp, inclensamp, drho; + + int i; + + double Qmaxo, Qmax, Qstp; + double qmaxl; + int Qno; + + double Ymax, Xmax, Xsc, phi, theta; + double Scoh, Sinc, Sinc1, Sinc2, Sincin, S1, Stot, Snorm; + double SigSamp, SigSsurf; + double SS1, SS2, SS3, SS4; + + int xii, yii, zii; + int phii, phimax; + double rotphi; + + double Qxy, Qcnt, wind; + double Qz; + double Qm2, Qm2l, Qzd, Qm3, Qm3l, QQ; + double Sig; + double snx, arg; + int NN; + double SF1, SF2, SF3, SFa; + double SF3re, SF3im, Sp3re, Sp3im; + double FF; + + double v, k0, lambda, cos2z, cosz; + double vzi; + double phi0; + + int li, lj, phij; + double lf, phif; + double phi1; + + double phirrr; + double cmpabs; + double sintheta; + double www, wwi; + + double axis_x, axis_y, axis_z, tmp_vx, tmp_vy, tmp_vz; + double vout_x, vout_y, vout_z, vout_zz, vout_zi, vout_v; + double dvx, dvy, dvz, dvzi; + double xiref, beref; + double sign; + + int layerno; + int iscatt; + + double t00, t0, t1; + double X, Y, Z, VX, VY, VZ, VZI; + char intersect; + double fcut; + + double xi[8]; + double beta[8]; + double v2re[8]; + double v2im[8]; + double vv2re[8]; + double vv2im[8]; + double Ot1[8]; + double Ot2[8]; + double In1[8]; + double In2[8]; + double Ott1[8]; + double Ott2[8]; + double Inn1[8]; + double Inn2[8]; + + phirrr = (phirot / PI - floor (phirot / PI)) * PI; + + rhosamp = phiPS * rhoPS + (1.0 - phiPS) * rhoD2O; + abslensamp = 1.0 / (phiPS / abslenPS + (1.0 - phiPS) / abslenD2O); + inclensamp = 1.0 / (phiPS / inclenPS + (1.0 - phiPS) / inclenD2O); + drho = rhoPS - rhoD2O; + + X = x; + Y = y; + Z = z; + VX = vx; + VY = vy; + VZ = vz; + VZI = 0.0; + + /* intersect = box_intersect(&t00, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); */ + intersect = outofthebox (&t00, &t1, X, Y, Z, VX, VY, VZ, xwidth, yheight, zthick); + + if (intersect && t00 >= 0.0) { /* intersect check */ + PROP_DT (t00); + SCATTER; + propbyt (t00, &X, &Y, &Z, VX, VY, VZ); + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + iscatt = 1; + + v = sqrt (VX * VX + VY * VY + VZ * VZ); + k0 = v / K2V; + lambda = 2.0 * PI / k0; + vzi = 0.0; + VZI = 0.0; + layerno = 0; + + cmpabs = 0.0; + + if (fabs (Z) < poserr) { + layerno = 1; + goto in11; + }; + if (fabs (Z - zthick) < poserr) { + layerno = 6; + goto in11; + }; + + if (fabs (fabs (X) - 0.5 * xwidth) < poserr || fabs (fabs (Y) - 0.5 * yheight) < poserr) { + if (VZ == 0.0) { + VZ = 1e3 * poserr; + vz = VZ; + }; + if (Z < zsapph) { + layerno = 1; + goto in1; + }; + if (Z < zsapph + zsamp) { + if (Z < zsapph + zsampsurf) { + layerno = 2; + goto in1; + }; + if (Z < zsapph + zsamp - zsampsurf) { + layerno = 3; + goto in1; + }; + layerno = 4; + goto in1; + }; + if (Z < zthick + poserr) { + if (Z < zsapph + zsamp + zsiliconsurf) { + layerno = 5; + } else { + layerno = 6; + }; + goto in1; + }; + ABSORB; + in1: + i = 0; + /* fprintf(stderr, "%e %e %e %e %i\n", t0, t1, z1[layerno], t, layerno); */ + }; + in11: + /* fprintf(stderr, "%i \n", layerno); */ + + cosz = VZ / v; + cos2z = cosz * cosz; + + if (lambda < 1.0) { + li = 1; + lf = 0.0; + } else { + if (lambda >= 20.0) { + li = 19; + lf = 1.0; + } else { + li = (int)(lambda); + lf = lambda - li; + }; + }; + lj = li + 1; + + xii = (int)((100.0 * X - floor (100.0 * X)) * 10.0); + yii = (int)((100.0 * Y - floor (100.0 * Y)) * 10.0); + + if (VY == 0.0) { + phi0 = 0.5 * PI; + } /* perpendicular vector in x,y-plane */ + else { + phi0 = atan (-VX / VY); + }; + + phi0 -= phirrr; + if (phi0 <= -0.5 * PI) { + phi0 += PI; + }; + + phi1 = (phase[xii][yii] - phi0) * 180.0 / PI; /* later rotphi = phase[xi,yi] */ + + phi0 *= -180.0 / PI; + if (phi0 < 0.0) { + phi0 += 180.0; + }; + phii = (int)(phi0); + phij = phii + 1; + if (phij > 180) { + phij -= 180; + }; + phif = phi0 - phii; + + SigSsurf + = ((SigB[li][phii] * (1.0 - phif) + SigB[li][phij] * phif) * (1.0 - lf) + (SigB[lj][phii] * (1.0 - phif) + SigB[lj][phij] * phif) * lf) * (1.0 - cos2z) + + (SigB[li][181] * (1.0 - lf) + SigB[lj][181] * lf) * cos2z; + SigSsurf *= 200.0 * PI / (k0 * k0); + + if (phi1 < 0.0) { + phi1 += 180.0; + }; + if (phi1 >= 180.0) { + phi1 -= 180.0; + }; + phii = (int)(phi1); + phij = phii + 1; + if (phij > 180) { + phij -= 180; + }; + phif = phi1 - phii; + + SigSamp + = ((SigB[li][phii] * (1.0 - phif) + SigB[li][phij] * phif) * (1.0 - lf) + (SigB[lj][phii] * (1.0 - phif) + SigB[lj][phij] * phif) * lf) * (1.0 - cos2z) + + (SigB[li][181] * (1.0 - lf) + SigB[lj][181] * lf) * cos2z; + SigSamp *= 200.0 * PI / (k0 * k0); + + /* fprintf(stderr,"%e %e %e %e %e %e %e %e %e %e %e %e\n",xi[1],beta[1],xi[2],beta[2],xi[3],beta[3],xi[4],beta[4],xi[5],beta[5],xi[6],beta[6]); */ + + xi[0] = 0.0; /* 0 to 7, 0 and 7 are air */ + beta[0] = 0.0; /* rho in units A^-2, abslen in units cm (see NIST SLD calculator) */ + xi[1] = lambda * lambda * rhosapph / PI; + beta[1] = lambda * 5e-9 * (lambda / abslensapph + 1.0 / inclensapph) / PI; + xi[2] = lambda * lambda * rhosamp / PI; + beta[2] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSsurf) / PI; + xi[3] = lambda * lambda * rhosamp / PI; + beta[3] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSamp) / PI; + xi[4] = lambda * lambda * rhosamp / PI; + beta[4] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSsurf) / PI; + xi[5] = lambda * lambda * rhosiliconsurf / PI; + beta[5] = lambda * 5e-9 * (lambda / abslensiliconsurf + 1.0 / inclensiliconsurf) / PI; + xi[6] = lambda * lambda * rhosilicon / PI; + beta[6] = lambda * 5e-9 * (lambda / abslensilicon + 1.0 / inclensilicon) / PI; + xi[7] = 0.0; + beta[7] = 0.0; + + /* + fprintf(stderr,"%e %e\n",SigSsurf,SigSamp); + fprintf(stderr,"%e %e %e %e %e %e %e %e %e %e %e %e\n",xi[1],beta[1],xi[2],beta[2],xi[3],beta[3],xi[4],beta[4],xi[5],beta[5],xi[6],beta[6]); + */ + + if (fabs (Z) < poserr) { + if (VZ <= 0.0) { + VZ = 1e3 * poserr; + }; + sintheta = VZ / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = v * wwi; + VZ = v * www; + goto insample; + }; + + if (fabs (Z - zthick) < poserr) { + if (VZ >= 0.0) { + VZ = -1e3 * poserr; + }; + sintheta = -VZ / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = -v * wwi; + VZ = -v * www; + goto insample; + }; + + if (fabs (X + 0.5 * xwidth) < poserr) { /* surface at -0.5*xwidth */ + if (VX <= 0.0) { + VX = 1e3 * poserr; + }; + sintheta = VX / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = v * wwi * VX / VZ; + VX = v * www; + goto insample; + }; + + if (fabs (X - 0.5 * xwidth) < poserr) { /* surface at +0.5*xwidth */ + if (VX >= 0.0) { + VX = -1e3 * poserr; + }; + sintheta = -VX / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = -v * wwi * VX / VZ; + VX = -v * www; + goto insample; + }; + + if (fabs (Y + 0.5 * yheight) < poserr) { /* surface at -0.5*ywidth */ + if (VY <= 0.0) { + VY = 1e3 * poserr; + }; + sintheta = VY / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = v * wwi * VY / VZ; + VY = v * www; + /*fprintf(stderr, "%e %e \n", vy,v); + fprintf(stderr, "%e %e %e \n", x,y,z); */ + goto insample; + }; + + if (fabs (Y - 0.5 * yheight) < poserr) { /* surface at +0.5*ywidth */ + if (VY >= 0.0) { + VY = -1e3 * poserr; + }; + sintheta = -VY / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = -v * wwi * VY / VZ; + VY = -v * www; + /* fprintf(stderr, "%e %e \n", vy,v); + fprintf(stderr, "%e %e %e \n", x,y,z); */ + goto insample; + }; + + if (fabs (Z) < poserr) { /* surface at z=0 */ + layerno = 1; + if (VZ <= 0.0) { + VZ = 1e3 * poserr; + }; + sintheta = VZ / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = v * wwi; + VZ = v * www; + goto insample; + }; + + if (fabs (Z - zthick) < poserr) { /* surface at z=zthick */ + layerno = 6; + if (VZ >= 0.0) { + VZ = -1e3 * poserr; + }; + sintheta = -VZ / v; + www = complsqrt (-xi[layerno] + sintheta * sintheta, beta[layerno], &wwi); + VZI = -v * wwi; + VZ = -v * www; + goto insample; + }; + ABSORB; + + insample: + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + + v = sqrt (VX * VX + VY * VY + VZ * VZ + VZI * VZI); + k0 = v / K2V; + lambda = 2.0 * PI / k0; + + cmpabs = (sintheta + www) * (sintheta + www) + wwi * wwi; + p *= 4.0 * sintheta * sintheta / cmpabs; + + sign = 1.0; + xiref = -2.0 * fabs (VZ) / v; + beref = 2.0 * VZI / v; + if (VZ < 0.0) { + beref = -beref; + sign = -1.0; + }; + + /*intersect = box_inteRsect(&t0, &t1, x, y, z-z1[layerno], vx, vy, vz, xwidth, yheight, zt[layerno]); */ + intersect = outofthebox (&t0, &t1, X, Y, Z - z1[layerno], VX, VY, VZ, xwidth, yheight, zt[layerno]); + + /*fprintf(stderr, "%e %e %e \n", t0, t1, z1[layerno]);*/ + /*if (fabs(fabs(X)-0.5*xwidth)>poserr && fabs(fabs(Y)-0.5*yheight)>poserr && fabs(Z-z1[layerno])>poserr && fabs(Z-z2[layerno])>poserr) ABSORB; */ + if (fabs (t0 * v) > poserr) + ABSORB; + PROP_DT (t1 - t0); + SCATTER; + propbyt (t1 - t0, &X, &Y, &Z, VX, VY, VZ); + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + iscatt++; + p *= exp (-VZI * VZ * (t1 - t0) / K2V); + + /*fprintf(stderr, "%e %e %e %e %i %e %e %e\n", t0, t1, z1[layerno], t, layerno, X,Y,Z); */ + /*fprintf(stderr, "%e %e %e %e %e %e %i\n", X,Y,Z,VX,VY,VZ,layerno); */ + + if (fabs (fabs (X) - 0.5 * xwidth) < poserr || fabs (fabs (Y) - 0.5 * yheight) < poserr) { + goto leave; + }; + + /* fprintf(stderr, "passed \n"); */ + /* + v = sqrt(VX*VX + VY*VY + VZ*VZ + VZI*VZI); + k0 = v / K2V; + lambda = 2.0*PI / k0; */ + + cosz = VZ / v; + cos2z = cosz * cosz; + + if (lambda < 1.0) { + li = 1; + lf = 0.0; + } else { + if (lambda >= 20.0) { + li = 19; + lf = 1.0; + } else { + li = (int)(lambda); + lf = lambda - li; + }; + }; + lj = li + 1; + + xii = (int)((100.0 * X - floor (100.0 * X)) * 10.0); + yii = (int)((100.0 * Y - floor (100.0 * Y)) * 10.0); + + if (VY == 0.0) { + phi0 = 0.5 * PI; + } /* perpendicular vector in x,y-plane */ + else { + phi0 = atan (-VX / VY); + }; + + phi0 -= phirrr; + if (phi0 <= -0.5 * PI) { + phi0 += PI; + }; + + phi1 = (phase[xii][yii] - phi0) * 180.0 / PI; /* later rotphi = phase[xi,yi] */ + + phi0 *= -180.0 / PI; + if (phi0 < 0.0) { + phi0 += 180.0; + }; + phii = (int)(phi0); + phij = phii + 1; + if (phij > 180) { + phij -= 180; + }; + phif = phi0 - phii; + + SigSsurf + = ((SigB[li][phii] * (1.0 - phif) + SigB[li][phij] * phif) * (1.0 - lf) + (SigB[lj][phii] * (1.0 - phif) + SigB[lj][phij] * phif) * lf) * (1.0 - cos2z) + + (SigB[li][181] * (1.0 - lf) + SigB[lj][181] * lf) * cos2z; + SigSsurf *= 200.0 * PI / (k0 * k0); + + if (phi1 < 0.0) { + phi1 += 180.0; + }; + if (phi1 >= 180.0) { + phi1 -= 180.0; + }; + phii = (int)(phi1); + phij = phii + 1; + if (phij > 180) { + phij -= 180; + }; + phif = phi1 - phii; + + SigSamp + = ((SigB[li][phii] * (1.0 - phif) + SigB[li][phij] * phif) * (1.0 - lf) + (SigB[lj][phii] * (1.0 - phif) + SigB[lj][phij] * phif) * lf) * (1.0 - cos2z) + + (SigB[li][181] * (1.0 - lf) + SigB[lj][181] * lf) * cos2z; + SigSamp *= 200.0 * PI / (k0 * k0); + + xi[0] = 0.0; /* 0 to 7, 0 and 7 are air */ + beta[0] = 0.0; /* rho in units A^-2, abslen in units cm (see NIST SLD calculator) */ + xi[1] = lambda * lambda * rhosapph / PI; + beta[1] = lambda * 5e-9 * (lambda / abslensapph + 1.0 / inclensapph) / PI; + xi[2] = lambda * lambda * rhosamp / PI; + beta[2] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSsurf) / PI; + xi[3] = lambda * lambda * rhosamp / PI; + beta[3] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSamp) / PI; + xi[4] = lambda * lambda * rhosamp / PI; + beta[4] = lambda * 5e-9 * (lambda / abslensamp + 1.0 / inclensamp + SigSsurf) / PI; + xi[5] = lambda * lambda * rhosiliconsurf / PI; + beta[5] = lambda * 5e-9 * (lambda / abslensiliconsurf + 1.0 / inclensiliconsurf) / PI; + xi[6] = lambda * lambda * rhosilicon / PI; + beta[6] = lambda * 5e-9 * (lambda / abslensilicon + 1.0 / inclensilicon) / PI; + xi[7] = 0.0; + beta[7] = 0.0; + + Qmax = gs_min (25.9 / fabs (Rad), PI / lambda); /* resonably small angle */ + qmaxl = log10 (Qmax); + Ymax = 0.25 * Qmax * Qmax / (k0 * k0); + if (Ymax >= 0.9999) + Ymax = 1.0; /* avoid rounding errors */ + Xmax = 1.0 - 2.0 * Ymax; + + /* + Scoh = SigSsuf oder SigSamp; */ + Sinc = 0.25 / PI / inclensamp; /* inclensamp in cm, 1/4pi solid angle normalization */ + /* + Sinc1= 400.0*PI* Ymax *Sinc; + Sinc2= 400.0*PI*(1.0-Ymax)*Sinc; */ + /* + S1 = Sinc1 + Scoh; + Stot = Sinc2 + S1; */ + + if (rand01 () <= sc_a) { + + fcut = gs_max (Ymax, sans_a); + + if (rand01 () <= fcut) { + + Qxy = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + if (rand01 () < 0.5) + Qxy = -Qxy; + p *= fabs (Qxy / k0 * (qmaxl - Qminl)) * l10 * 2.0; + /* fprintf(stderr,"%e\n",p); */ + + Qcnt = fabs (2.6 * cosz * k0); /* in positive coordinates */ + + if (2.0 * Qcnt > Qmax || Qcnt == 0.0) { /* total reflection out of window */ + Qz = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + if (rand01 () > 0.5) + Qz = -Qz; + p *= fabs (Qz / k0 * (qmaxl - Qminl)) * l10 * 2.0; + } else { + + if (Qcnt < Qmax) { /* full in */ + wind = rand01 (); + if (0.5 * (Qmax - Qcnt) / Qmax > wind) { + Qm2 = Qmax - Qcnt; + Qm2l = log10 (Qm2); + Qzd = pow (10.0, Qminl + (Qm2l - Qminl) * rand01 ()); + p *= fabs (Qzd / k0 * (Qm2l - Qminl)) * l10 * 2.0 * Qmax / (Qmax - Qcnt); + Qz = Qcnt + Qzd; + } else { + if (0.5 * (Qmax - 0.5 * Qcnt) / Qmax > wind) { + Qm2 = 0.5 * Qcnt; + Qm2l = log10 (Qm2); + Qzd = pow (10.0, Qminl + (Qm2l - Qminl) * rand01 ()); + p *= fabs (Qzd / k0 * (Qm2l - Qminl)) * l10 * 4.0 * Qmax / Qcnt; + Qz = Qcnt - Qzd; + } else { + if (0.5 > wind) { + Qm2 = 0.5 * Qcnt; + Qm2l = log10 (Qm2); + Qzd = pow (10.0, Qminl + (Qm2l - Qminl) * rand01 ()); + p *= fabs (Qzd / k0 * (Qm2l - Qminl)) * l10 * 4.0 * Qmax / Qcnt; + Qz = Qzd; + } else { + Qz = -pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + p *= fabs (Qz / k0 * (qmaxl - Qminl)) * l10 * 2.0; + }; + }; + }; + } else { /* part in */ + wind = rand01 (); + if (0.5 * (Qmax - 0.5 * Qcnt) / Qmax > wind) { + Qm2 = 0.5 * Qcnt; + Qm2l = log10 (Qm2); + Qm3 = Qmax - 0.5 * Qcnt; + Qm3l = log10 (Qm3); + Qzd = pow (10.0, Qm3l + (Qm2l - Qm3l) * rand01 ()); + p *= fabs (Qzd / k0 * (Qm2l - Qm3l)) * l10 * 2.0 * Qmax / (Qmax - 0.5 * Qcnt); + Qz = Qcnt - Qzd; + } else { + if (0.5 > wind) { + Qm2 = 0.5 * Qcnt; + Qm2l = log10 (Qm2); + Qzd = pow (10.0, Qminl + (Qm2l - Qminl) * rand01 ()); + p *= fabs (Qzd / k0 * (Qm2l - Qminl)) * l10 * 4.0 * Qmax / Qcnt; + Qz = Qzd; + } else { + Qz = -pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + p *= fabs (Qz / k0 * (qmaxl - Qminl)) * l10 * 2.0; + }; + }; + }; + }; + + Sincin = 0.0; + QQ = Qxy * Qxy + Qz * Qz; + if (QQ < Qmax * Qmax) { + Sincin = Sinc; + }; + + if (Qz == 0.0) { + phi = -0.5 * PI * Qxy / fabs (Qxy); + } else { + phi = atan (-Qxy / Qz); + }; + if (Qz < 0.0) { + phi += PI; + }; + theta = 2.0 * asin (0.5 * sqrt (QQ) / k0); + + xiref = xi[layerno]; + beref = beta[layerno]; + + calclayers (xiref, beref, VZ, VZI, v, zt, xi, beta, v2re, v2im, Ot1, Ot2, In1, In2); + + vec_prod (axis_x, axis_y, axis_z, VX, VY, VZ, 0.0, 0.0, -sign); + rotate (tmp_vx, tmp_vy, tmp_vz, VX, VY, VZ, theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, VX, VY, VZ); + + vout_zz = sign * fabs (vout_z); /*seems to be ok*/ + vout_zi = sign * fabs (VZI * VZ / vout_zz); + vout_v = sqrt (vout_x * vout_x + vout_y * vout_y + vout_zz * vout_zz + vout_zi * vout_zi); + ; + + calclayers (xiref, beref, vout_zz, vout_zi, vout_v, zt, xi, beta, vv2re, vv2im, Ott1, Ott2, Inn1, Inn2); + + /* + fprintf(stderr,"%e %e %e %e \n", sign, VZ, vout_z, vout_zz); + + fprintf(stderr,"%e %e %e %e %e %e %e %e %e %e %e %e\n", xi[1],beta[1],v2re[1],v2im[1],vv2re[1],vv2im[1],xi[2],beta[2],v2re[2],v2im[2],vv2re[2],vv2im[2]); + fprintf(stderr,"%e %e %e %e \n", In1[2],In2[2],Inn1[2],Inn2[2]); + fprintf(stderr,"%e %e %e %e \n", In1[3],In2[3],Inn1[3],Inn2[3]); + */ + + Scoh = 0.0; + Snorm = 0.0; + + rotphi = phirrr; + + dvx = vout_x - VX; + dvy = vout_y - VY; + dvz = vv2re[2] - v2re[2]; + dvzi = vv2im[2] - v2im[2]; + SS1 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[2]) + Sincin) * In1[2] * Inn1[2] * zt[2]; + Scoh += SS1; + + dvz = -vv2re[2] - v2re[2]; + dvzi = -vv2im[2] - v2im[2]; + SS2 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[2]) + Sincin) * In1[2] * Inn2[2] * zt[2]; + Scoh += SS2; + + dvz = vv2re[2] + v2re[2]; + dvzi = vv2im[2] + v2im[2]; + SS3 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[2]) + Sincin) * In2[2] * Inn1[2] * zt[2]; + Scoh += SS3; + + dvz = -vv2re[2] + v2re[2]; + dvzi = -vv2im[2] + v2im[2]; + SS4 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[2]) + Sincin) * In2[2] * Inn2[2] * zt[2]; + Scoh += SS4; + + Snorm += (SigSsurf + 400.0 * PI * Sinc) * zt[2]; + + /* fprintf(stderr,"layer1 %e %e %e %e\n",SS1,SS2,SS3,SS4); */ + + rotphi = phase[xii][yii] + phirrr; + + /* dvx = vout_x - VX; + dvy = vout_y - VY; */ + dvz = vv2re[3] - v2re[3]; + dvzi = vv2im[3] - v2im[3]; + SS1 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[3]) + Sincin) * In1[3] * Inn1[3] * zt[3]; + Scoh += SS1; + + dvz = -vv2re[3] - v2re[3]; + dvzi = -vv2im[3] - v2im[3]; + SS2 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[3]) + Sincin) * In1[3] * Inn2[3] * zt[3]; + Scoh += SS2; + + dvz = vv2re[3] + v2re[3]; + dvzi = vv2im[3] + v2im[3]; + SS3 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[3]) + Sincin) * In2[3] * Inn1[3] * zt[3]; + Scoh += SS3; + + dvz = -vv2re[3] + v2re[3]; + dvzi = -vv2im[3] + v2im[3]; + SS4 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[3]) + Sincin) * In2[3] * Inn2[3] * zt[3]; + Scoh += SS4; + + Snorm += (SigSamp + 400.0 * PI * Sinc) * zt[3]; + + /* fprintf(stderr,"layer2 %e %e %e %e\n",SS1,SS2,SS3,SS4); */ + + rotphi = phirrr; + + /* dvx = vout_x - VX; + dvy = vout_y - VY; */ + dvz = vv2re[4] - v2re[4]; + dvzi = vv2im[4] - v2im[4]; + SS1 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[4]) + Sincin) * In1[4] * Inn1[4] * zt[4]; + Scoh += SS1; + + dvz = -vv2re[4] - v2re[4]; + dvzi = -vv2im[4] - v2im[4]; + SS2 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[4]) + Sincin) * In1[4] * Inn2[4] * zt[4]; + Scoh += SS2; + + dvz = vv2re[4] + v2re[4]; + dvzi = vv2im[4] + v2im[4]; + SS3 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[4]) + Sincin) * In2[4] * Inn1[4] * zt[4]; + Scoh += SS3; + + dvz = -vv2re[4] + v2re[4]; + dvzi = -vv2im[4] + v2im[4]; + SS4 = (dSigdW (phiPS, Rad, drho, rotphi, dvx, dvy, dvz, dvzi, sign, zt[4]) + Sincin) * In2[4] * Inn2[4] * zt[4]; + Scoh += SS4; + + Snorm += (SigSsurf + 400.0 * PI * Sinc) * zt[4]; + + /* fprintf(stderr,"layer3 %e %e %e %e\n",SS1,SS2,SS3,SS4); */ + /* fprintf(stderr, "before %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ + + if (VZ > 0.0) { + if (vout_z < 0.0) { + vx = 0.0; + vy = 0.0; + vz = -1e5; + if (Z < z2[1]) + vz = 1e5; + PROP_DT (fabs ((Z - z2[1]) / vz)); + SCATTER; + Scoh /= Ot1[layerno + 1] * Ott1[2] * Snorm; + Z = z2[1]; + VX = vout_x; + VY = vout_y; + VZ = -fabs (vv2re[1]); + VZI = -fabs (vv2im[1]); + layerno = 1; + } else { + vx = 0.0; + vy = 0.0; + vz = 1e5; + if (Z > z1[6]) + vz = -1e5; + PROP_DT (fabs ((Z - z1[6]) / vz)); + SCATTER; + Scoh /= Ot1[layerno + 1] * Ott1[2] * Ott1[2] * Snorm / Inn2[6]; + Z = z1[6]; + VX = vout_x; + VY = vout_y; + VZ = fabs (vv2re[6]); + VZI = fabs (vv2im[6]); + layerno = 6; + }; + } else { + if (vout_z > 0.0) { + vx = 0.0; + vy = 0.0; + vz = 1e5; + if (Z > z1[6]) + vz = -1e5; + PROP_DT (fabs ((Z - z1[6]) / vz)); + SCATTER; + Scoh /= Ot1[layerno - 1] * Ott1[5] * Snorm; + Z = z1[6]; + VX = vout_x; + VY = vout_y; + VZ = fabs (vv2re[6]); + VZI = fabs (vv2im[6]); + layerno = 6; + } else { + vx = 0.0; + vy = 0.0; + vz = -1e5; + if (Z < z2[1]) + vz = 1e5; + PROP_DT (fabs ((Z - z2[1]) / vz)); + SCATTER; + Scoh /= Ot1[layerno - 1] * Ott1[5] * Ott1[5] * Snorm / Inn2[1]; + Z = z2[1]; + VX = vout_x; + VY = vout_y; + VZ = -fabs (vv2re[1]); + VZI = -fabs (vv2im[1]); + layerno = 1; + }; + }; + + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + /*SCATTER; */ + iscatt++; + + /* + Scoh = SigSsuf oder SigSamp; + Sinc = 25.00/PI/inclensamp; + Sinc1= 400.0*PI* Ymax *Sinc; + Sinc2= 400.0*PI*(1.0-Ymax)*Sinc; */ + /* + S1 = Sinc1 + Scoh; + Stot = Sinc2 + S1; */ + + /* Scoh *= 1e5; just for testing */ + /* fprintf(stderr,"%e %e\n",Scoh,Sincin); */ + + p *= 100.0 * PI * PI * Scoh / (fcut * sc_a); + /* fprintf(stderr,"%e %e\n",p,Scoh); */ + + } else { + + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) * (1.0 - fcut); + phi = 2.0 * PI * rand01 (); + theta = acos (Xsc); + + xiref = xi[layerno]; + beref = beta[layerno]; + + calclayers (xiref, beref, VZ, VZI, v, zt, xi, beta, v2re, v2im, Ot1, Ot2, In1, In2); + + vec_prod (axis_x, axis_y, axis_z, VX, VY, VZ, 0.0, 0.0, 1.0); + rotate (tmp_vx, tmp_vy, tmp_vz, VX, VY, VZ, theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, VX, VY, VZ); + + vout_zz = VZ * fabs (vout_z / VZ); /* refer to incoming neutron */ + vout_zi = VZI * VZ / vout_zz; + vout_v = sqrt (vout_x * vout_x + vout_y * vout_y + vout_z * vout_z); + + calclayers (xiref, beref, vout_zz, vout_zi, vout_v, zt, xi, beta, vv2re, vv2im, Ott1, Ott2, Inn1, Inn2); + + Scoh + = (In1[2] + In2[2]) * (Inn1[2] + Inn2[2]) * zt[2] + (In1[3] + In2[3]) * (Inn1[3] + Inn2[3]) * zt[3] + (In1[4] + In2[4]) * (Inn1[4] + Inn2[4]) * zt[4]; + + /* fprintf(stderr, "before %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ + + if (VZ > 0.0) { + if (vout_z < 0.0) { + vx = 0.0; + vy = 0.0; + vz = -1e5; + if (Z < z2[1]) + vz = 1e5; + PROP_DT (fabs ((Z - z2[1]) / vz)); + SCATTER; + Scoh /= Ot1[layerno + 1] * Ott1[2] * zsamp; + Z = z2[1]; + VX = vout_x; + VY = vout_y; + VZ = -fabs (vv2re[1]); + VZI = -fabs (vv2im[1]); + layerno = 1; + } else { + vx = 0.0; + vy = 0.0; + vz = 1e5; + if (Z > z1[6]) + vz = -1e5; + PROP_DT (fabs ((Z - z1[6]) / vz)); + SCATTER; + Scoh /= Ot1[layerno + 1] * Ott1[2] * Ott1[2] * zsamp / Inn2[6]; + Z = z1[6]; + VX = vout_x; + VY = vout_y; + VZ = fabs (vv2re[6]); + VZI = fabs (vv2im[6]); + layerno = 6; + }; + } else { + if (vout_z > 0.0) { + vx = 0.0; + vy = 0.0; + vz = 1e5; + if (Z > z1[6]) + vz = -1e5; + PROP_DT (fabs ((Z - z1[6]) / vz)); + SCATTER; + Scoh /= Ot1[layerno - 1] * Ott1[5] * zsamp; + Z = z1[6]; + VX = vout_x; + VY = vout_y; + VZ = fabs (vv2re[6]); + VZI = fabs (vv2im[6]); + layerno = 6; + } else { + vx = 0.0; + vy = 0.0; + vz = -1e5; + if (Z < z2[1]) + vz = 1e5; + PROP_DT (fabs ((Z - z2[1]) / vz)); + SCATTER; + Scoh /= Ot1[layerno - 1] * Ott1[5] * Ott1[5] * zsamp / Inn2[1]; + Z = z2[1]; + VX = vout_x; + VY = vout_y; + VZ = -fabs (vv2re[1]); + VZI = -fabs (vv2im[1]); + layerno = 1; + }; + }; + + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + /*SCATTER; */ + iscatt++; + + p *= Scoh / sc_a; + + }; /* coherent or incoherent */ + + } else { /* reflection */ + + xiref = xi[layerno]; + beref = beta[layerno]; + + calclayers (xiref, beref, VZ, VZI, v, zt, xi, beta, v2re, v2im, Ot1, Ot2, In1, In2); + + if (VZ > 0.0) { + vx = 0.0; + vy = 0.0; + vz = -1e5; + if (Z < z2[1]) + vz = 1e5; + PROP_DT (fabs ((Z - z2[1]) / vz)); + SCATTER; + p *= Ot2[2] / Ot1[layerno + 1] / (1.0 - sc_a); + Z = z2[1]; + VZ = -fabs (v2re[1]); + VZI = -fabs (v2im[1]); + layerno = 1; + } else { + vx = 0.0; + vy = 0.0; + vz = 1e5; + if (Z > z1[6]) + vz = -1e5; + PROP_DT (fabs ((Z - z1[6]) / vz)); + SCATTER; + p *= Ot2[5] / Ot1[layerno - 1] / (1.0 - sc_a); + Z = z1[6]; + VZ = fabs (v2re[6]); + VZI = fabs (v2im[6]); + layerno = 6; + }; + + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + SCATTER; + iscatt++; + }; + + /*fprintf(stderr, "after1 %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ + + /*fprintf(stderr, "%e %e %e %e %e %e %e %e %i \n", X,Y,Z,VX,VY,VZ,VZI,p,layerno); */ + /*fprintf(stderr, "on leave 1\n"); */ + + v = sqrt (VX * VX + VY * VY + VZ * VZ + VZI * VZI); + + /*intersect = box_intersect(&t0, &t1, x, y, z-z1[layerno], vx, vy, vz, xwidth, yheight, zt[layerno]); */ + intersect = outofthebox (&t0, &t1, X, Y, Z - z1[layerno], VX, VY, VZ, xwidth, yheight, zt[layerno]); + /*if (fabs(fabs(X)-0.5*xwidth)>poserr && fabs(fabs(Y)-0.5*yheight)>poserr && fabs(Z-z1[layerno])>poserr && fabs(Z-z2[layerno])>poserr) ABSORB; */ + /* fprintf(stderr, "after2 %i %e %e %e\n", layerno,t0,t1,v); */ + if (fabs (t0 * v) > poserr) + ABSORB; + PROP_DT (t1 - t0); + SCATTER; + propbyt (t1 - t0, &X, &Y, &Z, VX, VY, VZ); + /* fprintf(stderr, "after3 %e %e %e %e %e %e %i yes yes\n", X,Y,Z,VX,VY,VZ,layerno); */ + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + iscatt++; + p *= exp (-VZI * VZ * (t1 - t0) / K2V); + + leave: + + /* fprintf(stderr, "on leave 2\n"); */ + + v = sqrt (VX * VX + VY * VY + VZ * VZ + VZI * VZI); + + if (fabs (Z) < poserr) { + if (VZ >= 0.0) { + VZ = -1e3 * poserr; + vz = VZ; + }; + sintheta = -VZ / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VZ * VZ + VZI * VZI); + if (wwi >= 0.0) { + VZ = -v * (www * vz - wwi * vzi) / cmpabs; + VZI = v * (wwi * vz + www * vzi) / cmpabs; + } else { + VZ = v * (www * vz - wwi * vzi) / cmpabs; + VZI = -v * (wwi * vz + www * vzi) / cmpabs; + }; + goto outsample; + }; + + if (fabs (Z - zthick) < poserr) { + if (VZ <= 0.0) { + VZ = 1e3 * poserr; + vz = VZ; + }; + sintheta = VZ / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VZ * VZ + VZI * VZI); + if (wwi >= 0.0) { + VZ = -v * (www * vz - wwi * vzi) / cmpabs; + VZI = v * (wwi * vz + www * vzi) / cmpabs; + } else { + VZ = v * (www * vz - wwi * vzi) / cmpabs; + VZI = -v * (wwi * vz + www * vzi) / cmpabs; + }; + goto outsample; + }; + + if (fabs (X + 0.5 * xwidth) < poserr) { /* surface at -0.5*xwidth */ + if (VX >= 0.0) { + VX = -1e3 * poserr; + vx = VX; + }; + sintheta = -VX / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VX * VX + VZI * VZI * VZ * VZ / (VX * VX)); + if (wwi >= 0.0) { + VX = -v * (www * vx - wwi * vzi * vz / vx) / cmpabs; + VZI = v * (wwi * vx + www * vzi * vz / vx) * vx / (vz * cmpabs); + } else { + VX = v * (www * vx - wwi * vzi * vz / vx) / cmpabs; + VZI = -v * (wwi * vx + www * vzi * vz / vx) * vx / (vz * cmpabs); + }; + goto outsample; + }; + + if (fabs (X - 0.5 * xwidth) < poserr) { /* surface at +0.5*xwidth */ + if (VX <= 0.0) { + VX = 1e3 * poserr; + vx = VX; + }; + sintheta = VX / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VX * VX + VZI * VZI * VZ * VZ / (VX * VX)); + if (wwi >= 0.0) { + VX = -v * (www * vx - wwi * vzi * vz / vx) / cmpabs; + VZI = v * (wwi * vx + www * vzi * vz / vx) * vx / (vz * cmpabs); + } else { + VX = v * (www * vx - wwi * vzi * vz / vx) / cmpabs; + VZI = -v * (wwi * vx + www * vzi * vz / vx) * vx / (vz * cmpabs); + }; + goto outsample; + }; + + if (fabs (Y + 0.5 * yheight) < poserr) { /* surface at -0.5*ywidth */ + if (VY >= 0.0) { + VY = -1e3 * poserr; + vy = VY; + }; + sintheta = -VY / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VY * VY + VZI * VZI * VZ * VZ / (VY * VY)); + if (wwi >= 0.0) { + VY = -v * (www * vy - wwi * vzi * vz / vy) / cmpabs; + VZI = v * (wwi * vy + www * vzi * vz / vy) * vy / (vz * cmpabs); + } else { + VY = v * (www * vy - wwi * vzi * vz / vy) / cmpabs; + VZI = -v * (wwi * vy + www * vzi * vz / vy) * vy / (vz * cmpabs); + }; + goto outsample; + }; + + if (fabs (Y - 0.5 * yheight) < poserr) { /* surface at +0.5*ywidth */ + if (VY <= 0.0) { + VY = 1e3 * poserr; + vy = VY; + }; + sintheta = VY / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VY * VY + VZI * VZI * VZ * VZ / (VY * VY)); + if (wwi >= 0.0) { + VY = -v * (www * vy - wwi * vzi * vz / vy) / cmpabs; + VZI = v * (wwi * vy + www * vzi * vz / vy) * vy / (vz * cmpabs); + } else { + VY = v * (www * vy - wwi * vzi * vz / vy) / cmpabs; + VZI = -v * (wwi * vy + www * vzi * vz / vy) * vy / (vz * cmpabs); + }; + goto outsample; + }; + + if (fabs (Z) < poserr) { /* surface at z=0 */ + if (VZ >= 0.0) { + VZ = -1e3 * poserr; + vz = VZ; + }; + sintheta = -VZ / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VZ * VZ + VZI * VZI); + if (wwi >= 0.0) { + VZ = -v * (www * vz - wwi * vzi) / cmpabs; + VZI = -v * (wwi * vz + www * vzi) / cmpabs; + } else { + VZ = v * (www * vz - wwi * vzi) / cmpabs; + VZI = v * (wwi * vz + www * vzi) / cmpabs; + }; + goto outsample; + }; + + if (fabs (Z - zthick) < poserr) { /* surface at z=zthick */ + if (VZ <= 0.0) { + vz = 1e3 * poserr; + vz = VZ; + }; + sintheta = vz / v; + www = complsqrt (xi[layerno] + sintheta * sintheta, -beta[layerno], &wwi); + cmpabs = sqrt (VZ * VZ + VZI * VZI); + if (wwi >= 0.0) { + VZ = -v * (www * vz - wwi * vzi) / cmpabs; + VZI = -v * (wwi * vz + www * vzi) / cmpabs; + } else { + VZ = v * (www * vz - wwi * vzi) / cmpabs; + VZI = v * (wwi * vz + www * vzi) / cmpabs; + }; + goto outsample; + }; + ABSORB; + + outsample: + /*fprintf(stderr, "%e %e %e %e %e %e %i \n", X,Y,Z,VX,VY,VZ,layerno); */ + /*x = X; + y = Y; + z = Z; */ + vx = VX; + vy = VY; + vz = VZ; + vzi = VZI; + /*SCATTER; */ + /*i=0; */ + }; /* end intersect check */ %} FINALLY %{ @@ -1720,29 +1927,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - + { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = 0.0; - double zmax = zthick; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = 0.0; + double zmax = zthick; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/Guide_anyshape_r.comp b/mcstas-comps/contrib/Guide_anyshape_r.comp index 19703c704..282b91ad3 100644 --- a/mcstas-comps/contrib/Guide_anyshape_r.comp +++ b/mcstas-comps/contrib/Guide_anyshape_r.comp @@ -93,28 +93,31 @@ SHARE DECLARE %{ -r_off_struct offdata; -int use_file_coatings; // Flag to specify whether to use (1) or not (0) the mirror parameters given in the .OFF file + r_off_struct offdata; + int use_file_coatings; // Flag to specify whether to use (1) or not (0) the mirror parameters given in the .OFF file %} INITIALIZE %{ -/* initialize OFF object from the file(s) */ - if (!r_off_init( geometry, xwidth, yheight, zdepth, !center, &offdata )) exit(-1); + /* initialize OFF object from the file(s) */ + if (!r_off_init (geometry, xwidth, yheight, zdepth, !center, &offdata)) + exit (-1); - if (m==0 && alpha==0 && W==0) { + if (m == 0 && alpha == 0 && W == 0) { use_file_coatings = 1; - printf("Guide_anyshape_r: %s: All of m, alpha, W assigned 0: \n - We are using H. Jacobsen reflectivity model if m-values are given in %s\n", NAME_CURRENT_COMP, geometry); + printf ("Guide_anyshape_r: %s: All of m, alpha, W assigned 0: \n - We are using H. Jacobsen reflectivity model if m-values are given in %s\n", + NAME_CURRENT_COMP, geometry); } else { - printf("Guide_anyshape_r: %s: alpha / m / W values provided in input: \n The corresponding values specified in %s will be ignored!\n", NAME_CURRENT_COMP, geometry); + printf ("Guide_anyshape_r: %s: alpha / m / W values provided in input: \n The corresponding values specified in %s will be ignored!\n", NAME_CURRENT_COMP, + geometry); use_file_coatings = 0; } %} TRACE %{ - int intersect=0; - int counter=0; + int intersect = 0; + int counter = 0; /* main loop for multiple reflections */ #ifdef OPENACC r_off_struct thread_offdata = offdata; @@ -122,41 +125,49 @@ TRACE #define thread_offdata offdata #endif do { - double t0=0, t3=0, dt=0; - unsigned long faceindex0=0, faceindex3=0, fi=0; - Coords n0, n3, n={0,0,0}; + double t0 = 0, t3 = 0, dt = 0; + unsigned long faceindex0 = 0, faceindex3 = 0, fi = 0; + Coords n0, n3, n = { 0, 0, 0 }; /* determine intersections with object; PL: get index of the intersected face */ - double mc_gx=0.0, mc_gy=0.0, mc_gz=0.0; + double mc_gx = 0.0, mc_gy = 0.0, mc_gz = 0.0; if (mcgravitation) { - Coords locgrav; - locgrav = rot_apply(_comp->_rotation_absolute, coords_set(0,-GRAVITY,0)); - coords_get(locgrav, &mc_gx, &mc_gy, &mc_gz); + Coords locgrav; + locgrav = rot_apply (_comp->_rotation_absolute, coords_set (0, -GRAVITY, 0)); + coords_get (locgrav, &mc_gx, &mc_gy, &mc_gz); } - intersect = r_off_intersect(&t0, &t3, &n0, &n3, &faceindex0, &faceindex3, - x,y,z, vx, vy, vz, mc_gx, mc_gy, mc_gz, thread_offdata ); + intersect = r_off_intersect (&t0, &t3, &n0, &n3, &faceindex0, &faceindex3, x, y, z, vx, vy, vz, mc_gx, mc_gy, mc_gz, thread_offdata); /* get the smallest positive */ - if (t0 > 0) { dt = t0; n=n0; fi=faceindex0;} - if (intersect > 1 && dt <= 0 && t3 > dt) { dt = t3; n=n3; fi=faceindex3;} + if (t0 > 0) { + dt = t0; + n = n0; + fi = faceindex0; + } + if (intersect > 1 && dt <= 0 && t3 > dt) { + dt = t3; + n = n3; + fi = faceindex3; + } /* exit loop when no intersection forward */ - if (dt <= 0 || !intersect) break; + if (dt <= 0 || !intersect) + break; - double nx,ny,nz; - coords_get(n, &nx, &ny, &nz); + double nx, ny, nz; + coords_get (n, &nx, &ny, &nz); /* test if the angle is large in case the object has an internal coating */ - double n2 = nx*nx+ny*ny+nz*nz; - double n_dot_v = scalar_prod(vx,vy,vz,nx,ny,nz); - double q = 2*fabs(n_dot_v)*V2K/sqrt(n2); + double n2 = nx * nx + ny * ny + nz * nz; + double n_dot_v = scalar_prod (vx, vy, vz, nx, ny, nz); + double q = 2 * fabs (n_dot_v) * V2K / sqrt (n2); /* propagate neutron to reflection point */ - PROP_DT(dt); + PROP_DT (dt); /* handle surface intersection */ - double R=0; + double R = 0; double m_value = m; double alpha_value = alpha; double W_value = W; @@ -166,46 +177,47 @@ TRACE alpha_value = offdata.face_alpha_Array[fi]; W_value = offdata.face_W_Array[fi]; } - double par[] = {R0, Qc, alpha_value, m_value, W_value}; - StdReflecFunc(q, par, &R); - + double par[] = { R0, Qc, alpha_value, m_value, W_value }; + StdReflecFunc (q, par, &R); if (R > 1) { - fprintf(stderr,"Guide_anyshape_r: %s: Warning: Reflectivity R=%g > 1 lowered to R=1.\n", NAME_CURRENT_COMP, R); - R=1; + fprintf (stderr, "Guide_anyshape_r: %s: Warning: Reflectivity R=%g > 1 lowered to R=1.\n", NAME_CURRENT_COMP, R); + R = 1; } /* now handle either probability when transmit or reflect */ if (R > 0) { /* when allowing transmission, we should check if indeed we reflect */ - if (!transmit || (transmit && rand01() < R)) { + if (!transmit || (transmit && rand01 () < R)) { /* reflect velocity: -q -> -2*n*n.v/|n|^2 */ - if (!transmit) p *= R; - n_dot_v *= 2/n2; - vx -= nx*n_dot_v; - vy -= ny*n_dot_v; - vz -= nz*n_dot_v; + if (!transmit) + p *= R; + n_dot_v *= 2 / n2; + vx -= nx * n_dot_v; + vy -= ny * n_dot_v; + vz -= nz * n_dot_v; SCATTER; } else { if (transmit) { - p *= (1-R); /* transmitted beam has non reflected weight */ - } else ABSORB; + p *= (1 - R); /* transmitted beam has non reflected weight */ + } else + ABSORB; } } else { /* R=0: no reflection: absorb or transmit through when allowed */ - if (!transmit) ABSORB; + if (!transmit) + ABSORB; } /* leave surface by a small amount so that next intersection is not the same one */ - PROP_DT(1e-9); - } while (intersect && counter++= whalf || y <= -hhalf || y >= hhalf) + if (x <= -whalf || x >= whalf || y <= -hhalf || y >= hhalf) ABSORB; SCATTER; - for(;;) - { - double par[]={R0, Qc, alpha, m, W}; + for (;;) { + double par[] = { R0, Qc, alpha, m, W }; /* Find itersection points of neutron with inside and outside guide walls */ - ii = cylinder_intersect(&t11, &t12 ,x - curvature, y, z, vx, vy, vz, R1, h1); - ii = cylinder_intersect(&t21, &t22 ,x - curvature, y, z, vx, vy, vz, R2, h1); + ii = cylinder_intersect (&t11, &t12, x - curvature, y, z, vx, vy, vz, R1, h1); + ii = cylinder_intersect (&t21, &t22, x - curvature, y, z, vx, vy, vz, R2, h1); /* Choose appropriate reflection time */ time1 = (t11 < 1e-7) ? t12 : t11; time2 = (t21 < 1e-7) ? t22 : t21; - time = (time1 < 1e-7 || time2 < time1) ? time2 : time1; + time = (time1 < 1e-7 || time2 < time1) ? time2 : time1; /* Has neutron left the guide? */ - endtime = (z_off - z)/vz; - if (time > endtime || time <= 1e-7) break; + endtime = (z_off - z) / vz; + if (time > endtime || time <= 1e-7) + break; - PROP_DT(time); + PROP_DT (time); /* Find reflection surface */ R = (time == time1) ? R1 : R2; - i_bounce = (fabs(y - hhalf) < 1e-7 || fabs(y + hhalf) < 1e-7) ? 2 : 1; - switch(i_bounce) { - case 1: /* Inside or Outside wall */ - phi = atan(vx/vz); /* angle of neutron trajectory */ - alphaAng = asin(z/R); /* angle of guide wall */ - theta = fabs(phi - alphaAng); /* angle of reflection */ - vz = vel_xz*cos(2.0*alphaAng - phi); - vx = vel_xz*sin(2.0*alphaAng - phi); + i_bounce = (fabs (y - hhalf) < 1e-7 || fabs (y + hhalf) < 1e-7) ? 2 : 1; + switch (i_bounce) { + case 1: /* Inside or Outside wall */ + phi = atan (vx / vz); /* angle of neutron trajectory */ + alphaAng = asin (z / R); /* angle of guide wall */ + theta = fabs (phi - alphaAng); /* angle of reflection */ + vz = vel_xz * cos (2.0 * alphaAng - phi); + vx = vel_xz * sin (2.0 * alphaAng - phi); break; - case 2: /* Top or Bottom wall */ - theta = fabs(atan(vy/vz)); - vy = -vy; + case 2: /* Top or Bottom wall */ + theta = fabs (atan (vy / vz)); + vy = -vy; break; } /* Now compute reflectivity. */ - if (m == 0 || !R0) ABSORB; - - q = 4.0*PI*sin(theta)/lambda; - StdReflecFunc(q, par, &R); - if (R >= 0) p *= R; else ABSORB; + if (m == 0 || !R0) + ABSORB; + + q = 4.0 * PI * sin (theta) / lambda; + StdReflecFunc (q, par, &R); + if (R >= 0) + p *= R; + else + ABSORB; SCATTER; } %} @@ -134,35 +140,33 @@ MCDISPLAY double xplot1[100], xplot2[100], zplot1[100], zplot2[100]; int n = 100; int j = 1; - double R1 = (curvature - 0.5*w1); /* radius of inside arc */ - double R2 = (curvature + 0.5*w1); /* radius of outside arc */ - - - - for(j=0;j 0 (reflecting) \n"); - exit(-1); - }; - - void TEST_INPUT_2(char name[20],char compname[256]) - { - fprintf(stderr,"Component: %s (Guide_four_side) %s can \n", compname, name); - fprintf(stderr," NOT be negative \n"); - exit(-1); - }; - -void TEST_INPUT_3(char name[20],char compname[256]) - { - fprintf(stderr,"Component: %s (Guide_four_side) %sr must \n", compname, name); - fprintf(stderr," be positive\n"); - exit(-1); + void + TEST_INPUT_1 (char name[20], char compname[256]) { + fprintf (stderr, "Component: %s (Guide_four_side) %s must \n", compname, name); + fprintf (stderr, " be -1 (transperent) or \n"); + fprintf (stderr, " be 0 (absorbing) or \n"); + fprintf (stderr, " be > 0 (reflecting) \n"); + exit (-1); }; -void TEST_INPUT_4(char name[20],char name1[20], double inputname, double inputname1,char compname[256]) - { - fprintf(stderr,"Component: %s (Guide_four_side) \n", compname); - fprintf(stderr," %s have to be bigger or equal %s \n", name, name1); - printf(" %s = %f \n",name, inputname ); - printf(" %s = %f \n",name1, inputname1 ); - fprintf(stderr," check curve parameter and wallthicknesses! \n"); - exit(-1); - }; - - /* function to calculate the needed parameters for an elliptic wall*/ - - void ELLIPSE(double w1,double length, double lin, double lout, double wallthick, double *a, double *b, double *a2, double *b2, double *z0, double *w2, double *awt, double *a2wt, double *bwt, double *b2wt, double *w2wt, double *w1wt) - { - double DIV1, lb, u1, u2, u1wt, u2wt, dx, dz; - lb=lin+length+lout; /* lenght between the two focal points of the wall */ - *z0=(lin-length-lout)/2.0; - u1=sqrt((lin*lin)+(w1*w1)); /* length between entrance focal point and starting point of the wall (INNER side)*/ - u2=sqrt((w1*w1)+((length+lout)*(length+lout))); /* length between exit focal point and end point of the wall (INNER side) */ - *a=(u1+u2)/2.0; /* long half axis a of the ellipse (INNER side)*/ - *a2=*a*(*a); /* square of the long axis a (INNER side)*/ - *b=sqrt(*a2-(lb*(lb)/4.0)); /* short half axis b of the ellipse (INNER side)*/ - *b2=*b*(*b); /* square of short half axis b of the ellipse (INNER side)*/ - DIV1=sqrt(1.0-((lb/2.0-lout)*(lb/2.0-lout)/(*a2))); /* help variable to calculated the exit width (INNER side)*/ - *w2=*b*(DIV1); /* exit width (INNER side)*/ - if(length<(lb)/2-lout){ /* if the maximum opening of the guide is smaller than the small half axis b, the OUTER side is defined by: */ - dx=wallthick * sin(atan(*a2 * w1/(*b2 * (*z0)))); - dz=wallthick * cos(atan(*a2 * w1/(*b2 * (*z0)))); - u1wt=sqrt(((lin+dz)*(lin+dz))+((w1+dx)*(w1+dx))); /* length between entrance focal point and starting point of the wall (OUTER side)*/ - u2wt=sqrt(((w1+dx)*(w1+dx))+((length+lout-dz)*(length+lout-dz))); /* length between exit focal point and end point of the wall (OUTER side) */ - *awt=(u1wt+u2wt)/2.0; /* long half axis a of the ellipse (OUTER side)*/ - *a2wt=*awt*(*awt); /* square of the long axis a (OUTER side)*/ - *bwt=sqrt(*a2wt-(lb*lb/4.0)); /* short half axis b of the ellipse (OUTER side)*/ - *b2wt=*bwt*(*bwt); /* square of short half axis b of the ellipse (OUTER side)*/ - *w2wt=*bwt*sqrt(1.0-((lb/2.0-lout)*(lb/2.0-lout)/(*a2wt))); /* exit width for OUTER side */ - *w1wt=*bwt*sqrt(1.0-((lb/2.0-lout-length)*(lb/2.0-lout-length)/(*a2wt))); /* entrance width for OUTER side */ - }else{ /* if the maximum opening of the guide is the small half axis b the OUTER wall is defined by:*/ - *bwt=*b+wallthick; /* short half axis b of the ellipse (OUTER side)*/ - *b2wt=*bwt*(*bwt); /* square of the long axis a (OUTER side)*/ - *awt=sqrt(*b2wt+(lb*lb/4.0)); /* long half axis a of the ellipse (OUTER side)*/ - *a2wt=*b2wt+(lb*lb/4.0); /* square of short half axis b of the ellipse (OUTER side)*/ - *w2wt=*bwt*sqrt(1.0-((lb/2.0-lout)*(lb/2.0-lout)/(*a2wt))); /* exit width for OUTER side */ - *w1wt=*bwt*sqrt(1.0-((lb/2.0-lin)*(lb/2.0-lin)/(*a2wt))); /* entrance width for OUTER side */ - } - } + void + TEST_INPUT_2 (char name[20], char compname[256]) { + fprintf (stderr, "Component: %s (Guide_four_side) %s can \n", compname, name); + fprintf (stderr, " NOT be negative \n"); + exit (-1); + }; - /* function to calculate the needed parameters for a parabolical focusing wall*/ + void + TEST_INPUT_3 (char name[20], char compname[256]) { + fprintf (stderr, "Component: %s (Guide_four_side) %sr must \n", compname, name); + fprintf (stderr, " be positive\n"); + exit (-1); + }; - void PARABEL_FOCUS(double w1,double length , double lout, double wallthick, double *p2para, double *w2, double *pb , double *pa, double *p2parawt, double *pbwt, double *pawt, double *w2wt, double *w1wt) - { - double DIV1,DIV1wt, dx, dz; - DIV1=(length+lout)*(length+lout); /* help variable to calculate the curve parameters (INNER side) */ - *p2para=2.0*(sqrt(DIV1+(w1*w1))-sqrt(DIV1)); /* help variable to calculate the curve parameters (INNER side) */ - *w2=sqrt(*p2para*(lout+*p2para/4.0)); /* exit width (INNER side) */ - *pb=length+lout+*p2para/4.0; /* parameter b for parabolic equation to define the wall (INNER side)*/ - *pa=1.0/(*p2para); /* parameter a for parabolic equation to define the wall (INNER side)*/ - dx= wallthick*sin(atan(w1*2*(*pa))); /* help variable dx; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ - dz= wallthick*cos(atan(w1*2*(*pa))); /* help variable dz; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ - DIV1wt=(length+lout-dz)*(length+lout-dz); /* help variable to calculate the curve parameters (OUTER side) */ - *p2parawt=2.0*(sqrt(DIV1wt+((w1+dx)*(w1+dx)))-sqrt(DIV1wt)); /* help variable to calculate the curve parameters (OUTER side) */ - *pbwt=length+lout+*p2parawt/4.0; /* parameter b for parabolic equation to define the wall (OUTER side)*/ - *pawt=1.0/(*p2parawt); /* parameter a for parabolic equation to define the wall (OUTER side)*/ - *w2wt=sqrt(*p2parawt*(lout+ *p2parawt/4.0)); /* exit width (OUTER side) */ - *w1wt=sqrt(*p2parawt*(lout+length+ *p2parawt/4.0)); /* entrance width (OUTER side) */ - } - - - /* function to calculate the needed parameters for a parabolical defocusing wall*/ - - void PARABEL_DEFOCUS(double w1,double length, double lin, double wallthick, double *p2para, double *w2, double *pb , double *pa, double *p2parawt, double *pbwt, double *pawt, double *w2wt, double *w1wt) - { - double DIV1,DIV1wt, dx, dz; - DIV1=lin*lin; /* help variable to calculate the curve parameters (INNER side) */ - *p2para=2.0*(sqrt(DIV1+(w1*w1))-sqrt(DIV1)); /* help variable to calculate the curve parameters (INNER side) */ - *w2=sqrt(*p2para*(length+lin+*p2para/4.0)); /* exit width (INNER side) */ - *pb=-(lin+*p2para/4.0); /* parameter b for parabolic equation to define the wall (INNER side)*/ - *pa=-1.0/(*p2para); /* parameter a for parabolic equation to define the wall (INNER side)*/ - dx=wallthick*sin(atan(-*w2*2*(*pa))); /* help variable dx; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ - dz=wallthick*cos(atan(-*w2*2*(*pa))); /* help variable dz; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ - DIV1wt=(lin+length-dz)*(lin+length-dz); /* help variable to calculate the curve parameters (OUTER side) */ - *p2parawt=2.0*(sqrt(DIV1wt+((*w2+dx)*(*w2+dx)))-sqrt(DIV1wt)); /* help variable to calculate the curve parameters (OUTER side) */ - *w1wt=sqrt(*p2parawt*(lin+*p2parawt/4.0)); /* entrance width for right focusing parabolic wall (OUTER side) */ - *w2wt=sqrt(*p2parawt*(lin+length+*p2parawt/4.0)); /* exit width (OUTER side) */ - *pbwt=-(lin+*p2parawt/4.0); /* parameter b for parabolic equation to define the wall (OUTER side)*/ - *pawt=-1.0/(*p2parawt); /* parameter a for parabolic equation to define the wall (OUTER side)*/ - } - - - /* function to calculate the needed parameters for a linear wall*/ - - void LINEAR(double w1, double w2, double length, double wallthick, double *w1wt, double *w2wt) - { - *w1wt=w1+wallthick/(cos(atan((w1-w2)/length))); /* entrance width (OUTER side) */ - *w2wt=w2+wallthick/(cos(atan((w1-w2)/length))); /* exit width (OUTER side) */ - } - - - /* function to calculate the intersection time with a linear wall at an negative axis*/ - - void TIME_LINEAR(double t1in, double w1, double w2, double length, double xin, double zin, double vxin1, double vzin1, double w1wt, double *t2, double *t2wt) - { - double anstieg; - anstieg=(-w2+w1)/length; - *t2=(anstieg*zin-w1-xin)/(vxin1-anstieg*vzin1); /* time untill next interaction with this wall (INNER side)*/ - *t2wt=(anstieg*zin-w1wt-xin)/(vxin1-anstieg*vzin1); /* time untill next interaction with this wall (OUTER side)*/ - if(*t2<1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ - *t2=t1in+2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall tunneling.*/ - if(*t2wt<1e-15) /* see comments above*/ - *t2wt=t1in+2.0; - } + void + TEST_INPUT_4 (char name[20], char name1[20], double inputname, double inputname1, char compname[256]) { + fprintf (stderr, "Component: %s (Guide_four_side) \n", compname); + fprintf (stderr, " %s have to be bigger or equal %s \n", name, name1); + printf (" %s = %f \n", name, inputname); + printf (" %s = %f \n", name1, inputname1); + fprintf (stderr, " check curve parameter and wallthicknesses! \n"); + exit (-1); + }; + /* function to calculate the needed parameters for an elliptic wall*/ + + void + ELLIPSE (double w1, double length, double lin, double lout, double wallthick, double* a, double* b, double* a2, double* b2, double* z0, double* w2, double* awt, + double* a2wt, double* bwt, double* b2wt, double* w2wt, double* w1wt) { + double DIV1, lb, u1, u2, u1wt, u2wt, dx, dz; + lb = lin + length + lout; /* lenght between the two focal points of the wall */ + *z0 = (lin - length - lout) / 2.0; + u1 = sqrt ((lin * lin) + (w1 * w1)); /* length between entrance focal point and starting point of the wall (INNER side)*/ + u2 = sqrt ((w1 * w1) + ((length + lout) * (length + lout))); /* length between exit focal point and end point of the wall (INNER side) */ + *a = (u1 + u2) / 2.0; /* long half axis a of the ellipse (INNER side)*/ + *a2 = *a * (*a); /* square of the long axis a (INNER side)*/ + *b = sqrt (*a2 - (lb * (lb) / 4.0)); /* short half axis b of the ellipse (INNER side)*/ + *b2 = *b * (*b); /* square of short half axis b of the ellipse (INNER side)*/ + DIV1 = sqrt (1.0 - ((lb / 2.0 - lout) * (lb / 2.0 - lout) / (*a2))); /* help variable to calculated the exit width (INNER side)*/ + *w2 = *b * (DIV1); /* exit width (INNER side)*/ + if (length < (lb) / 2 - lout) { /* if the maximum opening of the guide is smaller than the small half axis b, the OUTER side is defined by: */ + dx = wallthick * sin (atan (*a2 * w1 / (*b2 * (*z0)))); + dz = wallthick * cos (atan (*a2 * w1 / (*b2 * (*z0)))); + u1wt = sqrt (((lin + dz) * (lin + dz)) + ((w1 + dx) * (w1 + dx))); /* length between entrance focal point and starting point of the wall (OUTER side)*/ + u2wt = sqrt (((w1 + dx) * (w1 + dx)) + + ((length + lout - dz) * (length + lout - dz))); /* length between exit focal point and end point of the wall (OUTER side) */ + *awt = (u1wt + u2wt) / 2.0; /* long half axis a of the ellipse (OUTER side)*/ + *a2wt = *awt * (*awt); /* square of the long axis a (OUTER side)*/ + *bwt = sqrt (*a2wt - (lb * lb / 4.0)); /* short half axis b of the ellipse (OUTER side)*/ + *b2wt = *bwt * (*bwt); /* square of short half axis b of the ellipse (OUTER side)*/ + *w2wt = *bwt * sqrt (1.0 - ((lb / 2.0 - lout) * (lb / 2.0 - lout) / (*a2wt))); /* exit width for OUTER side */ + *w1wt = *bwt * sqrt (1.0 - ((lb / 2.0 - lout - length) * (lb / 2.0 - lout - length) / (*a2wt))); /* entrance width for OUTER side */ + } else { /* if the maximum opening of the guide is the small half axis b the OUTER wall is defined by:*/ + *bwt = *b + wallthick; /* short half axis b of the ellipse (OUTER side)*/ + *b2wt = *bwt * (*bwt); /* square of the long axis a (OUTER side)*/ + *awt = sqrt (*b2wt + (lb * lb / 4.0)); /* long half axis a of the ellipse (OUTER side)*/ + *a2wt = *b2wt + (lb * lb / 4.0); /* square of short half axis b of the ellipse (OUTER side)*/ + *w2wt = *bwt * sqrt (1.0 - ((lb / 2.0 - lout) * (lb / 2.0 - lout) / (*a2wt))); /* exit width for OUTER side */ + *w1wt = *bwt * sqrt (1.0 - ((lb / 2.0 - lin) * (lb / 2.0 - lin) / (*a2wt))); /* entrance width for OUTER side */ + } + } - /* function to calculate the intersection time with a linear wall at an positive axis*/ + /* function to calculate the needed parameters for a parabolical focusing wall*/ + + void + PARABEL_FOCUS (double w1, double length, double lout, double wallthick, double* p2para, double* w2, double* pb, double* pa, double* p2parawt, double* pbwt, + double* pawt, double* w2wt, double* w1wt) { + double DIV1, DIV1wt, dx, dz; + DIV1 = (length + lout) * (length + lout); /* help variable to calculate the curve parameters (INNER side) */ + *p2para = 2.0 * (sqrt (DIV1 + (w1 * w1)) - sqrt (DIV1)); /* help variable to calculate the curve parameters (INNER side) */ + *w2 = sqrt (*p2para * (lout + *p2para / 4.0)); /* exit width (INNER side) */ + *pb = length + lout + *p2para / 4.0; /* parameter b for parabolic equation to define the wall (INNER side)*/ + *pa = 1.0 / (*p2para); /* parameter a for parabolic equation to define the wall (INNER side)*/ + dx = wallthick + * sin ( + atan (w1 * 2 * (*pa))); /* help variable dx; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ + dz = wallthick + * cos ( + atan (w1 * 2 * (*pa))); /* help variable dz; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ + DIV1wt = (length + lout - dz) * (length + lout - dz); /* help variable to calculate the curve parameters (OUTER side) */ + *p2parawt = 2.0 * (sqrt (DIV1wt + ((w1 + dx) * (w1 + dx))) - sqrt (DIV1wt)); /* help variable to calculate the curve parameters (OUTER side) */ + *pbwt = length + lout + *p2parawt / 4.0; /* parameter b for parabolic equation to define the wall (OUTER side)*/ + *pawt = 1.0 / (*p2parawt); /* parameter a for parabolic equation to define the wall (OUTER side)*/ + *w2wt = sqrt (*p2parawt * (lout + *p2parawt / 4.0)); /* exit width (OUTER side) */ + *w1wt = sqrt (*p2parawt * (lout + length + *p2parawt / 4.0)); /* entrance width (OUTER side) */ + } - void TIME_LINEAR_1(double t1in, double w1, double w2, double length, double xin, double zin, double vxin1, double vzin1, double w1wt, double *t2, double *t2wt) - { - double anstieg; - anstieg=(w2-w1)/length; - *t2=(anstieg*zin+w1-xin)/(vxin1-anstieg*vzin1); - *t2wt=(anstieg*zin+w1wt-xin)/(vxin1-anstieg*vzin1); - if(*t2<1e-15) - *t2=t1in+2.0; - if(*t2wt<1e-15) - *t2wt=t1in+2.0; + /* function to calculate the needed parameters for a parabolical defocusing wall*/ + + void + PARABEL_DEFOCUS (double w1, double length, double lin, double wallthick, double* p2para, double* w2, double* pb, double* pa, double* p2parawt, double* pbwt, + double* pawt, double* w2wt, double* w1wt) { + double DIV1, DIV1wt, dx, dz; + DIV1 = lin * lin; /* help variable to calculate the curve parameters (INNER side) */ + *p2para = 2.0 * (sqrt (DIV1 + (w1 * w1)) - sqrt (DIV1)); /* help variable to calculate the curve parameters (INNER side) */ + *w2 = sqrt (*p2para * (length + lin + *p2para / 4.0)); /* exit width (INNER side) */ + *pb = -(lin + *p2para / 4.0); /* parameter b for parabolic equation to define the wall (INNER side)*/ + *pa = -1.0 / (*p2para); /* parameter a for parabolic equation to define the wall (INNER side)*/ + dx = wallthick + * sin ( + atan (-*w2 * 2 * (*pa))); /* help variable dx; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ + dz = wallthick + * cos ( + atan (-*w2 * 2 * (*pa))); /* help variable dz; needed because the wall is not paralell to the z-axis or the wallthickness is not perpendicular to z*/ + DIV1wt = (lin + length - dz) * (lin + length - dz); /* help variable to calculate the curve parameters (OUTER side) */ + *p2parawt = 2.0 * (sqrt (DIV1wt + ((*w2 + dx) * (*w2 + dx))) - sqrt (DIV1wt)); /* help variable to calculate the curve parameters (OUTER side) */ + *w1wt = sqrt (*p2parawt * (lin + *p2parawt / 4.0)); /* entrance width for right focusing parabolic wall (OUTER side) */ + *w2wt = sqrt (*p2parawt * (lin + length + *p2parawt / 4.0)); /* exit width (OUTER side) */ + *pbwt = -(lin + *p2parawt / 4.0); /* parameter b for parabolic equation to define the wall (OUTER side)*/ + *pawt = -1.0 / (*p2parawt); /* parameter a for parabolic equation to define the wall (OUTER side)*/ } + /* function to calculate the needed parameters for a linear wall*/ - /* function to calculate the intersection time with an elliptical wall at a negative axis*/ - - void TIME_ELLIPSE(double vxin, double vzin, double xin, double zin, double a2, double b2, double z0, double t1in, double a2wt, double b2wt, double *t2w1, double *t2w1wt) - { - /* solving the elliptic equation in respect to z and the straight neutron trajectoty, only two z values possible! */ - - double m,n,q,p,z1,z2,qwt,pwt, xintersec, z1wt, z2wt, xintersecwt,t2w2,t2w2wt; - - m=vxin/vzin; /* m parameter of the neutron trajectory*/ - n=-m*zin+xin; /* n parameter of the neutron trajectory */ - p=2.0*(a2*m*n+b2*z0)/(a2*m*m+b2); /* p parameter of quadratic equation for calulation the z component of the intersection point with respect to the neutron trajectory (INNER side)*/ - q=(a2*n*n+b2*z0*z0-a2*b2)/(a2*m*m+b2); /* q parameter of quadratic equation for calulation the z component of the intersection point with respect to the neutron trajectory (INNER side)*/ - if ((p*p/4.0)-q<0){ - *t2w1=t1in+2.0; /* if the neutron never touch the ellipse the time is set to be bigger than the time (t1) needed to pass the component */ - }else{ - z1=-p/2.0+sqrt(((p)*(p)/4.0)-q); /* first solution for z (INNER side)*/ - z2=-p/2.0-sqrt(((p)*(p)/4.0)-q); /* second solution for z (INNER side)*/ - *t2w1=(z1-zin)/vzin; /* interaction time for first z value (INNER side)*/ - t2w2=(z2-zin)/vzin; /* interactime time for second z value (INNER side)*/ - if(*t2w1<1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ - *t2w1=t1in+2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall tunneling.*/ - if(t2w2<1e-15) /* see comments above*/ - t2w2=t1in+2.0; - if(t2w2<*t2w1) /* choosing the smaller positive time solution (INNER side)*/ - *t2w1=t2w2; - xintersec=m*(vzin*(*t2w1)+zin)+n; /* crosscheck of the x-coordinate of the intersection point */ - if (xintersec>0) /* for the right wall x-coordinate of the intersection point have to be negative */ - *t2w1=t1in+2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ - } - pwt=2.0*(a2wt*m*n+b2wt*z0)/(a2wt*m*m+b2wt); /* p parameter of quadratic equation for calulation the z component of the intersection point with respect to the neutron trajectory (OUTER side)*/ - qwt=(a2wt*n*n+b2wt*z0*z0-a2wt*b2wt)/(a2wt*m*m+b2wt); /* q parameter of quadratic equation for calulation the z component of the intersection point with respect to the neutron trajectory (OUTER side)*/ - if ((pwt*pwt/4.0)-qwt<0){ - *t2w1wt=t1in+2.0; /* if the neutron never touch the ellipse the time is set bigger than need to pass the component */ - }else{ - z1wt=-pwt/2.0+sqrt((pwt*pwt/4.0)-qwt); /* first solution for z (OUTER side) */ - z2wt=-pwt/2.0-sqrt((pwt*pwt/4.0)-qwt); /* second solution for z (OUTER side)*/ - *t2w1wt=(z1wt-zin)/vzin; /* interaction time for first z value (OUTER side)*/ - t2w2wt=(z2wt-zin)/vzin; /* interactime time for second z value (OUTER side)*/ - if(*t2w1wt<1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ - *t2w1wt=t1in+2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall tunneling.*/ - if(t2w2wt<1e-15) /* see comments above*/ - t2w2wt=t1in+2.0; - if(t2w2wt<*t2w1wt) /* choosing the smaller positive time solution (OUTER side)*/ - *t2w1wt=t2w2wt; - xintersecwt=m*(vzin*(*t2w1wt)+zin)+n; /* crosscheck of the x-coordinate of the intersection point */ - if (xintersecwt>0) /* x-coordinate of the intersection point have to be negative */ - *t2w1wt=t1in+2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ - } - }; - - - - /* function to calculate the intersection time with an elliptical wall at a positive axis*/ - -void TIME_ELLIPSE_1(double vxin, double vzin, double xin, double zin, double a2, double b2, double z0, double t1in, double a2wt, double b2wt, double *t2w1, double *t2w1wt) -{ - double m,n,q,p,z1,z2,qwt,pwt, xintersec, z1wt, z2wt, xintersecwt,t2w2,t2w2wt; - - m=vxin/vzin; - n=-m*zin+xin; - p=2.0*(a2*m*n+b2*z0)/(a2*m*m+b2); - q=(a2*n*n+b2*z0*z0-a2*b2)/(a2*m*m+b2); - if ((p*p/4.0)-q<0){ - *t2w1=t1in+2.0; - }else{ - z1=-p/2.0+sqrt(((p)*(p)/4.0)-q); - z2=-p/2.0-sqrt(((p)*(p)/4.0)-q); - *t2w1=(z1-zin)/vzin; - t2w2=(z2-zin)/vzin; - if(*t2w1<1e-15) - *t2w1=t1in+2.0; - if(t2w2<1e-15) - t2w2=t1in+2.0; - if(t2w2<*t2w1) - *t2w1=t2w2; - xintersec=m*(vzin*(*t2w1)+zin)+n; - if (xintersec<0){ - *t2w1=t1in+2.0;} - } - pwt=2.0*(a2wt*m*n+b2wt*z0)/(a2wt*m*m+b2wt); - qwt=(a2wt*n*n+b2wt*z0*z0-a2wt*b2wt)/(a2wt*m*m+b2wt); - if ((pwt*pwt/4.0)-qwt<0){ - *t2w1wt=t1in+2.0; - }else{ - z1wt=-pwt/2.0+sqrt((pwt*pwt/4.0)-qwt); - z2wt=-pwt/2.0-sqrt((pwt*pwt/4.0)-qwt); - *t2w1wt=(z1wt-zin)/vzin; - t2w2wt=(z2wt-zin)/vzin; - if(*t2w1wt<1e-15) - *t2w1wt=t1in+2.0; - if(t2w2wt<1e-15) - t2w2wt=t1in+2.0; - if(t2w2wt<*t2w1wt) - *t2w1wt=t2w2wt; - xintersecwt=m*(vzin*(*t2w1wt)+zin)+n; - if (xintersecwt<0) - *t2w1wt=t1in+2.0; - } + void + LINEAR (double w1, double w2, double length, double wallthick, double* w1wt, double* w2wt) { + *w1wt = w1 + wallthick / (cos (atan ((w1 - w2) / length))); /* entrance width (OUTER side) */ + *w2wt = w2 + wallthick / (cos (atan ((w1 - w2) / length))); /* exit width (OUTER side) */ } + /* function to calculate the intersection time with a linear wall at an negative axis*/ + + void + TIME_LINEAR (double t1in, double w1, double w2, double length, double xin, double zin, double vxin1, double vzin1, double w1wt, double* t2, double* t2wt) { + double anstieg; + anstieg = (-w2 + w1) / length; + *t2 = (anstieg * zin - w1 - xin) / (vxin1 - anstieg * vzin1); /* time untill next interaction with this wall (INNER side)*/ + *t2wt = (anstieg * zin - w1wt - xin) / (vxin1 - anstieg * vzin1); /* time untill next interaction with this wall (OUTER side)*/ + if (*t2 < 1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ + *t2 = t1in + 2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall + tunneling.*/ + if (*t2wt < 1e-15) /* see comments above*/ + *t2wt = t1in + 2.0; + } + /* function to calculate the intersection time with a linear wall at an positive axis*/ + + void + TIME_LINEAR_1 (double t1in, double w1, double w2, double length, double xin, double zin, double vxin1, double vzin1, double w1wt, double* t2, double* t2wt) { + double anstieg; + anstieg = (w2 - w1) / length; + *t2 = (anstieg * zin + w1 - xin) / (vxin1 - anstieg * vzin1); + *t2wt = (anstieg * zin + w1wt - xin) / (vxin1 - anstieg * vzin1); + if (*t2 < 1e-15) + *t2 = t1in + 2.0; + if (*t2wt < 1e-15) + *t2wt = t1in + 2.0; + } - /* function to calculate the intersection time with a parabolical wall at an negative axis*/ + /* function to calculate the intersection time with an elliptical wall at a negative axis*/ + + void + TIME_ELLIPSE (double vxin, double vzin, double xin, double zin, double a2, double b2, double z0, double t1in, double a2wt, double b2wt, double* t2w1, + double* t2w1wt) { + /* solving the elliptic equation in respect to z and the straight neutron trajectoty, only two z values possible! */ + + double m, n, q, p, z1, z2, qwt, pwt, xintersec, z1wt, z2wt, xintersecwt, t2w2, t2w2wt; + + m = vxin / vzin; /* m parameter of the neutron trajectory*/ + n = -m * zin + xin; /* n parameter of the neutron trajectory */ + p = 2.0 * (a2 * m * n + b2 * z0) / (a2 * m * m + b2); /* p parameter of quadratic equation for calulation the z component of the intersection point with + respect to the neutron trajectory (INNER side)*/ + q = (a2 * n * n + b2 * z0 * z0 - a2 * b2) / (a2 * m * m + b2); /* q parameter of quadratic equation for calulation the z component of the intersection point + with respect to the neutron trajectory (INNER side)*/ + if ((p * p / 4.0) - q < 0) { + *t2w1 = t1in + 2.0; /* if the neutron never touch the ellipse the time is set to be bigger than the time (t1) needed to pass the component */ + } else { + z1 = -p / 2.0 + sqrt (((p) * (p) / 4.0) - q); /* first solution for z (INNER side)*/ + z2 = -p / 2.0 - sqrt (((p) * (p) / 4.0) - q); /* second solution for z (INNER side)*/ + *t2w1 = (z1 - zin) / vzin; /* interaction time for first z value (INNER side)*/ + t2w2 = (z2 - zin) / vzin; /* interactime time for second z value (INNER side)*/ + if (*t2w1 + < 1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ + *t2w1 = t1in + 2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall + tunneling.*/ + if (t2w2 < 1e-15) /* see comments above*/ + t2w2 = t1in + 2.0; + if (t2w2 < *t2w1) /* choosing the smaller positive time solution (INNER side)*/ + *t2w1 = t2w2; + xintersec = m * (vzin * (*t2w1) + zin) + n; /* crosscheck of the x-coordinate of the intersection point */ + if (xintersec > 0) /* for the right wall x-coordinate of the intersection point have to be negative */ + *t2w1 = t1in + 2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ + } + pwt = 2.0 * (a2wt * m * n + b2wt * z0) / (a2wt * m * m + b2wt); /* p parameter of quadratic equation for calulation the z component of the intersection point + with respect to the neutron trajectory (OUTER side)*/ + qwt = (a2wt * n * n + b2wt * z0 * z0 - a2wt * b2wt) / (a2wt * m * m + b2wt); /* q parameter of quadratic equation for calulation the z component of the + intersection point with respect to the neutron trajectory (OUTER side)*/ + if ((pwt * pwt / 4.0) - qwt < 0) { + *t2w1wt = t1in + 2.0; /* if the neutron never touch the ellipse the time is set bigger than need to pass the component */ + } else { + z1wt = -pwt / 2.0 + sqrt ((pwt * pwt / 4.0) - qwt); /* first solution for z (OUTER side) */ + z2wt = -pwt / 2.0 - sqrt ((pwt * pwt / 4.0) - qwt); /* second solution for z (OUTER side)*/ + *t2w1wt = (z1wt - zin) / vzin; /* interaction time for first z value (OUTER side)*/ + t2w2wt = (z2wt - zin) / vzin; /* interactime time for second z value (OUTER side)*/ + if (*t2w1wt + < 1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ + *t2w1wt = t1in + 2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a + wall tunneling.*/ + if (t2w2wt < 1e-15) /* see comments above*/ + t2w2wt = t1in + 2.0; + if (t2w2wt < *t2w1wt) /* choosing the smaller positive time solution (OUTER side)*/ + *t2w1wt = t2w2wt; + xintersecwt = m * (vzin * (*t2w1wt) + zin) + n; /* crosscheck of the x-coordinate of the intersection point */ + if (xintersecwt > 0) /* x-coordinate of the intersection point have to be negative */ + *t2w1wt = t1in + 2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ + } + }; - void TIME_PARABEL(double vxin, double vzin, double xin, double zin, double pa, double pb, double t1in, double pawt, double pbwt, double *t2w1, double *t2w1wt) - { - double m,n,p,q,z1,z2,t2w2,xintersec,pwt,qwt,t2w2wt,z1wt,z2wt,xintersecwt; + /* function to calculate the intersection time with an elliptical wall at a positive axis*/ + + void + TIME_ELLIPSE_1 (double vxin, double vzin, double xin, double zin, double a2, double b2, double z0, double t1in, double a2wt, double b2wt, double* t2w1, + double* t2w1wt) { + double m, n, q, p, z1, z2, qwt, pwt, xintersec, z1wt, z2wt, xintersecwt, t2w2, t2w2wt; + + m = vxin / vzin; + n = -m * zin + xin; + p = 2.0 * (a2 * m * n + b2 * z0) / (a2 * m * m + b2); + q = (a2 * n * n + b2 * z0 * z0 - a2 * b2) / (a2 * m * m + b2); + if ((p * p / 4.0) - q < 0) { + *t2w1 = t1in + 2.0; + } else { + z1 = -p / 2.0 + sqrt (((p) * (p) / 4.0) - q); + z2 = -p / 2.0 - sqrt (((p) * (p) / 4.0) - q); + *t2w1 = (z1 - zin) / vzin; + t2w2 = (z2 - zin) / vzin; + if (*t2w1 < 1e-15) + *t2w1 = t1in + 2.0; + if (t2w2 < 1e-15) + t2w2 = t1in + 2.0; + if (t2w2 < *t2w1) + *t2w1 = t2w2; + xintersec = m * (vzin * (*t2w1) + zin) + n; + if (xintersec < 0) { + *t2w1 = t1in + 2.0; + } + } + pwt = 2.0 * (a2wt * m * n + b2wt * z0) / (a2wt * m * m + b2wt); + qwt = (a2wt * n * n + b2wt * z0 * z0 - a2wt * b2wt) / (a2wt * m * m + b2wt); + if ((pwt * pwt / 4.0) - qwt < 0) { + *t2w1wt = t1in + 2.0; + } else { + z1wt = -pwt / 2.0 + sqrt ((pwt * pwt / 4.0) - qwt); + z2wt = -pwt / 2.0 - sqrt ((pwt * pwt / 4.0) - qwt); + *t2w1wt = (z1wt - zin) / vzin; + t2w2wt = (z2wt - zin) / vzin; + if (*t2w1wt < 1e-15) + *t2w1wt = t1in + 2.0; + if (t2w2wt < 1e-15) + t2w2wt = t1in + 2.0; + if (t2w2wt < *t2w1wt) + *t2w1wt = t2w2wt; + xintersecwt = m * (vzin * (*t2w1wt) + zin) + n; + if (xintersecwt < 0) + *t2w1wt = t1in + 2.0; + } + } - m=vxin/vzin; /* m parameter of the neutron trajectory*/ - n=-m*zin+xin; /* n parameter of the neutron trajectory */ - p=(2.0*m*n*pa+1.0)/(pa*m*m); /* p parameter of quadratic equation (INNER side) */ - q=n*n/(m*m)-pb/(pa*m*m); /* q parameter of quadratic equation (INNER side) */ - if(q>0 && q>(p*p/4)) { /* in the very special case of no intersection the quadratic equation has no solution (negative square root) the time is set to t1+2.0 */ - *t2w1=t1in+2.0; - }else{ - if(vxin==0) /* in the special case of vx = 0 is x a constant */ - { - if(xin<0){ /* only neutron with a negativ x-component can hit the RIGHT wall (INNER side)*/ - *t2w1=(pb-pa*xin*xin-zin)/vzin; - }else{ - *t2w1=t1in+2.0; /* the time solution for neutron with a positive x component is set to a time long behind the exit of the guide */ - /* (means will not scatter with the right wall)*/ + /* function to calculate the intersection time with a parabolical wall at an negative axis*/ + + void + TIME_PARABEL (double vxin, double vzin, double xin, double zin, double pa, double pb, double t1in, double pawt, double pbwt, double* t2w1, double* t2w1wt) { + double m, n, p, q, z1, z2, t2w2, xintersec, pwt, qwt, t2w2wt, z1wt, z2wt, xintersecwt; + + m = vxin / vzin; /* m parameter of the neutron trajectory*/ + n = -m * zin + xin; /* n parameter of the neutron trajectory */ + p = (2.0 * m * n * pa + 1.0) / (pa * m * m); /* p parameter of quadratic equation (INNER side) */ + q = n * n / (m * m) - pb / (pa * m * m); /* q parameter of quadratic equation (INNER side) */ + if (q > 0 + && q > (p * p + / 4)) { /* in the very special case of no intersection the quadratic equation has no solution (negative square root) the time is set to t1+2.0 */ + *t2w1 = t1in + 2.0; + } else { + if (vxin == 0) /* in the special case of vx = 0 is x a constant */ + { + if (xin < 0) { /* only neutron with a negativ x-component can hit the RIGHT wall (INNER side)*/ + *t2w1 = (pb - pa * xin * xin - zin) / vzin; + } else { + *t2w1 = t1in + 2.0; /* the time solution for neutron with a positive x component is set to a time long behind the exit of the guide */ + /* (means will not scatter with the right wall)*/ + } + } else { /* if vx is not zero and x is a real variable*/ + z1 = -p / 2.0 + sqrt (p * p / 4.0 - q); /* first z-solution for intersection (INNER side)*/ + z2 = -p / 2.0 - sqrt (p * p / 4.0 - q); /* second z-solution for intersection (INNER side)*/ + *t2w1 = (z1 - zin) / vzin; /* first time solution (INNER side)*/ + t2w2 = (z2 - zin) / vzin; /* second time solution (INNER side)*/ + if (*t2w1 + < 1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ + *t2w1 = t1in + 2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a + wall tunneling.*/ + if (t2w2 < 1e-15) /* see comments above*/ + t2w2 = t1in + 2.0; + if (t2w2 < *t2w1) /* choosing the smaller positive time solution (INNER side)*/ + *t2w1 = t2w2; } - }else{ /* if vx is not zero and x is a real variable*/ - z1=-p/2.0+sqrt(p*p/4.0-q); /* first z-solution for intersection (INNER side)*/ - z2=-p/2.0-sqrt(p*p/4.0-q); /* second z-solution for intersection (INNER side)*/ - *t2w1=(z1-zin)/vzin; /* first time solution (INNER side)*/ - t2w2=(z2-zin)/vzin; /* second time solution (INNER side)*/ - if(*t2w1<1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ - *t2w1=t1in+2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall tunneling.*/ - if(t2w2<1e-15) /* see comments above*/ - t2w2=t1in+2.0; - if(t2w2<*t2w1) /* choosing the smaller positive time solution (INNER side)*/ - *t2w1=t2w2; - } - xintersec=m*(vzin*(*t2w1)+zin)+n; /* crosscheck of the x-coordinate of the intersection point */ - if (xintersec>0){ /* the x-coordinate of the intersection point have to be negative */ - *t2w1=t1in+2.0;} /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ - } - pwt=(2.0*m*n*pawt+1.0)/(pawt*m*m); /* p parameter of quadratic equation (OUTER side)*/ - qwt=n*n/(m*m)-pbwt/(pawt*m*m); /* q parameter of quadratic equation (OUTER side)*/ - if(qwt>0 && qwt>(pwt*pwt/4)){ /* in the very special case of no intersection the quadratic equation has no solution (negative square root) and the time is set to t1+2.0 */ - *t2w1wt=t1in+2.0; - }else{ - if(vxin==0) /* in the special case of vx = 0 is x a constant */ - { - if(xin<0){ - *t2w1wt=(pbwt-pawt*xin*xin-zin)/vzin; /* only neutron with a negativ x-component can hit the RIGHT wall (OUTER wall)*/ - }else{ - *t2w1wt=t1in+2.0; + xintersec = m * (vzin * (*t2w1) + zin) + n; /* crosscheck of the x-coordinate of the intersection point */ + if (xintersec > 0) { /* the x-coordinate of the intersection point have to be negative */ + *t2w1 = t1in + 2.0; + } /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ + } + pwt = (2.0 * m * n * pawt + 1.0) / (pawt * m * m); /* p parameter of quadratic equation (OUTER side)*/ + qwt = n * n / (m * m) - pbwt / (pawt * m * m); /* q parameter of quadratic equation (OUTER side)*/ + if (qwt > 0 && qwt > (pwt * pwt / 4)) { /* in the very special case of no intersection the quadratic equation has no solution (negative square root) and the + time is set to t1+2.0 */ + *t2w1wt = t1in + 2.0; + } else { + if (vxin == 0) /* in the special case of vx = 0 is x a constant */ + { + if (xin < 0) { + *t2w1wt = (pbwt - pawt * xin * xin - zin) / vzin; /* only neutron with a negativ x-component can hit the RIGHT wall (OUTER wall)*/ + } else { + *t2w1wt = t1in + 2.0; + } + } else { /* if vx is not zero */ + z1wt = -pwt / 2.0 + sqrt (pwt * pwt / 4.0 - qwt); /* first z-solution for intersection (OUTER side)*/ + z2wt = -pwt / 2.0 - sqrt (pwt * pwt / 4.0 - qwt); /* second z-solution for intersection (OUTER side)*/ + *t2w1wt = (z1wt - zin) / vzin; /* first time solution (OUTER side)*/ + t2w2wt = (z2wt - zin) / vzin; /* second time solution (OUTER side)*/ + if (*t2w1wt + < 1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ + *t2w1wt = t1in + 2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a + wall tunneling.*/ + if (t2w2wt < 1e-15) /* see comments above*/ + t2w2wt = t1in + 2.0; + if (t2w2wt < *t2w1wt) /* choosing the smaller positive time solution (OUTER wall)*/ + *t2w1wt = t2w2wt; } - }else{ /* if vx is not zero */ - z1wt=-pwt/2.0+sqrt(pwt*pwt/4.0-qwt); /* first z-solution for intersection (OUTER side)*/ - z2wt=-pwt/2.0-sqrt(pwt*pwt/4.0-qwt); /* second z-solution for intersection (OUTER side)*/ - *t2w1wt=(z1wt-zin)/vzin; /* first time solution (OUTER side)*/ - t2w2wt=(z2wt-zin)/vzin; /* second time solution (OUTER side)*/ - if(*t2w1wt<1e-15) /* solving the precision problem for the intersection times given by double variable type, to small times (<1e-15) gives scattering events */ - *t2w1wt=t1in+2.0; /* at the same postion again (time is set to zero). this results in a sign change in the velocity components, which results in a wall tunneling.*/ - if(t2w2wt<1e-15) /* see comments above*/ - t2w2wt=t1in+2.0; - if(t2w2wt<*t2w1wt) /* choosing the smaller positive time solution (OUTER wall)*/ - *t2w1wt=t2w2wt; - } - xintersecwt=m*(vzin*(*t2w1wt)+zin)+n; /* crosscheck of the x-coordinate of the intersection point */ - if (xintersecwt>0) /* x-coordinate of the intersection point have to be negative */ - *t2w1wt=t1in+2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ - } + xintersecwt = m * (vzin * (*t2w1wt) + zin) + n; /* crosscheck of the x-coordinate of the intersection point */ + if (xintersecwt > 0) /* x-coordinate of the intersection point have to be negative */ + *t2w1wt = t1in + 2.0; /* if this is not the case the time is set to t1+2.0 (time point behind the component) */ + } }; - - /* function to calculate the intersection time with a parabolical wall at an positive axis*/ - - void TIME_PARABEL_1(double vxin, double vzin, double xin, double zin, double pa, double pb, double t1in, double pawt, double pbwt, double *t2w1, double *t2w1wt) - { - double m,n,p,q,z1,z2,t2w2,xintersec,pwt,qwt,t2w2wt,z1wt,z2wt,xintersecwt; - - m=vxin/vzin; - n=-m*zin+xin; - p=(2.0*m*n*pa+1.0)/(pa*m*m); - q=n*n/(m*m)-pb/(pa*m*m); - if(q>0 && q>(p*p/4)) { - *t2w1=t1in+2.0; - }else{ - if(vxin==0) - { - if(xin<0){ - *t2w1=(pb-pa*xin*xin-zin)/vzin; - }else{ - *t2w1=t1in+2.0; + /* function to calculate the intersection time with a parabolical wall at an positive axis*/ + + void + TIME_PARABEL_1 (double vxin, double vzin, double xin, double zin, double pa, double pb, double t1in, double pawt, double pbwt, double* t2w1, double* t2w1wt) { + double m, n, p, q, z1, z2, t2w2, xintersec, pwt, qwt, t2w2wt, z1wt, z2wt, xintersecwt; + + m = vxin / vzin; + n = -m * zin + xin; + p = (2.0 * m * n * pa + 1.0) / (pa * m * m); + q = n * n / (m * m) - pb / (pa * m * m); + if (q > 0 && q > (p * p / 4)) { + *t2w1 = t1in + 2.0; + } else { + if (vxin == 0) { + if (xin < 0) { + *t2w1 = (pb - pa * xin * xin - zin) / vzin; + } else { + *t2w1 = t1in + 2.0; + } + } else { + z1 = -p / 2.0 + sqrt (p * p / 4.0 - q); + z2 = -p / 2.0 - sqrt (p * p / 4.0 - q); + *t2w1 = (z1 - zin) / vzin; + t2w2 = (z2 - zin) / vzin; + if (*t2w1 < 1e-15) + *t2w1 = t1in + 2.0; + if (t2w2 < 1e-15) + t2w2 = t1in + 2.0; + if (t2w2 < *t2w1) + *t2w1 = t2w2; } - }else{ - z1=-p/2.0+sqrt(p*p/4.0-q); - z2=-p/2.0-sqrt(p*p/4.0-q); - *t2w1=(z1-zin)/vzin; - t2w2=(z2-zin)/vzin; - if(*t2w1<1e-15) - *t2w1=t1in+2.0; - if(t2w2<1e-15) - t2w2=t1in+2.0; - if(t2w2<*t2w1) - *t2w1=t2w2; - } - xintersec=m*(vzin*(*t2w1)+zin)+n; - if (xintersec<0){ - *t2w1=t1in+2.0;} - } - pwt=(2.0*m*n*pawt+1.0)/(pawt*m*m); - qwt=n*n/(m*m)-pbwt/(pawt*m*m); - if(qwt>0 && qwt>(pwt*pwt/4)){ - *t2w1wt=t1in+2.0; - }else{ - if(vxin==0) - { - if(xin<0){ - *t2w1wt=(pbwt-pawt*xin*xin-zin)/vzin; - }else{ - *t2w1wt=t1in+2.0; + xintersec = m * (vzin * (*t2w1) + zin) + n; + if (xintersec < 0) { + *t2w1 = t1in + 2.0; } - }else{ - z1wt=-pwt/2.0+sqrt(pwt*pwt/4.0-qwt); - z2wt=-pwt/2.0-sqrt(pwt*pwt/4.0-qwt); - *t2w1wt=(z1wt-zin)/vzin; - t2w2wt=(z2wt-zin)/vzin; - if(*t2w1wt<1e-15) *t2w1wt=t1in+2.0; - if(t2w2wt<1e-15) t2w2wt=t1in+2.0; - if(t2w2wt<*t2w1wt) *t2w1wt=t2w2wt; - } - xintersecwt=m*(vzin*(*t2w1wt)+zin)+n; - if (xintersecwt<0) *t2w1wt=t1in+2.0; - } + } + pwt = (2.0 * m * n * pawt + 1.0) / (pawt * m * m); + qwt = n * n / (m * m) - pbwt / (pawt * m * m); + if (qwt > 0 && qwt > (pwt * pwt / 4)) { + *t2w1wt = t1in + 2.0; + } else { + if (vxin == 0) { + if (xin < 0) { + *t2w1wt = (pbwt - pawt * xin * xin - zin) / vzin; + } else { + *t2w1wt = t1in + 2.0; + } + } else { + z1wt = -pwt / 2.0 + sqrt (pwt * pwt / 4.0 - qwt); + z2wt = -pwt / 2.0 - sqrt (pwt * pwt / 4.0 - qwt); + *t2w1wt = (z1wt - zin) / vzin; + t2w2wt = (z2wt - zin) / vzin; + if (*t2w1wt < 1e-15) + *t2w1wt = t1in + 2.0; + if (t2w2wt < 1e-15) + t2w2wt = t1in + 2.0; + if (t2w2wt < *t2w1wt) + *t2w1wt = t2w2wt; + } + xintersecwt = m * (vzin * (*t2w1wt) + zin) + n; + if (xintersecwt < 0) + *t2w1wt = t1in + 2.0; + } }; - - /* test if the left or right scattered neutron in the upper and lower limits defined by TOP und BOTTOM walls */ - -void TEST_UP_DOWN(double t,double vzin, double zin,double vyin,double yin, double length, - double linhdin, double louthdin, double linhuin, double louthuin, - double h2din, double h1din, double h2uin, double h1uin, - double bhdin, double z0hdin, double a2hdin,double bhuin, double z0huin, double a2huin, - double pbhdin, double pahdin, double pbhuin, double pahuin, - double *ylimitd, double *ylimitu, double *ytest) -{ - if(linhdin==0 && louthdin==0) - { - *ylimitd=(-h2din+h1din)/length*(vzin*t+zin)-h1din; /* calculation of the lower y-limit given by a linear bottom wall and the interaction time*/ - }else{ - if(linhdin!=0 && louthdin!=0) - { - *ylimitd=-bhdin*sqrt(1-((z0hdin+(vzin*t+zin))*(z0hdin+(vzin*t+zin)))/a2hdin); /* calculation of the lower y-limit given by a elliptic bottom wall and the interaction time*/ - }else{ - *ylimitd=-sqrt(((vzin*t+zin)-pbhdin)/-pahdin); /* calculation of the lower y-limit given by a parabolic bottom wall and the interaction time*/ + /* test if the left or right scattered neutron in the upper and lower limits defined by TOP und BOTTOM walls */ + + void + TEST_UP_DOWN (double t, double vzin, double zin, double vyin, double yin, double length, double linhdin, double louthdin, double linhuin, double louthuin, + double h2din, double h1din, double h2uin, double h1uin, double bhdin, double z0hdin, double a2hdin, double bhuin, double z0huin, double a2huin, + double pbhdin, double pahdin, double pbhuin, double pahuin, double* ylimitd, double* ylimitu, double* ytest) { + if (linhdin == 0 && louthdin == 0) { + *ylimitd + = (-h2din + h1din) / length * (vzin * t + zin) - h1din; /* calculation of the lower y-limit given by a linear bottom wall and the interaction time*/ + } else { + if (linhdin != 0 && louthdin != 0) { + *ylimitd = -bhdin + * sqrt (1 + - ((z0hdin + (vzin * t + zin)) * (z0hdin + (vzin * t + zin))) + / a2hdin); /* calculation of the lower y-limit given by a elliptic bottom wall and the interaction time*/ + } else { + *ylimitd = -sqrt (((vzin * t + zin) - pbhdin) / -pahdin); /* calculation of the lower y-limit given by a parabolic bottom wall and the interaction time*/ } - } - if(linhuin==0 && louthuin==0) - { - *ylimitu=(h2uin-h1uin)/length*(vzin*t+zin)+h1uin; /* calculation of the upper y-limit given by a linear top wall and the interaction time*/ - } - else{ - if(linhuin!=0 && louthuin!=0) - { - *ylimitu=bhuin*sqrt(1-((z0huin+(vzin*t+zin))*(z0huin+(vzin*t+zin)))/a2huin); /* calculation of the upper y-limit given by a elliptic top wall and the interaction time*/ - }else{ - *ylimitu=sqrt(((vzin*t+zin)-pbhuin)/-pahuin); /* calculation of the upper y-limit given by a parabolic top wall and the interaction time*/ } + if (linhuin == 0 && louthuin == 0) { + *ylimitu = (h2uin - h1uin) / length * (vzin * t + zin) + h1uin; /* calculation of the upper y-limit given by a linear top wall and the interaction time*/ + } else { + if (linhuin != 0 && louthuin != 0) { + *ylimitu = bhuin + * sqrt (1 + - ((z0huin + (vzin * t + zin)) * (z0huin + (vzin * t + zin))) + / a2huin); /* calculation of the upper y-limit given by a elliptic top wall and the interaction time*/ + } else { + *ylimitu = sqrt (((vzin * t + zin) - pbhuin) / -pahuin); /* calculation of the upper y-limit given by a parabolic top wall and the interaction time*/ + } } - *ytest=vyin*t+yin; /* calculation of the y coordinate of the neutron at the interaction time */ + *ytest = vyin * t + yin; /* calculation of the y coordinate of the neutron at the interaction time */ }; - - /* test if the up or down scattered neutron in the right and left limits defined by RIGHT und LEFT walls */ - -void TEST_LEFT_RIGHT(double t,double vzin, double zin,double vxin,double xin, double length, - double linwrin, double loutwrin, double linwlin, double loutwlin, - double w2rin, double w1rin, double w2lin, double w1lin, - double bwrin, double z0wrin, double a2wrin,double bwlin, double z0wlin, double a2wlin, - double pbwrin, double pawrin, double pbwlin, double pawlin, - double *xlimitr, double *xlimitl, double *xtest) -{ - if(linwrin==0 && loutwrin==0) - { - *xlimitr=(-w2rin+w1rin)/length*(vzin*t+zin)-w1rin; - }else{ - if(linwrin!=0 && loutwrin!=0) - { - *xlimitr=-bwrin*sqrt(1-((z0wrin+(vzin*t+zin))*(z0wrin+(vzin*t+zin)))/a2wrin); - }else{ - *xlimitr=-sqrt(((vzin*t+zin)-pbwrin)/-pawrin); + /* test if the up or down scattered neutron in the right and left limits defined by RIGHT und LEFT walls */ + + void + TEST_LEFT_RIGHT (double t, double vzin, double zin, double vxin, double xin, double length, double linwrin, double loutwrin, double linwlin, double loutwlin, + double w2rin, double w1rin, double w2lin, double w1lin, double bwrin, double z0wrin, double a2wrin, double bwlin, double z0wlin, double a2wlin, + double pbwrin, double pawrin, double pbwlin, double pawlin, double* xlimitr, double* xlimitl, double* xtest) { + if (linwrin == 0 && loutwrin == 0) { + *xlimitr = (-w2rin + w1rin) / length * (vzin * t + zin) - w1rin; + } else { + if (linwrin != 0 && loutwrin != 0) { + *xlimitr = -bwrin * sqrt (1 - ((z0wrin + (vzin * t + zin)) * (z0wrin + (vzin * t + zin))) / a2wrin); + } else { + *xlimitr = -sqrt (((vzin * t + zin) - pbwrin) / -pawrin); + } } - } - if(linwlin==0 && loutwlin == 0) - { - *xlimitl=(w2lin-w1lin)/length*(vzin*t+zin)+w1lin; - }else{ - if(linwlin!=0 && loutwlin != 0) - { - *xlimitl=bwlin*sqrt(1-((z0wlin+(vzin*t+zin))*(z0wlin+(vzin*t+zin)))/a2wlin); - }else{ - *xlimitl=sqrt(((vzin*t+zin)-pbwlin)/-pawlin); + if (linwlin == 0 && loutwlin == 0) { + *xlimitl = (w2lin - w1lin) / length * (vzin * t + zin) + w1lin; + } else { + if (linwlin != 0 && loutwlin != 0) { + *xlimitl = bwlin * sqrt (1 - ((z0wlin + (vzin * t + zin)) * (z0wlin + (vzin * t + zin))) / a2wlin); + } else { + *xlimitl = sqrt (((vzin * t + zin) - pbwlin) / -pawlin); } - } - *xtest=vxin*t+xin; -}; - + } + *xtest = vxin * t + xin; + }; %} @@ -795,7 +809,7 @@ DECLARE double ahuwt; double bhuwt; double ahdwt; - double bhdwt; + double bhdwt; /* parameter a and b of the parabolic curves for the OUTER wall*/ double pawrwt; double pawlwt; @@ -804,8 +818,8 @@ DECLARE double pahuwt; double pahdwt; double pbhuwt; - double pbhdwt; - + double pbhdwt; + /* square of long and short axis a and b auf the ellipses (OUTER walls) */ double a2wlwt; double b2wlwt; @@ -814,7 +828,7 @@ DECLARE double a2huwt; double b2huwt; double a2hdwt; - double b2hdwt; + double b2hdwt; /* square of long and short axis a and b auf the ellipses (INNER walls)*/ double a2wl; double b2wl; @@ -823,7 +837,7 @@ DECLARE double a2hu; double b2hu; double a2hd; - double b2hd; + double b2hd; /* variables the calculated the guide geometrie in the entrance and exit plane (absorbing mask given by the walls)*/ double mru1; double mru2; @@ -840,23 +854,23 @@ DECLARE double mld1; double mld2; double nld1; - double nld2; + double nld2; /* z-component of the center of the ellipse (x-component is allways zero) */ double z0wr; double z0wl; double z0hu; double z0hd; - + /* help variables to calculate the parabolic curve parameters a and b (INNER walls)*/ double p2parawr; double p2parawl; double p2parahu; - double p2parahd; + double p2parahd; /* help variables to calculate the parabolic curve parameters a and b for (OUTER wall)*/ double p2parawrwt; double p2parawlwt; double p2parahuwt; - double p2parahdwt; + double p2parahdwt; t_Table riTable; t_Table liTable; @@ -872,275 +886,304 @@ DECLARE INITIALIZE %{ - int i; - + int i; -if (RIreflect && strlen(RIreflect)) { - if (Table_Read(&riTable, RIreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"right inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, RIreflect)); + if (RIreflect && strlen (RIreflect)) { + if (Table_Read (&riTable, RIreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "right inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, RIreflect)); } -if (LIreflect && strlen(LIreflect)) { - if (Table_Read(&liTable, LIreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"left inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, LIreflect)); + if (LIreflect && strlen (LIreflect)) { + if (Table_Read (&liTable, LIreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "left inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, LIreflect)); } -if (UIreflect && strlen(UIreflect)) { - if (Table_Read(&uiTable, UIreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"top inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, UIreflect)); + if (UIreflect && strlen (UIreflect)) { + if (Table_Read (&uiTable, UIreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "top inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, UIreflect)); } -if (DIreflect && strlen(DIreflect)) { - if (Table_Read(&diTable, DIreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"botton inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, DIreflect)); + if (DIreflect && strlen (DIreflect)) { + if (Table_Read (&diTable, DIreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "botton inner Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, DIreflect)); } -if (ROreflect && strlen(ROreflect)) { - if (Table_Read(&roTable, ROreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"right outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, ROreflect)); + if (ROreflect && strlen (ROreflect)) { + if (Table_Read (&roTable, ROreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "right outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, ROreflect)); } -if (LOreflect && strlen(LOreflect)) { - if (Table_Read(&loTable, LOreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"left outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, LOreflect)); + if (LOreflect && strlen (LOreflect)) { + if (Table_Read (&loTable, LOreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "left outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, LOreflect)); } -if (UOreflect && strlen(UOreflect)) { - if (Table_Read(&uoTable, UOreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"top outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, UOreflect)); + if (UOreflect && strlen (UOreflect)) { + if (Table_Read (&uoTable, UOreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "top outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, UOreflect)); } -if (DOreflect && strlen(DOreflect)) { - if (Table_Read(&doTable, DOreflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"botton outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, DOreflect)); + if (DOreflect && strlen (DOreflect)) { + if (Table_Read (&doTable, DOreflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "botton outer Wall: %s: can not read file %s\n", NAME_CURRENT_COMP, DOreflect)); } -if (w1r < 0) TEST_INPUT("w1r",NAME_CURRENT_COMP); - -if (w1l < 0) TEST_INPUT("w1l",NAME_CURRENT_COMP); + if (w1r < 0) + TEST_INPUT ("w1r", NAME_CURRENT_COMP); -if (h1u < 0) TEST_INPUT("h1u",NAME_CURRENT_COMP); + if (w1l < 0) + TEST_INPUT ("w1l", NAME_CURRENT_COMP); -if (h1d < 0) TEST_INPUT("h1d",NAME_CURRENT_COMP); + if (h1u < 0) + TEST_INPUT ("h1u", NAME_CURRENT_COMP); -if (w2r < 0) TEST_INPUT("w2r",NAME_CURRENT_COMP); + if (h1d < 0) + TEST_INPUT ("h1d", NAME_CURRENT_COMP); -if (w2l < 0) TEST_INPUT("w2l",NAME_CURRENT_COMP); + if (w2r < 0) + TEST_INPUT ("w2r", NAME_CURRENT_COMP); -if (h2u < 0) TEST_INPUT("h2u",NAME_CURRENT_COMP); + if (w2l < 0) + TEST_INPUT ("w2l", NAME_CURRENT_COMP); -if (h2d < 0) TEST_INPUT("h2d",NAME_CURRENT_COMP); + if (h2u < 0) + TEST_INPUT ("h2u", NAME_CURRENT_COMP); -if (mxrOW !=-1 && mxrOW < 0) TEST_INPUT_1("mxrOW",NAME_CURRENT_COMP); + if (h2d < 0) + TEST_INPUT ("h2d", NAME_CURRENT_COMP); -if (mxlOW !=-1 && mxlOW < 0) TEST_INPUT_1("mxlOW",NAME_CURRENT_COMP); + if (mxrOW != -1 && mxrOW < 0) + TEST_INPUT_1 ("mxrOW", NAME_CURRENT_COMP); -if (myuOW !=-1 && myuOW < 0) TEST_INPUT_1("myuOW",NAME_CURRENT_COMP); + if (mxlOW != -1 && mxlOW < 0) + TEST_INPUT_1 ("mxlOW", NAME_CURRENT_COMP); -if (mydOW !=-1 && mydOW < 0) TEST_INPUT_1("mydOW",NAME_CURRENT_COMP); + if (myuOW != -1 && myuOW < 0) + TEST_INPUT_1 ("myuOW", NAME_CURRENT_COMP); -if (mxr < 0 && mxr!=-1) TEST_INPUT_1("mxr",NAME_CURRENT_COMP); + if (mydOW != -1 && mydOW < 0) + TEST_INPUT_1 ("mydOW", NAME_CURRENT_COMP); -if (mxl < 0 && mxl!=-1) TEST_INPUT_1("mxl",NAME_CURRENT_COMP); + if (mxr < 0 && mxr != -1) + TEST_INPUT_1 ("mxr", NAME_CURRENT_COMP); -if (myu < 0 && myu!=-1) TEST_INPUT_1("myu",NAME_CURRENT_COMP); + if (mxl < 0 && mxl != -1) + TEST_INPUT_1 ("mxl", NAME_CURRENT_COMP); -if (myd < 0 && myd!=-1) TEST_INPUT_1("myd",NAME_CURRENT_COMP); + if (myu < 0 && myu != -1) + TEST_INPUT_1 ("myu", NAME_CURRENT_COMP); -if (Qcxl < 0) TEST_INPUT_2("Qcxl",NAME_CURRENT_COMP); + if (myd < 0 && myd != -1) + TEST_INPUT_1 ("myd", NAME_CURRENT_COMP); -if (Qcxr < 0) TEST_INPUT_2("Qcxr",NAME_CURRENT_COMP); + if (Qcxl < 0) + TEST_INPUT_2 ("Qcxl", NAME_CURRENT_COMP); -if (Qcyu < 0) TEST_INPUT_2("Qcyu",NAME_CURRENT_COMP); + if (Qcxr < 0) + TEST_INPUT_2 ("Qcxr", NAME_CURRENT_COMP); -if (Qcyd < 0) TEST_INPUT_2("Qcyd",NAME_CURRENT_COMP); + if (Qcyu < 0) + TEST_INPUT_2 ("Qcyu", NAME_CURRENT_COMP); -if (alphaxl < 0) TEST_INPUT_2("alphaxl",NAME_CURRENT_COMP); + if (Qcyd < 0) + TEST_INPUT_2 ("Qcyd", NAME_CURRENT_COMP); -if (alphaxr < 0) TEST_INPUT_2("alphaxr",NAME_CURRENT_COMP); + if (alphaxl < 0) + TEST_INPUT_2 ("alphaxl", NAME_CURRENT_COMP); -if (alphayu < 0) TEST_INPUT_2("alphayu",NAME_CURRENT_COMP); + if (alphaxr < 0) + TEST_INPUT_2 ("alphaxr", NAME_CURRENT_COMP); -if (alphayd < 0) TEST_INPUT_2("alphayd",NAME_CURRENT_COMP); + if (alphayu < 0) + TEST_INPUT_2 ("alphayu", NAME_CURRENT_COMP); -if (QcxlOW < 0) TEST_INPUT_2("QcxlOW",NAME_CURRENT_COMP); + if (alphayd < 0) + TEST_INPUT_2 ("alphayd", NAME_CURRENT_COMP); -if (QcxrOW < 0) TEST_INPUT_2("QcxrOW",NAME_CURRENT_COMP); + if (QcxlOW < 0) + TEST_INPUT_2 ("QcxlOW", NAME_CURRENT_COMP); -if (QcyuOW < 0) TEST_INPUT_2("QcyuOW",NAME_CURRENT_COMP); + if (QcxrOW < 0) + TEST_INPUT_2 ("QcxrOW", NAME_CURRENT_COMP); -if (QcydOW < 0) TEST_INPUT_2("QcydOW",NAME_CURRENT_COMP); + if (QcyuOW < 0) + TEST_INPUT_2 ("QcyuOW", NAME_CURRENT_COMP); -if (alphaxlOW < 0) TEST_INPUT_2("alphaxlOW",NAME_CURRENT_COMP); + if (QcydOW < 0) + TEST_INPUT_2 ("QcydOW", NAME_CURRENT_COMP); -if (alphaxrOW < 0) TEST_INPUT_2("alphaxrOW",NAME_CURRENT_COMP); + if (alphaxlOW < 0) + TEST_INPUT_2 ("alphaxlOW", NAME_CURRENT_COMP); -if (alphayuOW < 0) TEST_INPUT_2("alphayuOW",NAME_CURRENT_COMP); + if (alphaxrOW < 0) + TEST_INPUT_2 ("alphaxrOW", NAME_CURRENT_COMP); -if (alphaydOW < 0) TEST_INPUT_2("alphaydOW",NAME_CURRENT_COMP); + if (alphayuOW < 0) + TEST_INPUT_2 ("alphayuOW", NAME_CURRENT_COMP); -if (rwallthick < 0) TEST_INPUT_2("rwallthick",NAME_CURRENT_COMP); + if (alphaydOW < 0) + TEST_INPUT_2 ("alphaydOW", NAME_CURRENT_COMP); -if (lwallthick < 0) TEST_INPUT_2("lwallthick",NAME_CURRENT_COMP); + if (rwallthick < 0) + TEST_INPUT_2 ("rwallthick", NAME_CURRENT_COMP); -if (uwallthick < 0) TEST_INPUT_2("uwallthick",NAME_CURRENT_COMP); + if (lwallthick < 0) + TEST_INPUT_2 ("lwallthick", NAME_CURRENT_COMP); -if (dwallthick < 0) TEST_INPUT_2("dwallthick",NAME_CURRENT_COMP); + if (uwallthick < 0) + TEST_INPUT_2 ("uwallthick", NAME_CURRENT_COMP); + if (dwallthick < 0) + TEST_INPUT_2 ("dwallthick", NAME_CURRENT_COMP); -if (Wxr <=0) TEST_INPUT_3("Wxr",NAME_CURRENT_COMP); + if (Wxr <= 0) + TEST_INPUT_3 ("Wxr", NAME_CURRENT_COMP); -if (Wxl <=0) TEST_INPUT_3("Wxl",NAME_CURRENT_COMP); + if (Wxl <= 0) + TEST_INPUT_3 ("Wxl", NAME_CURRENT_COMP); -if (Wyu <=0) TEST_INPUT_3("Wyu",NAME_CURRENT_COMP); + if (Wyu <= 0) + TEST_INPUT_3 ("Wyu", NAME_CURRENT_COMP); -if (Wyd <=0) TEST_INPUT_3("Wyd",NAME_CURRENT_COMP); + if (Wyd <= 0) + TEST_INPUT_3 ("Wyd", NAME_CURRENT_COMP); -if (WxrOW <=0) TEST_INPUT_3("WxrOW",NAME_CURRENT_COMP); + if (WxrOW <= 0) + TEST_INPUT_3 ("WxrOW", NAME_CURRENT_COMP); -if (WxlOW <=0) TEST_INPUT_3("WxlOW",NAME_CURRENT_COMP); + if (WxlOW <= 0) + TEST_INPUT_3 ("WxlOW", NAME_CURRENT_COMP); -if (WyuOW <=0) TEST_INPUT_3("WyuOW",NAME_CURRENT_COMP); + if (WyuOW <= 0) + TEST_INPUT_3 ("WyuOW", NAME_CURRENT_COMP); -if (WydOW <=0) TEST_INPUT_3("WydOW",NAME_CURRENT_COMP); + if (WydOW <= 0) + TEST_INPUT_3 ("WydOW", NAME_CURRENT_COMP); -if (l <= 0) - { - fprintf(stderr,"Component: %s (Guide_four_side) real guide length \n", - NAME_CURRENT_COMP); - fprintf(stderr," is <= ZERO ! \n"); - exit(-1); + if (l <= 0) { + fprintf (stderr, "Component: %s (Guide_four_side) real guide length \n", NAME_CURRENT_COMP); + fprintf (stderr, " is <= ZERO ! \n"); + exit (-1); } -if (mcgravitation) fprintf(stderr,"WARNING: Guide_four_side: %s: " - "This component produces wrong results with gravitation !\n" - "Use Guide_gravity.\n", - NAME_CURRENT_COMP); - - - /* Calculation of curve-parameters for the right side wall - negative x-axis */ - - /* Calculation of curve-parameters for the right side wall - negative x-axis */ - -if(loutwr!=0 && linwr!=0) /* elliptic right side wall */ - { - ELLIPSE(w1r, l, linwr, loutwr, rwallthick, &awr, &bwr, &a2wr, &b2wr, &z0wr, &w2r, &awrwt, &a2wrwt, &bwrwt, &b2wrwt, &w2rwt, &w1rwt); - } - + if (mcgravitation) + fprintf (stderr, + "WARNING: Guide_four_side: %s: " + "This component produces wrong results with gravitation !\n" + "Use Guide_gravity.\n", + NAME_CURRENT_COMP); -if(linwr==0 && loutwr!=0) /* parabolic focusing right side wall */ - { - PARABEL_FOCUS( w1r,l ,loutwr, rwallthick, &p2parawr, &w2r, &pbwr , &pawr, &p2parawrwt, &pbwrwt, &pawrwt, &w2rwt, &w1rwt); - } + /* Calculation of curve-parameters for the right side wall - negative x-axis */ -if (linwr!=0 && loutwr==0) /* parabolic defocusing right side wall */ - { - PARABEL_DEFOCUS( w1r,l ,linwr, rwallthick, &p2parawr, &w2r, &pbwr , &pawr, &p2parawrwt, &pbwrwt, &pawrwt, &w2rwt, &w1rwt); - } - -if(linwr==0 && loutwr==0) /* straight right side wall */ - { - LINEAR(w1r, w2r, l, rwallthick, &w1rwt, &w2rwt); - } - - - /* Calculation of curve-parameters for the left side wall - positive x-axis - analog to right side*/ - -if((linwl!=0) && (loutwl!=0) ) /* elleptic left side wall */ - { - ELLIPSE(w1l, l, linwl, loutwl, lwallthick, &awl, &bwl, &a2wl, &b2wl, &z0wl, &w2l, &awlwt, &a2wlwt, &bwlwt, &b2wlwt, &w2lwt, &w1lwt); - } - -if(linwl==0 && loutwl!=0) /* parabolic focusing left side wall */ - { - PARABEL_FOCUS( w1l,l ,loutwl, lwallthick, &p2parawl, &w2l, &pbwl , &pawl, &p2parawlwt, &pbwlwt, &pawlwt, &w2lwt, &w1lwt); - } - -if (linwl!=0 && loutwl==0) /* parabolic defocusing left side wall */ - { - PARABEL_DEFOCUS( w1l,l ,linwl, lwallthick, &p2parawl, &w2l, &pbwl , &pawl, &p2parawlwt, &pbwlwt, &pawlwt, &w2lwt, &w1lwt); - } + /* Calculation of curve-parameters for the right side wall - negative x-axis */ -if(linwl==0 && loutwl==0) /* straight left side wall */ - { - LINEAR(w1l, w2l, l, lwallthick, &w1lwt, &w2lwt); - } + if (loutwr != 0 && linwr != 0) /* elliptic right side wall */ + { + ELLIPSE (w1r, l, linwr, loutwr, rwallthick, &awr, &bwr, &a2wr, &b2wr, &z0wr, &w2r, &awrwt, &a2wrwt, &bwrwt, &b2wrwt, &w2rwt, &w1rwt); + } + if (linwr == 0 && loutwr != 0) /* parabolic focusing right side wall */ + { + PARABEL_FOCUS (w1r, l, loutwr, rwallthick, &p2parawr, &w2r, &pbwr, &pawr, &p2parawrwt, &pbwrwt, &pawrwt, &w2rwt, &w1rwt); + } - /* Calculation of curve-parameters for the top wall - positive y-axis - analog right wall*/ + if (linwr != 0 && loutwr == 0) /* parabolic defocusing right side wall */ + { + PARABEL_DEFOCUS (w1r, l, linwr, rwallthick, &p2parawr, &w2r, &pbwr, &pawr, &p2parawrwt, &pbwrwt, &pawrwt, &w2rwt, &w1rwt); + } + if (linwr == 0 && loutwr == 0) /* straight right side wall */ + { + LINEAR (w1r, w2r, l, rwallthick, &w1rwt, &w2rwt); + } -if (linhu != 0 && louthu !=0) /* elliptic top wall */ - { - ELLIPSE(h1u, l, linhu, louthu, uwallthick, &ahu, &bhu, &a2hu, &b2hu, &z0hu , &h2u, &ahuwt, &a2huwt, &bhuwt, &b2huwt, &h2uwt, &h1uwt); - } + /* Calculation of curve-parameters for the left side wall - positive x-axis - analog to right side*/ -if(linhu==0 && louthu!=0) /* parabolic focusing top wall */ - { - PARABEL_FOCUS( h1u,l ,louthu, uwallthick, &p2parahu, &h2u, &pbhu , &pahu, &p2parahuwt, &pbhuwt, &pahuwt, &h2uwt, &h1uwt); - } + if ((linwl != 0) && (loutwl != 0)) /* elleptic left side wall */ + { + ELLIPSE (w1l, l, linwl, loutwl, lwallthick, &awl, &bwl, &a2wl, &b2wl, &z0wl, &w2l, &awlwt, &a2wlwt, &bwlwt, &b2wlwt, &w2lwt, &w1lwt); + } -if (linhu!=0 && louthu==0) /* parabolic defocusing top wall */ - { - PARABEL_DEFOCUS( h1u,l ,linhu, uwallthick, &p2parahu, &h2u, &pbhu , &pahu, &p2parahuwt, &pbhuwt, &pahuwt, &h2uwt, &h1uwt); - } + if (linwl == 0 && loutwl != 0) /* parabolic focusing left side wall */ + { + PARABEL_FOCUS (w1l, l, loutwl, lwallthick, &p2parawl, &w2l, &pbwl, &pawl, &p2parawlwt, &pbwlwt, &pawlwt, &w2lwt, &w1lwt); + } -if(linhu==0 && louthu==0) - { - LINEAR(h1u, h2u, l, uwallthick, &h1uwt, &h2uwt); - } + if (linwl != 0 && loutwl == 0) /* parabolic defocusing left side wall */ + { + PARABEL_DEFOCUS (w1l, l, linwl, lwallthick, &p2parawl, &w2l, &pbwl, &pawl, &p2parawlwt, &pbwlwt, &pawlwt, &w2lwt, &w1lwt); + } + if (linwl == 0 && loutwl == 0) /* straight left side wall */ + { + LINEAR (w1l, w2l, l, lwallthick, &w1lwt, &w2lwt); + } - /* Calculation of curve-parameters for the bottom wall - negative y-axis - analog right wall */ + /* Calculation of curve-parameters for the top wall - positive y-axis - analog right wall*/ -if (linhd != 0 && louthd !=0) /* elliptic bottom wall */ - { - ELLIPSE(h1d, l, linhd, louthd, dwallthick, &ahd, &bhd, &a2hd, &b2hd, &z0hd, &h2d, &ahdwt, &a2hdwt, &bhdwt, &b2hdwt, &h2dwt, &h1dwt); - } + if (linhu != 0 && louthu != 0) /* elliptic top wall */ + { + ELLIPSE (h1u, l, linhu, louthu, uwallthick, &ahu, &bhu, &a2hu, &b2hu, &z0hu, &h2u, &ahuwt, &a2huwt, &bhuwt, &b2huwt, &h2uwt, &h1uwt); + } -if(linhd==0 && louthd!=0) /* parabolic focusing bottom wall */ - { - PARABEL_FOCUS( h1d,l ,louthd, dwallthick, &p2parahd, &h2d, &pbhd , &pahd, &p2parahdwt, &pbhdwt, &pahdwt, &h2dwt, &h1dwt); - } + if (linhu == 0 && louthu != 0) /* parabolic focusing top wall */ + { + PARABEL_FOCUS (h1u, l, louthu, uwallthick, &p2parahu, &h2u, &pbhu, &pahu, &p2parahuwt, &pbhuwt, &pahuwt, &h2uwt, &h1uwt); + } -if (linhd!=0 && louthd==0) /* parabolic defocusing bottom wall */ - { - PARABEL_DEFOCUS( h1d,l ,linhd, dwallthick, &p2parahd, &h2d, &pbhd , &pahd, &p2parahdwt, &pbhdwt, &pahdwt, &h2dwt, &h1dwt); - } + if (linhu != 0 && louthu == 0) /* parabolic defocusing top wall */ + { + PARABEL_DEFOCUS (h1u, l, linhu, uwallthick, &p2parahu, &h2u, &pbhu, &pahu, &p2parahuwt, &pbhuwt, &pahuwt, &h2uwt, &h1uwt); + } -if(linhd==0 && louthd==0) - { - LINEAR(h1d, h2d, l, dwallthick, &h1dwt, &h2dwt); - } + if (linhu == 0 && louthu == 0) { + LINEAR (h1u, h2u, l, uwallthick, &h1uwt, &h2uwt); + } + /* Calculation of curve-parameters for the bottom wall - negative y-axis - analog right wall */ + if (linhd != 0 && louthd != 0) /* elliptic bottom wall */ + { + ELLIPSE (h1d, l, linhd, louthd, dwallthick, &ahd, &bhd, &a2hd, &b2hd, &z0hd, &h2d, &ahdwt, &a2hdwt, &bhdwt, &b2hdwt, &h2dwt, &h1dwt); + } -mru1=(h1uwt-h1u)/(w1r-w1rwt); /* calculation for entrance and exit absorbing mask for the right upper corner*/ -nru1=h1u-mru1*(-w1r); + if (linhd == 0 && louthd != 0) /* parabolic focusing bottom wall */ + { + PARABEL_FOCUS (h1d, l, louthd, dwallthick, &p2parahd, &h2d, &pbhd, &pahd, &p2parahdwt, &pbhdwt, &pahdwt, &h2dwt, &h1dwt); + } -mrd1=(-h1dwt+h1d)/(w1r-w1rwt); /* calculation for entrance and exit absorbing mask for the right lower corner*/ -nrd1=-h1d-mrd1*(-w1r); + if (linhd != 0 && louthd == 0) /* parabolic defocusing bottom wall */ + { + PARABEL_DEFOCUS (h1d, l, linhd, dwallthick, &p2parahd, &h2d, &pbhd, &pahd, &p2parahdwt, &pbhdwt, &pahdwt, &h2dwt, &h1dwt); + } -mlu1=(h1uwt-h1u)/(-w1l+w1lwt); /* calculation for entrance and exit absorbing mask for the left upper corner*/ -nlu1=h1u-mlu1*w1l; + if (linhd == 0 && louthd == 0) { + LINEAR (h1d, h2d, l, dwallthick, &h1dwt, &h2dwt); + } -mld1=(-h1dwt+h1d)/(-w1l+w1lwt); /* calculation for entrance and exit absorbing mask for the left lower corner*/ -nld1=-h1d-mld1*w1l; + mru1 = (h1uwt - h1u) / (w1r - w1rwt); /* calculation for entrance and exit absorbing mask for the right upper corner*/ + nru1 = h1u - mru1 * (-w1r); + mrd1 = (-h1dwt + h1d) / (w1r - w1rwt); /* calculation for entrance and exit absorbing mask for the right lower corner*/ + nrd1 = -h1d - mrd1 * (-w1r); -mru2=(h2u-h2uwt)/(-w2r+w2rwt); /* calculation for exit absorbing mask for the right upper corner*/ -nru2=h2u-mru2*(-w2r); + mlu1 = (h1uwt - h1u) / (-w1l + w1lwt); /* calculation for entrance and exit absorbing mask for the left upper corner*/ + nlu1 = h1u - mlu1 * w1l; -mrd2=(-h2d+h2dwt)/(-w2r+w2rwt); /* calculation for exit absorbing mask for the right lower corner*/ -nrd2=-h2d-mrd2*(-w2r); + mld1 = (-h1dwt + h1d) / (-w1l + w1lwt); /* calculation for entrance and exit absorbing mask for the left lower corner*/ + nld1 = -h1d - mld1 * w1l; -mlu2=(h2u-h2uwt)/(w2l-w2lwt); /* calculation for exit absorbing mask for the left upper corner*/ -nlu2=h2u-mlu2*w2l; + mru2 = (h2u - h2uwt) / (-w2r + w2rwt); /* calculation for exit absorbing mask for the right upper corner*/ + nru2 = h2u - mru2 * (-w2r); -mld2=(h2dwt-h2d)/(w2l-w2lwt); /* calculation for exit absorbing mask for the left lower corner*/ -nld2=-h2d-mld2*w2l; + mrd2 = (-h2d + h2dwt) / (-w2r + w2rwt); /* calculation for exit absorbing mask for the right lower corner*/ + nrd2 = -h2d - mrd2 * (-w2r); + mlu2 = (h2u - h2uwt) / (w2l - w2lwt); /* calculation for exit absorbing mask for the left upper corner*/ + nlu2 = h2u - mlu2 * w2l; + mld2 = (h2dwt - h2d) / (w2l - w2lwt); /* calculation for exit absorbing mask for the left lower corner*/ + nld2 = -h2d - mld2 * w2l; %} @@ -1150,7 +1193,7 @@ TRACE int i; - PROP_Z0; /* Propagate neutron to guide entrance. */ + PROP_Z0; /* Propagate neutron to guide entrance. */ /* time variables (INNER walls)*/ double t1; double t2w1r; @@ -1165,14 +1208,14 @@ TRACE /* zcomponent of the intersection point of the neutron trajectory and the ellipse (INNER walls)*/ double m; - double n; + double n; /* component and length of the surfaces normal vector at the intersection point */ double nz; double nx; double ny; - double n2; + double n2; /* prefactor to calculate the velocity vector after the interaction */ - double pf; + double pf; /* velocity vector components before the interaction*/ double vxin; double vyin; @@ -1187,904 +1230,891 @@ TRACE double ylimitd; double ylimitdwt; double ylimitu; - double ylimituwt; + double ylimituwt; /* interaction position of the neutron given by the interaction time; crosscheck with limit variables*/ double xtest; - double ytest; - - - - - if(x <= -w1r && x >= -w1rwt && y <= mru1*x+nru1 && y>= mrd1*x+nrd1 && mxr!=-1 && mxrOW!=-1) /* absorbing the neutron if it hit the RIGHT entrance wall and the wall is not transparent*/ - ABSORB; - if(x >= w1l && x <= w1lwt && y <= mlu1*x+nlu1 && y>= mld1*x+nld1 && mxl!=-1 && mxlOW!=-1 ) /* absorbing the neutron if it hit the LEFT entrance wall and the wall is not transparent*/ - ABSORB; - if(y<=-h1d && y >=-h1dwt && x <= (y-nld1)/mld1 && x>= (y-nrd1)/mrd1 && myd!=-1 && mydOW!=-1) /* absorbing the neutron if it hit the BOTTOM entrance wall and the wall is not transparent*/ - ABSORB; - if(y>=h1u && y <= h1uwt && x <= (y-nlu1)/mlu1 && x>= (y-nru1)/mru1 && myu!=-1 && myuOW!=-1) /* absorbing the neutron if it hit the TOP entrance wall and the wall is not transparent*/ - ABSORB; - - + double ytest; + + if (x <= -w1r && x >= -w1rwt && y <= mru1 * x + nru1 && y >= mrd1 * x + nrd1 && mxr != -1 + && mxrOW != -1) /* absorbing the neutron if it hit the RIGHT entrance wall and the wall is not transparent*/ + ABSORB; + if (x >= w1l && x <= w1lwt && y <= mlu1 * x + nlu1 && y >= mld1 * x + nld1 && mxl != -1 + && mxlOW != -1) /* absorbing the neutron if it hit the LEFT entrance wall and the wall is not transparent*/ + ABSORB; + if (y <= -h1d && y >= -h1dwt && x <= (y - nld1) / mld1 && x >= (y - nrd1) / mrd1 && myd != -1 + && mydOW != -1) /* absorbing the neutron if it hit the BOTTOM entrance wall and the wall is not transparent*/ + ABSORB; + if (y >= h1u && y <= h1uwt && x <= (y - nlu1) / mlu1 && x >= (y - nru1) / mru1 && myu != -1 + && myuOW != -1) /* absorbing the neutron if it hit the TOP entrance wall and the wall is not transparent*/ + ABSORB; + + do { /* start the propagation loop inside the guide */ + t1 = (l - z) / vz; /* needed time to pass the guide (or rest of the guide without any interaction)*/ + + if (loutwr == 0 && linwr == 0) { + TIME_LINEAR (t1, w1r, w2r, l, x, z, vx, vz, w1rwt, &t2w1r, &t2w1rwt); + } + if (loutwr != 0 && linwr != 0) { + TIME_ELLIPSE (vx, vz, x, z, a2wr, b2wr, z0wr, t1, a2wrwt, b2wrwt, &t2w1r, &t2w1rwt); + } + if ((loutwr != 0 && linwr == 0) || (loutwr == 0 && linwr != 0)) { + TIME_PARABEL (vx, vz, x, z, pawr, pbwr, t1, pawrwt, pbwrwt, &t2w1r, &t2w1rwt); + } -do{ /* start the propagation loop inside the guide */ - t1=(l-z)/vz; /* needed time to pass the guide (or rest of the guide without any interaction)*/ + if (loutwl == 0 && linwl == 0) { + TIME_LINEAR_1 (t1, w1l, w2l, l, x, z, vx, vz, w1lwt, &t2w1l, &t2w1lwt); + } + if (loutwl != 0 && linwl != 0) { + TIME_ELLIPSE_1 (vx, vz, x, z, a2wl, b2wl, z0wl, t1, a2wlwt, b2wlwt, &t2w1l, &t2w1lwt); + } -if(loutwr==0 && linwr==0) - { - TIME_LINEAR(t1, w1r, w2r, l, x, z, vx, vz, w1rwt, &t2w1r, &t2w1rwt); + if ((loutwl != 0 && linwl == 0) || (loutwl == 0 && linwl != 0)) { + TIME_PARABEL_1 (vx, vz, x, z, pawl, pbwl, t1, pawlwt, pbwlwt, &t2w1l, &t2w1lwt); } - if(loutwr!=0 && linwr!=0) - { - TIME_ELLIPSE(vx, vz, x, z, a2wr, b2wr, z0wr, t1, a2wrwt, b2wrwt, &t2w1r, &t2w1rwt); + if (louthu == 0 && linhu == 0) { + TIME_LINEAR_1 (t1, h1u, h2u, l, y, z, vy, vz, h1uwt, &t2h1u, &t2h1uwt); } - if((loutwr!=0 && linwr==0)|| (loutwr==0 && linwr!=0)) - { - TIME_PARABEL(vx, vz, x, z, pawr, pbwr, t1, pawrwt, pbwrwt, &t2w1r, &t2w1rwt); + if (louthu != 0 && linhu != 0) { + TIME_ELLIPSE_1 (vy, vz, y, z, a2hu, b2hu, z0hu, t1, a2huwt, b2huwt, &t2h1u, &t2h1uwt); } - if(loutwl==0 && linwl==0) - { - TIME_LINEAR_1(t1, w1l, w2l, l, x, z, vx, vz, w1lwt, &t2w1l, &t2w1lwt); + if ((louthu != 0 && linhu == 0) || (louthu == 0 && linhu != 0)) { + TIME_PARABEL_1 (vy, vz, y, z, pahu, pbhu, t1, pahuwt, pbhuwt, &t2h1u, &t2h1uwt); } - if(loutwl!=0 && linwl!=0) - { - TIME_ELLIPSE_1(vx, vz, x, z, a2wl, b2wl, z0wl, t1, a2wlwt, b2wlwt, &t2w1l, &t2w1lwt); + if (louthd == 0 && linhd == 0) { + TIME_LINEAR (t1, h1d, h2d, l, y, z, vy, vz, h1dwt, &t2h1d, &t2h1dwt); } + if (louthd != 0 && linhd != 0) { + TIME_ELLIPSE (vy, vz, y, z, a2hd, b2hd, z0hd, t1, a2hdwt, b2hdwt, &t2h1d, &t2h1dwt); + } - if((loutwl!=0 && linwl==0) || (loutwl==0 && linwl!=0)) - { - TIME_PARABEL_1(vx, vz, x, z, pawl, pbwl, t1, pawlwt, pbwlwt, &t2w1l, &t2w1lwt); + if ((louthd != 0 && linhd == 0) || (louthd == 0 && linhd != 0)) { + TIME_PARABEL (vy, vz, y, z, pahd, pbhd, t1, pahdwt, pbhdwt, &t2h1d, &t2h1dwt); } + /* TEST OF THE INNER INTERSECTION - TIMES */ + /* possible interactions outside the guide have to be eliminated*/ - if(louthu==0 && linhu==0) - { - TIME_LINEAR_1(t1, h1u, h2u, l, y, z, vy, vz, h1uwt, &t2h1u, &t2h1uwt); + if (t2w1r < t1 + 2.0) { /* test of RIGHT INNER wall interaction time*/ + TEST_UP_DOWN (t2w1r, vz, z, vy, y, l, linhd, louthd, linhu, louthu, h2d, h1d, h2u, h1u, bhd, z0hd, a2hd, bhu, z0hu, a2hu, pbhd, pahd, pbhu, pahu, &ylimitd, + &ylimitu, &ytest); + if (ytest < ylimitd || ytest > ylimitu) { + t2w1r = t1 + 2.0; + } } - - if(louthu!=0 && linhu!=0) - { - TIME_ELLIPSE_1(vy, vz, y, z, a2hu, b2hu, z0hu, t1, a2huwt, b2huwt, &t2h1u, &t2h1uwt); + if (t2w1l < t1 + 2.0) { /* test of LEFT INNER wall interaction time - analog to right wall*/ + TEST_UP_DOWN (t2w1l, vz, z, vy, y, l, linhd, louthd, linhu, louthu, h2d, h1d, h2u, h1u, bhd, z0hd, a2hd, bhu, z0hu, a2hu, pbhd, pahd, pbhu, pahu, &ylimitd, + &ylimitu, &ytest); + if (ytest < ylimitd || ytest > ylimitu) { + t2w1l = t1 + 2.0; + } } + if (t2h1u < t1 + 2.0) { /* test of TOP INNER wall interaction time - analog to right wall*/ + TEST_LEFT_RIGHT (t2h1u, vz, z, vx, x, l, linwr, loutwr, linwl, loutwl, w2r, w1r, w2l, w1l, bwr, z0wr, a2wr, bwl, z0wl, a2wl, pbwr, pawr, pbwl, pawl, + &xlimitr, &xlimitl, &xtest); + if (xtest < xlimitr || xtest > xlimitl) { + t2h1u = t1 + 2.0; + } + } - if((louthu!=0 && linhu==0)|| (louthu==0 && linhu!=0)) - { - TIME_PARABEL_1(vy, vz, y, z, pahu, pbhu, t1, pahuwt, pbhuwt, &t2h1u, &t2h1uwt); + if (t2h1d < t1 + 2.0) { /* test of BOTTOM INNER wall interaction time - analog to right wall*/ + TEST_LEFT_RIGHT (t2h1d, vz, z, vx, x, l, linwr, loutwr, linwl, loutwl, w2r, w1r, w2l, w1l, bwr, z0wr, a2wr, bwl, z0wl, a2wl, pbwr, pawr, pbwl, pawl, + &xlimitr, &xlimitl, &xtest); + if (xtest < xlimitr || xtest > xlimitl) { + t2h1d = t1 + 2.0; + } } + /* TEST OF THE OUTER INTERSECTION - TIMES */ - if(louthd==0 && linhd==0) - { - TIME_LINEAR(t1, h1d, h2d, l, y, z, vy, vz, h1dwt, &t2h1d, &t2h1dwt); + if (t2w1rwt < t1 + 2.0) { /* test of RIGHT OUTER wall interaction time - analog inner wall*/ + TEST_UP_DOWN (t2w1rwt, vz, z, vy, y, l, linhd, louthd, linhu, louthu, h2dwt, h1dwt, h2uwt, h1uwt, bhdwt, z0hd, a2hdwt, bhuwt, z0hu, a2huwt, pbhdwt, pahdwt, + pbhuwt, pahuwt, &ylimitd, &ylimitu, &ytest); + if (ytest < ylimitd || ytest > ylimitu) { + t2w1rwt = t1 + 2.0; + } } - if(louthd!=0 && linhd!=0) - { - TIME_ELLIPSE(vy, vz, y, z, a2hd, b2hd, z0hd, t1, a2hdwt, b2hdwt, &t2h1d, &t2h1dwt); + if (t2w1lwt < t1 + 2.0) { /* test of LEFT OUTER wall interaction time - analog inner wall*/ + TEST_UP_DOWN (t2w1lwt, vz, z, vy, y, l, linhd, louthd, linhu, louthu, h2dwt, h1dwt, h2uwt, h1uwt, bhdwt, z0hd, a2hdwt, bhuwt, z0hu, a2huwt, pbhdwt, pahdwt, + pbhuwt, pahuwt, &ylimitd, &ylimitu, &ytest); + if (ytest < ylimitd || ytest > ylimitu) { + t2w1lwt = t1 + 2.0; + } } - if((louthd!=0 && linhd==0)|| (louthd==0 && linhd!=0)) - { - TIME_PARABEL(vy, vz, y, z, pahd, pbhd, t1, pahdwt, pbhdwt, &t2h1d, &t2h1dwt); + if (t2h1uwt < t1 + 2.0) { /* test of TOP OUTER wall interaction time - analog inner wall*/ + TEST_LEFT_RIGHT (t2h1uwt, vz, z, vx, x, l, linwr, loutwr, linwl, loutwl, w2rwt, w1rwt, w2lwt, w1lwt, bwrwt, z0wr, a2wrwt, bwlwt, z0wl, a2wlwt, pbwrwt, + pawrwt, pbwlwt, pawlwt, &xlimitr, &xlimitl, &xtest); + if (xtest < xlimitr || xtest > xlimitl) { + t2h1uwt = t1 + 2.0; + } } + if (t2h1dwt < t1 + 2.0) { /* test of BOTTOM OUTER wall interaction time - analog inner wall*/ + TEST_LEFT_RIGHT (t2h1dwt, vz, z, vx, x, l, linwr, loutwr, linwl, loutwl, w2rwt, w1rwt, w2lwt, w1lwt, bwrwt, z0wr, a2wrwt, bwlwt, z0wl, a2wlwt, pbwrwt, + pawrwt, pbwlwt, pawlwt, &xlimitr, &xlimitl, &xtest); + if (xtest < xlimitr || xtest > xlimitl) { + t2h1dwt = t1 + 2.0; + } + } + /* which wall is hit first? which geometry? */ - /* TEST OF THE INNER INTERSECTION - TIMES */ - /* possible interactions outside the guide have to be eliminated*/ + if (t1 < t2w1r && t1 < t2w1l && t1 < t2h1u && t1 < t2h1d && t1 < t2w1rwt && t1 < t2w1lwt && t1 < t2h1uwt && t1 < t2h1dwt) { + i = 1; + } -if(t2w1rylimitu){ - t2w1r=t1+2.0; - } - } + /* neutron interacts with the INNER elliptic right wall and this wall is NOT transparent*/ + + if (t2w1r > 0 && t2w1r < t1 && t2w1r < t2w1l && t2w1r < t2h1u && t2w1r < t2h1d && t2w1r < t2w1rwt && t2w1r < t2w1lwt && t2w1r < t2h1uwt && t2w1r < t2h1dwt) { + if (mxr == 0) + i = 18; + else { + if (mxr == -1) + i = 14; + else { + if ((linwr != 0) && (loutwr != 0)) + i = 2; /* the neutron will be reflected*/ + else { + if ((loutwr != 0 && linwr == 0) || (loutwr == 0 && linwr != 0)) + i = 3; + else { + if (loutwr == 0 && linwr == 0) + i = 4; + } + } + } + } + } -if(t2w1lylimitu){ - t2w1l=t1+2.0; - } - } + /* neutron interacts with the elliptic left INNER wall - comments are analog to inner elliptic right wall*/ + + if (t2w1l > 0 && t2w1l < t1 && t2w1l < t2w1r && t2w1l < t2h1u && t2w1l < t2h1d && t2w1l < t2w1rwt && t2w1l < t2w1lwt && t2w1l < t2h1uwt && t2w1l < t2h1dwt) { + if (mxl == 0) + i = 19; + else { + if (mxl == -1) + i = 15; + else { + if ((linwl != 0) && (loutwl != 0)) + i = 5; + else { + if ((loutwl != 0 && linwl == 0) || (loutwl == 0 && linwl != 0)) + i = 6; + else { + if (loutwl == 0 && linwl == 0) + i = 7; + } + } + } + } + } + /* neutron interacts with the elliptic top INNER wall - comments are analog to inner elliptic right wall*/ + + if (t2h1u > 0 && t2h1u < t1 && t2h1u < t2w1r && t2h1u < t2w1l && t2h1u < t2h1d && t2h1u < t2w1rwt && t2h1u < t2w1lwt && t2h1u < t2h1uwt && t2h1u < t2h1dwt) { + if (myu == 0) + i = 20; + else { + if (myu == -1) + i = 16; + else { + if (louthu != 0 && linhu != 0) + i = 8; + else { + if ((louthu != 0 && linhu == 0) || (louthu == 0 && linhu != 0)) + i = 9; + else { + if (louthu == 0 && linhu == 0) + i = 10; + } + } + } + } + } -if(t2h1uxlimitl){ - t2h1u=t1+2.0; - } - } + /* neutron interacts with the elliptic down INNER wall - comments are analog to inner elliptic right wall*/ + + if (t2h1d > 0 && t2h1d < t1 && t2h1d < t2w1r && t2h1d < t2w1l && t2h1d < t2h1u && t2h1d < t2w1rwt && t2h1d < t2w1lwt && t2h1d < t2h1uwt && t2h1d < t2h1dwt) { + if (myd == 0) + i = 21; + else { + if (myd == -1) + i = 17; + else { + if (louthd != 0 && linhd != 0) + i = 11; + else { + if ((louthd != 0 && linhd == 0) || (louthd == 0 && linhd != 0)) + i = 12; + else { + if (louthd == 0 && linhd == 0) + i = 13; + } + } + } + } + } + /* EVERTHING AGAIN FOR THE OUTER WALLS */ + + /* neutron interacts with the elliptic right OUTER wall - comments are analog to inner elliptic right wall*/ + + if (t2w1rwt > 0 && t2w1rwt < t1 && t2w1rwt < t2w1r && t2w1rwt < t2w1l && t2w1rwt < t2h1u && t2w1rwt < t2h1d && t2w1rwt < t2w1lwt && t2w1rwt < t2h1uwt + && t2w1rwt < t2h1dwt) { + if (mxrOW == 0) + i = 34; + else { + if (mxrOW == -1) + i = 38; + else { + if (linwr != 0 && loutwr != 0) + i = 22; + else { + if ((loutwr != 0 && linwr == 0) || (loutwr == 0 && linwr != 0)) + i = 23; + else { + if (loutwr == 0 && linwr == 0) + i = 24; + } + } + } + } + } -if(t2h1dxlimitl) - { - t2h1d=t1+2.0; - } - } + /* neutron interacts with the elliptic left OUTER wall - comments are analog to inner elliptic right wall*/ + + if (t2w1lwt > 0 && t2w1lwt < t1 && t2w1lwt < t2w1r && t2w1lwt < t2w1l && t2w1lwt < t2h1u && t2w1lwt < t2h1d && t2w1lwt < t2w1rwt && t2w1lwt < t2h1uwt + && t2w1lwt < t2h1dwt) { + if (mxlOW == 0) + i = 35; + else { + if (mxlOW == -1) + i = 39; + else { + if (linwl != 0 && loutwl != 0) + i = 25; + else { + if ((loutwl != 0 && linwl == 0) || (loutwl == 0 && linwl != 0)) + i = 26; + else { + if (loutwl == 0 && linwl == 0) + i = 27; + } + } + } + } + } + /* neutron interacts with the elliptic top OUTER wall - comments are analog to inner elliptic right wall*/ + + if (t2h1uwt > 0 && t2h1uwt < t1 && t2h1uwt < t2w1r && t2h1uwt < t2w1l && t2h1uwt < t2h1u && t2h1uwt < t2h1d && t2h1uwt < t2w1rwt && t2h1uwt < t2w1lwt + && t2h1uwt < t2h1dwt) { + if (myuOW == 0) + i = 36; + else { + if (myuOW == -1) + i = 40; + else { + if (louthu != 0 && linhu != 0) + i = 28; + else { + if ((louthu != 0 && linhu == 0) || (louthu == 0 && linhu != 0)) + i = 29; + else { + if (louthu == 0 && linhu == 0) + i = 30; + } + } + } + } + } - /* TEST OF THE OUTER INTERSECTION - TIMES */ + /* neutron interacts with the elliptic down OUTER wall - comments are analog to inner elliptic right wall*/ + + if (t2h1dwt > 0 && t2h1dwt < t1 && t2h1dwt < t2w1r && t2h1dwt < t2w1l && t2h1dwt < t2h1u && t2h1dwt < t2h1d && t2h1dwt < t2w1rwt && t2h1dwt < t2w1lwt + && t2h1dwt < t2h1uwt) { + if (mydOW == 0) + i = 37; + else { + if (mydOW == -1) + i = 41; + else { + if (louthd != 0 && linhd != 0) + i = 31; + else { + if ((louthd != 0 && linhd == 0) || (louthd == 0 && linhd != 0)) + i = 32; + else { + if (louthd == 0 && linhd == 0) + i = 33; + } + } + } + } + } -if(t2w1rwtylimitu){ - t2w1rwt=t1+2.0; - } - } + switch (i) { /* the principal for the calculation is in every case the same: 1.) one needs the surface normal vector at the intersection point. 2.) + calculation of the velocity vector after the interaction by */ + /* vector subrtation (the basic idea and explanations can be found in the 'Mcstas component manual' in the section 'straight guide') */ + + case 1: /* no interaction, propagation to the end of the guide */ + PROP_DT (t1); + break; + + case 2: + PROP_DT (t2w1r); /* propagation to interaction point */ + vxin = vx; /* saving the velocity vector before the interaction*/ + vyin = vy; + vzin = vz; + nx = -x; /* surface normal vector components at the intersection point */ + nz = -x * x / ((a2wr / (z + z0wr)) - (z0wr + z)); + n2 = sqrt (nx * nx + nz * nz); /* lenght of the surface normal */ + pf = 2.0 * (vx * nx + vz * nz) / n2; /* prefactor for the calculation of the velocity vector after the interaction */ + vx -= pf * nx / n2; /* velocity vector after the interaction*/ + vz -= pf * nz / n2; + q = V2Q + * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); /* calculation the q-vector to calculated the reflectivity*/ + break; + + case 3: + PROP_DT (t2w1r); + vxin = vx; + vyin = vy; + vzin = vz; + nx = -x; + nz = -0.5 / pawr; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 4: + PROP_DT (t2w1r); + vxin = vx; + vyin = vy; + vzin = vz; + nx = l; + nz = w2r - w1r; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 5: + PROP_DT (t2w1l); + vxin = vx; + vyin = vy; + vzin = vz; + nx = -x; + nz = -x * x / ((a2wl / (z + z0wl)) - (z0wl + z)); + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + SCATTER; + break; + + case 6: + PROP_DT (t2w1l); + vxin = vx; + vyin = vy; + vzin = vz; + nx = -x; + nz = -0.5 / pawl; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 7: + PROP_DT (t2w1l); + vxin = vx; + vyin = vy; + vzin = vz; + nx = -l; + nz = w2l - w1l; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 8: + PROP_DT (t2h1u); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -y; + nz = -y * y / ((a2hu / (z + z0hu)) - (z0hu + z)); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 9: + PROP_DT (t2h1u); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -y; + nz = -0.5 / pahu; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 10: + PROP_DT (t2h1u); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -l; + nz = h2u - h1u; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 11: + PROP_DT (t2h1d); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -y; + nz = -y * y / ((a2hd / (z + z0hd)) - (z0hd + z)); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 12: + PROP_DT (t2h1d); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -y; + nz = -0.5 / pahd; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 13: + PROP_DT (t2h1d); + vxin = vx; + vyin = vy; + vzin = vz; + ny = l; + nz = h2d - h1d; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 14: /* transperent walls - no interaction */ + PROP_DT (t2w1r); + break; + + case 15: + PROP_DT (t2w1l); + break; + + case 16: + PROP_DT (t2h1u); + break; + + case 17: + PROP_DT (t2h1d); + break; + + case 18: /* absorbing walls - neutrons are absorbed at interaction point*/ + PROP_DT (t2w1r); + ABSORB; + break; + case 19: + PROP_DT (t2w1l); + ABSORB; + break; -if(t2w1lwtylimitu){ - t2w1lwt=t1+2.0; - } - } + case 20: + PROP_DT (t2h1u); + ABSORB; + break; -if(t2h1uwtxlimitl){ - t2h1uwt=t1+2.0; - } - } + case 21: + PROP_DT (t2h1d); + ABSORB; + break; + + /* OUTER WALLS - analog to inner walls, but sign of surface normal vector is changed */ + + case 22: + PROP_DT (t2w1rwt); /* propagation to interaction point */ + vxin = vx; /* saving the velocity vector before the interaction*/ + vyin = vy; + vzin = vz; + nx = x; /* surface normal vector components at the intersection point */ + nz = x * x / ((a2wrwt / (z + z0wr)) - (z0wr + z)); + n2 = sqrt (nx * nx + nz * nz); /* lenght of the surface normal */ + pf = 2.0 * (vx * nx + vz * nz) / n2; /* prefactor for the calculation of the velocity vector after the interaction */ + vx -= pf * nx / n2; /* velocity vector after the interaction*/ + vz -= pf * nz / n2; + q = V2Q + * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); /* calculation the q-vector to calculated the reflectivity*/ + break; + + case 23: + PROP_DT (t2w1rwt); + vxin = vx; + vyin = vy; + vzin = vz; + nx = x; + nz = 0.5 / pawrwt; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 24: + PROP_DT (t2w1rwt); + vxin = vx; + vyin = vy; + vzin = vz; + nx = -l; + nz = -(w2r - w1r); + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 25: + PROP_DT (t2w1lwt); + vxin = vx; + vyin = vy; + vzin = vz; + nx = x; + nz = x * x / ((a2wlwt / (z + z0wl)) - (z0wl + z)); + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 26: + PROP_DT (t2w1lwt); + vxin = vx; + vyin = vy; + vzin = vz; + nx = x; + nz = 0.5 / pawlwt; + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 27: + PROP_DT (t2w1lwt); + vxin = vx; + vyin = vy; + vzin = vz; + nx = l; + nz = -(w2l - w1l); + n2 = sqrt (nx * nx + nz * nz); + pf = 2.0 * (vx * nx + vz * nz) / n2; + vx -= pf * nx / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 28: + PROP_DT (t2h1uwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = y; + nz = y * y / ((a2huwt / (z + z0hu)) - (z0hu + z)); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 29: + PROP_DT (t2h1uwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = y; + nz = 0.5 / pahuwt; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 30: + PROP_DT (t2h1uwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = l; + nz = -(h2u - h1u); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 31: + PROP_DT (t2h1dwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = y; + nz = y * y / ((a2hdwt / (z + z0hd)) - (z0hd + z)); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 32: + PROP_DT (t2h1dwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = y; + nz = 0.5 / pahdwt; + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 33: + PROP_DT (t2h1dwt); + vxin = vx; + vyin = vy; + vzin = vz; + ny = -l; + nz = -(h2d - h1d); + n2 = sqrt (ny * ny + nz * nz); + pf = 2.0 * (vy * ny + vz * nz) / n2; + vy -= pf * ny / n2; + vz -= pf * nz / n2; + q = V2Q * sqrt ((vxin - vx) * (vxin - vx) + (vyin - vy) * (vyin - vy) + (vzin - vz) * (vzin - vz)); + break; + + case 34: + PROP_DT (t2w1rwt); + ABSORB; + break; + case 35: + PROP_DT (t2w1lwt); + ABSORB; + break; -if(t2h1dwtxlimitl) - { - t2h1dwt=t1+2.0; - } - } + case 36: + PROP_DT (t2h1uwt); + ABSORB; + break; - /* which wall is hit first? which geometry? */ + case 37: + PROP_DT (t2h1dwt); + ABSORB; + break; - if (t1 < t2w1r && t1 < t2w1l && t1 < t2h1u && t1 < t2h1d && t1 < t2w1rwt && t1 < t2w1lwt && t1 < t2h1uwt && t1 < t2h1dwt){ - i=1; - } + case 38: + PROP_DT (t2w1rwt); + break; - /* neutron interacts with the INNER elliptic right wall and this wall is NOT transparent*/ - - if (t2w1r > 0 && t2w1r < t1 - && t2w1r < t2w1l && t2w1r < t2h1u && t2w1r < t2h1d && t2w1r < t2w1rwt && t2w1r < t2w1lwt && t2w1r < t2h1uwt && t2w1r < t2h1dwt) - { - if (mxr == 0) i = 18; - else{ - if (mxr ==-1) i = 14; - else{ - if ((linwr!=0) && (loutwr!=0))i=2; /* the neutron will be reflected*/ - else{ - if ((loutwr!=0 && linwr==0) || (loutwr==0 && linwr!=0)) i=3; - else{ - if (loutwr==0 && linwr==0) i=4; - }}}}} - - /* neutron interacts with the elliptic left INNER wall - comments are analog to inner elliptic right wall*/ - - if (t2w1l > 0 && t2w1l < t1 - && t2w1l < t2w1r && t2w1l < t2h1u && t2w1l < t2h1d && t2w1l < t2w1rwt && t2w1l < t2w1lwt && t2w1l < t2h1uwt && t2w1l < t2h1dwt) - { - if (mxl == 0) i = 19; - else{ - if (mxl == -1) i = 15; - else{ - if ((linwl!=0) && (loutwl!=0) ) i=5; - else{ - if ((loutwl!=0 && linwl==0) || (loutwl==0 && linwl!=0)) i=6; - else{ - if (loutwl==0 && linwl==0) i=7; - }}}}} - - /* neutron interacts with the elliptic top INNER wall - comments are analog to inner elliptic right wall*/ - - if (t2h1u > 0 && t2h1u < t1 - && t2h1u < t2w1r && t2h1u < t2w1l && t2h1u < t2h1d && t2h1u < t2w1rwt && t2h1u < t2w1lwt && t2h1u < t2h1uwt && t2h1u < t2h1dwt){ - if (myu == 0) i = 20; - else{ - if (myu == -1) i = 16; - else{ - if (louthu !=0 && linhu!=0) i=8; - else{ - if ((louthu!=0 && linhu==0) || (louthu==0 && linhu!=0)) i=9; - else{ - if (louthu == 0 && linhu == 0) i=10; - }}}}} - - /* neutron interacts with the elliptic down INNER wall - comments are analog to inner elliptic right wall*/ - -if (t2h1d > 0 && t2h1d < t1 - && t2h1d < t2w1r && t2h1d < t2w1l && t2h1d < t2h1u && t2h1d < t2w1rwt && t2h1d < t2w1lwt && t2h1d < t2h1uwt && t2h1d < t2h1dwt){ - if (myd == 0) i= 21; - else{ - if (myd == -1) i= 17; - else{ - if (louthd !=0 && linhd!=0) i=11; - else{ - if ((louthd !=0 && linhd==0) || (louthd ==0 && linhd!=0)) i=12; - else{ - if (louthd == 0 && linhd == 0) i=13; - }}}}} - - - - /* EVERTHING AGAIN FOR THE OUTER WALLS */ - - /* neutron interacts with the elliptic right OUTER wall - comments are analog to inner elliptic right wall*/ - - if (t2w1rwt > 0 && t2w1rwt < t1 - && t2w1rwt < t2w1r && t2w1rwt < t2w1l && t2w1rwt < t2h1u && t2w1rwt < t2h1d && t2w1rwt 0 && t2w1lwt < t1 - && t2w1lwt < t2w1r && t2w1lwt < t2w1l && t2w1lwt < t2h1u && t2w1lwt < t2h1d && t2w1lwt 0 && t2h1uwt < t1 - && t2h1uwt < t2w1r && t2h1uwt < t2w1l && t2h1uwt < t2h1u && t2h1uwt < t2h1d && t2h1uwt < t2w1rwt && t2h1uwt < t2w1lwt && t2h1uwt < t2h1dwt){ - if (myuOW == 0) i = 36; - else{ - if (myuOW == -1) i = 40; - else{ - if (louthu !=0 && linhu!=0) i=28; - else{ - if ((louthu!=0 && linhu==0) || (louthu==0 && linhu!=0)) i = 29; - else{ - if (louthu == 0 && linhu == 0) i =30; - }}}}} - - - /* neutron interacts with the elliptic down OUTER wall - comments are analog to inner elliptic right wall*/ - - if (t2h1dwt > 0 && t2h1dwt < t1 - && t2h1dwt < t2w1r && t2h1dwt < t2w1l && t2h1dwt < t2h1u && t2h1dwt < t2h1d && t2h1dwt < t2w1rwt && t2h1dwt < t2w1lwt && t2h1dwt < t2h1uwt){ - if ( mydOW == 0 ) i=37; - else{ - if ( mydOW == -1) i=41; - else{ - if (louthd !=0 && linhd!=0) i=31; - else{ - if ((louthd !=0 && linhd==0) || (louthd ==0 && linhd!=0)) i=32; - else{ - if (louthd == 0 && linhd == 0) i =33; - }}}}} - - - - -switch(i){ /* the principal for the calculation is in every case the same: 1.) one needs the surface normal vector at the intersection point. 2.) calculation of the velocity vector after the interaction by */ - /* vector subrtation (the basic idea and explanations can be found in the 'Mcstas component manual' in the section 'straight guide') */ - - case 1: /* no interaction, propagation to the end of the guide */ - PROP_DT(t1); - break; - - case 2: - PROP_DT(t2w1r); /* propagation to interaction point */ - vxin=vx; /* saving the velocity vector before the interaction*/ - vyin=vy; - vzin=vz; - nx=-x; /* surface normal vector components at the intersection point */ - nz=-x*x/((a2wr/(z+z0wr))-(z0wr+z)); - n2=sqrt(nx*nx+nz*nz); /* lenght of the surface normal */ - pf=2.0*(vx*nx+vz*nz)/n2; /* prefactor for the calculation of the velocity vector after the interaction */ - vx-=pf*nx/n2; /* velocity vector after the interaction*/ - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); /* calculation the q-vector to calculated the reflectivity*/ - break; - - case 3: - PROP_DT(t2w1r); - vxin=vx; - vyin=vy; - vzin=vz; - nx=-x; - nz=-0.5/pawr; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 4: - PROP_DT(t2w1r); - vxin=vx; - vyin=vy; - vzin=vz; - nx=l; - nz=w2r-w1r; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 5: - PROP_DT(t2w1l); - vxin=vx; - vyin=vy; - vzin=vz; - nx=-x; - nz=-x*x/((a2wl/(z+z0wl))-(z0wl+z)); - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - SCATTER; - break; - - case 6: - PROP_DT(t2w1l); - vxin=vx; - vyin=vy; - vzin=vz; - nx=-x; - nz=-0.5/pawl; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 7: - PROP_DT(t2w1l); - vxin=vx; - vyin=vy; - vzin=vz; - nx=-l; - nz=w2l-w1l; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 8: - PROP_DT(t2h1u); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-y; - nz=-y*y/((a2hu/(z+z0hu))-(z0hu+z)); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 9: - PROP_DT(t2h1u); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-y; - nz=-0.5/pahu; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 10: - PROP_DT(t2h1u); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-l; - nz=h2u-h1u; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 11: - PROP_DT(t2h1d); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-y; - nz=-y*y/((a2hd/(z+z0hd))-(z0hd+z)); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 12: - PROP_DT(t2h1d); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-y; - nz=-0.5/pahd; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 13: - PROP_DT(t2h1d); - vxin=vx; - vyin=vy; - vzin=vz; - ny=l; - nz=h2d-h1d; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 14: /* transperent walls - no interaction */ - PROP_DT(t2w1r); - break; - - case 15: - PROP_DT(t2w1l); - break; - - case 16: - PROP_DT(t2h1u); - break; - - case 17: - PROP_DT(t2h1d); - break; - - case 18: /* absorbing walls - neutrons are absorbed at interaction point*/ - PROP_DT(t2w1r); - ABSORB; - break; - - case 19: - PROP_DT(t2w1l); - ABSORB; - break; - - case 20: - PROP_DT(t2h1u); - ABSORB; - break; - - case 21: - PROP_DT(t2h1d); - ABSORB; - break; - - /* OUTER WALLS - analog to inner walls, but sign of surface normal vector is changed */ - - case 22: - PROP_DT(t2w1rwt); /* propagation to interaction point */ - vxin=vx; /* saving the velocity vector before the interaction*/ - vyin=vy; - vzin=vz; - nx=x; /* surface normal vector components at the intersection point */ - nz=x*x/((a2wrwt/(z+z0wr))-(z0wr+z)); - n2=sqrt(nx*nx+nz*nz); /* lenght of the surface normal */ - pf=2.0*(vx*nx+vz*nz)/n2; /* prefactor for the calculation of the velocity vector after the interaction */ - vx-=pf*nx/n2; /* velocity vector after the interaction*/ - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); /* calculation the q-vector to calculated the reflectivity*/ - break; - - case 23: - PROP_DT(t2w1rwt); - vxin=vx; - vyin=vy; - vzin=vz; - nx=x; - nz=0.5/pawrwt; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 24: - PROP_DT(t2w1rwt); - vxin=vx; - vyin=vy; - vzin=vz; - nx=-l; - nz=-(w2r-w1r); - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 25: - PROP_DT(t2w1lwt); - vxin=vx; - vyin=vy; - vzin=vz; - nx=x; - nz=x*x/((a2wlwt/(z+z0wl))-(z0wl+z)); - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 26: - PROP_DT(t2w1lwt); - vxin=vx; - vyin=vy; - vzin=vz; - nx=x; - nz=0.5/pawlwt; - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 27: - PROP_DT(t2w1lwt); - vxin=vx; - vyin=vy; - vzin=vz; - nx=l; - nz=-(w2l-w1l); - n2=sqrt(nx*nx+nz*nz); - pf=2.0*(vx*nx+vz*nz)/n2; - vx-=pf*nx/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 28: - PROP_DT(t2h1uwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=y; - nz=y*y/((a2huwt/(z+z0hu))-(z0hu+z)); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 29: - PROP_DT(t2h1uwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=y; - nz=0.5/pahuwt; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 30: - PROP_DT(t2h1uwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=l; - nz=-(h2u-h1u); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 31: - PROP_DT(t2h1dwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=y; - nz=y*y/((a2hdwt/(z+z0hd))-(z0hd+z)); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 32: - PROP_DT(t2h1dwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=y; - nz=0.5/pahdwt; - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 33: - PROP_DT(t2h1dwt); - vxin=vx; - vyin=vy; - vzin=vz; - ny=-l; - nz=-(h2d-h1d); - n2=sqrt(ny*ny+nz*nz); - pf=2.0*(vy*ny+vz*nz)/n2; - vy-=pf*ny/n2; - vz-=pf*nz/n2; - q=V2Q*sqrt((vxin-vx)*(vxin-vx)+(vyin-vy)*(vyin-vy)+(vzin-vz)*(vzin-vz)); - break; - - case 34: - PROP_DT(t2w1rwt); - ABSORB; - break; - - case 35: - PROP_DT(t2w1lwt); - ABSORB; - break; - - case 36: - PROP_DT(t2h1uwt); - ABSORB; - break; - - case 37: - PROP_DT(t2h1dwt); - ABSORB; - break; - - case 38: - PROP_DT(t2w1rwt); - break; - - case 39: - PROP_DT(t2w1lwt); - break; - - case 40: - PROP_DT(t2h1uwt); - break; - - case 41: - PROP_DT(t2h1dwt); - break; - - } - - - - - if (((i==2) ||(i==3) || (i == 4 ))){ /* calculating the the probability that the neutron is reflected at the RIGHT INNER wall*/ - if (RIreflect && strlen(RIreflect)) - { - p=Table_Value(riTable, q, 1); - }else{ - if(mxr > 0 && q > Qcxr){ - double arg = (q - mxr*Qcxr)/Wxr; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphaxr*(q-Qcxr)); - }else - ABSORB; - } - } - } - - if (((i==22) ||(i==23) || (i==24 ))){ /* calculating the the probability that the neutron is reflected at the RIGHT OUTER wall*/ - if (ROreflect && strlen(ROreflect)) - { - p=Table_Value(roTable, q, 1); - }else{ - if(mxrOW > 0 && q > QcxrOW){ - double arg = (q - mxrOW*QcxrOW)/WxrOW; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphaxrOW*(q-QcxrOW)); - } - else - ABSORB; - } - } - } - - if (((i==5) ||(i==6) || (i == 7 ) ) ){ /* calculating the the probability that the neutron is reflected at the LEFT INNER wall*/ - if (LIreflect && strlen(LIreflect)) - { - p=Table_Value(liTable, q, 1); - }else{ - if(mxl > 0 && q > Qcxl){ - double arg = (q - mxl*Qcxl)/Wxl; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphaxl*(q-Qcxl)); - }else - ABSORB; - } - } - } + case 39: + PROP_DT (t2w1lwt); + break; - if (((i==25) || (i==26) || (i==27 ))){ /* calculating the the probability that the neutron is reflected at the LEFT OUTER wall*/ - if (LOreflect && strlen(LOreflect)) - { - p=Table_Value(loTable, q, 1); - }else{ - if(mxlOW > 0 && q > QcxlOW){ - double arg = (q - mxlOW*QcxlOW)/WxlOW; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphaxlOW*(q-QcxlOW)); - } - else - ABSORB; - } - } - } + case 40: + PROP_DT (t2h1uwt); + break; - if (((i==8) ||(i==9) || (i == 10 ))){ /* calculating the the probability that the neutron is reflected at the TOP INNER wall*/ - if (UIreflect && strlen(UIreflect)) - { - p=Table_Value(uiTable, q, 1); - }else{ - if(myu > 0 && q > Qcyu){ - double arg = (q - myu*Qcyu)/Wyu; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphayu*(q-Qcyu)); - }else - ABSORB; - } - } - } + case 41: + PROP_DT (t2h1dwt); + break; + } - if (((i==28) || (i==29) || (i==30 )) ){ /* calculating the the probability that the neutron is reflected at the TOP OUTER wall*/ - if (UOreflect && strlen(UOreflect)) - { - p=Table_Value(uoTable, q, 1); - }else{ - if(myuOW > 0 && q > QcyuOW){ - double arg = (q - myuOW*QcyuOW)/WyuOW; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphayuOW*(q-QcyuOW)); - }else - ABSORB; - } - } - } - - if (((i==11) ||(i==12) || (i == 13 ))){ /* calculating the the probability that the neutron is reflected at the BOTTOM INNER wall*/ - if (DIreflect && strlen(DIreflect)) - { - p=Table_Value(diTable, q, 1); - }else{ - if(myd > 0 && q > Qcyd){ - double arg = (q - myd*Qcyd)/Wyd; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphayd*(q-Qcyd)); - }else - ABSORB; - } - } - } + if (((i == 2) || (i == 3) || (i == 4))) { /* calculating the the probability that the neutron is reflected at the RIGHT INNER wall*/ + if (RIreflect && strlen (RIreflect)) { + p = Table_Value (riTable, q, 1); + } else { + if (mxr > 0 && q > Qcxr) { + double arg = (q - mxr * Qcxr) / Wxr; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphaxr * (q - Qcxr)); + } else + ABSORB; + } + } + } - if (((i==31) || (i==32) || (i==33 )) ){ /* calculating the the probability that the neutron is reflected at the BOTTOM OUTER wall*/ - if (DOreflect && strlen(DOreflect)) - { - p=Table_Value(doTable, q, 1); - }else{ - if(mydOW > 0 && q > QcydOW){ - double arg = (q - mydOW*QcydOW)/WydOW; - if(arg<10){ - p *= 0.5*(1.0-tanh(arg))*(1.0-alphaydOW*(q-QcydOW)); - }else - ABSORB; - } - } - } + if (((i == 22) || (i == 23) || (i == 24))) { /* calculating the the probability that the neutron is reflected at the RIGHT OUTER wall*/ + if (ROreflect && strlen (ROreflect)) { + p = Table_Value (roTable, q, 1); + } else { + if (mxrOW > 0 && q > QcxrOW) { + double arg = (q - mxrOW * QcxrOW) / WxrOW; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphaxrOW * (q - QcxrOW)); + } else + ABSORB; + } + } + } + if (((i == 5) || (i == 6) || (i == 7))) { /* calculating the the probability that the neutron is reflected at the LEFT INNER wall*/ + if (LIreflect && strlen (LIreflect)) { + p = Table_Value (liTable, q, 1); + } else { + if (mxl > 0 && q > Qcxl) { + double arg = (q - mxl * Qcxl) / Wxl; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphaxl * (q - Qcxl)); + } else + ABSORB; + } + } + } - p *= R0; - SCATTER; + if (((i == 25) || (i == 26) || (i == 27))) { /* calculating the the probability that the neutron is reflected at the LEFT OUTER wall*/ + if (LOreflect && strlen (LOreflect)) { + p = Table_Value (loTable, q, 1); + } else { + if (mxlOW > 0 && q > QcxlOW) { + double arg = (q - mxlOW * QcxlOW) / WxlOW; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphaxlOW * (q - QcxlOW)); + } else + ABSORB; + } + } + } -} while (z 0 && q > Qcyu) { + double arg = (q - myu * Qcyu) / Wyu; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphayu * (q - Qcyu)); + } else + ABSORB; + } + } + } + if (((i == 28) || (i == 29) || (i == 30))) { /* calculating the the probability that the neutron is reflected at the TOP OUTER wall*/ + if (UOreflect && strlen (UOreflect)) { + p = Table_Value (uoTable, q, 1); + } else { + if (myuOW > 0 && q > QcyuOW) { + double arg = (q - myuOW * QcyuOW) / WyuOW; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphayuOW * (q - QcyuOW)); + } else + ABSORB; + } + } + } - if(x <= -w2r && x >= -w2rwt && y <= mru2*x+nru2 && y >= mrd2*x+nrd2 && mxr!=-1 && mxrOW!=-1) /* absorbing the neutron if it hit the RIGHT exit wall and the wall is not transparent*/ - ABSORB; - if(x >= w2l && x <= w2lwt && y <= mlu2*x+nlu2 && y >= mld2*x+nld2 && mxl!=-1 && mxlOW!=-1) /* absorbing the neutron if it hit the LEFT exit wall and the wall is not transparent*/ - ABSORB; - if(y <= -h2d && y >= -h2dwt && x <= (y-nld2)/mld2 && x>= (y-nrd2)/mrd2 && myd!=-1 && mydOW!=-1) /* absorbing the neutron if it hit the BOTTOM exit wall and the wall is not transparent*/ - ABSORB; - if(y >= h2u && y <= h2uwt && x <= (y-nlu2)/mlu2 && x>= (y-nru2)/mru2 && myu!=-1 && myuOW!=-1) /* absorbing the neutron if it hit the TOP exit wall and the wall is not transparent*/ - ABSORB; + if (((i == 11) || (i == 12) || (i == 13))) { /* calculating the the probability that the neutron is reflected at the BOTTOM INNER wall*/ + if (DIreflect && strlen (DIreflect)) { + p = Table_Value (diTable, q, 1); + } else { + if (myd > 0 && q > Qcyd) { + double arg = (q - myd * Qcyd) / Wyd; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphayd * (q - Qcyd)); + } else + ABSORB; + } + } + } + if (((i == 31) || (i == 32) || (i == 33))) { /* calculating the the probability that the neutron is reflected at the BOTTOM OUTER wall*/ + if (DOreflect && strlen (DOreflect)) { + p = Table_Value (doTable, q, 1); + } else { + if (mydOW > 0 && q > QcydOW) { + double arg = (q - mydOW * QcydOW) / WydOW; + if (arg < 10) { + p *= 0.5 * (1.0 - tanh (arg)) * (1.0 - alphaydOW * (q - QcydOW)); + } else + ABSORB; + } + } + } + p *= R0; + SCATTER; + + } while (z < l); /* repeat the interaction loop untill the neutron pass the end of guide */ + + if (x <= -w2r && x >= -w2rwt && y <= mru2 * x + nru2 && y >= mrd2 * x + nrd2 && mxr != -1 + && mxrOW != -1) /* absorbing the neutron if it hit the RIGHT exit wall and the wall is not transparent*/ + ABSORB; + if (x >= w2l && x <= w2lwt && y <= mlu2 * x + nlu2 && y >= mld2 * x + nld2 && mxl != -1 + && mxlOW != -1) /* absorbing the neutron if it hit the LEFT exit wall and the wall is not transparent*/ + ABSORB; + if (y <= -h2d && y >= -h2dwt && x <= (y - nld2) / mld2 && x >= (y - nrd2) / mrd2 && myd != -1 + && mydOW != -1) /* absorbing the neutron if it hit the BOTTOM exit wall and the wall is not transparent*/ + ABSORB; + if (y >= h2u && y <= h2uwt && x <= (y - nlu2) / mlu2 && x >= (y - nru2) / mru2 && myu != -1 + && myuOW != -1) /* absorbing the neutron if it hit the TOP exit wall and the wall is not transparent*/ + ABSORB; %} @@ -2096,371 +2126,358 @@ FINALLY MCDISPLAY %{ - int i,imax; - double x1,y1,Z,x2,y2,Z1,Z0wr,Z0wl,Z0hu,Z0hd,xwt,ywt,x1wt,y1wt; - double mr,ml,mu,md,nr1,nl1,nu1,nd1,nr2,nl2,nu2,nd2; - double lbwl,lbwr,lbhu,lbhd; /* length between focal points , needed for elliptic case */ + int i, imax; + double x1, y1, Z, x2, y2, Z1, Z0wr, Z0wl, Z0hu, Z0hd, xwt, ywt, x1wt, y1wt; + double mr, ml, mu, md, nr1, nl1, nu1, nd1, nr2, nl2, nu2, nd2; + double lbwl, lbwr, lbhu, lbhd; /* length between focal points , needed for elliptic case */ - double x11,y11,x21,y21,Z11,Z0wr1,Z0wl1,Z0hu1,Z0hd1,xwt1,ywt1,x1wt1,y1wt1; - double mr1,ml1,mu1,md1,nr11,nl11,nu11,nd11,nr21,nl21,nu21,nd21; - double lbwl1,lbwr1,lbhu1,lbhd1; + double x11, y11, x21, y21, Z11, Z0wr1, Z0wl1, Z0hu1, Z0hd1, xwt1, ywt1, x1wt1, y1wt1; + double mr1, ml1, mu1, md1, nr11, nl11, nu11, nd11, nr21, nl21, nu21, nd21; + double lbwl1, lbwr1, lbhu1, lbhd1; - double x12,y12,x22,y22,Z12,Z0wr2,Z0wl2,Z0hu2,Z0hd2,xwt2,ywt2,x1wt2,y1wt2; - double mr2,ml2,mu2,md2,nr12,nl12,nu12,nd12,nr22,nl22,nu22,nd22; - double lbwl2,lbwr2,lbhu2,lbhd2; + double x12, y12, x22, y22, Z12, Z0wr2, Z0wl2, Z0hu2, Z0hd2, xwt2, ywt2, x1wt2, y1wt2; + double mr2, ml2, mu2, md2, nr12, nl12, nu12, nd12, nr22, nl22, nu22, nd22; + double lbwl2, lbwr2, lbhu2, lbhd2; + magnify ("xy"); - magnify("xy"); + imax = 100; /* maximum points for every line in Z direction*/ + lbwr = linwr + l + loutwr; + lbwl = linwl + l + loutwl; + lbhu = linhu + l + louthu; + lbhd = linhd + l + louthd; - imax=100; /* maximum points for every line in Z direction*/ - - lbwr=linwr+l+loutwr; - lbwl=linwl+l+loutwl; - lbhu=linhu+l+louthu; - lbhd=linhd+l+louthd; - - - - if (linwr==0 && loutwr==0){ - mr=(-w2r+w1r)/l; - nr1=-w1r; - nr2=-(w1rwt); - } - - -if (linwl==0 && loutwl==0){ - ml=(w2l-w1l)/l; - nl1=w1l; - nl2=(w1lwt); - } - + if (linwr == 0 && loutwr == 0) { + mr = (-w2r + w1r) / l; + nr1 = -w1r; + nr2 = -(w1rwt); + } -if (linhu == 0 && louthu==0) - { - mu=(h2u-h1u)/l; - nu1=h1u; - nu2=(h1uwt); + if (linwl == 0 && loutwl == 0) { + ml = (w2l - w1l) / l; + nl1 = w1l; + nl2 = (w1lwt); } + if (linhu == 0 && louthu == 0) { + mu = (h2u - h1u) / l; + nu1 = h1u; + nu2 = (h1uwt); + } -if (linhd == 0 && louthd==0) - { - md=(-h2d+h1d)/l; - nd1=-h1d; - nd2=-(h1dwt); + if (linhd == 0 && louthd == 0) { + md = (-h2d + h1d) / l; + nd1 = -h1d; + nd2 = -(h1dwt); } - Z0wr=(linwr-l-loutwr)/2.0; - Z0wl=(linwl-l-loutwl)/2.0; - Z0hu=lbhu/2.0-l-louthu; - Z0hd=lbhd/2.0-l-louthd; - - - if(myd!=-1) line(w1l, -h1d, 0.0, -w1r, -h1d, 0.0); /* entrance window given by the INNER walls*/ - if(myu!=-1)line(w1l, h1u, 0.0, -w1r, h1u, 0.0); - if(mxl!=-1)line(w1l, -h1d, 0.0, w1l, h1u, 0.0); - if(mxr!=-1)line( -w1r, h1u, 0.0, -w1r, -h1d, 0.0); - - if(myd!=-1)line(w2l, -h2d, l, -w2r, -h2d, l); /* exit window given by the INNER walls*/ - if(myu!=-1)line(w2l, h2u, l, -w2r, h2u, l); - if(mxl!=-1)line(w2l, -h2d, l, w2l, h2u, l); - if(mxr!=-1)line( -w2r, -h2d, l, -w2r, h2u, l); - - if(mydOW!=-1) line((w1lwt), -(h1dwt), 0.0, -(w1rwt), -(h1dwt), 0.0); /* entrance window given by the OUTER walls */ - if(myuOW!=-1)line((w1lwt), (h1uwt), 0.0, -(w1rwt), (h1uwt), 0.0); - if(mxlOW!=-1)line((w1lwt), -(h1dwt), 0.0, (w1lwt), (h1uwt), 0.0); - if(mxrOW!=-1)line( -(w1rwt), (h1uwt), 0.0, -(w1rwt), -(h1dwt), 0.0); - - if(mydOW!=-1)line((w2lwt), -(h2dwt), l, -(w2rwt), -(h2dwt), l); /* exit windows given by the OUTER walls*/ - if(myuOW!=-1)line((w2lwt), (h2uwt), l, -(w2rwt), (h2uwt), l); - if(mxlOW!=-1)line((w2lwt), -(h2dwt), l, (w2lwt), (h2uwt), l); - if(mxrOW!=-1)line( -(w2rwt), -(h2dwt), l, -(w2rwt), (h2uwt), l); - - if((myd!=-1 && mydOW!=-1) || (mxl!=-1 && mxlOW!=-1)) line(w1l, -h1d, 0.0, (w1lwt), -(h1dwt), 0.0); /* corner connection lines for the entrance windows*/ - if((myu!=-1 && myuOW!=-1) || (mxl!=-1 && mxlOW!=-1)) line(w1l, h1u, 0.0, (w1lwt), (h1uwt), 0.0); - if((myd!=-1 && mydOW!=-1) || (mxr!=-1 && mxrOW!=-1)) line(-w1r, -h1d, 0.0,-(w1rwt), -(h1dwt), 0.0); - if((myu!=-1 && myuOW!=-1) || (mxr!=-1 && mxrOW!=-1)) line( -w1r, h1u, 0.0, -(w1rwt), (h1uwt), 0.0); - - if((myd!=-1 && mydOW!=-1) || (mxl!=-1 && mxlOW!=-1)) line(w2l, -h2d, l, (w2lwt), -(h2dwt), l); /* corner connection lines for the exit windows*/ - if((myu!=-1 && myuOW!=-1) || (mxl!=-1 && mxlOW!=-1)) line(w2l, h2u, l, (w2lwt), (h2uwt), l); - if((myd!=-1 && mydOW!=-1) || (mxr!=-1 && mxrOW!=-1)) line(-w2r, -h2d, l,-(w2rwt), -(h2dwt), l); - if((myu!=-1 && myuOW!=-1) || (mxr!=-1 && mxrOW!=-1)) line( -w2r, h2u, l, -(w2rwt), (h2uwt), l); - -for(i=0;i= 1.4.3) to run this component -#endif - -/* -* G: (m/s^2) Gravitation acceleration along y axis [-9.81] -* Gx: (m/s^2) Gravitation acceleration along x axis [0] -* Gy: (m/s^2) Gravitation acceleration along y axis [-9.81] -* Gz: (m/s^2) Gravitation acceleration along z axis [0] -* mh: (1) m-value of material for left/right vert. mirrors -* mv: (1) m-value of material for top/bottom horz. mirrors -* mx: (1) m-value of material for left/right vert. mirrors -* my: (1) m-value of material for top/bottom horz. mirrors -*/ - - typedef struct Gravity_guide_Vars - { + %include "ref-lib" + #ifndef Gravity_guide_Version + #define Gravity_guide_Version "$Revision$" + + #ifndef PROP_GRAV_DT + #error McStas : You need PROP_GRAV_DT (McStas >= 1.4.3) to run this component + #endif + + /* + * G: (m/s^2) Gravitation acceleration along y axis [-9.81] + * Gx: (m/s^2) Gravitation acceleration along x axis [0] + * Gy: (m/s^2) Gravitation acceleration along y axis [-9.81] + * Gz: (m/s^2) Gravitation acceleration along z axis [0] + * mh: (1) m-value of material for left/right vert. mirrors + * mv: (1) m-value of material for top/bottom horz. mirrors + * mx: (1) m-value of material for left/right vert. mirrors + * my: (1) m-value of material for top/bottom horz. mirrors + */ + + typedef struct Gravity_guide_Vars { double gx; double gy; double gz; double nx[6], ny[6], nz[6]; double wx[6], wy[6], wz[6]; double A[6], norm_n2[6], norm_n[6]; - long N_reflection[7]; + long N_reflection[7]; double w1c, h1c; double w2c, h2c; double M[5]; @@ -172,222 +171,276 @@ SHARE double nzC[5], norm_n2xy[5], Axy[5]; double wav_lr, wav_tb, wav_z; double chamfer_z, chamfer_lr, chamfer_tb; - char compcurname[256]; + char compcurname[256]; double fc_freq, fc_phase; double warnings; } Gravity_guide_Vars_type; - void Gravity_guide_Init(Gravity_guide_Vars_type *aVars, - MCNUM a_w1, MCNUM a_h1, MCNUM a_w2, MCNUM a_h2, MCNUM a_l, MCNUM a_R0, - MCNUM a_Qc, MCNUM a_alpha, MCNUM a_m, MCNUM a_W, MCNUM a_nslit, MCNUM a_d, - MCNUM a_Gx, MCNUM a_Gy, MCNUM a_Gz, - MCNUM a_mleft, MCNUM a_mright, MCNUM a_mtop, MCNUM a_mbottom, MCNUM a_nhslit, - MCNUM a_wavy_lr, MCNUM a_wavy_tb, MCNUM a_wavy_z, MCNUM a_wavy, - MCNUM a_chamfers_z, MCNUM a_chamfers_lr, MCNUM a_chamfers_tb, MCNUM a_chamfers, - MCNUM a_nu, MCNUM a_phase, MCNUM a_aleft, MCNUM a_aright, MCNUM a_atop, MCNUM a_abottom) - { + void + Gravity_guide_Init (Gravity_guide_Vars_type* aVars, MCNUM a_w1, MCNUM a_h1, MCNUM a_w2, MCNUM a_h2, MCNUM a_l, MCNUM a_R0, MCNUM a_Qc, MCNUM a_alpha, MCNUM a_m, + MCNUM a_W, MCNUM a_nslit, MCNUM a_d, MCNUM a_Gx, MCNUM a_Gy, MCNUM a_Gz, MCNUM a_mleft, MCNUM a_mright, MCNUM a_mtop, MCNUM a_mbottom, + MCNUM a_nhslit, MCNUM a_wavy_lr, MCNUM a_wavy_tb, MCNUM a_wavy_z, MCNUM a_wavy, MCNUM a_chamfers_z, MCNUM a_chamfers_lr, + MCNUM a_chamfers_tb, MCNUM a_chamfers, MCNUM a_nu, MCNUM a_phase, MCNUM a_aleft, MCNUM a_aright, MCNUM a_atop, MCNUM a_abottom) { int i; - for (i=0; i<7; aVars->N_reflection[i++] = 0); - for (i=0; i<5; aVars->M[i++] = 0); - for (i=0; i<5; aVars->Alpha[i++] = 0); + for (i = 0; i < 7; aVars->N_reflection[i++] = 0) + ; + for (i = 0; i < 5; aVars->M[i++] = 0) + ; + for (i = 0; i < 5; aVars->Alpha[i++] = 0) + ; aVars->gx = a_Gx; /* The gravitation vector in the current component axis system */ aVars->gy = a_Gy; aVars->gz = a_Gz; - aVars->warnings=0; - - if (a_nslit <= 0 || a_nhslit <= 0) { fprintf(stderr,"%s: Fatal: no channel in this guide (nhslit or nslit=0).\n", aVars->compcurname); exit(-1); } - if (a_d < 0) { fprintf(stderr,"%s: Fatal: subdividing walls have negative thickness in this guide (d<0).\n", aVars->compcurname); exit(-1); } - aVars->w1c = (a_w1 - (a_nslit-1) *a_d)/(double)a_nslit; - aVars->w2c = (a_w2 - (a_nslit-1) *a_d)/(double)a_nslit; - aVars->h1c = (a_h1 - (a_nhslit-1)*a_d)/(double)a_nhslit; - aVars->h2c = (a_h2 - (a_nhslit-1)*a_d)/(double)a_nhslit; - - for (i=0; i <= 4; aVars->M[i++]=a_m); - for (i=0; i <= 4; aVars->Alpha[i++]=a_alpha); - if (a_mleft >= 0) aVars->M[1] =a_mleft ; - if (a_mright >= 0) aVars->M[2] =a_mright ; - if (a_mtop >= 0) aVars->M[3] =a_mtop ; - if (a_mbottom >= 0) aVars->M[4] =a_mbottom; - if (a_aleft >= 0) aVars->Alpha[1] =a_aleft ; - if (a_aright >= 0) aVars->Alpha[2] =a_aright ; - if (a_atop >= 0) aVars->Alpha[3] =a_atop ; - if (a_abottom >= 0) aVars->Alpha[4] =a_abottom; + aVars->warnings = 0; + + if (a_nslit <= 0 || a_nhslit <= 0) { + fprintf (stderr, "%s: Fatal: no channel in this guide (nhslit or nslit=0).\n", aVars->compcurname); + exit (-1); + } + if (a_d < 0) { + fprintf (stderr, "%s: Fatal: subdividing walls have negative thickness in this guide (d<0).\n", aVars->compcurname); + exit (-1); + } + aVars->w1c = (a_w1 - (a_nslit - 1) * a_d) / (double)a_nslit; + aVars->w2c = (a_w2 - (a_nslit - 1) * a_d) / (double)a_nslit; + aVars->h1c = (a_h1 - (a_nhslit - 1) * a_d) / (double)a_nhslit; + aVars->h2c = (a_h2 - (a_nhslit - 1) * a_d) / (double)a_nhslit; + + for (i = 0; i <= 4; aVars->M[i++] = a_m) + ; + for (i = 0; i <= 4; aVars->Alpha[i++] = a_alpha) + ; + if (a_mleft >= 0) + aVars->M[1] = a_mleft; + if (a_mright >= 0) + aVars->M[2] = a_mright; + if (a_mtop >= 0) + aVars->M[3] = a_mtop; + if (a_mbottom >= 0) + aVars->M[4] = a_mbottom; + if (a_aleft >= 0) + aVars->Alpha[1] = a_aleft; + if (a_aright >= 0) + aVars->Alpha[2] = a_aright; + if (a_atop >= 0) + aVars->Alpha[3] = a_atop; + if (a_abottom >= 0) + aVars->Alpha[4] = a_abottom; /* n: normal vectors to surfaces */ - aVars->nx[1] = a_l; aVars->ny[1] = 0; aVars->nz[1] = 0.5*(aVars->w2c-aVars->w1c); /* 1:+X left */ - aVars->nx[2] = -a_l; aVars->ny[2] = 0; aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ - aVars->nx[3] = 0; aVars->ny[3] = a_l; aVars->nz[3] = 0.5*(aVars->h2c-aVars->h1c); /* 3:+Y top */ - aVars->nx[4] = 0; aVars->ny[4] = -a_l; aVars->nz[4] = -aVars->nz[3]; /* 4:-Y bottom */ - aVars->nx[5] = 0; aVars->ny[5] = 0; aVars->nz[5] = a_l; /* 5:+Z exit */ - aVars->nx[0] = 0; aVars->ny[0] = 0; aVars->nz[0] = -a_l; /* 0:Z0 input */ + aVars->nx[1] = a_l; + aVars->ny[1] = 0; + aVars->nz[1] = 0.5 * (aVars->w2c - aVars->w1c); /* 1:+X left */ + aVars->nx[2] = -a_l; + aVars->ny[2] = 0; + aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ + aVars->nx[3] = 0; + aVars->ny[3] = a_l; + aVars->nz[3] = 0.5 * (aVars->h2c - aVars->h1c); /* 3:+Y top */ + aVars->nx[4] = 0; + aVars->ny[4] = -a_l; + aVars->nz[4] = -aVars->nz[3]; /* 4:-Y bottom */ + aVars->nx[5] = 0; + aVars->ny[5] = 0; + aVars->nz[5] = a_l; /* 5:+Z exit */ + aVars->nx[0] = 0; + aVars->ny[0] = 0; + aVars->nz[0] = -a_l; /* 0:Z0 input */ /* w: a point on these surfaces */ - aVars->wx[1] = +(aVars->w1c)/2; aVars->wy[1] = 0; aVars->wz[1] = 0; /* 1:+X left */ - aVars->wx[2] = -(aVars->w1c)/2; aVars->wy[2] = 0; aVars->wz[2] = 0; /* 2:-X right */ - aVars->wx[3] = 0; aVars->wy[3] = +(aVars->h1c)/2; aVars->wz[3] = 0; /* 3:+Y top */ - aVars->wx[4] = 0; aVars->wy[4] = -(aVars->h1c)/2; aVars->wz[4] = 0; /* 4:-Y bottom */ - aVars->wx[5] = 0; aVars->wy[5] = 0; aVars->wz[5] = a_l; /* 5:+Z exit */ - aVars->wx[0] = 0; aVars->wy[0] = 0; aVars->wz[0] = 0; /* 0:Z0 input */ - - for (i=0; i <= 5; i++) - { - aVars->A[i] = scalar_prod(aVars->nx[i], aVars->ny[i], aVars->nz[i], aVars->gx, aVars->gy, aVars->gz)/2; - aVars->norm_n2[i] = aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i] + aVars->nz[i]*aVars->nz[i]; - if (aVars->norm_n2[i] <= 0) - { fprintf(stderr,"%s: Fatal: normal vector norm %i is null/negative ! check guide dimensions.\n", aVars->compcurname, i); exit(-1); } /* should never occur */ + aVars->wx[1] = +(aVars->w1c) / 2; + aVars->wy[1] = 0; + aVars->wz[1] = 0; /* 1:+X left */ + aVars->wx[2] = -(aVars->w1c) / 2; + aVars->wy[2] = 0; + aVars->wz[2] = 0; /* 2:-X right */ + aVars->wx[3] = 0; + aVars->wy[3] = +(aVars->h1c) / 2; + aVars->wz[3] = 0; /* 3:+Y top */ + aVars->wx[4] = 0; + aVars->wy[4] = -(aVars->h1c) / 2; + aVars->wz[4] = 0; /* 4:-Y bottom */ + aVars->wx[5] = 0; + aVars->wy[5] = 0; + aVars->wz[5] = a_l; /* 5:+Z exit */ + aVars->wx[0] = 0; + aVars->wy[0] = 0; + aVars->wz[0] = 0; /* 0:Z0 input */ + + for (i = 0; i <= 5; i++) { + aVars->A[i] = scalar_prod (aVars->nx[i], aVars->ny[i], aVars->nz[i], aVars->gx, aVars->gy, aVars->gz) / 2; + aVars->norm_n2[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i] + aVars->nz[i] * aVars->nz[i]; + if (aVars->norm_n2[i] <= 0) { + fprintf (stderr, "%s: Fatal: normal vector norm %i is null/negative ! check guide dimensions.\n", aVars->compcurname, i); + exit (-1); + } /* should never occur */ else - aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); } /* partial computations for l/r/t/b sides, to save computing time */ - for (i=1; i <= 4; i++) - { /* stores nz that changes in case non box element (focus/defocus) */ - aVars->nzC[i] = aVars->nz[i]; /* partial xy terms */ - aVars->norm_n2xy[i]= aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i]; - aVars->Axy[i] = (aVars->nx[i]*aVars->gx + aVars->ny[i]*aVars->gy)/2; + for (i = 1; i <= 4; i++) { /* stores nz that changes in case non box element (focus/defocus) */ + aVars->nzC[i] = aVars->nz[i]; /* partial xy terms */ + aVars->norm_n2xy[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i]; + aVars->Axy[i] = (aVars->nx[i] * aVars->gx + aVars->ny[i] * aVars->gy) / 2; } /* handle waviness init */ - if (a_wavy && (!a_wavy_tb && !a_wavy_lr && !a_wavy_z)) - { aVars->wav_tb=aVars->wav_lr=aVars->wav_z=a_wavy; } - else - { aVars->wav_tb=a_wavy_tb; aVars->wav_lr=a_wavy_lr; aVars->wav_z=a_wavy_z; } - aVars->wav_tb *= DEG2RAD/(sqrt(8*log(2))); /* Convert from deg FWHM to rad Gaussian sigma */ - aVars->wav_lr *= DEG2RAD/(sqrt(8*log(2))); - aVars->wav_z *= DEG2RAD/(sqrt(8*log(2))); + if (a_wavy && (!a_wavy_tb && !a_wavy_lr && !a_wavy_z)) { + aVars->wav_tb = aVars->wav_lr = aVars->wav_z = a_wavy; + } else { + aVars->wav_tb = a_wavy_tb; + aVars->wav_lr = a_wavy_lr; + aVars->wav_z = a_wavy_z; + } + aVars->wav_tb *= DEG2RAD / (sqrt (8 * log (2))); /* Convert from deg FWHM to rad Gaussian sigma */ + aVars->wav_lr *= DEG2RAD / (sqrt (8 * log (2))); + aVars->wav_z *= DEG2RAD / (sqrt (8 * log (2))); /* handle chamfers init */ - if (a_chamfers && (!a_chamfers_z && !a_chamfers_lr && !a_chamfers_tb)) - { aVars->chamfer_z=aVars->chamfer_lr=aVars->chamfer_tb=a_chamfers; } - else - { - aVars->chamfer_z=a_chamfers_z; - aVars->chamfer_lr=a_chamfers_lr; - aVars->chamfer_tb=a_chamfers_tb; + if (a_chamfers && (!a_chamfers_z && !a_chamfers_lr && !a_chamfers_tb)) { + aVars->chamfer_z = aVars->chamfer_lr = aVars->chamfer_tb = a_chamfers; + } else { + aVars->chamfer_z = a_chamfers_z; + aVars->chamfer_lr = a_chamfers_lr; + aVars->chamfer_tb = a_chamfers_tb; } - aVars->fc_freq = a_nu; + aVars->fc_freq = a_nu; aVars->fc_phase = a_phase; } - int Gravity_guide_Trace(double *dt, - Gravity_guide_Vars_type *aVars, - double cx, double cy, double cz, - double cvx, double cvy, double cvz, - double cxnum, double cxk, double cynum, double cyk, - double *cnx, double *cny,double *cnz) - { + int + Gravity_guide_Trace (double* dt, Gravity_guide_Vars_type* aVars, double cx, double cy, double cz, double cvx, double cvy, double cvz, double cxnum, double cxk, + double cynum, double cyk, double* cnx, double* cny, double* cnz) { double B, C; - int ret=0; - int side=0; + int ret = 0; + int side = 0; double n1; - double dt0, dt_min=0; - int i; + double dt0, dt_min = 0; + int i; double loc_num, loc_nslit; - int i_slope=3; + int i_slope = 3; /* look if there is a previous intersection with guide sides */ /* A = 0.5 n.g; B = n.v; C = n.(r-W); */ /* 5=+Z side: n=(0, 0, -l) ; W = (0, 0, l) (at z=l, guide exit)*/ - B = aVars->nz[5]*cvz; C = aVars->nz[5]*(cz - aVars->wz[5]); - ret = solve_2nd_order(&dt0, NULL, aVars->A[5], B, C); - if (ret && dt0>1e-10) { dt_min = dt0; side=5; } + B = aVars->nz[5] * cvz; + C = aVars->nz[5] * (cz - aVars->wz[5]); + ret = solve_2nd_order (&dt0, NULL, aVars->A[5], B, C); + if (ret && dt0 > 1e-10) { + dt_min = dt0; + side = 5; + } - loc_num = cynum; loc_nslit = cyk; - for (i=4; i>0; i--) - { - if (i == 2) { i_slope=1; loc_num = cxnum; loc_nslit = cxk; } + loc_num = cynum; + loc_nslit = cyk; + for (i = 4; i > 0; i--) { + if (i == 2) { + i_slope = 1; + loc_num = cxnum; + loc_nslit = cxk; + } if (aVars->nzC[i_slope] != 0) { - n1 = loc_nslit - 2*(loc_num); /* slope of l/r/u/d sides depends on the channel ! */ - loc_num++; /* use partial computations to alter nz and A */ - aVars->nz[i]= aVars->nzC[i]*n1; - aVars->A[i] = aVars->Axy[i] + aVars->nz[i]*aVars->gz/2; + n1 = loc_nslit - 2 * (loc_num); /* slope of l/r/u/d sides depends on the channel ! */ + loc_num++; /* use partial computations to alter nz and A */ + aVars->nz[i] = aVars->nzC[i] * n1; + aVars->A[i] = aVars->Axy[i] + aVars->nz[i] * aVars->gz / 2; } - if (i < 3) - { B = aVars->nx[i]*cvx + aVars->nz[i]*cvz; C = aVars->nx[i]*(cx-aVars->wx[i]) + aVars->nz[i]*cz; } - else { B = aVars->ny[i]*cvy + aVars->nz[i]*cvz; C = aVars->ny[i]*(cy-aVars->wy[i]) + aVars->nz[i]*cz; } - ret = solve_2nd_order(&dt0, NULL, aVars->A[i], B, C); - if (ret && dt0>1e-10 && (dt0nzC[i] != 0) - { aVars->norm_n2[i] = aVars->norm_n2xy[i] + aVars->nz[i]*aVars->nz[i]; - aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); } + if (i < 3) { + B = aVars->nx[i] * cvx + aVars->nz[i] * cvz; + C = aVars->nx[i] * (cx - aVars->wx[i]) + aVars->nz[i] * cz; + } else { + B = aVars->ny[i] * cvy + aVars->nz[i] * cvz; + C = aVars->ny[i] * (cy - aVars->wy[i]) + aVars->nz[i] * cz; } - } + ret = solve_2nd_order (&dt0, NULL, aVars->A[i], B, C); + if (ret && dt0 > 1e-10 && (dt0 < dt_min || !dt_min)) { + dt_min = dt0; + side = i; + if (aVars->nzC[i] != 0) { + aVars->norm_n2[i] = aVars->norm_n2xy[i] + aVars->nz[i] * aVars->nz[i]; + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); + } + } + } *dt = dt_min; /* handles waviness: rotate n vector */ - if (side > 0 && side < 5 && (aVars->wav_z || aVars->wav_lr || aVars->wav_tb)) - { - double nt_x, nt_y, nt_z; /* transverse vector */ - double nn_x, nn_y, nn_z; /* normal vector (tmp) */ + if (side > 0 && side < 5 && (aVars->wav_z || aVars->wav_lr || aVars->wav_tb)) { + double nt_x, nt_y, nt_z; /* transverse vector */ + double nn_x, nn_y, nn_z; /* normal vector (tmp) */ double phi; /* normal vector n_z = [ 0,0,1], n_t = n x n_z; */ - vec_prod(nt_x,nt_y,nt_z, aVars->nx[side],aVars->ny[side],aVars->nz[side], 0,0,1); + vec_prod (nt_x, nt_y, nt_z, aVars->nx[side], aVars->ny[side], aVars->nz[side], 0, 0, 1); /* rotate n with angle wavy_z around n_t -> nn */ if (aVars->wav_z) { phi = aVars->wav_z; - rotate(nn_x,nn_y,nn_z, aVars->nx[side],aVars->ny[side],aVars->nz[side], aVars->wav_z*randnorm(), nt_x,nt_y,nt_z); - } else { nn_x=aVars->nx[side]; nn_y=aVars->ny[side]; nn_z=aVars->nz[side]; } + rotate (nn_x, nn_y, nn_z, aVars->nx[side], aVars->ny[side], aVars->nz[side], aVars->wav_z * randnorm (), nt_x, nt_y, nt_z); + } else { + nn_x = aVars->nx[side]; + nn_y = aVars->ny[side]; + nn_z = aVars->nz[side]; + } /* rotate n with angle wavy_{x|y} around n_z -> nt */ - phi = (side <=2) ? aVars->wav_lr : aVars->wav_tb; + phi = (side <= 2) ? aVars->wav_lr : aVars->wav_tb; if (phi) { - rotate(nt_x,nt_y,nt_z, nn_x,nn_y,nn_z, phi*randnorm(), 0,0,1); - } else { nt_x=nn_x; nt_y=nn_y; nt_z=nn_z; } - *cnx=nt_x; *cny=nt_y; *cnz=nt_z; - } else - { *cnx=aVars->nx[side]; *cny=aVars->ny[side]; *cnz=aVars->nz[side]; } + rotate (nt_x, nt_y, nt_z, nn_x, nn_y, nn_z, phi * randnorm (), 0, 0, 1); + } else { + nt_x = nn_x; + nt_y = nn_y; + nt_z = nn_z; + } + *cnx = nt_x; + *cny = nt_y; + *cnz = nt_z; + } else { + *cnx = aVars->nx[side]; + *cny = aVars->ny[side]; + *cnz = aVars->nz[side]; + } return (side); } + %include "read_table-lib" + #endif -%include "read_table-lib" - -#endif - -#ifndef Gravity_psdguide_Version -#define Gravity_psdguide_Version "$Revision$" - void update_detectors(int i, double p, double *detN, double *detp, double *detp2) - { - detN[i]++; - detp[i] += p; - detp2[i] += p*p; + #ifndef Gravity_psdguide_Version + #define Gravity_psdguide_Version "$Revision$" + void + update_detectors (int i, double p, double* detN, double* detp, double* detp2) { + detN[i]++; + detp[i] += p; + detp2[i] += p * p; } - void Gravity_guide_Absorb(int side, int nxpsd, double z, double l, double p, - double *N1, double *p1, double *p1_2, - double *N2, double *p2, double *p2_2, - double *N3, double *p3, double *p3_2, - double *N4, double *p4, double *p4_2) - { - int i; - i = floor(nxpsd*(z)/(l)); /* Bin number */ - /* i = (int)(nxpsd*z/l); */ - if (i == nxpsd) - { - i -= 1; /* end of guide belongs to last bin */ - printf("WARNING: hit i==nxpsd \n"); - - } - else if( i > nxpsd || i<0 ) - { - printf("WARNING: wrong positioning in linear PSD. i= %i \n",i); - printf("nxpsd = %i, z = %.3f, l = %.3f\n",nxpsd, z, l); - printf("Ignore event\n"); - return; - } - if (side == 1) - update_detectors(i, p, N1, p1, p1_2); - else if (side == 2) - update_detectors(i, p, N2, p2, p2_2); - else if (side == 3) - update_detectors(i, p, N3, p3, p3_2); - else if (side == 4) - update_detectors(i, p, N4, p4, p4_2); + void + Gravity_guide_Absorb (int side, int nxpsd, double z, double l, double p, double* N1, double* p1, double* p1_2, double* N2, double* p2, double* p2_2, double* N3, + double* p3, double* p3_2, double* N4, double* p4, double* p4_2) { + int i; + i = floor (nxpsd * (z) / (l)); /* Bin number */ + /* i = (int)(nxpsd*z/l); */ + if (i == nxpsd) { + i -= 1; /* end of guide belongs to last bin */ + printf ("WARNING: hit i==nxpsd \n"); + + } else if (i > nxpsd || i < 0) { + printf ("WARNING: wrong positioning in linear PSD. i= %i \n", i); + printf ("nxpsd = %i, z = %.3f, l = %.3f\n", nxpsd, z, l); + printf ("Ignore event\n"); + return; + } + if (side == 1) + update_detectors (i, p, N1, p1, p1_2); + else if (side == 2) + update_detectors (i, p, N2, p2, p2_2); + else if (side == 3) + update_detectors (i, p, N3, p3, p3_2); + else if (side == 4) + update_detectors (i, p, N4, p4, p4_2); } -#endif - + #endif %} DECLARE @@ -417,295 +470,319 @@ DECLARE INITIALIZE %{ - double Gx=0, Gy=-GRAVITY, Gz=0; + double Gx = 0, Gy = -GRAVITY, Gz = 0; Coords mcLocG; int i; - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) { - if (Table_Read(&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"Guide_gravity: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) { + if (Table_Read (&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Guide_gravity: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); } else { - if (W < 0 || R0 < 0 || Qc < 0) - { fprintf(stderr,"Guide_gravity: %s: W R0 Qc must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } + if (W < 0 || R0 < 0 || Qc < 0) { + fprintf (stderr, "Guide_gravity: %s: W R0 Qc must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } } - if (nslit <= 0 || nhslit <= 0) - { fprintf(stderr,"Guide_gravity: %s: nslit nhslit must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } + if (nslit <= 0 || nhslit <= 0) { + fprintf (stderr, "Guide_gravity: %s: nslit nhslit must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } - if (!w1 || !h1) - { fprintf(stderr,"Guide_gravity: %s: input window is closed (w1=h1=0).\n", NAME_CURRENT_COMP); - exit(-1); } + if (!w1 || !h1) { + fprintf (stderr, "Guide_gravity: %s: input window is closed (w1=h1=0).\n", NAME_CURRENT_COMP); + exit (-1); + } - if (d*nslit > w1) exit(fprintf(stderr, "Guide_gravity: %s: absorbing walls fill input window. No space left for transmission (d*nslit > w1).\n", NAME_CURRENT_COMP)); + if (d * nslit > w1) + exit (fprintf (stderr, "Guide_gravity: %s: absorbing walls fill input window. No space left for transmission (d*nslit > w1).\n", NAME_CURRENT_COMP)); - if (!w2) w2=w1; - if (!h2) h2=h1; + if (!w2) + w2 = w1; + if (!h2) + h2 = h1; - if (mcgravitation) G=-GRAVITY; - mcLocG = rot_apply(ROT_A_CURRENT_COMP, coords_set(0,G,0)); - coords_get(mcLocG, &Gx, &Gy, &Gz); + if (mcgravitation) + G = -GRAVITY; + mcLocG = rot_apply (ROT_A_CURRENT_COMP, coords_set (0, G, 0)); + coords_get (mcLocG, &Gx, &Gy, &Gz); - strcpy(GVars.compcurname, NAME_CURRENT_COMP); + strcpy (GVars.compcurname, NAME_CURRENT_COMP); if (l > 0 && nelements > 0) { - Gravity_guide_Init(&GVars, - w1, h1, w2, h2, l, R0, - Qc, alpha, m, W, nslit, d, - Gx, Gy, Gz, mleft, mright, mtop, - mbottom, nhslit, wavy_lr, wavy_tb, wavy_z, wavy, - chamfers_z, chamfers_lr, chamfers_tb, chamfers,nu,phase,aleft,aright,atop,abottom); - if (!G) for (i=0; i<5; GVars.A[i++] = 0); + Gravity_guide_Init (&GVars, w1, h1, w2, h2, l, R0, Qc, alpha, m, W, nslit, d, Gx, Gy, Gz, mleft, mright, mtop, mbottom, nhslit, wavy_lr, wavy_tb, wavy_z, + wavy, chamfers_z, chamfers_lr, chamfers_tb, chamfers, nu, phase, aleft, aright, atop, abottom); + if (!G) + for (i = 0; i < 5; GVars.A[i++] = 0) + ; if (GVars.fc_freq != 0 || GVars.fc_phase != 0) { if (w1 != w2 || h1 != h2) - exit(fprintf(stderr,"Guide_gravity: %s: rotating slit pack must be straight (w1=w2 and h1=h2).\n", NAME_CURRENT_COMP)); - printf("Guide_gravity: %s: Fermi Chopper mode: frequency=%g [Hz] phase=%g [deg]\n", - NAME_CURRENT_COMP, GVars.fc_freq, GVars.fc_phase); + exit (fprintf (stderr, "Guide_gravity: %s: rotating slit pack must be straight (w1=w2 and h1=h2).\n", NAME_CURRENT_COMP)); + printf ("Guide_gravity: %s: Fermi Chopper mode: frequency=%g [Hz] phase=%g [deg]\n", NAME_CURRENT_COMP, GVars.fc_freq, GVars.fc_phase); } - } else printf("Guide_gravity: %s: unactivated (l=0 or nelements=0)\n", NAME_CURRENT_COMP); - + } else + printf ("Guide_gravity: %s: unactivated (l=0 or nelements=0)\n", NAME_CURRENT_COMP); /* added lines 417 - 432 to init PSD's */ /* int i; */ - PSDlin_Nxp = create_darr1d(nxpsd); - PSDlin_pxp = create_darr1d(nxpsd); - PSDlin_p2xp = create_darr1d(nxpsd); - - PSDlin_Nxn = create_darr1d(nxpsd); - PSDlin_pxn = create_darr1d(nxpsd); - PSDlin_p2xn = create_darr1d(nxpsd); - - PSDlin_Nyp = create_darr1d(nxpsd); - PSDlin_pyp = create_darr1d(nxpsd); - PSDlin_p2yp = create_darr1d(nxpsd); - - PSDlin_Nyn = create_darr1d(nxpsd); - PSDlin_pyn = create_darr1d(nxpsd); - PSDlin_p2yn = create_darr1d(nxpsd); - - for (i=0; i 0 && nelements > 0) { double B, C, dt; - int ret, bounces = 0, i=0; + int ret, bounces = 0, i = 0; double this_width, this_height; - double angle=0; + double angle = 0; double Rtemp; if (GVars.fc_freq != 0 || GVars.fc_phase != 0) { /* rotate neutron w/r to guide element */ /* approximation of rotating straight Fermi Chopper */ - Coords X = coords_set(x,y,z-l/2); /* current coordinates of neutron in centered static frame */ + Coords X = coords_set (x, y, z - l / 2); /* current coordinates of neutron in centered static frame */ Rotation R; - double dt=(-z+l/2)/vz; /* time shift to each center of slit package */ - angle=fmod(360*GVars.fc_freq*(t+dt)+GVars.fc_phase, 360); /* in deg */ + double dt = (-z + l / 2) / vz; /* time shift to each center of slit package */ + angle = fmod (360 * GVars.fc_freq * (t + dt) + GVars.fc_phase, 360); /* in deg */ /* modify angle so that Z0 guide side is always in front of incoming neutron */ - if (angle > 90 && angle < 270) { angle -= 180; } + if (angle > 90 && angle < 270) { + angle -= 180; + } angle *= DEG2RAD; - rot_set_rotation(R, 0, -angle, 0); /* will rotate neutron instead of comp: negative side */ + rot_set_rotation (R, 0, -angle, 0); /* will rotate neutron instead of comp: negative side */ /* apply rotation to centered coordinates */ - Coords RX = rot_apply(R, X); - coords_get(RX, &x, &y, &z); - z = z+l/2; + Coords RX = rot_apply (R, X); + coords_get (RX, &x, &y, &z); + z = z + l / 2; /* rotate speed */ - X = coords_set(vx,vy,vz); - RX = rot_apply(R, X); - coords_get(RX, &vx, &vy, &vz); + X = coords_set (vx, vy, vz); + RX = rot_apply (R, X); + coords_get (RX, &vx, &vy, &vz); } - for (i=0; i<7; GVars.N_reflection[i++] = 0); + for (i = 0; i < 7; GVars.N_reflection[i++] = 0) + ; /* propagate to box input (with gravitation) in comp local coords */ /* A = 0.5 n.g; B = n.v; C = n.(r-W); */ /* 0=Z0 side: n=(0, 0, -l) ; W = (0, 0, 0) (at z=0, guide input)*/ - B = -l*vz; C = -l*z; + B = -l * vz; + C = -l * z; - ret = solve_2nd_order(&dt, NULL, GVars.A[0], B, C); - if (ret==0) ABSORB; + ret = solve_2nd_order (&dt, NULL, GVars.A[0], B, C); + if (ret == 0) + ABSORB; - if (dt>0.0) PROP_GRAV_DT(dt, GVars.gx, GVars.gy, GVars.gz); else if (angle) ABSORB; + if (dt > 0.0) + PROP_GRAV_DT (dt, GVars.gx, GVars.gy, GVars.gz); + else if (angle) + ABSORB; GVars.N_reflection[6]++; - this_width = w1; + this_width = w1; this_height = h1; - /* check if we are in the box input, else absorb */ - if (fabs(x) > this_width/2 || fabs(y) > this_height/2) + /* check if we are in the box input, else absorb */ + if (fabs (x) > this_width / 2 || fabs (y) > this_height / 2) ABSORB; - else - { - double w_edge, w_adj; /* Channel displacement on X */ - double h_edge, h_adj; /* Channel displacement on Y */ - double w_chnum,h_chnum; /* channel indexes */ + else { + double w_edge, w_adj; /* Channel displacement on X */ + double h_edge, h_adj; /* Channel displacement on Y */ + double w_chnum, h_chnum; /* channel indexes */ SCATTER; /* X: Shift origin to center of channel hit (absorb if hit dividing walls) */ - x += w1/2.0; - w_chnum = floor(x/(GVars.w1c+d)); /* 0= right side, nslit+1=left side */ - w_edge = w_chnum*(GVars.w1c+d); - if(x - w_edge > GVars.w1c) - { - x -= w1/2.0; /* Re-adjust origin */ + x += w1 / 2.0; + w_chnum = floor (x / (GVars.w1c + d)); /* 0= right side, nslit+1=left side */ + w_edge = w_chnum * (GVars.w1c + d); + if (x - w_edge > GVars.w1c) { + x -= w1 / 2.0; /* Re-adjust origin */ ABSORB; } - w_adj = w_edge + (GVars.w1c)/2.0; - x -= w_adj; w_adj -= w1/2.0; + w_adj = w_edge + (GVars.w1c) / 2.0; + x -= w_adj; + w_adj -= w1 / 2.0; /* Y: Shift origin to center of channel hit (absorb if hit dividing walls) */ - y += h1/2.0; - h_chnum = floor(y/(GVars.h1c+d)); /* 0= lower side, nslit+1=upper side */ - h_edge = h_chnum*(GVars.h1c+d); - if(y - h_edge > GVars.h1c) - { - y -= h1/2.0; /* Re-adjust origin */ + y += h1 / 2.0; + h_chnum = floor (y / (GVars.h1c + d)); /* 0= lower side, nslit+1=upper side */ + h_edge = h_chnum * (GVars.h1c + d); + if (y - h_edge > GVars.h1c) { + y -= h1 / 2.0; /* Re-adjust origin */ ABSORB; } - h_adj = h_edge + (GVars.h1c)/2.0; - y -= h_adj; h_adj -= h1/2.0; + h_adj = h_edge + (GVars.h1c) / 2.0; + y -= h_adj; + h_adj -= h1 / 2.0; /* neutron is now in the input window of the guide */ /* do loops on reflections in the box */ - for(;;) - { + for (;;) { /* get intersections for all box sides */ - double q, nx,ny,nz; + double q, nx, ny, nz; double this_length; - int side=0; + int side = 0; bounces++; /* now look for intersection with guide sides and exit */ - side = Gravity_guide_Trace(&dt, &GVars, x, y, z, - vx, vy, vz, w_chnum, nslit, h_chnum, nhslit, - &nx, &ny, &nz); + side = Gravity_guide_Trace (&dt, &GVars, x, y, z, vx, vy, vz, w_chnum, nslit, h_chnum, nhslit, &nx, &ny, &nz); /* only positive dt are valid */ /* exit reflection loops if no intersection (neutron is after box) */ - if (side == 0 || dt <= 0) - { if (GVars.warnings < 100) - fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); - GVars.warnings++; - x += w_adj; y += h_adj; ABSORB; } /* should never occur */ + if (side == 0 || dt <= 0) { + if (GVars.warnings < 100) + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); + GVars.warnings++; + x += w_adj; + y += h_adj; + ABSORB; + } /* should never occur */ /* propagate to dt */ - PROP_GRAV_DT(dt, GVars.gx, GVars.gy, GVars.gz); + PROP_GRAV_DT (dt, GVars.gx, GVars.gy, GVars.gz); /* do reflection on speed for l/r/u/d sides */ if (side == 5) /* neutron reaches end of guide: end loop and exit comp */ - { GVars.N_reflection[side]++; x += w_adj; y += h_adj; SCATTER; x -= w_adj; y -= h_adj; break; } + { + GVars.N_reflection[side]++; + x += w_adj; + y += h_adj; + SCATTER; + x -= w_adj; + y -= h_adj; + break; + } /* else reflection on a guide wall */ - if(GVars.M[side] == 0 || Qc == 0 || R0 == 0) /* walls are absorbing */ - { x += w_adj; y += h_adj; - Gravity_guide_Absorb(side, nxpsd, z, l,p, - PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, - PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, - PSDlin_Nyp, PSDlin_pyp, PSDlin_p2yp, - PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); + if (GVars.M[side] == 0 || Qc == 0 || R0 == 0) /* walls are absorbing */ + { + x += w_adj; + y += h_adj; + Gravity_guide_Absorb (side, nxpsd, z, l, p, PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, PSDlin_Nyp, PSDlin_pyp, + PSDlin_p2yp, PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); ABSORB; - } + } /* handle chamfers */ - this_width = w1+(w2-w1)*z/l; - this_height= h1+(h2-h1)*z/l; - this_length= fmod(z, l/nelements); + this_width = w1 + (w2 - w1) * z / l; + this_height = h1 + (h2 - h1) * z / l; + this_length = fmod (z, l / nelements); /* absorb on input/output of element parts */ - if (GVars.chamfer_z && (this_lengthl/nelements-GVars.chamfer_z)) - { x += w_adj; y += h_adj; ABSORB; } + if (GVars.chamfer_z && (this_length < GVars.chamfer_z || this_length > l / nelements - GVars.chamfer_z)) { + x += w_adj; + y += h_adj; + ABSORB; + } /* absorb on l/r/t/b sides */ - if (GVars.chamfer_lr && (side==1 || side==2) && (fabs(y+h_adj)>this_height/2-GVars.chamfer_lr)) - { x += w_adj; y += h_adj; ABSORB; } - if (GVars.chamfer_tb && (side==3 || side==4) && (fabs(x+w_adj)>this_width/2- GVars.chamfer_tb)) - { x += w_adj; y += h_adj; ABSORB; } + if (GVars.chamfer_lr && (side == 1 || side == 2) && (fabs (y + h_adj) > this_height / 2 - GVars.chamfer_lr)) { + x += w_adj; + y += h_adj; + ABSORB; + } + if (GVars.chamfer_tb && (side == 3 || side == 4) && (fabs (x + w_adj) > this_width / 2 - GVars.chamfer_tb)) { + x += w_adj; + y += h_adj; + ABSORB; + } /* change/mirror velocity: h_f = v - n.2*n.v/|n|^2 */ GVars.N_reflection[side]++; /* GVars.norm_n2 > 0 was checked at INIT */ /* compute n.v using current values */ - B = scalar_prod(vx,vy,vz,nx,ny,nz); - dt = 2*B/GVars.norm_n2[side]; /* 2*n.v/|n|^2 */ - vx -= nx*dt; - vy -= ny*dt; - vz -= nz*dt; + B = scalar_prod (vx, vy, vz, nx, ny, nz); + dt = 2 * B / GVars.norm_n2[side]; /* 2*n.v/|n|^2 */ + vx -= nx * dt; + vy -= ny * dt; + vz -= nz * dt; /* compute q and modify neutron weight */ /* scattering q=|n_i-n_f| = V2Q*|vf - v| = V2Q*2*n.v/|n| */ - q = 2*V2Q*fabs(B)/GVars.norm_n[side]; + q = 2 * V2Q * fabs (B) / GVars.norm_n[side]; - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) - TableReflecFunc(q, &pTable, &B); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) + TableReflecFunc (q, &pTable, &B); else { - double par[] = {R0, Qc, GVars.Alpha[side], GVars.M[side], W}; - StdReflecFunc(q, par, &B); + double par[] = { R0, Qc, GVars.Alpha[side], GVars.M[side], W }; + StdReflecFunc (q, par, &B); } if (B <= 0) { - x += w_adj; y += h_adj; - Gravity_guide_Absorb(side, nxpsd, z, l, p, - PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, - PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, - PSDlin_Nyp, PSDlin_pyp, PSDlin_p2yp, - PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); + x += w_adj; + y += h_adj; + Gravity_guide_Absorb (side, nxpsd, z, l, p, PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, PSDlin_Nyp, PSDlin_pyp, + PSDlin_p2yp, PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); ABSORB; - } + } else { - Rtemp = rand01(); /* count for substrate psd with probability 1-B */ - if(Rtemp > B) { - Gravity_guide_Absorb(side, nxpsd, z, l, p, - PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, - PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, - PSDlin_Nyp, PSDlin_pyp, PSDlin_p2yp, - PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); + Rtemp = rand01 (); /* count for substrate psd with probability 1-B */ + if (Rtemp > B) { + Gravity_guide_Absorb (side, nxpsd, z, l, p, PSDlin_Nxp, PSDlin_pxp, PSDlin_p2xp, PSDlin_Nxn, PSDlin_pxn, PSDlin_p2xn, PSDlin_Nyp, PSDlin_pyp, + PSDlin_p2yp, PSDlin_Nyn, PSDlin_pyn, PSDlin_p2yn); } p *= B; - } + } - x += w_adj; y += h_adj; SCATTER; x -= w_adj; y -= h_adj; + x += w_adj; + y += h_adj; + SCATTER; + x -= w_adj; + y -= h_adj; GVars.N_reflection[0]++; /* go to the next reflection */ if (bounces > 1000) { /* psd block 3 */ ABSORB; - } + } } /* end for */ - x += w_adj; y += h_adj; /* Re-adjust origin after SCATTER */ + x += w_adj; + y += h_adj; /* Re-adjust origin after SCATTER */ } if (GVars.fc_freq != 0 || GVars.fc_phase != 0) { /* rotate back neutron w/r to guide element */ /* approximation of rotating straight Fermi Chopper */ - Coords X = coords_set(x,y,z-l/2); /* current coordinates of neutron in centered static frame */ + Coords X = coords_set (x, y, z - l / 2); /* current coordinates of neutron in centered static frame */ Rotation R; - rot_set_rotation(R, 0, angle, 0); /* will rotate back neutron: positive side */ + rot_set_rotation (R, 0, angle, 0); /* will rotate back neutron: positive side */ /* apply rotation to centered coordinates */ - Coords RX = rot_apply(R, X); - coords_get(RX, &x, &y, &z); - z = z+l/2; + Coords RX = rot_apply (R, X); + coords_get (RX, &x, &y, &z); + z = z + l / 2; /* rotate speed */ - X = coords_set(vx,vy,vz); - RX = rot_apply(R, X); - coords_get(RX, &vx, &vy, &vz); + X = coords_set (vx, vy, vz); + RX = rot_apply (R, X); + coords_get (RX, &vx, &vy, &vz); } } /* if l */ @@ -714,125 +791,89 @@ TRACE SAVE %{ - currentPOS = POS_A_CURRENT_COMP.z; - DETECTOR_OUT_1D( - "Linear PSD monitor X+", - "Position [m]", - "Intensity", - "z", currentPOS,(currentPOS+l), nxpsd, - &PSDlin_Nxp[0],&PSDlin_pxp[0],&PSDlin_p2xp[0], - filenameL); - - DETECTOR_OUT_1D( - "Linear PSD monitor X-", - "Position [m]", - "Intensity", - "z", currentPOS,(currentPOS+l), nxpsd, - &PSDlin_Nxn[0],&PSDlin_pxn[0],&PSDlin_p2xn[0], - filenameR); - - DETECTOR_OUT_1D( - "Linear PSD monitor Y+", - "Position [m]", - "Intensity", - "z", currentPOS,(currentPOS+l), nxpsd, - &PSDlin_Nyp[0],&PSDlin_pyp[0],&PSDlin_p2yp[0], - filenameT); - - DETECTOR_OUT_1D( - "Linear PSD monitor Y-", - "Position [m]", - "Intensity", - "z", currentPOS,(currentPOS+l), nxpsd, - &PSDlin_Nyn[0],&PSDlin_pyn[0],&PSDlin_p2yn[0], - filenameB); + currentPOS = POS_A_CURRENT_COMP.z; + DETECTOR_OUT_1D ("Linear PSD monitor X+", "Position [m]", "Intensity", "z", currentPOS, (currentPOS + l), nxpsd, &PSDlin_Nxp[0], &PSDlin_pxp[0], + &PSDlin_p2xp[0], filenameL); + + DETECTOR_OUT_1D ("Linear PSD monitor X-", "Position [m]", "Intensity", "z", currentPOS, (currentPOS + l), nxpsd, &PSDlin_Nxn[0], &PSDlin_pxn[0], + &PSDlin_p2xn[0], filenameR); + + DETECTOR_OUT_1D ("Linear PSD monitor Y+", "Position [m]", "Intensity", "z", currentPOS, (currentPOS + l), nxpsd, &PSDlin_Nyp[0], &PSDlin_pyp[0], + &PSDlin_p2yp[0], filenameT); + + DETECTOR_OUT_1D ("Linear PSD monitor Y-", "Position [m]", "Intensity", "z", currentPOS, (currentPOS + l), nxpsd, &PSDlin_Nyn[0], &PSDlin_pyn[0], + &PSDlin_p2yn[0], filenameB); %} FINALLY %{ if (GVars.warnings > 100) { - fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); - fprintf(stderr,"%s: warning: This message has been repeated %g times\n", GVars.compcurname, GVars.warnings); + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); + fprintf (stderr, "%s: warning: This message has been repeated %g times\n", GVars.compcurname, GVars.warnings); } - destroy_darr1d(PSDlin_Nxp); - destroy_darr1d(PSDlin_pxp); - destroy_darr1d(PSDlin_p2xp); + destroy_darr1d (PSDlin_Nxp); + destroy_darr1d (PSDlin_pxp); + destroy_darr1d (PSDlin_p2xp); - destroy_darr1d(PSDlin_Nxn); - destroy_darr1d(PSDlin_pxn); - destroy_darr1d(PSDlin_p2xn); + destroy_darr1d (PSDlin_Nxn); + destroy_darr1d (PSDlin_pxn); + destroy_darr1d (PSDlin_p2xn); - destroy_darr1d(PSDlin_Nyp); - destroy_darr1d(PSDlin_pyp); - destroy_darr1d(PSDlin_p2yp); + destroy_darr1d (PSDlin_Nyp); + destroy_darr1d (PSDlin_pyp); + destroy_darr1d (PSDlin_p2yp); - destroy_darr1d(PSDlin_Nyn); - destroy_darr1d(PSDlin_pyn); - destroy_darr1d(PSDlin_p2yn); + destroy_darr1d (PSDlin_Nyn); + destroy_darr1d (PSDlin_pyn); + destroy_darr1d (PSDlin_p2yn); %} MCDISPLAY %{ if (l > 0 && nelements > 0) { - int i,j,n; - double x1,x2,x3,x4; - double y1,y2,y3,y4; + int i, j, n; + double x1, x2, x3, x4; + double y1, y2, y3, y4; double nel = (nelements > 11 ? 11 : nelements); - - for (n=0; n= 1.4.3) to run this component -#endif - -/* -* G: (m/s^2) Gravitation acceleration along y axis [-9.81] -* Gx: (m/s^2) Gravitation acceleration along x axis [0] -* Gy: (m/s^2) Gravitation acceleration along y axis [-9.81] -* Gz: (m/s^2) Gravitation acceleration along z axis [0] -* mh: (1) m-value of material for left/right vert. mirrors -* mv: (1) m-value of material for top/bottom horz. mirrors -* mx: (1) m-value of material for left/right vert. mirrors -* my: (1) m-value of material for top/bottom horz. mirrors -*/ - - typedef struct Honeycomb_guide_Vars - { + %include "ref-lib" + #ifndef Honeycomb_guide_Version + #define Honeycomb_guide_Version "$Revision$" + + #ifndef PROP_GRAV_DT + #error McStas : You need PROP_GRAV_DT (McStas >= 1.4.3) to run this component + #endif + + /* + * G: (m/s^2) Gravitation acceleration along y axis [-9.81] + * Gx: (m/s^2) Gravitation acceleration along x axis [0] + * Gy: (m/s^2) Gravitation acceleration along y axis [-9.81] + * Gz: (m/s^2) Gravitation acceleration along z axis [0] + * mh: (1) m-value of material for left/right vert. mirrors + * mv: (1) m-value of material for top/bottom horz. mirrors + * mx: (1) m-value of material for left/right vert. mirrors + * my: (1) m-value of material for top/bottom horz. mirrors + */ + + typedef struct Honeycomb_guide_Vars { double gx; double gy; double gz; double nx[8], ny[8], nz[8]; double wx[8], wy[8], wz[8]; double A[8], norm_n2[8], norm_n[8]; - long N_reflection[9]; + long N_reflection[9]; double w1c, w2c; double M[7]; double nzC[7], norm_n2xy[7], Axy[7]; - char compcurname[256]; + char compcurname[256]; double warnings; } Honeycomb_guide_Vars_type; - void Honeycomb_guide_Init(Honeycomb_guide_Vars_type *aVars, - MCNUM a_w1, MCNUM a_w2, MCNUM a_l, MCNUM a_R0, - MCNUM a_Qc, MCNUM a_alpha, MCNUM a_m, MCNUM a_W, MCNUM a_nslit, MCNUM a_d, - MCNUM a_Gx, MCNUM a_Gy, MCNUM a_Gz, MCNUM a_mright, MCNUM a_mleft, MCNUM a_mleftup, - MCNUM a_mrightdown, MCNUM a_mrightup, MCNUM a_mleftdown) - { + void + Honeycomb_guide_Init (Honeycomb_guide_Vars_type* aVars, MCNUM a_w1, MCNUM a_w2, MCNUM a_l, MCNUM a_R0, MCNUM a_Qc, MCNUM a_alpha, MCNUM a_m, MCNUM a_W, + MCNUM a_nslit, MCNUM a_d, MCNUM a_Gx, MCNUM a_Gy, MCNUM a_Gz, MCNUM a_mright, MCNUM a_mleft, MCNUM a_mleftup, MCNUM a_mrightdown, + MCNUM a_mrightup, MCNUM a_mleftdown) { int i; - for (i=0; i<8; aVars->N_reflection[i++] = 0); - for (i=0; i<7; aVars->M[i++] = 0); + for (i = 0; i < 8; aVars->N_reflection[i++] = 0) + ; + for (i = 0; i < 7; aVars->M[i++] = 0) + ; aVars->gx = a_Gx; /* The gravitation vector in the current component axis system */ aVars->gy = a_Gy; aVars->gz = a_Gz; - aVars->warnings=0; + aVars->warnings = 0; - if (a_nslit <= 0) { fprintf(stderr,"%s: Fatal: no channel in this guide (kh or nslit=0).\n", aVars->compcurname); exit(-1); } - if (a_d < 0) { fprintf(stderr,"%s: Fatal: subdividing walls have negative thickness in this guide (d<0).\n", aVars->compcurname); exit(-1); } - - aVars->w1c = 0.5*(a_w1 - (a_nslit-1) *2*a_d)/(double)a_nslit; /*INPUT APOTHEM*/ - aVars->w2c = 0.5*(a_w2 - (a_nslit-1) *2*a_d)/(double)a_nslit; /*OUTPUT APOTHEM*/ + if (a_nslit <= 0) { + fprintf (stderr, "%s: Fatal: no channel in this guide (kh or nslit=0).\n", aVars->compcurname); + exit (-1); + } + if (a_d < 0) { + fprintf (stderr, "%s: Fatal: subdividing walls have negative thickness in this guide (d<0).\n", aVars->compcurname); + exit (-1); + } - for (i=0; i <= 6; aVars->M[i++]=a_m); - if (a_mright >= 0) aVars->M[1] =a_mright; - if (a_mleft >= 0) aVars->M[2] =a_mleft; - if (a_mleftup >= 0) aVars->M[3] =a_mleftup; - if (a_mrightdown >= 0) aVars->M[4] =a_mrightdown; - if (a_mrightup >= 0) aVars->M[5] =a_mrightup; - if (a_mleftdown >= 0) aVars->M[6] =a_mleftdown; + aVars->w1c = 0.5 * (a_w1 - (a_nslit - 1) * 2 * a_d) / (double)a_nslit; /*INPUT APOTHEM*/ + aVars->w2c = 0.5 * (a_w2 - (a_nslit - 1) * 2 * a_d) / (double)a_nslit; /*OUTPUT APOTHEM*/ + + for (i = 0; i <= 6; aVars->M[i++] = a_m) + ; + if (a_mright >= 0) + aVars->M[1] = a_mright; + if (a_mleft >= 0) + aVars->M[2] = a_mleft; + if (a_mleftup >= 0) + aVars->M[3] = a_mleftup; + if (a_mrightdown >= 0) + aVars->M[4] = a_mrightdown; + if (a_mrightup >= 0) + aVars->M[5] = a_mrightup; + if (a_mleftdown >= 0) + aVars->M[6] = a_mleftdown; /* n: normal vectors to surfaces */ - aVars->nx[1] = -a_l; aVars->ny[1] = 0; aVars->nz[1] = (aVars->w2c-aVars->w1c); /* 1:+X right */ - aVars->nx[2] = +a_l; aVars->ny[2] = 0; aVars->nz[2] = -aVars->nz[1]; /* 2:-X left */ - - aVars->nx[3] = +a_l*0.5; aVars->ny[3] = -0.866025*a_l; aVars->nz[3] = (aVars->w2c-aVars->w1c); /* 3:+Y leftup*/ - aVars->nx[4] = -a_l*0.5; aVars->ny[4] = +0.866025*a_l; aVars->nz[4] = -(aVars->w2c-aVars->w1c); /* 4:+Y rightdown*/ - aVars->nx[5] = -a_l*0.5; aVars->ny[5] = -0.866025*a_l; aVars->nz[5] = (aVars->w2c-aVars->w1c); /* 5:+Y rightup */ - aVars->nx[6] = +a_l*0.5; aVars->ny[6] = +0.866025*a_l; aVars->nz[6] = -(aVars->w2c-aVars->w1c); /* 6:+Y leftdown */ - - aVars->nx[7] = 0; aVars->ny[7] = 0; aVars->nz[7] = a_l; - aVars->nx[0] = 0; aVars->ny[0] = 0; aVars->nz[0] = -a_l; + aVars->nx[1] = -a_l; + aVars->ny[1] = 0; + aVars->nz[1] = (aVars->w2c - aVars->w1c); /* 1:+X right */ + aVars->nx[2] = +a_l; + aVars->ny[2] = 0; + aVars->nz[2] = -aVars->nz[1]; /* 2:-X left */ + + aVars->nx[3] = +a_l * 0.5; + aVars->ny[3] = -0.866025 * a_l; + aVars->nz[3] = (aVars->w2c - aVars->w1c); /* 3:+Y leftup*/ + aVars->nx[4] = -a_l * 0.5; + aVars->ny[4] = +0.866025 * a_l; + aVars->nz[4] = -(aVars->w2c - aVars->w1c); /* 4:+Y rightdown*/ + aVars->nx[5] = -a_l * 0.5; + aVars->ny[5] = -0.866025 * a_l; + aVars->nz[5] = (aVars->w2c - aVars->w1c); /* 5:+Y rightup */ + aVars->nx[6] = +a_l * 0.5; + aVars->ny[6] = +0.866025 * a_l; + aVars->nz[6] = -(aVars->w2c - aVars->w1c); /* 6:+Y leftdown */ + + aVars->nx[7] = 0; + aVars->ny[7] = 0; + aVars->nz[7] = a_l; + aVars->nx[0] = 0; + aVars->ny[0] = 0; + aVars->nz[0] = -a_l; /* w: a point on these surfaces */ - aVars->wx[1] = (aVars->w1c); aVars->wy[1] = 0; aVars->wz[1] = 0; /* 1: right */ - aVars->wx[2] = -(aVars->w1c); aVars->wy[2] = 0; aVars->wz[2] = 0; /* 2: left */ - aVars->wx[3] = -0.5*(aVars->w1c); aVars->wy[3] = +0.866025*(aVars->w1c); aVars->wz[3] = 0; /* 3: leftup */ - aVars->wx[4] = +0.5*(aVars->w1c); aVars->wy[4] = -0.866025*(aVars->w1c); aVars->wz[4] = 0; /* 4: rightdown */ - aVars->wx[5] = +0.5*(aVars->w1c); aVars->wy[5] = +0.866025*(aVars->w1c); aVars->wz[5] = 0; /* 5: rightup */ - aVars->wx[6] = -0.5*(aVars->w1c); aVars->wy[6] = -0.866025*(aVars->w1c); aVars->wz[6] = 0; /* 6: leftdown */ - aVars->wx[7] = 0; aVars->wy[7] = 0; aVars->wz[7] = a_l; /* 7:+Z exit */ - aVars->wx[0] = 0; aVars->wy[0] = 0; aVars->wz[0] = 0; /* 0:Z0 input */ - - for (i=0; i <= 7; i++) - { - aVars->A[i] = scalar_prod(aVars->nx[i], aVars->ny[i], aVars->nz[i], aVars->gx, aVars->gy, aVars->gz)/2; - aVars->norm_n2[i] = aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i] + aVars->nz[i]*aVars->nz[i]; - if (aVars->norm_n2[i] <= 0) - { fprintf(stderr,"%s: Fatal: normal vector norm %i is null/negative ! check guide dimensions.\n", aVars->compcurname, i); exit(-1); } /* should never occur */ + aVars->wx[1] = (aVars->w1c); + aVars->wy[1] = 0; + aVars->wz[1] = 0; /* 1: right */ + aVars->wx[2] = -(aVars->w1c); + aVars->wy[2] = 0; + aVars->wz[2] = 0; /* 2: left */ + aVars->wx[3] = -0.5 * (aVars->w1c); + aVars->wy[3] = +0.866025 * (aVars->w1c); + aVars->wz[3] = 0; /* 3: leftup */ + aVars->wx[4] = +0.5 * (aVars->w1c); + aVars->wy[4] = -0.866025 * (aVars->w1c); + aVars->wz[4] = 0; /* 4: rightdown */ + aVars->wx[5] = +0.5 * (aVars->w1c); + aVars->wy[5] = +0.866025 * (aVars->w1c); + aVars->wz[5] = 0; /* 5: rightup */ + aVars->wx[6] = -0.5 * (aVars->w1c); + aVars->wy[6] = -0.866025 * (aVars->w1c); + aVars->wz[6] = 0; /* 6: leftdown */ + aVars->wx[7] = 0; + aVars->wy[7] = 0; + aVars->wz[7] = a_l; /* 7:+Z exit */ + aVars->wx[0] = 0; + aVars->wy[0] = 0; + aVars->wz[0] = 0; /* 0:Z0 input */ + + for (i = 0; i <= 7; i++) { + aVars->A[i] = scalar_prod (aVars->nx[i], aVars->ny[i], aVars->nz[i], aVars->gx, aVars->gy, aVars->gz) / 2; + aVars->norm_n2[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i] + aVars->nz[i] * aVars->nz[i]; + if (aVars->norm_n2[i] <= 0) { + fprintf (stderr, "%s: Fatal: normal vector norm %i is null/negative ! check guide dimensions.\n", aVars->compcurname, i); + exit (-1); + } /* should never occur */ else - aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); } /* partial computations for sides, to save computing time */ - for (i=1; i <= 6; i++) - { - aVars->nzC[i] = aVars->nz[i]; - aVars->norm_n2xy[i]= aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i]; - aVars->Axy[i] =(aVars->nx[i]*aVars->gx + aVars->ny[i]*aVars->gy)/2; + for (i = 1; i <= 6; i++) { + aVars->nzC[i] = aVars->nz[i]; + aVars->norm_n2xy[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i]; + aVars->Axy[i] = (aVars->nx[i] * aVars->gx + aVars->ny[i] * aVars->gy) / 2; } } #pragma acc routine seq - int Honeycomb_guide_Trace(double *dt, - Honeycomb_guide_Vars_type *aVars, - double cx, double cy, double cz, - double cvx, double cvy, double cvz, - double cxnum, int nslit, double cynum) - { + int + Honeycomb_guide_Trace (double* dt, Honeycomb_guide_Vars_type* aVars, double cx, double cy, double cz, double cvx, double cvy, double cvz, double cxnum, + int nslit, double cynum) { double B, C; - int ret=0; - int side=0; + int ret = 0; + int side = 0; double n1; - double dt0, dt_min=0; + double dt0, dt_min = 0; int i; double loc_num; - int i_slope=3; + int i_slope = 3; /* look if there is a previous intersection with guide sides */ /* A = 0.5 n.g; B = n.v; C = n.(r-W); */ /* 5=+Z side: n=(0, 0, -l) ; W = (0, 0, l) (at z=l, guide exit)*/ - B = aVars->nz[7]*cvz; C = aVars->nz[7]*(cz - aVars->wz[7]); - ret = solve_2nd_order(&dt0, NULL, aVars->A[7], B, C); - if (ret && dt0>10e-10) - { dt_min = dt0; side=7; } + B = aVars->nz[7] * cvz; + C = aVars->nz[7] * (cz - aVars->wz[7]); + ret = solve_2nd_order (&dt0, NULL, aVars->A[7], B, C); + if (ret && dt0 > 10e-10) { + dt_min = dt0; + side = 7; + } - loc_num = (3*cynum+cxnum)/2; - for (i=6; i>0; i--) - { - if (i == 4) { i_slope=1; loc_num =(3*cynum-cxnum)/2; } - if (i == 2) { i_slope=1; loc_num = cxnum;} + loc_num = (3 * cynum + cxnum) / 2; + for (i = 6; i > 0; i--) { + if (i == 4) { + i_slope = 1; + loc_num = (3 * cynum - cxnum) / 2; + } + if (i == 2) { + i_slope = 1; + loc_num = cxnum; + } if (aVars->nzC[i_slope] != 0) { - n1=loc_num-1; - loc_num++; loc_num++; - aVars->nz[i] = aVars->nzC[i]*n1; - aVars->A[i] = aVars->Axy[i] + aVars->nz[i]*aVars->gz/2; + n1 = loc_num - 1; + loc_num++; + loc_num++; + aVars->nz[i] = aVars->nzC[i] * n1; + aVars->A[i] = aVars->Axy[i] + aVars->nz[i] * aVars->gz / 2; } - B = aVars->nx[i]*cvx + aVars->ny[i]*cvy + aVars->nz[i]*cvz; /* n.v */ - C = aVars->nx[i]*(cx-aVars->wx[i]) + aVars->ny[i]*(cy-aVars->wy[i]) + aVars->nz[i]*cz; /* n.(r-W) */ - - ret = solve_2nd_order(&dt0, NULL, aVars->A[i], B, C); - if (ret && dt0>10e-10 && (dt0nzC[i] != 0) - { aVars->norm_n2[i] = aVars->norm_n2xy[i] + aVars->nz[i]*aVars->nz[i]; aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); } + B = aVars->nx[i] * cvx + aVars->ny[i] * cvy + aVars->nz[i] * cvz; /* n.v */ + C = aVars->nx[i] * (cx - aVars->wx[i]) + aVars->ny[i] * (cy - aVars->wy[i]) + aVars->nz[i] * cz; /* n.(r-W) */ + + ret = solve_2nd_order (&dt0, NULL, aVars->A[i], B, C); + if (ret && dt0 > 10e-10 && (dt0 < dt_min || !dt_min)) { + dt_min = dt0; + side = i; + if (aVars->nzC[i] != 0) { + aVars->norm_n2[i] = aVars->norm_n2xy[i] + aVars->nz[i] * aVars->nz[i]; + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); + } } - } + } *dt = dt_min; return (side); } -#endif + #endif %} DECLARE %{ Honeycomb_guide_Vars_type GVars; - //#prama acc routine declare create(GVars) + // #prama acc routine declare create(GVars) %} INITIALIZE %{ - double Gx=0, Gy=9.81, Gz=0; + double Gx = 0, Gy = 9.81, Gz = 0; Coords mcLocG; int i; - - if (!w2) w2=w1; - if (W < 0 || nslit <= 0 || R0 < 0 || Qc < 0) - { fprintf(stderr,"%s:Guide_gravity: W nslit R0 Qc must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } + if (!w2) + w2 = w1; + + if (W < 0 || nslit <= 0 || R0 < 0 || Qc < 0) { + fprintf (stderr, "%s:Guide_gravity: W nslit R0 Qc must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } - if (mcgravitation) G=-9.81; - mcLocG = rot_apply(ROT_A_CURRENT_COMP, coords_set(Gx,G,Gz)); - coords_get(mcLocG, &Gx, &Gy, &Gz); + if (mcgravitation) + G = -9.81; + mcLocG = rot_apply (ROT_A_CURRENT_COMP, coords_set (Gx, G, Gz)); + coords_get (mcLocG, &Gx, &Gy, &Gz); - strcpy(GVars.compcurname, NAME_CURRENT_COMP); - Honeycomb_guide_Init(&GVars, - w1, w2, l, R0, - Qc, alpha, m, W, nslit, d, - Gx, Gy, Gz,mright, mleft, mleftup, mrightdown, mrightup, mleftdown); + strcpy (GVars.compcurname, NAME_CURRENT_COMP); + Honeycomb_guide_Init (&GVars, w1, w2, l, R0, Qc, alpha, m, W, nslit, d, Gx, Gy, Gz, mright, mleft, mleftup, mrightdown, mrightup, mleftdown); - if (!G) for (i=0; i<7; GVars.A[i++] = 0); - //#pragma acc update device(GVars) + if (!G) + for (i = 0; i < 7; GVars.A[i++] = 0) + ; + // #pragma acc update device(GVars) %} TRACE %{ double B, C, dt; - int ret, bounces = 0; - float n,m1,nv,mv; - int nup=-1, mright1=-1; - double xhole,yhole, y_min; + int ret, bounces = 0; + float n, m1, nv, mv; + int nup = -1, mright1 = -1; + double xhole, yhole, y_min; double cn; double inside; double w_edge, w_adj; /* Channel displacement */ double h_edge, h_adj; - double w_chnum,h_chnum,w_c,h_c; /* channel indexes */ + double w_chnum, h_chnum, w_c, h_c; /* channel indexes */ /* propagate to box input (with gravitation) in comp local coords */ /* 0=Z0 side: n=(0, 0, l) ; W = (0, 0, 0) (at z=0, guide input)*/ - B = -l*vz; C = -l*z; + B = -l * vz; + C = -l * z; - ret = solve_2nd_order(&dt, NULL, GVars.A[0], B, C); - if (ret && dt>0) - { - PROP_GRAV_DT(dt, GVars.gx, GVars.gy, GVars.gz); + ret = solve_2nd_order (&dt, NULL, GVars.A[0], B, C); + if (ret && dt > 0) { + PROP_GRAV_DT (dt, GVars.gx, GVars.gy, GVars.gz); GVars.N_reflection[8]++; } /* check if we are in the box input, else absorb */ - if(dt > 0 && fabs(x) <= w1/2 && fabs(y) <= w1/2) - { - for(n=0; x>((2*n+1)*(GVars.w1c+d)) ; n++); nv=n; - if (n==0) { for(n=0; x<((2*n-1)*(GVars.w1c+d)); n--); nv=n; } - - xhole=2*n*(GVars.w1c+d); - if(x-xhole>0) nup=1; - y_min=1.732*(GVars.w1c+d); + if (dt > 0 && fabs (x) <= w1 / 2 && fabs (y) <= w1 / 2) { + for (n = 0; x > ((2 * n + 1) * (GVars.w1c + d)); n++) + ; + nv = n; + if (n == 0) { + for (n = 0; x < ((2 * n - 1) * (GVars.w1c + d)); n--) + ; + nv = n; + } - for(m1=0;y>((2*m1+1)*y_min); m1++); mv=m1; - if (m1==0) { for (m1=0; y<((2*m1-1)*(y_min)); m1--); mv=m1; } + xhole = 2 * n * (GVars.w1c + d); + if (x - xhole > 0) + nup = 1; + y_min = 1.732 * (GVars.w1c + d); + + for (m1 = 0; y > ((2 * m1 + 1) * y_min); m1++) + ; + mv = m1; + if (m1 == 0) { + for (m1 = 0; y < ((2 * m1 - 1) * (y_min)); m1--) + ; + mv = m1; + } - yhole=2*m1*1.732*(GVars.w1c+d); - if(y-yhole>0) mright1=1; + yhole = 2 * m1 * 1.732 * (GVars.w1c + d); + if (y - yhole > 0) + mright1 = 1; - cn=1.1547*(GVars.w1c+d); - inside=(fabs(y-yhole)+0.577351*fabs(x-xhole)-cn); - if(inside>0) - { - xhole +=nup*(GVars.w1c+d); - yhole +=mright1*(1.732*(GVars.w1c+d)); + cn = 1.1547 * (GVars.w1c + d); + inside = (fabs (y - yhole) + 0.577351 * fabs (x - xhole) - cn); + if (inside > 0) { + xhole += nup * (GVars.w1c + d); + yhole += mright1 * (1.732 * (GVars.w1c + d)); } /* double w_chnum,h_chnum;*/ /* channel indexes */ /* Shift origin to center of channel hit (absorb if hit dividing walls) */ - w_c=xhole/(GVars.w1c+d); - h_c=yhole/(1.732*(GVars.w1c+d)); - w_chnum=rint(w_c); - h_chnum=rint(h_c); + w_c = xhole / (GVars.w1c + d); + h_c = yhole / (1.732 * (GVars.w1c + d)); + w_chnum = rint (w_c); + h_chnum = rint (h_c); - x -=xhole; - y -=yhole; + x -= xhole; + y -= yhole; w_adj = xhole; h_adj = yhole; - if(fabs(x) > GVars.w1c) - { + if (fabs (x) > GVars.w1c) { x += xhole; /* Re-adjust origin */ y += yhole; ABSORB; } - if(fabs(x*0.5+y*0.866025) > GVars.w1c) - { + if (fabs (x * 0.5 + y * 0.866025) > GVars.w1c) { x += xhole; /* Re-adjust origin */ y += yhole; ABSORB; } - if(fabs(-x*0.5+y*0.866025) > GVars.w1c) - { + if (fabs (-x * 0.5 + y * 0.866025) > GVars.w1c) { x += xhole; /* Re-adjust origin */ y += yhole; ABSORB; @@ -346,161 +410,146 @@ TRACE /* neutron is now in the input window of the guide */ /* do loops on reflections in the box */ - for(;;) - { + for (;;) { /* get intersections for all box sides */ double q; - int side=0; + int side = 0; bounces++; /* now look for intersection with guide sides and exit */ - side = Honeycomb_guide_Trace(&dt, &GVars, x, y, z, - vx, vy, vz, w_chnum, nslit, h_chnum); + side = Honeycomb_guide_Trace (&dt, &GVars, x, y, z, vx, vy, vz, w_chnum, nslit, h_chnum); /* only positive dt are valid */ /* exit reflection loops if no intersection (neutron is after box) */ - if (side == 0 || dt <= 0) - { if (GVars.warnings < 100) - fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); - GVars.warnings++; - x += w_adj; y += h_adj; ABSORB; } /* should never occur */ + if (side == 0 || dt <= 0) { + if (GVars.warnings < 100) + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); + GVars.warnings++; + x += w_adj; + y += h_adj; + ABSORB; + } /* should never occur */ /* propagate to dt */ - PROP_GRAV_DT(dt, GVars.gx, GVars.gy, GVars.gz); + PROP_GRAV_DT (dt, GVars.gx, GVars.gy, GVars.gz); /* do reflection on speed for l/r/u/d sides */ if (side == 7) /* neutron reaches end of guide: end loop and exit comp */ - { GVars.N_reflection[side]++; x += w_adj; y += h_adj; SCATTER; x -= w_adj; y -= h_adj; break; } + { + GVars.N_reflection[side]++; + x += w_adj; + y += h_adj; + SCATTER; + x -= w_adj; + y -= h_adj; + break; + } /* else reflection on a guide wall */ - if(GVars.M[side] == 0 || Qc == 0) /* walls are absorbing */ - { x += w_adj; y += h_adj; ABSORB; } + if (GVars.M[side] == 0 || Qc == 0) /* walls are absorbing */ + { + x += w_adj; + y += h_adj; + ABSORB; + } /* change/mirror velocity: h_f = v - n.2*n.v/|n|^2 */ - B = GVars.nx[side]*vx + GVars.ny[side]*vy + GVars.nz[side]*vz; /* n.v */ - GVars.N_reflection[side]++; /* GVars.norm_n2 > 0 was checked at INIT */ - dt = 2*B/GVars.norm_n2[side]; /* 2*n.v/|n|^2 */ - vx -= GVars.nx[side]*dt; - vy -= GVars.ny[side]*dt; - vz -= GVars.nz[side]*dt; + B = GVars.nx[side] * vx + GVars.ny[side] * vy + GVars.nz[side] * vz; /* n.v */ + GVars.N_reflection[side]++; /* GVars.norm_n2 > 0 was checked at INIT */ + dt = 2 * B / GVars.norm_n2[side]; /* 2*n.v/|n|^2 */ + vx -= GVars.nx[side] * dt; + vy -= GVars.ny[side] * dt; + vz -= GVars.nz[side] * dt; /* compute q and modify neutron weight */ /* scattering q=|nslit_i-nslit_f| = V2Q*|vf - v| = V2Q*2*n.v/|n| */ - q = 2*V2Q*fabs(B)/GVars.norm_n[side]; + q = 2 * V2Q * fabs (B) / GVars.norm_n[side]; { - double par[] = {R0, Qc, alpha, GVars.M[side], W}; - StdReflecFunc(q, par, &B); + double par[] = { R0, Qc, alpha, GVars.M[side], W }; + StdReflecFunc (q, par, &B); } - if (B <= 0) { x += w_adj; y += h_adj; ABSORB; } - else p *= B; - x += w_adj; y += h_adj; SCATTER; x -= w_adj; y -= h_adj; + if (B <= 0) { + x += w_adj; + y += h_adj; + ABSORB; + } else + p *= B; + x += w_adj; + y += h_adj; + SCATTER; + x -= w_adj; + y -= h_adj; GVars.N_reflection[0]++; /* go to the next reflection */ - if (bounces > 1000) ABSORB; + if (bounces > 1000) + ABSORB; } /* end for */ - x += w_adj; y += h_adj; /* Re-adjust origin after SCATTER */ - } - else + x += w_adj; + y += h_adj; /* Re-adjust origin after SCATTER */ + } else ABSORB; %} FINALLY %{ -if (GVars.warnings > 100) { - fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); - fprintf(stderr,"%s: warning: This message has been repeated %g times\n", GVars.compcurname, GVars.warnings); -} + if (GVars.warnings > 100) { + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", GVars.compcurname); + fprintf (stderr, "%s: warning: This message has been repeated %g times\n", GVars.compcurname, GVars.warnings); + } %} MCDISPLAY %{ - int i,j; - double a,b,c; - double x0,x01,x1,x11,x2,x21; - double y0,y01,y1,y11,y2,y21,y3,y31,y4,y41; - - - - for(j = -nslit/2; j <= nslit/2; j++) - { - y0 = j*(GVars.w1c+d)*1.732; - y01= j*(GVars.w2c+d)*1.732; - y1 =y0 +(GVars.w1c+d)/1.732; - y11=y01+(GVars.w2c+d)/1.732; - y2 =y0 -(GVars.w1c+d)/1.732; - y21=y01-(GVars.w2c+d)/1.732; - y3 =y0 +(GVars.w1c+d)*1.1547; - y31=y01+(GVars.w2c+d)*1.1547; - y4 =y0 -(GVars.w1c+d)*1.1547; - y41=y01-(GVars.w2c+d)*1.1547; - - for(i = -nslit; i <= nslit; i++) + int i, j; + double a, b, c; + double x0, x01, x1, x11, x2, x21; + double y0, y01, y1, y11, y2, y21, y3, y31, y4, y41; + + for (j = -nslit / 2; j <= nslit / 2; j++) { + y0 = j * (GVars.w1c + d) * 1.732; + y01 = j * (GVars.w2c + d) * 1.732; + y1 = y0 + (GVars.w1c + d) / 1.732; + y11 = y01 + (GVars.w2c + d) / 1.732; + y2 = y0 - (GVars.w1c + d) / 1.732; + y21 = y01 - (GVars.w2c + d) / 1.732; + y3 = y0 + (GVars.w1c + d) * 1.1547; + y31 = y01 + (GVars.w2c + d) * 1.1547; + y4 = y0 - (GVars.w1c + d) * 1.1547; + y41 = y01 - (GVars.w2c + d) * 1.1547; + + for (i = -nslit; i <= nslit; i++) { - a=i+j; - b=a/2+0.1; - c=rint(b); + a = i + j; + b = a / 2 + 0.1; + c = rint (b); - if(fabs(c-b)<0.3) + if (fabs (c - b) < 0.3) { - x0 = i*(GVars.w1c+d); - x01= i*(GVars.w2c+d); - x1 =x0 +(GVars.w1c+d); - x11=x01+(GVars.w2c+d); - x2 =x0 -(GVars.w1c+d); - x21=x01-(GVars.w2c+d); - - - multiline(5, - x1, y1, 0.0, - x11, y11, (double)l, - x21, y11, (double)l, - x2, y1, 0.0, - x1, y1, 0.0); - - - multiline(5, - x1, y1, 0.0, - x11, y11, (double)l, - x01, y31, (double)l, - x0, y3, 0.0, - x1, y1, 0.0); - - multiline(5, - x0, y3, 0.0, - x01, y31, (double)l, - x21, y11, (double)l, - x2, y1, 0.0, - x0, y3, 0.0); - - multiline(5, - x2, y1, 0.0, - x21, y11, (double)l, - x21, y21, (double)l, - x2, y2, 0.0, - x2, y1, 0.0); - - multiline(5, - x2, y2, 0.0, - x21, y21, (double)l, - x01, y41, (double)l, - x0, y4, 0.0, - x2, y2, 0.0); - - multiline(5, - x0, y4, 0.0, - x01, y41, (double)l, - x11, y21, (double)l, - x1, y2, 0.0, - x0, y4, 0.0); - - } - } - } + x0 = i * (GVars.w1c + d); + x01 = i * (GVars.w2c + d); + x1 = x0 + (GVars.w1c + d); + x11 = x01 + (GVars.w2c + d); + x2 = x0 - (GVars.w1c + d); + x21 = x01 - (GVars.w2c + d); + + multiline (5, x1, y1, 0.0, x11, y11, (double)l, x21, y11, (double)l, x2, y1, 0.0, x1, y1, 0.0); + + multiline (5, x1, y1, 0.0, x11, y11, (double)l, x01, y31, (double)l, x0, y3, 0.0, x1, y1, 0.0); + + multiline (5, x0, y3, 0.0, x01, y31, (double)l, x21, y11, (double)l, x2, y1, 0.0, x0, y3, 0.0); + + multiline (5, x2, y1, 0.0, x21, y11, (double)l, x21, y21, (double)l, x2, y2, 0.0, x2, y1, 0.0); + multiline (5, x2, y2, 0.0, x21, y21, (double)l, x01, y41, (double)l, x0, y4, 0.0, x2, y2, 0.0); + + multiline (5, x0, y4, 0.0, x01, y41, (double)l, x11, y21, (double)l, x1, y2, 0.0, x0, y4, 0.0); + } + } + } %} END diff --git a/mcstas-comps/contrib/Guide_m.comp b/mcstas-comps/contrib/Guide_m.comp index 345b74dc7..834927797 100644 --- a/mcstas-comps/contrib/Guide_m.comp +++ b/mcstas-comps/contrib/Guide_m.comp @@ -110,42 +110,46 @@ DECLARE INITIALIZE %{ - if (mcgravitation) fprintf(stderr,"WARNING: Guide: %s: " - "This component produces wrong results with gravitation !\n" - "Use Guide_gravity.\n", - NAME_CURRENT_COMP); + if (mcgravitation) + fprintf (stderr, + "WARNING: Guide: %s: " + "This component produces wrong results with gravitation !\n" + "Use Guide_gravity.\n", + NAME_CURRENT_COMP); - if (reflect && strlen(reflect)) { - if (Table_Read(&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"Guide: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); + if (reflect && strlen (reflect)) { + if (Table_Read (&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Guide: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); } else { - if (W_left < 0 || W_right < 0 || W_top < 0 || W_bottom < 0 || R0_left < 0 ||R0_right < 0 || R0_top < 0 || R0_bottom < 0 || Qc_left < 0 || Qc_right < 0 || Qc_top < 0 || Qc_bottom < 0 || m_left < 0 || m_right < 0 || m_top < 0 || m_bottom < 0) - { fprintf(stderr,"Guide: %s: W R0 Qc must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } - if (m_left < 1 && m_left != 0) fprintf(stderr,"WARNING: Guide: %s: m_left < 1 behaves as if m=1.\n", - NAME_CURRENT_COMP); - if (m_right < 1 && m_right != 0) fprintf(stderr,"WARNING: Guide: %s: m_right < 1 behaves as if m=1.\n", - NAME_CURRENT_COMP); - if (m_top < 1 && m_top != 0) fprintf(stderr,"WARNING: Guide: %s: m_top < 1 behaves as if m=1.\n", - NAME_CURRENT_COMP); - if (m_bottom < 1 && m_bottom != 0) fprintf(stderr,"WARNING: Guide: %s: m_bottom < 1 behaves as if m=1.\n", - NAME_CURRENT_COMP); + if (W_left < 0 || W_right < 0 || W_top < 0 || W_bottom < 0 || R0_left < 0 || R0_right < 0 || R0_top < 0 || R0_bottom < 0 || Qc_left < 0 || Qc_right < 0 + || Qc_top < 0 || Qc_bottom < 0 || m_left < 0 || m_right < 0 || m_top < 0 || m_bottom < 0) { + fprintf (stderr, "Guide: %s: W R0 Qc must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } + if (m_left < 1 && m_left != 0) + fprintf (stderr, "WARNING: Guide: %s: m_left < 1 behaves as if m=1.\n", NAME_CURRENT_COMP); + if (m_right < 1 && m_right != 0) + fprintf (stderr, "WARNING: Guide: %s: m_right < 1 behaves as if m=1.\n", NAME_CURRENT_COMP); + if (m_top < 1 && m_top != 0) + fprintf (stderr, "WARNING: Guide: %s: m_top < 1 behaves as if m=1.\n", NAME_CURRENT_COMP); + if (m_bottom < 1 && m_bottom != 0) + fprintf (stderr, "WARNING: Guide: %s: m_bottom < 1 behaves as if m=1.\n", NAME_CURRENT_COMP); } %} TRACE %{ - double t1,t2; /* Intersection times. */ - double av,ah,bv,bh,cv1,cv2,ch1,ch2,d; /* Intermediate values */ - double weight; /* Internal probability weight */ - double vdotn_v1,vdotn_v2,vdotn_h1,vdotn_h2; /* Dot products. */ - int i; /* Which mirror hit? */ - double q; /* Q [1/AA] of reflection */ - double nlen2; /* Vector lengths squared */ + double t1, t2; /* Intersection times. */ + double av, ah, bv, bh, cv1, cv2, ch1, ch2, d; /* Intermediate values */ + double weight; /* Internal probability weight */ + double vdotn_v1, vdotn_v2, vdotn_h1, vdotn_h2; /* Dot products. */ + int i; /* Which mirror hit? */ + double q; /* Q [1/AA] of reflection */ + double nlen2; /* Vector lengths squared */ /* ToDo: These could be precalculated. */ - double ww = .5*(w2 - w1), hh = .5*(h2 - h1); - double whalf = .5*w1, hhalf = .5*h1; + double ww = .5 * (w2 - w1), hh = .5 * (h2 - h1); + double whalf = .5 * w1, hhalf = .5 * h1; /* Propagate neutron to guide entrance. */ PROP_Z0; @@ -153,110 +157,107 @@ TRACE absorbed in a GROUP construction, e.g. all neutrons - even the later absorbed ones are scattered at the guide entry. */ SCATTER; - if(x <= -whalf || x >= whalf || y <= -hhalf || y >= hhalf) + if (x <= -whalf || x >= whalf || y <= -hhalf || y >= hhalf) ABSORB; - for(;;) - { + for (;;) { /* Compute the dot products of v and n for the four mirrors. */ - av = l*vx; bv = ww*vz; - ah = l*vy; bh = hh*vz; - vdotn_v1 = bv + av; /* Left vertical */ - vdotn_v2 = bv - av; /* Right vertical */ - vdotn_h1 = bh + ah; /* Lower horizontal */ - vdotn_h2 = bh - ah; /* Upper horizontal */ + av = l * vx; + bv = ww * vz; + ah = l * vy; + bh = hh * vz; + vdotn_v1 = bv + av; /* Left vertical */ + vdotn_v2 = bv - av; /* Right vertical */ + vdotn_h1 = bh + ah; /* Lower horizontal */ + vdotn_h2 = bh - ah; /* Upper horizontal */ /* Compute the dot products of (O - r) and n as c1+c2 and c1-c2 */ - cv1 = -whalf*l - z*ww; cv2 = x*l; - ch1 = -hhalf*l - z*hh; ch2 = y*l; + cv1 = -whalf * l - z * ww; + cv2 = x * l; + ch1 = -hhalf * l - z * hh; + ch2 = y * l; /* Compute intersection times. */ - t1 = (l - z)/vz; + t1 = (l - z) / vz; i = 0; - if(vdotn_v1 < 0 && (t2 = (cv1 - cv2)/vdotn_v1) < t1) - { + if (vdotn_v1 < 0 && (t2 = (cv1 - cv2) / vdotn_v1) < t1) { t1 = t2; i = 1; } - if(vdotn_v2 < 0 && (t2 = (cv1 + cv2)/vdotn_v2) < t1) - { + if (vdotn_v2 < 0 && (t2 = (cv1 + cv2) / vdotn_v2) < t1) { t1 = t2; i = 2; } - if(vdotn_h1 < 0 && (t2 = (ch1 - ch2)/vdotn_h1) < t1) - { + if (vdotn_h1 < 0 && (t2 = (ch1 - ch2) / vdotn_h1) < t1) { t1 = t2; i = 3; } - if(vdotn_h2 < 0 && (t2 = (ch1 + ch2)/vdotn_h2) < t1) - { + if (vdotn_h2 < 0 && (t2 = (ch1 + ch2) / vdotn_h2) < t1) { t1 = t2; i = 4; } - if(i == 0) - break; /* Neutron left guide. */ - PROP_DT(t1); - switch(i) - { - case 1: /* Left vertical mirror */ - nlen2 = l*l + ww*ww; - q = V2Q*(-2)*vdotn_v1/sqrt(nlen2); - d = 2*vdotn_v1/nlen2; - vx = vx - d*l; - vz = vz - d*ww; - m = m_left; - Qc = Qc_left; - W = W_left; - alpha= alpha_left; - R0= R0_left; - break; - case 2: /* Right vertical mirror */ - nlen2 = l*l + ww*ww; - q = V2Q*(-2)*vdotn_v2/sqrt(nlen2); - d = 2*vdotn_v2/nlen2; - vx = vx + d*l; - vz = vz - d*ww; - m = m_right; - Qc = Qc_right; - W = W_right; - alpha= alpha_right; - R0= R0_right; - break; - case 3: /* Lower horizontal mirror */ - nlen2 = l*l + hh*hh; - q = V2Q*(-2)*vdotn_h1/sqrt(nlen2); - d = 2*vdotn_h1/nlen2; - vy = vy - d*l; - vz = vz - d*hh; - m = m_bottom; - Qc = Qc_bottom; - W = W_bottom; - alpha= alpha_bottom; - R0= R0_bottom; - break; - case 4: /* Upper horizontal mirror */ - nlen2 = l*l + hh*hh; - q = V2Q*(-2)*vdotn_h2/sqrt(nlen2); - d = 2*vdotn_h2/nlen2; - vy = vy + d*l; - vz = vz - d*hh; - m = m_top; - Qc = Qc_top; - W = W_top; - alpha= alpha_top; - R0= R0_top; - break; + if (i == 0) + break; /* Neutron left guide. */ + PROP_DT (t1); + switch (i) { + case 1: /* Left vertical mirror */ + nlen2 = l * l + ww * ww; + q = V2Q * (-2) * vdotn_v1 / sqrt (nlen2); + d = 2 * vdotn_v1 / nlen2; + vx = vx - d * l; + vz = vz - d * ww; + m = m_left; + Qc = Qc_left; + W = W_left; + alpha = alpha_left; + R0 = R0_left; + break; + case 2: /* Right vertical mirror */ + nlen2 = l * l + ww * ww; + q = V2Q * (-2) * vdotn_v2 / sqrt (nlen2); + d = 2 * vdotn_v2 / nlen2; + vx = vx + d * l; + vz = vz - d * ww; + m = m_right; + Qc = Qc_right; + W = W_right; + alpha = alpha_right; + R0 = R0_right; + break; + case 3: /* Lower horizontal mirror */ + nlen2 = l * l + hh * hh; + q = V2Q * (-2) * vdotn_h1 / sqrt (nlen2); + d = 2 * vdotn_h1 / nlen2; + vy = vy - d * l; + vz = vz - d * hh; + m = m_bottom; + Qc = Qc_bottom; + W = W_bottom; + alpha = alpha_bottom; + R0 = R0_bottom; + break; + case 4: /* Upper horizontal mirror */ + nlen2 = l * l + hh * hh; + q = V2Q * (-2) * vdotn_h2 / sqrt (nlen2); + d = 2 * vdotn_h2 / nlen2; + vy = vy + d * l; + vz = vz - d * hh; + m = m_top; + Qc = Qc_top; + W = W_top; + alpha = alpha_top; + R0 = R0_top; + break; } /* Now compute reflectivity. */ weight = 1.0; /* Initial internal weight factor */ - if(m == 0) + if (m == 0) ABSORB; - if (reflect && strlen(reflect)) - weight = Table_Value(pTable, q, 1); - else if(q > Qc) - { - double arg = (q-m*Qc)/W; - if(arg < 10) - weight = .5*(1-tanh(arg))*(1-alpha*(q-Qc)); + if (reflect && strlen (reflect)) + weight = Table_Value (pTable, q, 1); + else if (q > Qc) { + double arg = (q - m * Qc) / W; + if (arg < 10) + weight = .5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc)); else - ABSORB; /* Cutoff ~ 1E-10 */ + ABSORB; /* Cutoff ~ 1E-10 */ weight *= R0; } else { /* q <= Qc */ weight *= R0; @@ -269,22 +270,13 @@ TRACE MCDISPLAY %{ - multiline(5, - -w1/2.0, -h1/2.0, 0.0, - w1/2.0, -h1/2.0, 0.0, - w1/2.0, h1/2.0, 0.0, - -w1/2.0, h1/2.0, 0.0, - -w1/2.0, -h1/2.0, 0.0); - multiline(5, - -w2/2.0, -h2/2.0, (double)l, - w2/2.0, -h2/2.0, (double)l, - w2/2.0, h2/2.0, (double)l, - -w2/2.0, h2/2.0, (double)l, - -w2/2.0, -h2/2.0, (double)l); - line(-w1/2.0, -h1/2.0, 0, -w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, -h1/2.0, 0, w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, h1/2.0, 0, w2/2.0, h2/2.0, (double)l); - line(-w1/2.0, h1/2.0, 0, -w2/2.0, h2/2.0, (double)l); + multiline (5, -w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, -h1 / 2.0, 0.0); + multiline (5, -w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, + -h2 / 2.0, (double)l); + line (-w1 / 2.0, -h1 / 2.0, 0, -w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, -h1 / 2.0, 0, w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, h1 / 2.0, 0, w2 / 2.0, h2 / 2.0, (double)l); + line (-w1 / 2.0, h1 / 2.0, 0, -w2 / 2.0, h2 / 2.0, (double)l); %} END diff --git a/mcstas-comps/contrib/Guide_multichannel.comp b/mcstas-comps/contrib/Guide_multichannel.comp index 7056e3f4f..8f27234ee 100644 --- a/mcstas-comps/contrib/Guide_multichannel.comp +++ b/mcstas-comps/contrib/Guide_multichannel.comp @@ -101,22 +101,22 @@ void getRefPar(double par[], double R0, double Qc, double alpha, double m, doubl %} DECLARE %{ - /* + /* Absorption formula: - mu = A*lambda + s_free*(1 - exp(-B/lambda^2 - D/lambda^4) - following coefficients in mu_par array correspond to { s_free, A, B, D } - Units: - s_free [1/cm] - A [1/cm/A] - B [A^2] - D [A^4] + mu = A*lambda + s_free*(1 - exp(-B/lambda^2 - D/lambda^4) + following coefficients in mu_par array correspond to { s_free, A, B, D } + Units: + s_free [1/cm] + A [1/cm/A] + B [A^2] + D [A^4] */ - /* Si at room temperature */ - //const double mu_Si[4]; - /* Al2O3 (sapphire) at room temperature */ - //const double mu_Al2O3[4]; - /* default - high absorption */ - //const double mu_default[4]; + /* Si at room temperature */ + // const double mu_Si[4]; + /* Al2O3 (sapphire) at room temperature */ + // const double mu_Al2O3[4]; + /* default - high absorption */ + // const double mu_default[4]; double w1c; double w2c; double ww; @@ -137,272 +137,298 @@ DECLARE INITIALIZE %{ - static const double mu_Si[4] = {0.1018, 6.054e-3, 0.38, 0.0}; - static const double mu_Al2O3[4] = {0.2120, 8.11e-3, 0.16, 0.129}; - static const double mu_default[4] = {100.0, 100.0, 100.0, 100.0}; - getRefPar(refpar_x,R0, Qcx, alphax, mx, W); - getRefPar(refpar_y,R0, Qcy, alphay, my, W); + static const double mu_Si[4] = { 0.1018, 6.054e-3, 0.38, 0.0 }; + static const double mu_Al2O3[4] = { 0.2120, 8.11e-3, 0.16, 0.129 }; + static const double mu_default[4] = { 100.0, 100.0, 100.0, 100.0 }; + getRefPar (refpar_x, R0, Qcx, alphax, mx, W); + getRefPar (refpar_y, R0, Qcy, alphay, my, W); /* lambda = v2lam/v */ - v2lam=2*PI/V2K; - + v2lam = 2 * PI / V2K; + /* Set absorption coefficient */ - memcpy(mu_par, mu_default, sizeof(mu_par)); - opaque=1; - if (nslit>1) { - if (strcmp(mater,"Si") ==0) { - memcpy(mu_par, mu_Si, sizeof(mu_par)); - opaque=0; - } else if (strcmp(mater,"Al2O3") ==0) { - memcpy(mu_par, mu_Al2O3, sizeof(mu_par)); - opaque=0; - } + memcpy (mu_par, mu_default, sizeof (mu_par)); + opaque = 1; + if (nslit > 1) { + if (strcmp (mater, "Si") == 0) { + memcpy (mu_par, mu_Si, sizeof (mu_par)); + opaque = 0; + } else if (strcmp (mater, "Al2O3") == 0) { + memcpy (mu_par, mu_Al2O3, sizeof (mu_par)); + opaque = 0; + } } if (opaque) { - printf("%s: Absorbing blades.\n",NAME_CURRENT_COMP); + printf ("%s: Absorbing blades.\n", NAME_CURRENT_COMP); } else { - ww = mu_par[1]*2 + mu_par[0]*(1.0 - exp(-mu_par[2]/4 - mu_par[3]/16)); - printf("%s: Translucent blades, %s, mu(2A) = %g [1/cm].\n",NAME_CURRENT_COMP,mater,ww); + ww = mu_par[1] * 2 + mu_par[0] * (1.0 - exp (-mu_par[2] / 4 - mu_par[3] / 16)); + printf ("%s: Translucent blades, %s, mu(2A) = %g [1/cm].\n", NAME_CURRENT_COMP, mater, ww); } - printf("%s: nslit=%d\n",NAME_CURRENT_COMP,nslit); - + printf ("%s: nslit=%d\n", NAME_CURRENT_COMP, nslit); + /* process input data */ - if (!w2) w2=w1; - if (!h2) h2=h1; - if (nslit <= 0) - { fprintf(stderr,"Guide_multichannel: %s: nslit must be positive\n", NAME_CURRENT_COMP); - exit(-1); } - if (m) { mx=my=m; } - if (Qc) { Qcx=Qcy=Qc; } - if (alpha) { alphax=alphay=alpha; } - w1c = (w1 + dlam)/(double)nslit; - w2c = (w2 + dlam)/(double)nslit; - ww = .5*(w2 - w1); - hh = .5*(h2 - h1); + if (!w2) + w2 = w1; + if (!h2) + h2 = h1; + if (nslit <= 0) { + fprintf (stderr, "Guide_multichannel: %s: nslit must be positive\n", NAME_CURRENT_COMP); + exit (-1); + } + if (m) { + mx = my = m; + } + if (Qc) { + Qcx = Qcy = Qc; + } + if (alpha) { + alphax = alphay = alpha; + } + w1c = (w1 + dlam) / (double)nslit; + w2c = (w2 + dlam) / (double)nslit; + ww = .5 * (w2 - w1); + hh = .5 * (h2 - h1); winner = w1c - dlam; // width of one channel at the entry - whalf = .5*winner; - hhalf = .5*h1; - av = hh/l; // angular deflection of top(+)/bottom(-) walls - ah = ww/l; // angular deflection of left(+)/right(-) walls - dah = (w2-w1)/(l*nslit); // angular step between blades - + whalf = .5 * winner; + hhalf = .5 * h1; + av = hh / l; // angular deflection of top(+)/bottom(-) walls + ah = ww / l; // angular deflection of left(+)/right(-) walls + dah = (w2 - w1) / (l * nslit); // angular step between blades - - if (dlam*nslit >= w1+dlam) exit(fprintf(stderr, "Guide_multichannel: %s: No space left for channels, " - "blades are too thick, (dlam*nslit >= w1+dlam).\n", NAME_CURRENT_COMP)); + if (dlam * nslit >= w1 + dlam) + exit (fprintf (stderr, + "Guide_multichannel: %s: No space left for channels, " + "blades are too thick, (dlam*nslit >= w1+dlam).\n", + NAME_CURRENT_COMP)); - if (mcgravitation) fprintf(stderr,"WARNING: Guide_multichannel: %s: " - "This component produces wrong results with gravitation.\n",NAME_CURRENT_COMP); + if (mcgravitation) + fprintf (stderr, + "WARNING: Guide_multichannel: %s: " + "This component produces wrong results with gravitation.\n", + NAME_CURRENT_COMP); %} TRACE %{ - double tt,tout; - double a1,b1,a2,b2; // side wall equation (right, left) - double vdotn, mu, q, edge,N0,v0, p0, p1, lam0, lam2, lam4; - double ref,rtmp; - int ic; // which wall hit ? - int is; // channel index - int inblade; // flags - int i,nloop; + double tt, tout; + double a1, b1, a2, b2; // side wall equation (right, left) + double vdotn, mu, q, edge, N0, v0, p0, p1, lam0, lam2, lam4; + double ref, rtmp; + int ic; // which wall hit ? + int is; // channel index + int inblade; // flags + int i, nloop; double tc[4]; // Intersection times - double N[3]; // surface normal - + double N[3]; // surface normal /* Propagate neutron to the guide entrance. */ PROP_Z0; /* Call Scatter at the guide entry, needed for GROUP construction. */ SCATTER; /* apply front mask */ - if(fabs(x) >= w1/2.0 || fabs(y) >= hhalf) + if (fabs (x) >= w1 / 2.0 || fabs (y) >= hhalf) ABSORB; - /* slit index + /* slit index Each slit includes the empty chanel of width = winner + the wall on the left/top side */ - is=floor((x+0.5*w1)/w1c); + is = floor ((x + 0.5 * w1) / w1c); /* right edge of the channel */ - edge = is*w1c - 0.5*w1; - inblade=(x-edge>winner ? 1:0); // is inside the blade ? + edge = is * w1c - 0.5 * w1; + inblade = (x - edge > winner ? 1 : 0); // is inside the blade ? if (inblade && opaque) { - ABSORB; + ABSORB; } /* wall equation: x = a + b*z */ if (inblade) { - a1=edge+winner; b1=(is+1)*dah-ah; // right wall - a2=a1+dlam;b2=b1; // left wall + a1 = edge + winner; + b1 = (is + 1) * dah - ah; // right wall + a2 = a1 + dlam; + b2 = b1; // left wall } else { - a1=edge; b1=is*dah-ah; // right wall - a2=edge+winner; b2=b1+dah; // left wall + a1 = edge; + b1 = is * dah - ah; // right wall + a2 = edge + winner; + b2 = b1 + dah; // left wall } - v0=sqrt(vx*vx+vy*vy+vz*vz); - nloop=0; + v0 = sqrt (vx * vx + vy * vy + vz * vz); + nloop = 0; if (opaque) { - mu = 1e10; + mu = 1e10; } else { - lam0=v2lam/v0; - lam2=lam0*lam0; - lam4=lam2*lam2; - mu = mu_par[1]*lam0 + mu_par[0]*(1.0 - exp( - mu_par[2]/lam2 - mu_par[3]/lam4)); - mu *= 100.0; // convert to m^-1 + lam0 = v2lam / v0; + lam2 = lam0 * lam0; + lam4 = lam2 * lam2; + mu = mu_par[1] * lam0 + mu_par[0] * (1.0 - exp (-mu_par[2] / lam2 - mu_par[3] / lam4)); + mu *= 100.0; // convert to m^-1 } - for(;;) - { - /* kill events with too many bounces */ - if (nloop>100) { - /* stopped on loop limit */ - ABSORB; - } + for (;;) { + /* kill events with too many bounces */ + if (nloop > 100) { + /* stopped on loop limit */ + ABSORB; + } /* Compute intersection times. */ - tout = (l - z)/vz; - tc[0] = (a1 - x + b1*z)/(vx - b1*vz); // right - tc[1] = (a2 - x + b2*z)/(vx - b2*vz); // left - tc[2] = (-hhalf - y - av*z)/(vy + av*vz); // bottom - tc[3] = ( hhalf - y + av*z)/(vy - av*vz); // top - tt=tout; - ic=-1; - for (i=0;i<4;i++) { - if ((tc[i]>0.0) && (tc[i]< tt)) { - tt=tc[i]; - ic=i; - } - } - /* Neutron left guide. */ - if(ic < 0) { - PROP_DT(tt); - if (inblade && (! opaque)) - p *= exp(-mu*v0*tt); // transmission probability - break; - } - - /* handle interactions with walls */ - switch(ic) - { - case 0: /* Right vertical mirror */ - N[0]=1.0; N[1]=0.0; N[2]=-b1; - N0=sqrt(1.0+b1*b1); - break; - case 1: /* Left vertical mirror */ - N[0]=-1.0; N[1]=0.0; N[2]=b2; - N0=sqrt(1.0+b2*b2); - break; - case 2: /* Lower horizontal mirror */ - N[0]=0.0; N[1]=1.0; N[2]=av; - N0=sqrt(1.0+av*av); - break; - case 3: /* Upper horizontal mirror */ - N[0]=0.0; N[1]=-1.0; N[2]=av; - N0=sqrt(1.0+av*av); - break; + tout = (l - z) / vz; + tc[0] = (a1 - x + b1 * z) / (vx - b1 * vz); // right + tc[1] = (a2 - x + b2 * z) / (vx - b2 * vz); // left + tc[2] = (-hhalf - y - av * z) / (vy + av * vz); // bottom + tc[3] = (hhalf - y + av * z) / (vy - av * vz); // top + tt = tout; + ic = -1; + for (i = 0; i < 4; i++) { + if ((tc[i] > 0.0) && (tc[i] < tt)) { + tt = tc[i]; + ic = i; + } + } + /* Neutron left guide. */ + if (ic < 0) { + PROP_DT (tt); + if (inblade && (!opaque)) + p *= exp (-mu * v0 * tt); // transmission probability + break; + } + + /* handle interactions with walls */ + switch (ic) { + case 0: /* Right vertical mirror */ + N[0] = 1.0; + N[1] = 0.0; + N[2] = -b1; + N0 = sqrt (1.0 + b1 * b1); + break; + case 1: /* Left vertical mirror */ + N[0] = -1.0; + N[1] = 0.0; + N[2] = b2; + N0 = sqrt (1.0 + b2 * b2); + break; + case 2: /* Lower horizontal mirror */ + N[0] = 0.0; + N[1] = 1.0; + N[2] = av; + N0 = sqrt (1.0 + av * av); + break; + case 3: /* Upper horizontal mirror */ + N[0] = 0.0; + N[1] = -1.0; + N[2] = av; + N0 = sqrt (1.0 + av * av); + break; + } + /* scattering vector */ + vdotn = N[0] * vx + N[1] * vy + N[2] * vz; + q = -2.0 * vdotn / N0; + + if (q <= 0.0) { + /* stopped on q<0, this should not happen */ + ABSORB; } - /* scattering vector */ - vdotn = N[0]*vx + N[1]*vy + N[2]*vz; - q=-2.0*vdotn/N0; - - if (q<=0.0) { - /* stopped on q<0, this should not happen */ - ABSORB; - } /* compute reflectivity. */ - double ref=0; - if ((ic <= 1 && mx == 0) || (ic >= 2 && my == 0)) - { - if (opaque) { - /* stopped, no way through blind & opaque mirrors*/ + double ref = 0; + if ((ic <= 1 && mx == 0) || (ic >= 2 && my == 0)) { + if (opaque) { + /* stopped, no way through blind & opaque mirrors*/ ABSORB; - } else ref=0; - } else { - /* - if (ic<=1) { - double par[] = {R0, Qcx, alphax, mx, W}; - } else { - double par[] = {R0, Qcy, alphay, my, W}; - } - StdReflecFunc(q*V2Q, par, &ref); - */ - if (ic<=1) { - StdReflecFunc(q*V2Q, refpar_x, &ref); - } else { - StdReflecFunc(q*V2Q, refpar_y, &ref); - } - } - if (inblade) { - // cumulative probabilities - p0 = 1.0-exp(-mu*v0*tt); // absorption - p1 = 1.0 - (1.0-p0)*ref; // absorption or transmission - } else { - p0=0.0; - p1=1.0 - ref; - // no entry into lamella below reflectivity edge ... - if ((ic<=1) && (q*V2Q=2) || (is<=0) || (is>=nslit-1)) { - ABSORB; - } - */ - if ( opaque || (ic>=2)) { - // ABSORB, no way through bottom/top walls - ABSORB; - } - if (((ic==0) && (is==0)) || ((ic==nslit-1) && (is==1)) ) { - // ABSORB, no way through right/left walls - ABSORB; - } - PROP_DT(tt+1.0e-9); // add small shift to avoid num. prec. errors - if (ic==0) { - is -= 1; - edge = is*w1c - 0.5*w1; - } - inblade=1; - /* new wall equation */ - a1=edge+winner; b1=(is+1)*dah-ah; // right wall - a2=a1+dlam;b2=b1; // left wall - SCATTER; - /* into channel */ - } else { - PROP_DT(tt+1.0e-9); // add small shift to avoid num. prec. errors - if (ic==1) { - is += 1; - edge = is*w1c - 0.5*w1; - } - inblade=0; - /* new wall equation */ - a1=edge; b1=is*dah-ah; // right wall - a2=edge+winner; b2=b1+dah; // left wall - SCATTER; - } -/* reflect */ - } else { - PROP_DT(tt); // move to the reflection point - vx += N[0]*q; - vy += N[1]*q; - vz += N[2]*q; - PROP_DT(1.0e-9); // add small shift away from the surface to avoid num. prec. errors - nloop++; // count reflections - SCATTER; + } else + ref = 0; + } else { + /* + if (ic<=1) { + double par[] = {R0, Qcx, alphax, mx, W}; + } else { + double par[] = {R0, Qcy, alphay, my, W}; + } + StdReflecFunc(q*V2Q, par, &ref); + */ + if (ic <= 1) { + StdReflecFunc (q * V2Q, refpar_x, &ref); + } else { + StdReflecFunc (q * V2Q, refpar_y, &ref); + } + } + if (inblade) { + // cumulative probabilities + p0 = 1.0 - exp (-mu * v0 * tt); // absorption + p1 = 1.0 - (1.0 - p0) * ref; // absorption or transmission + } else { + p0 = 0.0; + p1 = 1.0 - ref; + // no entry into lamella below reflectivity edge ... + if ((ic <= 1) && (q * V2Q < refpar_x[1] * refpar_x[3])) { + p0 = 1.0 - ref; + p1 = p0; + } + } + /* play the rullette */ + rtmp = rand01 (); + /* absorb */ + if (rtmp < p0) { + /* stopped, absorption in the blade */ + ABSORB; + /* transmit */ + } else if (rtmp < p1) { + /* into blade */ + if (!inblade) { + // no transport into the outer walls or opaque material + /* bug fix 24/3/2017 + if ( opaque || (ic>=2) || (is<=0) || (is>=nslit-1)) { + ABSORB; + } + */ + if (opaque || (ic >= 2)) { + // ABSORB, no way through bottom/top walls + ABSORB; + } + if (((ic == 0) && (is == 0)) || ((ic == nslit - 1) && (is == 1))) { + // ABSORB, no way through right/left walls + ABSORB; + } + PROP_DT (tt + 1.0e-9); // add small shift to avoid num. prec. errors + if (ic == 0) { + is -= 1; + edge = is * w1c - 0.5 * w1; + } + inblade = 1; + /* new wall equation */ + a1 = edge + winner; + b1 = (is + 1) * dah - ah; // right wall + a2 = a1 + dlam; + b2 = b1; // left wall + SCATTER; + /* into channel */ + } else { + PROP_DT (tt + 1.0e-9); // add small shift to avoid num. prec. errors + if (ic == 1) { + is += 1; + edge = is * w1c - 0.5 * w1; + } + inblade = 0; + /* new wall equation */ + a1 = edge; + b1 = is * dah - ah; // right wall + a2 = edge + winner; + b2 = b1 + dah; // left wall + SCATTER; + } + /* reflect */ + } else { + PROP_DT (tt); // move to the reflection point + vx += N[0] * q; + vy += N[1] * q; + vz += N[2] * q; + PROP_DT (1.0e-9); // add small shift away from the surface to avoid num. prec. errors + nloop++; // count reflections + SCATTER; } } /* end for */ /* renormalize to avoid accumulation of num. precision errors*/ - if (nloop>0) { - rtmp=v0/sqrt(vx*vx+vy*vy+vz*vz); - vx = vx * rtmp; - vy = vy * rtmp; - vz = vz * rtmp; + if (nloop > 0) { + rtmp = v0 / sqrt (vx * vx + vy * vy + vz * vz); + vx = vx * rtmp; + vy = vy * rtmp; + vz = vz * rtmp; } %} @@ -410,25 +436,15 @@ MCDISPLAY %{ int i; - magnify("xy"); - for(i = 0; i < nslit; i++) - { - multiline(5, - i*w1c - w1/2.0, -h1/2.0, 0.0, - i*w2c - w2/2.0, -h2/2.0, (double)l, - i*w2c - w2/2.0, h2/2.0, (double)l, - i*w1c - w1/2.0, h1/2.0, 0.0, - i*w1c - w1/2.0, -h1/2.0, 0.0); - multiline(5, - (i+1)*w1c - dlam - w1/2.0, -h1/2.0, 0.0, - (i+1)*w2c - dlam - w2/2.0, -h2/2.0, (double)l, - (i+1)*w2c - dlam - w2/2.0, h2/2.0, (double)l, - (i+1)*w1c - dlam - w1/2.0, h1/2.0, 0.0, - (i+1)*w1c - dlam - w1/2.0, -h1/2.0, 0.0); + magnify ("xy"); + for (i = 0; i < nslit; i++) { + multiline (5, i * w1c - w1 / 2.0, -h1 / 2.0, 0.0, i * w2c - w2 / 2.0, -h2 / 2.0, (double)l, i * w2c - w2 / 2.0, h2 / 2.0, (double)l, i * w1c - w1 / 2.0, + h1 / 2.0, 0.0, i * w1c - w1 / 2.0, -h1 / 2.0, 0.0); + multiline (5, (i + 1) * w1c - dlam - w1 / 2.0, -h1 / 2.0, 0.0, (i + 1) * w2c - dlam - w2 / 2.0, -h2 / 2.0, (double)l, (i + 1) * w2c - dlam - w2 / 2.0, + h2 / 2.0, (double)l, (i + 1) * w1c - dlam - w1 / 2.0, h1 / 2.0, 0.0, (i + 1) * w1c - dlam - w1 / 2.0, -h1 / 2.0, 0.0); } - line(-w1/2.0, -h1/2.0, 0.0, w1/2.0, -h1/2.0, 0.0); - line(-w2/2.0, -h2/2.0, (double)l, w2/2.0, -h2/2.0, (double)l); - + line (-w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, -h1 / 2.0, 0.0); + line (-w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, -h2 / 2.0, (double)l); %} END diff --git a/mcstas-comps/contrib/ISIS_moderator.comp b/mcstas-comps/contrib/ISIS_moderator.comp index 274f6567a..4777e7ae2 100644 --- a/mcstas-comps/contrib/ISIS_moderator.comp +++ b/mcstas-comps/contrib/ISIS_moderator.comp @@ -61,59 +61,60 @@ focus_yh = 0.01, xwidth = 0.074, yheight = 0.074, CAngle = 0.0,SAC= 1, Lmin=0, L SHARE %{ -typedef struct -{ -int nEnergy; ///< Number of energy bins -int nTime; ///< number of time bins + typedef struct { + int nEnergy; ///< Number of energy bins + int nTime; ///< number of time bins -double* TimeBin; ///< Time bins -double* EnergyBin; ///< Energy bins + double* TimeBin; ///< Time bins + double* EnergyBin; ///< Energy bins -double** Flux; ///< Flux per bin (integrated) - double* EInt; ///< Integrated Energy point - double Total; ///< Integrated Total + double** Flux; ///< Flux per bin (integrated) + double* EInt; ///< Integrated Energy point + double Total; ///< Integrated Total } Source; /* New functions */ - int cmdnumberD(char *,double*); - int cmdnumberI(char *,int*,const int); - double polInterp(double*,double*,int,double); - FILE* openFile(char*); - FILE* openFileTest(char*); - int readHtable(FILE*,const double,const double, Source*); - int timeStart(char*); - int timeEnd(char*); - int energyBin(char*,double,double,double*,double*); - int notComment(char*); - double strArea(double dist, double rtmodX, double rtmodY, double focus_xw, double focus_yh); - - -double** matrix(const int m,const int n) - /*! - Determine a double matrix - */ -{ - int i; - double* pv; - double** pd; - - if (m<1) return 0; - if (n<1) return 0; - pv = (double*) malloc(m*n*sizeof(double)); - pd = (double**) malloc(m*sizeof(double*)); - if (!pd) - { - fprintf(stderr,"No room for matrix!\n"); - exit(1); + int cmdnumberD (char*, double*); + int cmdnumberI (char*, int*, const int); + double polInterp (double*, double*, int, double); + FILE* openFile (char*); + FILE* openFileTest (char*); + int readHtable (FILE*, const double, const double, Source*); + int timeStart (char*); + int timeEnd (char*); + int energyBin (char*, double, double, double*, double*); + int notComment (char*); + double strArea (double dist, double rtmodX, double rtmodY, double focus_xw, double focus_yh); + + double** + matrix (const int m, const int n) + /*! + Determine a double matrix + */ + { + int i; + double* pv; + double** pd; + + if (m < 1) + return 0; + if (n < 1) + return 0; + pv = (double*)malloc (m * n * sizeof (double)); + pd = (double**)malloc (m * sizeof (double*)); + if (!pd) { + fprintf (stderr, "No room for matrix!\n"); + exit (1); } - for (i=0;itestDiff) - { - ns=i; - diff=testDiff; - } - C[i]=Y[i]; - D[i]=Y[i]; + { + double out, errOut; /* out put variables */ + double* C = malloc (Psize * sizeof (double)); + double* D = malloc (Psize * sizeof (double)); + if (!C || !D) { + #ifndef OPENACC + fprintf (stderr, "Error in ISIS_moderator: memory allocation failure. Exit!\n"); + exit (-1); + #endif + } + double testDiff, diff; + + double w, den, ho, hp; /* intermediate variables */ + int i, m, ns; + + ns = 0; + diff = fabs (Aim - X[0]); + C[0] = Y[0]; + D[0] = Y[0]; + for (i = 1; i < Psize; i++) { + testDiff = fabs (Aim - X[i]); + if (diff > testDiff) { + ns = i; + diff = testDiff; + } + C[i] = Y[i]; + D[i] = Y[i]; } - out=Y[ns]; - ns--; /* Now can be -1 !!!! */ + out = Y[ns]; + ns--; /* Now can be -1 !!!! */ + + for (m = 1; m < Psize; m++) { + for (i = 0; i < Psize - m; i++) { + ho = X[i] - Aim; + hp = X[i + m] - Aim; + w = C[i + 1] - D[i]; + /* den=ho-hp; -- test !=0.0 */ + den = w / (ho - hp); + D[i] = hp * den; + C[i] = ho * den; + } - for(m=1;mAR[Npts-1]) - return Npts; + { + int klo, khi, k; + if (Npts <= 0) + return 0; + if (V > AR[Npts - 1]) + return Npts; - if(AR[0]>0.0)AR[0]=0.0; + if (AR[0] > 0.0) + AR[0] = 0.0; - if (V0.0)AR[0]=0.0; return 0; } - klo=0; - khi= Npts-1; - while (khi-klo >1) - { - k=(khi+klo) >> 1; // quick division by 2 - if (AR[k]>V) - khi=k; + klo = 0; + khi = Npts - 1; + while (khi - klo > 1) { + k = (khi + klo) >> 1; // quick division by 2 + if (AR[k] > V) + khi = k; else - klo=k; + klo = k; } - return khi; -} - -int cmdnumberD(char *mc,double* num) - /*! - \returns 1 on success 0 on failure - */ -{ - int i,j; - char* ss; - char **endptr; - double nmb; - int len; - - len=strlen(mc); - j=0; - - for(i=0;iEinit && *Ea Eb - that is encompassed by EI->EE - */ -{ - double frac; - double dRange; - - if (EI>Eb) - return 0.0; - if (EEEa) ? (Eb-EI)/dRange : 1.0; - - - frac-=(EE Eend - \param Einit :: inital Energy - \parma Eend :: final energy - */ -{ - char ss[255]; /* BIG space for line */ - double Ea,Eb; - double T,D; - double Efrac; // Fraction of an Energy Bin - int Ftime; // time Flag - int eIndex; // energy Index - int tIndex; // time Index - double Tsum; // Running integration - double Efraction; // Amount to use for an energy/time bin - - // extern Source TS; - - int DebugCnt; - int i; + } + + int + timeStart (char* Line) /*! - Status Flag:: - Ftime=1 :: [time ] Reading Time : Data : Err [Exit on Total] + Search for a word time at the start of + the line. + \param Line :: Line to search + \returns 1 on success 0 on failure + */ + { + int len, i; + + len = strlen (Line); + for (i = 0; i < len && isspace (Line[i]); i++) + ; + if (len - i < 4) + return 0; + return (strncmp (Line + i, "time", 4)) ? 0 : 1; + } - Double Read File to determine how many bins and - memory size + int + timeEnd (char* Line) + /*! + Search for a word time at the start of + the line. + \param Line :: Line to search + \returns 1 on success 0 on failure */ - if (!TFile) return(0); - Ea=0.0; - Eb=0.0; - fprintf(stderr,"Energy == %g %g\n",Einit,Eend); - eIndex= -1; - DebugCnt=0; - Ftime=0; - tIndex=0; - TS->nTime=0; - TS->nEnergy=0; - // Read file and get time bins - while(fgets(ss,255,TFile) && Eend>Ea) - { - if (notComment(ss)) - { - DebugCnt++; - if (!Ftime) - { - if (energyBin(ss,Einit,Eend,&Ea,&Eb)) - { - if (eIndex==0) - TS->nTime=tIndex; - eIndex++; - } - else if (timeStart(ss)) - { - Ftime=1; - tIndex=0; - } - } - else // In the time section - { - if (timeEnd(ss)) // Found "total" - Ftime=0; - else - { - // Need to read the line in the case of first run - if (TS->nTime==0) - { - if (cmdnumberD(ss,&T) && - cmdnumberD(ss,&D)) - tIndex++; - } - } - } - } - } - // Plus 2 since we have a 0 counter and we have missed the last line. - TS->nEnergy=eIndex+2; - if (!TS->nTime && tIndex) - TS->nTime=tIndex; - // printf("tIndex %d %d %d %d \n",tIndex,eIndex,TS->nEnergy,TS->nTime); - - /* SECOND TIME THROUGH:: */ - rewind(TFile); - - TS->Flux=matrix(TS->nEnergy,TS->nTime); - TS->EInt=(double*) malloc(TS->nEnergy*sizeof(double)); - TS->TimeBin=(double*) malloc(TS->nTime*sizeof(double)); - TS->EnergyBin=(double*) malloc(TS->nEnergy*sizeof(double)); - - Tsum=0.0; - Ea=0.0; - Eb=0.0; - eIndex=-1; - DebugCnt=0; - Ftime=0; - tIndex=0; - TS->EInt[0]=0.0; - // Read file and get time bins - while(fgets(ss,255,TFile) && Eend>Ea) - { - if (notComment(ss)) - { - DebugCnt++; - if (!Ftime) - { - if (energyBin(ss,Einit,Eend,&Ea,&Eb)) - { - eIndex++; - TS->EnergyBin[eIndex]=(Einit>Ea) ? Einit : Ea; - Efraction=calcFraction(Einit,Eend,Ea,Eb); - Ftime++; - } - } - else if (Ftime==1) - { - if (timeStart(ss)) - { - Ftime=2; - tIndex=0; - } - } - - else // In the time section - { - if (timeEnd(ss)) // Found "total" - { - Ftime=0; - TS->EInt[eIndex+1]=Tsum; - } - else - { - // Need to read the line in the case of first run - if (cmdnumberD(ss,&T) && - cmdnumberD(ss,&D)) - { - TS->TimeBin[tIndex]=T/1e8; // convert Time into second (from shakes) - Tsum+=D*Efraction; - TS->Flux[eIndex][tIndex]=Tsum; - tIndex++; - } - } - } - } - } + { + int len, i; - TS->EnergyBin[eIndex+1]=Eend; - TS->Total=Tsum; - - // printf("tIndex %d %d %d \n",tIndex,eIndex,TS.nTime); - //printf("Tsum %g \n",Tsum); - //fprintf(stderr,"ebin1 ebinN %g %g\n",TS.EnergyBin[0],TS.EnergyBin[TS.nEnergy-1]); - - return 1; -} // readHtable - - -#pragma acc routine seq -void getPoint(double* TV,double* EV,double* lim1, double* lim2, Source TS, _class_particle *_particle) - /*! - Calculate the Time and Energy - by sampling the file. - Uses TS table to find the point - \param TV :: - \param EV :: - \param lim1 :: - \param lim2 :: - */ -{ - int i; + len = strlen (Line); + for (i = 0; i < len && isspace (Line[i]); i++) + ; + if (len - i < 5) + return 0; + return (strncmp (Line + i, "total", 5)) ? 0 : 1; + } - // extern Source TS; - double R0,R1,R,Rend; - int Epnt; ///< Points to the next higher index of the neutron integral - int Tpnt; - int iStart,iEnd; - double TRange,Tspread; - double Espread,Estart; - double *EX; + int + energyBin (char* Line, double Einit, double Eend, double* Ea, double* Eb) + /*! + Search for a word "energy bin:" at the start of + the line. Then separte off the energy bin values + \param Line :: Line to search + \param Ea :: first energy bin [meV] + \param Eb :: second energy bin [meV] + \returns 1 on success 0 on failure + */ + { + int len, i; + double A, B; - // So that lowPoly+highPoly==maxPoly - const int maxPoly=6; - const int highPoly=maxPoly/2; - const int lowPoly=maxPoly-highPoly; + len = strlen (Line); + for (i = 0; i < len && isspace (Line[i]); i++) + ; + if (len - i < 11) + return 0; - // static int testVar=0; + if (strncmp (Line + i, "energy bin:", 11)) + return 0; - R0=rand01(); - /* if (testVar==0) - { - R0=1.0e-8; - testVar=1; - } + i += 11; + if (!cmdnumberD (Line + i, &A)) + return 0; + // remove 'to' + for (; i < len - 1 && Line[i] != 'o'; i++) + ; + i++; + if (!cmdnumberD (Line + i, &B)) + return 0; + A *= 1e9; + B *= 1e9; + *Ea = A; + *Eb = B; + if (*Eb > Einit && *Ea < Eend) + return 1; + return 0; + } + + double + calcFraction (double EI, double EE, double Ea, double Eb) + /*! + Calculate the fraction of the bin between Ea -> Eb + that is encompassed by EI->EE */ - Rend=R=TS.Total*R0; - // This gives Eint[Epnt-1] > R > Eint[Epnt] - Epnt=binSearch(TS.nEnergy-1,TS.EInt,R); - - // if (Epnt < 0) - // Epnt=1; - Tpnt=binSearch(TS.nTime-1,TS.Flux[Epnt-1],R); - // fprintf(stderr,"TBoundaryX == %12.6e %12.6e \n",TS.TimeBin[Tpnt-1],TS.TimeBin[Tpnt]); - // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); - // if (Epnt == -1) - //{ - // Epnt=0; - // fprintf(stderr,"\n Rvals == %g %d %d %g\n",R,Epnt,Tpnt,TS.TimeBin[0]); - // fprintf(stderr,"EInt == %d %12.6e %12.6e %12.6e %12.6e \n",Epnt,TS.EInt[Epnt-1],R,TS.EInt[Epnt],TS.EInt[Epnt+1]); - // printf("EBoundary == %12.6e %12.6e \n",TS.EnergyBin[Epnt],TS.EnergyBin[Epnt+1]); - - // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt+1][Tpnt],R,TS.Flux[Epnt+1][Tpnt+1]); - // } - - if(R < TS.Flux[Epnt-1][Tpnt-1] || R >TS.Flux[Epnt-1][Tpnt] ) - { -#ifndef OPENACC - fprintf(stderr, "outside bin limits Tpnt/Epnt problem %12.6e %12.6e %12.6e \n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); -#endif - } + { + double frac; + double dRange; - if(Epnt == 0) - { - Estart=0.0; - Espread=TS.EInt[0]; - *EV=TS.EnergyBin[1]; - } - else - { - Estart=TS.EInt[Epnt-1]; - Espread=TS.EInt[Epnt]-TS.EInt[Epnt-1]; - *EV=TS.EnergyBin[Epnt+1]; - } + if (EI > Eb) + return 0.0; + if (EE < Ea) + return 0.0; - if (Tpnt==0 || Epnt==0) - { -#ifndef OPENACC - fprintf(stderr,"BIG ERROR WITH Tpnt: %d and Epnt: %d\n",Tpnt,Epnt); - exit(1); -#endif - } - if (Tpnt==TS.nTime) - { -#ifndef OPENACC - fprintf(stderr,"BIG ERROR WITH Tpnt and Epnt\n"); - exit(1); -#endif - - *TV=0.0; - Tspread=TS.Flux[Epnt-1][0]-TS.EInt[Epnt-1]; - TRange=TS.TimeBin[0]; - R-=TS.EInt[Epnt-1]; + dRange = Eb - Ea; + frac = (EI > Ea) ? (Eb - EI) / dRange : 1.0; + + frac -= (EE < Eb) ? (Eb - EE) / dRange : 0.0; + + // if(frac != 1.0) + // fprintf(stderr,"frac %g, Ea %g,Eb %g, EI %g, EE %g\n",frac,Ea,Eb,EI,EE); + + return frac; + } + + int + readHtable (FILE* TFile, const double Einit, const double Eend, Source* TS) + /*! + Process a general h.o file to create an integrated + table of results from Einit -> Eend + \param Einit :: inital Energy + \parma Eend :: final energy + */ + { + char ss[255]; /* BIG space for line */ + double Ea, Eb; + double T, D; + double Efrac; // Fraction of an Energy Bin + int Ftime; // time Flag + int eIndex; // energy Index + int tIndex; // time Index + double Tsum; // Running integration + double Efraction; // Amount to use for an energy/time bin + + // extern Source TS; + + int DebugCnt; + int i; + /*! + Status Flag:: + Ftime=1 :: [time ] Reading Time : Data : Err [Exit on Total] + + Double Read File to determine how many bins and + memory size + */ + if (!TFile) + return (0); + Ea = 0.0; + Eb = 0.0; + fprintf (stderr, "Energy == %g %g\n", Einit, Eend); + eIndex = -1; + DebugCnt = 0; + Ftime = 0; + tIndex = 0; + TS->nTime = 0; + TS->nEnergy = 0; + // Read file and get time bins + while (fgets (ss, 255, TFile) && Eend > Ea) { + if (notComment (ss)) { + DebugCnt++; + if (!Ftime) { + if (energyBin (ss, Einit, Eend, &Ea, &Eb)) { + if (eIndex == 0) + TS->nTime = tIndex; + eIndex++; + } else if (timeStart (ss)) { + Ftime = 1; + tIndex = 0; + } + } else // In the time section + { + if (timeEnd (ss)) // Found "total" + Ftime = 0; + else { + // Need to read the line in the case of first run + if (TS->nTime == 0) { + if (cmdnumberD (ss, &T) && cmdnumberD (ss, &D)) + tIndex++; + } + } + } + } } - else - { - *TV=TS.TimeBin[Tpnt-1]; - TRange=TS.TimeBin[Tpnt]-TS.TimeBin[Tpnt-1]; - Tspread=TS.Flux[Epnt-1][Tpnt]-TS.Flux[Epnt-1][Tpnt-1]; - R-=TS.Flux[Epnt-1][Tpnt-1]; + // Plus 2 since we have a 0 counter and we have missed the last line. + TS->nEnergy = eIndex + 2; + if (!TS->nTime && tIndex) + TS->nTime = tIndex; + // printf("tIndex %d %d %d %d \n",tIndex,eIndex,TS->nEnergy,TS->nTime); + + /* SECOND TIME THROUGH:: */ + rewind (TFile); + + TS->Flux = matrix (TS->nEnergy, TS->nTime); + TS->EInt = (double*)malloc (TS->nEnergy * sizeof (double)); + TS->TimeBin = (double*)malloc (TS->nTime * sizeof (double)); + TS->EnergyBin = (double*)malloc (TS->nEnergy * sizeof (double)); + + Tsum = 0.0; + Ea = 0.0; + Eb = 0.0; + eIndex = -1; + DebugCnt = 0; + Ftime = 0; + tIndex = 0; + TS->EInt[0] = 0.0; + // Read file and get time bins + while (fgets (ss, 255, TFile) && Eend > Ea) { + if (notComment (ss)) { + DebugCnt++; + if (!Ftime) { + if (energyBin (ss, Einit, Eend, &Ea, &Eb)) { + eIndex++; + TS->EnergyBin[eIndex] = (Einit > Ea) ? Einit : Ea; + Efraction = calcFraction (Einit, Eend, Ea, Eb); + Ftime++; + } + } else if (Ftime == 1) { + if (timeStart (ss)) { + Ftime = 2; + tIndex = 0; + } + } + + else // In the time section + { + if (timeEnd (ss)) // Found "total" + { + Ftime = 0; + TS->EInt[eIndex + 1] = Tsum; + } else { + // Need to read the line in the case of first run + if (cmdnumberD (ss, &T) && cmdnumberD (ss, &D)) { + TS->TimeBin[tIndex] = T / 1e8; // convert Time into second (from shakes) + Tsum += D * Efraction; + TS->Flux[eIndex][tIndex] = Tsum; + tIndex++; + } + } + } + } } - // printf("R == %12.6e\n",R); - R/=Tspread; - // printf("R == %12.6e\n",R); - *TV+=TRange*R; + TS->EnergyBin[eIndex + 1] = Eend; + TS->Total = Tsum; - R1=TS.EInt[Epnt-1]+Espread*rand01(); - iStart=Epnt>lowPoly ? Epnt-lowPoly : 0; // max(Epnt-halfPoly,0) - iEnd=TS.nEnergy>Epnt+highPoly ? Epnt+highPoly : TS.nEnergy-1; // min(nEnergy-1,Epnt+highPoly + // printf("tIndex %d %d %d \n",tIndex,eIndex,TS.nTime); + // printf("Tsum %g \n",Tsum); + // fprintf(stderr,"ebin1 ebinN %g %g\n",TS.EnergyBin[0],TS.EnergyBin[TS.nEnergy-1]); - *EV=polInterp(TS.EInt+iStart,TS.EnergyBin+iStart,1+iEnd-iStart,R1); + return 1; + } // readHtable - // fprintf(stderr,"Energy == %d %d %12.6e %12.6e \n",iStart,iEnd,R1,*EV); - // fprintf(stderr,"bins == %12.6e %12.6e %12.6e %12.6e \n",TS.EnergyBin[iStart],TS.EnergyBin[iEnd], - // TS.EInt[Epnt],TS.EInt[Epnt-1]); + #pragma acc routine seq + void + getPoint (double* TV, double* EV, double* lim1, double* lim2, Source TS, _class_particle* _particle) + /*! + Calculate the Time and Energy + by sampling the file. + Uses TS table to find the point + \param TV :: + \param EV :: + \param lim1 :: + \param lim2 :: + */ + { + int i; + + // extern Source TS; + double R0, R1, R, Rend; + int Epnt; ///< Points to the next higher index of the neutron integral + int Tpnt; + int iStart, iEnd; + double TRange, Tspread; + double Espread, Estart; + double* EX; + + // So that lowPoly+highPoly==maxPoly + const int maxPoly = 6; + const int highPoly = maxPoly / 2; + const int lowPoly = maxPoly - highPoly; + + // static int testVar=0; + + R0 = rand01 (); + /* if (testVar==0) + { + R0=1.0e-8; + testVar=1; + } + */ + Rend = R = TS.Total * R0; + // This gives Eint[Epnt-1] > R > Eint[Epnt] + Epnt = binSearch (TS.nEnergy - 1, TS.EInt, R); + + // if (Epnt < 0) + // Epnt=1; + Tpnt = binSearch (TS.nTime - 1, TS.Flux[Epnt - 1], R); + // fprintf(stderr,"TBoundaryX == %12.6e %12.6e \n",TS.TimeBin[Tpnt-1],TS.TimeBin[Tpnt]); + // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); + // if (Epnt == -1) + //{ + // Epnt=0; + // fprintf(stderr,"\n Rvals == %g %d %d %g\n",R,Epnt,Tpnt,TS.TimeBin[0]); + // fprintf(stderr,"EInt == %d %12.6e %12.6e %12.6e %12.6e \n",Epnt,TS.EInt[Epnt-1],R,TS.EInt[Epnt],TS.EInt[Epnt+1]); + // printf("EBoundary == %12.6e %12.6e \n",TS.EnergyBin[Epnt],TS.EnergyBin[Epnt+1]); + + // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt+1][Tpnt],R,TS.Flux[Epnt+1][Tpnt+1]); + // } + + if (R < TS.Flux[Epnt - 1][Tpnt - 1] || R > TS.Flux[Epnt - 1][Tpnt]) { + #ifndef OPENACC + fprintf (stderr, "outside bin limits Tpnt/Epnt problem %12.6e %12.6e %12.6e \n", TS.Flux[Epnt - 1][Tpnt - 1], R, TS.Flux[Epnt - 1][Tpnt]); + #endif + } - if(*TV < TS.TimeBin[Tpnt-1] || *TV > TS.TimeBin[Tpnt]) - { -#ifndef OPENACC - fprintf(stderr,"%d Tpnt %d Tval %g Epnt %d \n",TS.nTime,Tpnt,*TV,Epnt); - fprintf(stderr,"TBoundary == %12.6e,%g , %12.6e \n\n",TS.TimeBin[Tpnt-1],*TV,TS.TimeBin[Tpnt]); -#endif + if (Epnt == 0) { + Estart = 0.0; + Espread = TS.EInt[0]; + *EV = TS.EnergyBin[1]; + } else { + Estart = TS.EInt[Epnt - 1]; + Espread = TS.EInt[Epnt] - TS.EInt[Epnt - 1]; + *EV = TS.EnergyBin[Epnt + 1]; } + if (Tpnt == 0 || Epnt == 0) { + #ifndef OPENACC + fprintf (stderr, "BIG ERROR WITH Tpnt: %d and Epnt: %d\n", Tpnt, Epnt); + exit (1); + #endif + } + if (Tpnt == TS.nTime) { + #ifndef OPENACC + fprintf (stderr, "BIG ERROR WITH Tpnt and Epnt\n"); + exit (1); + #endif + + *TV = 0.0; + Tspread = TS.Flux[Epnt - 1][0] - TS.EInt[Epnt - 1]; + TRange = TS.TimeBin[0]; + R -= TS.EInt[Epnt - 1]; + } else { + *TV = TS.TimeBin[Tpnt - 1]; + TRange = TS.TimeBin[Tpnt] - TS.TimeBin[Tpnt - 1]; + Tspread = TS.Flux[Epnt - 1][Tpnt] - TS.Flux[Epnt - 1][Tpnt - 1]; + R -= TS.Flux[Epnt - 1][Tpnt - 1]; + } + // printf("R == %12.6e\n",R); + R /= Tspread; + // printf("R == %12.6e\n",R); + *TV += TRange * R; + + R1 = TS.EInt[Epnt - 1] + Espread * rand01 (); + iStart = Epnt > lowPoly ? Epnt - lowPoly : 0; // max(Epnt-halfPoly,0) + iEnd = TS.nEnergy > Epnt + highPoly ? Epnt + highPoly : TS.nEnergy - 1; // min(nEnergy-1,Epnt+highPoly + + *EV = polInterp (TS.EInt + iStart, TS.EnergyBin + iStart, 1 + iEnd - iStart, R1); + + // fprintf(stderr,"Energy == %d %d %12.6e %12.6e \n",iStart,iEnd,R1,*EV); + // fprintf(stderr,"bins == %12.6e %12.6e %12.6e %12.6e \n",TS.EnergyBin[iStart],TS.EnergyBin[iEnd], + // TS.EInt[Epnt],TS.EInt[Epnt-1]); + + if (*TV < TS.TimeBin[Tpnt - 1] || *TV > TS.TimeBin[Tpnt]) { + #ifndef OPENACC + fprintf (stderr, "%d Tpnt %d Tval %g Epnt %d \n", TS.nTime, Tpnt, *TV, Epnt); + fprintf (stderr, "TBoundary == %12.6e,%g , %12.6e \n\n", TS.TimeBin[Tpnt - 1], *TV, TS.TimeBin[Tpnt]); + #endif + } - if(*EV < *lim1 || *EV > *lim2) - { -#ifndef OPENACC - fprintf(stderr,"outside boundaries\n Epnt= %d, Tpnt= %d binlo %g|%g| binhi %g \n",Epnt,Tpnt,TS.EnergyBin[Epnt-1],*EV,TS.EnergyBin[Epnt]); + if (*EV < *lim1 || *EV > *lim2) { + #ifndef OPENACC + fprintf (stderr, "outside boundaries\n Epnt= %d, Tpnt= %d binlo %g|%g| binhi %g \n", Epnt, Tpnt, TS.EnergyBin[Epnt - 1], *EV, TS.EnergyBin[Epnt]); - fprintf(stderr,"TS == %g %g :: %d %d \n",TS.EInt[Epnt-1],TS.EInt[Epnt],iStart,iEnd); - fprintf(stderr,"Points (%g) == ",R1); + fprintf (stderr, "TS == %g %g :: %d %d \n", TS.EInt[Epnt - 1], TS.EInt[Epnt], iStart, iEnd); + fprintf (stderr, "Points (%g) == ", R1); - for(i=0;i /* global variables */ - double p_in; /* Polorization term (from McSTAS) */ - int Tnpts; /* Number of points in parameteriation */ - double scaleSize; /* correction for the actual area of the moderator viewed */ - double angleArea; /* Area seen by the window */ - double Nsim; /* Total number of neutrons to be simulated */ - int Ncount; /* Number of neutron simulate so far*/ + double p_in; /* Polorization term (from McSTAS) */ + int Tnpts; /* Number of points in parameteriation */ + double scaleSize; /* correction for the actual area of the moderator viewed */ + double angleArea; /* Area seen by the window */ + double Nsim; /* Total number of neutrons to be simulated */ + int Ncount; /* Number of neutron simulate so far*/ Source TS; /* runtime variables*/ - double rtE0; /* runtime Energy minima and maxima so we can use angstroms as negative input */ + double rtE0; /* runtime Energy minima and maxima so we can use angstroms as negative input */ double rtE1; - double rtmodX; /* runtime moderator sizes, so that a negative argument may give a default size */ + double rtmodX; /* runtime moderator sizes, so that a negative argument may give a default size */ double rtmodY; int TargetStation; double CurrentWeight; @@ -867,313 +831,400 @@ INITIALIZE %{ /* READ IN THE ENERGY FILE */ - char fname[256]; /* Variables */ + char fname[256]; /* Variables */ FILE* TFile; double tmp; char lowerFace[255]; int Bcnt; int i; - struct BeamLine - { - char Name[50]; - double Xsize; - double Ysize; - } Olist[50]; - - if (target_index && !dist) - { + struct BeamLine { + char Name[50]; + double Xsize; + double Ysize; + } Olist[50]; + + if (target_index && !dist) { Coords ToTarget; - double tx,ty,tz; - ToTarget = coords_sub(POS_A_COMP_INDEX(INDEX_CURRENT_COMP+target_index),POS_A_CURRENT_COMP); - ToTarget = rot_apply(ROT_A_CURRENT_COMP, ToTarget); - coords_get(ToTarget, &tx, &ty, &tz); - dist=sqrt(tx*tx+ty*ty+tz*tz); + double tx, ty, tz; + ToTarget = coords_sub (POS_A_COMP_INDEX (INDEX_CURRENT_COMP + target_index), POS_A_CURRENT_COMP); + ToTarget = rot_apply (ROT_A_CURRENT_COMP, ToTarget); + coords_get (ToTarget, &tx, &ty, &tz); + dist = sqrt (tx * tx + ty * ty + tz * tz); } - - Nsim=(double)mcget_ncount(); - Bcnt=0; + + Nsim = (double)mcget_ncount (); + Bcnt = 0; // CH4 face 1 (north) - strcpy(Olist[Bcnt].Name,"mari"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"gem"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"hrpd"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"pearl"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; + strcpy (Olist[Bcnt].Name, "mari"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "gem"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "hrpd"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "pearl"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; // CH4 face 2 (south) - strcpy(Olist[Bcnt].Name,"sandals"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"prisma"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; + strcpy (Olist[Bcnt].Name, "sandals"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "prisma"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; // H2 face - strcpy(Olist[Bcnt].Name,"surf"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"crisp"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"iris"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; + strcpy (Olist[Bcnt].Name, "surf"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "crisp"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "iris"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; // Water face 1 - strcpy(Olist[Bcnt].Name,"polaris"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"het"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"tosca"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; + strcpy (Olist[Bcnt].Name, "polaris"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "het"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "tosca"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; // Water face 2 - strcpy(Olist[Bcnt].Name,"maps"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"evs"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"sxd"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; + strcpy (Olist[Bcnt].Name, "maps"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "evs"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "sxd"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; // TS1 Generics - strcpy(Olist[Bcnt].Name,"ch4"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; - strcpy(Olist[Bcnt].Name,"h2"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"water"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.115; Bcnt++; + strcpy (Olist[Bcnt].Name, "ch4"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; + strcpy (Olist[Bcnt].Name, "h2"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "water"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.115; + Bcnt++; // TS2 Generics - strcpy(Olist[Bcnt].Name,"groove"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - strcpy(Olist[Bcnt].Name,"hydrogen"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"narrow"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"broad"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; + strcpy (Olist[Bcnt].Name, "groove"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + strcpy (Olist[Bcnt].Name, "hydrogen"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "narrow"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "broad"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; // TS2 groove - strcpy(Olist[Bcnt].Name,"e1"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - strcpy(Olist[Bcnt].Name,"e2"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - strcpy(Olist[Bcnt].Name,"e3"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - strcpy(Olist[Bcnt].Name,"e4"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - strcpy(Olist[Bcnt].Name,"e5"); Olist[Bcnt].Xsize=0.08333; Olist[Bcnt].Ysize=0.03; Bcnt++; - - //Broad face - strcpy(Olist[Bcnt].Name,"e6"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"e7"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"e8"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"e9"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; + strcpy (Olist[Bcnt].Name, "e1"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e2"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e3"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e4"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e5"); + Olist[Bcnt].Xsize = 0.08333; + Olist[Bcnt].Ysize = 0.03; + Bcnt++; + + // Broad face + strcpy (Olist[Bcnt].Name, "e6"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e7"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e8"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "e9"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; // Narrow face - strcpy(Olist[Bcnt].Name,"w1"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"w2"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"w3"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - strcpy(Olist[Bcnt].Name,"w4"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.12; Bcnt++; - - //Hydrogen face - strcpy(Olist[Bcnt].Name,"w5"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"w6"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"w7"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"w8"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - strcpy(Olist[Bcnt].Name,"w9"); Olist[Bcnt].Xsize=0.12; Olist[Bcnt].Ysize=0.11; Bcnt++; - + strcpy (Olist[Bcnt].Name, "w1"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w2"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w3"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w4"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.12; + Bcnt++; + + // Hydrogen face + strcpy (Olist[Bcnt].Name, "w5"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w6"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w7"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w8"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; + strcpy (Olist[Bcnt].Name, "w9"); + Olist[Bcnt].Xsize = 0.12; + Olist[Bcnt].Ysize = 0.11; + Bcnt++; /* write out version number */ - fprintf(stderr,"**********************************************************************\n"); - fprintf(stderr,"**** This is ISIS_moderator.comp version 2.0 (25/8/05) ****\n"); - fprintf(stderr,"**** Please check to see if your files are up-to-date ****\n"); - fprintf(stderr,"**** http://www.isis.rl.ac.uk/Computing/Software/MC/index.htm ****\n"); - fprintf(stderr,"**********************************************************************\n\n"); - - + fprintf (stderr, "**********************************************************************\n"); + fprintf (stderr, "**** This is ISIS_moderator.comp version 2.0 (25/8/05) ****\n"); + fprintf (stderr, "**** Please check to see if your files are up-to-date ****\n"); + fprintf (stderr, "**** http://www.isis.rl.ac.uk/Computing/Software/MC/index.htm ****\n"); + fprintf (stderr, "**********************************************************************\n\n"); /* convert arguments to runtime variables so that they may be altered */ - rtE0=Emin; - rtE1=Emax; - rtmodX=xwidth; - rtmodY=yheight; - + rtE0 = Emin; + rtE1 = Emax; + rtmodX = xwidth; + rtmodY = yheight; /* Convert NEGATIVE energy (denoting angstroms) into meV */ - if ( (rtE0<0 && Emax>0) | (rtE0>0 && Emax<0)) - { - fprintf(stderr,"Cannot have differing signs for Emin and Emax, choose Angstroms or meV!\n"); - exit(1); - } - - - if (rtE0<0 && Emax<0) - { - fprintf (stderr,"converting Angstroms to meV\n"); - rtE0=81.793936/(rtE0*rtE0); - rtE1=81.793936/(rtE1*rtE1); - } - if (Lmin && Lmax) - { - fprintf (stderr,"converting Angstroms to meV\n"); - rtE0=81.793936/(Lmin*Lmin); - rtE1=81.793936/(Lmax*Lmax); - } - if (rtE0>rtE1) - { - tmp=rtE1; - rtE1=rtE0; - rtE0=tmp; - fprintf (stderr,"%g A -> %g A => %g meV -> %g meV\n",-Emin,-Emax,rtE0,rtE1); - } - - - - + if ((rtE0 < 0 && Emax > 0) | (rtE0 > 0 && Emax < 0)) { + fprintf (stderr, "Cannot have differing signs for Emin and Emax, choose Angstroms or meV!\n"); + exit (1); + } + if (rtE0 < 0 && Emax < 0) { + fprintf (stderr, "converting Angstroms to meV\n"); + rtE0 = 81.793936 / (rtE0 * rtE0); + rtE1 = 81.793936 / (rtE1 * rtE1); + } + if (Lmin && Lmax) { + fprintf (stderr, "converting Angstroms to meV\n"); + rtE0 = 81.793936 / (Lmin * Lmin); + rtE1 = 81.793936 / (Lmax * Lmax); + } + if (rtE0 > rtE1) { + tmp = rtE1; + rtE1 = rtE0; + rtE0 = tmp; + fprintf (stderr, "%g A -> %g A => %g meV -> %g meV\n", -Emin, -Emax, rtE0, rtE1); + } /**********************************************************************/ - Tnpts=0; - Ncount=0; - fprintf(stderr,"Face == %s \n",Face); + Tnpts = 0; + Ncount = 0; + fprintf (stderr, "Face == %s \n", Face); - for(i=0;Face[i] && Face[i]!=' ';i++) - lowerFace[i]=tolower(Face[i]); - lowerFace[i]=0; + for (i = 0; Face[i] && Face[i] != ' '; i++) + lowerFace[i] = tolower (Face[i]); + lowerFace[i] = 0; - for(i=0;i \n"); - for(i=0;i \n"); + for (i = 0; i < Bcnt; i++) { + fprintf (stderr, " %s ", Olist[i].Name); + /* if (!((i+1) % 4)) */ + fprintf (stderr, "\n"); } + scaleSize = xwidth * yheight / 0.0025; + exit (1); + } - rtmodY*=cos(CAngle); + rtmodY *= cos (CAngle); /* READ PARAMETER FILE */ - TFile=openFile(fname); - - if (!readHtable(TFile,rtE0,rtE1,&TS)) - { - fprintf(stderr,"Failed to read the Hzone from file %s\n", fname); - exit(1); - } - fclose(TFile); + TFile = openFile (fname); - fprintf(stderr,"nEnergy == %d\n",TS.nEnergy); + if (!readHtable (TFile, rtE0, rtE1, &TS)) { + fprintf (stderr, "Failed to read the Hzone from file %s\n", fname); + exit (1); + } + fclose (TFile); + + fprintf (stderr, "nEnergy == %d\n", TS.nEnergy); /* Do solid angle correction if required */ // if SAC=0/1 solid angle is determined if (SAC) - angleArea=(dist>0.0) ? strArea(dist, rtmodX, rtmodY, focus_xw, focus_yh) : 2*3.141592654; + angleArea = (dist > 0.0) ? strArea (dist, rtmodX, rtmodY, focus_xw, focus_yh) : 2 * 3.141592654; else - angleArea=1.0; - - /* + angleArea = 1.0; + + /* TS1: MCNPX runs were done for 60 mu-A, but the source runs at 160 mu-A, 40 Hz. TS2: MCNPX runs were done for 60 mu-A, but the source runs at 40-mu-A, 10 Hz. */ - + if (TargetStation == 1) { - CurrentWeight = 160.0/60.0; + CurrentWeight = 160.0 / 60.0; } else { - CurrentWeight = 40.0/60.0; + CurrentWeight = 40.0 / 60.0; } - %} TRACE %{ - double v,r,E; - double xf,yf,dx,dy,w_focus; /* mxp ->max var in param space */ - double Ival,Tval,Eval; - double Ddist; /* Temp versions of dist */ + double v, r, E; + double xf, yf, dx, dy, w_focus; /* mxp ->max var in param space */ + double Ival, Tval, Eval; + double Ddist; /* Temp versions of dist */ #pragma acc atomic Ncount++; - p=p_in; - - p=1.0; /* forcing */ - z=0; - x = 0.5*rtmodX*randpm1(); /* Get point +/-0.5 * */ - y = 0.5*rtmodY*randpm1(); - xf = 0.5*focus_xw*randpm1(); /* Choose focusing position uniformly */ - yf = 0.5*focus_yh*randpm1(); - dx = xf-x; - dy = yf-y; - if (dist>0.0) - { - r = sqrt(dx*dx+dy*dy+dist*dist); /* Actual distance to point */ - Ddist=dist; - w_focus = (SAC) ? angleArea : scaleSize*(dist*dist)/(r*r); - } - else /* Assume that we have a window 1metre infront of the moderator */ - /* with size area of detector and solid angle 1.0 */ - { - r=1.0; - w_focus=scaleSize; - Ddist=1.0; - } - - getPoint(&Tval,&Eval,&rtE0,&rtE1, TS, _particle); + p = p_in; + + p = 1.0; /* forcing */ + z = 0; + x = 0.5 * rtmodX * randpm1 (); /* Get point +/-0.5 * */ + y = 0.5 * rtmodY * randpm1 (); + xf = 0.5 * focus_xw * randpm1 (); /* Choose focusing position uniformly */ + yf = 0.5 * focus_yh * randpm1 (); + dx = xf - x; + dy = yf - y; + if (dist > 0.0) { + r = sqrt (dx * dx + dy * dy + dist * dist); /* Actual distance to point */ + Ddist = dist; + w_focus = (SAC) ? angleArea : scaleSize * (dist * dist) / (r * r); + } else /* Assume that we have a window 1metre infront of the moderator */ + /* with size area of detector and solid angle 1.0 */ + { + r = 1.0; + w_focus = scaleSize; + Ddist = 1.0; + } - //fprintf(stderr,"outside %g mev\n", TS.Total ); - if(verbose) - if(Eval>rtE1 || Eval rtE1 || Eval < rtE0) + fprintf (stderr, "outside %g mev\n", Eval); + Ival = TS.Total * 3.744905847e14 * 1.1879451; /* ( of proton in 60uAmp) * (1-cos(30))*2*Pi */ - v = SE2V*sqrt(Eval); /* Calculate the velocity */ - vz = v*Ddist/r; - vy = v*dy/r; - vx = v*dx/r; + v = SE2V * sqrt (Eval); /* Calculate the velocity */ + vz = v * Ddist / r; + vy = v * dy / r; + vx = v * dx / r; - if (Ncount==1) - fprintf(stderr,"Totals:: %g %d %d \n",TS.Total,TS.nEnergy,TS.nTime); + if (Ncount == 1) + fprintf (stderr, "Totals:: %g %d %d \n", TS.Total, TS.nEnergy, TS.nTime); if (!(Ncount % 100000) && verbose) - fprintf(stderr,"FF[%d]=> %g %g %g %g \n",Ncount,Eval,Tval,TS.Total,Ival); + fprintf (stderr, "FF[%d]=> %g %g %g %g \n", Ncount, Eval, Tval, TS.Total, Ival); + + t = Tval; - t=Tval; - - p=w_focus*Ival*CurrentWeight/Nsim; + p = w_focus * Ival * CurrentWeight / Nsim; %} MCDISPLAY %{ - double cirp=0.0,cirq=0.3,pi=3.141592654; - int pp=0; /* circle drawing parameter*/ + double cirp = 0.0, cirq = 0.3, pi = 3.141592654; + int pp = 0; /* circle drawing parameter*/ - - - - multiline(5,-0.5*rtmodX,-0.5*rtmodY,0.0, - 0.5*rtmodX,-0.5*rtmodY,0.0, - 0.5*rtmodX,0.5*rtmodY,0.0, - -0.5*rtmodX,0.5*rtmodY,0.0, - -0.5*rtmodX,-0.5*rtmodY,0.0); + multiline (5, -0.5 * rtmodX, -0.5 * rtmodY, 0.0, 0.5 * rtmodX, -0.5 * rtmodY, 0.0, 0.5 * rtmodX, 0.5 * rtmodY, 0.0, -0.5 * rtmodX, 0.5 * rtmodY, 0.0, + -0.5 * rtmodX, -0.5 * rtmodY, 0.0); /* circle("xy",0.0,0.0,0.0,cos(cirp)); */ /*line(0.5*sin(cirp),0.0,0.5*cos(cirp),0.5*sin(cirq),0.0,0.5*cos(cirq));*/ /*line(-0.5,0.0,0.0,0.0,0.0,0.5);*/ - for (pp=0;pp<=20;pp=pp+2) - { - cirp= (pp*(pi/21.0))-(0.5*pi); - cirq= ((pp+1)*(pi/21.0))-(0.5*pi); - line(0.5*sin(cirp),0.0,0.5*cos(cirp),0.5*sin(cirq),0.0,0.5*cos(cirq)); - } - + for (pp = 0; pp <= 20; pp = pp + 2) { + cirp = (pp * (pi / 21.0)) - (0.5 * pi); + cirq = ((pp + 1) * (pi / 21.0)) - (0.5 * pi); + line (0.5 * sin (cirp), 0.0, 0.5 * cos (cirp), 0.5 * sin (cirq), 0.0, 0.5 * cos (cirq)); + } %} END diff --git a/mcstas-comps/contrib/Lens.comp b/mcstas-comps/contrib/Lens.comp index 45e3fddf8..8f53cd7ac 100644 --- a/mcstas-comps/contrib/Lens.comp +++ b/mcstas-comps/contrib/Lens.comp @@ -121,52 +121,51 @@ p_interact=0.1,focus_aw=10,focus_ah=10,RMS=0, string geometry=0) SHARE %{ -/* support for OFF/PLY geometry */ -%include "read_table-lib" -%include "interoff-lib" + /* support for OFF/PLY geometry */ + %include "read_table-lib" + %include "interoff-lib" -/* Lens_roughness: function to rotate normal vector around axis for roughness -* with specified tilt angle (deg) + /* Lens_roughness: function to rotate normal vector around axis for roughness + * with specified tilt angle (deg) * RETURNS: rotated nx,ny,nz coordinates */ -#pragma acc routine seq - void Lens_roughness(double *nx, double *ny, double *nz, double tilt, _class_particle* _particle) - { - double nt_x, nt_y, nt_z; /* transverse vector */ - double n1_x, n1_y, n1_z; /* normal vector (tmp) */ + #pragma acc routine seq + void + Lens_roughness (double* nx, double* ny, double* nz, double tilt, _class_particle* _particle) { + double nt_x, nt_y, nt_z; /* transverse vector */ + double n1_x, n1_y, n1_z; /* normal vector (tmp) */ /* normal vector n_z = [ 0,1,0], n_t = n x n_z; */ - vec_prod(nt_x,nt_y,nt_z, *nx,*ny,*nz, 0,1,0); + vec_prod (nt_x, nt_y, nt_z, *nx, *ny, *nz, 0, 1, 0); /* rotate n with angle wav_z around n_t -> n1 */ - tilt *= DEG2RAD/(sqrt(8*log(2)))*randnorm(); - rotate(n1_x,n1_y,n1_z, *nx,*ny,*nz, tilt, nt_x,nt_y,nt_z); + tilt *= DEG2RAD / (sqrt (8 * log (2))) * randnorm (); + rotate (n1_x, n1_y, n1_z, *nx, *ny, *nz, tilt, nt_x, nt_y, nt_z); /* rotate n1 with angle phi around n -> nt */ - rotate(nt_x,nt_y,nt_z, n1_x,n1_y,n1_z, 2*PI*rand01(), *nx,*ny,*nz); + rotate (nt_x, nt_y, nt_z, n1_x, n1_y, n1_z, 2 * PI * rand01 (), *nx, *ny, *nz); - *nx=nt_x; - *ny=nt_y; - *nz=nt_z; + *nx = nt_x; + *ny = nt_y; + *nz = nt_z; } -/* parabola_intersect: Calculate intersection between a line and a parabola with -* axis along z, focal length f, centered at (0,0,0) - * RETURNS 0 when no intersection is found - * or 1 in case of intersection with resulting times t0 and t1 */ -#pragma acc routine seq - int parabola_intersect(double *t0, double *t1, double x, double y, double z, - double vx, double vy, double vz, double f) - { - /* equation of line: (x,y,z) = (vx,vy,vz)*t+(x,y,z)_0 */ - /* equation of parabola: z = (x^2+y^2)/4/f - that is: 4*f*(vz*t+z0) = (vx*t+x0)^2 + (vy*t+y0)^2 */ - - double A = vx*vx+vy*vy; - double B = 2*vx*x+2*vy*y-4*vz*f; - double C = x*x+y*y-4*f*z; - - return(solve_2nd_order(t0, t1, A,B,C)); + /* parabola_intersect: Calculate intersection between a line and a parabola with + * axis along z, focal length f, centered at (0,0,0) + * RETURNS 0 when no intersection is found + * or 1 in case of intersection with resulting times t0 and t1 */ + #pragma acc routine seq + int + parabola_intersect (double* t0, double* t1, double x, double y, double z, double vx, double vy, double vz, double f) { + /* equation of line: (x,y,z) = (vx,vy,vz)*t+(x,y,z)_0 */ + /* equation of parabola: z = (x^2+y^2)/4/f + that is: 4*f*(vz*t+z0) = (vx*t+x0)^2 + (vy*t+y0)^2 */ + + double A = vx * vx + vy * vy; + double B = 2 * vx * x + 2 * vy * y - 4 * vz * f; + double C = x * x + y * y - 4 * f * z; + + return (solve_2nd_order (t0, t1, A, B, C)); } /* Lens_intersect: function to compute intersection with lens surface @@ -180,35 +179,35 @@ SHARE * neutron must then be propagated on the surface with PROP_DT, * and checked for actual intersection. */ -#pragma acc routine seq - double Lens_intersect(double x,double y,double z, - double vx,double vy,double vz, - double shift, double radius, - int type, double arg) - { + #pragma acc routine seq + double + Lens_intersect (double x, double y, double z, double vx, double vy, double vz, double shift, double radius, int type, double arg) { double t0, t1; - if (!vz || !type || !radius) return -1; - if (type==1 && arg) { /* spherical */ - if (sphere_intersect(&t0,&t1, x,y,z+shift+arg, vx,vy,vz, fabs(arg))) { - return ( arg > 0 ? t1 : t0 ); /* concave : convex surface */ + if (!vz || !type || !radius) + return -1; + if (type == 1 && arg) { /* spherical */ + if (sphere_intersect (&t0, &t1, x, y, z + shift + arg, vx, vy, vz, fabs (arg))) { + return (arg > 0 ? t1 : t0); /* concave : convex surface */ } else - return(-1); - } else if (type==2 && arg) { /* parabolic */ - if (parabola_intersect(&t0, &t1, x,y,z+shift, vx,vy,vz, arg)) { - if (t0 < 0 && 0 < t1) return(t1); - if (t1 < 0 && 0 < t0) return(t0); - return(t1 < t0 ? t1 : t0); + return (-1); + } else if (type == 2 && arg) { /* parabolic */ + if (parabola_intersect (&t0, &t1, x, y, z + shift, vx, vy, vz, arg)) { + if (t0 < 0 && 0 < t1) + return (t1); + if (t1 < 0 && 0 < t0) + return (t0); + return (t1 < t0 ? t1 : t0); } else - return(-1); + return (-1); /* end parabola */ - } else if (type==3) { /* planar */ - if (plane_intersect(&t0, x,y,z+shift, vx,vy,vz, -sin(arg),0,-cos(arg), 0,0,0)>0) - return(t0); + } else if (type == 3) { /* planar */ + if (plane_intersect (&t0, x, y, z + shift, vx, vy, vz, -sin (arg), 0, -cos (arg), 0, 0, 0) > 0) + return (t0); else - return(-1); - } else /* unsupported geometry */ - return(-1); + return (-1); + } else /* unsupported geometry */ + return (-1); } %} @@ -226,24 +225,22 @@ DECLARE INITIALIZE %{ /* density: Number of atoms by AA^3, pow(10,-24) stands for conversion from cm^3 to AA^3 */ - if (density<=0 || weight<=0) - exit(printf("Lens: %s: FATAL: invalid material density or molar weight: density=%g weight=%g\n", - NAME_CURRENT_COMP, density, weight)); - rho= density*6.02214179*1e23*1e-24/weight; - if (sigma_coh==0) - exit(printf("Lens: %s: FATAL: invalid material coherent cross section: sigma_coh=%g\n", - NAME_CURRENT_COMP, sigma_coh)); - bc=sqrt(fabs(sigma_coh)*100/4/PI)*1e-5; /* bound coherent cross section */ - if (sigma_coh<0) bc *= -1; - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { + if (density <= 0 || weight <= 0) + exit (printf ("Lens: %s: FATAL: invalid material density or molar weight: density=%g weight=%g\n", NAME_CURRENT_COMP, density, weight)); + rho = density * 6.02214179 * 1e23 * 1e-24 / weight; + if (sigma_coh == 0) + exit (printf ("Lens: %s: FATAL: invalid material coherent cross section: sigma_coh=%g\n", NAME_CURRENT_COMP, sigma_coh)); + bc = sqrt (fabs (sigma_coh) * 100 / 4 / PI) * 1e-5; /* bound coherent cross section */ + if (sigma_coh < 0) + bc *= -1; + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { #ifndef USE_OFF - fprintf(stderr,"Error: You are attempting to use an OFF geometry without -DUSE_OFF. You will need to recompile with that define set!\n"); - exit(-1); + fprintf (stderr, "Error: You are attempting to use an OFF geometry without -DUSE_OFF. You will need to recompile with that define set!\n"); + exit (-1); #else /* init the OFF/PLY without centering and scaling */ - if (!off_init(geometry, 0, 0, 0, 1, &offdata)) - exit(printf("Lens: %s: FATAL: could not initialize geometry file %s [OFF/PLY]\n", - NAME_CURRENT_COMP, geometry)); + if (!off_init (geometry, 0, 0, 0, 1, &offdata)) + exit (printf ("Lens: %s: FATAL: could not initialize geometry file %s [OFF/PLY]\n", NAME_CURRENT_COMP, geometry)); #endif } @@ -252,323 +249,361 @@ INITIALIZE focus_aw *= DEG2RAD; focus_ah *= DEG2RAD; - my_s = rho * 100 *(sigma_inc+sigma_coh); - my_a_v= rho * 100 * sigma_abs; + my_s = rho * 100 * (sigma_inc + sigma_coh); + my_a_v = rho * 100 * sigma_abs; %} TRACE %{ -double n; /* refractive index */ -double v, lambda; /* neutron speed and wavelength */ -double dt; /* time to intersection */ -double theta_RMS; -double nx=0, ny=0, nz=0; /* normal vector to surface */ -double ax, ay, az; /* temporary vector for surface refraction */ -double alpha1, beta1, theta1, theta2; /* angles for refraction computation */ - -#ifdef OPENACC -#ifdef USE_OFF -off_struct thread_offdata = offdata; -#endif -#else -#define thread_offdata offdata -#endif - -/* iterate two faces intersection until no more is possible */ -do { - /* ======================== First face of the lens ========================== */ - /* determine intersection time */ - nx=ny=nz=0; + double n; /* refractive index */ + double v, lambda; /* neutron speed and wavelength */ + double dt; /* time to intersection */ + double theta_RMS; + double nx = 0, ny = 0, nz = 0; /* normal vector to surface */ + double ax, ay, az; /* temporary vector for surface refraction */ + double alpha1, beta1, theta1, theta2; /* angles for refraction computation */ + + #ifdef OPENACC #ifdef USE_OFF - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { - double t1=0,t0=0; - Coords n, n0, n1; - n=n0=n1=coords_set(0,0,0); - int intersect=off_intersect (&t0, &t1, &n0, &n1, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); - if (!intersect) dt=-1; - else if (t0 < 0 && 0 < t1) { dt = t1; n=n1; } - else if (t1 < 0 && 0 < t0) { dt = t0; n=n0; } - else { - if (t1 < t0) { dt=t1; n=n1; } - else { dt=t0; n=n0; } - } - coords_get(n, &nx, &ny, &nz); - } else + off_struct thread_offdata = offdata; #endif - if (r1 && !focus1) { - dt = Lens_intersect(x,y,z, vx, vy, vz, thickness/2, radius, 1, r1); - } else if (!r1 && focus1){ - if (focus1>0){ - dt = Lens_intersect(x,y,z, vx, vy, vz, thickness/2, radius, 2, -focus1); - }else{ - dt = Lens_intersect(x,y,z, vx, vy, vz, thickness/2 + radius*radius/(4*fabs(focus1)) , radius, 2, -focus1); + #else + #define thread_offdata offdata + #endif + + /* iterate two faces intersection until no more is possible */ + do { + /* ======================== First face of the lens ========================== */ + /* determine intersection time */ + nx = ny = nz = 0; + #ifdef USE_OFF + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { + double t1 = 0, t0 = 0; + Coords n, n0, n1; + n = n0 = n1 = coords_set (0, 0, 0); + int intersect = off_intersect (&t0, &t1, &n0, &n1, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + if (!intersect) + dt = -1; + else if (t0 < 0 && 0 < t1) { + dt = t1; + n = n1; + } else if (t1 < 0 && 0 < t0) { + dt = t0; + n = n0; + } else { + if (t1 < t0) { + dt = t1; + n = n1; + } else { + dt = t0; + n = n0; + } + } + coords_get (n, &nx, &ny, &nz); + } else + #endif + if (r1 && !focus1) { + dt = Lens_intersect (x, y, z, vx, vy, vz, thickness / 2, radius, 1, r1); + } else if (!r1 && focus1) { + if (focus1 > 0) { + dt = Lens_intersect (x, y, z, vx, vy, vz, thickness / 2, radius, 2, -focus1); + } else { + dt = Lens_intersect (x, y, z, vx, vy, vz, thickness / 2 + radius * radius / (4 * fabs (focus1)), radius, 2, -focus1); + } + } else { + dt = Lens_intersect (x, y, z, vx, vy, vz, thickness / 2, radius, 3, phiy1); + } + if (dt <= 0) + break; /* no intersection: exit from main loop */ + + /* propagate to surface (1) */ + PROP_DT (dt); + + /* check for lens cross section (radius) */ + if (radius && x * x + y * y > radius * radius) + break; /* outside from cross section: exit from main loop */ + SCATTER; + + v = sqrt (vx * vx + vy * vy + vz * vz); + + if (v) + lambda = 3956.0032 / v; + else + ABSORB; + + /* compute refractive index */ + /* without inc nor abs: n = sqrt(1-(lambda*lambda*rho*bc/PI)); */ + /* M. L. Goldberger et al, Phys. Rev. 71, 294 - 310 (1947) */ + /* alpha1 = (sigma_inc+sigma_abs*2200/v)/2/lambda; + n = 1-lambda*lambda*rho/2/PI*sqrt(bc*bc-alpha1*alpha1); */ + n = sqrt (1 - (lambda * lambda * rho * bc / PI)); + + #pragma acc atomic + mean_n += n * p; + #pragma acc atomic + events += p; + + theta_RMS = atan (2 * RMS / lambda); /* cone angle from RMS roughness */ + + /* compute normal vector (1) when not given by OFF/PLY */ + if (!nx && !ny && !nz) { + dt = 0; + if (r1 && !focus1) { + double sign = r1 / fabs (r1); + nx = -sign * x; + ny = -sign * y; + nz = sign * (-z - thickness / 2 - r1); + } else if (!r1 && focus1) { + nx = -x / 2 / focus1; + ny = -y / 2 / focus1; + nz = -1; + } else { + nx = -sin (phiy1); + ny = 0; + nz = -cos (phiy1); } - } else { - dt = Lens_intersect(x,y,z, vx, vy, vz, thickness/2, radius, 3, phiy1); - } - if (dt <= 0) break; /* no intersection: exit from main loop */ - - /* propagate to surface (1) */ - PROP_DT(dt); - - /* check for lens cross section (radius) */ - if (radius && x*x+y*y > radius*radius) break; /* outside from cross section: exit from main loop */ - SCATTER; - - v=sqrt(vx*vx+vy*vy+vz*vz); - - if (v) lambda=3956.0032/v; else ABSORB; - - /* compute refractive index */ - /* without inc nor abs: n = sqrt(1-(lambda*lambda*rho*bc/PI)); */ - /* M. L. Goldberger et al, Phys. Rev. 71, 294 - 310 (1947) */ - /* alpha1 = (sigma_inc+sigma_abs*2200/v)/2/lambda; - n = 1-lambda*lambda*rho/2/PI*sqrt(bc*bc-alpha1*alpha1); */ - n = sqrt(1-(lambda*lambda*rho*bc/PI)); - -#pragma acc atomic - mean_n += n*p; -#pragma acc atomic - events += p; - - theta_RMS=atan(2*RMS/lambda); /* cone angle from RMS roughness */ - - /* compute normal vector (1) when not given by OFF/PLY */ - if (!nx && !ny && !nz) { - dt = 0; - if (r1 && !focus1) { - double sign=r1/fabs(r1); - nx=-sign*x; - ny=-sign*y; - nz=sign*(-z-thickness/2-r1); - } else if (!r1 && focus1) { - nx=-x/2/focus1; - ny=-y/2/focus1; - nz=-1; - } else { - nx=-sin(phiy1); - ny=0; - nz=-cos(phiy1); } - } - /* tilt normal vector for roughness, in cone theta_RMS */ - if (RMS>0) Lens_roughness(&nx, &ny, &nz, theta_RMS, _particle); + /* tilt normal vector for roughness, in cone theta_RMS */ + if (RMS > 0) + Lens_roughness (&nx, &ny, &nz, theta_RMS, _particle); - /* compute incoming angles w.r.t surface */ - NORM(nx,ny,nz); - vec_prod(ax,ay,az,nx,ny,nz,-vx,-vy,-vz); - /* if n and v are parallel - no refraction.*/ - if (ax!=0 || ay!=0 || az!=0){ - theta1 = atan2(sqrt(ax*ax+ay*ay+az*az),scalar_prod(nx,ny,nz,-vx,-vy,-vz)); + /* compute incoming angles w.r.t surface */ + NORM (nx, ny, nz); + vec_prod (ax, ay, az, nx, ny, nz, -vx, -vy, -vz); + /* if n and v are parallel - no refraction.*/ + if (ax != 0 || ay != 0 || az != 0) { + theta1 = atan2 (sqrt (ax * ax + ay * ay + az * az), scalar_prod (nx, ny, nz, -vx, -vy, -vz)); /* Fresnel formula for refraction */ - theta2 = asin(sin(theta1)/n); + theta2 = asin (sin (theta1) / n); /* compute new velocity after refraction */ - alpha1 = (sin(theta2))/(sin(theta1)); - beta1 = (alpha1*v*cos(theta1))-(v*cos(theta2)); - vx = beta1*nx + alpha1*vx; - vy = beta1*ny + alpha1*vy; - vz = beta1*nz + alpha1*vz; - } - /* ======================== Second face of the lens ========================= */ - /* determine intersection time to go to second surface */ - nx=ny=nz=0; - #ifdef USE_OFF - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { - double t1=0,t0=0; - Coords n, n0, n1; - n=n0=n1=coords_set(0,0,0); - int intersect=off_intersect (&t0, &t1, &n0, &n1, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); - if (!intersect) dt=-1; - else if (t0 < 0 && 0 < t1) { dt = t1; n=n1; } - else if (t1 < 0 && 0 < t0) { dt = t0; n=n0; } - else { - if (t1 < t0) { dt=t1; n=n1; } - else { dt=t0; n=n0; } + alpha1 = (sin (theta2)) / (sin (theta1)); + beta1 = (alpha1 * v * cos (theta1)) - (v * cos (theta2)); + vx = beta1 * nx + alpha1 * vx; + vy = beta1 * ny + alpha1 * vy; + vz = beta1 * nz + alpha1 * vz; } - coords_get(n, &nx, &ny, &nz); - } else - #endif - if (r2 && !focus2) - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 1, -r2); - else if (!r2 && focus2){ - if (focus2>0){ - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 2, focus2); - }else{ - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2 - radius*radius/(4*fabs(focus2)) , radius, 2, focus2); + /* ======================== Second face of the lens ========================= */ + /* determine intersection time to go to second surface */ + nx = ny = nz = 0; + #ifdef USE_OFF + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { + double t1 = 0, t0 = 0; + Coords n, n0, n1; + n = n0 = n1 = coords_set (0, 0, 0); + int intersect = off_intersect (&t0, &t1, &n0, &n1, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + if (!intersect) + dt = -1; + else if (t0 < 0 && 0 < t1) { + dt = t1; + n = n1; + } else if (t1 < 0 && 0 < t0) { + dt = t0; + n = n0; + } else { + if (t1 < t0) { + dt = t1; + n = n1; + } else { + dt = t0; + n = n0; + } } - }else{ - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 3, phiy2); - } - if (dt <= 0) break; /* no intersection: exit from main loop */ - - /* =============== Absorption and scattering between the two faces =========== */ - double my_a,my_t,p_trans,p_scatt,mc_trans,mc_scatt,ws,d_path; - double p_mult=1; - int flag=0; - double l_i=0; - double solid_angle=0; - - my_a = my_a_v*(2200/v); - my_t = my_a + my_s; - ws = my_s/my_t; /* (inc+coh)/(inc+coh+abs) */ - - d_path = v * dt; - - /* Proba of transmission along length d_path */ - p_trans = exp(-my_t*d_path); - p_scatt = 1 - p_trans; - - flag = 0; /* flag used for propagation to exit point before ending */ - /* are we next to the exit ? probably no scattering (avoid rounding errors) */ - if (my_s*d_path <= 4e-7) { - flag = 1; /* No interaction before the exit */ - } - - /* force a given fraction of the beam to scatter */ - if (p_interact>0 && p_interact<=1) { - /* we force a portion of the beam to interact */ - /* This is used to improve statistics on single scattering (and multiple) */ - mc_trans = 1-p_interact; - } else { - mc_trans = p_trans; /* 1 - p_scatt */ - } + coords_get (n, &nx, &ny, &nz); + } else + #endif + if (r2 && !focus2) + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 1, -r2); + else if (!r2 && focus2) { + if (focus2 > 0) { + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 2, focus2); + } else { + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2 - radius * radius / (4 * fabs (focus2)), radius, 2, focus2); + } + } else { + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 3, phiy2); + } + if (dt <= 0) + break; /* no intersection: exit from main loop */ + + /* =============== Absorption and scattering between the two faces =========== */ + double my_a, my_t, p_trans, p_scatt, mc_trans, mc_scatt, ws, d_path; + double p_mult = 1; + int flag = 0; + double l_i = 0; + double solid_angle = 0; + + my_a = my_a_v * (2200 / v); + my_t = my_a + my_s; + ws = my_s / my_t; /* (inc+coh)/(inc+coh+abs) */ + + d_path = v * dt; + + /* Proba of transmission along length d_path */ + p_trans = exp (-my_t * d_path); + p_scatt = 1 - p_trans; + + flag = 0; /* flag used for propagation to exit point before ending */ + /* are we next to the exit ? probably no scattering (avoid rounding errors) */ + if (my_s * d_path <= 4e-7) { + flag = 1; /* No interaction before the exit */ + } - mc_scatt = 1 - mc_trans; /* portion of beam to scatter (or force to) */ - if (mc_scatt <= 0 || mc_scatt>1) flag=1; + /* force a given fraction of the beam to scatter */ + if (p_interact > 0 && p_interact <= 1) { + /* we force a portion of the beam to interact */ + /* This is used to improve statistics on single scattering (and multiple) */ + mc_trans = 1 - p_interact; + } else { + mc_trans = p_trans; /* 1 - p_scatt */ + } - /* MC choice: Interaction or transmission ? */ - if (!flag && mc_scatt > 0 && (mc_scatt >= 1 || (rand01()) < mc_scatt)) { /* Interaction neutron/sample */ - p_mult *= ws; /* Update weight ; account for absorption and retain scattered fraction */ - /* we have chosen portion mc_scatt of beam instead of p_scatt, so we compensate */ - p_mult *= fabs(p_scatt/mc_scatt); /* lower than 1 */ - } else { - flag = 1; /* Transmission : no interaction neutron/sample */ - p_mult *= fabs(p_trans/mc_trans); /* attenuate beam by portion which is scattered (and left along) */ - } + mc_scatt = 1 - mc_trans; /* portion of beam to scatter (or force to) */ + if (mc_scatt <= 0 || mc_scatt > 1) + flag = 1; - if (flag) { /* propagate directly to secound surface */ - if (!isnan(p_mult)) { - p *= p_mult; /* apply absorption correction */ + /* MC choice: Interaction or transmission ? */ + if (!flag && mc_scatt > 0 && (mc_scatt >= 1 || (rand01 ()) < mc_scatt)) { /* Interaction neutron/sample */ + p_mult *= ws; /* Update weight ; account for absorption and retain scattered fraction */ + /* we have chosen portion mc_scatt of beam instead of p_scatt, so we compensate */ + p_mult *= fabs (p_scatt / mc_scatt); /* lower than 1 */ } else { - ABSORB; + flag = 1; /* Transmission : no interaction neutron/sample */ + p_mult *= fabs (p_trans / mc_trans); /* attenuate beam by portion which is scattered (and left along) */ } - } - else - { - double a; - if (my_t*d_path < 1e-6){ - /* For very weak scattering, use simple uniform sampling of scattering - point to avoid rounding errors. */ - dt = rand0max(d_path); /* length */ + + if (flag) { /* propagate directly to secound surface */ + if (!isnan (p_mult)) { + p *= p_mult; /* apply absorption correction */ + } else { + ABSORB; + } } else { - a = rand0max((1 - exp(-my_t*d_path))); - dt = -log(1 - a) / my_t; /* length */ - } + double a; + if (my_t * d_path < 1e-6) { + /* For very weak scattering, use simple uniform sampling of scattering + point to avoid rounding errors. */ + dt = rand0max (d_path); /* length */ + } else { + a = rand0max ((1 - exp (-my_t * d_path))); + dt = -log (1 - a) / my_t; /* length */ + } - l_i = dt;/* Penetration in sample: scattering+abs */ - dt /= v; /* Time from present position to scattering point */ - PROP_DT(dt); /* Point of scattering */ + l_i = dt; /* Penetration in sample: scattering+abs */ + dt /= v; /* Time from present position to scattering point */ + PROP_DT (dt); /* Point of scattering */ - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle,0,0,1, focus_aw, focus_ah, ROT_A_CURRENT_COMP); - NORM(vx, vy, vz); + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, 0, 0, 1, focus_aw, focus_ah, ROT_A_CURRENT_COMP); + NORM (vx, vy, vz); - vx*=v; - vy*=v; - vz*=v; + vx *= v; + vy *= v; + vz *= v; - p_mult *= solid_angle/4/PI; - if (!isnan(p_mult)) { - p *= p_mult; - } else { + p_mult *= solid_angle / 4 / PI; + if (!isnan (p_mult)) { + p *= p_mult; + } else { ABSORB; - } - SCATTER; - - /* recompute new intersection time to go to second surface (velocity changed during scattering event) */ - nx=ny=nz=0; - #ifdef USE_OFF - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { - double t1=0,t0=0; - Coords n, n0, n1; - n=n0=n1=coords_set(0,0,0); - int intersect=off_intersect (&t0, &t1, &n0, &n1, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); - if (!intersect) dt=-1; - else if (t0 < 0 && 0 < t1) { dt = t1; n=n1; } - else if (t1 < 0 && 0 < t0) { dt = t0; n=n0; } - else { - if (t1 < t0) { dt=t1; n=n1; } - else { dt=t0; n=n0; } - } - coords_get(n, &nx, &ny, &nz); - } else - #endif - if (r2 && !focus2) - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 1, -r2); - else if (!r2 && focus2) - if (focus2>0){ - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 2, focus2); - }else{ - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2 - radius*radius/(4*fabs(focus2)) , radius, 2, focus2); } - else - dt = Lens_intersect(x,y,z, vx, vy, vz, -thickness/2, radius, 3, phiy2); - - if (dt <= 0) break; /* no intersection: exit from main loop */ + SCATTER; + + /* recompute new intersection time to go to second surface (velocity changed during scattering event) */ + nx = ny = nz = 0; + #ifdef USE_OFF + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { + double t1 = 0, t0 = 0; + Coords n, n0, n1; + n = n0 = n1 = coords_set (0, 0, 0); + int intersect = off_intersect (&t0, &t1, &n0, &n1, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + if (!intersect) + dt = -1; + else if (t0 < 0 && 0 < t1) { + dt = t1; + n = n1; + } else if (t1 < 0 && 0 < t0) { + dt = t0; + n = n0; + } else { + if (t1 < t0) { + dt = t1; + n = n1; + } else { + dt = t0; + n = n0; + } + } + coords_get (n, &nx, &ny, &nz); + } else + #endif + if (r2 && !focus2) + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 1, -r2); + else if (!r2 && focus2) + if (focus2 > 0) { + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 2, focus2); + } else { + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2 - radius * radius / (4 * fabs (focus2)), radius, 2, focus2); + } + else + dt = Lens_intersect (x, y, z, vx, vy, vz, -thickness / 2, radius, 3, phiy2); - } /* end scattering handling in material*/ + if (dt <= 0) + break; /* no intersection: exit from main loop */ - /* propagate to surface */ - PROP_DT(dt); + } /* end scattering handling in material*/ - /* check for lens cross section (radius) */ - if (radius && x*x+y*y > radius*radius) break; /* outside from cross section: exit from main loop */ - SCATTER; + /* propagate to surface */ + PROP_DT (dt); - v=sqrt(vx*vx+vy*vy+vz*vz); + /* check for lens cross section (radius) */ + if (radius && x * x + y * y > radius * radius) + break; /* outside from cross section: exit from main loop */ + SCATTER; - /* compute normal vector (2) when not given by OFF/PLY */ - if (!nx && !ny && !nz) { - dt = 0; - if (r2 && !focus2) { - double sign=r2/fabs(r2); - nx=sign*x; - ny=sign*y; - nz=sign*(z-thickness/2-r2); - } else if (!r2 && focus2){ - nx=x/2/focus2; - ny=y/2/focus2; - nz=-1; - } else { - nx=-sin(phiy2); - ny=0; - nz=-cos(phiy2); + v = sqrt (vx * vx + vy * vy + vz * vz); + + /* compute normal vector (2) when not given by OFF/PLY */ + if (!nx && !ny && !nz) { + dt = 0; + if (r2 && !focus2) { + double sign = r2 / fabs (r2); + nx = sign * x; + ny = sign * y; + nz = sign * (z - thickness / 2 - r2); + } else if (!r2 && focus2) { + nx = x / 2 / focus2; + ny = y / 2 / focus2; + nz = -1; + } else { + nx = -sin (phiy2); + ny = 0; + nz = -cos (phiy2); + } } - } - /* tilt normal vector for roughness, in cone theta_RMS */ - if (RMS>0) Lens_roughness(&nx, &ny, &nz, theta_RMS, _particle); + /* tilt normal vector for roughness, in cone theta_RMS */ + if (RMS > 0) + Lens_roughness (&nx, &ny, &nz, theta_RMS, _particle); - /* compute incoming angles w.r.t surface */ - NORM(nx,ny,nz); - vec_prod(ax,ay,az,nx,ny,nz,-vx,-vy,-vz); - /* if n and v are parallel - no refraction.*/ - if (ax!=0 || ay!=0 || az!=0){ - theta1 = atan2(sqrt(ax*ax+ay*ay+az*az),scalar_prod(nx,ny,nz,-vx,-vy,-vz)); + /* compute incoming angles w.r.t surface */ + NORM (nx, ny, nz); + vec_prod (ax, ay, az, nx, ny, nz, -vx, -vy, -vz); + /* if n and v are parallel - no refraction.*/ + if (ax != 0 || ay != 0 || az != 0) { + theta1 = atan2 (sqrt (ax * ax + ay * ay + az * az), scalar_prod (nx, ny, nz, -vx, -vy, -vz)); /* Fresnel formula for refraction */ - theta2=asin(sin(theta1)*n); + theta2 = asin (sin (theta1) * n); /* compute new velocity after refraction */ - alpha1 = (sin(theta2))/(sin(theta1)); - beta1 = (alpha1*v*cos(theta1))-(v*cos(theta2)); - vx = beta1*nx + alpha1*vx; - vy = beta1*ny + alpha1*vy; - vz = beta1*nz + alpha1*vz; - } -} while (dt>0); /* loop until no more intersection */ - + alpha1 = (sin (theta2)) / (sin (theta1)); + beta1 = (alpha1 * v * cos (theta1)) - (v * cos (theta2)); + vx = beta1 * nx + alpha1 * vx; + vy = beta1 * ny + alpha1 * vy; + vz = beta1 * nz + alpha1 * vz; + } + } while (dt > 0); /* loop until no more intersection */ %} FINALLY %{ @@ -596,214 +631,209 @@ FINALLY %{ MCDISPLAY %{ - magnify("xy"); - double theta1,theta00=0,theta01=0,eps,eps2,theta_line,distance,height,height2,dist_parab1,dist_parab2; - height=radius/2; - height2=radius/2; - dist_parab1=0.0; - dist_parab2=0.0; + magnify ("xy"); + double theta1, theta00 = 0, theta01 = 0, eps, eps2, theta_line, distance, height, height2, dist_parab1, dist_parab2; + height = radius / 2; + height2 = radius / 2; + dist_parab1 = 0.0; + dist_parab2 = 0.0; /* draw circles to describe the 2 surfaces */ - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { /* OFF file */ - off_display(offdata); - } - else { + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { /* OFF file */ + off_display (offdata); + } else { if (r1 && !focus1) { /* sphere1 */ - theta00=asin(fabs((radius/2)/r1)); - if (r1<0 && r2<=0 && (-r1+r1*cos(theta00)>thickness/2) ){ - theta00=acos((fabs(r1)-thickness/2)/fabs(r1)); - height=fabs(r1)*sin(theta00); + theta00 = asin (fabs ((radius / 2) / r1)); + if (r1 < 0 && r2 <= 0 && (-r1 + r1 * cos (theta00) > thickness / 2)) { + theta00 = acos ((fabs (r1) - thickness / 2) / fabs (r1)); + height = fabs (r1) * sin (theta00); } - theta1=-theta00; - eps=theta00/4; - eps2=2*PI/4; - while (theta1<0) { - circle("xy",0,0,-thickness/2-r1+r1*cos(theta1),fabs(r1)*sin(theta1)); - theta1+=eps; - theta_line=0; - while (theta_line<2*PI){ - line(fabs(r1)*sin(theta1-eps)*cos(theta_line),fabs(r1)*sin(theta1-eps)*sin(theta_line),-thickness/2-r1+r1*cos(theta1-eps),fabs(r1)*sin(theta1)*cos(theta_line),fabs(r1)*sin(theta1)*sin(theta_line),-thickness/2-r1+r1*cos(theta1)); - theta_line+=eps2; + theta1 = -theta00; + eps = theta00 / 4; + eps2 = 2 * PI / 4; + while (theta1 < 0) { + circle ("xy", 0, 0, -thickness / 2 - r1 + r1 * cos (theta1), fabs (r1) * sin (theta1)); + theta1 += eps; + theta_line = 0; + while (theta_line < 2 * PI) { + line (fabs (r1) * sin (theta1 - eps) * cos (theta_line), fabs (r1) * sin (theta1 - eps) * sin (theta_line), + -thickness / 2 - r1 + r1 * cos (theta1 - eps), fabs (r1) * sin (theta1) * cos (theta_line), fabs (r1) * sin (theta1) * sin (theta_line), + -thickness / 2 - r1 + r1 * cos (theta1)); + theta_line += eps2; } } } else if (!r1 && focus1) { /* parabola1 */ - if (focus1>0){ - dist_parab1=-radius*radius/(4*focus1); + if (focus1 > 0) { + dist_parab1 = -radius * radius / (4 * focus1); } else { - dist_parab1=0.0; + dist_parab1 = 0.0; } - distance=-(radius*radius)/(4*focus1); - eps=-distance/4; - eps2=2*PI/4; - while (focus1*distance<0) { - if (focus1>0){ - circle("xy",0,0,distance-thickness/2,sqrt((4*focus1*fabs(distance)))); - distance+=eps; - theta_line=0; - while (theta_line<2*PI){ - line(sqrt(4*fabs(focus1)*(fabs(distance-eps)))*cos(theta_line),sqrt(4*fabs(focus1)*(fabs(distance-eps)))*sin(theta_line),distance-eps-thickness/2,sqrt(4*fabs(focus1)*fabs(distance))*cos(theta_line),sqrt(4*fabs(focus1)*fabs(distance))*sin(theta_line),distance-thickness/2); - theta_line+=eps2; + distance = -(radius * radius) / (4 * focus1); + eps = -distance / 4; + eps2 = 2 * PI / 4; + while (focus1 * distance < 0) { + if (focus1 > 0) { + circle ("xy", 0, 0, distance - thickness / 2, sqrt ((4 * focus1 * fabs (distance)))); + distance += eps; + theta_line = 0; + while (theta_line < 2 * PI) { + line (sqrt (4 * fabs (focus1) * (fabs (distance - eps))) * cos (theta_line), sqrt (4 * fabs (focus1) * (fabs (distance - eps))) * sin (theta_line), + distance - eps - thickness / 2, sqrt (4 * fabs (focus1) * fabs (distance)) * cos (theta_line), + sqrt (4 * fabs (focus1) * fabs (distance)) * sin (theta_line), distance - thickness / 2); + theta_line += eps2; } } else { - theta_line=0; - double rp,rpe,zz; - rp=sqrt(4*fabs(focus1)*fabs(distance)); - zz=-thickness/2-radius*radius/(4*fabs(focus1))+distance; - circle("xy",0,0,zz,rp); - distance+=eps; - zz=-thickness/2-radius*radius/(4*fabs(focus1))+distance; - rpe=sqrt(4*fabs(focus1)*fabs(distance)); - - theta_line=0; - while (theta_line<2*PI){ - line(rpe*cos(theta_line),rpe*sin(theta_line),zz, rp*cos(theta_line), rp*sin(theta_line), zz-eps); - theta_line+=eps2; + theta_line = 0; + double rp, rpe, zz; + rp = sqrt (4 * fabs (focus1) * fabs (distance)); + zz = -thickness / 2 - radius * radius / (4 * fabs (focus1)) + distance; + circle ("xy", 0, 0, zz, rp); + distance += eps; + zz = -thickness / 2 - radius * radius / (4 * fabs (focus1)) + distance; + rpe = sqrt (4 * fabs (focus1) * fabs (distance)); + + theta_line = 0; + while (theta_line < 2 * PI) { + line (rpe * cos (theta_line), rpe * sin (theta_line), zz, rp * cos (theta_line), rp * sin (theta_line), zz - eps); + theta_line += eps2; } } } - } else { /* plane 1 */ + } else { /* plane 1 */ /* phiy1 is rotation angle around 'y' at z=-thickness. width/height is radius. */ - double x1= height2*cos(phiy1); - double y1= height2; - double z1=-height2*sin(phiy1)-thickness/2; - multiline(5, x1, y1, z1, - x1, -y1, z1, - -x1, -y1,-z1, - -x1, y1,-z1, - x1, y1, z1); + double x1 = height2 * cos (phiy1); + double y1 = height2; + double z1 = -height2 * sin (phiy1) - thickness / 2; + multiline (5, x1, y1, z1, x1, -y1, z1, -x1, -y1, -z1, -x1, y1, -z1, x1, y1, z1); } - if (r2 && !focus2) { /* sphere 2 */ - theta01=asin(fabs((radius/2)/r2)); - if (r1<=0&&r2<0&&(r2-r2*cos(theta01)<-thickness/2)){ - theta01=acos((fabs(r2)-thickness/2)/fabs(r2)); - height2=fabs(r2)*sin(theta01); + if (r2 && !focus2) { /* sphere 2 */ + theta01 = asin (fabs ((radius / 2) / r2)); + if (r1 <= 0 && r2 < 0 && (r2 - r2 * cos (theta01) < -thickness / 2)) { + theta01 = acos ((fabs (r2) - thickness / 2) / fabs (r2)); + height2 = fabs (r2) * sin (theta01); } - theta1=PI-theta01; - - eps=(PI-theta1)/4; - eps2=2*PI/4; - while (theta10){ - dist_parab2=radius*radius/(4*focus2); - }else{ - dist_parab2=0.0; + if (focus2 > 0) { + dist_parab2 = radius * radius / (4 * focus2); + } else { + dist_parab2 = 0.0; } - distance=(radius*radius)/(4*focus2); - height2=sqrt((4*focus2*fabs(distance))); - eps=-distance/4; - eps2=2*PI/4; - while (focus2*distance>0){ - if (focus2>0) { - circle("xy",0,0,distance+thickness/2,sqrt((4*fabs(focus2)*fabs(distance)))); - distance+=eps; - theta_line=0; - while (theta_line<2*PI) { - line(sqrt(4*focus2*(fabs(distance-eps)))*cos(theta_line),sqrt(4*focus2*(fabs(distance-eps)))*sin(theta_line),distance-eps+thickness/2,sqrt(4*focus2*fabs(distance))*cos(theta_line),sqrt(4*focus2*fabs(distance))*sin(theta_line),distance+thickness/2); - theta_line+=eps2; + distance = (radius * radius) / (4 * focus2); + height2 = sqrt ((4 * focus2 * fabs (distance))); + eps = -distance / 4; + eps2 = 2 * PI / 4; + while (focus2 * distance > 0) { + if (focus2 > 0) { + circle ("xy", 0, 0, distance + thickness / 2, sqrt ((4 * fabs (focus2) * fabs (distance)))); + distance += eps; + theta_line = 0; + while (theta_line < 2 * PI) { + line (sqrt (4 * focus2 * (fabs (distance - eps))) * cos (theta_line), sqrt (4 * focus2 * (fabs (distance - eps))) * sin (theta_line), + distance - eps + thickness / 2, sqrt (4 * focus2 * fabs (distance)) * cos (theta_line), sqrt (4 * focus2 * fabs (distance)) * sin (theta_line), + distance + thickness / 2); + theta_line += eps2; } } else { - double rp,rpe,zz; - rp=sqrt(4*fabs(focus2)*fabs(distance)); - zz=thickness/2+(radius*radius)/(4*fabs(focus2))+distance; - circle("xy",0,0,zz,rp); - distance+=eps; - zz=thickness/2+(radius*radius)/(4*fabs(focus2))+distance; - rpe=sqrt(4*fabs(focus2)*fabs(distance)); - - theta_line=0; - while (theta_line<2*PI){ - line(rpe*cos(theta_line),rpe*sin(theta_line),zz, rp*cos(theta_line), rp*sin(theta_line), zz-eps); - theta_line+=eps2; + double rp, rpe, zz; + rp = sqrt (4 * fabs (focus2) * fabs (distance)); + zz = thickness / 2 + (radius * radius) / (4 * fabs (focus2)) + distance; + circle ("xy", 0, 0, zz, rp); + distance += eps; + zz = thickness / 2 + (radius * radius) / (4 * fabs (focus2)) + distance; + rpe = sqrt (4 * fabs (focus2) * fabs (distance)); + + theta_line = 0; + while (theta_line < 2 * PI) { + line (rpe * cos (theta_line), rpe * sin (theta_line), zz, rp * cos (theta_line), rp * sin (theta_line), zz - eps); + theta_line += eps2; } } } } else { /* plane 2 */ /* phiy2 is rotation angle around 'y' at z=+thickness. width/height is radius. */ - double x1= height2*cos(phiy2); - double y1= height2; - double z1=-height2*sin(phiy2)+thickness/2; - multiline(5, x1, y1, z1, - x1, -y1, z1, - -x1, -y1,-z1, - -x1, y1,-z1, - x1, y1, z1); + double x1 = height2 * cos (phiy2); + double y1 = height2; + double z1 = -height2 * sin (phiy2) + thickness / 2; + multiline (5, x1, y1, z1, x1, -y1, z1, -x1, -y1, -z1, -x1, y1, -z1, x1, y1, z1); } /* draw outer containing cylinder */ - if (r1 && r2 && !focus1 && !focus2){ - line(-fabs(r1)*sin(theta00),-fabs(r1)*sin(theta00),-thickness/2-r1+r1*cos(theta00),-fabs(r2)*sin(theta01),fabs(r2)*sin(theta01),thickness/2+r2-r2*cos(theta01)); - line(fabs(r1)*sin(theta00),-fabs(r1)*sin(theta00),-thickness/2-r1+r1*cos(theta00),fabs(r2)*sin(theta01),fabs(r1)*sin(theta00),thickness/2+r2-r2*cos(theta01)); - line(-fabs(r1)*sin(theta00),-fabs(r1)*sin(theta00),-thickness/2-r1+r1*cos(theta00),fabs(r2)*sin(theta01),-fabs(r1)*sin(theta00),thickness/2+r2-r2*cos(theta01)); - line(-fabs(r1)*sin(theta00),fabs(r1)*sin(theta00),-thickness/2-r1+r1*cos(theta00),fabs(r2)*sin(theta01),fabs(r1)*sin(theta00),thickness/2+r2-r2*cos(theta01)); - } - else if (r1 && !r2) { - if (!focus2){ - line(-height,0,-thickness/2-r1+r1*cos(theta00),-height,0,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(height,0,-thickness/2-r1+r1*cos(theta00),height,0,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - line(0,-height,-thickness/2-r1+r1*cos(theta00),0,-height,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(0,height,-thickness/2-r1+r1*cos(theta00),0,height,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - } - else - { - line(-fabs(r1)*sin(theta00),0,-thickness/2-r1+r1*cos(theta00),-radius/2,0,thickness/2+radius*radius/(16*focus2)); - line(fabs(r1)*sin(theta00),0,-thickness/2-r1+r1*cos(theta00),radius/2,0,thickness/2+radius*radius/(16*focus2)); - } - } - else if (r2 && !r1) { - if (!focus1){ - line(-height2,0,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),-height2,0,thickness/2+r2-r2*cos(theta01)); - line(height2,0,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),height2,0,thickness/2+r2-r2*cos(theta01)); - line(0,height2,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),0,height2,thickness/2+r2-r2*cos(theta01)); - line(0,height2,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),0,height2,thickness/2+r2-r2*cos(theta01)); - } - else - { - line(-height2,0,-thickness/2-radius*radius/(16*focus1),-height2,0,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(height2,0,-thickness/2-radius*radius/(16*focus1),height2,0,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - line(0,height2,-thickness/2-radius*radius/(16*focus1),0,height2,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(0,height2,-thickness/2-radius*radius/(16*focus1),0,height2,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - } - } - else { - if (!focus1 && !focus2){ - line(-radius/2,0,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),-radius/2,0,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(radius/2,0,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),radius/2,0,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - line(0,-radius/2,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),0,-radius/2,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(0,radius/2,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),0,radius/2,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - } - else if (!focus1){ - line(-radius/2,0,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),-radius/2,0,thickness/2+dist_parab2); - line(radius/2,0,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),radius/2,0,thickness/2+dist_parab2); - line(0,-radius/2,(-thickness/2+radius/2*sin(phiy1))/cos(phiy1),0,-radius/2,thickness/2+dist_parab2); - line(0,radius/2,(-thickness/2-radius/2*sin(phiy1))/cos(phiy1),0,radius/2,thickness/2+dist_parab2); - } - else if (!focus2){ - line(-height,0,-thickness/2+dist_parab1,-height,0,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(height,0,-thickness/2+dist_parab1,height,0,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - line(0,-height,-thickness/2+dist_parab1,0,-height,(thickness/2+radius/2*sin(phiy2))/cos(phiy2)); - line(0,height,-thickness/2+dist_parab1,0,height,(thickness/2-radius/2*sin(phiy2))/cos(phiy2)); - } - else { - line(-radius,0,-thickness/2+dist_parab1,-radius,0,thickness/2+dist_parab2); - line(radius,0,-thickness/2+dist_parab1,radius,0,thickness/2+dist_parab2); - line(0,-radius,-thickness/2+dist_parab1,0,-radius,thickness/2+dist_parab2); - line(0,radius,-thickness/2+dist_parab1,0,radius,thickness/2+dist_parab2); - } - } + if (r1 && r2 && !focus1 && !focus2) { + line (-fabs (r1) * sin (theta00), -fabs (r1) * sin (theta00), -thickness / 2 - r1 + r1 * cos (theta00), -fabs (r2) * sin (theta01), + fabs (r2) * sin (theta01), thickness / 2 + r2 - r2 * cos (theta01)); + line (fabs (r1) * sin (theta00), -fabs (r1) * sin (theta00), -thickness / 2 - r1 + r1 * cos (theta00), fabs (r2) * sin (theta01), fabs (r1) * sin (theta00), + thickness / 2 + r2 - r2 * cos (theta01)); + line (-fabs (r1) * sin (theta00), -fabs (r1) * sin (theta00), -thickness / 2 - r1 + r1 * cos (theta00), fabs (r2) * sin (theta01), + -fabs (r1) * sin (theta00), thickness / 2 + r2 - r2 * cos (theta01)); + line (-fabs (r1) * sin (theta00), fabs (r1) * sin (theta00), -thickness / 2 - r1 + r1 * cos (theta00), fabs (r2) * sin (theta01), fabs (r1) * sin (theta00), + thickness / 2 + r2 - r2 * cos (theta01)); + } else if (r1 && !r2) { + if (!focus2) { + line (-height, 0, -thickness / 2 - r1 + r1 * cos (theta00), -height, 0, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (height, 0, -thickness / 2 - r1 + r1 * cos (theta00), height, 0, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, -height, -thickness / 2 - r1 + r1 * cos (theta00), 0, -height, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, height, -thickness / 2 - r1 + r1 * cos (theta00), 0, height, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + } else { + line (-fabs (r1) * sin (theta00), 0, -thickness / 2 - r1 + r1 * cos (theta00), -radius / 2, 0, thickness / 2 + radius * radius / (16 * focus2)); + line (fabs (r1) * sin (theta00), 0, -thickness / 2 - r1 + r1 * cos (theta00), radius / 2, 0, thickness / 2 + radius * radius / (16 * focus2)); + } + } else if (r2 && !r1) { + if (!focus1) { + line (-height2, 0, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), -height2, 0, thickness / 2 + r2 - r2 * cos (theta01)); + line (height2, 0, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), height2, 0, thickness / 2 + r2 - r2 * cos (theta01)); + line (0, height2, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), 0, height2, thickness / 2 + r2 - r2 * cos (theta01)); + line (0, height2, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), 0, height2, thickness / 2 + r2 - r2 * cos (theta01)); + } else { + line (-height2, 0, -thickness / 2 - radius * radius / (16 * focus1), -height2, 0, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (height2, 0, -thickness / 2 - radius * radius / (16 * focus1), height2, 0, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, height2, -thickness / 2 - radius * radius / (16 * focus1), 0, height2, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, height2, -thickness / 2 - radius * radius / (16 * focus1), 0, height2, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + } + } else { + if (!focus1 && !focus2) { + line (-radius / 2, 0, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), -radius / 2, 0, + (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (radius / 2, 0, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), radius / 2, 0, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, -radius / 2, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), 0, -radius / 2, + (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, radius / 2, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), 0, radius / 2, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + } else if (!focus1) { + line (-radius / 2, 0, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), -radius / 2, 0, thickness / 2 + dist_parab2); + line (radius / 2, 0, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), radius / 2, 0, thickness / 2 + dist_parab2); + line (0, -radius / 2, (-thickness / 2 + radius / 2 * sin (phiy1)) / cos (phiy1), 0, -radius / 2, thickness / 2 + dist_parab2); + line (0, radius / 2, (-thickness / 2 - radius / 2 * sin (phiy1)) / cos (phiy1), 0, radius / 2, thickness / 2 + dist_parab2); + } else if (!focus2) { + line (-height, 0, -thickness / 2 + dist_parab1, -height, 0, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (height, 0, -thickness / 2 + dist_parab1, height, 0, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, -height, -thickness / 2 + dist_parab1, 0, -height, (thickness / 2 + radius / 2 * sin (phiy2)) / cos (phiy2)); + line (0, height, -thickness / 2 + dist_parab1, 0, height, (thickness / 2 - radius / 2 * sin (phiy2)) / cos (phiy2)); + } else { + line (-radius, 0, -thickness / 2 + dist_parab1, -radius, 0, thickness / 2 + dist_parab2); + line (radius, 0, -thickness / 2 + dist_parab1, radius, 0, thickness / 2 + dist_parab2); + line (0, -radius, -thickness / 2 + dist_parab1, 0, -radius, thickness / 2 + dist_parab2); + line (0, radius, -thickness / 2 + dist_parab1, 0, radius, thickness / 2 + dist_parab2); + } + } } /* end of not a OFF/PLY */ %} diff --git a/mcstas-comps/contrib/Lens_simple.comp b/mcstas-comps/contrib/Lens_simple.comp index 9a49fe1ad..1541d018b 100644 --- a/mcstas-comps/contrib/Lens_simple.comp +++ b/mcstas-comps/contrib/Lens_simple.comp @@ -75,85 +75,80 @@ SigmaAL=0.141, d0=0.002) INITIALIZE %{ -if ( (xmin >= xmax || ymin >= ymax) && radius == 0) - { fprintf(stderr,"Lens_simple: %s: Error: give geometry\n", NAME_CURRENT_COMP); exit(-1); } + if ((xmin >= xmax || ymin >= ymax) && radius == 0) { + fprintf (stderr, "Lens_simple: %s: Error: give geometry\n", NAME_CURRENT_COMP); + exit (-1); + } %} TRACE %{ - double vvv = vx*vx + vy*vy + vz*vz; + double vvv = vx * vx + vy * vy + vz * vz; - double Xi = rho/PI *(4e-20*PI*PI)/(V2Q*V2Q*vvv); - double foc = Rc/Xi/Nl; + double Xi = rho / PI * (4e-20 * PI * PI) / (V2Q * V2Q * vvv); + double foc = Rc / Xi / Nl; - if (z>0e0 || vvv==0e0) ABSORB; + if (z > 0e0 || vvv == 0e0) + ABSORB; - PROP_Z0; + PROP_Z0; - double ss = x*x + y*y; + double ss = x * x + y * y; - if (((radius == 0) && (xxmax || yymax)) - || ((radius != 0) && (ss > radius*radius))) - ABSORB; - else - SCATTER; + if (((radius == 0) && (x < xmin || x > xmax || y < ymin || y > ymax)) || ((radius != 0) && (ss > radius * radius))) + ABSORB; + else + SCATTER; - if (parab==0e0 && ss >= Rc*Rc) ABSORB; + if (parab == 0e0 && ss >= Rc * Rc) + ABSORB; - if (parab!=0e0) - foc*= 1e0 - 0.5*Nl*Xi*(1e0-0.5*ss/(Rc*Rc)); - else - foc*= (1e0 - 0.5*Nl*Xi)*sqrt(1e0-ss/(Rc*Rc)); + if (parab != 0e0) + foc *= 1e0 - 0.5 * Nl * Xi * (1e0 - 0.5 * ss / (Rc * Rc)); + else + foc *= (1e0 - 0.5 * Nl * Xi) * sqrt (1e0 - ss / (Rc * Rc)); - double tt2 = (-0.7*fabs(foc))/vz; - double xx2 = x + vx*tt2; - double yy2 = y + vy*tt2; - double zz2 = -0.7*fabs(foc); - double ll1 = -zz2; + double tt2 = (-0.7 * fabs (foc)) / vz; + double xx2 = x + vx * tt2; + double yy2 = y + vy * tt2; + double zz2 = -0.7 * fabs (foc); + double ll1 = -zz2; - double ll2 = 1.0/(1.0/foc-1.0/ll1); - double llr = -ll2/ll1; + double ll2 = 1.0 / (1.0 / foc - 1.0 / ll1); + double llr = -ll2 / ll1; - xx2*= llr; - yy2*= llr; - zz2*= llr; + xx2 *= llr; + yy2 *= llr; + zz2 *= llr; - xx2 = xx2 - x; - yy2 = yy2 - y; - double zdir = zz2/fabs(zz2); - double xyzlen = xx2*xx2 + yy2*yy2 + zz2*zz2; + xx2 = xx2 - x; + yy2 = yy2 - y; + double zdir = zz2 / fabs (zz2); + double xyzlen = xx2 * xx2 + yy2 * yy2 + zz2 * zz2; - vx = xx2*zdir*sqrt(vvv/xyzlen); - vy = yy2*zdir*sqrt(vvv/xyzlen); - vz = zz2*zdir*sqrt(vvv/xyzlen); + vx = xx2 * zdir * sqrt (vvv / xyzlen); + vy = yy2 * zdir * sqrt (vvv / xyzlen); + vz = zz2 * zdir * sqrt (vvv / xyzlen); - double thck; - if (parab!=0e0) - thck = ss/Rc + d0; - else - thck = 2.0*(Rc-sqrt(Rc*Rc-ss)) + d0; + double thck; + if (parab != 0e0) + thck = ss / Rc + d0; + else + thck = 2.0 * (Rc - sqrt (Rc * Rc - ss)) + d0; - p*=exp(-Nl*SigmaAL*(2.0*PI/(V2Q*sqrt(vvv)))*thck); // Transmission // + p *= exp (-Nl * SigmaAL * (2.0 * PI / (V2Q * sqrt (vvv))) * thck); // Transmission // %} MCDISPLAY %{ double xw, yh; - - xw = (xmax - xmin)/2.0; - yh = (ymax - ymin)/2.0; - multiline(3, xmin-xw, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, ymax+yh, 0.0); - multiline(3, xmax+xw, (double)ymax, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmax, ymax+yh, 0.0); - multiline(3, xmin-xw, (double)ymin, 0.0, - (double)xmin, (double)ymin, 0.0, - (double)xmin, ymin-yh, 0.0); - multiline(3, xmax+xw, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, ymin-yh, 0.0); + + xw = (xmax - xmin) / 2.0; + yh = (ymax - ymin) / 2.0; + multiline (3, xmin - xw, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, ymax + yh, 0.0); + multiline (3, xmax + xw, (double)ymax, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmax, ymax + yh, 0.0); + multiline (3, xmin - xw, (double)ymin, 0.0, (double)xmin, (double)ymin, 0.0, (double)xmin, ymin - yh, 0.0); + multiline (3, xmax + xw, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, ymin - yh, 0.0); %} END diff --git a/mcstas-comps/contrib/Mirror_Curved_Bispectral.comp b/mcstas-comps/contrib/Mirror_Curved_Bispectral.comp index 725cfa94b..bc06393d0 100644 --- a/mcstas-comps/contrib/Mirror_Curved_Bispectral.comp +++ b/mcstas-comps/contrib/Mirror_Curved_Bispectral.comp @@ -57,740 +57,761 @@ SHARE DECLARE %{ -t_Table pTable; - + t_Table pTable; %} INITIALIZE %{ - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) { - if (Table_Read(&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"Mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) { + if (Table_Read (&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); } %} TRACE %{ -double f; //half of distance between focal points -double asquared; -double a; //half of ellipse length -double b; //half of ellipse width - -double xprime; //x in coordinates with center of ellipse at (xprime,zprime)=(0,0) -double ymirror; //height of the mirror - + double f; // half of distance between focal points + double asquared; + double a; // half of ellipse length + double b; // half of ellipse width -//Defining the mirror -double a1; -double b1; -double c1; + double xprime; // x in coordinates with center of ellipse at (xprime,zprime)=(0,0) + double ymirror; // height of the mirror -//solving the time the neutron hits the sample -double A, B, C, D, E, P, Q, R, U, V, I, J, K; + // Defining the mirror + double a1; + double b1; + double c1; -//finding rotation of mirror -double alpha1, beta1, gamma1; -double theta_m; -double sin_theta_m, cos_theta_m; + // solving the time the neutron hits the sample + double A, B, C, D, E, P, Q, R, U, V, I, J, K; -double tan_theta_1; -double tan_theta_2; -double tan_theta_3; + // finding rotation of mirror + double alpha1, beta1, gamma1; + double theta_m; + double sin_theta_m, cos_theta_m; + double tan_theta_1; + double tan_theta_2; + double tan_theta_3; -double v_n; //speed of neutron perpendicular to surface + double v_n; // speed of neutron perpendicular to surface -double Ref; //reflectivity + double Ref; // reflectivity -double dt; -double q; + double dt; + double q; int intersect; -double discriminant; - - - - -double dt_2; -double dt_3; -int prop_case; -double x_2; -double y_2; -double z_2; -double t_2; -double x_3; -double y_3; -double z_3; -double t_3; - -int x_hit; -int x_hit_2; -int x_hit_3; -double xprime_2; -double ymirror_2; -double xprime_3; -double ymirror_3; -int intersect_2; -int intersect_3; - - -intersect=0; -x_hit=0; -x_hit_2=0; -x_hit_3=0; -intersect_2=0; -intersect_3=0; -prop_case=0; - -//printf("\n\n\n"); - double old_x = x, old_y = y, old_z = z, old_t=t, old_vx=vx, old_vz=vz, old_vy=vy; - -// printf("x=%f, y=%f, z=%f, vx=%f, vy=%f, vz=%f\n",x,y,z,vx,vy,vz); - -// Check if neutron hits mirror. First find which z,x coordinates it hits. - -//mirror is defined by z(x)=a1x^3+b1x^2+c1x+d1, with dz/dx|x=-length/2=tan(theta_1), dz/dx|x=0=tan(theta_2), dz/dx|x=length/2=tan(theta3), z(0)=0. (d1=0) - -tan_theta_1=tan(theta_1*DEG2RAD); -tan_theta_2=tan(theta_2*DEG2RAD); -tan_theta_3=tan(theta_3*DEG2RAD); - - -a1=2.0/3.0*(tan_theta_1+tan_theta_3-2.0*tan_theta_2)/(length*length); -b1=(tan_theta_3-tan_theta_1)/(2.0*length); -c1=tan_theta_2; - - -//neutron trajectory is defined by x=x0+vx*t, z=z0+vz*t. setting z=a1*x^3+b1*x^2+c1*x gives the equation A*t^3+B*t^2+C*t+D=0, with -A=a1*vx*vx*vx; -B=3.0*a1*x*vx*vx+b1*vx*vx; -C=3.0*a1*x*x*vx+2.0*b1*x*vx+c1*vx-vz; -D=a1*x*x*x+b1*x*x+c1*x-z; - -//printf("a1=%f,b1=%f,c1=%f",a1,b1,c1); - -//this equation must now be solved for t; - -if (A!=0){ -P=1/3.0*(3.0*C/A-B*B/(A*A)); -Q=1/27.0*(2.0*B*B*B/(A*A*A)-9.0*B*C/(A*A)+27.0*D/A); - -E=P*P*P/27.0+Q*Q/4.0; - -// printf("A=%f, B=%f, C=%f, D=%f, 1e6P=%f, 1e6Q=%f, 1e6E=%f\n", A, B, C, D, 1e6*P, 1e6*Q, 1e6*E); - -prop_case=0; -if (E>=0){ - -U=cbrt(-Q/2.0+sqrt(E)); -V=cbrt(-Q/2.0-sqrt(E)); - -I=U+V-B/(3.0*A); -dt=I; -dt_2=I; -dt_3=I; -// printf("I=%f\n",I); - -// J=-(U+V)/2+1i*(U-V)*sqrt(3)/2-B/(3*A) //complex solution -// K=-(U+V)/2-1i*(U-V)*sqrt(3)/2-B/(3*A) //complex solution -}else{ - R=acos(-Q/(2.0*sqrt(-P*P*P/27.0))); - -// printf("R=%f\n",R); - - - I=2.0*sqrt(fabs(P)/3.0)*cos(R/3.0)-B/A/3.0; - J=-2.0*sqrt(fabs(P)/3.0)*cos(R/3.0 + 3.1415926535/3.0)-B/A/3.0; - K=-2.0*sqrt(fabs(P)/3.0)*cos(R/3.0 - 3.1415926535/3.0)-B/A/3.0; - -// printf("2.0*sqrt(abs(P)/3.0)=%f", 2.0*sqrt(abs(P)/3.0)); -// printf("cos(R/3.0)=%f, cos(R/3.0 + 3.1415926535/3.0)=%f, cos(R/3.0 - 3.1415926535/3.0)=%f, -B/A/3.0=%f\n", cos(R/3.0), cos(R/3.0 + 3.1415926535/3.0), cos(R/3.0 - 3.1415926535/3.0), -B/A/3.0); - -// printf("I=%f, J=%f, K=%f, \n",I, J, K); -// printf("P=%f, R=%f, A=%f, B=%f, \n",P, R, A, B); - - - -// Three solutions. Find the smallest positive of these. -//there are problems with the solutions.... - if (I<=0){ - if (J<=0 && K<=0){dt=-1.0;} //if all three are negative, dt<0 and nothing happens - if (J<=0 && K>0){dt=K;} //if only K>0, dt=K - if (J>0 && K<=0){dt=J;} //if only J>0, dt=J - - if (J>0 && K>0){ //if both J>0 and K>0, compare - if (J>=K){dt=K; prop_case=1; dt_2=J;}else{dt=J; dt_2=I; prop_case=2;} } //dt is the smallest value - }else{ //end if (I<=0) - if (J<=0 && K<=0){dt=I;} //if only I>0, dt=I; - - if (J<=0 && K>0){ //if both I>0 and K>0, compare - if (K>=I){dt=I; dt_2=K; prop_case=3;}else{dt=K; dt_2=I; prop_case=4;} } //dt is the smallest value - - if (J>0 && K<=0){ //if both I>0 and J>0, compare - if (J>=I){dt=I; dt_2=J; prop_case=5;}else{dt=J; dt_2=I; prop_case=6;} } //dt is the smallest value - - if (J>0 && K>0){ //if all three>0, compare - if (J>=K){ //either K or I is smallest - if (K>=I){dt=I; if(J>=K){ dt_2=K; dt_3=J; prop_case=9;}else{dt_2=K; dt_3=J; prop_case=15;}}else{dt=K; if (J>=I){dt_2=I; dt_3=J; prop_case=10;}else{dt_2=J; dt_3=I; prop_case=11;} } //if K is smallest, compare it to I - }else{ - if (J>=I){dt=I; if (K>J){dt_2=J; dt_3=K; prop_case=12;}else{dt_2=J; dt_3=J; prop_case=16;}}else{dt=J; if (K>I){dt_2=I; dt_3=K; prop_case=13;}else{{dt_2=K; dt_3=I; prop_case=14;}} }} //else compare J to I - } //end if(J>0 && K>0) - - } //end }else{ for if(I<=0) + double discriminant; + double dt_2; + double dt_3; + int prop_case; + double x_2; + double y_2; + double z_2; + double t_2; + double x_3; + double y_3; + double z_3; + double t_3; + + int x_hit; + int x_hit_2; + int x_hit_3; + double xprime_2; + double ymirror_2; + double xprime_3; + double ymirror_3; + int intersect_2; + int intersect_3; + + intersect = 0; + x_hit = 0; + x_hit_2 = 0; + x_hit_3 = 0; + intersect_2 = 0; + intersect_3 = 0; + prop_case = 0; + + // printf("\n\n\n"); + double old_x = x, old_y = y, old_z = z, old_t = t, old_vx = vx, old_vz = vz, old_vy = vy; + + // printf("x=%f, y=%f, z=%f, vx=%f, vy=%f, vz=%f\n",x,y,z,vx,vy,vz); + + // Check if neutron hits mirror. First find which z,x coordinates it hits. + + // mirror is defined by z(x)=a1x^3+b1x^2+c1x+d1, with dz/dx|x=-length/2=tan(theta_1), dz/dx|x=0=tan(theta_2), dz/dx|x=length/2=tan(theta3), z(0)=0. (d1=0) + + tan_theta_1 = tan (theta_1 * DEG2RAD); + tan_theta_2 = tan (theta_2 * DEG2RAD); + tan_theta_3 = tan (theta_3 * DEG2RAD); + + a1 = 2.0 / 3.0 * (tan_theta_1 + tan_theta_3 - 2.0 * tan_theta_2) / (length * length); + b1 = (tan_theta_3 - tan_theta_1) / (2.0 * length); + c1 = tan_theta_2; + + // neutron trajectory is defined by x=x0+vx*t, z=z0+vz*t. setting z=a1*x^3+b1*x^2+c1*x gives the equation A*t^3+B*t^2+C*t+D=0, with + A = a1 * vx * vx * vx; + B = 3.0 * a1 * x * vx * vx + b1 * vx * vx; + C = 3.0 * a1 * x * x * vx + 2.0 * b1 * x * vx + c1 * vx - vz; + D = a1 * x * x * x + b1 * x * x + c1 * x - z; + + // printf("a1=%f,b1=%f,c1=%f",a1,b1,c1); + + // this equation must now be solved for t; + + if (A != 0) { + P = 1 / 3.0 * (3.0 * C / A - B * B / (A * A)); + Q = 1 / 27.0 * (2.0 * B * B * B / (A * A * A) - 9.0 * B * C / (A * A) + 27.0 * D / A); + + E = P * P * P / 27.0 + Q * Q / 4.0; + + // printf("A=%f, B=%f, C=%f, D=%f, 1e6P=%f, 1e6Q=%f, 1e6E=%f\n", A, B, C, D, 1e6*P, 1e6*Q, 1e6*E); + + prop_case = 0; + if (E >= 0) { + + U = cbrt (-Q / 2.0 + sqrt (E)); + V = cbrt (-Q / 2.0 - sqrt (E)); + + I = U + V - B / (3.0 * A); + dt = I; + dt_2 = I; + dt_3 = I; + // printf("I=%f\n",I); + + // J=-(U+V)/2+1i*(U-V)*sqrt(3)/2-B/(3*A) //complex solution + // K=-(U+V)/2-1i*(U-V)*sqrt(3)/2-B/(3*A) //complex solution + } else { + R = acos (-Q / (2.0 * sqrt (-P * P * P / 27.0))); + + // printf("R=%f\n",R); + + I = 2.0 * sqrt (fabs (P) / 3.0) * cos (R / 3.0) - B / A / 3.0; + J = -2.0 * sqrt (fabs (P) / 3.0) * cos (R / 3.0 + 3.1415926535 / 3.0) - B / A / 3.0; + K = -2.0 * sqrt (fabs (P) / 3.0) * cos (R / 3.0 - 3.1415926535 / 3.0) - B / A / 3.0; + + // printf("2.0*sqrt(abs(P)/3.0)=%f", 2.0*sqrt(abs(P)/3.0)); + // printf("cos(R/3.0)=%f, cos(R/3.0 + 3.1415926535/3.0)=%f, cos(R/3.0 - 3.1415926535/3.0)=%f, -B/A/3.0=%f\n", cos(R/3.0), cos(R/3.0 + 3.1415926535/3.0), + // cos(R/3.0 - 3.1415926535/3.0), -B/A/3.0); + + // printf("I=%f, J=%f, K=%f, \n",I, J, K); + // printf("P=%f, R=%f, A=%f, B=%f, \n",P, R, A, B); + + // Three solutions. Find the smallest positive of these. + // there are problems with the solutions.... + if (I <= 0) { + if (J <= 0 && K <= 0) { + dt = -1.0; + } // if all three are negative, dt<0 and nothing happens + if (J <= 0 && K > 0) { + dt = K; + } // if only K>0, dt=K + if (J > 0 && K <= 0) { + dt = J; + } // if only J>0, dt=J + + if (J > 0 && K > 0) { // if both J>0 and K>0, compare + if (J >= K) { + dt = K; + prop_case = 1; + dt_2 = J; + } else { + dt = J; + dt_2 = I; + prop_case = 2; + } + } // dt is the smallest value + } else { // end if (I<=0) + if (J <= 0 && K <= 0) { + dt = I; + } // if only I>0, dt=I; + + if (J <= 0 && K > 0) { // if both I>0 and K>0, compare + if (K >= I) { + dt = I; + dt_2 = K; + prop_case = 3; + } else { + dt = K; + dt_2 = I; + prop_case = 4; + } + } // dt is the smallest value + + if (J > 0 && K <= 0) { // if both I>0 and J>0, compare + if (J >= I) { + dt = I; + dt_2 = J; + prop_case = 5; + } else { + dt = J; + dt_2 = I; + prop_case = 6; + } + } // dt is the smallest value + + if (J > 0 && K > 0) { // if all three>0, compare + if (J >= K) { // either K or I is smallest + if (K >= I) { + dt = I; + if (J >= K) { + dt_2 = K; + dt_3 = J; + prop_case = 9; + } else { + dt_2 = K; + dt_3 = J; + prop_case = 15; + } + } else { + dt = K; + if (J >= I) { + dt_2 = I; + dt_3 = J; + prop_case = 10; + } else { + dt_2 = J; + dt_3 = I; + prop_case = 11; + } + } // if K is smallest, compare it to I + } else { + if (J >= I) { + dt = I; + if (K > J) { + dt_2 = J; + dt_3 = K; + prop_case = 12; + } else { + dt_2 = J; + dt_3 = J; + prop_case = 16; + } + } else { + dt = J; + if (K > I) { + dt_2 = I; + dt_3 = K; + prop_case = 13; + } else { + { + dt_2 = K; + dt_3 = I; + prop_case = 14; + } + } + } + } // else compare J to I + } // end if(J>0 && K>0) + + } // end }else{ for if(I<=0) + + } // end }else{ for if (E>=0) + + } else { // end if (A!=0) + if (B != 0) { + + discriminant = C * C - 4 * B * D; + + if (discriminant < 0) { + dt = -1.0; + } else { // only complex solutions: set dt<0 to avoid interaction + I = (-C - sqrt (discriminant)) / (2.0 * B); + J = (-C + sqrt (discriminant)) / (2.0 * B); + + if (I <= 0 && J <= 0) { + dt = -1.0; + } // both times are negative. + if (I <= 0 && J > 0) { + dt = J; + } // set dt to only positive value. + if (I > 0 && J <= 0) { + dt = I; + } // set dt to only positive value. + if (I > 0 && J > 0) { + if (I > J) { + dt = J; + dt_2 = I; + prop_case = 7; + } else { + dt = I; + dt_2 = J; + prop_case = 8; + } + } // set dt to smallest positive value + + } // end if (discriminant<0){}else{ + } else { // end if (B!)=0 + if (C != 0) { + dt = -D / C; + } else { + printf ("warning: A=B=C=0. Neutron is ignored\n"); + } + } // end if(B!=0){}else{ + } // end if (A!=0){}else{ + // now intersection time has been found. + if (dt > 0) { // if time is positive, propagate neutron to where it hits mirror. This is done without gravity. + // printf("before anything: x=%f,y=%f,z=%f,vx=%f,vy=%f,vz=%f, dt=%f\n",x,y,z,vx,vy,vz,dt); -} // end }else{ for if (E>=0) - - -}else{ //end if (A!=0) -if (B!=0){ - -discriminant=C*C-4*B*D; - -if (discriminant<0){dt=-1.0;}else{ //only complex solutions: set dt<0 to avoid interaction -I=(-C-sqrt(discriminant))/(2.0*B); -J=(-C+sqrt(discriminant))/(2.0*B); - -if (I<=0 && J<=0){dt = -1.0;} //both times are negative. -if (I<=0 && J>0 ){dt = J;} //set dt to only positive value. -if (I>0 && J<=0){dt = I;} //set dt to only positive value. -if (I>0 && J>0 ){if (I>J) {dt=J; dt_2=I; prop_case=7;}else{dt=I; dt_2=J; prop_case=8;} } //set dt to smallest positive value - -} //end if (discriminant<0){}else{ -}else{ //end if (B!)=0 -if (C!=0) { dt = -D/C;}else{ - printf("warning: A=B=C=0. Neutron is ignored\n"); } -} //end if(B!=0){}else{ -} //end if (A!=0){}else{ -//now intersection time has been found. - -if (dt>0) { //if time is positive, propagate neutron to where it hits mirror. This is done without gravity. -// printf("before anything: x=%f,y=%f,z=%f,vx=%f,vy=%f,vz=%f, dt=%f\n",x,y,z,vx,vy,vz,dt); - - x += vx*dt; - y += vy*dt; - z += vz*dt; + x += vx * dt; + y += vy * dt; + z += vz * dt; t += dt; + x_hit = (x >= -length / 2 && x <= length / 2); + + if (prop_case == 0) { + x_2 = x; + y_2 = y; + z_2 = z; + t_2 = t; + x_3 = x; + y_3 = y; + z_3 = z; + t_3 = t; + } -x_hit=(x >=-length/2 && x<=length/2); - - -if (prop_case==0){ -x_2=x; -y_2=y; -z_2=z; -t_2=t; -x_3=x; -y_3=y; -z_3=z; -t_3=t; -} - -if (prop_case>0) -{ -x_2=old_x+vx*dt_2; -y_2=old_y+vy*dt_2; -z_2=old_z+vz*dt_2; -t_2=old_t+dt_2; -x_hit_2=(x_2 >=-length/2 && x_2<=length/2); -} - -if (prop_case>8) -{ -x_3=old_x+vx*dt_3; -y_3=old_y+vy*dt_3; -z_3=old_z+vz*dt_3; -t_3=old_t+dt_3; -x_hit_3=(x_3 >=-length/2 && x_3<=length/2); -} - -//printf("x_hit=%d, x_hit_2=%d, x_hit_3=%d\n",x_hit, x_hit_2, x_hit_3); -//printf("dt=%f, dt_2=%f, dt_3=%f\n",dt,dt_2,dt_3); -// printf("x=%f,y=%f,z=%f,vx=%f,vy=%f,vz=%f\n",x,y,z,vx,vy,vz); - -// printf("x=%f, length/2=%f\n",x, length/2); - - -if (x_hit || x_hit_2 || x_hit_3){ -//if (x >=-length/2 && x<=length/2){ //check if neutron is within x limits of the mirror. If so, check if it is within y limits. - - -//define the ellipse -b=smallaxis/2; - -f=(focus_e-focus_s)*0.5; - - asquared=f*f+b*b; - a=sqrt(asquared); - -xprime=-f-focus_s+mirror_start+length/2+x; //xprime is the x-coordinate in a coordinate system centered at the center of the ellipse - -//ymirror=b*sqrt(1-xprime*xprime/(f*f)); //following Kaspars convention, assuming f~=a (valid for most elliptic guides normally used) - -ymirror=b*sqrt(1-xprime*xprime/asquared); - - - -xprime_2=-f-focus_s+mirror_start+length/2+x_2; //xprime is the x-coordinate in a coordinate system centered at the center of the ellipse -ymirror_2=b*sqrt(1-xprime_2*xprime_2/asquared); - -xprime_3=-f-focus_s+mirror_start+length/2+x_3; //xprime is the x-coordinate in a coordinate system centered at the center of the ellipse -ymirror_3=b*sqrt(1-xprime_3*xprime_3/asquared); - -if (guide_start>mirror_start){ //If (part of the) mirror is outside the guide, the mirror can be extended -if ( x<-length/2+guide_start-mirror_start) { -ymirror=yheight/2; -} - -if ( x_2<-length/2+guide_start-mirror_start) { -ymirror_2=yheight/2; -} - -if ( x_3<-length/2+guide_start-mirror_start) { -ymirror_3=yheight/2; -} - - - - -} - - - + if (prop_case > 0) { + x_2 = old_x + vx * dt_2; + y_2 = old_y + vy * dt_2; + z_2 = old_z + vz * dt_2; + t_2 = old_t + dt_2; + x_hit_2 = (x_2 >= -length / 2 && x_2 <= length / 2); + } + if (prop_case > 8) { + x_3 = old_x + vx * dt_3; + y_3 = old_y + vy * dt_3; + z_3 = old_z + vz * dt_3; + t_3 = old_t + dt_3; + x_hit_3 = (x_3 >= -length / 2 && x_3 <= length / 2); + } + // printf("x_hit=%d, x_hit_2=%d, x_hit_3=%d\n",x_hit, x_hit_2, x_hit_3); + // printf("dt=%f, dt_2=%f, dt_3=%f\n",dt,dt_2,dt_3); + // printf("x=%f,y=%f,z=%f,vx=%f,vy=%f,vz=%f\n",x,y,z,vx,vy,vz); + // printf("x=%f, length/2=%f\n",x, length/2); + if (x_hit || x_hit_2 || x_hit_3) { + // if (x >=-length/2 && x<=length/2){ //check if neutron is within x limits of the mirror. If so, check if it is within y limits. + // define the ellipse + b = smallaxis / 2; + f = (focus_e - focus_s) * 0.5; + asquared = f * f + b * b; + a = sqrt (asquared); -// printf("ymirror=%f, y=%f\n",ymirror, y); -intersect = ( y>=-ymirror && y<=ymirror && x >=-length/2 && x<=length/2); + xprime = -f - focus_s + mirror_start + length / 2 + x; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse -if (prop_case>0) { -intersect_2 = ( y_2>=-ymirror && y_2<=ymirror && x_2 >=-length/2 && x_2<=length/2); -} -if (prop_case>8){ -intersect_3 = ( y_3>=-ymirror && y_3<=ymirror && x_3 >=-length/2 && x_3<=length/2); -} + // ymirror=b*sqrt(1-xprime*xprime/(f*f)); //following Kaspars convention, assuming f~=a (valid for most elliptic guides normally used) -//printf("y_2=%f, ymirror=%f\n",y_2,ymirror); + ymirror = b * sqrt (1 - xprime * xprime / asquared); -//printf("\nintersect=%d, intersect_2=%d, intersect_3=%d, prop_case=%d\n",intersect, intersect_2, intersect_3, prop_case); + xprime_2 = -f - focus_s + mirror_start + length / 2 + x_2; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse + ymirror_2 = b * sqrt (1 - xprime_2 * xprime_2 / asquared); -//printf("x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); -//printf("x_2=%f,y_2=%f,z_2=%f,t_2=%f\n",x_2,y_2,z_2,t_2); -//printf("x_3=%f,y_3=%f,z_3=%f,t_3=%f\n",x_3,y_3,z_3,t_3); + xprime_3 = -f - focus_s + mirror_start + length / 2 + x_3; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse + ymirror_3 = b * sqrt (1 - xprime_3 * xprime_3 / asquared); -if (!intersect){ -if (!intersect_2){ -intersect=intersect_3; -x=x_3; -y=y_3; -z=z_3; -t=t_3; -}else{ -intersect=intersect_2; -x=x_2; -y=y_2; -z=z_2; -t=t_2; -} -} + if (guide_start > mirror_start) { // If (part of the) mirror is outside the guide, the mirror can be extended + if (x < -length / 2 + guide_start - mirror_start) { + ymirror = yheight / 2; + } -//printf("intersect=%d, intersect_2=%d, intersect_3=%d, prop_case=%d\n\n",intersect, intersect_2, intersect_3, prop_case); -//printf("x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); + if (x_2 < -length / 2 + guide_start - mirror_start) { + ymirror_2 = yheight / 2; + } -//printf("z=%f, zcalc=%f\n",z,a1*x*x*x+b1*x*x+c1*x); -//printf("z=%f, zcalc=%f\n",z_2,a1*x_2*x_2*x_2+b1*x_2*x_2+c1*x_2); -//printf("z=%f, zcalc=%f\n",z_3,a1*x_3*x_3*x_3+b1*x_3*x_3+c1*x_3); + if (x_3 < -length / 2 + guide_start - mirror_start) { + ymirror_3 = yheight / 2; + } + } - if (intersect) { //if neutron is within ylimits of the mirror handle reflection/transmission + // printf("ymirror=%f, y=%f\n",ymirror, y); + intersect = (y >= -ymirror && y <= ymirror && x >= -length / 2 && x <= length / 2); -//first find the angle of the mirror. It is given by theta(x)=alpha*x^2+beta*x+gamma1, with theta(-l/2)=theta1, theta(0)=theta2, theta(l/2)=theta3 + if (prop_case > 0) { + intersect_2 = (y_2 >= -ymirror && y_2 <= ymirror && x_2 >= -length / 2 && x_2 <= length / 2); + } + if (prop_case > 8) { + intersect_3 = (y_3 >= -ymirror && y_3 <= ymirror && x_3 >= -length / 2 && x_3 <= length / 2); + } -alpha1=2*(theta_1+theta_3-2*theta_2)/(length*length); -beta1=(theta_3-theta_1)/length; -gamma1=theta_2; + // printf("y_2=%f, ymirror=%f\n",y_2,ymirror); + + // printf("\nintersect=%d, intersect_2=%d, intersect_3=%d, prop_case=%d\n",intersect, intersect_2, intersect_3, prop_case); + + // printf("x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); + // printf("x_2=%f,y_2=%f,z_2=%f,t_2=%f\n",x_2,y_2,z_2,t_2); + // printf("x_3=%f,y_3=%f,z_3=%f,t_3=%f\n",x_3,y_3,z_3,t_3); + + if (!intersect) { + if (!intersect_2) { + intersect = intersect_3; + x = x_3; + y = y_3; + z = z_3; + t = t_3; + } else { + intersect = intersect_2; + x = x_2; + y = y_2; + z = z_2; + t = t_2; + } + } -theta_m=alpha1*x*x+beta1*x+gamma1; // angle of mirror. + // printf("intersect=%d, intersect_2=%d, intersect_3=%d, prop_case=%d\n\n",intersect, intersect_2, intersect_3, prop_case); + // printf("x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); -//The vector normal to the mirror is e_n= sin(theta)*e_x-cos(theta)*e_z + // printf("z=%f, zcalc=%f\n",z,a1*x*x*x+b1*x*x+c1*x); + // printf("z=%f, zcalc=%f\n",z_2,a1*x_2*x_2*x_2+b1*x_2*x_2+c1*x_2); + // printf("z=%f, zcalc=%f\n",z_3,a1*x_3*x_3*x_3+b1*x_3*x_3+c1*x_3); -//find amplitude of v in direction of e_n: + if (intersect) { // if neutron is within ylimits of the mirror handle reflection/transmission -sin_theta_m=sin(theta_m*DEG2RAD); -cos_theta_m=cos(theta_m*DEG2RAD); + // first find the angle of the mirror. It is given by theta(x)=alpha*x^2+beta*x+gamma1, with theta(-l/2)=theta1, theta(0)=theta2, theta(l/2)=theta3 -v_n=sin_theta_m*vx-cos_theta_m*vz; + alpha1 = 2 * (theta_1 + theta_3 - 2 * theta_2) / (length * length); + beta1 = (theta_3 - theta_1) / length; + gamma1 = theta_2; + theta_m = alpha1 * x * x + beta1 * x + gamma1; // angle of mirror. -q=fabs(2.0*v_n*V2Q); + // The vector normal to the mirror is e_n= sin(theta)*e_x-cos(theta)*e_z -double R0=0.99; -double Qc=0.0217; -double m_value=m*0.9853+0.1978; -double W=-0.0002*m_value+0.0022; -double alpha=0.1204*m_value+5.0944; -double beta=-7.6251*m_value+68.1137; + // find amplitude of v in direction of e_n: -if (m_value<=3) -{alpha=m_value; -beta=0;} + sin_theta_m = sin (theta_m * DEG2RAD); + cos_theta_m = cos (theta_m * DEG2RAD); + v_n = sin_theta_m * vx - cos_theta_m * vz; + q = fabs (2.0 * v_n * V2Q); + double R0 = 0.99; + double Qc = 0.0217; + double m_value = m * 0.9853 + 0.1978; + double W = -0.0002 * m_value + 0.0022; + double alpha = 0.1204 * m_value + 5.0944; + double beta = -7.6251 * m_value + 68.1137; + if (m_value <= 3) { + alpha = m_value; + beta = 0; + } - /* Reflectivity (see component Guide). */ - if(m == 0) - ABSORB; - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) - Ref=Table_Value(pTable, q, 1); - else { + /* Reflectivity (see component Guide). */ + if (m == 0) + ABSORB; + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) + Ref = Table_Value (pTable, q, 1); + else { Ref = R0; - if(q > Qc) - { - double arg = (q-m_value*Qc)/W; - if(arg < 10) - Ref *= .5*(1-tanh(arg))*(1-alpha*(q-Qc)+beta*(q-Qc)*(q-Qc)); //matches data from Swiss Neutronics - else Ref=0; + if (q > Qc) { + double arg = (q - m_value * Qc) / W; + if (arg < 10) + Ref *= .5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc) + beta * (q - Qc) * (q - Qc)); // matches data from Swiss Neutronics + else + Ref = 0; } - } - if (Ref < 0) Ref=0; - else if (Ref > 1) Ref=1; - - -//Now comes actual reflection/transmission - if (!transmit) { //all neutrons are reflected - if (!Ref) ABSORB; - p *= Ref; - -//handle reflection: change v_n -->-v_n - -vx=old_vx*(cos_theta_m*cos_theta_m-sin_theta_m*sin_theta_m)+old_vz*(2*cos_theta_m*sin_theta_m); -vz=old_vx*(2*cos_theta_m*sin_theta_m)+old_vz*(sin_theta_m*sin_theta_m-cos_theta_m*cos_theta_m); - -// printf("theta_m=%f, sin_theta_m=%f, cos_theta_m=%f, v_n=%f, old_vx=%f, vx=%f, old_vz=%f, vz=%f\n\n", theta_m, sin_theta_m, cos_theta_m, v_n, old_vx, vx, old_vz, vz); - - - SCATTER; -//printf("line 471.In mirror: x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); -//printf("In mirror: old_vx=%f,old_vy=%f,old_vz=%f,vx=%f,vy=%f,vz=%f,v_n=%f\n",old_vx,old_vy,old_vz,vx,vy,vz,v_n); - - } else { //if neutrons can be transmitted - - - -//calculate absorption. -// substrate -double lambda=(2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); -double sin_theta=lambda*q/(4*PI); - -//double substrate_path_length=substrate_thickness/sin_theta; -//double coating_path_length=coating_thickness/sin_theta; - -double sin_theta_c=Qc/(4*PI); - -double theta_diff; -double substrate_path_length; -double coating_path_length; - -double remaining_length_through_mirror; - -int hit_back_mirror; - -if (v_n>0) { -hit_back_mirror=1;} else{ -hit_back_mirror=0;} - -remaining_length_through_mirror=length/2-x; - - -if (sin_theta>sin_theta_c*lambda) { -theta_diff=sqrt(sin_theta*sin_theta-sin_theta_c*sin_theta_c*lambda*lambda); -coating_path_length=coating_thickness/theta_diff; -substrate_path_length=substrate_thickness/theta_diff; - - if (coating_path_length>remaining_length_through_mirror){ -coating_path_length=remaining_length_through_mirror; -substrate_path_length=0; -} - - if (substrate_path_length>remaining_length_through_mirror){ -substrate_path_length=remaining_length_through_mirror; -} - - - - - - + } + if (Ref < 0) + Ref = 0; + else if (Ref > 1) + Ref = 1; + // Now comes actual reflection/transmission + if (!transmit) { // all neutrons are reflected + if (!Ref) + ABSORB; + p *= Ref; + // handle reflection: change v_n -->-v_n + vx = old_vx * (cos_theta_m * cos_theta_m - sin_theta_m * sin_theta_m) + old_vz * (2 * cos_theta_m * sin_theta_m); + vz = old_vx * (2 * cos_theta_m * sin_theta_m) + old_vz * (sin_theta_m * sin_theta_m - cos_theta_m * cos_theta_m); + // printf("theta_m=%f, sin_theta_m=%f, cos_theta_m=%f, v_n=%f, old_vx=%f, vx=%f, old_vz=%f, vz=%f\n\n", theta_m, sin_theta_m, cos_theta_m, v_n, old_vx, + // vx, old_vz, vz); + SCATTER; + // printf("line 471.In mirror: x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); + // printf("In mirror: old_vx=%f,old_vy=%f,old_vz=%f,vx=%f,vy=%f,vz=%f,v_n=%f\n",old_vx,old_vy,old_vz,vx,vy,vz,v_n); -} else{ + } else { // if neutrons can be transmitted -if (hit_back_mirror==0){ //neutron comes from front of mirror -substrate_path_length=0; -coating_path_length=remaining_length_through_mirror; -}else {//neutron comes from behind mirror + // calculate absorption. + // substrate + double lambda = (2 * PI / V2K) / sqrt (vx * vx + vy * vy + vz * vz); + double sin_theta = lambda * q / (4 * PI); -substrate_path_length=remaining_length_through_mirror; -coating_path_length=0; -} -} + // double substrate_path_length=substrate_thickness/sin_theta; + // double coating_path_length=coating_thickness/sin_theta; + double sin_theta_c = Qc / (4 * PI); -double mu_substrate=0.0318/lambda+0.0055*lambda-0.0050; //unit: cm^-1 -mu_substrate=mu_substrate*100; //unit: m^-1; + double theta_diff; + double substrate_path_length; + double coating_path_length; -//For nickel and titanium coating, the following formular is used: -// mu = rho/m(atom)*sigma_a,thermal*lambda/lambda_thermal + double remaining_length_through_mirror; -// lambda_thermal=1.798 Å + int hit_back_mirror; -// rho_nickel=8.908g/cm^3 -// m(atom)_nickel=58.6934*1.661*10^-27 kg -// sigma_a,thermal_nickel=4.49*10^-28 m^2 - -// rho_titanium=4.506g/cm^3 -// m(atom)_titanium=47.867*1.661*10^-27 kg -// sigma_a,thermal_titanium=6.09*10^-28 m^2 - -double Ni_coefficient=22.8180; -double Ti_coefficient=19.1961; + if (v_n > 0) { + hit_back_mirror = 1; + } else { + hit_back_mirror = 0; + } -double mu_coating=(0.5*Ni_coefficient+0.5*Ti_coefficient)*lambda; //it is roughly 50% nickel and 50% titanium + remaining_length_through_mirror = length / 2 - x; + if (sin_theta > sin_theta_c * lambda) { + theta_diff = sqrt (sin_theta * sin_theta - sin_theta_c * sin_theta_c * lambda * lambda); + coating_path_length = coating_thickness / theta_diff; + substrate_path_length = substrate_thickness / theta_diff; + if (coating_path_length > remaining_length_through_mirror) { + coating_path_length = remaining_length_through_mirror; + substrate_path_length = 0; + } - // transmit when rand > R - if (Ref == 0 || rand01() >= Ref) { //transmit -if (substrate_thickness>0){ p=p*exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length); //reduce weight of neutrons due to attenuation in the mirror -//x+=(coating_path_length+substrate_path_length)-(coating_thickness+substrate_thickness)/sin_theta; -//printf("xshift is %f \n",(coating_path_length+substrate_path_length)-(coating_thickness+substrate_thickness)/sin_theta); -} -// printf("line 380\n"); -/* -if (v_n>0) { -printf("neutron is transmitted from back of mirror. %f\n",exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length)); -}else{ -printf("neutron is transmitted from front of mirror. %f\n",exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length)); -} -*/ -} else {//neutron is reflected - if (v_n>0 && substrate_thickness>0) { //if neutron comes from behind the mirror -// printf("neutron is reflected from back of mirror. %f\n",Ref*exp(-2*mu_substrate*substrate_path_length-2*mu_coating*coating_path_length)); - p=p*exp(-2*mu_substrate*substrate_path_length-2*mu_coating*coating_path_length);} //else{ //reduce weight of neutrons due to attenuation in the mirror - // printf("neutron is reflected from front of mirror. %f\n", Ref);} -//handle reflection: change v_n -->-v_n -vx=old_vx*(cos_theta_m*cos_theta_m-sin_theta_m*sin_theta_m)+old_vz*(2*cos_theta_m*sin_theta_m); -vz=old_vx*(2*cos_theta_m*sin_theta_m)+old_vz*(sin_theta_m*sin_theta_m-cos_theta_m*cos_theta_m); -// printf("line 388\n"); + if (substrate_path_length > remaining_length_through_mirror) { + substrate_path_length = remaining_length_through_mirror; + } -} + } else { -// printf("theta_m=%f, sin_theta_m=%f, cos_theta_m=%f, v_n=%f, old_vx=%f, vx=%f, old_vz=%f, vz=%f\n\n", theta_m, sin_theta_m, cos_theta_m, v_n, old_vx, vx, old_vz, vz); + if (hit_back_mirror == 0) { // neutron comes from front of mirror + substrate_path_length = 0; + coating_path_length = remaining_length_through_mirror; + } else { // neutron comes from behind mirror -//printf("vxvx+vzvz=%f, oldvxoldvx+oldvzoldvz=%f", vx*vx+vz*vz, old_vx*old_vx+old_vz*old_vz); + substrate_path_length = remaining_length_through_mirror; + coating_path_length = 0; + } + } - SCATTER; -//printf("line 524.In mirror: x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); -//printf("old_vx=%f,old_vy=%f,old_vz=%f,vx=%f,vy=%f,vz=%f,v_n=%f\n",old_vx,old_vy,old_vz,vx,vy,vz,v_n); -//after transmission or reflection - } //end } else { after if (!transmit) { - } + double mu_substrate = 0.0318 / lambda + 0.0055 * lambda - 0.0050; // unit: cm^-1 + mu_substrate = mu_substrate * 100; // unit: m^-1; + + // For nickel and titanium coating, the following formular is used: + // mu = rho/m(atom)*sigma_a,thermal*lambda/lambda_thermal + + // lambda_thermal=1.798 Å + + // rho_nickel=8.908g/cm^3 + // m(atom)_nickel=58.6934*1.661*10^-27 kg + // sigma_a,thermal_nickel=4.49*10^-28 m^2 + + // rho_titanium=4.506g/cm^3 + // m(atom)_titanium=47.867*1.661*10^-27 kg + // sigma_a,thermal_titanium=6.09*10^-28 m^2 + + double Ni_coefficient = 22.8180; + double Ti_coefficient = 19.1961; + + double mu_coating = (0.5 * Ni_coefficient + 0.5 * Ti_coefficient) * lambda; // it is roughly 50% nickel and 50% titanium + + // transmit when rand > R + if (Ref == 0 || rand01 () >= Ref) { // transmit + if (substrate_thickness > 0) { + p = p * exp (-mu_substrate * substrate_path_length - mu_coating * coating_path_length); // reduce weight of neutrons due to attenuation in the + // mirror + // x+=(coating_path_length+substrate_path_length)-(coating_thickness+substrate_thickness)/sin_theta; + // printf("xshift is %f \n",(coating_path_length+substrate_path_length)-(coating_thickness+substrate_thickness)/sin_theta); + } + // printf("line 380\n"); + /* + if (v_n>0) { + printf("neutron is transmitted from back of mirror. %f\n",exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length)); + }else{ + printf("neutron is transmitted from front of mirror. %f\n",exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length)); + } + */ + } else { // neutron is reflected + if (v_n > 0 && substrate_thickness > 0) { // if neutron comes from behind the mirror + // printf("neutron is reflected from back of mirror. %f\n",Ref*exp(-2*mu_substrate*substrate_path_length-2*mu_coating*coating_path_length)); + p = p * exp (-2 * mu_substrate * substrate_path_length - 2 * mu_coating * coating_path_length); + } // else{ //reduce weight of neutrons due to attenuation in the mirror + // printf("neutron is reflected from front of mirror. %f\n", Ref);} + // handle reflection: change v_n -->-v_n + vx = old_vx * (cos_theta_m * cos_theta_m - sin_theta_m * sin_theta_m) + old_vz * (2 * cos_theta_m * sin_theta_m); + vz = old_vx * (2 * cos_theta_m * sin_theta_m) + old_vz * (sin_theta_m * sin_theta_m - cos_theta_m * cos_theta_m); + // printf("line 388\n"); + } + // printf("theta_m=%f, sin_theta_m=%f, cos_theta_m=%f, v_n=%f, old_vx=%f, vx=%f, old_vz=%f, vz=%f\n\n", theta_m, sin_theta_m, cos_theta_m, v_n, old_vx, + // vx, old_vz, vz); - + // printf("vxvx+vzvz=%f, oldvxoldvx+oldvzoldvz=%f", vx*vx+vz*vz, old_vx*old_vx+old_vz*old_vz); + SCATTER; + // printf("line 524.In mirror: x=%f,y=%f,z=%f,t=%f\n",x,y,z,t); + // printf("old_vx=%f,old_vy=%f,old_vz=%f,vx=%f,vy=%f,vz=%f,v_n=%f\n",old_vx,old_vy,old_vz,vx,vy,vz,v_n); + // after transmission or reflection + } // end } else { after if (!transmit) { + } -} // end if (x >=-length/2 && x<=length/2) + } // end if (x >=-length/2 && x<=length/2) -// printf("intersect=%d\n",intersect); + // printf("intersect=%d\n",intersect); - if (!intersect) { + if (!intersect) { /* No intersection: restore neutron position. */ x = old_x; y = old_y; z = old_z; t = old_t; -// printf("line 409\n"); - + // printf("line 409\n"); } - - -} //end if (dt>0) - + } // end if (dt>0) %} MCDISPLAY %{ + /* + if (xcenter==0){ -/* -if (xcenter==0){ - -xstart=0; -xend=length; -xprime_start=-a+mirror_start+xstart; -ystart=b*sqrt(1-xprime_start*xprime_start/asquared); - -xprime_end=-a+mirror_start+xend; -yend=b*sqrt(1-xprime_end*xprime_end/asquared); - -} -*/ - -/* -if (xcenter==1){ -xstart=-length/2; -xend=length/2; - - -xprime_start=-a+mirror_start+xstart+length/2; -ystart=b*sqrt(1-xprime_start*xprime_start/asquared); - -xprime_end=-a+mirror_start+xend+length/2; -yend=b*sqrt(1-xprime_end*xprime_end/asquared); -} - -line(xstart,-ystart,0,xstart,ystart,0); -line(xend,-yend,0,xend,yend,0); -line(xstart,-ystart,0,xend,-yend,0); -line(xstart,ystart,0,xend,yend,0); -*/ - -double xstart; -double xend; -double xprime_start; -double ystart; - -double xprime_end; -double yend; + xstart=0; + xend=length; + xprime_start=-a+mirror_start+xstart; + ystart=b*sqrt(1-xprime_start*xprime_start/asquared); -double focus_2; -double focus_1; -double b; -double f; -double asquared; -double a; - - -int n_lines; -int j=0; -double xprimepos[51]; -double ypos[51]; -double x_plot[51]; -double zpos[51]; -double xstep; - - - -focus_2=focus_e-mirror_start; //focus in local coordinates -focus_1=focus_s-mirror_start; - -b=smallaxis/2; - -f=(focus_2-focus_1)*0.5; - asquared=f*f+b*b; - a=sqrt(asquared); - - -xstart=-length/2; -xend=length/2; - -n_lines=50; - -xstep=length/n_lines; + xprime_end=-a+mirror_start+xend; + yend=b*sqrt(1-xprime_end*xprime_end/asquared); + } + */ + /* + if (xcenter==1){ + xstart=-length/2; + xend=length/2; + xprime_start=-a+mirror_start+xstart+length/2; + ystart=b*sqrt(1-xprime_start*xprime_start/asquared); + xprime_end=-a+mirror_start+xend+length/2; + yend=b*sqrt(1-xprime_end*xprime_end/asquared); + } + line(xstart,-ystart,0,xstart,ystart,0); + line(xend,-yend,0,xend,yend,0); + line(xstart,-ystart,0,xend,-yend,0); + line(xstart,ystart,0,xend,yend,0); + */ -double a1, b1, c1; -double tan_theta_1; -double tan_theta_2; -double tan_theta_3; + double xstart; + double xend; + double xprime_start; + double ystart; + double xprime_end; + double yend; + double focus_2; + double focus_1; + double b; + double f; + double asquared; + double a; -//mirror is defined by z(x)=a1x^3+b1x^2+c1x+d1, with dz/dx|x=-length/2=tan(theta_1), dz/dx|x=0=tan(theta_2), dz/dx|x=length/2=tan(theta3), z(0)=0. (d1=0) + int n_lines; + int j = 0; + double xprimepos[51]; + double ypos[51]; + double x_plot[51]; + double zpos[51]; + double xstep; -tan_theta_1=tan(theta_1*DEG2RAD); -tan_theta_2=tan(theta_2*DEG2RAD); -tan_theta_3=tan(theta_3*DEG2RAD); + focus_2 = focus_e - mirror_start; // focus in local coordinates + focus_1 = focus_s - mirror_start; + b = smallaxis / 2; -a1=2.0/3.0*(tan_theta_1+tan_theta_3-2.0*tan_theta_2)/(length*length); -b1=(tan_theta_3-tan_theta_1)/(2.0*length); -c1=tan_theta_2; + f = (focus_2 - focus_1) * 0.5; + asquared = f * f + b * b; + a = sqrt (asquared); + xstart = -length / 2; + xend = length / 2; + n_lines = 50; -for (j=0; jmirror_start){ -if ( xstart+xstep*j<-length/2+guide_start-mirror_start) { -ypos[j]=yheight/2; -} -} + // mirror is defined by z(x)=a1x^3+b1x^2+c1x+d1, with dz/dx|x=-length/2=tan(theta_1), dz/dx|x=0=tan(theta_2), dz/dx|x=length/2=tan(theta3), z(0)=0. (d1=0) + tan_theta_1 = tan (theta_1 * DEG2RAD); + tan_theta_2 = tan (theta_2 * DEG2RAD); + tan_theta_3 = tan (theta_3 * DEG2RAD); + a1 = 2.0 / 3.0 * (tan_theta_1 + tan_theta_3 - 2.0 * tan_theta_2) / (length * length); + b1 = (tan_theta_3 - tan_theta_1) / (2.0 * length); + c1 = tan_theta_2; -// ypos[j]=b*sqrt(1-xprimepos[j]*xprimepos[j]/(f*f)); //following convention in Kaspar's elliptic guide.. -// printf("xprimepos[j]=%f,f*f=%f, ypos[j]=%f\n",xprimepos[j],f*f,ypos[j]); + for (j = 0; j < n_lines + 1; j++) { + xprimepos[j] = -f - focus_s + mirror_start + length / 2 + xstart + xstep * j; -x_plot[j]=xstart+xstep*j; -zpos[j]=a1*x_plot[j]*x_plot[j]*x_plot[j]+b1*x_plot[j]*x_plot[j]+c1*x_plot[j]; -} + ypos[j] = b * sqrt (1 - xprimepos[j] * xprimepos[j] / asquared); // correct -for (j=0; j mirror_start) { + if (xstart + xstep * j < -length / 2 + guide_start - mirror_start) { + ypos[j] = yheight / 2; + } + } + // ypos[j]=b*sqrt(1-xprimepos[j]*xprimepos[j]/(f*f)); //following convention in Kaspar's elliptic guide.. + // printf("xprimepos[j]=%f,f*f=%f, ypos[j]=%f\n",xprimepos[j],f*f,ypos[j]); -line(x_plot[0],-ypos[0],zpos[0],x_plot[0],ypos[0],zpos[0]); -line(x_plot[50],-ypos[50],zpos[50],x_plot[50],ypos[50],zpos[50]); + x_plot[j] = xstart + xstep * j; + zpos[j] = a1 * x_plot[j] * x_plot[j] * x_plot[j] + b1 * x_plot[j] * x_plot[j] + c1 * x_plot[j]; + } + for (j = 0; j < n_lines; j++) { + line (x_plot[j], -ypos[j], zpos[j], x_plot[j + 1], -ypos[j + 1], zpos[j + 1]); + line (x_plot[j], ypos[j], zpos[j], x_plot[j + 1], ypos[j + 1], zpos[j + 1]); + } + line (x_plot[0], -ypos[0], zpos[0], x_plot[0], ypos[0], zpos[0]); + line (x_plot[50], -ypos[50], zpos[50], x_plot[50], ypos[50], zpos[50]); + // printf("ypos0=%f xpos0=%f ypos50=%f xpos50=%f",ypos[0], x_plot[0], ypos[50], x_plot[50]); -//printf("ypos0=%f xpos0=%f ypos50=%f xpos50=%f",ypos[0], x_plot[0], ypos[50], x_plot[50]); + /* double xmax, xmin, ymax, ymin; -/* double xmax, xmin, ymax, ymin; - - if (center == 0) { - xmax= x1; xmin=0; - ymax= yheight; ymin=0; - } else { - xmax= x1/2; xmin=-xmax; - ymax= yheight/2; ymin=-ymax; - } - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); -*/ + if (center == 0) { + xmax= x1; xmin=0; + ymax= yheight; ymin=0; + } else { + xmax= x1/2; xmin=-xmax; + ymax= yheight/2; ymin=-ymax; + } + multiline(5, (double)xmin, (double)ymin, 0.0, + (double)xmax, (double)ymin, 0.0, + (double)xmax, (double)ymax, 0.0, + (double)xmin, (double)ymax, 0.0, + (double)xmin, (double)ymin, 0.0); + */ %} END diff --git a/mcstas-comps/contrib/Mirror_Elliptic.comp b/mcstas-comps/contrib/Mirror_Elliptic.comp index 27acd7465..64422d386 100644 --- a/mcstas-comps/contrib/Mirror_Elliptic.comp +++ b/mcstas-comps/contrib/Mirror_Elliptic.comp @@ -50,179 +50,174 @@ R0=0.99, Qc=0.0219, alpha=6.07, m=1.0, W=0.003) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -#ifndef SIGN -#define SIGN(a) (a >= 0 ? (a == 0 ? 0 : 1) : -1) -#endif + #ifndef SIGN + #define SIGN(a) (a >= 0 ? (a == 0 ? 0 : 1) : -1) + #endif %include "read_table-lib" %include "ref-lib" %} DECLARE %{ - double beta1; /* ellipse parameters */ - double alpha1; - double beta2; /* ellipse squared parameters */ + double beta1; /* ellipse parameters */ + double alpha1; + double beta2; /* ellipse squared parameters */ double alpha2; t_Table pTable; - int err; + int err; %} INITIALIZE %{ - if (reflect && strlen(reflect) && strcmp(reflect, "NULL") && strcmp(reflect,"0")) { - if (Table_Read(&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"Mirror_Elliptic: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) { + if (Table_Read (&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Mirror_Elliptic: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); } /* Calculation of ellipse parameters */ - alpha1 = interfocus/2 +focus; - alpha2 = alpha1*alpha1; - beta2 = alpha2 - (interfocus*interfocus)/4; - beta1 = sqrt(beta2); + alpha1 = interfocus / 2 + focus; + alpha2 = alpha1 * alpha1; + beta2 = alpha2 - (interfocus * interfocus) / 4; + beta1 = sqrt (beta2); err = 0; - yheight/=2; - if(zmin==0&&zmax==0){ - zmin = -alpha1; - zmax = alpha1; + yheight /= 2; + if (zmin == 0 && zmax == 0) { + zmin = -alpha1; + zmax = alpha1; + } else { + if (zmin >= zmax) + exit (fprintf (stderr, "Mirror_Elliptic: %s: error definition zmin and zmax\n", NAME_CURRENT_COMP)); } - else{ - if(zmin>=zmax) exit(fprintf(stderr,"Mirror_Elliptic: %s: error definition zmin and zmax\n", NAME_CURRENT_COMP)); - } - printf("Mirror_Elliptic: %s: alpha=%f alpha^2=%f beta=%f beta^2=%f\n", - NAME_CURRENT_COMP, alpha1,alpha2,beta1,beta2); + printf ("Mirror_Elliptic: %s: alpha=%f alpha^2=%f beta=%f beta^2=%f\n", NAME_CURRENT_COMP, alpha1, alpha2, beta1, beta2); %} TRACE %{ double q, B; - double div,z1,x1,z2,x2; + double div, z1, x1, z2, x2; double v; - double vx_2,vz_2; - int i=-1; - double oa,ob,ab,xa,za; + double vx_2, vz_2; + int i = -1; + double oa, ob, ab, xa, za; double angle; double old_x; double old_y; double old_z; - double par[5] = {R0, Qc, alpha, m, W}; - double a,b; + double par[5] = { R0, Qc, alpha, m, W }; + double a, b; double delta; /* First check if neutron has the right direction. */ - if((vz != 0.0 && -z/vz >= 0) && x+beta1> 0) - { - - i++; - old_z=z; - old_x=x; - old_y=y; - a=vx/vz; - b=x-a*z; - /* printf("\nx : %e / z : %f / y : %e\nvx : %e / vz : %e / vy : %e\na : %e / b : %f",x,z,y,vx,vz,a,b); */ - - /* Calculation of intersection with ellipse */ - delta = sqrt(4*(a*a*b*b-(a*a+beta2/alpha2)*(b*b-beta2))); - /* printf("\nDELTA : %e",delta); */ - z1 = (-2*a*b - delta)/(2*(a*a+beta2/alpha2)); - z2 = (-2*a*b + delta)/(2*(a*a+beta2/alpha2)); - x1 = a*z1+b; - x2 = a*z2+b; - /* printf("\nx1 : %f / z1 : %f\nx2 : %f / z2 : %f\n",x1,z1,x2,z2); */ - - /* Choose the right result */ - if((z1>z2)&&(fabs(z1)= 0) && x + beta1 > 0) { + + i++; + old_z = z; + old_x = x; + old_y = y; + a = vx / vz; + b = x - a * z; + /* printf("\nx : %e / z : %f / y : %e\nvx : %e / vz : %e / vy : %e\na : %e / b : %f",x,z,y,vx,vz,a,b); */ + + /* Calculation of intersection with ellipse */ + delta = sqrt (4 * (a * a * b * b - (a * a + beta2 / alpha2) * (b * b - beta2))); + /* printf("\nDELTA : %e",delta); */ + z1 = (-2 * a * b - delta) / (2 * (a * a + beta2 / alpha2)); + z2 = (-2 * a * b + delta) / (2 * (a * a + beta2 / alpha2)); + x1 = a * z1 + b; + x2 = a * z2 + b; + /* printf("\nx1 : %f / z1 : %f\nx2 : %f / z2 : %f\n",x1,z1,x2,z2); */ + + /* Choose the right result */ + if ((z1 > z2) && (fabs (z1) < alpha1)) { + x = SIGN (x1) * beta1 * sqrt (1 - z1 * z1 / alpha2); + z = z1; + } else { + if (fabs (z2) < alpha1) { + x = SIGN (x2) * beta1 * sqrt (1 - z2 * z2 / alpha2); + z = z2; + } else { + printf ("Mirror_Elliptic: %s: WARNING: Error in the coordinates calculation (Absorb)\n", NAME_CURRENT_COMP); + ABSORB; } - if(fabs(x-a*z-b)>0.001){ - #pragma acc atomic - err = err + 1; - printf("Mirror_Elliptic: %s: x=%e z=%f X=%f (Absorb)",NAME_CURRENT_COMP,x,z,a*z+b); - ABSORB; + } + if (fabs (x - a * z - b) > 0.001) { + #pragma acc atomic + err = err + 1; + printf ("Mirror_Elliptic: %s: x=%e z=%f X=%f (Absorb)", NAME_CURRENT_COMP, x, z, a * z + b); + ABSORB; + } + + /* y calculation */ + y += vy * (z - old_z) / vz; + + /*reflection*/ + if (x < 0 && fabs (y) <= yheight && z >= zmin && z <= zmax) { + /*reflection angle in the plane xz*/ + div = -atan (vx / vz); + angle = -atan ((beta2 * z) / (alpha2 * x)); + + /*vx and vz calculation after reflection*/ + v = sqrt (vx * vx + vz * vz); + vz = v * cos (2 * angle + div); + vx = v * sin (2 * angle + div); + /* + printf("reflection2D :\nv: %e / angle (tangeante) : %f / div : %f / incidence : %f\n",v,angle,div,2*angle+div); + printf("vx : %f /vz : %f\n",vx,vz); + */ + /*incidence angle in 3D*/ + ob = sqrt ((old_x - x) * (old_x - x) + (old_z - z) * (old_z - z)); + xa = x - ob * cos (div + angle) * sin (angle); + za = z - ob * cos (div + angle) * cos (angle); + oa = sqrt ((old_x - xa) * (old_x - xa) + (old_z - za) * (old_z - za)); + ob = sqrt ((old_x - x) * (old_x - x) + (old_y - y) * (old_y - y) + (old_z - z) * (old_z - z)); + ab = sqrt ((xa - x) * (xa - x) + (old_y - y) * (old_y - y) + (za - z) * (za - z)); + angle = acos ((-ab * ab - ob * ob + oa * oa) / (2 * ab * ob)); + /* printf("3D :\nxa : %f / za : %f\noa : %f / ob : %f / ab : %f\nangle : %f / v : %e\n",xa,za,oa,ob,ab,angle,v); */ + + v = sqrt (vx * vx + vy * vy + vz * vz); + q = fabs (2 * sin (angle) * v * V2Q); + /* Reflectivity (see component Guide). */ + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) + TableReflecFunc (q, &pTable, &B); + else { + StdReflecFunc (q, par, &B); } - - - /* y calculation */ - y+=vy*(z-old_z)/vz; - - /*reflection*/ - if(x<0 && fabs(y)<=yheight && z>=zmin && z<=zmax){ - /*reflection angle in the plane xz*/ - div = -atan(vx/vz); - angle = -atan((beta2*z)/(alpha2*x)); - - /*vx and vz calculation after reflection*/ - v=sqrt(vx*vx+vz*vz); - vz = v*cos(2*angle+div); - vx = v*sin(2*angle+div); - /* - printf("reflection2D :\nv: %e / angle (tangeante) : %f / div : %f / incidence : %f\n",v,angle,div,2*angle+div); - printf("vx : %f /vz : %f\n",vx,vz); - */ - /*incidence angle in 3D*/ - ob = sqrt((old_x-x)*(old_x-x)+(old_z-z)*(old_z-z)); - xa = x-ob*cos(div+angle)*sin(angle); - za = z-ob*cos(div+angle)*cos(angle); - oa = sqrt((old_x-xa)*(old_x-xa)+(old_z-za)*(old_z-za)); - ob = sqrt((old_x-x)*(old_x-x)+(old_y-y)*(old_y-y)+(old_z-z)*(old_z-z)); - ab = sqrt((xa-x)*(xa-x)+(old_y-y)*(old_y-y)+(za-z)*(za-z)); - angle = acos((-ab*ab-ob*ob+oa*oa)/(2*ab*ob)); - /* printf("3D :\nxa : %f / za : %f\noa : %f / ob : %f / ab : %f\nangle : %f / v : %e\n",xa,za,oa,ob,ab,angle,v); */ - - v=sqrt(vx*vx+vy*vy+vz*vz); - q = fabs(2*sin(angle)*v*V2Q); - /* Reflectivity (see component Guide). */ - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) - TableReflecFunc(q, &pTable, &B); - else { - StdReflecFunc(q, par, &B); - } - if (B <= 0) { ABSORB; } - else p *= B; - } - else ABSORB; - SCATTER; - } - else{ + if (B <= 0) { + ABSORB; + } else + p *= B; + } else + ABSORB; + SCATTER; + } else { ABSORB; } %} FINALLY %{ - if(err!=0){ - fprintf(stderr,"Mirror_Elliptic: %s: WARNING : %d neutrons absorbed for inadapted divergence !\n", NAME_CURRENT_COMP, err); - } + if (err != 0) { + fprintf (stderr, "Mirror_Elliptic: %s: WARNING : %d neutrons absorbed for inadapted divergence !\n", NAME_CURRENT_COMP, err); + } %} MCDISPLAY %{ - double xi,zi,xf,zf,delta_z; - - delta_z = (zmax-zmin)/99; - xi=-beta1*sqrt(1-zmin*zmin/alpha2); - line(xi,-yheight,zmin,xi,yheight,zmin); - zi=zmin; - /* printf("delta_z : %f / xi : %f / zi : %f\n",delta_z,xi,zi); */ - do{ - zf = zi + delta_z; - xf=-beta1*sqrt(1-zf*zf/alpha2); - line(xi,yheight,zi,xf,yheight,zf); - line(xf,yheight,zf,xf,-yheight,zf); - line(xf,-yheight,zf,xi,-yheight,zi); - xi=xf; - zi=zf; - } while(zf<=zmax); + double xi, zi, xf, zf, delta_z; + delta_z = (zmax - zmin) / 99; + xi = -beta1 * sqrt (1 - zmin * zmin / alpha2); + line (xi, -yheight, zmin, xi, yheight, zmin); + zi = zmin; + /* printf("delta_z : %f / xi : %f / zi : %f\n",delta_z,xi,zi); */ + do { + zf = zi + delta_z; + xf = -beta1 * sqrt (1 - zf * zf / alpha2); + line (xi, yheight, zi, xf, yheight, zf); + line (xf, yheight, zf, xf, -yheight, zf); + line (xf, -yheight, zf, xi, -yheight, zi); + xi = xf; + zi = zf; + } while (zf <= zmax); %} END diff --git a/mcstas-comps/contrib/Mirror_Elliptic_Bispectral.comp b/mcstas-comps/contrib/Mirror_Elliptic_Bispectral.comp index da369ef8f..5e4a8b49e 100644 --- a/mcstas-comps/contrib/Mirror_Elliptic_Bispectral.comp +++ b/mcstas-comps/contrib/Mirror_Elliptic_Bispectral.comp @@ -68,489 +68,453 @@ DECLARE INITIALIZE %{ - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) { - if (Table_Read(&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr,"Mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) { + if (Table_Read (&pTable, reflect, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Mirror: %s: can not read file %s\n", NAME_CURRENT_COMP, reflect)); } %} TRACE %{ -double f; //half of distance between focal points -double asquared; -double a; //half of ellipse length -double b; //half of ellipse width - -double xprime; //x in coordinates with center of ellipse at (xprime,zprime)=(0,0) -double ymirror; //height of the mirror - - -//Defining the mirror -double a1; -double b1; -double c1; - -//solving the time the neutron hits the sample -double A, B, C, D, E, P, Q, R, U, V, I, J, K; - -//finding rotation of mirror -double alpha1, beta1, gamma1; -double theta_m; -double xhi, zeta; - - -double b_w; -double f_w; -double asquared_w; -double A_w; -double B_w; -double C_w; -double determinant_w; - - -double b_h; -double f_h; -double asquared_h; -double xprime_h; - - -double xprime_w; -double zprime_w; -double asquare_z; -double bsquare_x; - - -double v_n; //speed of neutron perpendicular to surface - -double Ref; //reflectivity - -double dt; -double q; + double f; // half of distance between focal points + double asquared; + double a; // half of ellipse length + double b; // half of ellipse width + + double xprime; // x in coordinates with center of ellipse at (xprime,zprime)=(0,0) + double ymirror; // height of the mirror + + // Defining the mirror + double a1; + double b1; + double c1; + + // solving the time the neutron hits the sample + double A, B, C, D, E, P, Q, R, U, V, I, J, K; + + // finding rotation of mirror + double alpha1, beta1, gamma1; + double theta_m; + double xhi, zeta; + + double b_w; + double f_w; + double asquared_w; + double A_w; + double B_w; + double C_w; + double determinant_w; + + double b_h; + double f_h; + double asquared_h; + double xprime_h; + + double xprime_w; + double zprime_w; + double asquare_z; + double bsquare_x; + + double v_n; // speed of neutron perpendicular to surface + + double Ref; // reflectivity + + double dt; + double q; int intersect; -double discriminant; - -double xprime_start_w; -double zprime_start_w; - -double z_test; -double x_test; -double z_prime_test; - -int hit_back_flag; - -int prop_case; - - -double x_2; -double y_2; -double z_2; -double t_2; -int x_hit; -int x_hit_2; - -double xprime_h_2; -double ymirror_2; -int intersect_2; - -intersect=0; -x_2=0; -y_2=0; -z_2=0; -t_2=-1; -prop_case=0; - double old_x = x, old_y = y, old_z = z, old_t=t, old_vx=vx, old_vz=vz, old_vy=vy; - -// Check if neutron hits mirror. First find which z,x coordinates it hits. - - - -//define the ellipse -b_w=smallaxis_w/2; -f_w=(focus_end_w-focus_start_w)*0.5; -asquared_w=f_w*f_w+b_w*b_w; - -//in coordinate system of mirror: xprime_w(t)=xprime_w+vx*t. z-value is zprime(t)=b*sqrt(1-x'^2/a^2)+old_z+vz*t. This gives equation for t: A_w*t^2+B_w*t+C_w=0; - -xprime_start_w=old_x-f_w-focus_start_w+mirror_start; -zprime_start_w=z; - -A_w=b_w*b_w*vx*vx+asquared_w*vz*vz; -B_w=2*b_w*b_w*xprime_start_w*vx+2*asquared_w*old_z*vz; -C_w=b_w*b_w*xprime_start_w*xprime_start_w+asquared_w*old_z*old_z-asquared_w*b_w*b_w; - -//this equation must now be solved for t; - -if (A_w!=0){ -determinant_w=B_w*B_w-4.0*A_w*C_w; -if (determinant_w>=0){ -I=(-B_w-sqrt(determinant_w))/(2.0*A_w); -J=(-B_w+sqrt(determinant_w))/(2.0*A_w); - -if (I<=0 && J<=0){dt = -1.0;} //both times are negative. -if (I<=0 && J>0 ){dt = J;} //set dt to only positive value. -if (I>0 && J<=0){dt = I;} //set dt to only positive value. - -if (I>0 && J>0 ){prop_case=1; if (I>J) {dt=J;}else{dt=I;}} //set dt to smallest positive value - - -} else {dt=-1.0;} //only complex solutions: set dt negative so no scattering - -}else{ //end if (A!=0) -if (B_w!=0){ -dt=-C/B_w; -}else{ //end if (B!)=0 - printf("warning: A_w=B_w=C_w=0. Neutron is ignored\n"); } -} //end if (A!=0){}else{ -//now intersection time has been found. + double discriminant; + + double xprime_start_w; + double zprime_start_w; + + double z_test; + double x_test; + double z_prime_test; + + int hit_back_flag; + + int prop_case; + + double x_2; + double y_2; + double z_2; + double t_2; + int x_hit; + int x_hit_2; + + double xprime_h_2; + double ymirror_2; + int intersect_2; + + intersect = 0; + x_2 = 0; + y_2 = 0; + z_2 = 0; + t_2 = -1; + prop_case = 0; + double old_x = x, old_y = y, old_z = z, old_t = t, old_vx = vx, old_vz = vz, old_vy = vy; + + // Check if neutron hits mirror. First find which z,x coordinates it hits. + + // define the ellipse + b_w = smallaxis_w / 2; + f_w = (focus_end_w - focus_start_w) * 0.5; + asquared_w = f_w * f_w + b_w * b_w; + + // in coordinate system of mirror: xprime_w(t)=xprime_w+vx*t. z-value is zprime(t)=b*sqrt(1-x'^2/a^2)+old_z+vz*t. This gives equation for t: + // A_w*t^2+B_w*t+C_w=0; + + xprime_start_w = old_x - f_w - focus_start_w + mirror_start; + zprime_start_w = z; + + A_w = b_w * b_w * vx * vx + asquared_w * vz * vz; + B_w = 2 * b_w * b_w * xprime_start_w * vx + 2 * asquared_w * old_z * vz; + C_w = b_w * b_w * xprime_start_w * xprime_start_w + asquared_w * old_z * old_z - asquared_w * b_w * b_w; + + // this equation must now be solved for t; + + if (A_w != 0) { + determinant_w = B_w * B_w - 4.0 * A_w * C_w; + if (determinant_w >= 0) { + I = (-B_w - sqrt (determinant_w)) / (2.0 * A_w); + J = (-B_w + sqrt (determinant_w)) / (2.0 * A_w); + + if (I <= 0 && J <= 0) { + dt = -1.0; + } // both times are negative. + if (I <= 0 && J > 0) { + dt = J; + } // set dt to only positive value. + if (I > 0 && J <= 0) { + dt = I; + } // set dt to only positive value. + + if (I > 0 && J > 0) { + prop_case = 1; + if (I > J) { + dt = J; + } else { + dt = I; + } + } // set dt to smallest positive value + + } else { + dt = -1.0; + } // only complex solutions: set dt negative so no scattering + + } else { // end if (A!=0) + if (B_w != 0) { + dt = -C / B_w; + } else { // end if (B!)=0 + printf ("warning: A_w=B_w=C_w=0. Neutron is ignored\n"); + } + } // end if (A!=0){}else{ + // now intersection time has been found. -//printf("dt=%f\n",dt); + // printf("dt=%f\n",dt); -if (dt>0) { //if time is positive, propagate neutron to where it hits mirror. This is done without gravity. + if (dt > 0) { // if time is positive, propagate neutron to where it hits mirror. This is done without gravity. - x += vx*dt; - y += vy*dt; - z += vz*dt; + x += vx * dt; + y += vy * dt; + z += vz * dt; t += dt; + if (prop_case > 0) // also check if neutron can hit mirror at second solution - it might not be in y-range for first solution + { + x_2 = x + vx * fabs (J - I); + y_2 = y + vy * fabs (J - I); + z_2 = z + vz * fabs (J - I); + t_2 = t + fabs (J - I); + + } else { + x_2 = x; + y_2 = y; + z_2 = z; + t_2 = t; + } -if (prop_case>0) //also check if neutron can hit mirror at second solution - it might not be in y-range for first solution -{ - x_2=x+vx*fabs(J-I); - y_2=y+vy*fabs(J-I); - z_2=z+vz*fabs(J-I); - t_2=t+fabs(J-I); - -}else{ -x_2=x; -y_2=y; -z_2=z; -t_2=t; -} - -x_hit=(x>=0 &&x<=length); -x_hit_2=(x_2>=0 &&x_2<=length); - -// printf("x=%f,y=%f,z=%f\n",x,y,z); -//if (x >=0 && x<=length){ //check if neutron is within x limits of the mirror. If so, check if it is within y limits. -if (x_hit || x_hit_2){ - -//define the ellipse -b_h=smallaxis_h/2; - -f_h=(focus_end_h-focus_start_h)*0.5; - - asquared_h=f_h*f_h+b_h*b_h; - -xprime_h=-f_h-focus_start_h+mirror_start+x; //xprime is the x-coordinate in a coordinate system centered at the center of the ellipse - -ymirror=b_h*sqrt(1-xprime_h*xprime_h/asquared_h); - + x_hit = (x >= 0 && x <= length); + x_hit_2 = (x_2 >= 0 && x_2 <= length); -xprime_h_2=-f_h-focus_start_h+mirror_start+x_2; //xprime is the x-coordinate in a coordinate system centered at the center of the ellipse + // printf("x=%f,y=%f,z=%f\n",x,y,z); + // if (x >=0 && x<=length){ //check if neutron is within x limits of the mirror. If so, check if it is within y limits. + if (x_hit || x_hit_2) { -ymirror_2=b_h*sqrt(1-xprime_h_2*xprime_h_2/asquared_h); + // define the ellipse + b_h = smallaxis_h / 2; + f_h = (focus_end_h - focus_start_h) * 0.5; -intersect = ( y>=-ymirror && y<=ymirror && x>=0 && x<=length && zprime_start_w+vz*dt>=0); + asquared_h = f_h * f_h + b_h * b_h; -intersect_2 = ( y_2>=-ymirror_2 && y_2<=ymirror_2 && x_2>=0 && x_2<=length && zprime_start_w+vz*(dt+fabs(J-I))>=0); + xprime_h = -f_h - focus_start_h + mirror_start + x; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse -if (!intersect && intersect_2){ //if neutron doesn't hit mirror with smallest t, but hits with largest t, propagte to largest t -intersect=intersect_2; -x=x_2; -y=y_2; -z=z_2; -t=t_2; -dt=t_2-old_t; -//printf("x=%f,y=%f,z=%f\n",x,y,z); -} + ymirror = b_h * sqrt (1 - xprime_h * xprime_h / asquared_h); - if (intersect) { //if neutron is within ylimits of the mirror handle reflection/transmission + xprime_h_2 = -f_h - focus_start_h + mirror_start + x_2; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse + ymirror_2 = b_h * sqrt (1 - xprime_h_2 * xprime_h_2 / asquared_h); -//now perform reflection. + intersect = (y >= -ymirror && y <= ymirror && x >= 0 && x <= length && zprime_start_w + vz * dt >= 0); -//First find out if neutron hits front or back of mirror: propagate backwards a bit and check if neutron is outside ellipse: if so, it hits back of mirror + intersect_2 = (y_2 >= -ymirror_2 && y_2 <= ymirror_2 && x_2 >= 0 && x_2 <= length && zprime_start_w + vz * (dt + fabs (J - I)) >= 0); + if (!intersect && intersect_2) { // if neutron doesn't hit mirror with smallest t, but hits with largest t, propagte to largest t + intersect = intersect_2; + x = x_2; + y = y_2; + z = z_2; + t = t_2; + dt = t_2 - old_t; + // printf("x=%f,y=%f,z=%f\n",x,y,z); + } -b_w=smallaxis_w/2.0; + if (intersect) { // if neutron is within ylimits of the mirror handle reflection/transmission -f_w=(focus_end_w-focus_start_w)*0.5; - asquared_w=f_w*f_w+b_w*b_w; + // now perform reflection. -z_test=zprime_start_w+vz*(dt-1e-6); -x_test=xprime_start_w+vx*(dt-1e-6); -z_prime_test=b_w*sqrt(1-x_test*x_test/asquared_w); + // First find out if neutron hits front or back of mirror: propagate backwards a bit and check if neutron is outside ellipse: if so, it hits back of + // mirror -//find velocity in q direction. + b_w = smallaxis_w / 2.0; -xprime_w=xprime_start_w+vx*dt; -zprime_w=zprime_start_w+vz*dt; -asquare_z=asquared_w*zprime_w; -bsquare_x=b_w*b_w*xprime_w; + f_w = (focus_end_w - focus_start_w) * 0.5; + asquared_w = f_w * f_w + b_w * b_w; + z_test = zprime_start_w + vz * (dt - 1e-6); + x_test = xprime_start_w + vx * (dt - 1e-6); + z_prime_test = b_w * sqrt (1 - x_test * x_test / asquared_w); -zeta=(asquare_z)/(sqrt(asquare_z*asquare_z+bsquare_x*bsquare_x)); -xhi=-(bsquare_x)/(sqrt(asquare_z*asquare_z+bsquare_x*bsquare_x)); + // find velocity in q direction. -//printf("z_test=%f, z_prime_test=%f\n",z_test,z_prime_test); + xprime_w = xprime_start_w + vx * dt; + zprime_w = zprime_start_w + vz * dt; + asquare_z = asquared_w * zprime_w; + bsquare_x = b_w * b_w * xprime_w; -if (z_test>z_prime_test) { -hit_back_flag=1; -} -//printf("vx=%f, vz=%f, vy=%f, xhi=%f, zeta=%f, prop_case=%d\n",vx,vz,vy,xhi,zeta,prop_case); -v_n=-xhi*vx+zeta*vz; + zeta = (asquare_z) / (sqrt (asquare_z * asquare_z + bsquare_x * bsquare_x)); + xhi = -(bsquare_x) / (sqrt (asquare_z * asquare_z + bsquare_x * bsquare_x)); -q=fabs(2.0*v_n*V2Q); + // printf("z_test=%f, z_prime_test=%f\n",z_test,z_prime_test); + if (z_test > z_prime_test) { + hit_back_flag = 1; + } + // printf("vx=%f, vz=%f, vy=%f, xhi=%f, zeta=%f, prop_case=%d\n",vx,vz,vy,xhi,zeta,prop_case); + v_n = -xhi * vx + zeta * vz; - //Reflectivity parameters calculated from SWISS neutronics data. -double R0=0.99; -double Qc=0.0217; -double m_value=m*0.9853+0.1978; -double W=-0.0002*m_value+0.0022; -double alpha=0.1204*m_value+5.0944; -double beta=-7.6251*m_value+68.1137; + q = fabs (2.0 * v_n * V2Q); -if (m_value<=3) -{alpha=m_value; -beta=0;} + // Reflectivity parameters calculated from SWISS neutronics data. + double R0 = 0.99; + double Qc = 0.0217; + double m_value = m * 0.9853 + 0.1978; + double W = -0.0002 * m_value + 0.0022; + double alpha = 0.1204 * m_value + 5.0944; + double beta = -7.6251 * m_value + 68.1137; + if (m_value <= 3) { + alpha = m_value; + beta = 0; + } - /* Reflectivity (see component Guide). */ - if(m == 0) - ABSORB; - if (reflect && strlen(reflect) && strcmp(reflect,"NULL") && strcmp(reflect,"0")) - Ref=Table_Value(pTable, q, 1); - else { + /* Reflectivity (see component Guide). */ + if (m == 0) + ABSORB; + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) + Ref = Table_Value (pTable, q, 1); + else { Ref = R0; - if(q > Qc) - { - double arg = (q-m_value*Qc)/W; - if(arg < 10) - Ref *= .5*(1-tanh(arg))*(1-alpha*(q-Qc)+beta*(q-Qc)*(q-Qc)); //matches data from Swiss Neutronics - else Ref=0; + if (q > Qc) { + double arg = (q - m_value * Qc) / W; + if (arg < 10) + Ref *= .5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc) + beta * (q - Qc) * (q - Qc)); // matches data from Swiss Neutronics + else + Ref = 0; + } + } + if (Ref < 0) + Ref = 0; + else if (Ref > 1) + Ref = 1; + + // Now comes actual reflection/transmission + if (!transmit) { // all neutrons are reflected + // printf("v_n=%f,q=%f, Ref=%f, lambda=%f, theta=%f, 1p_before=%f",v_n,q, Ref, (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz),asin((2*PI/V2K)/sqrt(vx*vx + vy*vy + // + vz*vz)*q/(4*PI))*RAD2DEG,p); + if (!Ref) + ABSORB; + p *= Ref; + // printf("p_after=%f\n",p); + // handle reflection: change v_n -->-v_n + + vx = old_vx * (zeta * zeta - xhi * xhi) + old_vz * (2 * zeta * xhi); + vz = +old_vx * (2 * zeta * xhi) + old_vz * (xhi * xhi - zeta * zeta); + + SCATTER; // after transmission or reflection + + } else { // if neutrons can be transmitted + + // calculate absorption. + // substrate + double lambda = (2 * PI / V2K) / sqrt (vx * vx + vy * vy + vz * vz); + double sin_theta = lambda * q / (4 * PI); + double substrate_path_length = substrate_thickness / sin_theta; + double mu_substrate = 0.0318 / lambda + 0.0055 * lambda - 0.0050; // unit: cm^-1 + mu_substrate = mu_substrate * 100; // unit: m^-1; + + // For nickel and titanium coating, the following formular is used: + // mu = rho/m(atom)*sigma_a,thermal*lambda/lambda_thermal + + // lambda_thermal=1.798 Å + + // rho_nickel=8.908g/cm^3 + // m(atom)_nickel=58.6934*1.661*10^-27 kg + // sigma_a,thermal_nickel=4.49*10^-28 m^2 + + // rho_titanium=4.506g/cm^3 + // m(atom)_titanium=47.867*1.661*10^-27 kg + // sigma_a,thermal_titanium=6.09*10^-28 m^2 + + double coating_path_length = coating_thickness / sin_theta; + double Ni_coefficient = 22.8180; + double Ti_coefficient = 19.1961; + + double mu_coating = (0.5 * Ni_coefficient + 0.5 * Ti_coefficient) * lambda; // it is roughly 50% nickel and 50% titanium + + // transmit when rand > R + if (Ref == 0 || rand01 () >= Ref) { // transmit + if (substrate_thickness > 0) { + p = p * exp (-mu_substrate * substrate_path_length - mu_coating * coating_path_length); + } // reduce weight of neutrons due to attenuation in the mirror + + } else { // neutron is reflected + if (hit_back_flag == 1 && substrate_thickness > 0) { // if neutron comes from behind the mirror + p = p * exp (-2 * mu_substrate * substrate_path_length - 2 * mu_coating * coating_path_length); + } // reduce weight of neutrons due to attenuation in the mirror + // handle reflection: change v_n -->-v_n + + vx = old_vx * (zeta * zeta - xhi * xhi) - old_vz * (2 * zeta * xhi); + vz = -old_vx * (2 * zeta * xhi) + old_vz * (xhi * xhi - zeta * zeta); } - } - if (Ref < 0) Ref=0; - else if (Ref > 1) Ref=1; - - -//Now comes actual reflection/transmission - if (!transmit) { //all neutrons are reflected -//printf("v_n=%f,q=%f, Ref=%f, lambda=%f, theta=%f, 1p_before=%f",v_n,q, Ref, (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz),asin((2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz)*q/(4*PI))*RAD2DEG,p); - if (!Ref) ABSORB; - p *= Ref; -//printf("p_after=%f\n",p); -//handle reflection: change v_n -->-v_n - -vx=old_vx*(zeta*zeta-xhi*xhi)+old_vz*(2*zeta*xhi); -vz=+old_vx*(2*zeta*xhi)+old_vz*(xhi*xhi-zeta*zeta); - - - SCATTER; //after transmission or reflection - - } else { //if neutrons can be transmitted - - - -//calculate absorption. -// substrate -double lambda=(2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); -double sin_theta=lambda*q/(4*PI); -double substrate_path_length=substrate_thickness/sin_theta; -double mu_substrate=0.0318/lambda+0.0055*lambda-0.0050; //unit: cm^-1 -mu_substrate=mu_substrate*100; //unit: m^-1; - -//For nickel and titanium coating, the following formular is used: -// mu = rho/m(atom)*sigma_a,thermal*lambda/lambda_thermal - -// lambda_thermal=1.798 Å - -// rho_nickel=8.908g/cm^3 -// m(atom)_nickel=58.6934*1.661*10^-27 kg -// sigma_a,thermal_nickel=4.49*10^-28 m^2 - -// rho_titanium=4.506g/cm^3 -// m(atom)_titanium=47.867*1.661*10^-27 kg -// sigma_a,thermal_titanium=6.09*10^-28 m^2 - -double coating_path_length=coating_thickness/sin_theta; -double Ni_coefficient=22.8180; -double Ti_coefficient=19.1961; - -double mu_coating=(0.5*Ni_coefficient+0.5*Ti_coefficient)*lambda; //it is roughly 50% nickel and 50% titanium - - - - // transmit when rand > R - if (Ref == 0 || rand01() >= Ref) { //transmit -if (substrate_thickness>0){ p=p*exp(-mu_substrate*substrate_path_length-mu_coating*coating_path_length);} //reduce weight of neutrons due to attenuation in the mirror - -} else {//neutron is reflected - if (hit_back_flag==1 && substrate_thickness>0) { //if neutron comes from behind the mirror - p=p*exp(-2*mu_substrate*substrate_path_length-2*mu_coating*coating_path_length);} //reduce weight of neutrons due to attenuation in the mirror -//handle reflection: change v_n -->-v_n - -vx=old_vx*(zeta*zeta-xhi*xhi)-old_vz*(2*zeta*xhi); -vz=-old_vx*(2*zeta*xhi)+old_vz*(xhi*xhi-zeta*zeta); -} - -//printf("p_before=%f, q=%f",p,q); - SCATTER; //after transmission or reflection -//printf("p_after=%f\n",p); - } //end } else { after if (!transmit) { - } - - - - -} // end if (x >=-length/2 && x<=length/2) + // printf("p_before=%f, q=%f",p,q); + SCATTER; // after transmission or reflection + // printf("p_after=%f\n",p); + } // end } else { after if (!transmit) { + } + } // end if (x >=-length/2 && x<=length/2) - if (!intersect) { + if (!intersect) { /* No intersection: restore neutron position. */ x = old_x; y = old_y; z = old_z; t = old_t; - - } - - -} //end if (dt>0) - + } // end if (dt>0) %} MCDISPLAY %{ + double xstart; + double xend; + double xprime_start; + double ystart; + double xprime_end; + double yend; -double xstart; -double xend; -double xprime_start; -double ystart; - -double xprime_end; -double yend; - -double focus_2_h; -double focus_1_h; -double b_h; -double f_h; -double asquared_h; - -double focus_2_w; -double focus_1_w; -double b_w; -double f_w; -double asquared_w; - + double focus_2_h; + double focus_1_h; + double b_h; + double f_h; + double asquared_h; -int n_lines; -int j=0; -double xprimepos[51]; -double ypos[51]; -double x_plot[51]; -double zpos[51]; -double xstep; -double xprime_w[51]; + double focus_2_w; + double focus_1_w; + double b_w; + double f_w; + double asquared_w; + int n_lines; + int j = 0; + double xprimepos[51]; + double ypos[51]; + double x_plot[51]; + double zpos[51]; + double xstep; + double xprime_w[51]; + focus_2_h = focus_end_h; // focus in local coordinates + focus_1_h = focus_start_h; -focus_2_h=focus_end_h; //focus in local coordinates -focus_1_h=focus_start_h; + b_h = smallaxis_h / 2.0; -b_h=smallaxis_h/2.0; + f_h = (focus_2_h - focus_1_h) * 0.5; + asquared_h = f_h * f_h + b_h * b_h; -f_h=(focus_2_h-focus_1_h)*0.5; - asquared_h=f_h*f_h+b_h*b_h; + focus_2_w = focus_end_w; // focus in local coordinates + focus_1_w = focus_start_w; + b_w = smallaxis_w / 2.0; + f_w = (focus_2_w - focus_1_w) * 0.5; + asquared_w = f_w * f_w + b_w * b_w; -focus_2_w=focus_end_w; //focus in local coordinates -focus_1_w=focus_start_w; + xstart = 0; + xend = length; -b_w=smallaxis_w/2.0; + n_lines = 50; -f_w=(focus_2_w-focus_1_w)*0.5; - asquared_w=f_w*f_w+b_w*b_w; + xstep = length / n_lines; + for (j = 0; j < n_lines + 1; j++) { + xprimepos[j] = -f_h - focus_start_h + mirror_start + xstart + xstep * j; + ypos[j] = b_h * sqrt (1 - xprimepos[j] * xprimepos[j] / asquared_h); // correct -xstart=0; -xend=length; + x_plot[j] = xstart + xstep * j; -n_lines=50; + xprime_w[j] + = -f_w - focus_start_w + mirror_start + xstart + xstep * j; // xprime is the x-coordinate in a coordinate system centered at the center of the ellipse -xstep=length/n_lines; - - - - - - - - - - - - - -for (j=0; j= 0) && x-xwidth-xshift < 0) - { - do{ + if ((vz != 0.0 && -z / vz >= 0) && x - xwidth - xshift < 0) { + do { i++; - old_z=z; - old_x=x; - old_y=y; - a=vz/vx; - b=z-a*x; + old_z = z; + old_x = x; + old_y = y; + a = vz / vx; + b = z - a * x; /*calculation of intersection with the parabola*/ - delta = sqrt(4*gamma1*(b-beta1)+a*a); - x1 = (a - delta)/(2*gamma1); - x2 = (a + delta)/(2*gamma1); - z1 = gamma1*x1*x1+beta1; - z2 = gamma1*x2*x2+beta1; + delta = sqrt (4 * gamma1 * (b - beta1) + a * a); + x1 = (a - delta) / (2 * gamma1); + x2 = (a + delta) / (2 * gamma1); + z1 = gamma1 * x1 * x1 + beta1; + z2 = gamma1 * x2 * x2 + beta1; /*choose the correct answer*/ - if(z1>z2){ - z=z1; - x=x1; - } - else{ - z=z2; - x=x2; + if (z1 > z2) { + z = z1; + x = x1; + } else { + z = z2; + x = x2; } /* absorbs the neutron if the difference between the 2 calculation methods is larger than 1% */ - if(fabs(z-a*x-b)>0.01){ - #pragma acc atomic - err = err +1; - ABSORB; + if (fabs (z - a * x - b) > 0.01) { + #pragma acc atomic + err = err + 1; + ABSORB; } - - + /* calculation of y*/ - y+=vy*(z-old_z)/vz; + y += vy * (z - old_z) / vz; /*reflection*/ - if((x-xshift)>0 && fabs(y)<=yheight){ - #pragma acc atomic + if ((x - xshift) > 0 && fabs (y) <= yheight) { + #pragma acc atomic nom = nom + 1; /* reflection angle in the xz plane */ - div = -atan(vx/vz); - angle = atan(1/(2*gamma1*x)); + div = -atan (vx / vz); + angle = atan (1 / (2 * gamma1 * x)); /* vx and vz calculation after reflection */ - v=sqrt(vx*vx+vz*vz); - vz = v*cos(2*angle+div); - vx = v*sin(2*angle+div); + v = sqrt (vx * vx + vz * vz); + vz = v * cos (2 * angle + div); + vx = v * sin (2 * angle + div); /*incidence angle in 3D*/ - ob = sqrt((old_x-x)*(old_x-x)+(old_z-z)*(old_z-z)); - ab = ob*cos(-div+angle); + ob = sqrt ((old_x - x) * (old_x - x) + (old_z - z) * (old_z - z)); + ab = ob * cos (-div + angle); /* printf("%e = %e * cos(%e)",ab,ob,div+angle); */ - xa = x+ab*sin(-angle); - za = z+ab*cos(-angle); - oa = sqrt((old_x-xa)*(old_x-xa)+(old_z-za)*(old_z-za)); - ob = sqrt((old_x-x)*(old_x-x)+(old_y-y)*(old_y-y)+(old_z-z)*(old_z-z)); - /* printf("\nob : %e / ab : %e\nO: %e / %f / %f\nA : %e / %f / %f\nB : %e / %f / %f\nAngle : %e rad / Div : %e rad\n",ob,ab,old_x,old_y,old_z,xa,old_y,za,x,y,z,angle,div); */ - - ab = sqrt((xa-x)*(xa-x)+(old_y-y)*(old_y-y)+(za-z)*(za-z)); - angle = acos((-ab*ab-ob*ob+oa*oa)/(2*ab*ob)); - - v=sqrt(vx*vx+vy*vy+vz*vz); - q = fabs(2*sin(angle)*v*V2Q); + xa = x + ab * sin (-angle); + za = z + ab * cos (-angle); + oa = sqrt ((old_x - xa) * (old_x - xa) + (old_z - za) * (old_z - za)); + ob = sqrt ((old_x - x) * (old_x - x) + (old_y - y) * (old_y - y) + (old_z - z) * (old_z - z)); + /* printf("\nob : %e / ab : %e\nO: %e / %f / %f\nA : %e / %f / %f\nB : %e / %f / %f\nAngle : %e rad / Div : %e + * rad\n",ob,ab,old_x,old_y,old_z,xa,old_y,za,x,y,z,angle,div); */ + + ab = sqrt ((xa - x) * (xa - x) + (old_y - y) * (old_y - y) + (za - z) * (za - z)); + angle = acos ((-ab * ab - ob * ob + oa * oa) / (2 * ab * ob)); + + v = sqrt (vx * vx + vy * vy + vz * vz); + q = fabs (2 * sin (angle) * v * V2Q); /* Reflectivity (see component Guide). */ - if (reflect && strlen(reflect) && strcmp(reflect, "NULL") && strcmp(reflect,"0")) - TableReflecFunc(q, &pTable, &B); + if (reflect && strlen (reflect) && strcmp (reflect, "NULL") && strcmp (reflect, "0")) + TableReflecFunc (q, &pTable, &B); else { - StdReflecFunc(q, par, &B); + StdReflecFunc (q, par, &B); } - if (B <= 0) { ABSORB; } - else p *= B; + if (B <= 0) { + ABSORB; + } else + p *= B; } - if(vz<0){ - #pragma acc atomic - vz_neg = vz_neg + 1; - ABSORB; + if (vz < 0) { + #pragma acc atomic + vz_neg = vz_neg + 1; + ABSORB; } - }while((x-xshift)>0 && fabs(y)<=yheight); - if (i<0) fprintf(stderr,"Mirror_Parabolic: %s: out mirror\n", NAME_CURRENT_COMP); - y=old_y; - x=old_x; - z=old_z; + } while ((x - xshift) > 0 && fabs (y) <= yheight); + if (i < 0) + fprintf (stderr, "Mirror_Parabolic: %s: out mirror\n", NAME_CURRENT_COMP); + y = old_y; + x = old_x; + z = old_z; SCATTER; - } - else{ + } else { ABSORB; } %} @@ -189,29 +189,29 @@ TRACE FINALLY %{ /* printf("\n %d neutrons were reflected on the component %s.\n",nom,NAME_CURRENT_COMP);*/ - if(err!=0||vz_neg!=0){ - fprintf(stderr,"Mirror_Parabolic: %s: %d lost neutrons for inadapted divergence\n" - "\t%d for vz <0 \n neutrons absorbed inside the component.\n", - NAME_CURRENT_COMP,err,vz_neg); + if (err != 0 || vz_neg != 0) { + fprintf (stderr, + "Mirror_Parabolic: %s: %d lost neutrons for inadapted divergence\n" + "\t%d for vz <0 \n neutrons absorbed inside the component.\n", + NAME_CURRENT_COMP, err, vz_neg); } %} MCDISPLAY %{ - double delta0,xi,xf,zi,zf; - - delta0 = xwidth/99; - xi = xwidth+xshift; - line (xi,-yheight,0, xi,yheight,0); - do - { - xf = xi - delta0; - zi = gamma1*xi*xi+beta1; - zf = gamma1*xf*xf+beta1; - line (xi,yheight,zi, xf,yheight,zf); - line (xi,-yheight,zi, xf,-yheight,zf); - line (xf,yheight,zf, xf,-yheight,zf); - xi = xf; - }while(xf>=xshift); + double delta0, xi, xf, zi, zf; + + delta0 = xwidth / 99; + xi = xwidth + xshift; + line (xi, -yheight, 0, xi, yheight, 0); + do { + xf = xi - delta0; + zi = gamma1 * xi * xi + beta1; + zf = gamma1 * xf * xf + beta1; + line (xi, yheight, zi, xf, yheight, zf); + line (xi, -yheight, zi, xf, -yheight, zf); + line (xf, yheight, zf, xf, -yheight, zf); + xi = xf; + } while (xf >= xshift); %} END diff --git a/mcstas-comps/contrib/Monochromator_2foc.comp b/mcstas-comps/contrib/Monochromator_2foc.comp index 1ca540532..f473e54a6 100644 --- a/mcstas-comps/contrib/Monochromator_2foc.comp +++ b/mcstas-comps/contrib/Monochromator_2foc.comp @@ -80,193 +80,210 @@ SETTING PARAMETERS (string reflect=0, zwidth=0.01, yheight=0.01, gap=0.0005, NH= /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -%include "read_table-lib" -#ifndef DIV_CUTOFF -#define DIV_CUTOFF 2 /* ~ 10^-5 cutoff. */ -#endif + %include "read_table-lib" + #ifndef DIV_CUTOFF + #define DIV_CUTOFF 2 /* ~ 10^-5 cutoff. */ + #endif %} DECLARE %{ -double mos_y; /* mosaic - in radians */ -double mos_z; -double mono_Q; -double SlabWidth; -double SlabHeight; -t_Table rTable; + double mos_y; /* mosaic - in radians */ + double mos_z; + double mono_Q; + double SlabWidth; + double SlabHeight; + t_Table rTable; %} INITIALIZE %{ -if (mosaic != 0) { + if (mosaic != 0) { mos_y = mosaic; - mos_z = mos_y; } - else { + mos_z = mos_y; + } else { mos_y = mosaich; - mos_z = mosaicv; } + mos_z = mosaicv; + } mono_Q = Q; - if (DM != 0) mono_Q = 2*PI/DM; - - if (mono_Q == 0) { fprintf(stderr,"Monochromator_2foc: %s: Error scattering vector Q = 0\n", NAME_CURRENT_COMP); exit(-1); } - if (r0 == 0) { fprintf(stderr,"Monochromator_2foc: %s: Error reflectivity r0 is null\n", NAME_CURRENT_COMP); exit(-1); } - if (NH*NV == 0) { fprintf(stderr,"Monochromator_2foc: %s: no slabs ??? (NH or NV=0)\n", NAME_CURRENT_COMP); exit(-1); } - - if (verbose) - { - printf("Monochromator_2foc: component %s Q=%.3g Angs-1 (DM=%.4g Angs)\n", NAME_CURRENT_COMP, mono_Q, 2*PI/mono_Q); - if (NH*NV == 1) printf(" flat.\n"); - else - { if (NH > 1) - { printf(" horizontal: %i blades", (int)NH); - if (RH != 0) printf(" focusing with RH=%.3g [m]", RH); - printf("\n"); + if (DM != 0) + mono_Q = 2 * PI / DM; + + if (mono_Q == 0) { + fprintf (stderr, "Monochromator_2foc: %s: Error scattering vector Q = 0\n", NAME_CURRENT_COMP); + exit (-1); + } + if (r0 == 0) { + fprintf (stderr, "Monochromator_2foc: %s: Error reflectivity r0 is null\n", NAME_CURRENT_COMP); + exit (-1); + } + if (NH * NV == 0) { + fprintf (stderr, "Monochromator_2foc: %s: no slabs ??? (NH or NV=0)\n", NAME_CURRENT_COMP); + exit (-1); + } + + if (verbose) { + printf ("Monochromator_2foc: component %s Q=%.3g Angs-1 (DM=%.4g Angs)\n", NAME_CURRENT_COMP, mono_Q, 2 * PI / mono_Q); + if (NH * NV == 1) + printf (" flat.\n"); + else { + if (NH > 1) { + printf (" horizontal: %i blades", (int)NH); + if (RH != 0) + printf (" focusing with RH=%.3g [m]", RH); + printf ("\n"); } - if (NV > 1) - { printf(" vertical: %i blades", (int)NV); - if (RV != 0) printf(" focusing with RV=%.3g [m]", RV); - printf("\n"); + if (NV > 1) { + printf (" vertical: %i blades", (int)NV); + if (RV != 0) + printf (" focusing with RV=%.3g [m]", RV); + printf ("\n"); } } } - if (reflect != NULL) - { - if (verbose) fprintf(stdout, "Monochromator_2foc: %s : Reflectivity data (k, R)\n", NAME_CURRENT_COMP); - Table_Read(&rTable, reflect, 1); /* read 1st block data from file into rTable */ - Table_Rebin(&rTable); /* rebin as evenly, increasing array */ - if (rTable.rows < 2) Table_Free(&rTable); - Table_Info(rTable); - } else rTable.data = NULL; - - if (width == 0) SlabWidth = zwidth; - else SlabWidth = (width+gap)/NH - gap; - if (height == 0) SlabHeight = yheight; - else SlabHeight = (height+gap)/NV - gap; + if (reflect != NULL) { + if (verbose) + fprintf (stdout, "Monochromator_2foc: %s : Reflectivity data (k, R)\n", NAME_CURRENT_COMP); + Table_Read (&rTable, reflect, 1); /* read 1st block data from file into rTable */ + Table_Rebin (&rTable); /* rebin as evenly, increasing array */ + if (rTable.rows < 2) + Table_Free (&rTable); + Table_Info (rTable); + } else + rTable.data = NULL; + + if (width == 0) + SlabWidth = zwidth; + else + SlabWidth = (width + gap) / NH - gap; + if (height == 0) + SlabHeight = yheight; + else + SlabHeight = (height + gap) / NV - gap; %} TRACE %{ double dt; - if(vx != 0.0 && (dt = -x/vx) >= 0.0) - { - double zmin,zmax, ymin,ymax, zp,yp, y1,z1,t1; + if (vx != 0.0 && (dt = -x / vx) >= 0.0) { + double zmin, zmax, ymin, ymax, zp, yp, y1, z1, t1; - zmax = ((NH*(SlabWidth+gap))-gap)/2; - zmin = -1*zmax; - ymax = ((NV*(SlabHeight+gap))-gap)/2; - ymin = -1*ymax; - y1 = y + vy*dt; /* Propagate to crystal plane */ - z1 = z + vz*dt; + zmax = ((NH * (SlabWidth + gap)) - gap) / 2; + zmin = -1 * zmax; + ymax = ((NV * (SlabHeight + gap)) - gap) / 2; + ymin = -1 * ymax; + y1 = y + vy * dt; /* Propagate to crystal plane */ + z1 = z + vz * dt; t1 = t + dt; - zp = fmod ( (z1-zmin),(SlabWidth+gap) ); - yp = fmod ( (y1-ymin),(SlabHeight+gap) ); - + zp = fmod ((z1 - zmin), (SlabWidth + gap)); + yp = fmod ((y1 - ymin), (SlabHeight + gap)); /* hit a slab or a gap ? */ - if (z1>zmin && z1ymin && y1 zmin && z1 < zmax && y1 > ymin && y1 < ymax && zp < SlabWidth && yp < SlabHeight) { + double row, col, sna, snb, csa, csb, vxp, vyp, vzp; double v, theta0, theta, tmp3; - double tilth,tiltv; /* used to calculate tilt angle of slab */ - - col = ceil ( (z1-zmin)/(SlabWidth+gap)); /* which slab hit ? */ - row = ceil ( (y1-ymin)/(SlabHeight+gap)); - if (RH != 0) tilth = asin((col-(NH+1)/2)*(SlabWidth+gap)/RH); - else tilth=0; - if (RV != 0) tiltv = -asin((row-(NV+1)/2)*(SlabHeight+gap)/RV); - else tiltv=0; + double tilth, tiltv; /* used to calculate tilt angle of slab */ + + col = ceil ((z1 - zmin) / (SlabWidth + gap)); /* which slab hit ? */ + row = ceil ((y1 - ymin) / (SlabHeight + gap)); + if (RH != 0) + tilth = asin ((col - (NH + 1) / 2) * (SlabWidth + gap) / RH); + else + tilth = 0; + if (RV != 0) + tiltv = -asin ((row - (NV + 1) / 2) * (SlabHeight + gap) / RV); + else + tiltv = 0; /* rotate with tilth and tiltv */ - sna = sin(tilth); - snb = sin(tiltv); - csa = cos(tilth); - csb = cos(tiltv); - vxp = vx*csa*csb+vy*snb-vz*sna*csb; - vyp = -vx*csa*snb+vy*csb+vz*sna*snb; - vzp = vx*sna+vz*csa; + sna = sin (tilth); + snb = sin (tiltv); + csa = cos (tilth); + csb = cos (tiltv); + vxp = vx * csa * csb + vy * snb - vz * sna * csb; + vyp = -vx * csa * snb + vy * csb + vz * sna * snb; + vzp = vx * sna + vz * csa; /* First: scattering in plane */ /* theta0 = atan2(vx,vz); neutron angle to slab Risoe version */ - v = sqrt(vxp*vxp+vyp*vyp+vzp*vzp); - theta0 = asin(vxp/v); /* correct neutron angle to slab */ + v = sqrt (vxp * vxp + vyp * vyp + vzp * vzp); + theta0 = asin (vxp / v); /* correct neutron angle to slab */ - theta = asin(Q2V*mono_Q/(2.0*v)); /* Bragg's law */ + theta = asin (Q2V * mono_Q / (2.0 * v)); /* Bragg's law */ if (theta0 < 0) - theta = -theta; - tmp3 = (theta-theta0)/(MIN2RAD*mos_y); - if (tmp3 < DIV_CUTOFF) - { + theta = -theta; + tmp3 = (theta - theta0) / (MIN2RAD * mos_y); + if (tmp3 < DIV_CUTOFF) { double my_r0, k; - double dphi,tmp1,tmp2,tmp4,vratio,phi,cs,sn; - - k = V2K*v; - -#ifndef OPENACC - if (rTable.data != NULL) - { - my_r0 = r0*Table_Value(rTable, k, 1); /* 2nd column */ - } - else -#endif - my_r0 = r0; - - if (my_r0 >= 1) - { -#ifndef OPENACC - if (verbose) fprintf(stdout, "Warning: Monochromator_2foc: %s: lowered reflectivity from %f to 0.99 (k=%f)\n", - NAME_CURRENT_COMP, my_r0, k); -#endif - my_r0=0.99; + double dphi, tmp1, tmp2, tmp4, vratio, phi, cs, sn; + + k = V2K * v; + + #ifndef OPENACC + if (rTable.data != NULL) { + my_r0 = r0 * Table_Value (rTable, k, 1); /* 2nd column */ + } else + #endif + my_r0 = r0; + + if (my_r0 >= 1) { + #ifndef OPENACC + if (verbose) + fprintf (stdout, "Warning: Monochromator_2foc: %s: lowered reflectivity from %f to 0.99 (k=%f)\n", NAME_CURRENT_COMP, my_r0, k); + #endif + my_r0 = 0.99; } - if (my_r0 < 0) - { -#ifndef OPENACC - if (verbose) fprintf(stdout, "Warning: Monochromator_2foc: %s: raised reflectivity from %f to 0 (k=%f)\n", - NAME_CURRENT_COMP, my_r0, k); -#endif - my_r0=0; + if (my_r0 < 0) { + #ifndef OPENACC + if (verbose) + fprintf (stdout, "Warning: Monochromator_2foc: %s: raised reflectivity from %f to 0 (k=%f)\n", NAME_CURRENT_COMP, my_r0, k); + #endif + my_r0 = 0; } x = 0.0; y = y1; z = z1; t = t1; - + /* reflectivity */ - t1 = fabs(my_r0)*exp(-tmp3*tmp3*4*log(2)); - if (t1 <= 0) ABSORB; - if (t1 > 1) t1 = 1; + t1 = fabs (my_r0) * exp (-tmp3 * tmp3 * 4 * log (2)); + if (t1 <= 0) + ABSORB; + if (t1 > 1) + t1 = 1; p *= t1; /* Use mosaics */ - - tmp1 = 2*theta; - cs = cos(tmp1); - sn = sin(tmp1); - tmp2 = cs*vxp - sn*vzp; + + tmp1 = 2 * theta; + cs = cos (tmp1); + sn = sin (tmp1); + tmp2 = cs * vxp - sn * vzp; vyp = vyp; /* vz = cs*vz + sn*vx; diese Zeile wurde durch die folgende ersetzt */ - tmp4 = vyp/vzp; /* korrigiert den schr�en Einfall aufs Pl�tchen */ - vzp = cs*(-vyp*sin(tmp4)+vzp*cos(tmp4)) + sn*vxp; + tmp4 = vyp / vzp; /* korrigiert den schr�en Einfall aufs Pl�tchen */ + vzp = cs * (-vyp * sin (tmp4) + vzp * cos (tmp4)) + sn * vxp; vxp = tmp2; /* Second: scatering out of plane. Approximation is that Debye-Scherrer cone is a plane */ - phi = atan2(vyp,vzp); /* out-of plane angle */ - dphi = (MIN2RAD*mos_z)/(2*sqrt(2*log(2)))*randnorm(); /* MC choice: */ + phi = atan2 (vyp, vzp); /* out-of plane angle */ + dphi = (MIN2RAD * mos_z) / (2 * sqrt (2 * log (2))) * randnorm (); /* MC choice: */ /* Vertical angle of the crystallite */ - vyp = vzp*tan(phi+2*dphi*sin(theta)); - vratio = v/sqrt(vxp*vxp+vyp*vyp+vzp*vzp); - vzp = vzp*vratio; - vyp = vyp*vratio; /* Renormalize v */ - vxp = vxp*vratio; + vyp = vzp * tan (phi + 2 * dphi * sin (theta)); + vratio = v / sqrt (vxp * vxp + vyp * vyp + vzp * vzp); + vzp = vzp * vratio; + vyp = vyp * vratio; /* Renormalize v */ + vxp = vxp * vratio; /* rotate v coords back */ - vx = vxp*csb*csa-vyp*snb*csa+vzp*sna; - vy = vxp*snb+vyp*csb; - vz = -vxp*csb*sna+vyp*snb*sna+vzp*csa; + vx = vxp * csb * csa - vyp * snb * csa + vzp * sna; + vy = vxp * snb + vyp * csb; + vz = -vxp * csb * sna + vyp * snb * sna + vzp * csa; /* v=sqrt(vx*vx+vy*vy+vz*vz); */ SCATTER; } /* end if Bragg ok */ @@ -278,36 +295,36 @@ MCDISPLAY %{ int ih; - - for(ih = 0; ih < NH; ih++) - { + for (ih = 0; ih < NH; ih++) { int iv; - for(iv = 0; iv < NV; iv++) - { - double zmin,zmax,ymin,ymax; + for (iv = 0; iv < NV; iv++) { + double zmin, zmax, ymin, ymax; double xt, xt1, yt, yt1; - zmin = (SlabWidth+gap)*(ih-NH/2.0)+gap/2; - zmax = zmin+SlabWidth; - ymin = (SlabHeight+gap)*(iv-NV/2.0)+gap/2; - ymax = ymin+SlabHeight; - - if (RH) - { xt = zmin*zmin/RH; - xt1 = zmax*zmax/RH; } - else { xt = 0; xt1 = 0; } - - if (RV) - { yt = ymin*ymin/RV; - yt1 = ymax*ymax/RV; } - else { yt = 0; yt1 = 0; } - multiline(5, xt+yt, (double)ymin, (double)zmin, - xt+yt1, (double)ymax, (double)zmin, - xt1+yt1, (double)ymax, (double)zmax, - xt1+yt, (double)ymin, (double)zmax, - xt+yt, (double)ymin, (double)zmin); - } - } + zmin = (SlabWidth + gap) * (ih - NH / 2.0) + gap / 2; + zmax = zmin + SlabWidth; + ymin = (SlabHeight + gap) * (iv - NV / 2.0) + gap / 2; + ymax = ymin + SlabHeight; + + if (RH) { + xt = zmin * zmin / RH; + xt1 = zmax * zmax / RH; + } else { + xt = 0; + xt1 = 0; + } + + if (RV) { + yt = ymin * ymin / RV; + yt1 = ymax * ymax / RV; + } else { + yt = 0; + yt1 = 0; + } + multiline (5, xt + yt, (double)ymin, (double)zmin, xt + yt1, (double)ymax, (double)zmin, xt1 + yt1, (double)ymax, (double)zmax, xt1 + yt, (double)ymin, + (double)zmax, xt + yt, (double)ymin, (double)zmin); + } + } %} END diff --git a/mcstas-comps/contrib/Monochromator_bent.comp b/mcstas-comps/contrib/Monochromator_bent.comp index 3cc6f41bd..db41e6c55 100755 --- a/mcstas-comps/contrib/Monochromator_bent.comp +++ b/mcstas-comps/contrib/Monochromator_bent.comp @@ -1,1620 +1,1670 @@ -/******************************************************************************* -* -* McStas, neutron ray-tracing package -* Copyright 1997-2002, All rights reserved -* Risoe National Laboratory, Roskilde, Denmark -* Institut Laue Langevin, Grenoble, France -* -* Component: Monochromator_bent -* -* %I -* Written by: Daniel Lomholt Christensen with help from Jan Šaroun -* Date: 24 August 2023 -* Origin: ILL/NBI -* -* A bent crystal monochromator. Based on the model implemented by Jan Šaroun in NIMA 529 (2004) pp 162-165. -* Mosacity and bending radius can be set. -* -* %D -* This monochromator is an array of crystals, that can be bent. -* The crystals are placed by the user in the x,y,z pos and rot parameters. -* The crystal is bent, so that it follows a curve on a cylinder of radius_x. -* The monochromator lies along the z plane, so when a diffraction angle of theta -* is desired, it should just be inserted in the ROTATED parameter around -* the y-axis. -* Instruments that showcase the use of this component is the -* "Test_monochromator_bent.instr", and the "ILL_SALSA.instr" under the examples folder. -* SALSA showcases its complex use in a real instrument, while Test_monochromator_bent -* makes a simple show of its capabilities. -* -* -* %Parameters -* INPUT PARAMETERS: -* zwidth: [m] Width of each crystal without bending. -* yheight: [m] Height of each crystal without bending. -* xthickness: [m] Thickness of each crystal without bending. -* radius_x: [m] Radius of the circle the monochromator bends on in the plane. Can be negative. -* radius_y: [m] Radius of the (very large) circle the monochromator bends on as a side effect of the horizontal bending. The code assumes that it is so small that it does not affect the points of intersection appreciatively of the crystal. -* plane_of_reflection: ["Si400"] The plane of reflection from the material. The list of possible reflections can be seen in the source code. -* angle_to_cut_horizontal: [degrees] Angle between cut and normal of crystal slab, horizontally -* mosaicity: [arcmin] Gaussian mosaicity of the crystal. Always the horizontal mosaicity -* mosaic_anisotropy: [1] Anisotropy of the mosaicity, changes vertical mosaicity to be mosaic_anisotropy*mosaicity -* n_crystals: [#] Number of crystals in your array. -* domainthickness: [mu-m] Thickness of the crystal domains. -* temperature: [K]Temperature of the monochromator in Kelvin. -* optimize: [ ] Flag to tell if the component should optimize for reflections or not. -* x_pos: [vector] x-Position of each crystal -* y_pos: [vector] y-Position of each crystal -* z_pos: [vector] z-Position of each crystal -* x_rot: [vector] Rotation around x-axis for each crystal -* y_rot: [vector] Rotation around y-axis for each crystal -* z_rot: [vector] Rotation around z-axis for each crystal NOTE: Rotations happen around x, then y, then z. -* verbose: [ ] Verbosity of the monochromator. Used for debugging. -* draw_as_rectangles: [ ] Draw the monochromators as boxes. DOES NOT WORK WHEN USING _rot parameters. -* -* %L -* Jan Šaroun NIM A Volume 529, Issue 1-3 (2004), pp162-165 -* -* %E -*******************************************************************************/ -DEFINE COMPONENT Monochromator_bent -SETTING PARAMETERS (zwidth=0.2, - yheight=0.1, - xthickness=0.0005, - radius_x=2, - radius_y=0, - string plane_of_reflection="Si400", - angle_to_cut_horizontal=0, - mosaicity=30, - mosaic_anisotropy=1, - int n_crystals=1, - domainthickness=10, - temperature=300, - int optimize=0, - vector x_pos=NULL, - vector y_pos=NULL, - vector z_pos=NULL, - vector x_rot=NULL, - vector y_rot=NULL, - vector z_rot=NULL, - int verbose=0, - int draw_as_rectangles=0) -// Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) -NOACC -// The component is currently "NOACC" only, there are thread race-conditions on GPU - -SHARE -%{ - #include - - /////////////////////////////////////////////////////////////////////////// - /////////////// Structs for the component - /////////////////////////////////////////////////////////////////////////// - - struct Monochromator_values{ - double length, height, thickness; - double mosaicity_horizontal, mosaicity_vertical; - int type; - double radius_horizontal; - double radius_vertical; - double radius_outer; - double radius_inner; - double Debye_Waller_factor; - double lattice_spacing; - double Maier_Leibnitz_reflectivity; - double poisson_ratio; - double bound_atom_scattering_cross_section; - double absorption_for_1AA_Neutrons; - double incoherent_scattering_cross_section; - double volume; - double Constant_from_Freund_paper; - double debye_temperature; - double atomic_number; - double temperature_mono; - double B0; - double BT; - double single_phonon_absorption; - double multiple_phonon_absorption; - double nuclear_capture_absorption; - double total_absorption; - double tau[3]; - double perp_to_tau[3]; - double lattice_spacing_gradient_field[3][3]; - double gradient_of_bragg_angle; - double domain_thickness; - double max_angle; - double min_angle; - double angle_range; - double rotation_matrices[3][3]; // pointer to rotation matrices - double neg_rotation_matrix[3][3]; // pointer to rotation matrices - double x; - double y; - double z; - double bounding_box_thickness; // the xthickness plus the arrowheight (the saggita) - }; - - struct Monochromator_array{ - struct Monochromator_values* crystal; - int number_of_crystals; - int verbosity; - }; - - struct neutron_values { - // Statically allocate vectors that are always 3 - double ki[3]; // Incoming wavevector - double kf[3]; // outgoig wavevector - double r[3]; - double v[3]; // velocity of neutron - double tau[3]; //Reciprocal lattice vector - double ki_size; // size of incoming wavevector - double v_size; // speed - double tau_size; // size of reciprocal lattice vector - double kf_size; // size of outgoing wavevector - double* vert_angle; // Angle of deviation by the mosaic crystal vertically - double* horiz_angle; // Angle of deviation by the mosaic crystal in x-z plane - double* beta; // Gradient of deviation from bragg condition - double* eps_zero; // Angular deviation from bragg angle - double absorption; // Absorption factor - double path; // Length of the path the neutron follows - double wavelength; // De Broglie wavelength of neutron - double kinematic_reflectivity; // The Q value from the paper this code is based on. - double* path_length; // The time spent in crystals, to add to path for attenuation - double* entry_time; // Time from start of crystal, to entrance of each lamella - double* exit_time; // Time from start of crystal, to exit of each lamella - double* probabilities; // Probability of reflection in each lamella - double* accu_probs; // Accumulating probability in each lamella - double TOR; // The time in s from crystal edge to reflection - int chosen_crystal; // Which crystal the neutron reflects from in - int transmit_neutron; - int direction; // Direction of neutron - int n; // Number of crystals in the monochromator - int reflections; // How many reflections has the neutron performed - int intersections; // How many crystals the neutron has intersected - int* intersection_list; // List of intersected crystals, sorted by intersection time. - }; - - enum crystal_type {flat, bent, mosaic, bent_mosaic}; - - //////////////////////////////////////////////////////////////////////////// - /////////////// Mathematical functions for the component - //////////////////////////////////////////////////////////////////////////// - - double sign(double x){ - if (x >= 0) return 1; - return -1; - } - - double square(double x){ - return x*x; - } - // Function to generate numbers in a uniform distribution - double random_normal_distribution(double* sigma, _class_particle* _particle){ - double u1, u2; - u1 = rand01(); - u2 = rand01(); - double r = sqrt(-2 * log(u1)); - double theta = 2 * M_PI * u2; - return *sigma * r * cos(theta); - } - - // The following two function returns, respectively, - // the Gaussian cumulative distribution function, - // And the inverse gaussian cumulative distribution function. - double normalCDF(double x, double sigma) { - return 0.5 * (1 + erf( x * M_SQRT1_2)); - } - // Inspired by https://gist.github.com/kmpm/1211922/6b7fcd0155b23c3dc71e6f4969f2c48785371292 - double inverseNormalCDF(double p, double sigma){ - if (p <= 0 || p >= 1) return sign(p)*6; - - double mu = 0; - double r, val; - double q = p - 0.5; - - if (fabs(q) <= .425) { - r = .180625 - q * q; - val = - q * (((((((r * 2509.0809287301226727 + - 33430.575583588128105) * r + 67265.770927008700853) * r + - 45921.953931549871457) * r + 13731.693765509461125) * r + - 1971.5909503065514427) * r + 133.14166789178437745) * r + - 3.387132872796366608) - / (((((((r * 5226.495278852854561 + - 28729.085735721942674) * r + 39307.89580009271061) * r + - 21213.794301586595867) * r + 5394.1960214247511077) * r + - 687.1870074920579083) * r + 42.313330701600911252) * r + 1); - } - else { - if (q > 0) { - r = 1 - p; - } - else { - r = p; - } - - r = sqrt(-log(r)); - - if (r <= 5) - { - r += -1.6; - val = (((((((r * 7.7454501427834140764e-4 + - .0227238449892691845833) * r + .24178072517745061177) * - r + 1.27045825245236838258) * r + - 3.64784832476320460504) * r + 5.7694972214606914055) * - r + 4.6303378461565452959) * r + - 1.42343711074968357734) - / (((((((r * - 1.05075007164441684324e-9 + 5.475938084995344946e-4) * - r + .0151986665636164571966) * r + - .14810397642748007459) * r + .68976733498510000455) * - r + 1.6763848301838038494) * r + - 2.05319162663775882187) * r + 1); - } - else { /* very close to 0 or 1 */ - r += -5; - val = (((((((r * 2.01033439929228813265e-7 + - 2.71155556874348757815e-5) * r + - .0012426609473880784386) * r + .026532189526576123093) * - r + .29656057182850489123) * r + - 1.7848265399172913358) * r + 5.4637849111641143699) * - r + 6.6579046435011037772) - / (((((((r * - 2.04426310338993978564e-15 + 1.4215117583164458887e-7) * - r + 1.8463183175100546818e-5) * r + - 7.868691311456132591e-4) * r + .0148753612908506148525) - * r + .13692988092273580531) * r + - .59983220655588793769) * r + 1); - } - - if (q < 0.0) { - val = -val; - } - } - - return mu + sigma * val; - } - //////////////////////////////////////////////////////////////////////////// - // End of mathematical functions - //////////////////////////////////////////////////////////////////////////// - - //========================================================================== - //======== Functions for choosing the right crystal for reflections ======== - //========================================================================== - enum crystal_plane {Cu111, Cu200, Cu220, Cu311, Cu400, Cu331, Cu420, Cu440, Ge111, Ge220, Ge311, - Ge400, Ge331, Ge422, Ge511, Ge533, Ge711, Ge551, Si111, Si220, Si311, Si400, Si331, - Si422, Si333, Si511, Si440, Si711, Si551, Be10, Be100, Be102, Be103, Be110, Be112, Be200, - Be00_2, Be10_1, PG00_2,PG00_4,PG00_6, Fe110, HS111,HS222,HS111star,Di111,Di220, Di311, Di400, - Di331, Di422, Di333, Di511, Di440}; - - // An array containing all the possible strings that will be accepted if given as an - // argument to the parameter plane_of_reflection - const char* crystal_planeStrings[] = { - "Cu111", "Cu200", "Cu220", "Cu311", "Cu400", "Cu331", "Cu420", "Cu440", "Ge111", - "Ge220", "Ge311", "Ge400", "Ge331", "Ge422", "Ge511", "Ge533", "Ge711", "Ge551", - "Si111", "Si220", "Si311", "Si400", "Si331", "Si422", "Si333", "Si511", "Si440", - "Si711", "Si551"," Be10", "Be100", "Be102", "Be103", "Be110", "Be112", "Be200", - "Be00_2", "Be10_1", "PG00_2","PG00_4","PG00_6", "Fe110", "HS111","HS222","HS111star", - "Di111","Di220", "Di311", "Di400", "Di331", "Di422", "Di333", "Di511", "Di440"}; - - // Function to convert a string to an enum value - enum crystal_plane stringToEnum(const char* plane) { - for (int i = 0; i < sizeof(crystal_planeStrings) / sizeof(crystal_planeStrings[0]); ++i) { - if (strcmp(plane, crystal_planeStrings[i]) == 0) { - return (enum crystal_plane)i; - } - } - return 0; - } - /* TITLE Crystal table for perfect crystal bent monochromator - Table copied from SIMRES, current url: https://github.com/saroun/simres - Contents: dhkl, QML,sigmab,sigmaa,V0,A,thetaD,C2,poi - dhkl ... Lattice spacing of crystal plane. - QML = 4*PI*(F*dhkl/V0)**2 [ A^-1 cm^-1] - sigmab ... bound-atom scattering cross-section [barn] - sigmaa ... absorption for 1A neutrons [barn*A^-1] - sigmai ... incoherent scattering cross-section [barn] - V0 .... volume [A^3]/atom - A .... atomic number - thetaD .... Debye temperature (K) - C2 .... constant from the Freund's paper [A^-2 eV^-1] - poi .... Poisson elastic constant */ - - - double crystal_table[56][10] = {{ 2.087063, 0.23391E+00 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 1.80745 , 0.17544E+00 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 1.27806 , 0.87718E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 1.089933, 0.63795E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 0.903725, 0.43859E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 0.829315, 0.36934E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 0.808316, 0.35087E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 0.63903 , 0.21930E-01 ,7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00}, - { 3.26665 , 0.87700E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15450E+00}, - { 2.00041 , 0.65760E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.30000E+00}, - { 1.70595 , 0.23920E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15430E+00}, - { 1.41450 , 0.32880E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27300E+00}, - { 1.29803 , 0.13850E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15430E+00}, - { 1.15493 , 0.21925E-01 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00}, - { 1.08888 , 0.97400E-02 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00}, - { 0.86284 , 0.61200E-02 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00}, - { 0.79228 , 0.51588E-02 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00}, - { 0.79228 , 0.51600E-02 ,8.42 , 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00}, - { 3.13536 , 0.25970E-01 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.18080E+00}, - { 1.92001 , 0.19480E-01 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.30000E+00}, - { 1.63739 , 0.70800E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 1.35765 , 0.97400E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 1.24587 , 0.41000E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.18080E+00}, - { 1.10852 , 0.64930E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 1.04512 , 0.28900E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 1.04512 , 0.28900E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 0.96000 , 0.48700E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 0.76044 , 0.15277E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 0.76044 , 0.15277E-02 ,2.18 , 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00}, - { 1.97956 , 0.11361 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00}, - { 1.97956 , 0.11361 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 1.32857 , 0.05117 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 1.02290 , 0.091 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 1.14290 , 0.15147 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 0.96363 , 0.10768 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 0.98978 , 0.0284 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00}, - { 1.79215 , 0.37245 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00}, - { 1.73285 , 0.26116 ,7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00}, - { 3.35500 , 0.79500E+00 ,5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00}, - { 1.67750 , 0.18000E+00 ,5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00}, - { 1.11830 , 0.08833E+00 ,5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00}, - { 2.02660 , 0.34031E+00 ,11.43, 2.53, 0.4 , 11.75 , 55.85, 411, 10.67 , 0.30000E+00}, - { 3.43500 , 0.11020E+00 ,1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00 , 0.30000E+00}, - { 1.71750 , 0.13130E+00 ,1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00 , 0.30000E+00}, - { 3.43500 , 0.55100E-01 ,1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00 , 0.30000E+00}, - { 2.05929 , 0.36606 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 1.26105 , 0.27455 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 1.07543 , 0.09984 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.89170 , 0.13727 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.81828 , 0.0578 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.72807 , 0.09152 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.68643 , 0.04067 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.68643 , 0.04067 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.63053 , 0.06864 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00}, - { 0.63053 , 0.06864 ,5.55449 ,0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00} - }; - /////////////////////////////////////////////////////////////////////////// - // End of functions for choosing crystal reflections - /////////////////////////////////////////////////////////////////////////// - - /////////////////////////////////////////////////////////////////////////// - /////////////// Testing function - /////////////////////////////////////////////////////////////////////////// - void print_neutron_state(struct neutron_values* neutron){ - printf("Neutron state:\nki %g, %g, %g\ntau %g, %g, %g\nkf %g, %g, %g\nv %g, %g, %g\nr %g, %g, %g\nki size %g, tau size %g, kf size %g, v size %g\n\n", - neutron->ki[0], neutron->ki[1], neutron->ki[2], - neutron->tau[0], neutron->tau[1], neutron->tau[2], - neutron->kf[0], neutron->kf[1], neutron->kf[2], - neutron->v[0], neutron->v[1], neutron->v[2], - neutron->r[0], neutron->r[1], neutron->r[2], - neutron->ki_size, neutron->tau_size, neutron->kf_size, neutron->v_size - ); - } - - /////////////////////////////////////////////////////////////////////////// - /////////////// Calculations for absorption factor - /////////////// Based on the cross sections from - /////////////// A. K. Freund in Nuclear Instruments and Methods 213 (1983) 495-501 - /////////////////////////////////////////////////////////////////////////// - - // Integral needed for debye factor - - double calculate_phi_integral(double x){ - // Asymptotic approximation - if (x > 5) return PI * PI / 6 - exp(-x)/(x+1); - // Integate with Simpson/3. I dont know what this means - double z = 1 + x/(exp(x)-1); - double dx = x/100; - double ksi; - for (int i = 2; i <= 100; i++) { - ksi = (i-1)*dx; - switch (i%2){ - case 1: - z = z + 4 * ksi/(exp(ksi)-1); - break; - case 0: - z = z + 2 * ksi/(exp(ksi)-1); - break; - } - } - return z*dx/3; - } - - /////////////////////////////////////////////////////////////////////////// - /////////////// Function for checking if the neutron is inside the - /////////////// monochromator - /////////////////////////////////////////////////////////////////////////// - - int neutron_is_inside_crystal(double* x, double* y, double* z, - struct Monochromator_values* mono){ - // Check that r, theta and h are within parameters - double num_sig = 1e-6; - double r = sqrt(*x* *x + *z* *z ); - if (r < mono->radius_inner - num_sig || r > mono->radius_outer + num_sig) { - return 0;} - double theta = atan2(*z, *x); - //TODO: This arctan2 call is what makes the component alot slower. - // SOURCE: https://math.stackexchange.com/questions/1098487/atan2-faster-approximation - // It mostly works but fails often. Could be implemented if necessary in the future. - // double a = min(fabs(*z), fabs(*x)) / max(fabs(*z), fabs(*x)); - // double s = a * a; - // double test = ((-0.0464964749 * s + 0.15931422) * s - 0.327622764) * s * a + a; - // if (fabs(*z) > fabs(a)) test = 1.57079637 - test; - // if (*x < 0) test = 3.14159274 - test; - // if (*z < 0) test = -test; - if (theta < 0 && mono->radius_horizontal>0) theta = 2*PI + theta; - if (theta < mono->min_angle - num_sig || theta > mono->max_angle + num_sig) { - return 0;} - if (*y< - mono->height/2 - num_sig|| *y > mono->height/2 + num_sig) { - return 0;} - return 1; - } - - /////////////////////////////////////////////////////////////////////////// - // Function that sorts which times are the two lowest for a single crystal - /////////////////////////////////////////////////////////////////////////// - void sort_times(double* t1, double* t2, double* new_t){ - // NOTE: This algorithm breaks down if an intersection - // is at exactly -1 second away. - // Make t1r[0] + neutron->v[0]* *new_t; - y = neutron->r[1] + neutron->v[1]* *new_t; - z = neutron->r[2] + neutron->v[2]* *new_t; - if (neutron_is_inside_crystal(&x, &y, &z, mono)){ - sort_times(t1, t2, new_t); - } - } - - //////////////////////////////////////////////////////////////////////////// - /////////////// Function for finding intersection times for a single crystal - //////////////////////////////////////////////////////////////////////////// - int cylinder_cut_out_intersect(double *t1, double *t2, - struct neutron_values* neutron, - struct Monochromator_values* mono){ - // TODO: Add reference to our paper for a visualisation of the geometry. - // The equations for this code are derived from the equation of the circle, - // equations for the neutron line, and the coordinates with cos and sin. - // This algorithm finds the two lowest values of time, - // and sets those as t1min_angle)*neutron->r[0] - neutron->r[2])/ - (neutron->v[2] - tan(mono->min_angle)* neutron->v[0]); - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - temp_t = (tan(mono->max_angle)*neutron->r[0] - neutron->r[2])/ - (neutron->v[2] - tan(mono->max_angle)* neutron->v[0]); - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - // Find intersections on the circular part of the crystal - double term1, term2, divisor; - term1 = mono->radius_inner*mono->radius_inner - - neutron->r[0]*neutron->r[0] - - neutron->r[2]*neutron->r[2]; - term2 = neutron->r[0]*neutron->v[0] + neutron->r[2]*neutron->v[2]; - divisor = neutron->v[0]*neutron->v[0] + neutron->v[2]*neutron->v[2]; - term1 = term1/divisor + square(term2/divisor); - if ( term1>0){ - term2 = neutron->r[0]*neutron->v[0] + neutron->r[2]*neutron->v[2]; - - temp_t = sqrt(term1)-term2/divisor; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - temp_t = -sqrt(term1)-term2/divisor; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - } - term1 = mono->radius_outer * mono->radius_outer - - neutron->r[0] * neutron->r[0] - - neutron->r[2] * neutron->r[2]; - term2 = neutron->r[0] * neutron->v[0] + neutron->r[2] * neutron->v[2]; - divisor = neutron->v[0] * neutron->v[0] + neutron->v[2] * neutron->v[2]; - term1 = term1/divisor + square(term2/divisor); - if ( term1>0){ - term2 = neutron->r[0]*neutron->v[0] + neutron->r[2]*neutron->v[2]; - - temp_t = sqrt(term1)-term2/divisor; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - temp_t = -sqrt(term1)-term2/divisor; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - - } - - // Find intersections with the flat top and bottom planes. - temp_t = (mono->height-neutron->r[1])/ neutron->v[1]; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - temp_t = (-mono->height-neutron->r[1])/ neutron->v[1]; - check_intersection_and_update_times(t1,t2,&temp_t, neutron, mono); - if (*t1>0) return 2; - if (*t2>0) return 1; - return 0; - - } - /////////////////////////////////////////////////////////////////////////// - // Function for transforming coordinates into local crystal coordinates. - // Difference between rotate point and coordinate transformation - // is that the one only acts on a point, and the other on a neutron - /////////////////////////////////////////////////////////////////////////// - - void Coordinate_transformation(struct neutron_values* neutron, - struct Monochromator_values* mono){ - // Now rotate the neutron, in the crystal coordinate system - // such that the flat of the crystal is aligned with the z-axis. - // Rotations are around first x then y then z. - double new_v[3] = {0,0,0}; - double new_r[3] = {0,0,0}; - // First translate, then rotate the neutron - double neutron_r[3] = {neutron->r[0] - mono->x, - neutron->r[1] - mono->y, - neutron->r[2] - mono->z}; - for (int i = 0; i<3; i++){ - for (int j = 0; j<3; j++){ - new_r[i] += mono->rotation_matrices[i][j]*neutron_r[j]; - new_v[i] += mono->rotation_matrices[i][j]*neutron->v[j]; - } - } - // Set the neutrons values to be these new ones - // and update the wavevector - for (int i =0; i<3; i++){ - neutron->r[i] = new_r[i]; - neutron->v[i] = new_v[i]; - neutron->ki[i] = neutron->v[i]*V2K; - } - } - //////////////////////////////////////////////////////////////////////////// - // Functions for mcdisplay. It rotates, then moves the crystals - //////////////////////////////////////////////////////////////////////////// - - void rotate_point(double *point, - struct Monochromator_values *mono){ - double new_point[3]={0,0,0}; - // In order to not get the rotation matrix anew for each point, - // define it here and since this is a passive rotation of the crystal - // use the transposed matrix. - ; - double transp_mat[3][3]; - rot_transpose(mono->rotation_matrices,transp_mat); - for (int i = 0; i<3; i++){ - for (int j = 0; j<3; j++){ - new_point[i] += transp_mat[i][j]*point[j]; - // if (mono->verbosity){ - // printf("transp_mat[%d,%d]=%g\n", i,j,transp_mat[i][j]);} - } - } - point[0] = new_point[0] + mono->x; - point[1] = new_point[1] + mono->y; - point[2] = new_point[2] + mono->z; - } - - void rotate_all_points(double* x1, double* x2, - double* x3, double* x4, - double* y1, double* y2, - double* z1, double* z2, - double* z3, double* z4, - double p[][3], - struct Monochromator_values *mono){ - // First define the points of the first box - p[0][0] = *x1; p[0][1]=*y1; p[0][2]=*z1; - p[1][0] = *x1; p[1][1]=*y2; p[1][2]=*z1; - p[2][0] = *x2; p[2][1]=*y1; p[2][2]=*z2; - p[3][0] = *x2; p[3][1]=*y2; p[3][2]=*z2; - // // Now define the points of the second box - p[4][0] = *x3; p[4][1]=*y1; p[4][2]=*z3; - p[5][0] = *x3; p[5][1]=*y2; p[5][2]=*z3; - p[6][0] = *x4; p[6][1]=*y1; p[6][2]=*z4; - p[7][0] = *x4; p[7][1]=*y2; p[7][2]=*z4; - // Now Rotate all the points and perform their translation - for (int i = 0; i<8; i++){ - rotate_point(p[i], mono); - } - } - /////////////////////////////////////////////////////////////////////////// - // Function for sorting which crystal is intersected first. - /////////////////////////////////////////////////////////////////////////// - void sort_intersections(double* t, double* t1, int* l, struct neutron_values* neut){ - for (int i = 0; in; i++){ - - if (neut->entry_time[i]==0 && neut->exit_time[i]==0) { - // If t is the lates time, set it. - neut->entry_time[i] = *t; - neut->exit_time[i] = *t1; - neut->intersection_list[i] = *l; - break; - } - else if (*tentry_time[i]){ - //Move all the other times up one. - for (int j = neut->n-1; j>=i; j--){ - neut->entry_time[j] = neut->entry_time[j-1]; - neut->exit_time[j] = neut->exit_time[j-1]; - neut->intersection_list[j] = neut->intersection_list[j-1]; - } - neut->entry_time[i] = *t; - neut->exit_time[i] = *t1; - neut->intersection_list[i] = *l; - break; - } - } - } - /////////////////////////////////////////////////////////////////////////// - // Function for finding intersections with all the crystals in the array. - /////////////////////////////////////////////////////////////////////////// - void find_intersections(struct Monochromator_array* mono_arr, - struct neutron_values* neutron){ - - memset(neutron->intersection_list, -1, sizeof(int)*neutron->n); - memset(neutron->entry_time, 0, sizeof(double)*neutron->n); - memset(neutron->exit_time, 0, sizeof(double)*neutron->n); - memset(neutron->path_length, 0, sizeof(double)*neutron->n); - int intersects_bounding_box=0; - double t1, t2; - double temp1,temp2; - double position[3] = {neutron->r[0], neutron->r[1], neutron->r[2]}; - double speed[3] = {neutron->v[0], neutron->v[1], neutron->v[2]}; - double dx, dy, dz; - for (int i = 0; inumber_of_crystals; i++){ - if (mono_arr->verbosity){printf("Crystal %d out of %d is being processed for intersections\n", i,mono_arr->number_of_crystals );} - intersects_bounding_box=0; - dx = mono_arr->crystal[i].bounding_box_thickness; - dy = 2*mono_arr->crystal[i].height; - dz = mono_arr->crystal[i].length; - Coordinate_transformation(neutron, &mono_arr->crystal[i]); - // Before doing proper intersection, check if the neutron is in a bounding box - intersects_bounding_box = box_intersect(&temp1, &temp2, - neutron->r[0], neutron->r[1], neutron->r[2], - neutron->v[0], neutron->v[1], neutron->v[2], - dx, dy, dz); - if (intersects_bounding_box){ - if (mono_arr->verbosity){printf("Bounding box check survived\n");} - neutron->r[0] -= mono_arr->crystal[i].radius_horizontal; - cylinder_cut_out_intersect(&t1, &t2, neutron, &mono_arr->crystal[i]); - if (t1 >= 0 || t2 >= 0){ - // neutron intersects with crystal from outside of crystal - // If neutron starts inside crystal, set entry time to 0. - if (t1<0) {t1 = 0;} - sort_intersections(&t1, &t2, &i, neutron); - } - } - - for (int j = 0; j<3; j++){ - neutron->r[j] = position[j]; - neutron->v[j] = speed[j]; - } - } - // Find the number of intersections, and assign the path length through those crystals. - neutron->intersections = 0; - for (int i = 0; inumber_of_crystals; i++){ - if (neutron->intersection_list[i] == -1){break;} - neutron->intersections += 1; - neutron->path_length[i] = neutron->exit_time[i] - neutron->entry_time[i]; - } - } - - /////////////////////////////////////////////////////////////////////////// - /////////////// B0 and BT are values used for the Debye factor - /////////////////////////////////////////////////////////////////////////// - void calculate_B0_and_BT(struct Monochromator_values *monochromator){ - double x; - monochromator->B0 = 2872.556/monochromator->atomic_number - /monochromator->debye_temperature; - - if (monochromator->temperature_mono>0.1) x = monochromator->debye_temperature - /monochromator->temperature_mono; - else x =monochromator->debye_temperature/0.1; - double phis = calculate_phi_integral(x); - - monochromator->BT = 4 * monochromator->B0 * phis / square(x); - } - - //////////////////////////////////////////////////////////////////////////// - /////////////// The kinematic reflectivity is calculated as in - /////////////// Zachariasen - //////////////////////////////////////////////////////////////////////////// - double calculate_kinematic_reflectivity(struct Monochromator_values* monochromator, - struct neutron_values* neutron){ - double sine_of_bragg_angle = neutron->wavelength/2/monochromator->lattice_spacing; - if (sine_of_bragg_angle>=1) return 0; // Only do first order reflections - double cosine_of_bragg_angle = sqrt(1-square(sine_of_bragg_angle)); - double extinction_length = monochromator->lattice_spacing - /neutron->wavelength - *sqrt(4*PI/monochromator->Maier_Leibnitz_reflectivity*100); - // Kinenatic reflectivity = QML*DHKL*sin(theta_B)**2/PI/cos(theta_B) [m⁻1] - double kinematic_reflectivity = monochromator->Maier_Leibnitz_reflectivity; - kinematic_reflectivity *= monochromator->lattice_spacing; - kinematic_reflectivity *= square(sine_of_bragg_angle); - kinematic_reflectivity *= 1/PI/cosine_of_bragg_angle; - kinematic_reflectivity *= monochromator->Debye_Waller_factor; - // Primary extinction factor, using the approximation - // in G.E Bacon and R.D. Lowde, Acta Cryst. (1948). 1, 303 - - kinematic_reflectivity *= tanh(monochromator->domain_thickness/extinction_length) - /monochromator->domain_thickness*extinction_length; - return kinematic_reflectivity; - } - - //////////////////////////////////////////////////////////////////////////// - /////////////// The actual calculations for the att coefficient - /////////////// See the citation for Freund higher up. - //////////////////////////////////////////////////////////////////////////// - double calculate_attenuation_coefficient(struct Monochromator_values* mono, - struct neutron_values* neutron){ - double E = square(neutron->v_size)*VS2E; // Neutron energy in meV - // Get factor for single phonon cross section - - double Bernoulli_sequence[31] = {1,-0.5,0.166667,0,-0.033333,0,0.0238095,0,-0.033333, - 0,0.0757576,0,-0.253114,0,1.16667,0,-7.09216,0,54.9712, - 0,-529.124,0,6192.12,0,-86580.3,0,1.42551717e6,0,-2.7298231e7, - 0,6.01580874e8}; - double x; - if (mono->temperature_mono - 0.1 <= 0){ - x = mono->debye_temperature/0.1; - } - else{ - x = mono->debye_temperature/mono->temperature_mono; - } - double R, Ifact, Xn; - if (x<6){ - R = 0; - Ifact = 1; - Xn = 1/x; - //JS: TODO, R may converge quickly, then the loop could be terminated sooner than after 31 steps - for (int i=0; i<30; i++){ - R += Bernoulli_sequence[i]*Xn/Ifact/(i + 2.5); - Xn *= x; - Ifact *= i + 1; - } - } - else R = 3.3/sqrt(x*x*x*x*x*x*x); - - // Define boltzmann_constant in units of (meV/K) - double boltzmann_constant = 0.08617333262; - double DWMF = 1-exp(-(mono->B0+mono->BT) - *mono->Constant_from_Freund_paper*E/1000); - // Factor 1000 is to convert Freund constant to meV - // Set the cross sections, as written in freunds paper - mono->nuclear_capture_absorption = mono->incoherent_scattering_cross_section - +mono->absorption_for_1AA_Neutrons*neutron->wavelength; - - mono->multiple_phonon_absorption = mono->bound_atom_scattering_cross_section - *square(mono->atomic_number/(mono->atomic_number + 1)) - *DWMF; - - mono->single_phonon_absorption = 3*mono->bound_atom_scattering_cross_section/mono->atomic_number - * sqrt(boltzmann_constant * mono->debye_temperature/E) * R; - - double attenuation_coefficient = (mono->nuclear_capture_absorption - + mono->single_phonon_absorption - + mono->multiple_phonon_absorption) - /mono->volume; // [10^-28m^2/10^-30m^3] - attenuation_coefficient *= 100; // [m^-1] - return attenuation_coefficient; - } - /////////////////////////////////////////////////////////////////////////// - /////////////// Function that retrieves local scattering vector G or tau. - /////////////////////////////////////////////////////////////////////////// - void calculate_local_scattering_vector(struct Monochromator_values* mono, - struct neutron_values* neutron, int* crystal){ - double tau_temp[3] = {mono->tau[0], mono->tau[1], mono->tau[2]}; - - double size_of_in_plane_tau = sqrt(square(mono->tau[0]) - + square(mono->tau[2])); - for (int i=0 ; i<3; i++) { - tau_temp[i] += mono->lattice_spacing_gradient_field[i][0]*neutron->r[0] - +mono->lattice_spacing_gradient_field[i][1]*neutron->r[1] - +mono->lattice_spacing_gradient_field[i][2]*neutron->r[2]; - } - - double tau_size = sqrt(square(tau_temp[0]) - + square(tau_temp[1]) - + square(tau_temp[2])); - - // Add the angles of the mosaic block to the scattering vector - neutron->tau[0] = tau_temp[0] - + tau_temp[2]*neutron->horiz_angle[*crystal] - - mono->tau[1]*mono->tau[0]/size_of_in_plane_tau - * neutron->vert_angle[*crystal]; - neutron->tau[1] = tau_temp[1] + size_of_in_plane_tau *neutron->vert_angle[*crystal]; - neutron->tau[2] = tau_temp[2] - - tau_temp[0]*neutron->horiz_angle[*crystal] - - mono->tau[1]*mono->tau[2]/size_of_in_plane_tau - * neutron->vert_angle[*crystal]; - - // Renormalize local scat vect - double normalization_factor = tau_size - /sqrt(square(neutron->tau[0]) - + square(neutron->tau[1]) + square(neutron->tau[2])); - - neutron->tau[0] *= neutron->direction*normalization_factor; - neutron->tau[1] *= neutron->direction*normalization_factor; - neutron->tau[2] *= neutron->direction*normalization_factor; - } - //////////////////////////////////////////////////////////////////////////// - // Function that sets the neutron structs values at a point and speed - //////////////////////////////////////////////////////////////////////////// - void set_neutron_values( - struct neutron_values* neutron, - double x, double y, double z, - double vx, double vy, double vz){ - neutron->r[0] = x; - neutron->r[1] = y; - neutron->r[2] = z; - neutron->v[0] = vx; - neutron->v[1] = vy; - neutron->v[2] = vz; - neutron->v_size = 0; - neutron->ki_size = 0; - neutron->kf_size = 0; - for (int i =0; i<3; i++){ - neutron->ki[i] = neutron->v[i]*V2K; - neutron->ki_size += square(neutron->ki[i]); - neutron->v_size += square(neutron->v[i]); - } - - neutron->v_size = sqrt(neutron->v_size); - neutron->ki_size = sqrt(neutron->ki_size); - neutron->wavelength = 3956/neutron->v_size;// Wavelength in Angstrom. - } - //////////////////////////////////////////////////////////////////////////// - /////////////// Functions that find epsilon zero and beta. - //////////////////////////////////////////////////////////////////////////// - void calculate_epszero_and_beta(struct Monochromator_values* mono, - struct neutron_values* neutron, int lamella){ - // Update the final wavevector, as well as the size of the reciprocal lattice vector - neutron->tau_size = 0; - neutron->kf_size = 0; - for (int i=0; i<3; i++){ - neutron->kf[i] = neutron->ki[i] + neutron->tau[i]; - neutron->tau_size += square(neutron->tau[i]); - neutron->kf_size += square(neutron->kf[i]); - } - - neutron->tau_size = sqrt(neutron->tau_size); - neutron->kf_size = sqrt(neutron->kf_size); - double a = 0; - double b = 0; - // a is the numerator for the angular deviation of the bragg angle. - // a = (ki + tau_0 + tau*gamma)^2 - ki^2 - a = square(neutron->kf_size) - square(neutron->ki_size); - // b is the angle between k_i and tau, muktiplied by the size of each. - // b = tau*(ki + tau_0 + delta nabla tau * ki + k*gamma) - // But only the part that is along the - // direction of the mosaic angle, and therefore it becomes - // tau*k*cos(theta_b) in the paper. - b = neutron->direction*neutron->tau_size*(neutron->kf[0]*mono->perp_to_tau[0] - +neutron->kf[1]*mono->perp_to_tau[1] - +neutron->kf[2]*mono->perp_to_tau[2]); - - // Calculate the angular deviation from the Bragg condition - // eps_zero = - neutron->eps_zero[lamella] = -a/(2*b); - // Calculate gradient of the angular deviation - neutron->beta[lamella] = 0; - - for (int i = 0; i<3; i++){ - double z = 0; - for (int j = 0; j<3; j++){ - z += neutron->direction*mono->lattice_spacing_gradient_field[i][j] - *neutron->ki[j]; - } - neutron->beta[lamella] += (neutron->ki[i]+ mono->tau[i])*z; - } - neutron->beta[lamella] *= -1/b/neutron->ki_size; - // These definitions of beta and eps_zero exactly correspond to eq.4 of NIMA paper - } - //////////////////////////////////////////////////////////////////////////// - /////////////// Function that finds the probability - /////////////// that a neutron will reflect - //////////////////////////////////////////////////////////////////////////// - - void find_propability_of_reflection(struct Monochromator_values* mono, - struct neutron_values* neutron, int lamella){ - double kinematic_reflectivity = calculate_kinematic_reflectivity(mono, neutron); - if (mono->type==bent){ - // P = 1 - exp(-Q/(beta)) - neutron->probabilities[lamella] = 1 - exp(-kinematic_reflectivity - /fabs(neutron->beta[lamella])); - } - else if (mono->type==bent_mosaic){ - // P=1-e^[-Q/beta*(Phi[eps_0/eta + beta k delta/eta] - Phi[eps_0/eta])] - // arg1 = [eps_0/eta + beta k delta/eta] - double arg1 = (neutron->eps_zero[lamella] + - neutron->beta[lamella]*neutron->v_size - *neutron->path_length[lamella])/ - mono->mosaicity_horizontal; - // arg2 = [eps_0/eta] - double arg2 = neutron->eps_zero[lamella]/mono->mosaicity_horizontal; - neutron->probabilities[lamella] = 1-exp(-kinematic_reflectivity - /neutron->beta[lamella]* - (normalCDF(arg1, 1) - normalCDF(arg2, 1))); - } - } - - //////////////////////////////////////////////////////////////////////////// - /////////////// Simple function to choose the random angle of the mosaic - /////////////// block - //////////////////////////////////////////////////////////////////////////// - void choose_mosaic_block_angle(struct Monochromator_values* mono, - struct neutron_values* neutron, int* i, _class_particle* particle){ - if (mono->type==bent_mosaic){ - neutron->vert_angle[*i] = random_normal_distribution(&mono->mosaicity_vertical, particle); - neutron->horiz_angle[*i] = random_normal_distribution(&mono->mosaicity_horizontal, particle); - } - else { - neutron->vert_angle[*i] = 0; - neutron->horiz_angle[*i] = 0; - } - } - //=================================================================== - //===== FUNCTIONS TO MOVE NEUTRON IN MONOCHROMATOR COORDINATES ====== - //=================================================================== - void transport_neutron_to_crystal_coordinates(struct Monochromator_values* mono, - struct neutron_values* neutron, - int* lamella){ - neutron->r[0] += neutron->v[0]*neutron->entry_time[*lamella]; - neutron->r[1] += neutron->v[1]*neutron->entry_time[*lamella]; - neutron->r[2] += neutron->v[2]*neutron->entry_time[*lamella]; - Coordinate_transformation(neutron, mono); - } - - void propagate_neutrons_to_point_of_reflection(struct neutron_values* neutron){ - neutron->r[0] += neutron->v[0]*neutron->TOR; - neutron->r[1] += neutron->v[1]*neutron->TOR; - neutron->r[2] += neutron->v[2]*neutron->TOR; - } - - - // ========================================================================= - //============= START OF OVERVIEW FUNCTIONS CALLED FROM TRACE ============== - //========================================================================== - - void check_if_neutron_intersects(struct Monochromator_array* mono_arr, - struct neutron_values* neutron){ - if (mono_arr->verbosity){printf( - "Checking if neutron intersects with Monochromator\n");} - find_intersections(mono_arr, neutron); - if (neutron->entry_time[0] <0){ - if (mono_arr->verbosity) { - printf("!!! POSSIBLE ERROR AT MONOCHROMATOR_BENT!!! \n" - "Neutron enters the crystal at a negative time=%g", - neutron->entry_time[0]); - } - // Different setups may yield this error. - // The default behaviour is then to let the neutron pass through. - neutron->transmit_neutron = 1; - } - if (mono_arr->verbosity) { - for (int i = 0; i < neutron->intersections; i++){ - printf("Intersection %d: t=%g\n",i,neutron->entry_time[i]); - } - } - } - - // - // ========================================================================= - // - - void calculate_probabilities_of_reflection(struct Monochromator_array* mono_arr, - struct neutron_values* neutron, _class_particle* particle){ - - if (mono_arr->verbosity) {printf("Calculating probabilities of reflection\n");} - double position[3] = {neutron->r[0], neutron->r[1], neutron->r[2]}; - double speed[3] = {neutron->v[0], neutron->v[1], neutron->v[2]}; - for (int i = 0; i < neutron->intersections; i++){ - struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[i]]; - - transport_neutron_to_crystal_coordinates(mono, neutron, &i); - choose_mosaic_block_angle(mono, neutron, &i, particle); - // It is necessary to calculate the local scattering vector and - // epszero and beta without any horizontal mosaicity, as per the equations. - double mos_temp = neutron->horiz_angle[i]; - neutron->horiz_angle[i] = 0; - calculate_local_scattering_vector(mono, neutron, &i); - calculate_epszero_and_beta(mono, neutron, i); - neutron->horiz_angle[i] = mos_temp; - find_propability_of_reflection(mono, neutron, i); - if (mono_arr->verbosity) {printf("Raw probability is %f\n", neutron->probabilities[i]);} - // Check if reflection would be inside the crystal - // It should only ever not be, when the mono is at 0 mosaicity - if (mono->type==bent){ - neutron->TOR = -neutron->eps_zero[i]/(neutron->ki_size*neutron->beta[i]); - neutron->TOR *= neutron->ki_size/neutron->v_size; - propagate_neutrons_to_point_of_reflection(neutron); - double transposed_x = neutron->r[0] - mono->radius_horizontal; - if (!neutron_is_inside_crystal(&transposed_x, &neutron->r[1], - &neutron->r[2], mono)) { - neutron->probabilities[i] = 0; - } - } - if (i==0 && mono->type==bent && neutron->reflections>0){ - neutron->probabilities[i] = 0; - // Don't allow double reflections in a perfect crystal - } - - if (i == 0){ - neutron->accu_probs[i] = neutron->probabilities[i]; - } else { - neutron->accu_probs[i] = 1 - (1-neutron->accu_probs[i-1])* - (1-neutron->probabilities[i]); - } - if (mono_arr->verbosity) { - printf("P(intersection %d)= %f\taccuP=%f\n", i, neutron->probabilities[i], - neutron->accu_probs[i]); - } - // Place neutron back to the original position - // wit the original speed and direction - for (int j = 0; j < 3; j++) { - neutron->r[j] = position[j]; - neutron->v[j] = speed[j]; - } - } - } - - // - // ========================================================================= - // - - void choose_crystal_to_reflect_from(struct Monochromator_array* mono_arr, - struct neutron_values* neutron, - int* optimize, _class_particle* _particle){ - if (mono_arr->verbosity) { printf("Choosing crystal to reflect from\n");} - double reflect_condition; - if (neutron->direction>0 && *optimize){ - reflect_condition = neutron->accu_probs[neutron->intersections-1]*rand01(); - } else{ - reflect_condition = 1*rand01(); - } - neutron->chosen_crystal = 0; // The starting crystal is always 0. - // Find the crystal the neutron reflects from, or the - // final crystal the neutron is in. - while(neutron->accu_probs[neutron->chosen_crystal]<= reflect_condition - && neutron->chosen_crystal < neutron->intersections){ - neutron->chosen_crystal += 1; - } - if (mono_arr->verbosity) { - printf("Chosen crystal = %d\t at refcon=%g, accuprobs=%g\n", - neutron->chosen_crystal, reflect_condition, - neutron->accu_probs[neutron->chosen_crystal]); - } - - } - - // - // ========================================================================= - // - - void check_if_neutron_should_pass_through(struct Monochromator_array* mono_arr, - struct neutron_values* neutron, - double* weight, double* weight_init){ - if (mono_arr->verbosity) {printf("Checking if neutron should pass through\n");} - if (neutron->chosen_crystal == neutron->intersections) { - neutron->transmit_neutron = 1; - neutron->chosen_crystal -=1; - } - else if (*weight*neutron->accu_probs[neutron->chosen_crystal]/ *weight_init - < 1e-3){ - neutron->transmit_neutron = 1; - } - if (mono_arr->verbosity && neutron->transmit_neutron) { - printf("Neutron has not reflected\n");} - } - - // - // ========================================================================= - // - - void sample_reflection_time(struct Monochromator_array* mono_arr, struct neutron_values* neutron, - _class_particle* _particle){ - if (mono_arr->verbosity){printf("Sampling reflection time\n");} - int crystal = neutron->chosen_crystal; - struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[crystal]]; - if (mono->type==bent){ - // Note: This equation can also be solved precisely as a - // quadratic equation in Bragg's law. - neutron->TOR = -neutron->eps_zero[crystal]/(neutron->ki_size*neutron->beta[crystal]); - } - else if (mono->type==bent_mosaic){ - double kinematic_reflectivity = calculate_kinematic_reflectivity(mono, neutron); - // TOR = eta/k/beta * Phi^-1 [Phi(eps_0/eta) - - // beta/Q * ln(1-ksi*P(delta_n))] - eps_0/k/beta - // arg1 = eps_0/eta - double arg1 = neutron->eps_zero[crystal]/mono->mosaicity_horizontal; - // log_result = ln(1-ksi*P(delta_n)) - // Done like this to ensure type safety - double log_arg = 1-rand01()*neutron->probabilities[crystal]; - double log_result = (double) log((double) log_arg); - // arg2 = beta/Q * ln(1-ksi*P(delta_n)) - double arg2 = neutron->beta[crystal]/kinematic_reflectivity*log_result; - neutron->TOR = inverseNormalCDF(normalCDF(arg1, 1) - arg2, 1); - neutron->TOR *= mono->mosaicity_horizontal; - neutron->TOR -= neutron->eps_zero[crystal]; - neutron->TOR *= 1/neutron->beta[crystal]/neutron->ki_size; - } - neutron->TOR *= neutron->ki_size/neutron->v_size; - transport_neutron_to_crystal_coordinates(mono, neutron, &crystal); - propagate_neutrons_to_point_of_reflection(neutron); - double transposed_x = neutron->r[0] - mono->radius_horizontal; - // Check if the neutron is in the monochromator. - // It should only ever not be, when the mono is at 0 mosaicity - // at the point of reflection - if (!neutron_is_inside_crystal(&transposed_x, &neutron->r[1], - &neutron->r[2], mono)) { - if (mono_arr->verbosity) {printf("ERROR: THE FOUND REFLECTION IS NOT INSIDE CRYSTAL.\n");} - neutron->transmit_neutron = 1; - } - if (mono_arr->verbosity) {printf("TOR = %g\n", neutron->TOR);} - - } - - // - // ========================================================================= - // - - void reflect_neutron(struct Monochromator_array* mono_arr, - struct neutron_values* neutron, - double* speed_x, double* speed_y, double* speed_z, - double* weight, int* optimize){ - if (mono_arr->verbosity) {printf("Reflecting neutron\n");} - int crystal = neutron->chosen_crystal; - struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[crystal]]; - double calculated_epsilon = neutron->eps_zero[crystal] + - neutron->beta[crystal]*neutron->TOR*neutron->v_size; - neutron->horiz_angle[crystal] = calculated_epsilon; - calculate_local_scattering_vector(mono, neutron, &crystal); - - *speed_x = (neutron->ki[0] + neutron->tau[0]); - *speed_y = (neutron->ki[1] + neutron->tau[1]); - *speed_z = (neutron->ki[2] + neutron->tau[2]); - // Rotate the speed vector back into the original coordinate system from the crystal coordinates system - double new_v[3] = {0,0,0}; - double transp_mat[3][3]; - rot_transpose(mono->rotation_matrices,transp_mat); - for (int i = 0; i<3; i++){ - new_v[i] += transp_mat[i][0]* *speed_x; - new_v[i] += transp_mat[i][1]* *speed_y; - new_v[i] += transp_mat[i][2]* *speed_z; - } - *speed_x = new_v[0]; - *speed_y = new_v[1]; - *speed_z = new_v[2]; - - // Renormalize the neutron as we are adding a - // reciprocal lattice vector with a changing - // lattice spacing across the crystal - - double v_size = sqrt(square(*speed_x) + square(*speed_y) + square(*speed_z)); - *speed_x *= neutron->ki_size/v_size*K2V; - *speed_y *= neutron->ki_size/v_size*K2V; - *speed_z *= neutron->ki_size/v_size*K2V; - - - if (neutron->direction>0 && *optimize){ - if (mono_arr->verbosity) {printf("p*=%g \n", neutron->accu_probs[neutron->intersections-1]);} - *weight *= neutron->accu_probs[neutron->intersections-1]; - } - - for (int i = 0; ichosen_crystal; i++){ - neutron->path += neutron->path_length[i]; - } - neutron->path += neutron->TOR; - neutron->direction *= -1; - neutron->reflections += 1; - } - - // - // ========================================================================= - // - - void find_new_intersections(struct Monochromator_array* mono_arr, - struct neutron_values* neutron){ - if (mono_arr->verbosity) {printf("Finding new intersections\n");} - find_intersections(mono_arr, neutron); - if (mono_arr->verbosity) { - for (int i = 0; i < neutron->intersections; i++){ - printf("Intersection %d: t=%g\n",i,neutron->entry_time[i]); - } - } - } - - // - // ========================================================================= - // - - void attenuate_neutron(struct Monochromator_array* mono_arr, - struct neutron_values* neutron, - double* p){ - if (mono_arr->verbosity) {printf("Attenuating neutron\n");} - if (neutron->transmit_neutron == 1){ - for (int i = 0; i < neutron->intersections; i++){ - neutron->path += neutron->path_length[i]; - } - } - double attenuation_coefficient = calculate_attenuation_coefficient(&mono_arr->crystal[0], neutron); - // TODO: This attenuation does not support multiple different crystals in the array. - // It is not currently the use case, and therefore we will live with it. - *p *= exp(-attenuation_coefficient*neutron->path*neutron->v_size); - } -%} - -DECLARE -%{ - int counter; - int counter2; - double curvature; - int MAX_REFLECTIONS; - - struct neutron_values neutron; - struct Monochromator_array mono_arr; -%} - -INITIALIZE -%{ - /////////////////////////////////////////////////////////////////////////// - /////////////// ERROR FUNCTIONS - /////////////////////////////////////////////////////////////////////////// - if (xthickness <= 0) - exit(printf("Monochromator_Bent: %s: " - "invalid monochromator xthickness=%g\n", NAME_CURRENT_COMP, xthickness)); - if (zwidth <= 0) - exit(printf("Monochromator_Bent: %s: " - "invalid monochromator zwidth=%g\n", NAME_CURRENT_COMP, zwidth)); - if (yheight <= 0) - exit(printf("Monochromator_Bent: %s: " - "invalid monochromator yheight=%g\n", NAME_CURRENT_COMP, yheight)); - - int x_pos_mem_flag = 0; - int y_pos_mem_flag = 0; - int z_pos_mem_flag = 0; - int x_rot_mem_flag = 0; - int y_rot_mem_flag = 0; - int z_rot_mem_flag = 0; - double *temp = calloc(n_crystals, sizeof(double)); - if (!x_pos){ - if (verbose) printf("X pos is not defined, using 0 as position\n"); - int x_pos_mem_flag = 1; - x_pos = calloc(n_crystals, sizeof(double)); - memcpy(x_pos, temp, n_crystals * sizeof(double)); - } - if (!y_pos){ - if (verbose) printf("Y pos is not defined, using 0 as position\n"); - int y_pos_mem_flag = 1; - y_pos = calloc(n_crystals, sizeof(double)); - memcpy(y_pos, temp, n_crystals * sizeof(double)); - } - if (!z_pos){ - if (verbose) printf("Z pos is not defined, using 0 as position\n"); - int z_pos_mem_flag = 1; - z_pos = calloc(n_crystals, sizeof(double)); - memcpy(z_pos, temp, n_crystals * sizeof(double)); - } - if (!x_rot){ - if (verbose) printf("X rot is not defined, using 0 as rotation\n"); - int x_rot_mem_flag = 1; - x_rot = calloc(n_crystals, sizeof(double)); - memcpy(x_rot, temp, n_crystals * sizeof(double)); - } - if (!y_rot){ - if (verbose) printf("Y rot is not defined, using 0 as rotation\n"); - int y_rot_mem_flag = 1; - y_rot = calloc(n_crystals, sizeof(double)); - memcpy(y_rot, temp, n_crystals * sizeof(double)); - } - if (!z_rot){ - if (verbose) printf("Z rot is not defined, using 0 as rotation\n"); - int z_rot_mem_flag = 1; - z_rot = calloc(n_crystals, sizeof(double)); - memcpy(z_rot, temp, n_crystals * sizeof(double)); - } - if (verbose) - for (int i=0;i<1;i++){ - printf("x,y,z,rot=(%g,%g,%g,%g,%g,%g)\n", - x_pos[i],y_pos[i],z_pos[i],x_rot[i],y_rot[i],z_rot[i]); - } - if (verbose){ - printf("Monochromator_Bent output: " - "Component name is %s:\n", NAME_CURRENT_COMP); - } - //////////////////////////////////////////////////////////////////////////// - /////////////// INITIALIZING PARAMETERS - //////////////////////////////////////////////////////////////////////////// - mono_arr.crystal = (struct Monochromator_values*) malloc(n_crystals * sizeof(struct Monochromator_values)); - mono_arr.number_of_crystals = n_crystals; // [#] - mono_arr.verbosity = verbose; // [#] - for (int i=0; i0){ - mono_arr.crystal[i].max_angle = PI + asin(zwidth/(2*radius_x)); - mono_arr.crystal[i].min_angle = PI - asin(zwidth/(2*radius_x)); - } else if (radius_x<0){ - mono_arr.crystal[i].max_angle = -asin(zwidth/(2*radius_x)); - mono_arr.crystal[i].min_angle = asin(zwidth/(2*radius_x)); - } - mono_arr.crystal[i].angle_range = mono_arr.crystal[i].max_angle - mono_arr.crystal[i].min_angle; - // Figure out the type of Monochromator - if (radius_x) mono_arr.crystal[i].type=bent; - if (mosaicity) mono_arr.crystal[i].type = mosaic; - if (mosaicity && radius_x) mono_arr.crystal[i].type = bent_mosaic; - if (!radius_x && !mosaicity) mono_arr.crystal[i].type = flat; - // Read the designated plane of reflection, for use in the Monochromator. - enum crystal_plane plane = stringToEnum((const char *)&plane_of_reflection); - // Set Monochromator values - mono_arr.crystal[i].length = zwidth; // [m] - mono_arr.crystal[i].height = yheight; // [m] - mono_arr.crystal[i].thickness = xthickness; // [m] - mono_arr.crystal[i].radius_horizontal = radius_x; // [m] - mono_arr.crystal[i].radius_vertical = radius_y; // [m] - mono_arr.crystal[i].radius_inner = fabs(mono_arr.crystal[i].radius_horizontal) - mono_arr.crystal[i].thickness/2; // [m] - mono_arr.crystal[i].radius_outer = fabs(mono_arr.crystal[i].radius_horizontal) + mono_arr.crystal[i].thickness/2; // [m] - double arrowheight = mono_arr.crystal[i].radius_outer*(1-cos(mono_arr.crystal[i].angle_range/2)); //sagita of circles - mono_arr.crystal[i].bounding_box_thickness = mono_arr.crystal[i].thickness + 2*arrowheight; - mono_arr.crystal[i].domain_thickness = domainthickness; // [] - mono_arr.crystal[i].temperature_mono = temperature; // [T] - mono_arr.crystal[i].lattice_spacing = crystal_table[plane][0]; // [A] - mono_arr.crystal[i].Maier_Leibnitz_reflectivity = crystal_table[plane][1]*100; // [A^-1 m^-1] - mono_arr.crystal[i].bound_atom_scattering_cross_section = crystal_table[plane][2]; // [barn] - mono_arr.crystal[i].absorption_for_1AA_Neutrons = crystal_table[plane][3];// [barn*A^-1] - mono_arr.crystal[i].incoherent_scattering_cross_section = crystal_table[plane][4];// [barn] - mono_arr.crystal[i].volume = crystal_table[plane][5]; // [A^-3] - mono_arr.crystal[i].atomic_number = crystal_table[plane][6]; // [#] - mono_arr.crystal[i].debye_temperature = crystal_table[plane][7]; // [K] - mono_arr.crystal[i].Constant_from_Freund_paper = crystal_table[plane][8]; //[A^-2 eV^-1] - mono_arr.crystal[i].poisson_ratio = crystal_table[plane][9]; // [] - calculate_B0_and_BT(&mono_arr.crystal[i]); - mono_arr.crystal[i].Debye_Waller_factor = exp(-(mono_arr.crystal[i].B0 + mono_arr.crystal[i].BT)/2/square(mono_arr.crystal[i].lattice_spacing)); - - mono_arr.crystal[i].x = x_pos[i]; - mono_arr.crystal[i].y = y_pos[i]; - mono_arr.crystal[i].z = z_pos[i]; - double xrot = x_rot[i] * DEG2RAD; - double yrot = y_rot[i] * DEG2RAD; - double zrot = z_rot[i] * DEG2RAD; - rot_set_rotation(mono_arr.crystal[i].rotation_matrices, xrot, yrot, zrot); - rot_set_rotation(mono_arr.crystal[i].neg_rotation_matrix, -xrot, -yrot, -zrot); - if (verbose){ - printf("%d'th crystal\nrot_x=%g\trot_y=%g\trot_z=%g\n" - "tr_x=%g\ttr_y=%g\ttr_z=%g\n",i, - x_rot[i], y_rot[i], z_rot[i], - x_pos[i], y_pos[i], z_pos[i] - ); - } - - - //Set the mosaicity if relevant - if (mono_arr.crystal[i].type == mosaic || mono_arr.crystal[i].type == bent_mosaic){ - //Input mosaicity is in arc min. Convert to Degrees and then to radians - // (And multiply with R8LN2 which I don't know what is). - // Is it because of input being fwhm instead of sigma? - double R8LN2 = 2.354820045; - mono_arr.crystal[i].mosaicity_horizontal = mosaicity/60*DEG2RAD/R8LN2; - mono_arr.crystal[i].mosaicity_vertical = mono_arr.crystal[i].mosaicity_horizontal*mosaic_anisotropy; - } - // Initialize reciprocal lattice vector G or tau in some texts, and perp_to_tau. - - double chi = angle_to_cut_horizontal*DEG2RAD; - - double tau_size_zero = 2*PI/mono_arr.crystal[i].lattice_spacing; - - mono_arr.crystal[i].tau[0] = tau_size_zero*cos(chi); - mono_arr.crystal[i].tau[1] = 0; - mono_arr.crystal[i].tau[2] = tau_size_zero*sin(chi); - - mono_arr.crystal[i].perp_to_tau[0] = sin(chi); - mono_arr.crystal[i].perp_to_tau[1] = 0; - mono_arr.crystal[i].perp_to_tau[2] = -cos(chi); - - // Initialize lattice_spacing_gradient_field - curvature = 1/mono_arr.crystal[i].radius_horizontal; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][0] = -mono_arr.crystal[i].poisson_ratio*cos(chi)*tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][1] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][2] = sin(chi) - *tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][0] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][1] = mono_arr.crystal[i].radius_vertical!=0 ? tau_size_zero*cos(chi)/mono_arr.crystal[i].radius_vertical : 0;; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][2] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][0] = sin(chi) - *tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][1] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][2] = -cos(chi) - *tau_size_zero*curvature; - } - - // Initialize neutron structs values - neutron.beta = (double*) calloc (n_crystals, sizeof(double)); - neutron.eps_zero = (double*) calloc (n_crystals, sizeof(double)); - neutron.vert_angle = (double*) calloc (n_crystals, sizeof(double)); - neutron.horiz_angle = (double*) calloc (n_crystals, sizeof(double)); - neutron.path_length = (double*) calloc (n_crystals, sizeof(double)); - neutron.entry_time = (double*) calloc (n_crystals, sizeof(double)); - neutron.exit_time = (double*) calloc (n_crystals, sizeof(double)); - neutron.probabilities = (double*) calloc (n_crystals, sizeof(double)); - neutron.accu_probs = (double*) calloc (n_crystals, sizeof(double)); - neutron.intersection_list = (int*) calloc (n_crystals, sizeof(int)); - neutron.n = n_crystals; - neutron.direction = 1; // Default direction is going away from the instrument - counter = 0; - counter2 = 0; - MAX_REFLECTIONS = 100; // Chosen maximum number of reflections - - // Free the position and rotations memories - if (x_pos_mem_flag) free(x_pos); - if (y_pos_mem_flag) free(y_pos); - if (z_pos_mem_flag) free(z_pos); - if (x_rot_mem_flag) free(x_rot); - if (y_rot_mem_flag) free(y_rot); - if (z_rot_mem_flag) free(z_rot); -%} - -TRACE -%{ - // Initialize variables for use in TRACE - int final_reflection = 0; - neutron.path = 0; - neutron.reflections = 0; - int neutron_is_inside_crystal =1; - double weight_init = p; if (weight_init <= 0.0) ABSORB; - neutron.transmit_neutron = 0; - neutron.direction = 1; - set_neutron_values(&neutron, x,y,z,vx,vy,vz); - if (verbose){ - printf("\nNEW NEUTRON STARTED\n"); - } - check_if_neutron_intersects(&mono_arr, &neutron); - - while (neutron_is_inside_crystal){ - calculate_probabilities_of_reflection(&mono_arr, &neutron, _particle); - choose_crystal_to_reflect_from(&mono_arr, &neutron, &optimize, _particle); - check_if_neutron_should_pass_through(&mono_arr, &neutron, &p, &weight_init); - if (neutron.reflections>MAX_REFLECTIONS){neutron.transmit_neutron=1;} - if (neutron.transmit_neutron){break;} - final_reflection = neutron.chosen_crystal; - sample_reflection_time(&mono_arr, &neutron, _particle); - // Let neutron pass through if point of reflection is outside of crystal - if (neutron.transmit_neutron){break;} - PROP_DT(neutron.TOR+neutron.entry_time[neutron.chosen_crystal]); - SCATTER; - reflect_neutron(&mono_arr, &neutron, &vx, &vy, &vz, &p, &optimize); - set_neutron_values(&neutron, x,y,z,vx,vy,vz); // Update speeds and wavevectors - find_new_intersections(&mono_arr, &neutron); - } - attenuate_neutron(&mono_arr, &neutron, &p); - -%} - -FINALLY -%{ - // Finally free the neutron - free(neutron.beta); - free(neutron.eps_zero); - free(neutron.vert_angle); - free(neutron.horiz_angle); - free(neutron.path_length); - free(neutron.entry_time); - free(neutron.exit_time); - free(neutron.probabilities); - free(neutron.accu_probs); - free(neutron.intersection_list); - - - free(mono_arr.crystal); -%} - - -MCDISPLAY -%{ - double x_inner [2]; - double x_outer [2]; - double y_top; - double y_bottom; - double z_inner [2]; - double z_outer [2]; - double points[8][3]; - // We draw the monochromator by drawing lines between chosen points. - // For this reason we need to move the points, - // in accordance to their position in the array. - for (int j=0; jradius_horizontal) - xthickness/2; - // double outer_radii = inner_radii + xthickness; - double angle0, angle1, movex, movey, movez; - y_top = yheight/2; - y_bottom = -yheight/2; - for (i = 0; i < max_i-0.2; i = i + 0.2) { - angle0 = i/max_i*mono->angle_range + mono->min_angle; - angle1 = (i+0.2)/max_i*mono->angle_range + mono->min_angle; - // Define the 8 coordinates of the n'th box in the crystal - x_inner[0] = (radius_x) + cos(angle0)*mono->radius_inner; - x_inner[1] = (radius_x) + cos(angle1)*mono->radius_inner; - - z_inner[0] = -sin(angle0)*mono->radius_inner; - z_inner[1] = -sin(angle1)*mono->radius_inner; - - x_outer[0] = (radius_x) + cos(angle0)*mono->radius_outer; - x_outer[1] = (radius_x) + cos(angle1)*mono->radius_outer; - - z_outer[0] = -sin(angle0)*mono->radius_outer; - z_outer[1] = -sin(angle1)*mono->radius_outer; - // These 8 coordinates define 8 points. Coordinate transform these - // to the current crystal - rotate_all_points(&x_inner[0], &x_outer[0], - &x_inner[1], &x_outer[1], - &y_top, &y_bottom, - &z_inner[0], &z_outer[0], - &z_inner[1], &z_outer[1], - points, mono); - // Draw a box in th xy plane - multiline(5, - points[0][0],points[0][1],points[0][2], - points[2][0],points[2][1],points[2][2], - points[3][0],points[3][1],points[3][2], - points[1][0],points[1][1],points[1][2], - points[0][0],points[0][1],points[0][2]); - - // Draw curving parts of crystal in the zx plane - line(points[0][0], points[0][1], points[0][2], - points[4][0], points[4][1], points[4][2]); - line(points[1][0], points[1][1], points[1][2], - points[5][0], points[5][1], points[5][2]); - line(points[2][0], points[2][1], points[2][2], - points[6][0], points[6][1], points[6][2]); - line(points[3][0], points[3][1], points[3][2], - points[7][0], points[7][1], points[7][2]); - } - // Draw a final box in the xy plane - multiline(5, - points[4][0],points[4][1],points[4][2], - points[6][0],points[6][1],points[6][2], - points[7][0],points[7][1],points[7][2], - points[5][0],points[5][1],points[5][2], - points[4][0],points[4][1],points[4][2]); - - } - - // line(0,0,0, - // -mono.perp_to_tau[0], -mono.perp_to_tau[1], -mono.perp_to_tau[2]); - if (draw_as_rectangles){ - for (int crystal=0; crystal with help from Jan Šaroun +* Date: 24 August 2023 +* Origin: ILL/NBI +* +* A bent crystal monochromator. Based on the model implemented by Jan Šaroun in NIMA 529 (2004) pp 162-165. +* Mosacity and bending radius can be set. +* +* %D +* This monochromator is an array of crystals, that can be bent. +* The crystals are placed by the user in the x,y,z pos and rot parameters. +* The crystal is bent, so that it follows a curve on a cylinder of radius_x. +* The monochromator lies along the z plane, so when a diffraction angle of theta +* is desired, it should just be inserted in the ROTATED parameter around +* the y-axis. +* Instruments that showcase the use of this component is the +* "Test_monochromator_bent.instr", and the "ILL_SALSA.instr" under the examples folder. +* SALSA showcases its complex use in a real instrument, while Test_monochromator_bent +* makes a simple show of its capabilities. +* +* +* %Parameters +* INPUT PARAMETERS: +* zwidth: [m] Width of each crystal without bending. +* yheight: [m] Height of each crystal without bending. +* xthickness: [m] Thickness of each crystal without bending. +* radius_x: [m] Radius of the circle the monochromator bends on in the plane. Can be negative. +* radius_y: [m] Radius of the (very large) circle the monochromator bends on as a side effect of the horizontal bending. The code assumes that it is so small that it does not affect the points of intersection appreciatively of the crystal. +* plane_of_reflection: ["Si400"] The plane of reflection from the material. The list of possible reflections can be seen in the source code. +* angle_to_cut_horizontal: [degrees] Angle between cut and normal of crystal slab, horizontally +* mosaicity: [arcmin] Gaussian mosaicity of the crystal. Always the horizontal mosaicity +* mosaic_anisotropy: [1] Anisotropy of the mosaicity, changes vertical mosaicity to be mosaic_anisotropy*mosaicity +* n_crystals: [#] Number of crystals in your array. +* domainthickness: [mu-m] Thickness of the crystal domains. +* temperature: [K]Temperature of the monochromator in Kelvin. +* optimize: [ ] Flag to tell if the component should optimize for reflections or not. +* x_pos: [vector] x-Position of each crystal +* y_pos: [vector] y-Position of each crystal +* z_pos: [vector] z-Position of each crystal +* x_rot: [vector] Rotation around x-axis for each crystal +* y_rot: [vector] Rotation around y-axis for each crystal +* z_rot: [vector] Rotation around z-axis for each crystal NOTE: Rotations happen around x, then y, then z. +* verbose: [ ] Verbosity of the monochromator. Used for debugging. +* draw_as_rectangles: [ ] Draw the monochromators as boxes. DOES NOT WORK WHEN USING _rot parameters. +* +* %L +* Jan Šaroun NIM A Volume 529, Issue 1-3 (2004), pp162-165 +* +* %E +*******************************************************************************/ +DEFINE COMPONENT Monochromator_bent +SETTING PARAMETERS (zwidth=0.2, + yheight=0.1, + xthickness=0.0005, + radius_x=2, + radius_y=0, + string plane_of_reflection="Si400", + angle_to_cut_horizontal=0, + mosaicity=30, + mosaic_anisotropy=1, + int n_crystals=1, + domainthickness=10, + temperature=300, + int optimize=0, + vector x_pos=NULL, + vector y_pos=NULL, + vector z_pos=NULL, + vector x_rot=NULL, + vector y_rot=NULL, + vector z_rot=NULL, + int verbose=0, + int draw_as_rectangles=0) +// Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) +NOACC +// The component is currently "NOACC" only, there are thread race-conditions on GPU + +SHARE +%{ + #include + + /////////////////////////////////////////////////////////////////////////// + /////////////// Structs for the component + /////////////////////////////////////////////////////////////////////////// + + struct Monochromator_values { + double length, height, thickness; + double mosaicity_horizontal, mosaicity_vertical; + int type; + double radius_horizontal; + double radius_vertical; + double radius_outer; + double radius_inner; + double Debye_Waller_factor; + double lattice_spacing; + double Maier_Leibnitz_reflectivity; + double poisson_ratio; + double bound_atom_scattering_cross_section; + double absorption_for_1AA_Neutrons; + double incoherent_scattering_cross_section; + double volume; + double Constant_from_Freund_paper; + double debye_temperature; + double atomic_number; + double temperature_mono; + double B0; + double BT; + double single_phonon_absorption; + double multiple_phonon_absorption; + double nuclear_capture_absorption; + double total_absorption; + double tau[3]; + double perp_to_tau[3]; + double lattice_spacing_gradient_field[3][3]; + double gradient_of_bragg_angle; + double domain_thickness; + double max_angle; + double min_angle; + double angle_range; + double rotation_matrices[3][3]; // pointer to rotation matrices + double neg_rotation_matrix[3][3]; // pointer to rotation matrices + double x; + double y; + double z; + double bounding_box_thickness; // the xthickness plus the arrowheight (the saggita) + }; + + struct Monochromator_array { + struct Monochromator_values* crystal; + int number_of_crystals; + int verbosity; + }; + + struct neutron_values { + // Statically allocate vectors that are always 3 + double ki[3]; // Incoming wavevector + double kf[3]; // outgoig wavevector + double r[3]; + double v[3]; // velocity of neutron + double tau[3]; // Reciprocal lattice vector + double ki_size; // size of incoming wavevector + double v_size; // speed + double tau_size; // size of reciprocal lattice vector + double kf_size; // size of outgoing wavevector + double* vert_angle; // Angle of deviation by the mosaic crystal vertically + double* horiz_angle; // Angle of deviation by the mosaic crystal in x-z plane + double* beta; // Gradient of deviation from bragg condition + double* eps_zero; // Angular deviation from bragg angle + double absorption; // Absorption factor + double path; // Length of the path the neutron follows + double wavelength; // De Broglie wavelength of neutron + double kinematic_reflectivity; // The Q value from the paper this code is based on. + double* path_length; // The time spent in crystals, to add to path for attenuation + double* entry_time; // Time from start of crystal, to entrance of each lamella + double* exit_time; // Time from start of crystal, to exit of each lamella + double* probabilities; // Probability of reflection in each lamella + double* accu_probs; // Accumulating probability in each lamella + double TOR; // The time in s from crystal edge to reflection + int chosen_crystal; // Which crystal the neutron reflects from in + int transmit_neutron; + int direction; // Direction of neutron + int n; // Number of crystals in the monochromator + int reflections; // How many reflections has the neutron performed + int intersections; // How many crystals the neutron has intersected + int* intersection_list; // List of intersected crystals, sorted by intersection time. + }; + + enum crystal_type { flat, bent, mosaic, bent_mosaic }; + + //////////////////////////////////////////////////////////////////////////// + /////////////// Mathematical functions for the component + //////////////////////////////////////////////////////////////////////////// + + double + sign (double x) { + if (x >= 0) + return 1; + return -1; + } + + double + square (double x) { + return x * x; + } + // Function to generate numbers in a uniform distribution + double + random_normal_distribution (double* sigma, _class_particle* _particle) { + double u1, u2; + u1 = rand01 (); + u2 = rand01 (); + double r = sqrt (-2 * log (u1)); + double theta = 2 * M_PI * u2; + return *sigma * r * cos (theta); + } + + // The following two function returns, respectively, + // the Gaussian cumulative distribution function, + // And the inverse gaussian cumulative distribution function. + double + normalCDF (double x, double sigma) { + return 0.5 * (1 + erf (x * M_SQRT1_2)); + } + // Inspired by https://gist.github.com/kmpm/1211922/6b7fcd0155b23c3dc71e6f4969f2c48785371292 + double + inverseNormalCDF (double p, double sigma) { + if (p <= 0 || p >= 1) + return sign (p) * 6; + + double mu = 0; + double r, val; + double q = p - 0.5; + + if (fabs (q) <= .425) { + r = .180625 - q * q; + val = q + * (((((((r * 2509.0809287301226727 + 33430.575583588128105) * r + 67265.770927008700853) * r + 45921.953931549871457) * r + 13731.693765509461125) * r + + 1971.5909503065514427) + * r + + 133.14166789178437745) + * r + + 3.387132872796366608) + / (((((((r * 5226.495278852854561 + 28729.085735721942674) * r + 39307.89580009271061) * r + 21213.794301586595867) * r + 5394.1960214247511077) * r + + 687.1870074920579083) + * r + + 42.313330701600911252) + * r + + 1); + } else { + if (q > 0) { + r = 1 - p; + } else { + r = p; + } + + r = sqrt (-log (r)); + + if (r <= 5) { + r += -1.6; + val = (((((((r * 7.7454501427834140764e-4 + .0227238449892691845833) * r + .24178072517745061177) * r + 1.27045825245236838258) * r + + 3.64784832476320460504) + * r + + 5.7694972214606914055) + * r + + 4.6303378461565452959) + * r + + 1.42343711074968357734) + / (((((((r * 1.05075007164441684324e-9 + 5.475938084995344946e-4) * r + .0151986665636164571966) * r + .14810397642748007459) * r + + .68976733498510000455) + * r + + 1.6763848301838038494) + * r + + 2.05319162663775882187) + * r + + 1); + } else { /* very close to 0 or 1 */ + r += -5; + val = (((((((r * 2.01033439929228813265e-7 + 2.71155556874348757815e-5) * r + .0012426609473880784386) * r + .026532189526576123093) * r + + .29656057182850489123) + * r + + 1.7848265399172913358) + * r + + 5.4637849111641143699) + * r + + 6.6579046435011037772) + / (((((((r * 2.04426310338993978564e-15 + 1.4215117583164458887e-7) * r + 1.8463183175100546818e-5) * r + 7.868691311456132591e-4) * r + + .0148753612908506148525) + * r + + .13692988092273580531) + * r + + .59983220655588793769) + * r + + 1); + } + + if (q < 0.0) { + val = -val; + } + } + + return mu + sigma * val; + } + //////////////////////////////////////////////////////////////////////////// + // End of mathematical functions + //////////////////////////////////////////////////////////////////////////// + + //========================================================================== + //======== Functions for choosing the right crystal for reflections ======== + //========================================================================== + enum crystal_plane { + Cu111, + Cu200, + Cu220, + Cu311, + Cu400, + Cu331, + Cu420, + Cu440, + Ge111, + Ge220, + Ge311, + Ge400, + Ge331, + Ge422, + Ge511, + Ge533, + Ge711, + Ge551, + Si111, + Si220, + Si311, + Si400, + Si331, + Si422, + Si333, + Si511, + Si440, + Si711, + Si551, + Be10, + Be100, + Be102, + Be103, + Be110, + Be112, + Be200, + Be00_2, + Be10_1, + PG00_2, + PG00_4, + PG00_6, + Fe110, + HS111, + HS222, + HS111star, + Di111, + Di220, + Di311, + Di400, + Di331, + Di422, + Di333, + Di511, + Di440 + }; + + // An array containing all the possible strings that will be accepted if given as an + // argument to the parameter plane_of_reflection + const char* crystal_planeStrings[] + = { "Cu111", "Cu200", "Cu220", "Cu311", "Cu400", "Cu331", "Cu420", "Cu440", "Ge111", "Ge220", "Ge311", "Ge400", "Ge331", "Ge422", + "Ge511", "Ge533", "Ge711", "Ge551", "Si111", "Si220", "Si311", "Si400", "Si331", "Si422", "Si333", "Si511", "Si440", "Si711", + "Si551", " Be10", "Be100", "Be102", "Be103", "Be110", "Be112", "Be200", "Be00_2", "Be10_1", "PG00_2", "PG00_4", "PG00_6", "Fe110", + "HS111", "HS222", "HS111star", "Di111", "Di220", "Di311", "Di400", "Di331", "Di422", "Di333", "Di511", "Di440" }; + + // Function to convert a string to an enum value + enum crystal_plane + stringToEnum (const char* plane) { + for (int i = 0; i < sizeof (crystal_planeStrings) / sizeof (crystal_planeStrings[0]); ++i) { + if (strcmp (plane, crystal_planeStrings[i]) == 0) { + return (enum crystal_plane)i; + } + } + return 0; + } + /* TITLE Crystal table for perfect crystal bent monochromator + Table copied from SIMRES, current url: https://github.com/saroun/simres + Contents: dhkl, QML,sigmab,sigmaa,V0,A,thetaD,C2,poi + dhkl ... Lattice spacing of crystal plane. + QML = 4*PI*(F*dhkl/V0)**2 [ A^-1 cm^-1] + sigmab ... bound-atom scattering cross-section [barn] + sigmaa ... absorption for 1A neutrons [barn*A^-1] + sigmai ... incoherent scattering cross-section [barn] + V0 .... volume [A^3]/atom + A .... atomic number + thetaD .... Debye temperature (K) + C2 .... constant from the Freund's paper [A^-2 eV^-1] + poi .... Poisson elastic constant */ + + double crystal_table[56][10] = { { 2.087063, 0.23391E+00, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 1.80745, 0.17544E+00, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 1.27806, 0.87718E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 1.089933, 0.63795E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 0.903725, 0.43859E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 0.829315, 0.36934E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 0.808316, 0.35087E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 0.63903, 0.21930E-01, 7.485, 2.094, 0.55, 11.81, 63.54, 315, 12.00, 0.30000E+00 }, + { 3.26665, 0.87700E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15450E+00 }, + { 2.00041, 0.65760E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.30000E+00 }, + { 1.70595, 0.23920E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15430E+00 }, + { 1.41450, 0.32880E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27300E+00 }, + { 1.29803, 0.13850E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.15430E+00 }, + { 1.15493, 0.21925E-01, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00 }, + { 1.08888, 0.97400E-02, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00 }, + { 0.86284, 0.61200E-02, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00 }, + { 0.79228, 0.51588E-02, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00 }, + { 0.79228, 0.51600E-02, 8.42, 1.216, 0.18, 22.63, 72.6, 290, 9.0, 0.27270E+00 }, + { 3.13536, 0.25970E-01, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.18080E+00 }, + { 1.92001, 0.19480E-01, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.30000E+00 }, + { 1.63739, 0.70800E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 1.35765, 0.97400E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 1.24587, 0.41000E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.18080E+00 }, + { 1.10852, 0.64930E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 1.04512, 0.28900E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 1.04512, 0.28900E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 0.96000, 0.48700E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 0.76044, 0.15277E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 0.76044, 0.15277E-02, 2.18, 0.0889, 0.0, 20.02, 28.09, 420, 6.36, 0.28000E+00 }, + { 1.97956, 0.11361, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00 }, + { 1.97956, 0.11361, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 1.32857, 0.05117, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 1.02290, 0.091, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 1.14290, 0.15147, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 0.96363, 0.10768, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 0.98978, 0.0284, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.28000E+00 }, + { 1.79215, 0.37245, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00 }, + { 1.73285, 0.26116, 7.62579, 0.00422655, 0.002, 8.10926, 9.012, 1100, 7.62, 0.30000E+00 }, + { 3.35500, 0.79500E+00, 5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00 }, + { 1.67750, 0.18000E+00, 5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00 }, + { 1.11830, 0.08833E+00, 5.555, 0.0019, 0.0, 8.80, 12.01, 1050, 20.00, 0.30000E+00 }, + { 2.02660, 0.34031E+00, 11.43, 2.53, 0.4, 11.75, 55.85, 411, 10.67, 0.30000E+00 }, + { 3.43500, 0.11020E+00, 1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00, 0.30000E+00 }, + { 1.71750, 0.13130E+00, 1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00, 0.30000E+00 }, + { 3.43500, 0.55100E-01, 1.79, 2.88, 0.55, 13.16, 48.0, 300, 12.00, 0.30000E+00 }, + { 2.05929, 0.36606, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 1.26105, 0.27455, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 1.07543, 0.09984, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.89170, 0.13727, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.81828, 0.0578, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.72807, 0.09152, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.68643, 0.04067, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.68643, 0.04067, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.63053, 0.06864, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 }, + { 0.63053, 0.06864, 5.55449, 0.00194444, 0.0, 5.67213, 12.01, 1860, 3.00, 0.30000E+00 } }; + /////////////////////////////////////////////////////////////////////////// + // End of functions for choosing crystal reflections + /////////////////////////////////////////////////////////////////////////// + + /////////////////////////////////////////////////////////////////////////// + /////////////// Testing function + /////////////////////////////////////////////////////////////////////////// + void + print_neutron_state (struct neutron_values* neutron) { + printf ("Neutron state:\nki %g, %g, %g\ntau %g, %g, %g\nkf %g, %g, %g\nv %g, %g, %g\nr %g, %g, %g\nki size %g, tau size %g, kf size %g, v size %g\n\n", + neutron->ki[0], neutron->ki[1], neutron->ki[2], neutron->tau[0], neutron->tau[1], neutron->tau[2], neutron->kf[0], neutron->kf[1], neutron->kf[2], + neutron->v[0], neutron->v[1], neutron->v[2], neutron->r[0], neutron->r[1], neutron->r[2], neutron->ki_size, neutron->tau_size, neutron->kf_size, + neutron->v_size); + } + + /////////////////////////////////////////////////////////////////////////// + /////////////// Calculations for absorption factor + /////////////// Based on the cross sections from + /////////////// A. K. Freund in Nuclear Instruments and Methods 213 (1983) 495-501 + /////////////////////////////////////////////////////////////////////////// + + // Integral needed for debye factor + + double + calculate_phi_integral (double x) { + // Asymptotic approximation + if (x > 5) + return PI * PI / 6 - exp (-x) / (x + 1); + // Integate with Simpson/3. I dont know what this means + double z = 1 + x / (exp (x) - 1); + double dx = x / 100; + double ksi; + for (int i = 2; i <= 100; i++) { + ksi = (i - 1) * dx; + switch (i % 2) { + case 1: + z = z + 4 * ksi / (exp (ksi) - 1); + break; + case 0: + z = z + 2 * ksi / (exp (ksi) - 1); + break; + } + } + return z * dx / 3; + } + + /////////////////////////////////////////////////////////////////////////// + /////////////// Function for checking if the neutron is inside the + /////////////// monochromator + /////////////////////////////////////////////////////////////////////////// + + int + neutron_is_inside_crystal (double* x, double* y, double* z, struct Monochromator_values* mono) { + // Check that r, theta and h are within parameters + double num_sig = 1e-6; + double r = sqrt (*x * *x + *z * *z); + if (r < mono->radius_inner - num_sig || r > mono->radius_outer + num_sig) { + return 0; + } + double theta = atan2 (*z, *x); + // TODO: This arctan2 call is what makes the component alot slower. + // SOURCE: https://math.stackexchange.com/questions/1098487/atan2-faster-approximation + // It mostly works but fails often. Could be implemented if necessary in the future. + // double a = min(fabs(*z), fabs(*x)) / max(fabs(*z), fabs(*x)); + // double s = a * a; + // double test = ((-0.0464964749 * s + 0.15931422) * s - 0.327622764) * s * a + a; + // if (fabs(*z) > fabs(a)) test = 1.57079637 - test; + // if (*x < 0) test = 3.14159274 - test; + // if (*z < 0) test = -test; + if (theta < 0 && mono->radius_horizontal > 0) + theta = 2 * PI + theta; + if (theta < mono->min_angle - num_sig || theta > mono->max_angle + num_sig) { + return 0; + } + if (*y < -mono->height / 2 - num_sig || *y > mono->height / 2 + num_sig) { + return 0; + } + return 1; + } + + /////////////////////////////////////////////////////////////////////////// + // Function that sorts which times are the two lowest for a single crystal + /////////////////////////////////////////////////////////////////////////// + void + sort_times (double* t1, double* t2, double* new_t) { + // NOTE: This algorithm breaks down if an intersection + // is at exactly -1 second away. + // Make t1r[0] + neutron->v[0] * *new_t; + y = neutron->r[1] + neutron->v[1] * *new_t; + z = neutron->r[2] + neutron->v[2] * *new_t; + if (neutron_is_inside_crystal (&x, &y, &z, mono)) { + sort_times (t1, t2, new_t); + } + } + + //////////////////////////////////////////////////////////////////////////// + /////////////// Function for finding intersection times for a single crystal + //////////////////////////////////////////////////////////////////////////// + int + cylinder_cut_out_intersect (double* t1, double* t2, struct neutron_values* neutron, struct Monochromator_values* mono) { + // TODO: Add reference to our paper for a visualisation of the geometry. + // The equations for this code are derived from the equation of the circle, + // equations for the neutron line, and the coordinates with cos and sin. + // This algorithm finds the two lowest values of time, + // and sets those as t1min_angle) * neutron->r[0] - neutron->r[2]) / (neutron->v[2] - tan (mono->min_angle) * neutron->v[0]); + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + temp_t = (tan (mono->max_angle) * neutron->r[0] - neutron->r[2]) / (neutron->v[2] - tan (mono->max_angle) * neutron->v[0]); + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + // Find intersections on the circular part of the crystal + double term1, term2, divisor; + term1 = mono->radius_inner * mono->radius_inner - neutron->r[0] * neutron->r[0] - neutron->r[2] * neutron->r[2]; + term2 = neutron->r[0] * neutron->v[0] + neutron->r[2] * neutron->v[2]; + divisor = neutron->v[0] * neutron->v[0] + neutron->v[2] * neutron->v[2]; + term1 = term1 / divisor + square (term2 / divisor); + if (term1 > 0) { + term2 = neutron->r[0] * neutron->v[0] + neutron->r[2] * neutron->v[2]; + + temp_t = sqrt (term1) - term2 / divisor; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + temp_t = -sqrt (term1) - term2 / divisor; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + } + term1 = mono->radius_outer * mono->radius_outer - neutron->r[0] * neutron->r[0] - neutron->r[2] * neutron->r[2]; + term2 = neutron->r[0] * neutron->v[0] + neutron->r[2] * neutron->v[2]; + divisor = neutron->v[0] * neutron->v[0] + neutron->v[2] * neutron->v[2]; + term1 = term1 / divisor + square (term2 / divisor); + if (term1 > 0) { + term2 = neutron->r[0] * neutron->v[0] + neutron->r[2] * neutron->v[2]; + + temp_t = sqrt (term1) - term2 / divisor; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + temp_t = -sqrt (term1) - term2 / divisor; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + } + + // Find intersections with the flat top and bottom planes. + temp_t = (mono->height - neutron->r[1]) / neutron->v[1]; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + temp_t = (-mono->height - neutron->r[1]) / neutron->v[1]; + check_intersection_and_update_times (t1, t2, &temp_t, neutron, mono); + if (*t1 > 0) + return 2; + if (*t2 > 0) + return 1; + return 0; + } + /////////////////////////////////////////////////////////////////////////// + // Function for transforming coordinates into local crystal coordinates. + // Difference between rotate point and coordinate transformation + // is that the one only acts on a point, and the other on a neutron + /////////////////////////////////////////////////////////////////////////// + + void + Coordinate_transformation (struct neutron_values* neutron, struct Monochromator_values* mono) { + // Now rotate the neutron, in the crystal coordinate system + // such that the flat of the crystal is aligned with the z-axis. + // Rotations are around first x then y then z. + double new_v[3] = { 0, 0, 0 }; + double new_r[3] = { 0, 0, 0 }; + // First translate, then rotate the neutron + double neutron_r[3] = { neutron->r[0] - mono->x, neutron->r[1] - mono->y, neutron->r[2] - mono->z }; + for (int i = 0; i < 3; i++) { + for (int j = 0; j < 3; j++) { + new_r[i] += mono->rotation_matrices[i][j] * neutron_r[j]; + new_v[i] += mono->rotation_matrices[i][j] * neutron->v[j]; + } + } + // Set the neutrons values to be these new ones + // and update the wavevector + for (int i = 0; i < 3; i++) { + neutron->r[i] = new_r[i]; + neutron->v[i] = new_v[i]; + neutron->ki[i] = neutron->v[i] * V2K; + } + } + //////////////////////////////////////////////////////////////////////////// + // Functions for mcdisplay. It rotates, then moves the crystals + //////////////////////////////////////////////////////////////////////////// + + void + rotate_point (double* point, struct Monochromator_values* mono) { + double new_point[3] = { 0, 0, 0 }; + // In order to not get the rotation matrix anew for each point, + // define it here and since this is a passive rotation of the crystal + // use the transposed matrix. + ; + double transp_mat[3][3]; + rot_transpose (mono->rotation_matrices, transp_mat); + for (int i = 0; i < 3; i++) { + for (int j = 0; j < 3; j++) { + new_point[i] += transp_mat[i][j] * point[j]; + // if (mono->verbosity){ + // printf("transp_mat[%d,%d]=%g\n", i,j,transp_mat[i][j]);} + } + } + point[0] = new_point[0] + mono->x; + point[1] = new_point[1] + mono->y; + point[2] = new_point[2] + mono->z; + } + + void + rotate_all_points (double* x1, double* x2, double* x3, double* x4, double* y1, double* y2, double* z1, double* z2, double* z3, double* z4, double p[][3], + struct Monochromator_values* mono) { + // First define the points of the first box + p[0][0] = *x1; + p[0][1] = *y1; + p[0][2] = *z1; + p[1][0] = *x1; + p[1][1] = *y2; + p[1][2] = *z1; + p[2][0] = *x2; + p[2][1] = *y1; + p[2][2] = *z2; + p[3][0] = *x2; + p[3][1] = *y2; + p[3][2] = *z2; + // // Now define the points of the second box + p[4][0] = *x3; + p[4][1] = *y1; + p[4][2] = *z3; + p[5][0] = *x3; + p[5][1] = *y2; + p[5][2] = *z3; + p[6][0] = *x4; + p[6][1] = *y1; + p[6][2] = *z4; + p[7][0] = *x4; + p[7][1] = *y2; + p[7][2] = *z4; + // Now Rotate all the points and perform their translation + for (int i = 0; i < 8; i++) { + rotate_point (p[i], mono); + } + } + /////////////////////////////////////////////////////////////////////////// + // Function for sorting which crystal is intersected first. + /////////////////////////////////////////////////////////////////////////// + void + sort_intersections (double* t, double* t1, int* l, struct neutron_values* neut) { + for (int i = 0; i < neut->n; i++) { + + if (neut->entry_time[i] == 0 && neut->exit_time[i] == 0) { + // If t is the lates time, set it. + neut->entry_time[i] = *t; + neut->exit_time[i] = *t1; + neut->intersection_list[i] = *l; + break; + } else if (*t < neut->entry_time[i]) { + // Move all the other times up one. + for (int j = neut->n - 1; j >= i; j--) { + neut->entry_time[j] = neut->entry_time[j - 1]; + neut->exit_time[j] = neut->exit_time[j - 1]; + neut->intersection_list[j] = neut->intersection_list[j - 1]; + } + neut->entry_time[i] = *t; + neut->exit_time[i] = *t1; + neut->intersection_list[i] = *l; + break; + } + } + } + /////////////////////////////////////////////////////////////////////////// + // Function for finding intersections with all the crystals in the array. + /////////////////////////////////////////////////////////////////////////// + void + find_intersections (struct Monochromator_array* mono_arr, struct neutron_values* neutron) { + + memset (neutron->intersection_list, -1, sizeof (int) * neutron->n); + memset (neutron->entry_time, 0, sizeof (double) * neutron->n); + memset (neutron->exit_time, 0, sizeof (double) * neutron->n); + memset (neutron->path_length, 0, sizeof (double) * neutron->n); + int intersects_bounding_box = 0; + double t1, t2; + double temp1, temp2; + double position[3] = { neutron->r[0], neutron->r[1], neutron->r[2] }; + double speed[3] = { neutron->v[0], neutron->v[1], neutron->v[2] }; + double dx, dy, dz; + for (int i = 0; i < mono_arr->number_of_crystals; i++) { + if (mono_arr->verbosity) { + printf ("Crystal %d out of %d is being processed for intersections\n", i, mono_arr->number_of_crystals); + } + intersects_bounding_box = 0; + dx = mono_arr->crystal[i].bounding_box_thickness; + dy = 2 * mono_arr->crystal[i].height; + dz = mono_arr->crystal[i].length; + Coordinate_transformation (neutron, &mono_arr->crystal[i]); + // Before doing proper intersection, check if the neutron is in a bounding box + intersects_bounding_box + = box_intersect (&temp1, &temp2, neutron->r[0], neutron->r[1], neutron->r[2], neutron->v[0], neutron->v[1], neutron->v[2], dx, dy, dz); + if (intersects_bounding_box) { + if (mono_arr->verbosity) { + printf ("Bounding box check survived\n"); + } + neutron->r[0] -= mono_arr->crystal[i].radius_horizontal; + cylinder_cut_out_intersect (&t1, &t2, neutron, &mono_arr->crystal[i]); + if (t1 >= 0 || t2 >= 0) { + // neutron intersects with crystal from outside of crystal + // If neutron starts inside crystal, set entry time to 0. + if (t1 < 0) { + t1 = 0; + } + sort_intersections (&t1, &t2, &i, neutron); + } + } + + for (int j = 0; j < 3; j++) { + neutron->r[j] = position[j]; + neutron->v[j] = speed[j]; + } + } + // Find the number of intersections, and assign the path length through those crystals. + neutron->intersections = 0; + for (int i = 0; i < mono_arr->number_of_crystals; i++) { + if (neutron->intersection_list[i] == -1) { + break; + } + neutron->intersections += 1; + neutron->path_length[i] = neutron->exit_time[i] - neutron->entry_time[i]; + } + } + + /////////////////////////////////////////////////////////////////////////// + /////////////// B0 and BT are values used for the Debye factor + /////////////////////////////////////////////////////////////////////////// + void + calculate_B0_and_BT (struct Monochromator_values* monochromator) { + double x; + monochromator->B0 = 2872.556 / monochromator->atomic_number / monochromator->debye_temperature; + + if (monochromator->temperature_mono > 0.1) + x = monochromator->debye_temperature / monochromator->temperature_mono; + else + x = monochromator->debye_temperature / 0.1; + double phis = calculate_phi_integral (x); + + monochromator->BT = 4 * monochromator->B0 * phis / square (x); + } + + //////////////////////////////////////////////////////////////////////////// + /////////////// The kinematic reflectivity is calculated as in + /////////////// Zachariasen + //////////////////////////////////////////////////////////////////////////// + double + calculate_kinematic_reflectivity (struct Monochromator_values* monochromator, struct neutron_values* neutron) { + double sine_of_bragg_angle = neutron->wavelength / 2 / monochromator->lattice_spacing; + if (sine_of_bragg_angle >= 1) + return 0; // Only do first order reflections + double cosine_of_bragg_angle = sqrt (1 - square (sine_of_bragg_angle)); + double extinction_length = monochromator->lattice_spacing / neutron->wavelength * sqrt (4 * PI / monochromator->Maier_Leibnitz_reflectivity * 100); + // Kinenatic reflectivity = QML*DHKL*sin(theta_B)**2/PI/cos(theta_B) [m⁻1] + double kinematic_reflectivity = monochromator->Maier_Leibnitz_reflectivity; + kinematic_reflectivity *= monochromator->lattice_spacing; + kinematic_reflectivity *= square (sine_of_bragg_angle); + kinematic_reflectivity *= 1 / PI / cosine_of_bragg_angle; + kinematic_reflectivity *= monochromator->Debye_Waller_factor; + // Primary extinction factor, using the approximation + // in G.E Bacon and R.D. Lowde, Acta Cryst. (1948). 1, 303 + + kinematic_reflectivity *= tanh (monochromator->domain_thickness / extinction_length) / monochromator->domain_thickness * extinction_length; + return kinematic_reflectivity; + } + + //////////////////////////////////////////////////////////////////////////// + /////////////// The actual calculations for the att coefficient + /////////////// See the citation for Freund higher up. + //////////////////////////////////////////////////////////////////////////// + double + calculate_attenuation_coefficient (struct Monochromator_values* mono, struct neutron_values* neutron) { + double E = square (neutron->v_size) * VS2E; // Neutron energy in meV + // Get factor for single phonon cross section + + double Bernoulli_sequence[31] = { 1, -0.5, 0.166667, 0, -0.033333, 0, 0.0238095, 0, -0.033333, 0, 0.0757576, 0, -0.253114, 0, 1.16667, 0, + -7.09216, 0, 54.9712, 0, -529.124, 0, 6192.12, 0, -86580.3, 0, 1.42551717e6, 0, -2.7298231e7, 0, 6.01580874e8 }; + double x; + if (mono->temperature_mono - 0.1 <= 0) { + x = mono->debye_temperature / 0.1; + } else { + x = mono->debye_temperature / mono->temperature_mono; + } + double R, Ifact, Xn; + if (x < 6) { + R = 0; + Ifact = 1; + Xn = 1 / x; + // JS: TODO, R may converge quickly, then the loop could be terminated sooner than after 31 steps + for (int i = 0; i < 30; i++) { + R += Bernoulli_sequence[i] * Xn / Ifact / (i + 2.5); + Xn *= x; + Ifact *= i + 1; + } + } else + R = 3.3 / sqrt (x * x * x * x * x * x * x); + + // Define boltzmann_constant in units of (meV/K) + double boltzmann_constant = 0.08617333262; + double DWMF = 1 - exp (-(mono->B0 + mono->BT) * mono->Constant_from_Freund_paper * E / 1000); + // Factor 1000 is to convert Freund constant to meV + // Set the cross sections, as written in freunds paper + mono->nuclear_capture_absorption = mono->incoherent_scattering_cross_section + mono->absorption_for_1AA_Neutrons * neutron->wavelength; + + mono->multiple_phonon_absorption = mono->bound_atom_scattering_cross_section * square (mono->atomic_number / (mono->atomic_number + 1)) * DWMF; + + mono->single_phonon_absorption + = 3 * mono->bound_atom_scattering_cross_section / mono->atomic_number * sqrt (boltzmann_constant * mono->debye_temperature / E) * R; + + double attenuation_coefficient + = (mono->nuclear_capture_absorption + mono->single_phonon_absorption + mono->multiple_phonon_absorption) / mono->volume; // [10^-28m^2/10^-30m^3] + attenuation_coefficient *= 100; // [m^-1] + return attenuation_coefficient; + } + /////////////////////////////////////////////////////////////////////////// + /////////////// Function that retrieves local scattering vector G or tau. + /////////////////////////////////////////////////////////////////////////// + void + calculate_local_scattering_vector (struct Monochromator_values* mono, struct neutron_values* neutron, int* crystal) { + double tau_temp[3] = { mono->tau[0], mono->tau[1], mono->tau[2] }; + + double size_of_in_plane_tau = sqrt (square (mono->tau[0]) + square (mono->tau[2])); + for (int i = 0; i < 3; i++) { + tau_temp[i] += mono->lattice_spacing_gradient_field[i][0] * neutron->r[0] + mono->lattice_spacing_gradient_field[i][1] * neutron->r[1] + + mono->lattice_spacing_gradient_field[i][2] * neutron->r[2]; + } + + double tau_size = sqrt (square (tau_temp[0]) + square (tau_temp[1]) + square (tau_temp[2])); + + // Add the angles of the mosaic block to the scattering vector + neutron->tau[0] + = tau_temp[0] + tau_temp[2] * neutron->horiz_angle[*crystal] - mono->tau[1] * mono->tau[0] / size_of_in_plane_tau * neutron->vert_angle[*crystal]; + neutron->tau[1] = tau_temp[1] + size_of_in_plane_tau * neutron->vert_angle[*crystal]; + neutron->tau[2] + = tau_temp[2] - tau_temp[0] * neutron->horiz_angle[*crystal] - mono->tau[1] * mono->tau[2] / size_of_in_plane_tau * neutron->vert_angle[*crystal]; + + // Renormalize local scat vect + double normalization_factor = tau_size / sqrt (square (neutron->tau[0]) + square (neutron->tau[1]) + square (neutron->tau[2])); + + neutron->tau[0] *= neutron->direction * normalization_factor; + neutron->tau[1] *= neutron->direction * normalization_factor; + neutron->tau[2] *= neutron->direction * normalization_factor; + } + //////////////////////////////////////////////////////////////////////////// + // Function that sets the neutron structs values at a point and speed + //////////////////////////////////////////////////////////////////////////// + void + set_neutron_values (struct neutron_values* neutron, double x, double y, double z, double vx, double vy, double vz) { + neutron->r[0] = x; + neutron->r[1] = y; + neutron->r[2] = z; + neutron->v[0] = vx; + neutron->v[1] = vy; + neutron->v[2] = vz; + neutron->v_size = 0; + neutron->ki_size = 0; + neutron->kf_size = 0; + for (int i = 0; i < 3; i++) { + neutron->ki[i] = neutron->v[i] * V2K; + neutron->ki_size += square (neutron->ki[i]); + neutron->v_size += square (neutron->v[i]); + } + + neutron->v_size = sqrt (neutron->v_size); + neutron->ki_size = sqrt (neutron->ki_size); + neutron->wavelength = 3956 / neutron->v_size; // Wavelength in Angstrom. + } + //////////////////////////////////////////////////////////////////////////// + /////////////// Functions that find epsilon zero and beta. + //////////////////////////////////////////////////////////////////////////// + void + calculate_epszero_and_beta (struct Monochromator_values* mono, struct neutron_values* neutron, int lamella) { + // Update the final wavevector, as well as the size of the reciprocal lattice vector + neutron->tau_size = 0; + neutron->kf_size = 0; + for (int i = 0; i < 3; i++) { + neutron->kf[i] = neutron->ki[i] + neutron->tau[i]; + neutron->tau_size += square (neutron->tau[i]); + neutron->kf_size += square (neutron->kf[i]); + } + + neutron->tau_size = sqrt (neutron->tau_size); + neutron->kf_size = sqrt (neutron->kf_size); + double a = 0; + double b = 0; + // a is the numerator for the angular deviation of the bragg angle. + // a = (ki + tau_0 + tau*gamma)^2 - ki^2 + a = square (neutron->kf_size) - square (neutron->ki_size); + // b is the angle between k_i and tau, muktiplied by the size of each. + // b = tau*(ki + tau_0 + delta nabla tau * ki + k*gamma) + // But only the part that is along the + // direction of the mosaic angle, and therefore it becomes + // tau*k*cos(theta_b) in the paper. + b = neutron->direction * neutron->tau_size + * (neutron->kf[0] * mono->perp_to_tau[0] + neutron->kf[1] * mono->perp_to_tau[1] + neutron->kf[2] * mono->perp_to_tau[2]); + + // Calculate the angular deviation from the Bragg condition + // eps_zero = + neutron->eps_zero[lamella] = -a / (2 * b); + // Calculate gradient of the angular deviation + neutron->beta[lamella] = 0; + + for (int i = 0; i < 3; i++) { + double z = 0; + for (int j = 0; j < 3; j++) { + z += neutron->direction * mono->lattice_spacing_gradient_field[i][j] * neutron->ki[j]; + } + neutron->beta[lamella] += (neutron->ki[i] + mono->tau[i]) * z; + } + neutron->beta[lamella] *= -1 / b / neutron->ki_size; + // These definitions of beta and eps_zero exactly correspond to eq.4 of NIMA paper + } + //////////////////////////////////////////////////////////////////////////// + /////////////// Function that finds the probability + /////////////// that a neutron will reflect + //////////////////////////////////////////////////////////////////////////// + + void + find_propability_of_reflection (struct Monochromator_values* mono, struct neutron_values* neutron, int lamella) { + double kinematic_reflectivity = calculate_kinematic_reflectivity (mono, neutron); + if (mono->type == bent) { + // P = 1 - exp(-Q/(beta)) + neutron->probabilities[lamella] = 1 - exp (-kinematic_reflectivity / fabs (neutron->beta[lamella])); + } else if (mono->type == bent_mosaic) { + // P=1-e^[-Q/beta*(Phi[eps_0/eta + beta k delta/eta] - Phi[eps_0/eta])] + // arg1 = [eps_0/eta + beta k delta/eta] + double arg1 = (neutron->eps_zero[lamella] + neutron->beta[lamella] * neutron->v_size * neutron->path_length[lamella]) / mono->mosaicity_horizontal; + // arg2 = [eps_0/eta] + double arg2 = neutron->eps_zero[lamella] / mono->mosaicity_horizontal; + neutron->probabilities[lamella] = 1 - exp (-kinematic_reflectivity / neutron->beta[lamella] * (normalCDF (arg1, 1) - normalCDF (arg2, 1))); + } + } + + //////////////////////////////////////////////////////////////////////////// + /////////////// Simple function to choose the random angle of the mosaic + /////////////// block + //////////////////////////////////////////////////////////////////////////// + void + choose_mosaic_block_angle (struct Monochromator_values* mono, struct neutron_values* neutron, int* i, _class_particle* particle) { + if (mono->type == bent_mosaic) { + neutron->vert_angle[*i] = random_normal_distribution (&mono->mosaicity_vertical, particle); + neutron->horiz_angle[*i] = random_normal_distribution (&mono->mosaicity_horizontal, particle); + } else { + neutron->vert_angle[*i] = 0; + neutron->horiz_angle[*i] = 0; + } + } + //=================================================================== + //===== FUNCTIONS TO MOVE NEUTRON IN MONOCHROMATOR COORDINATES ====== + //=================================================================== + void + transport_neutron_to_crystal_coordinates (struct Monochromator_values* mono, struct neutron_values* neutron, int* lamella) { + neutron->r[0] += neutron->v[0] * neutron->entry_time[*lamella]; + neutron->r[1] += neutron->v[1] * neutron->entry_time[*lamella]; + neutron->r[2] += neutron->v[2] * neutron->entry_time[*lamella]; + Coordinate_transformation (neutron, mono); + } + + void + propagate_neutrons_to_point_of_reflection (struct neutron_values* neutron) { + neutron->r[0] += neutron->v[0] * neutron->TOR; + neutron->r[1] += neutron->v[1] * neutron->TOR; + neutron->r[2] += neutron->v[2] * neutron->TOR; + } + + // ========================================================================= + //============= START OF OVERVIEW FUNCTIONS CALLED FROM TRACE ============== + //========================================================================== + + void + check_if_neutron_intersects (struct Monochromator_array* mono_arr, struct neutron_values* neutron) { + if (mono_arr->verbosity) { + printf ("Checking if neutron intersects with Monochromator\n"); + } + find_intersections (mono_arr, neutron); + if (neutron->entry_time[0] < 0) { + if (mono_arr->verbosity) { + printf ("!!! POSSIBLE ERROR AT MONOCHROMATOR_BENT!!! \n" + "Neutron enters the crystal at a negative time=%g", + neutron->entry_time[0]); + } + // Different setups may yield this error. + // The default behaviour is then to let the neutron pass through. + neutron->transmit_neutron = 1; + } + if (mono_arr->verbosity) { + for (int i = 0; i < neutron->intersections; i++) { + printf ("Intersection %d: t=%g\n", i, neutron->entry_time[i]); + } + } + } + + // + // ========================================================================= + // + + void + calculate_probabilities_of_reflection (struct Monochromator_array* mono_arr, struct neutron_values* neutron, _class_particle* particle) { + + if (mono_arr->verbosity) { + printf ("Calculating probabilities of reflection\n"); + } + double position[3] = { neutron->r[0], neutron->r[1], neutron->r[2] }; + double speed[3] = { neutron->v[0], neutron->v[1], neutron->v[2] }; + for (int i = 0; i < neutron->intersections; i++) { + struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[i]]; + + transport_neutron_to_crystal_coordinates (mono, neutron, &i); + choose_mosaic_block_angle (mono, neutron, &i, particle); + // It is necessary to calculate the local scattering vector and + // epszero and beta without any horizontal mosaicity, as per the equations. + double mos_temp = neutron->horiz_angle[i]; + neutron->horiz_angle[i] = 0; + calculate_local_scattering_vector (mono, neutron, &i); + calculate_epszero_and_beta (mono, neutron, i); + neutron->horiz_angle[i] = mos_temp; + find_propability_of_reflection (mono, neutron, i); + if (mono_arr->verbosity) { + printf ("Raw probability is %f\n", neutron->probabilities[i]); + } + // Check if reflection would be inside the crystal + // It should only ever not be, when the mono is at 0 mosaicity + if (mono->type == bent) { + neutron->TOR = -neutron->eps_zero[i] / (neutron->ki_size * neutron->beta[i]); + neutron->TOR *= neutron->ki_size / neutron->v_size; + propagate_neutrons_to_point_of_reflection (neutron); + double transposed_x = neutron->r[0] - mono->radius_horizontal; + if (!neutron_is_inside_crystal (&transposed_x, &neutron->r[1], &neutron->r[2], mono)) { + neutron->probabilities[i] = 0; + } + } + if (i == 0 && mono->type == bent && neutron->reflections > 0) { + neutron->probabilities[i] = 0; + // Don't allow double reflections in a perfect crystal + } + + if (i == 0) { + neutron->accu_probs[i] = neutron->probabilities[i]; + } else { + neutron->accu_probs[i] = 1 - (1 - neutron->accu_probs[i - 1]) * (1 - neutron->probabilities[i]); + } + if (mono_arr->verbosity) { + printf ("P(intersection %d)= %f\taccuP=%f\n", i, neutron->probabilities[i], neutron->accu_probs[i]); + } + // Place neutron back to the original position + // wit the original speed and direction + for (int j = 0; j < 3; j++) { + neutron->r[j] = position[j]; + neutron->v[j] = speed[j]; + } + } + } + + // + // ========================================================================= + // + + void + choose_crystal_to_reflect_from (struct Monochromator_array* mono_arr, struct neutron_values* neutron, int* optimize, _class_particle* _particle) { + if (mono_arr->verbosity) { + printf ("Choosing crystal to reflect from\n"); + } + double reflect_condition; + if (neutron->direction > 0 && *optimize) { + reflect_condition = neutron->accu_probs[neutron->intersections - 1] * rand01 (); + } else { + reflect_condition = 1 * rand01 (); + } + neutron->chosen_crystal = 0; // The starting crystal is always 0. + // Find the crystal the neutron reflects from, or the + // final crystal the neutron is in. + while (neutron->accu_probs[neutron->chosen_crystal] <= reflect_condition && neutron->chosen_crystal < neutron->intersections) { + neutron->chosen_crystal += 1; + } + if (mono_arr->verbosity) { + printf ("Chosen crystal = %d\t at refcon=%g, accuprobs=%g\n", neutron->chosen_crystal, reflect_condition, neutron->accu_probs[neutron->chosen_crystal]); + } + } + + // + // ========================================================================= + // + + void + check_if_neutron_should_pass_through (struct Monochromator_array* mono_arr, struct neutron_values* neutron, double* weight, double* weight_init) { + if (mono_arr->verbosity) { + printf ("Checking if neutron should pass through\n"); + } + if (neutron->chosen_crystal == neutron->intersections) { + neutron->transmit_neutron = 1; + neutron->chosen_crystal -= 1; + } else if (*weight * neutron->accu_probs[neutron->chosen_crystal] / *weight_init < 1e-3) { + neutron->transmit_neutron = 1; + } + if (mono_arr->verbosity && neutron->transmit_neutron) { + printf ("Neutron has not reflected\n"); + } + } + + // + // ========================================================================= + // + + void + sample_reflection_time (struct Monochromator_array* mono_arr, struct neutron_values* neutron, _class_particle* _particle) { + if (mono_arr->verbosity) { + printf ("Sampling reflection time\n"); + } + int crystal = neutron->chosen_crystal; + struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[crystal]]; + if (mono->type == bent) { + // Note: This equation can also be solved precisely as a + // quadratic equation in Bragg's law. + neutron->TOR = -neutron->eps_zero[crystal] / (neutron->ki_size * neutron->beta[crystal]); + } else if (mono->type == bent_mosaic) { + double kinematic_reflectivity = calculate_kinematic_reflectivity (mono, neutron); + // TOR = eta/k/beta * Phi^-1 [Phi(eps_0/eta) - + // beta/Q * ln(1-ksi*P(delta_n))] - eps_0/k/beta + // arg1 = eps_0/eta + double arg1 = neutron->eps_zero[crystal] / mono->mosaicity_horizontal; + // log_result = ln(1-ksi*P(delta_n)) + // Done like this to ensure type safety + double log_arg = 1 - rand01 () * neutron->probabilities[crystal]; + double log_result = (double)log ((double)log_arg); + // arg2 = beta/Q * ln(1-ksi*P(delta_n)) + double arg2 = neutron->beta[crystal] / kinematic_reflectivity * log_result; + neutron->TOR = inverseNormalCDF (normalCDF (arg1, 1) - arg2, 1); + neutron->TOR *= mono->mosaicity_horizontal; + neutron->TOR -= neutron->eps_zero[crystal]; + neutron->TOR *= 1 / neutron->beta[crystal] / neutron->ki_size; + } + neutron->TOR *= neutron->ki_size / neutron->v_size; + transport_neutron_to_crystal_coordinates (mono, neutron, &crystal); + propagate_neutrons_to_point_of_reflection (neutron); + double transposed_x = neutron->r[0] - mono->radius_horizontal; + // Check if the neutron is in the monochromator. + // It should only ever not be, when the mono is at 0 mosaicity + // at the point of reflection + if (!neutron_is_inside_crystal (&transposed_x, &neutron->r[1], &neutron->r[2], mono)) { + if (mono_arr->verbosity) { + printf ("ERROR: THE FOUND REFLECTION IS NOT INSIDE CRYSTAL.\n"); + } + neutron->transmit_neutron = 1; + } + if (mono_arr->verbosity) { + printf ("TOR = %g\n", neutron->TOR); + } + } + + // + // ========================================================================= + // + + void + reflect_neutron (struct Monochromator_array* mono_arr, struct neutron_values* neutron, double* speed_x, double* speed_y, double* speed_z, double* weight, + int* optimize) { + if (mono_arr->verbosity) { + printf ("Reflecting neutron\n"); + } + int crystal = neutron->chosen_crystal; + struct Monochromator_values* mono = &mono_arr->crystal[neutron->intersection_list[crystal]]; + double calculated_epsilon = neutron->eps_zero[crystal] + neutron->beta[crystal] * neutron->TOR * neutron->v_size; + neutron->horiz_angle[crystal] = calculated_epsilon; + calculate_local_scattering_vector (mono, neutron, &crystal); + + *speed_x = (neutron->ki[0] + neutron->tau[0]); + *speed_y = (neutron->ki[1] + neutron->tau[1]); + *speed_z = (neutron->ki[2] + neutron->tau[2]); + // Rotate the speed vector back into the original coordinate system from the crystal coordinates system + double new_v[3] = { 0, 0, 0 }; + double transp_mat[3][3]; + rot_transpose (mono->rotation_matrices, transp_mat); + for (int i = 0; i < 3; i++) { + new_v[i] += transp_mat[i][0] * *speed_x; + new_v[i] += transp_mat[i][1] * *speed_y; + new_v[i] += transp_mat[i][2] * *speed_z; + } + *speed_x = new_v[0]; + *speed_y = new_v[1]; + *speed_z = new_v[2]; + + // Renormalize the neutron as we are adding a + // reciprocal lattice vector with a changing + // lattice spacing across the crystal + + double v_size = sqrt (square (*speed_x) + square (*speed_y) + square (*speed_z)); + *speed_x *= neutron->ki_size / v_size * K2V; + *speed_y *= neutron->ki_size / v_size * K2V; + *speed_z *= neutron->ki_size / v_size * K2V; + + if (neutron->direction > 0 && *optimize) { + if (mono_arr->verbosity) { + printf ("p*=%g \n", neutron->accu_probs[neutron->intersections - 1]); + } + *weight *= neutron->accu_probs[neutron->intersections - 1]; + } + + for (int i = 0; i < neutron->chosen_crystal; i++) { + neutron->path += neutron->path_length[i]; + } + neutron->path += neutron->TOR; + neutron->direction *= -1; + neutron->reflections += 1; + } + + // + // ========================================================================= + // + + void + find_new_intersections (struct Monochromator_array* mono_arr, struct neutron_values* neutron) { + if (mono_arr->verbosity) { + printf ("Finding new intersections\n"); + } + find_intersections (mono_arr, neutron); + if (mono_arr->verbosity) { + for (int i = 0; i < neutron->intersections; i++) { + printf ("Intersection %d: t=%g\n", i, neutron->entry_time[i]); + } + } + } + + // + // ========================================================================= + // + + void + attenuate_neutron (struct Monochromator_array* mono_arr, struct neutron_values* neutron, double* p) { + if (mono_arr->verbosity) { + printf ("Attenuating neutron\n"); + } + if (neutron->transmit_neutron == 1) { + for (int i = 0; i < neutron->intersections; i++) { + neutron->path += neutron->path_length[i]; + } + } + double attenuation_coefficient = calculate_attenuation_coefficient (&mono_arr->crystal[0], neutron); + // TODO: This attenuation does not support multiple different crystals in the array. + // It is not currently the use case, and therefore we will live with it. + *p *= exp (-attenuation_coefficient * neutron->path * neutron->v_size); + } +%} + +DECLARE +%{ + int counter; + int counter2; + double curvature; + int MAX_REFLECTIONS; + + struct neutron_values neutron; + struct Monochromator_array mono_arr; +%} + +INITIALIZE +%{ + /////////////////////////////////////////////////////////////////////////// + /////////////// ERROR FUNCTIONS + /////////////////////////////////////////////////////////////////////////// + if (xthickness <= 0) + exit (printf ("Monochromator_Bent: %s: " + "invalid monochromator xthickness=%g\n", + NAME_CURRENT_COMP, xthickness)); + if (zwidth <= 0) + exit (printf ("Monochromator_Bent: %s: " + "invalid monochromator zwidth=%g\n", + NAME_CURRENT_COMP, zwidth)); + if (yheight <= 0) + exit (printf ("Monochromator_Bent: %s: " + "invalid monochromator yheight=%g\n", + NAME_CURRENT_COMP, yheight)); + + int x_pos_mem_flag = 0; + int y_pos_mem_flag = 0; + int z_pos_mem_flag = 0; + int x_rot_mem_flag = 0; + int y_rot_mem_flag = 0; + int z_rot_mem_flag = 0; + double* temp = calloc (n_crystals, sizeof (double)); + if (!x_pos) { + if (verbose) + printf ("X pos is not defined, using 0 as position\n"); + int x_pos_mem_flag = 1; + x_pos = calloc (n_crystals, sizeof (double)); + memcpy (x_pos, temp, n_crystals * sizeof (double)); + } + if (!y_pos) { + if (verbose) + printf ("Y pos is not defined, using 0 as position\n"); + int y_pos_mem_flag = 1; + y_pos = calloc (n_crystals, sizeof (double)); + memcpy (y_pos, temp, n_crystals * sizeof (double)); + } + if (!z_pos) { + if (verbose) + printf ("Z pos is not defined, using 0 as position\n"); + int z_pos_mem_flag = 1; + z_pos = calloc (n_crystals, sizeof (double)); + memcpy (z_pos, temp, n_crystals * sizeof (double)); + } + if (!x_rot) { + if (verbose) + printf ("X rot is not defined, using 0 as rotation\n"); + int x_rot_mem_flag = 1; + x_rot = calloc (n_crystals, sizeof (double)); + memcpy (x_rot, temp, n_crystals * sizeof (double)); + } + if (!y_rot) { + if (verbose) + printf ("Y rot is not defined, using 0 as rotation\n"); + int y_rot_mem_flag = 1; + y_rot = calloc (n_crystals, sizeof (double)); + memcpy (y_rot, temp, n_crystals * sizeof (double)); + } + if (!z_rot) { + if (verbose) + printf ("Z rot is not defined, using 0 as rotation\n"); + int z_rot_mem_flag = 1; + z_rot = calloc (n_crystals, sizeof (double)); + memcpy (z_rot, temp, n_crystals * sizeof (double)); + } + if (verbose) + for (int i = 0; i < 1; i++) { + printf ("x,y,z,rot=(%g,%g,%g,%g,%g,%g)\n", x_pos[i], y_pos[i], z_pos[i], x_rot[i], y_rot[i], z_rot[i]); + } + if (verbose) { + printf ("Monochromator_Bent output: " + "Component name is %s:\n", + NAME_CURRENT_COMP); + } + //////////////////////////////////////////////////////////////////////////// + /////////////// INITIALIZING PARAMETERS + //////////////////////////////////////////////////////////////////////////// + mono_arr.crystal = (struct Monochromator_values*)malloc (n_crystals * sizeof (struct Monochromator_values)); + mono_arr.number_of_crystals = n_crystals; // [#] + mono_arr.verbosity = verbose; // [#] + for (int i = 0; i < n_crystals; i++) { + // // Initialize angles of the Monochromator + if (radius_x > 0) { + mono_arr.crystal[i].max_angle = PI + asin (zwidth / (2 * radius_x)); + mono_arr.crystal[i].min_angle = PI - asin (zwidth / (2 * radius_x)); + } else if (radius_x < 0) { + mono_arr.crystal[i].max_angle = -asin (zwidth / (2 * radius_x)); + mono_arr.crystal[i].min_angle = asin (zwidth / (2 * radius_x)); + } + mono_arr.crystal[i].angle_range = mono_arr.crystal[i].max_angle - mono_arr.crystal[i].min_angle; + // Figure out the type of Monochromator + if (radius_x) + mono_arr.crystal[i].type = bent; + if (mosaicity) + mono_arr.crystal[i].type = mosaic; + if (mosaicity && radius_x) + mono_arr.crystal[i].type = bent_mosaic; + if (!radius_x && !mosaicity) + mono_arr.crystal[i].type = flat; + // Read the designated plane of reflection, for use in the Monochromator. + enum crystal_plane plane = stringToEnum ((const char*)&plane_of_reflection); + // Set Monochromator values + mono_arr.crystal[i].length = zwidth; // [m] + mono_arr.crystal[i].height = yheight; // [m] + mono_arr.crystal[i].thickness = xthickness; // [m] + mono_arr.crystal[i].radius_horizontal = radius_x; // [m] + mono_arr.crystal[i].radius_vertical = radius_y; // [m] + mono_arr.crystal[i].radius_inner = fabs (mono_arr.crystal[i].radius_horizontal) - mono_arr.crystal[i].thickness / 2; // [m] + mono_arr.crystal[i].radius_outer = fabs (mono_arr.crystal[i].radius_horizontal) + mono_arr.crystal[i].thickness / 2; // [m] + double arrowheight = mono_arr.crystal[i].radius_outer * (1 - cos (mono_arr.crystal[i].angle_range / 2)); // sagita of circles + mono_arr.crystal[i].bounding_box_thickness = mono_arr.crystal[i].thickness + 2 * arrowheight; + mono_arr.crystal[i].domain_thickness = domainthickness; // [] + mono_arr.crystal[i].temperature_mono = temperature; // [T] + mono_arr.crystal[i].lattice_spacing = crystal_table[plane][0]; // [A] + mono_arr.crystal[i].Maier_Leibnitz_reflectivity = crystal_table[plane][1] * 100; // [A^-1 m^-1] + mono_arr.crystal[i].bound_atom_scattering_cross_section = crystal_table[plane][2]; // [barn] + mono_arr.crystal[i].absorption_for_1AA_Neutrons = crystal_table[plane][3]; // [barn*A^-1] + mono_arr.crystal[i].incoherent_scattering_cross_section = crystal_table[plane][4]; // [barn] + mono_arr.crystal[i].volume = crystal_table[plane][5]; // [A^-3] + mono_arr.crystal[i].atomic_number = crystal_table[plane][6]; // [#] + mono_arr.crystal[i].debye_temperature = crystal_table[plane][7]; // [K] + mono_arr.crystal[i].Constant_from_Freund_paper = crystal_table[plane][8]; //[A^-2 eV^-1] + mono_arr.crystal[i].poisson_ratio = crystal_table[plane][9]; // [] + calculate_B0_and_BT (&mono_arr.crystal[i]); + mono_arr.crystal[i].Debye_Waller_factor = exp (-(mono_arr.crystal[i].B0 + mono_arr.crystal[i].BT) / 2 / square (mono_arr.crystal[i].lattice_spacing)); + + mono_arr.crystal[i].x = x_pos[i]; + mono_arr.crystal[i].y = y_pos[i]; + mono_arr.crystal[i].z = z_pos[i]; + double xrot = x_rot[i] * DEG2RAD; + double yrot = y_rot[i] * DEG2RAD; + double zrot = z_rot[i] * DEG2RAD; + rot_set_rotation (mono_arr.crystal[i].rotation_matrices, xrot, yrot, zrot); + rot_set_rotation (mono_arr.crystal[i].neg_rotation_matrix, -xrot, -yrot, -zrot); + if (verbose) { + printf ("%d'th crystal\nrot_x=%g\trot_y=%g\trot_z=%g\n" + "tr_x=%g\ttr_y=%g\ttr_z=%g\n", + i, x_rot[i], y_rot[i], z_rot[i], x_pos[i], y_pos[i], z_pos[i]); + } + + // Set the mosaicity if relevant + if (mono_arr.crystal[i].type == mosaic || mono_arr.crystal[i].type == bent_mosaic) { + // Input mosaicity is in arc min. Convert to Degrees and then to radians + // (And multiply with R8LN2 which I don't know what is). + // Is it because of input being fwhm instead of sigma? + double R8LN2 = 2.354820045; + mono_arr.crystal[i].mosaicity_horizontal = mosaicity / 60 * DEG2RAD / R8LN2; + mono_arr.crystal[i].mosaicity_vertical = mono_arr.crystal[i].mosaicity_horizontal * mosaic_anisotropy; + } + // Initialize reciprocal lattice vector G or tau in some texts, and perp_to_tau. + + double chi = angle_to_cut_horizontal * DEG2RAD; + + double tau_size_zero = 2 * PI / mono_arr.crystal[i].lattice_spacing; + + mono_arr.crystal[i].tau[0] = tau_size_zero * cos (chi); + mono_arr.crystal[i].tau[1] = 0; + mono_arr.crystal[i].tau[2] = tau_size_zero * sin (chi); + + mono_arr.crystal[i].perp_to_tau[0] = sin (chi); + mono_arr.crystal[i].perp_to_tau[1] = 0; + mono_arr.crystal[i].perp_to_tau[2] = -cos (chi); + + // Initialize lattice_spacing_gradient_field + curvature = 1 / mono_arr.crystal[i].radius_horizontal; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][0] = -mono_arr.crystal[i].poisson_ratio * cos (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][1] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][2] = sin (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][0] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][1] + = mono_arr.crystal[i].radius_vertical != 0 ? tau_size_zero * cos (chi) / mono_arr.crystal[i].radius_vertical : 0; + ; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][2] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][0] = sin (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][1] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][2] = -cos (chi) * tau_size_zero * curvature; + } + + // Initialize neutron structs values + neutron.beta = (double*)calloc (n_crystals, sizeof (double)); + neutron.eps_zero = (double*)calloc (n_crystals, sizeof (double)); + neutron.vert_angle = (double*)calloc (n_crystals, sizeof (double)); + neutron.horiz_angle = (double*)calloc (n_crystals, sizeof (double)); + neutron.path_length = (double*)calloc (n_crystals, sizeof (double)); + neutron.entry_time = (double*)calloc (n_crystals, sizeof (double)); + neutron.exit_time = (double*)calloc (n_crystals, sizeof (double)); + neutron.probabilities = (double*)calloc (n_crystals, sizeof (double)); + neutron.accu_probs = (double*)calloc (n_crystals, sizeof (double)); + neutron.intersection_list = (int*)calloc (n_crystals, sizeof (int)); + neutron.n = n_crystals; + neutron.direction = 1; // Default direction is going away from the instrument + counter = 0; + counter2 = 0; + MAX_REFLECTIONS = 100; // Chosen maximum number of reflections + + // Free the position and rotations memories + if (x_pos_mem_flag) + free (x_pos); + if (y_pos_mem_flag) + free (y_pos); + if (z_pos_mem_flag) + free (z_pos); + if (x_rot_mem_flag) + free (x_rot); + if (y_rot_mem_flag) + free (y_rot); + if (z_rot_mem_flag) + free (z_rot); +%} + +TRACE +%{ + // Initialize variables for use in TRACE + int final_reflection = 0; + neutron.path = 0; + neutron.reflections = 0; + int neutron_is_inside_crystal = 1; + double weight_init = p; + if (weight_init <= 0.0) + ABSORB; + neutron.transmit_neutron = 0; + neutron.direction = 1; + set_neutron_values (&neutron, x, y, z, vx, vy, vz); + if (verbose) { + printf ("\nNEW NEUTRON STARTED\n"); + } + check_if_neutron_intersects (&mono_arr, &neutron); + + while (neutron_is_inside_crystal) { + calculate_probabilities_of_reflection (&mono_arr, &neutron, _particle); + choose_crystal_to_reflect_from (&mono_arr, &neutron, &optimize, _particle); + check_if_neutron_should_pass_through (&mono_arr, &neutron, &p, &weight_init); + if (neutron.reflections > MAX_REFLECTIONS) { + neutron.transmit_neutron = 1; + } + if (neutron.transmit_neutron) { + break; + } + final_reflection = neutron.chosen_crystal; + sample_reflection_time (&mono_arr, &neutron, _particle); + // Let neutron pass through if point of reflection is outside of crystal + if (neutron.transmit_neutron) { + break; + } + PROP_DT (neutron.TOR + neutron.entry_time[neutron.chosen_crystal]); + SCATTER; + reflect_neutron (&mono_arr, &neutron, &vx, &vy, &vz, &p, &optimize); + set_neutron_values (&neutron, x, y, z, vx, vy, vz); // Update speeds and wavevectors + find_new_intersections (&mono_arr, &neutron); + } + attenuate_neutron (&mono_arr, &neutron, &p); +%} + +FINALLY +%{ + // Finally free the neutron + free (neutron.beta); + free (neutron.eps_zero); + free (neutron.vert_angle); + free (neutron.horiz_angle); + free (neutron.path_length); + free (neutron.entry_time); + free (neutron.exit_time); + free (neutron.probabilities); + free (neutron.accu_probs); + free (neutron.intersection_list); + + free (mono_arr.crystal); +%} + + +MCDISPLAY +%{ + double x_inner[2]; + double x_outer[2]; + double y_top; + double y_bottom; + double z_inner[2]; + double z_outer[2]; + double points[8][3]; + // We draw the monochromator by drawing lines between chosen points. + // For this reason we need to move the points, + // in accordance to their position in the array. + for (int j = 0; j < n_crystals; j++) { + if (draw_as_rectangles) { + break; + } + struct Monochromator_values* mono = &mono_arr.crystal[j]; + double max_i = 5; + double i = 0; + // double inner_radii = fabs(mono->radius_horizontal) - xthickness/2; + // double outer_radii = inner_radii + xthickness; + double angle0, angle1, movex, movey, movez; + y_top = yheight / 2; + y_bottom = -yheight / 2; + for (i = 0; i < max_i - 0.2; i = i + 0.2) { + angle0 = i / max_i * mono->angle_range + mono->min_angle; + angle1 = (i + 0.2) / max_i * mono->angle_range + mono->min_angle; + // Define the 8 coordinates of the n'th box in the crystal + x_inner[0] = (radius_x) + cos (angle0) * mono->radius_inner; + x_inner[1] = (radius_x) + cos (angle1) * mono->radius_inner; + + z_inner[0] = -sin (angle0) * mono->radius_inner; + z_inner[1] = -sin (angle1) * mono->radius_inner; + + x_outer[0] = (radius_x) + cos (angle0) * mono->radius_outer; + x_outer[1] = (radius_x) + cos (angle1) * mono->radius_outer; + + z_outer[0] = -sin (angle0) * mono->radius_outer; + z_outer[1] = -sin (angle1) * mono->radius_outer; + // These 8 coordinates define 8 points. Coordinate transform these + // to the current crystal + rotate_all_points (&x_inner[0], &x_outer[0], &x_inner[1], &x_outer[1], &y_top, &y_bottom, &z_inner[0], &z_outer[0], &z_inner[1], &z_outer[1], points, mono); + // Draw a box in th xy plane + multiline (5, points[0][0], points[0][1], points[0][2], points[2][0], points[2][1], points[2][2], points[3][0], points[3][1], points[3][2], points[1][0], + points[1][1], points[1][2], points[0][0], points[0][1], points[0][2]); + + // Draw curving parts of crystal in the zx plane + line (points[0][0], points[0][1], points[0][2], points[4][0], points[4][1], points[4][2]); + line (points[1][0], points[1][1], points[1][2], points[5][0], points[5][1], points[5][2]); + line (points[2][0], points[2][1], points[2][2], points[6][0], points[6][1], points[6][2]); + line (points[3][0], points[3][1], points[3][2], points[7][0], points[7][1], points[7][2]); + } + // Draw a final box in the xy plane + multiline (5, points[4][0], points[4][1], points[4][2], points[6][0], points[6][1], points[6][2], points[7][0], points[7][1], points[7][2], points[5][0], + points[5][1], points[5][2], points[4][0], points[4][1], points[4][2]); + } + + // line(0,0,0, + // -mono.perp_to_tau[0], -mono.perp_to_tau[1], -mono.perp_to_tau[2]); + if (draw_as_rectangles) { + for (int crystal = 0; crystal < n_crystals; crystal++) { + double origo[3] = { 0, 0, 0 }; + rotate_point (origo, &mono_arr.crystal[crystal]); + // Set the box + box (origo[0], origo[1], origo[2], xthickness, yheight, zwidth, xthickness, 0, 0, 0); + } + } +%} + +END + + diff --git a/mcstas-comps/contrib/Monochromator_bent_complex.comp b/mcstas-comps/contrib/Monochromator_bent_complex.comp index b1f572344..7d960fa66 100755 --- a/mcstas-comps/contrib/Monochromator_bent_complex.comp +++ b/mcstas-comps/contrib/Monochromator_bent_complex.comp @@ -1,344 +1,326 @@ -/******************************************************************************* -* -* McStas, neutron ray-tracing package -* Copyright 1997-2002, All rights reserved -* Risoe National Laboratory, Roskilde, Denmark -* Institut Laue Langevin, Grenoble, France -* -* Component: Monochromator_bent_complex -* -* %I -* Written by: Daniel Lomholt Christensen with help from Jan Šaroun -* Date: 2 August 2025 -* Origin: ILL/NBI -* -* A bent crystal monochromator. Based on the model implemented by Jan Šaroun in NIMA 529 (2004) pp 162-165. Mosacity and bending radius can be set. -* -* %D -* This component is a more complex implementation of Monochromator_bent. -* This component only differs in the fact that it allows and forces the user -* to set every single parameter for every single crystal in the crystal array. -* -* -* %Parameters -* INPUT PARAMETERS: -* zwidth: [m] Width of each crystal without bending. -* yheight: [m] Height of each crystal without bending. -* xthickness: [m] Thickness of each crystal without bending. -* radius_x: [m] Radius of the circle the monochromator bends on in the plane. Can be negative. -* radius_y: [m] Radius of the (very large) circle the monochromator bends on as a side effect of the horizontal bending. The code assumes that it is so small that it does not affect the points of intersection appreciatively of the crystal. -* plane_of_reflection: ["Si400"] The plane of reflection from the material. The list of possible reflections can be seen in the source code. -* angle_to_cut_horizontal: [degrees] Angle between cut and normal of crystal slab, horizontally -* mosaicity: [arcmin] Gaussian mosaicity of the crystal. Always the horizontal mosaicity -* mosaic_anisotropy: [1] Anisotropy of the mosaicity, changes vertical mosaicity to be mosaic_anisotropy*mosaicity -* n_crystals: [#] Number of crystals in your array. -* domainthickness: [mu-m] Thickness of the crystal domains. -* temperature: [K]Temperature of the monochromator in Kelvin. -* optimize: [ ] Flag to tell if the component should optimize for reflections or not. -* x_pos: [vector] x-Position of each crystal -* y_pos: [vector] y-Position of each crystal -* z_pos: [vector] z-Position of each crystal -* x_rot: [vector] Rotation around x-axis for each crystal -* y_rot: [vector] Rotation around y-axis for each crystal -* z_rot: [vector] Rotation around z-axis for each crystal NOTE: Rotations happen around x, then y, then z. -* verbose: [ ] Verbosity of the monochromator. Used for debugging. -* draw_as_rectangles: [ ] Draw the monochromators as boxes. DOES NOT WORK WHEN USING _rot parameters. -* -* %L -* Jan Šaroun NIM A Volume 529, Issue 1-3 (2004), pp162-165 -* -* %E -*******************************************************************************/ -DEFINE COMPONENT Monochromator_bent_complex -SETTING PARAMETERS (vector zwidth=NULL, - vector yheight=NULL, - vector xthickness=NULL, - vector radius_x=NULL, - vector radius_y=NULL, - vector angle_to_cut_horizontal=NULL, - vector mosaicity=NULL, - vector mosaic_anisotropy=NULL, - vector domainthickness=NULL, - vector temperature=NULL, - string plane_of_reflection="Si400", - vector x_pos=NULL, - vector y_pos=NULL, - vector z_pos=NULL, - vector x_rot=NULL, - vector y_rot=NULL, - vector z_rot=NULL, - int n_crystals=1, - int optimize=0, - int verbose=0, - int draw_as_rectangles=0) -// Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) -NOACC -// The component is currently "NOACC" only, there are thread race-conditions on GPU - -SHARE INHERIT Monochromator_bent -DECLARE -%{ - int counter; - int counter2; - double curvature; - int MAX_REFLECTIONS; - struct neutron_values neutron; - struct Monochromator_array mono_arr; -%} - -INITIALIZE -%{ - - if (verbose) - for (int i=0;i<1;i++){ - printf("x,y,z,rot=(%g,%g,%g,%g,%g,%g)\n", - x_pos[i],y_pos[i],z_pos[i],x_rot[i],y_rot[i],z_rot[i]); - } - if (verbose){ - printf("Monochromator_Bent output: " - "Component name is %s:\n", NAME_CURRENT_COMP); - } - //////////////////////////////////////////////////////////////////////////// - /////////////// INITIALIZING PARAMETERS - //////////////////////////////////////////////////////////////////////////// - mono_arr.crystal = (struct Monochromator_values*) malloc(n_crystals * sizeof(struct Monochromator_values)); - mono_arr.number_of_crystals = n_crystals; // [#] - mono_arr.verbosity = verbose; // [#] - - // Separate the string into individual crystals - int MAX_TOKENS = 6*n_crystals; - - char** planes = malloc(n_crystals*sizeof(char*)); - if (planes == NULL) { - exit(fprintf(stderr, "Error: memory allocation failed for planes\n")); - } - int token_count = 0; - // Remove trailing newline, if any - plane_of_reflection[strcspn(plane_of_reflection, "\n")] = '\0'; - - // Tokenize the string using ';' as delimiter - char *plane = strtok(plane_of_reflection, ";"); - while (plane != NULL && token_count < MAX_TOKENS) { - planes[token_count++] = plane; - plane = strtok(NULL, ";"); - } - - // Print the tokens - if (mono_arr.verbosity){ - printf("\nPlanes:\n"); - for (int i = 0; i < token_count; ++i) { - printf("[%d]: %s\n", i, planes[i]); - } - } - - for (int i=0; i0){ - mono_arr.crystal[i].max_angle = PI + asin(zwidth[i]/(2*radius_x[i])); - mono_arr.crystal[i].min_angle = PI - asin(zwidth[i]/(2*radius_x[i])); - } else if (radius_x[i]<0){ - mono_arr.crystal[i].max_angle = -asin(zwidth[i]/(2*radius_x[i])); - mono_arr.crystal[i].min_angle = asin(zwidth[i]/(2*radius_x[i])); - } - mono_arr.crystal[i].angle_range = mono_arr.crystal[i].max_angle - mono_arr.crystal[i].min_angle; - // Figure out the type of Monochromator - if (radius_x[i]) mono_arr.crystal[i].type=bent; - if (mosaicity[i]) mono_arr.crystal[i].type = mosaic; - if ((mosaicity[i]>0) && (fabs(radius_x[i])>0)) mono_arr.crystal[i].type = bent_mosaic; - // Read the designated plane of reflection, for use in the Monochromator. - enum crystal_plane plane = stringToEnum((const char *)planes[i]); - // Set Monochromator values - mono_arr.crystal[i].length = zwidth[i]; // [m] - mono_arr.crystal[i].height = yheight[i]; // [m] - mono_arr.crystal[i].thickness = xthickness[i]; // [m] - mono_arr.crystal[i].radius_horizontal = radius_x[i]; // [m] - mono_arr.crystal[i].radius_vertical = radius_y[i]; // [m] - mono_arr.crystal[i].radius_inner = fabs(mono_arr.crystal[i].radius_horizontal) - mono_arr.crystal[i].thickness/2; // [m] - mono_arr.crystal[i].radius_outer = fabs(mono_arr.crystal[i].radius_horizontal) + mono_arr.crystal[i].thickness/2; // [m] - double arrowheight = mono_arr.crystal[i].radius_outer*(1-cos(mono_arr.crystal[i].angle_range/2)); //sagita of circles - mono_arr.crystal[i].bounding_box_thickness = mono_arr.crystal[i].thickness + 2*arrowheight; - mono_arr.crystal[i].domain_thickness = domainthickness[i]; // [] - mono_arr.crystal[i].temperature_mono = temperature[i]; // [T] - mono_arr.crystal[i].lattice_spacing = crystal_table[plane][0]; // [A] - - mono_arr.crystal[i].Maier_Leibnitz_reflectivity = crystal_table[plane][1]*100; // [A^-1 m^-1] - mono_arr.crystal[i].bound_atom_scattering_cross_section = crystal_table[plane][2]; // [barn] - mono_arr.crystal[i].absorption_for_1AA_Neutrons = crystal_table[plane][3];// [barn*A^-1] - mono_arr.crystal[i].incoherent_scattering_cross_section = crystal_table[plane][4];// [barn] - mono_arr.crystal[i].volume = crystal_table[plane][5]; // [A^-3] - mono_arr.crystal[i].atomic_number = crystal_table[plane][6]; // [#] - mono_arr.crystal[i].debye_temperature = crystal_table[plane][7]; // [K] - mono_arr.crystal[i].Constant_from_Freund_paper = crystal_table[plane][8]; //[A^-2 eV^-1] - mono_arr.crystal[i].poisson_ratio = crystal_table[plane][9]; // [] - calculate_B0_and_BT(&mono_arr.crystal[i]); - mono_arr.crystal[i].Debye_Waller_factor = exp(-(mono_arr.crystal[i].B0 + mono_arr.crystal[i].BT)/2/square(mono_arr.crystal[i].lattice_spacing)); - - mono_arr.crystal[i].x = x_pos[i]; - mono_arr.crystal[i].y = y_pos[i]; - mono_arr.crystal[i].z = z_pos[i]; - double xrot = x_rot[i] * DEG2RAD; - double yrot = y_rot[i] * DEG2RAD; - double zrot = z_rot[i] * DEG2RAD; - rot_set_rotation(mono_arr.crystal[i].rotation_matrices, xrot, yrot, zrot); - rot_set_rotation(mono_arr.crystal[i].neg_rotation_matrix, -xrot, -yrot, -zrot); - if (verbose){ - printf("%d'th crystal\nrot_x=%g\trot_y=%g\trot_z=%g\n" - "tr_x=%g\ttr_y=%g\ttr_z=%g\n",i, - xrot, yrot, zrot, - x_pos[i], y_pos[i], z_pos[i] - ); - } - - - //Set the mosaicity if relevant - if (mono_arr.crystal[i].type == mosaic || mono_arr.crystal[i].type == bent_mosaic){ - //Input mosaicity is in arc min. Convert to Degrees and then to radians - // (And multiply with R8LN2 which I don't know what is). - // Is it because of input being fwhm instead of sigma? - double R8LN2 = 2.354820045; - mono_arr.crystal[i].mosaicity_horizontal = mosaicity[i]/60*DEG2RAD/R8LN2; - mono_arr.crystal[i].mosaicity_vertical = mono_arr.crystal[i].mosaicity_horizontal*mosaic_anisotropy[i]; - } - // Initialize reciprocal lattice vector G or tau in some texts, and perp_to_tau. - - double chi = angle_to_cut_horizontal[i]*DEG2RAD; - - double tau_size_zero = 2*PI/mono_arr.crystal[i].lattice_spacing; - - mono_arr.crystal[i].tau[0] = tau_size_zero*cos(chi); - mono_arr.crystal[i].tau[1] = 0; - mono_arr.crystal[i].tau[2] = tau_size_zero*sin(chi); - - mono_arr.crystal[i].perp_to_tau[0] = sin(chi); - mono_arr.crystal[i].perp_to_tau[1] = 0; - mono_arr.crystal[i].perp_to_tau[2] = -cos(chi); - - // Initialize lattice_spacing_gradient_field - curvature = 1/mono_arr.crystal[i].radius_horizontal; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][0] = -mono_arr.crystal[i].poisson_ratio*cos(chi)*tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][1] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[0][2] = sin(chi) - *tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][0] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][1] = mono_arr.crystal[i].radius_vertical!=0 ? tau_size_zero*cos(chi)/mono_arr.crystal[i].radius_vertical : 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[1][2] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][0] = sin(chi) - *tau_size_zero*curvature; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][1] = 0; - mono_arr.crystal[i].lattice_spacing_gradient_field[2][2] = -cos(chi) - *tau_size_zero*curvature; - } - free(planes); - //TODO: This is very gpu unfriendly. Should be changed to depend on OPENACC usage - // Initialize neutron structs values - neutron.beta = (double*) calloc (n_crystals, sizeof(double)); - neutron.eps_zero = (double*) calloc (n_crystals, sizeof(double)); - neutron.vert_angle = (double*) calloc (n_crystals, sizeof(double)); - neutron.horiz_angle = (double*) calloc (n_crystals, sizeof(double)); - neutron.path_length = (double*) calloc (n_crystals, sizeof(double)); - neutron.entry_time = (double*) calloc (n_crystals, sizeof(double)); - neutron.exit_time = (double*) calloc (n_crystals, sizeof(double)); - neutron.probabilities = (double*) calloc (n_crystals, sizeof(double)); - neutron.accu_probs = (double*) calloc (n_crystals, sizeof(double)); - neutron.intersection_list = (int*) calloc (n_crystals, sizeof(int)); - neutron.n = n_crystals; - neutron.direction = 1; // Default direction is going away from the instrument - counter = 0; - counter2 = 0; - MAX_REFLECTIONS = 100; // Chosen maximum number of reflections -%} - -TRACE INHERIT Monochromator_bent - -FINALLY INHERIT Monochromator_bent - - -MCDISPLAY -%{ - double x_inner [2]; - double x_outer [2]; - double y_top; - double y_bottom; - double z_inner [2]; - double z_outer [2]; - double points[8][3]; - // We draw the monochromator by drawing lines between chosen points. - // For this reason we need to move the points, - // in accordance to their position in the array. - for (int j=0; jradius_horizontal) - xthickness/2; - // double outer_radii = inner_radii + xthickness; - double angle0, angle1, movex, movey, movez; - y_top = mono->height/2; - y_bottom = -mono->height/2; - for (i = 0; i < max_i-0.2; i = i + 0.2) { - angle0 = i/max_i*mono->angle_range + mono->min_angle; - angle1 = (i+0.2)/max_i*mono->angle_range + mono->min_angle; - // Define the 8 coordinates of the n'th box in the crystal - x_inner[0] = mono->radius_horizontal + cos(angle0)*mono->radius_inner; - x_inner[1] = mono->radius_horizontal + cos(angle1)*mono->radius_inner; - - z_inner[0] = -sin(angle0)*mono->radius_inner; - z_inner[1] = -sin(angle1)*mono->radius_inner; - - x_outer[0] = mono->radius_horizontal + cos(angle0)*mono->radius_outer; - x_outer[1] = mono->radius_horizontal + cos(angle1)*mono->radius_outer; - - z_outer[0] = -sin(angle0)*mono->radius_outer; - z_outer[1] = -sin(angle1)*mono->radius_outer; - // These 8 coordinates define 8 points. Coordinate transform these - // to the current crystal - rotate_all_points(&x_inner[0], &x_outer[0], - &x_inner[1], &x_outer[1], - &y_top, &y_bottom, - &z_inner[0], &z_outer[0], - &z_inner[1], &z_outer[1], - points, mono); - // Draw a box in th xy plane - multiline(5, - points[0][0],points[0][1],points[0][2], - points[2][0],points[2][1],points[2][2], - points[3][0],points[3][1],points[3][2], - points[1][0],points[1][1],points[1][2], - points[0][0],points[0][1],points[0][2]); - - // Draw curving parts of crystal in the zx plane - line(points[0][0], points[0][1], points[0][2], - points[4][0], points[4][1], points[4][2]); - line(points[1][0], points[1][1], points[1][2], - points[5][0], points[5][1], points[5][2]); - line(points[2][0], points[2][1], points[2][2], - points[6][0], points[6][1], points[6][2]); - line(points[3][0], points[3][1], points[3][2], - points[7][0], points[7][1], points[7][2]); - } - // Draw a final box in the xy plane - multiline(5, - points[4][0],points[4][1],points[4][2], - points[6][0],points[6][1],points[6][2], - points[7][0],points[7][1],points[7][2], - points[5][0],points[5][1],points[5][2], - points[4][0],points[4][1],points[4][2]); - - } - - // line(0,0,0, - // -mono.perp_to_tau[0], -mono.perp_to_tau[1], -mono.perp_to_tau[2]); - if (draw_as_rectangles){ - for (int crystal=0; crystalthickness,mono->height,mono->length,mono->thickness,0,0,0); - } - } -%} - -END - - +/******************************************************************************* +* +* McStas, neutron ray-tracing package +* Copyright 1997-2002, All rights reserved +* Risoe National Laboratory, Roskilde, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Component: Monochromator_bent_complex +* +* %I +* Written by: Daniel Lomholt Christensen with help from Jan Šaroun +* Date: 2 August 2025 +* Origin: ILL/NBI +* +* A bent crystal monochromator. Based on the model implemented by Jan Šaroun in NIMA 529 (2004) pp 162-165. Mosacity and bending radius can be set. +* +* %D +* This component is a more complex implementation of Monochromator_bent. +* This component only differs in the fact that it allows and forces the user +* to set every single parameter for every single crystal in the crystal array. +* +* +* %Parameters +* INPUT PARAMETERS: +* zwidth: [m] Width of each crystal without bending. +* yheight: [m] Height of each crystal without bending. +* xthickness: [m] Thickness of each crystal without bending. +* radius_x: [m] Radius of the circle the monochromator bends on in the plane. Can be negative. +* radius_y: [m] Radius of the (very large) circle the monochromator bends on as a side effect of the horizontal bending. The code assumes that it is so small that it does not affect the points of intersection appreciatively of the crystal. +* plane_of_reflection: ["Si400"] The plane of reflection from the material. The list of possible reflections can be seen in the source code. +* angle_to_cut_horizontal: [degrees] Angle between cut and normal of crystal slab, horizontally +* mosaicity: [arcmin] Gaussian mosaicity of the crystal. Always the horizontal mosaicity +* mosaic_anisotropy: [1] Anisotropy of the mosaicity, changes vertical mosaicity to be mosaic_anisotropy*mosaicity +* n_crystals: [#] Number of crystals in your array. +* domainthickness: [mu-m] Thickness of the crystal domains. +* temperature: [K]Temperature of the monochromator in Kelvin. +* optimize: [ ] Flag to tell if the component should optimize for reflections or not. +* x_pos: [vector] x-Position of each crystal +* y_pos: [vector] y-Position of each crystal +* z_pos: [vector] z-Position of each crystal +* x_rot: [vector] Rotation around x-axis for each crystal +* y_rot: [vector] Rotation around y-axis for each crystal +* z_rot: [vector] Rotation around z-axis for each crystal NOTE: Rotations happen around x, then y, then z. +* verbose: [ ] Verbosity of the monochromator. Used for debugging. +* draw_as_rectangles: [ ] Draw the monochromators as boxes. DOES NOT WORK WHEN USING _rot parameters. +* +* %L +* Jan Šaroun NIM A Volume 529, Issue 1-3 (2004), pp162-165 +* +* %E +*******************************************************************************/ +DEFINE COMPONENT Monochromator_bent_complex +SETTING PARAMETERS (vector zwidth=NULL, + vector yheight=NULL, + vector xthickness=NULL, + vector radius_x=NULL, + vector radius_y=NULL, + vector angle_to_cut_horizontal=NULL, + vector mosaicity=NULL, + vector mosaic_anisotropy=NULL, + vector domainthickness=NULL, + vector temperature=NULL, + string plane_of_reflection="Si400", + vector x_pos=NULL, + vector y_pos=NULL, + vector z_pos=NULL, + vector x_rot=NULL, + vector y_rot=NULL, + vector z_rot=NULL, + int n_crystals=1, + int optimize=0, + int verbose=0, + int draw_as_rectangles=0) +// Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) +NOACC +// The component is currently "NOACC" only, there are thread race-conditions on GPU + +SHARE INHERIT Monochromator_bent +DECLARE +%{ + int counter; + int counter2; + double curvature; + int MAX_REFLECTIONS; + struct neutron_values neutron; + struct Monochromator_array mono_arr; +%} + +INITIALIZE +%{ + + if (verbose) + for (int i = 0; i < 1; i++) { + printf ("x,y,z,rot=(%g,%g,%g,%g,%g,%g)\n", x_pos[i], y_pos[i], z_pos[i], x_rot[i], y_rot[i], z_rot[i]); + } + if (verbose) { + printf ("Monochromator_Bent output: " + "Component name is %s:\n", + NAME_CURRENT_COMP); + } + //////////////////////////////////////////////////////////////////////////// + /////////////// INITIALIZING PARAMETERS + //////////////////////////////////////////////////////////////////////////// + mono_arr.crystal = (struct Monochromator_values*)malloc (n_crystals * sizeof (struct Monochromator_values)); + mono_arr.number_of_crystals = n_crystals; // [#] + mono_arr.verbosity = verbose; // [#] + + // Separate the string into individual crystals + int MAX_TOKENS = 6 * n_crystals; + + char** planes = malloc (n_crystals * sizeof (char*)); + if (planes == NULL) { + exit (fprintf (stderr, "Error: memory allocation failed for planes\n")); + } + int token_count = 0; + // Remove trailing newline, if any + plane_of_reflection[strcspn (plane_of_reflection, "\n")] = '\0'; + + // Tokenize the string using ';' as delimiter + char* plane = strtok (plane_of_reflection, ";"); + while (plane != NULL && token_count < MAX_TOKENS) { + planes[token_count++] = plane; + plane = strtok (NULL, ";"); + } + + // Print the tokens + if (mono_arr.verbosity) { + printf ("\nPlanes:\n"); + for (int i = 0; i < token_count; ++i) { + printf ("[%d]: %s\n", i, planes[i]); + } + } + + for (int i = 0; i < n_crystals; i++) { + // // Initialize angles of the Monochromator + if (radius_x[i] > 0) { + mono_arr.crystal[i].max_angle = PI + asin (zwidth[i] / (2 * radius_x[i])); + mono_arr.crystal[i].min_angle = PI - asin (zwidth[i] / (2 * radius_x[i])); + } else if (radius_x[i] < 0) { + mono_arr.crystal[i].max_angle = -asin (zwidth[i] / (2 * radius_x[i])); + mono_arr.crystal[i].min_angle = asin (zwidth[i] / (2 * radius_x[i])); + } + mono_arr.crystal[i].angle_range = mono_arr.crystal[i].max_angle - mono_arr.crystal[i].min_angle; + // Figure out the type of Monochromator + if (radius_x[i]) + mono_arr.crystal[i].type = bent; + if (mosaicity[i]) + mono_arr.crystal[i].type = mosaic; + if ((mosaicity[i] > 0) && (fabs (radius_x[i]) > 0)) + mono_arr.crystal[i].type = bent_mosaic; + // Read the designated plane of reflection, for use in the Monochromator. + enum crystal_plane plane = stringToEnum ((const char*)planes[i]); + // Set Monochromator values + mono_arr.crystal[i].length = zwidth[i]; // [m] + mono_arr.crystal[i].height = yheight[i]; // [m] + mono_arr.crystal[i].thickness = xthickness[i]; // [m] + mono_arr.crystal[i].radius_horizontal = radius_x[i]; // [m] + mono_arr.crystal[i].radius_vertical = radius_y[i]; // [m] + mono_arr.crystal[i].radius_inner = fabs (mono_arr.crystal[i].radius_horizontal) - mono_arr.crystal[i].thickness / 2; // [m] + mono_arr.crystal[i].radius_outer = fabs (mono_arr.crystal[i].radius_horizontal) + mono_arr.crystal[i].thickness / 2; // [m] + double arrowheight = mono_arr.crystal[i].radius_outer * (1 - cos (mono_arr.crystal[i].angle_range / 2)); // sagita of circles + mono_arr.crystal[i].bounding_box_thickness = mono_arr.crystal[i].thickness + 2 * arrowheight; + mono_arr.crystal[i].domain_thickness = domainthickness[i]; // [] + mono_arr.crystal[i].temperature_mono = temperature[i]; // [T] + mono_arr.crystal[i].lattice_spacing = crystal_table[plane][0]; // [A] + + mono_arr.crystal[i].Maier_Leibnitz_reflectivity = crystal_table[plane][1] * 100; // [A^-1 m^-1] + mono_arr.crystal[i].bound_atom_scattering_cross_section = crystal_table[plane][2]; // [barn] + mono_arr.crystal[i].absorption_for_1AA_Neutrons = crystal_table[plane][3]; // [barn*A^-1] + mono_arr.crystal[i].incoherent_scattering_cross_section = crystal_table[plane][4]; // [barn] + mono_arr.crystal[i].volume = crystal_table[plane][5]; // [A^-3] + mono_arr.crystal[i].atomic_number = crystal_table[plane][6]; // [#] + mono_arr.crystal[i].debye_temperature = crystal_table[plane][7]; // [K] + mono_arr.crystal[i].Constant_from_Freund_paper = crystal_table[plane][8]; //[A^-2 eV^-1] + mono_arr.crystal[i].poisson_ratio = crystal_table[plane][9]; // [] + calculate_B0_and_BT (&mono_arr.crystal[i]); + mono_arr.crystal[i].Debye_Waller_factor = exp (-(mono_arr.crystal[i].B0 + mono_arr.crystal[i].BT) / 2 / square (mono_arr.crystal[i].lattice_spacing)); + + mono_arr.crystal[i].x = x_pos[i]; + mono_arr.crystal[i].y = y_pos[i]; + mono_arr.crystal[i].z = z_pos[i]; + double xrot = x_rot[i] * DEG2RAD; + double yrot = y_rot[i] * DEG2RAD; + double zrot = z_rot[i] * DEG2RAD; + rot_set_rotation (mono_arr.crystal[i].rotation_matrices, xrot, yrot, zrot); + rot_set_rotation (mono_arr.crystal[i].neg_rotation_matrix, -xrot, -yrot, -zrot); + if (verbose) { + printf ("%d'th crystal\nrot_x=%g\trot_y=%g\trot_z=%g\n" + "tr_x=%g\ttr_y=%g\ttr_z=%g\n", + i, xrot, yrot, zrot, x_pos[i], y_pos[i], z_pos[i]); + } + + // Set the mosaicity if relevant + if (mono_arr.crystal[i].type == mosaic || mono_arr.crystal[i].type == bent_mosaic) { + // Input mosaicity is in arc min. Convert to Degrees and then to radians + // (And multiply with R8LN2 which I don't know what is). + // Is it because of input being fwhm instead of sigma? + double R8LN2 = 2.354820045; + mono_arr.crystal[i].mosaicity_horizontal = mosaicity[i] / 60 * DEG2RAD / R8LN2; + mono_arr.crystal[i].mosaicity_vertical = mono_arr.crystal[i].mosaicity_horizontal * mosaic_anisotropy[i]; + } + // Initialize reciprocal lattice vector G or tau in some texts, and perp_to_tau. + + double chi = angle_to_cut_horizontal[i] * DEG2RAD; + + double tau_size_zero = 2 * PI / mono_arr.crystal[i].lattice_spacing; + + mono_arr.crystal[i].tau[0] = tau_size_zero * cos (chi); + mono_arr.crystal[i].tau[1] = 0; + mono_arr.crystal[i].tau[2] = tau_size_zero * sin (chi); + + mono_arr.crystal[i].perp_to_tau[0] = sin (chi); + mono_arr.crystal[i].perp_to_tau[1] = 0; + mono_arr.crystal[i].perp_to_tau[2] = -cos (chi); + + // Initialize lattice_spacing_gradient_field + curvature = 1 / mono_arr.crystal[i].radius_horizontal; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][0] = -mono_arr.crystal[i].poisson_ratio * cos (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][1] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[0][2] = sin (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][0] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][1] + = mono_arr.crystal[i].radius_vertical != 0 ? tau_size_zero * cos (chi) / mono_arr.crystal[i].radius_vertical : 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[1][2] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][0] = sin (chi) * tau_size_zero * curvature; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][1] = 0; + mono_arr.crystal[i].lattice_spacing_gradient_field[2][2] = -cos (chi) * tau_size_zero * curvature; + } + free (planes); + // TODO: This is very gpu unfriendly. Should be changed to depend on OPENACC usage + // Initialize neutron structs values + neutron.beta = (double*)calloc (n_crystals, sizeof (double)); + neutron.eps_zero = (double*)calloc (n_crystals, sizeof (double)); + neutron.vert_angle = (double*)calloc (n_crystals, sizeof (double)); + neutron.horiz_angle = (double*)calloc (n_crystals, sizeof (double)); + neutron.path_length = (double*)calloc (n_crystals, sizeof (double)); + neutron.entry_time = (double*)calloc (n_crystals, sizeof (double)); + neutron.exit_time = (double*)calloc (n_crystals, sizeof (double)); + neutron.probabilities = (double*)calloc (n_crystals, sizeof (double)); + neutron.accu_probs = (double*)calloc (n_crystals, sizeof (double)); + neutron.intersection_list = (int*)calloc (n_crystals, sizeof (int)); + neutron.n = n_crystals; + neutron.direction = 1; // Default direction is going away from the instrument + counter = 0; + counter2 = 0; + MAX_REFLECTIONS = 100; // Chosen maximum number of reflections +%} + +TRACE INHERIT Monochromator_bent + +FINALLY INHERIT Monochromator_bent + + +MCDISPLAY +%{ + double x_inner[2]; + double x_outer[2]; + double y_top; + double y_bottom; + double z_inner[2]; + double z_outer[2]; + double points[8][3]; + // We draw the monochromator by drawing lines between chosen points. + // For this reason we need to move the points, + // in accordance to their position in the array. + for (int j = 0; j < n_crystals; j++) { + if (draw_as_rectangles) { + break; + } + struct Monochromator_values* mono = &mono_arr.crystal[j]; + double max_i = 5; + double i = 0; + // double inner_radii = fabs(mono->radius_horizontal) - xthickness/2; + // double outer_radii = inner_radii + xthickness; + double angle0, angle1, movex, movey, movez; + y_top = mono->height / 2; + y_bottom = -mono->height / 2; + for (i = 0; i < max_i - 0.2; i = i + 0.2) { + angle0 = i / max_i * mono->angle_range + mono->min_angle; + angle1 = (i + 0.2) / max_i * mono->angle_range + mono->min_angle; + // Define the 8 coordinates of the n'th box in the crystal + x_inner[0] = mono->radius_horizontal + cos (angle0) * mono->radius_inner; + x_inner[1] = mono->radius_horizontal + cos (angle1) * mono->radius_inner; + + z_inner[0] = -sin (angle0) * mono->radius_inner; + z_inner[1] = -sin (angle1) * mono->radius_inner; + + x_outer[0] = mono->radius_horizontal + cos (angle0) * mono->radius_outer; + x_outer[1] = mono->radius_horizontal + cos (angle1) * mono->radius_outer; + + z_outer[0] = -sin (angle0) * mono->radius_outer; + z_outer[1] = -sin (angle1) * mono->radius_outer; + // These 8 coordinates define 8 points. Coordinate transform these + // to the current crystal + rotate_all_points (&x_inner[0], &x_outer[0], &x_inner[1], &x_outer[1], &y_top, &y_bottom, &z_inner[0], &z_outer[0], &z_inner[1], &z_outer[1], points, mono); + // Draw a box in th xy plane + multiline (5, points[0][0], points[0][1], points[0][2], points[2][0], points[2][1], points[2][2], points[3][0], points[3][1], points[3][2], points[1][0], + points[1][1], points[1][2], points[0][0], points[0][1], points[0][2]); + + // Draw curving parts of crystal in the zx plane + line (points[0][0], points[0][1], points[0][2], points[4][0], points[4][1], points[4][2]); + line (points[1][0], points[1][1], points[1][2], points[5][0], points[5][1], points[5][2]); + line (points[2][0], points[2][1], points[2][2], points[6][0], points[6][1], points[6][2]); + line (points[3][0], points[3][1], points[3][2], points[7][0], points[7][1], points[7][2]); + } + // Draw a final box in the xy plane + multiline (5, points[4][0], points[4][1], points[4][2], points[6][0], points[6][1], points[6][2], points[7][0], points[7][1], points[7][2], points[5][0], + points[5][1], points[5][2], points[4][0], points[4][1], points[4][2]); + } + + // line(0,0,0, + // -mono.perp_to_tau[0], -mono.perp_to_tau[1], -mono.perp_to_tau[2]); + if (draw_as_rectangles) { + for (int crystal = 0; crystal < n_crystals; crystal++) { + struct Monochromator_values* mono = &mono_arr.crystal[crystal]; + double origo[3] = { 0, 0, 0 }; + rotate_point (origo, mono); + // Set the box + box (origo[0], origo[1], origo[2], mono->thickness, mono->height, mono->length, mono->thickness, 0, 0, 0); + } + } +%} + +END + + diff --git a/mcstas-comps/contrib/MultiDiskChopper.comp b/mcstas-comps/contrib/MultiDiskChopper.comp index 89b5e0e50..54b556cc7 100644 --- a/mcstas-comps/contrib/MultiDiskChopper.comp +++ b/mcstas-comps/contrib/MultiDiskChopper.comp @@ -74,276 +74,261 @@ SETTING PARAMETERS (string slit_center="0 180", string slit_width="10 20", nslit DECLARE %{ -double T; -double To; -double omega; -double *dslit_center; -double *dhslit_width; -double *t0; -double *t1; + double T; + double To; + double omega; + double* dslit_center; + double* dhslit_width; + double* t0; + double* t1; %} INITIALIZE %{ -char *pch; -int i; -double sense; - -phase = remainder(phase,360.0)*DEG2RAD; - omega = 2.0*PI*nu; /* rad/s */ - sense = (omega<0) ? -1 : 1 ; - - if (isfirst && (nrev-floor(nrev)!=0) ) - { MPI_MASTER(fprintf(stderr,"MultiDiskChopper: %s: wrong First chopper revolution number, must be integer (nrev=%g)\n", NAME_CURRENT_COMP, nrev);) - exit(-1); } - - if (!omega) { - MPI_MASTER(fprintf(stderr,"MultiDiskChopper: %s WARNING: chopper frequency is 0!\n", NAME_CURRENT_COMP);) - omega = 1e-15; /* We should actually use machine epsilon here... */ - } - - if (nslits<=0) - { MPI_MASTER(fprintf(stderr,"MultiDiskChopper: %s: nslits must be > 0\n", NAME_CURRENT_COMP); - exit(-1);) } - - // Read slits in array - dslit_center = malloc(nslits*sizeof(*dslit_center)); - pch = strtok(slit_center, ";_, "); - for (i=0; i= 360.0) ) { - while (dslit_center[i] >= 360.0) - { - dslit_center[i] -= 360.0; - } - - MPI_MASTER(fprintf(stderr,"MultiDiskChopper: %s: WARNING: Slit center No. %d moved to %f\n", NAME_CURRENT_COMP, i+1, dslit_center[i]);) - } - - dslit_center[i] *= DEG2RAD; + char* pch; + int i; + double sense; + + phase = remainder (phase, 360.0) * DEG2RAD; + omega = 2.0 * PI * nu; /* rad/s */ + sense = (omega < 0) ? -1 : 1; + + if (isfirst && (nrev - floor (nrev) != 0)) { + MPI_MASTER (fprintf (stderr, "MultiDiskChopper: %s: wrong First chopper revolution number, must be integer (nrev=%g)\n", NAME_CURRENT_COMP, nrev);) + exit (-1); + } + + if (!omega) { + MPI_MASTER (fprintf (stderr, "MultiDiskChopper: %s WARNING: chopper frequency is 0!\n", NAME_CURRENT_COMP);) + omega = 1e-15; /* We should actually use machine epsilon here... */ + } + + if (nslits <= 0) { + MPI_MASTER (fprintf (stderr, "MultiDiskChopper: %s: nslits must be > 0\n", NAME_CURRENT_COMP); exit (-1);) + } + + // Read slits in array + dslit_center = malloc (nslits * sizeof (*dslit_center)); + pch = strtok (slit_center, ";_, "); + for (i = 0; i < nslits; i++) { + if (pch == NULL) { + MPI_MASTER (fprintf (stderr, "MultiDiskChopper: %s: Cannot parse slit_center: Not enough values?\n", NAME_CURRENT_COMP);) + exit (-1); + } + dslit_center[i] = atof (pch); + pch = strtok (NULL, ";_, "); + + if ((dslit_center[i] < 0)) { + while (dslit_center[i] < 0) { + dslit_center[i] += 360.0; } - - // dhslit_width: HALF slit width - dhslit_width = malloc(nslits*sizeof(*dhslit_width)); - pch = strtok(slit_width, ";_, "); - for (i=0; i= 360.0)) { + while (dslit_center[i] >= 360.0) { + dslit_center[i] -= 360.0; } - - // generate times t0 = time when slit i starts opening (at top of the disk) (minus t1[i-1] if !equal) - t0 = malloc(nslits*sizeof(*t0)); - t0[0] = ( sense*remainder(dslit_center[0]-phase,2*PI) - dhslit_width[0] ) / fabs(omega); - - for (i=1; i 0 ) { - // 'anormal' case, chopper above guide - // mirror coordinate system - xprime = -x; - yprime = -y+delta_y; - } else { - // 'normal' case, chopper below guide - xprime = x; - yprime = y-delta_y; - } - - // Is neutron transmitted/absorbed outside the disk diameter ? - if ( ( SQR(xprime) + SQR(yprime) ) > SQR(radius) ) - if (abs_out) { - ABSORB; + double phi; + double xprime, yprime; + double toff; + int irev, islit; + + // Propagate into the chopper disk plane + PROP_Z0; + + if (delta_y > 0) { + // 'anormal' case, chopper above guide + // mirror coordinate system + xprime = -x; + yprime = -y + delta_y; + } else { + // 'normal' case, chopper below guide + xprime = x; + yprime = y - delta_y; + } + + // Is neutron transmitted/absorbed outside the disk diameter ? + if ((SQR (xprime) + SQR (yprime)) > SQR (radius)) + if (abs_out) { + ABSORB; + } else { + SCATTER; + } + else { + if (isfirst) { + irev = (nrev > 0 ? ratio * (floor ((2 * nrev + 1) * rand01 ()) - nrev) : 0); + + if (equal) { + // Distribute neutrons equally over slits + t = rand01 () * nslits; + islit = (t == nslits) ? nslits - 1 : floor (t); + t = (t - islit) * t1[islit]; + + p *= t1[islit] / T * nslits; } else { - SCATTER; + // Distribute neutrons proportional to slit size + t = rand01 () * To; + islit = 0; + while (t1[islit] < t) + islit++; + + /* weight correction: chopper slits transmission opening time per full revolution time */ + p *= To / T; } - else - { - if (isfirst) { - irev = (nrev > 0 ? ratio*( floor((2*nrev+1)*rand01()) - nrev ) : 0); - - if (equal) { - // Distribute neutrons equally over slits - t = rand01() * nslits; - islit = (t==nslits) ? nslits-1 : floor(t); - t = (t-islit) * t1[islit]; - - p *= t1[islit] / T * nslits; - } else { - // Distribute neutrons proportional to slit size - t = rand01() * To; - islit = 0; - while (t1[islit] < t) - islit++; - - /* weight correction: chopper slits transmission opening time per full revolution time */ - p *= To / T; - } - - // offset time stamp according to slit phase, neutron position and jitter - t += t0[islit] - atan2(xprime,yprime)/omega + irev*T + ( jitter ? jitter*randnorm() : 0 ); - - } else { - - // where does the neutron hit the disk ? - phi = atan2(xprime,yprime) + omega*( t - delay - ( jitter ? jitter*randnorm() : 0 ) ) ; - - // does the neutron hit one of the slits ? - islit=0; - while (islit -#include -#include -#include -#endif + #ifndef GSL_VERSION + #include + #include + #include + #include + #endif %} DECLARE %{ -double xmin; -double xmax; -double zmin; -double zmax; -double tx; -double ty; -double tz; + double xmin; + double xmax; + double zmin; + double zmax; + double tx; + double ty; + double tz; %} INITIALIZE %{ -if (frac_inc>0) { + if (frac_inc > 0) { if (!(ythick) || !(mu_inc)) { - fprintf(stderr,"Multilayer: error: %s: You requested a non-meaningful combination of frac_inc, ythick, mu_inc. EXIT\n", NAME_CURRENT_COMP); - exit(1); + fprintf (stderr, "Multilayer: error: %s: You requested a non-meaningful combination of frac_inc, ythick, mu_inc. EXIT\n", NAME_CURRENT_COMP); + exit (1); } } - xmin = -xwidth/2.0; - xmax = xwidth/2.0; - zmin = -zlength/2.0; - zmax = zlength/2.0; + xmin = -xwidth / 2.0; + xmax = xwidth / 2.0; + zmin = -zlength / 2.0; + zmax = zlength / 2.0; if (target_index) { Coords ToTarget; - ToTarget = coords_sub(POS_A_COMP_INDEX(INDEX_CURRENT_COMP+target_index),POS_A_CURRENT_COMP); - ToTarget = rot_apply(ROT_A_CURRENT_COMP, ToTarget); - coords_get(ToTarget, &tx, &ty, &tz); + ToTarget = coords_sub (POS_A_COMP_INDEX (INDEX_CURRENT_COMP + target_index), POS_A_CURRENT_COMP); + ToTarget = rot_apply (ROT_A_CURRENT_COMP, ToTarget); + coords_get (ToTarget, &tx, &ty, &tz); } else { - tx = 0; ty = 0; tz = 0; + tx = 0; + ty = 0; + tz = 0; } - %} TRACE %{ - double dt,q,n1,n2,pfn,R0,lambda,theta,s0,c0,kx,ky,kz,t0,t1,t2,l_i,l_o,v, solid_angle; + double dt, q, n1, n2, pfn, R0, lambda, theta, s0, c0, kx, ky, kz, t0, t1, t2, l_i, l_o, v, solid_angle; double intersect = 0; /* First check if neutron has the right direction. */ /* calculate time to reach the mirror i.e. y=0*/ - if(vy != 0.0 && (dt = -y/vy) >= 0) - { + if (vy != 0.0 && (dt = -y / vy) >= 0) { double old_x = x, old_y = y, old_z = z; - //printf("x %g y %g z %g vx %g vy %g vz %g \n",x,y,z,vx,vy,vz); - x += vx*dt; - //y += vy*dt; - z += vz*dt; - y=0; + // printf("x %g y %g z %g vx %g vy %g vz %g \n",x,y,z,vx,vy,vz); + x += vx * dt; + // y += vy*dt; + z += vz * dt; + y = 0; /* Now check if neutron intersects mirror. */ - if(x >= xmin && x <= xmax && z >= zmin && z <= zmax) - { + if (x >= xmin && x <= xmax && z >= zmin && z <= zmax) { // Incoherent scattering from substrate or coherent scattering from thin film? - if (rand01()0) && (focus_yh>0)) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, tx, ty, tz, focus_xw, focus_yh, ROT_A_CURRENT_COMP); - } else { - if (tx == ty == tz == 0) { - ty = 1e-9; - } - randvec_target_circle(&vx, &vy, &vz, &solid_angle, tx, ty, tz, 0); - } - NORM(vx, vy, vz); - vx *= v; - vy *= v; - vz *= v; - intersect = box_intersect(&t0, &t2, x, y, z, vx, vy, vz, xwidth, ythick, zlength); - if (intersect) { - l_o = v*t2; - p *= (l_i+l_o)*(mu_inc/100.0)*exp(mu_inc*(l_i+l_o)/100.0); - p /= 4*PI/solid_angle; - p /= frac_inc; - } else { - // Kill neutron! - printf("Could not hit sample from inside. ABSORBED\n"); - ABSORB; - } - } else { // Otherwise simply leave alone - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); - } + if (rand01 () < frac_inc) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + // This part is basically from V_sample + + intersect = box_intersect (&t0, &t2, x, y + ythick / 2.0, z, vx, vy, vz, xwidth, ythick, zlength); + if (intersect) { + if (t0 < 0) + ABSORB; /* we already passed the sample; this is illegal */ + dt = rand01 () * (t2 - t0); /* Time of scattering (relative to t0) */ + PROP_DT (dt + t0); + SCATTER; + v = sqrt (vx * vx + vy * vy + vz * vz); + l_i = v * dt; /* Penetration in sample until scattering */ + + // If target comp and focus area set, work with that. Otherwise scatter in 4PI + if (target_index && (focus_xw > 0) && (focus_yh > 0)) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, tx, ty, tz, focus_xw, focus_yh, ROT_A_CURRENT_COMP); + } else { + if (tx == ty == tz == 0) { + ty = 1e-9; + } + randvec_target_circle (&vx, &vy, &vz, &solid_angle, tx, ty, tz, 0); + } + NORM (vx, vy, vz); + vx *= v; + vy *= v; + vz *= v; + intersect = box_intersect (&t0, &t2, x, y, z, vx, vy, vz, xwidth, ythick, zlength); + if (intersect) { + l_o = v * t2; + p *= (l_i + l_o) * (mu_inc / 100.0) * exp (mu_inc * (l_i + l_o) / 100.0); + p /= 4 * PI / solid_angle; + p /= frac_inc; + } else { + // Kill neutron! + printf ("Could not hit sample from inside. ABSORBED\n"); + ABSORB; + } + } else { // Otherwise simply leave alone + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } } else { -// -// If neutron intersect mirror calculate reflectivity from a thin -// film using simple fresnel coefficients formula found in e.g. Born and Wolf -// this could be generalised to many layers using the matrix formalism -// but we'll get this bit to work first. -// - double dbl0,dbl1,tvar; - int arrsize=nlayer+2; - int i; - int j; - - gsl_complex rnf,rnf1; - gsl_complex a12t,a22t,cr,c0,ci; - gsl_complex btm,btm1,cbtm,cbtm1; - gsl_complex ac1,ac2,ac3,ac4; - gsl_complex cans,tcvar1,tcvar2,tcvar3,tcvar4; - - gsl_matrix_complex * ris = gsl_matrix_complex_alloc(500,1); - gsl_matrix_complex * pfn = gsl_matrix_complex_alloc(500,1); - gsl_matrix_complex * betan = gsl_matrix_complex_alloc(500,1); - gsl_matrix_complex * a1 = gsl_matrix_complex_alloc(2,2); - gsl_matrix_complex * a2 = gsl_matrix_complex_alloc(2,2); - gsl_matrix_complex * a3 = gsl_matrix_complex_alloc(2,2); - - t += dt; - //q = fabs(2*vy*V2Q); - kx = vx*V2K; - ky = vy*V2K; - kz = vz*V2K; - lambda = 2*PI/sqrt(kx*kx+ky*ky+kz*kz); - theta = atan(fabs(old_y)/fabs(z-old_z)); - - double lsq=lambda*lambda; - double tpi=2*PI; - double tlc=8.0*PI*PI/lsq; - - double st0 = sin(theta); - double ct0 = cos(theta); - dbl0=0.0; - dbl1=1.0; - cr=gsl_complex_rect(dbl1,dbl0); - ci=gsl_complex_rect(dbl0,dbl1); - c0=gsl_complex_rect(dbl0,dbl0); - a12t=c0; - a22t=c0; - - for(i=0; i< nlayer+2; i++) - { - tcvar1=gsl_complex_rect(1.0 - (lsq * sldPar[i] / tpi),dbl0); - gsl_matrix_complex_set(ris,i,0,tcvar1); - } - - gsl_matrix_complex_set(pfn,0,0,gsl_complex_mul_real(gsl_matrix_complex_get(ris,0,0),st0)); - rnf1=gsl_complex_mul(gsl_matrix_complex_get(ris,0,0),gsl_matrix_complex_get(ris,0,0)); - if(nlayer > 0){ - for(i=1;i 0) { + for (i = 1; i < nlayer + 1; i++) { + rnf = gsl_complex_mul (gsl_matrix_complex_get (ris, i, 0), gsl_matrix_complex_get (ris, i, 0)); + tcvar1 = gsl_complex_sub (rnf, gsl_complex_mul_real (rnf1, ct0 * ct0)); + gsl_matrix_complex_set (pfn, i, 0, gsl_complex_sqrt (tcvar1)); + } + } + tcvar1 = gsl_matrix_complex_get (ris, nlayer + 1, 0); + rnf = gsl_complex_mul (tcvar1, tcvar1); + tcvar1 = gsl_complex_sub (rnf, gsl_complex_mul_real (rnf1, ct0 * ct0)); + gsl_matrix_complex_set (pfn, nlayer + 1, 0, gsl_complex_sqrt (tcvar1)); + + if (nlayer > 0) { + for (i = 0; i < nlayer; i++) { + tcvar1 = gsl_matrix_complex_get (pfn, i + 1, 0); + gsl_matrix_complex_set (betan, i + 1, 0, gsl_complex_mul_real (tcvar1, tpi * dPar[i] / lambda)); + } + } + + gsl_matrix_complex_set (a1, 0, 0, cr); + tcvar1 = gsl_matrix_complex_get (pfn, 0, 0); + tcvar2 = gsl_matrix_complex_get (pfn, 1, 0); + if (GSL_REAL (gsl_complex_add (tcvar1, tcvar2)) != 0.0 || GSL_IMAG (gsl_complex_add (tcvar1, tcvar2)) != 0.0) { + a12t = gsl_complex_div (gsl_complex_sub (tcvar1, tcvar2), gsl_complex_add (tcvar1, tcvar2)); + } else { + a12t = c0; + } + tcvar3 = gsl_complex_mul (tcvar1, tcvar2); + tcvar4 = gsl_complex_mul_real (tcvar3, -1.0 * tlc * sigmaPar[0] * sigmaPar[0]); + gsl_matrix_complex_set (a1, 0, 1, gsl_complex_mul (a12t, gsl_complex_exp (tcvar4))); + gsl_matrix_complex_set (a1, 1, 0, gsl_matrix_complex_get (a1, 0, 1)); + gsl_matrix_complex_set (a1, 1, 1, cr); + + if (nlayer > 0) { + if (nrepeats > 1) { + for (j = 1; j < nrepeats - 1; j++) { + for (i = 1; i < nlayer; i++) { + btm = gsl_complex_mul (gsl_matrix_complex_get (betan, i, 0), ci); + btm1 = gsl_complex_mul (gsl_complex_mul_real (gsl_matrix_complex_get (betan, i, 0), -1.0), ci); + cbtm = gsl_complex_exp (btm); + cbtm1 = gsl_complex_exp (btm1); + gsl_matrix_complex_set (a2, 0, 0, cbtm); + tcvar1 = gsl_matrix_complex_get (pfn, i, 0); + tcvar2 = gsl_matrix_complex_get (pfn, i + 1, 0); + if (GSL_REAL (gsl_complex_add (tcvar1, tcvar2)) != 0.0 || GSL_IMAG (gsl_complex_add (tcvar1, tcvar2)) != 0.0) { + a22t = gsl_complex_div (gsl_complex_sub (tcvar1, tcvar2), gsl_complex_add (tcvar1, tcvar2)); + } else { + a22t = c0; + } + tcvar3 = gsl_complex_mul (tcvar1, tcvar2); + tcvar4 = gsl_complex_mul_real (tcvar3, -1.0 * tlc * sigmaPar[i] * sigmaPar[i]); + a22t = gsl_complex_mul (a22t, gsl_complex_exp (tcvar4)); + gsl_matrix_complex_set (a2, 0, 1, gsl_complex_mul (a22t, cbtm)); + gsl_matrix_complex_set (a2, 1, 0, gsl_complex_mul (a22t, cbtm1)); + gsl_matrix_complex_set (a2, 1, 1, cbtm1); + + tcvar1 = gsl_matrix_complex_get (a1, 0, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 0)); + tcvar3 = gsl_matrix_complex_get (a1, 0, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 0)); + gsl_matrix_complex_set (a3, 0, 0, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 0, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 1)); + tcvar3 = gsl_matrix_complex_get (a1, 0, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 1)); + gsl_matrix_complex_set (a3, 0, 1, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 1, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 0)); + tcvar3 = gsl_matrix_complex_get (a1, 1, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 0)); + gsl_matrix_complex_set (a3, 1, 0, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 1, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 1)); + tcvar3 = gsl_matrix_complex_get (a1, 1, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 1)); + gsl_matrix_complex_set (a3, 1, 1, gsl_complex_add (tcvar2, tcvar4)); + + gsl_matrix_complex_set (a1, 0, 0, gsl_matrix_complex_get (a3, 0, 0)); + gsl_matrix_complex_set (a1, 0, 1, gsl_matrix_complex_get (a3, 0, 1)); + gsl_matrix_complex_set (a1, 1, 0, gsl_matrix_complex_get (a3, 1, 0)); + gsl_matrix_complex_set (a1, 1, 1, gsl_matrix_complex_get (a3, 1, 1)); + } + } // Exit the nrepeats block and do the final repeat with the substrate + for (i = 1; i < nlayer + 1; i++) { + btm = gsl_complex_mul (gsl_matrix_complex_get (betan, i, 0), ci); + btm1 = gsl_complex_mul (gsl_complex_mul_real (gsl_matrix_complex_get (betan, i, 0), -1.0), ci); + cbtm = gsl_complex_exp (btm); + cbtm1 = gsl_complex_exp (btm1); + gsl_matrix_complex_set (a2, 0, 0, cbtm); + tcvar1 = gsl_matrix_complex_get (pfn, i, 0); + tcvar2 = gsl_matrix_complex_get (pfn, i + 1, 0); + if (GSL_REAL (gsl_complex_add (tcvar1, tcvar2)) != 0.0 || GSL_IMAG (gsl_complex_add (tcvar1, tcvar2)) != 0.0) { + a22t = gsl_complex_div (gsl_complex_sub (tcvar1, tcvar2), gsl_complex_add (tcvar1, tcvar2)); + } else { + a22t = c0; + } + tcvar3 = gsl_complex_mul (tcvar1, tcvar2); + tcvar4 = gsl_complex_mul_real (tcvar3, -1.0 * tlc * sigmaPar[i] * sigmaPar[i]); + a22t = gsl_complex_mul (a22t, gsl_complex_exp (tcvar4)); + gsl_matrix_complex_set (a2, 0, 1, gsl_complex_mul (a22t, cbtm)); + gsl_matrix_complex_set (a2, 1, 0, gsl_complex_mul (a22t, cbtm1)); + gsl_matrix_complex_set (a2, 1, 1, cbtm1); + + tcvar1 = gsl_matrix_complex_get (a1, 0, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 0)); + tcvar3 = gsl_matrix_complex_get (a1, 0, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 0)); + gsl_matrix_complex_set (a3, 0, 0, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 0, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 1)); + tcvar3 = gsl_matrix_complex_get (a1, 0, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 1)); + gsl_matrix_complex_set (a3, 0, 1, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 1, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 0)); + tcvar3 = gsl_matrix_complex_get (a1, 1, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 0)); + gsl_matrix_complex_set (a3, 1, 0, gsl_complex_add (tcvar2, tcvar4)); + + tcvar1 = gsl_matrix_complex_get (a1, 1, 0); + tcvar2 = gsl_complex_mul (tcvar1, gsl_matrix_complex_get (a2, 0, 1)); + tcvar3 = gsl_matrix_complex_get (a1, 1, 1); + tcvar4 = gsl_complex_mul (tcvar3, gsl_matrix_complex_get (a2, 1, 1)); + gsl_matrix_complex_set (a3, 1, 1, gsl_complex_add (tcvar2, tcvar4)); + + gsl_matrix_complex_set (a1, 0, 0, gsl_matrix_complex_get (a3, 0, 0)); + gsl_matrix_complex_set (a1, 0, 1, gsl_matrix_complex_get (a3, 0, 1)); + gsl_matrix_complex_set (a1, 1, 0, gsl_matrix_complex_get (a3, 1, 0)); + gsl_matrix_complex_set (a1, 1, 1, gsl_matrix_complex_get (a3, 1, 1)); } - } - tcvar1=gsl_matrix_complex_get(ris,nlayer+1,0); - rnf=gsl_complex_mul(tcvar1,tcvar1); - tcvar1=gsl_complex_sub(rnf,gsl_complex_mul_real(rnf1,ct0*ct0)); - gsl_matrix_complex_set(pfn,nlayer + 1,0,gsl_complex_sqrt(tcvar1)); - - if(nlayer > 0){ - for(i=0;i 0){ - if(nrepeats > 1){ - for(j=1;j0) { - p /= (1-frac_inc); - } - SCATTER; - - gsl_matrix_complex_free(ris); - gsl_matrix_complex_free(pfn); - gsl_matrix_complex_free(betan); - gsl_matrix_complex_free(a1); - gsl_matrix_complex_free(a2); - gsl_matrix_complex_free(a3); + } + ac1 = gsl_matrix_complex_get (a1, 1, 0); + ac2 = gsl_complex_conjugate (ac1); + ac3 = gsl_matrix_complex_get (a1, 0, 0); + ac4 = gsl_complex_conjugate (ac3); + cans = gsl_complex_div (gsl_complex_mul (ac1, ac2), gsl_complex_mul (ac3, ac4)); + R0 = gsl_complex_abs (cans); + + // printf("Q %g pfn %g lambda %g \n",q,pfn,lambda); + /*reflect off horizontal surface so reverse y component of velocity*/ + vy = -vy; + /* Reflectivity (see component Guide). */ + p *= R0; + if (frac_inc > 0) { + p /= (1 - frac_inc); + } + SCATTER; + + gsl_matrix_complex_free (ris); + gsl_matrix_complex_free (pfn); + gsl_matrix_complex_free (betan); + gsl_matrix_complex_free (a1); + gsl_matrix_complex_free (a2); + gsl_matrix_complex_free (a3); } - } - else - { + } else { /* No intersection: restore neutron state. */ - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } } %} MCDISPLAY %{ - box(0.0, (double)-ythick/2.0, 0.0, (double)xwidth, (double)ythick, (double)zlength,0, 0, 1, 0); + box (0.0, (double)-ythick / 2.0, 0.0, (double)xwidth, (double)ythick, (double)zlength, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/NPI_tof_dhkl_detector.comp b/mcstas-comps/contrib/NPI_tof_dhkl_detector.comp index c30aaf4b0..cae04022c 100644 --- a/mcstas-comps/contrib/NPI_tof_dhkl_detector.comp +++ b/mcstas-comps/contrib/NPI_tof_dhkl_detector.comp @@ -88,132 +88,134 @@ verbose=0, restore_neutron=1) SHARE %{ -/* used for reading data table from file */ -%include "read_table-lib" + /* used for reading data table from file */ + %include "read_table-lib" -/* -Save up to nmax events stored by the detector in a text file, one per row. -Each row contains detection coordinates: x, y, t, sin(theta), p. -*/ + /* + Save up to nmax events stored by the detector in a text file, one per row. + Each row contains detection coordinates: x, y, t, sin(theta), p. + */ -void saveEvents(double** EVENTS, char* file_name, long int nmax, long int iev) { - long int i, j, n; - double sumP; - FILE *hfile; - hfile=fopen(file_name,"w"); - if (!hfile) - { - fprintf(stderr,"saveEvents: can't open file for output (%s)\n",file_name); - exit(-1); - } else { - n = nmax; - if (n > iev) { - n = iev; - } - sumP = 0.0; - for (i=0;i iev) { + n = iev; + } + sumP = 0.0; + for (i = 0; i < n; i++) { + sumP += EVENTS[i][5]; + } + fprintf (hfile, "# Detection events\n"); + fprintf (hfile, "# sum(p) = %g\n", sumP); + fprintf (hfile, "# sum(n) = %ld\n", n); + fprintf (hfile, "# Columns: x [mm], y[mm], z[mm], t[ms], sin(theta), p\n"); + for (i = 0; i < n; i++) { + for (j = 0; j < 6; j++) { + fprintf (hfile, "%g ", EVENTS[i][j]); + } + fprintf (hfile, "\n"); + } + fclose (hfile); + } + } -Parameters ------------ -iex: excluding this line index -sinth: sin(thetaB) -tof: neutron time of flight from the source (not from the chopper !) [s] -trange: time range for searching overlap [s] + /* + Used in the modulation mode: + Calculates the index of the nearest line which fits within given time interval (trange). + Excludes the line with given index (iex). -Returns -------- -The index of the nearest diffraction line from the dhkl list, or -1 if not found. -*/ - int getNearestLine(int iex, double sinth, double tof, double trange, int n_dhkl, double* dhkl, double mod_shift, double Ltof) { - int i; - int j=0; - int io=-1; - double dtmax,dt,tline; - const double hm=2*PI*K2V; - dtmax=trange; - for (i=0; i=0) { - io=getNearestLine(iline, sth, tdet, trange, n_dhkl, dhkl, mod_shift,Ltof); - if (io<0) { - TOF_N[i][j] += 1; - TOF_p[i][j] += 1; - TOF_p2[i][j] += 1; - } else { - TOF_N[i][j] += 1; - TOF_p[i][j] += 2; - TOF_p2[i][j] += 4; - } - } - } - } + Returns + ------- + The index of the nearest diffraction line from the dhkl list, or -1 if not found. + */ + int + getNearestLine (int iex, double sinth, double tof, double trange, int n_dhkl, double* dhkl, double mod_shift, double Ltof) { + int i; + int j = 0; + int io = -1; + double dtmax, dt, tline; + const double hm = 2 * PI * K2V; + dtmax = trange; + for (i = 0; i < n_dhkl; i++) { + if (i != iex) { + // get centre of the pulse chain + tline = 2 * dhkl[i] * (1.0 + mod_shift) * sinth / hm * Ltof; + dt = fabs (tof - tline); + if (dt < dtmax) { + dtmax = dt; + j = i; + } + } + } + if (dtmax < 0.5 * trange) { + io = j; + } + return io; } + /* + Estimates the overlap map in the (scattering angle, tof) space + for plotting with DETECTOR_OUT_2D. + + Returns + ------- + TOF_N, TOF_p, TOF_p2 arrays for 2D plots with DETECTOR_OUT_2D. + The values are: + 0: empty region + 1: valid region (diffraction line without overlap) + 2: overlaping of 2 or more lines + */ + void + calcOverlaps (double tmin, double tmax, double ami, double ama, double trange, int na, int nt, double t2lam, double mod_shift, double Ltof, double** TOF_N, + double** TOF_p, double** TOF_p2, int n_dhkl, double* dhkl) { + int i, j, iline, io; + double tdet, a, sth; + double a1, a2, drange; + a1 = ami * DEG2RAD; + a2 = ama * DEG2RAD; + double da = (a2 - a1) / na; + double dt = (tmax - tmin) / nt; + for (i = 0; i < na; i++) { + a = a1 + (i + 0.5) * da; + sth = sin (a / 2); + drange = trange * t2lam / 2 / sth; + for (j = 0; j < nt; j++) { + TOF_N[i][j] = 0; + TOF_p[i][j] = 0; + TOF_p2[i][j] = 0; + tdet = tmin + (j + 0.5) * dt; + iline = getNearestLine (-1, sth, tdet, trange, n_dhkl, dhkl, mod_shift, Ltof); + if (iline >= 0) { + io = getNearestLine (iline, sth, tdet, trange, n_dhkl, dhkl, mod_shift, Ltof); + if (io < 0) { + TOF_N[i][j] += 1; + TOF_p[i][j] += 1; + TOF_p2[i][j] += 1; + } else { + TOF_N[i][j] += 1; + TOF_p[i][j] += 2; + TOF_p2[i][j] += 4; + } + } + } + } + } %} DECLARE @@ -225,7 +227,7 @@ DECLARE DArray2d TOF_p; DArray2d TOF_p2; DArray2d EVENTS; - double *dhkl; + double* dhkl; double time_min; double time_max; double grf_th1; @@ -237,310 +239,280 @@ DECLARE int n_dhkl; // set to 1 for some debugging info int dbg; - int dbgn; + int dbgn; %} INITIALIZE %{ - /* h/m_n in [Ang*m/s] */ - double hm = 2*PI*K2V; - dbgn=0; - iev = -1; - - D_N=create_darr1d(nd); - D_p=create_darr1d(nd); - D_p2=create_darr1d(nd); - TOF_N=create_darr2d(na,nt); - TOF_p=create_darr2d(na,nt); - TOF_p2=create_darr2d(na,nt); - EVENTS=create_darr2d(nev,6); - - // read dhkl table - n_dhkl=0; - if (modulation) { - MPI_MASTER( - printf("%s: Modulation on, table = %s, line shift=%g\n",NAME_CURRENT_COMP,mod_d0_table,mod_shift); - ) - if (! mod_d0_table || !strlen(mod_d0_table) || !strcmp(mod_d0_table, "NULL")) { - MPI_MASTER( - fprintf(stderr,"ERROR %s: Can't read table with d0 values: %s \n",NAME_CURRENT_COMP, mod_d0_table); - ) - exit(-1); - } else { - t_Table sTable; - MPI_MASTER(printf("trying to read dhkl table [%s]\n",mod_d0_table)); - Table_Read(&sTable, mod_d0_table, 1); - double size = sTable.rows; - if (size>0) { - dhkl = (double*)malloc(sizeof(double)*size); - int i; - for (i=0; i 0) { + dhkl = (double*)malloc (sizeof (double) * size); + int i; + for (i = 0; i < size; i++) { + dhkl[i] = Table_Index (sTable, i, 0); + } + n_dhkl = size; + if (verbose) + printf ("Read %d rows from dhkl table [%s]\n", n_dhkl, mod_d0_table); + } + Table_Free (&sTable); + } + if (!n_dhkl) { + MPI_MASTER (fprintf (stderr, "ERROR %s: Can't evaluate modulated data without dhkl list\n", NAME_CURRENT_COMP);); + exit (-1); + } + + if (!n_dhkl) { + MPI_MASTER (fprintf (stderr, "ERROR %s: Can't evaluate modulated data without dhkl list\n", NAME_CURRENT_COMP);); + exit (-1); + } + if (mod_dt <= 0) { + MPI_MASTER (fprintf (stderr, "ERROR %s: Modulation period must be positive\n", NAME_CURRENT_COMP);); + exit (-1); + } + if (mod_twidth <= 0) { + MPI_MASTER (fprintf (stderr, "ERROR %s: Time range in modulation mode must be positive\n", NAME_CURRENT_COMP);); + exit (-1); } - - // Distance L0 determines the wavelength - L0=Linst-Lc; - Ltof=Linst; - t2lam=hm/L0; - - - // range of theta-tof plot - time_min=2*d_min*sin(amin*DEG2RAD/2)/t2lam; - time_max=2*d_max*sin(amax*DEG2RAD/2)/t2lam; - grf_th1=amin; - grf_th2=amax; + } else { + MPI_MASTER (printf ("%s: Modulation off\n", NAME_CURRENT_COMP);); + } + + // Distance L0 determines the wavelength + L0 = Linst - Lc; + Ltof = Linst; + t2lam = hm / L0; + + // range of theta-tof plot + time_min = 2 * d_min * sin (amin * DEG2RAD / 2) / t2lam; + time_max = 2 * d_max * sin (amax * DEG2RAD / 2) / t2lam; + grf_th1 = amin; + grf_th2 = amax; + if (modulation) { + calcOverlaps (time_min, time_max, grf_th1, grf_th2, mod_twidth, na, nt, mod_shift, Ltof, t2lam, TOF_N, TOF_p, TOF_p2, n_dhkl, dhkl); + } + MPI_MASTER (if (verbose) { + printf ("%s: lambda/(t-t0)=%g\n", NAME_CURRENT_COMP, t2lam); + printf ("Lc=%g, L0=%g, LD=%g, time0=%g\n", Lc, L0, radius, time0 * 1000); + printf ("For Fe110 at 90 deg: tof=%g [ms]\n", 2 * 2.1055 * sin (45 * DEG2RAD) / hm * Ltof); if (modulation) { - calcOverlaps(time_min, time_max, grf_th1, grf_th2, mod_twidth, na, nt, mod_shift, Ltof, t2lam, TOF_N, TOF_p, TOF_p2, n_dhkl, dhkl); + printf ("mod_dt=%g [ms], mod_shift=%g\n", mod_dt, mod_shift); } - MPI_MASTER( - if (verbose) { - printf("%s: lambda/(t-t0)=%g\n",NAME_CURRENT_COMP,t2lam); - printf("Lc=%g, L0=%g, LD=%g, time0=%g\n", Lc, L0, radius, time0*1000); - printf("For Fe110 at 90 deg: tof=%g [ms]\n",2*2.1055*sin(45*DEG2RAD)/hm*Ltof); - if (modulation) { - printf("mod_dt=%g [ms], mod_shift=%g\n", mod_dt, mod_shift); - } - } - ); + }); %} TRACE %{ - int i,j,io,iline,iref,valid_region; - double t0,t1,lam,theta2,d,cos2; - double sinth,dt,p0,tau,v0,x0,y0,z0,dx,dy,sig,tof,dd; - double tref,tc; - double r8ln2=2.355; - const double hm = 2*PI*K2V; // = h/m_n - double L1; - double th2_min=amin*PI/180; - double th2_max=amax*PI/180; - - #ifndef OPENACC - if (dbgn>20) { - #pragma acc atomic write - dbg=0; - } - #endif - /* cross-section with the detector front face. Allow height = yheight+3*res_y to account for a random - displacement due to vertical resolution. - */ - int cross=cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, yheight+3*res_y); - /* don't allow intersections with top/bottom cylinder walls, - only neutrons from inside of the cylinder are allowed. - */ - if ( (cross!=1) || (t0>0) || (t1<0) ) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); - } else { - // go to cylinder surface = detector entry - PROP_DT(t1); - // save position before propagation through the detection volume - x0=x; - y0=y; - z0=z; - // add random penetration within the detector depth - v0=sqrt(vx*vx+vy*vy+vz*vz); - sig=100*mu*hm/v0; // mu is in 1/cm - p0=1.0-exp(-sig*zdepth); - tau=-1.0*log(1.0-p0*rand01())/sig/v0; - PROP_DT(tau); - p *= p0; - // add random shift by y-resolution - dy = randnorm()*res_y/r8ln2; - y0 += dy; - // add random shift by x-resolution (normal to radius) - dx = randnorm()*res_x/r8ln2; - cos2=z0/radius; - z0 += dx*sqrt(1.-cos2*cos2); - x0 += dx*cos2; - // add random time resolution shift - tof = t + randnorm()*res_t/r8ln2; - // NOTE: detection coordinates are x0, y0, z0, tof - // L1 = detected sample to detector distance: - L1=sqrt(x0*x0 + z0*z0 + y0*y0); - // Clip y on +- 0.5*yheight - if (fabs(y)<(0.5*yheight)) { - dd=(d_max-d_min)/nd; - // get cos(2*theta), assume primary beam axis // [0 0 1] - cos2=z0/L1; - theta2=acos(cos2); - dt = 0; - if (theta2>th2_min && theta2< th2_max) { - sinth=sin(theta2/2); - valid_region=0; - int iex=-1; - /* Modulation mode: estimate the number of modulation periods and correct dt. - Exclude regions with overlaping diffraction lines - */ - if (modulation) { - iline=getNearestLine(-1, sinth, tof, mod_twidth,n_dhkl,dhkl,mod_shift,Ltof); - if (iline>=0) { - io=getNearestLine(iline, sinth, tof, mod_twidth,n_dhkl,dhkl,mod_shift,Ltof); - if (io<0) { - valid_region=1; - /* - Correction for modulation in steps: - 1) tref = reference time for given dhkl, theta and reference chopper window - 2) tc = neutron time minus tref - 3) iref = new reference chopper window - 4) dt = correction for tof - */ - tref=2*(1.0+mod_shift)*dhkl[iline]*sinth/hm*L0; - tc=tof-time0-tref; - iref=(int)floor(tc/mod_dt+0.5); - dt=iref*mod_dt+time0; - #ifndef OPENACC - if (iline==0 && dbg) { - #pragma acc atomic - dbgn = dbgn+1; - printf("iref=%d, dt=%g, t=%g, tcor=%g\n", - iref, iref*mod_dt*1000,tc*1000, (tof-tref-dt)*1000); - } - #endif - } - } - // Normal mode: get indices in the ToF - 2theta grid and accumulate plot data - } else { - valid_region=1; - dt=time0; - i = (int)floor((theta2-grf_th1*DEG2RAD)/(grf_th2*DEG2RAD-grf_th1*DEG2RAD)*na+0.5); - j = (int)floor((t-time_min)/(time_max-time_min)*nt+0.5); - if ( j>=0 && j=0 && i 20) { + #pragma acc atomic write + dbg = 0; + } + #endif + /* cross-section with the detector front face. Allow height = yheight+3*res_y to account for a random + displacement due to vertical resolution. + */ + int cross = cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius, yheight + 3 * res_y); + /* don't allow intersections with top/bottom cylinder walls, + only neutrons from inside of the cylinder are allowed. + */ + if ((cross != 1) || (t0 > 0) || (t1 < 0)) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } else { + // go to cylinder surface = detector entry + PROP_DT (t1); + // save position before propagation through the detection volume + x0 = x; + y0 = y; + z0 = z; + // add random penetration within the detector depth + v0 = sqrt (vx * vx + vy * vy + vz * vz); + sig = 100 * mu * hm / v0; // mu is in 1/cm + p0 = 1.0 - exp (-sig * zdepth); + tau = -1.0 * log (1.0 - p0 * rand01 ()) / sig / v0; + PROP_DT (tau); + p *= p0; + // add random shift by y-resolution + dy = randnorm () * res_y / r8ln2; + y0 += dy; + // add random shift by x-resolution (normal to radius) + dx = randnorm () * res_x / r8ln2; + cos2 = z0 / radius; + z0 += dx * sqrt (1. - cos2 * cos2); + x0 += dx * cos2; + // add random time resolution shift + tof = t + randnorm () * res_t / r8ln2; + // NOTE: detection coordinates are x0, y0, z0, tof + // L1 = detected sample to detector distance: + L1 = sqrt (x0 * x0 + z0 * z0 + y0 * y0); + // Clip y on +- 0.5*yheight + if (fabs (y) < (0.5 * yheight)) { + dd = (d_max - d_min) / nd; + // get cos(2*theta), assume primary beam axis // [0 0 1] + cos2 = z0 / L1; + theta2 = acos (cos2); + dt = 0; + if (theta2 > th2_min && theta2 < th2_max) { + sinth = sin (theta2 / 2); + valid_region = 0; + int iex = -1; + /* Modulation mode: estimate the number of modulation periods and correct dt. + Exclude regions with overlaping diffraction lines + */ + if (modulation) { + iline = getNearestLine (-1, sinth, tof, mod_twidth, n_dhkl, dhkl, mod_shift, Ltof); + if (iline >= 0) { + io = getNearestLine (iline, sinth, tof, mod_twidth, n_dhkl, dhkl, mod_shift, Ltof); + if (io < 0) { + valid_region = 1; + /* + Correction for modulation in steps: + 1) tref = reference time for given dhkl, theta and reference chopper window + 2) tc = neutron time minus tref + 3) iref = new reference chopper window + 4) dt = correction for tof + */ + tref = 2 * (1.0 + mod_shift) * dhkl[iline] * sinth / hm * L0; + tc = tof - time0 - tref; + iref = (int)floor (tc / mod_dt + 0.5); + dt = iref * mod_dt + time0; + #ifndef OPENACC + if (iline == 0 && dbg) { + #pragma acc atomic + dbgn = dbgn + 1; + printf ("iref=%d, dt=%g, t=%g, tcor=%g\n", iref, iref * mod_dt * 1000, tc * 1000, (tof - tref - dt) * 1000); + } + #endif + } + } + // Normal mode: get indices in the ToF - 2theta grid and accumulate plot data + } else { + valid_region = 1; + dt = time0; + i = (int)floor ((theta2 - grf_th1 * DEG2RAD) / (grf_th2 * DEG2RAD - grf_th1 * DEG2RAD) * na + 0.5); + j = (int)floor ((t - time_min) / (time_max - time_min) * nt + 0.5); + if (j >= 0 && j < nt && i >= 0 && i < na) { + double p2 = p * p; + #pragma acc atomic + TOF_N[i][j] = TOF_N[i][j] + 1; + #pragma acc atomic + TOF_p[i][j] = TOF_p[i][j] + p; + #pragma acc atomic + TOF_p2[i][j] = TOF_p2[i][j] + p2; + } + } + /* Valid event: calculate wavelength and dhkl "as recorded by the instrument", i.e. + including smearing by instrument resolution. + Record a list of detection event coordinates in EVENTS array. + */ + if (valid_region) { + // subtract reference chopper time from tof and calculate wavelength + lam = hm * (tof - dt) / (L0 - radius + L1); + d = lam / 2 / sinth; + #pragma acc atomic + iev = iev + 1; + if (iev < nev) { + double tmp; - tmp = y0*1e3; - #pragma acc atomic write - EVENTS[iev][1] = tmp; + tmp = x0 * 1e3; + #pragma acc atomic write + EVENTS[iev][0] = tmp; - tmp = z0*1e3; - #pragma acc atomic write - EVENTS[iev][2] = tmp; + tmp = y0 * 1e3; + #pragma acc atomic write + EVENTS[iev][1] = tmp; - tmp = tof*1e3; - #pragma acc atomic write - EVENTS[iev][3] = tmp; + tmp = z0 * 1e3; + #pragma acc atomic write + EVENTS[iev][2] = tmp; - #pragma acc atomic write - EVENTS[iev][4] = sinth; + tmp = tof * 1e3; + #pragma acc atomic write + EVENTS[iev][3] = tmp; - #pragma acc atomic write - EVENTS[iev][5] = p; - } - i=(int)floor((d-d_min)/dd+0.5); - if (i>=0 && i= 0 && i < nd) { + double p2 = p * p; + #pragma acc atomic + D_N[i] = D_N[i] + 1; + #pragma acc atomic + D_p[i] = D_p[i] + p; + #pragma acc atomic + D_p2[i] = D_p2[i] + p2; + } + } + } } + } + if (restore_neutron) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } %} SAVE %{ - - if (nev>1) { - saveEvents(EVENTS,"events.dat", nev, iev); + + if (nev > 1) { + saveEvents (EVENTS, "events.dat", nev, iev); } - DETECTOR_OUT_1D( - "ToF to dhkl detector", - "dhkl [AA]", - "Intensity", - "d", d_min, d_max, nd, - &D_N[0],&D_p[0],&D_p2[0], - filename); + DETECTOR_OUT_1D ("ToF to dhkl detector", "dhkl [AA]", "Intensity", "d", d_min, d_max, nd, &D_N[0], &D_p[0], &D_p2[0], filename); if (modulation) { - DETECTOR_OUT_2D( - "Map of overlapping regions", - "Scattering angle [deg]", - "Time-of-flight [ms]", - grf_th1, grf_th2, time_min*1000, time_max*1000, - na, nt, - &TOF_N[0][0],&TOF_p[0][0],&TOF_p2[0][0], - "overlap_map.dat"); + DETECTOR_OUT_2D ("Map of overlapping regions", "Scattering angle [deg]", "Time-of-flight [ms]", grf_th1, grf_th2, time_min * 1000, time_max * 1000, na, nt, + &TOF_N[0][0], &TOF_p[0][0], &TOF_p2[0][0], "overlap_map.dat"); } %} FINALLY %{ - free(dhkl); - destroy_darr1d(D_N); - destroy_darr1d(D_p); - destroy_darr1d(D_p2); - destroy_darr2d(TOF_N); - destroy_darr2d(TOF_p); - destroy_darr2d(TOF_p2); - destroy_darr2d(EVENTS); + free (dhkl); + destroy_darr1d (D_N); + destroy_darr1d (D_p); + destroy_darr1d (D_p2); + destroy_darr2d (TOF_N); + destroy_darr2d (TOF_p); + destroy_darr2d (TOF_p2); + destroy_darr2d (EVENTS); %} MCDISPLAY %{ - magnify("xz"); - circle("xz", 0, 0, 0, radius ); - + magnify ("xz"); + circle ("xz", 0, 0, 0, radius); %} END diff --git a/mcstas-comps/contrib/NPI_tof_theta_monitor.comp b/mcstas-comps/contrib/NPI_tof_theta_monitor.comp index 6b83c5959..7d547a768 100644 --- a/mcstas-comps/contrib/NPI_tof_theta_monitor.comp +++ b/mcstas-comps/contrib/NPI_tof_theta_monitor.comp @@ -66,98 +66,93 @@ SHARE %} DECLARE %{ - DArray2d TOF_N; - DArray2d TOF_p; - DArray2d TOF_p2; - double th2_min; - double th2_max; - double dth; - double dtof; - double tt_0; - double tt_1; + DArray2d TOF_N; + DArray2d TOF_p; + DArray2d TOF_p2; + double th2_min; + double th2_max; + double dth; + double dtof; + double tt_0; + double tt_1; %} INITIALIZE %{ - th2_min = amin*DEG2RAD; - th2_max = amax*DEG2RAD; - dth=(th2_max-th2_min)/na; - tt_0=tmin*1e-6; - tt_1=tmax*1e-6; - dtof=(tt_1-tt_0)/nt; - - TOF_N = create_darr2d(na, nt); - TOF_p = create_darr2d(na, nt); - TOF_p2 = create_darr2d(na, nt); - - if (verbose) { - printf("%s: range 2theta=(%g,%g), time(%g,%g)\n",NAME_CURRENT_COMP,amin,amax,tmin/1000,tmax/1000); - } - - // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + th2_min = amin * DEG2RAD; + th2_max = amax * DEG2RAD; + dth = (th2_max - th2_min) / na; + tt_0 = tmin * 1e-6; + tt_1 = tmax * 1e-6; + dtof = (tt_1 - tt_0) / nt; + + TOF_N = create_darr2d (na, nt); + TOF_p = create_darr2d (na, nt); + TOF_p2 = create_darr2d (na, nt); + + if (verbose) { + printf ("%s: range 2theta=(%g,%g), time(%g,%g)\n", NAME_CURRENT_COMP, amin, amax, tmin / 1000, tmax / 1000); + } + + // Use instance name for monitor output if no input was given + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ - int i,j; - double t0,t1,theta2; - double cos2; - int cross=cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, yheight); - - /* don't allow intersections with top/bottom cylinder walls - only neutrons from inside are allowed - */ - if ( (cross!=1) || (t0>0) || (t1<0) ) { - p=0; - } else { - PROP_DT(t1); - - /* Calculate pixel */ - if (fabs(y)<(0.5*yheight)) { - cos2=z/sqrt(radius*radius+y*y); - theta2=acos(cos2); - if (theta2>th2_min && theta2< th2_max) { - i = (int)floor((theta2-th2_min)/dth+0.5); - j = (int)floor((t-tt_0)/dtof+0.5); - if ( j>=0 && j=0 && i 0) || (t1 < 0)) { + p = 0; + } else { + PROP_DT (t1); + + /* Calculate pixel */ + if (fabs (y) < (0.5 * yheight)) { + cos2 = z / sqrt (radius * radius + y * y); + theta2 = acos (cos2); + if (theta2 > th2_min && theta2 < th2_max) { + i = (int)floor ((theta2 - th2_min) / dth + 0.5); + j = (int)floor ((t - tt_0) / dtof + 0.5); + if (j >= 0 && j < nt && i >= 0 && i < na) { + double p2 = p * p; + #pragma acc atomic + TOF_N[i][j] = TOF_N[i][j] + 1; + #pragma acc atomic + TOF_p[i][j] = TOF_p[i][j] + p; + #pragma acc atomic + TOF_p2[i][j] = TOF_p2[i][j] + p2; + } else { + } } } - if (restore_neutron) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); - } + } + if (restore_neutron) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } %} SAVE %{ - DETECTOR_OUT_2D( - "Cylindrical monitor ToF x 2theta", - "Scattering angle [deg]", - "Time-of-flight [\\gms]", - amin, amax, tmin, tmax, - na, nt, - &TOF_N[0][0],&TOF_p[0][0],&TOF_p2[0][0], - filename); + DETECTOR_OUT_2D ("Cylindrical monitor ToF x 2theta", "Scattering angle [deg]", "Time-of-flight [\\gms]", amin, amax, tmin, tmax, na, nt, &TOF_N[0][0], + &TOF_p[0][0], &TOF_p2[0][0], filename); %} FINALLY %{ - destroy_darr2d(TOF_N); - destroy_darr2d(TOF_p); - destroy_darr2d(TOF_p2); + destroy_darr2d (TOF_N); + destroy_darr2d (TOF_p); + destroy_darr2d (TOF_p2); %} MCDISPLAY %{ - magnify("y"); - circle("xz", 0,0,0,radius); + magnify ("y"); + circle ("xz", 0, 0, 0, radius); %} END diff --git a/mcstas-comps/contrib/PSD_Pol_monitor.comp b/mcstas-comps/contrib/PSD_Pol_monitor.comp index a94ca5d06..d4c9dbd3f 100644 --- a/mcstas-comps/contrib/PSD_Pol_monitor.comp +++ b/mcstas-comps/contrib/PSD_Pol_monitor.comp @@ -1,181 +1,177 @@ -/******************************************************************************* -* -* McStas, neutron ray-tracing package -* Copyright 1997-2002, All rights reserved -* Risoe National Laboratory, Roskilde, Denmark -* Institut Laue Langevin, Grenoble, France -* -* Component: PSD_Pol_monitor -* -* %I -* Written by: Alexander Backs, based on PSD_monitor by K. Lefmann -* Date: 2022 -* Origin: ESS -* -* Position-sensitive monitor. -* -* %D -* An (n times m) pixel PSD monitor, measuring local polarisation as function of x,y coordinates. -* -* Example: PSD_Pol_monitor(xmin=-0.1, xmax=0.1, ymin=-0.1, ymax=0.1, nx=90, ny=90, my=1, filename="Output.psd") -* -* %P -* INPUT PARAMETERS: -* -* xmin: [m] Lower x bound of detector opening -* xmax: [m] Upper x bound of detector opening -* ymin: [m] Lower y bound of detector opening -* ymax: [m] Upper y bound of detector opening -* xwidth: [m] Width of detector. Overrides xmin, xmax -* yheight: [m] Height of detector. Overrides ymin, ymax -* nx: [1] Number of pixel columns -* ny: [1] Number of pixel rows -* filename: [string] Name of file in which to store the detector image -* restore_neutron: [1] If set, the monitor does not influence the neutron state -* nowritefile: [1] If set, monitor will skip writing to disk -* mx: [1] Define the projection axis along which the polarizatoin is evaluated, x-component -* my: [1] Define the projection axis along which the polarizatoin is evaluated, y-component -* mz: [1] Define the projection axis along which the polarizatoin is evaluated, z-component -* -* CALCULATED PARAMETERS: -* -* PSDpol_N: [] Array of neutron counts -* PSDpol_p: [] Array of neutron weighted polarization -* PSDpol_p2: [] Array of standard deviation of weighted polarization -* -* %E -*******************************************************************************/ -DEFINE COMPONENT PSD_Pol_monitor - -SETTING PARAMETERS (int nx=90, int ny=90, string filename=0, - xmin=-0.05, xmax=0.05, ymin=-0.05, ymax=0.05, xwidth=0, yheight=0, - restore_neutron=0, int nowritefile=0, - mx=0, my=0, mz=0) - -SHARE %{ -%} - -DECLARE -%{ - DArray2d PSDpol_N; - DArray2d PSDpol_p; - DArray2d PSDpol_p2; - DArray2d PSDpsum; - char titlestring[128]; -%} - -INITIALIZE -%{ - // Check that input parameteters makes sense - if (mx==0 && my==0 && mz==0) { - fprintf(stderr, "Pol_monitor: %s: NULL vector defined!\n" - "ERROR (mx, my, mz). Exiting", - NAME_CURRENT_COMP); - exit(1); - } - - if (xwidth > 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } - - if ((xmin >= xmax) || (ymin >= ymax)){ - printf("PSD_monitor: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(-1); - } - - sprintf(titlestring, "Polarisation monitor m=(%g %g %g) %s", mx, my, mz, NAME_CURRENT_COMP); - - NORM(mx, my, mz); - PSDpol_N = create_darr2d(nx, ny); - PSDpol_p = create_darr2d(nx, ny); - PSDpol_p2 = create_darr2d(nx, ny); - PSDpsum = create_darr2d(nx,ny); - - // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); -%} - -TRACE -%{ - PROP_Z0; - - double pol_proj = mx*sx + my*sy + mz*sz; //scalar_prod(mx, my, mz, sx, sy, sz); - - if(fabs(pol_proj)>1) { - if (fabs(pol_proj)<1+FLT_EPSILON){ - pol_proj /= fabs(pol_proj); - } - else{ - ABSORB; - } - } - - - if (x>xmin && xymin && y1) { - mc_MPI_Sum(&PSDpol_p[0][0], (int)nx*ny); - mc_MPI_Sum(&PSDpol_p2[0][0], (int)nx*ny); - mc_MPI_Sum(&PSDpol_N[0][0], (int)nx*ny); - mc_MPI_Sum(&PSDpsum[0][0], (int)nx*ny); - } -#endif /* USE_MPI */ - if (!nowritefile) { - for (int i=0;i 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } + + if ((xmin >= xmax) || (ymin >= ymax)) { + printf ("PSD_monitor: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (-1); + } + + sprintf (titlestring, "Polarisation monitor m=(%g %g %g) %s", mx, my, mz, NAME_CURRENT_COMP); + + NORM (mx, my, mz); + PSDpol_N = create_darr2d (nx, ny); + PSDpol_p = create_darr2d (nx, ny); + PSDpol_p2 = create_darr2d (nx, ny); + PSDpsum = create_darr2d (nx, ny); + + // Use instance name for monitor output if no input was given + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); +%} + +TRACE +%{ + PROP_Z0; + + double pol_proj = mx * sx + my * sy + mz * sz; // scalar_prod(mx, my, mz, sx, sy, sz); + + if (fabs (pol_proj) > 1) { + if (fabs (pol_proj) < 1 + FLT_EPSILON) { + pol_proj /= fabs (pol_proj); + } else { + ABSORB; + } + } + + if (x > xmin && x < xmax && y > ymin && y < ymax) { + int i = floor ((x - xmin) * nx / (xmax - xmin)); + int j = floor ((y - ymin) * ny / (ymax - ymin)); + + double ppol = p * pol_proj; + double ppol2 = ppol * pol_proj; + + PSDpol_N[i][j] += 1; + PSDpol_p[i][j] += ppol; + PSDpol_p2[i][j] += ppol2; + PSDpsum[i][j] += p; + SCATTER; + } + if (restore_neutron) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } +%} + +SAVE +%{ + #ifdef USE_MPI + if (mpi_node_count > 1) { + mc_MPI_Sum (&PSDpol_p[0][0], (int)nx * ny); + mc_MPI_Sum (&PSDpol_p2[0][0], (int)nx * ny); + mc_MPI_Sum (&PSDpol_N[0][0], (int)nx * ny); + mc_MPI_Sum (&PSDpsum[0][0], (int)nx * ny); + } + #endif /* USE_MPI */ + if (!nowritefile) { + for (int i = 0; i < nx; i++) { + for (int j = 0; j < ny; j++) { + if (PSDpsum[i][j] && PSDpol_N[i][j]) { + PSDpol_p[i][j] /= PSDpsum[i][j]; + PSDpol_p2[i][j] /= PSDpsum[i][j]; + } + } + } + DETECTOR_OUT_2D ("PSD Pol monitor", "X position [cm]", "Y position [cm]", xmin * 100.0, xmax * 100.0, ymin * 100.0, ymax * 100.0, nx, ny, &PSDpol_N[0][0], + &PSDpol_p[0][0], &PSDpol_p2[0][0], filename); + } +%} + +FINALLY +%{ + destroy_darr2d (PSDpol_N); + destroy_darr2d (PSDpol_p); + destroy_darr2d (PSDpol_p2); + destroy_darr2d (PSDpsum); +%} + +MCDISPLAY +%{ + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); +%} + +END diff --git a/mcstas-comps/contrib/PSD_monitor_rad.comp b/mcstas-comps/contrib/PSD_monitor_rad.comp index c34c0a9f2..d895056e0 100644 --- a/mcstas-comps/contrib/PSD_monitor_rad.comp +++ b/mcstas-comps/contrib/PSD_monitor_rad.comp @@ -62,24 +62,25 @@ INITIALIZE %{ int i; - PSDr_N = create_darr1d(nr); - PSDr_p = create_darr1d(nr); - PSDr_p2 = create_darr1d(nr); - PSDr_av_p = create_darr1d(nr); - PSDr_av_p2 = create_darr1d(nr); - - for (i=0; i 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } - if ((xmin >= xmax) || (ymin >= ymax)){ - printf("PSD_monitor: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(0); + if ((xmin >= xmax) || (ymin >= ymax)) { + printf ("PSD_monitor: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (0); } - PSD_N = create_darr2d(nx, ny); - PSD_p = create_darr2d(nx, ny); - PSD_p2 = create_darr2d(nx, ny); + PSD_N = create_darr2d (nx, ny); + PSD_p = create_darr2d (nx, ny); + PSD_p2 = create_darr2d (nx, ny); // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ - int i,j; + int i, j; + + if (sy > 0) { + SCATTER; + } else { + PROP_Z0; + if (x > xmin && x < xmax && y > ymin && y < ymax) { + i = floor ((x - xmin) * nx / (xmax - xmin)); + j = floor ((y - ymin) * ny / (ymax - ymin)); + double p2 = p * p; + #pragma acc atomic + PSD_N[i][j] = PSD_N[i][j] + 1; + #pragma acc atomic + PSD_p[i][j] = PSD_p[i][j] + p; + #pragma acc atomic + PSD_p2[i][j] = PSD_p2[i][j] + p2; - if (sy > 0) - {SCATTER;} - else - { - PROP_Z0; - if (x>xmin && xymin && y 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } - if ((xmin >= xmax) || (ymin >= ymax)){ - printf("PSD_monitor: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(0); + if ((xmin >= xmax) || (ymin >= ymax)) { + printf ("PSD_monitor: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (0); } - PSD_N = create_darr2d(nx, ny); - PSD_p = create_darr2d(nx, ny); - PSD_p2 = create_darr2d(nx, ny); + PSD_N = create_darr2d (nx, ny); + PSD_p = create_darr2d (nx, ny); + PSD_p2 = create_darr2d (nx, ny); // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ - int i,j; + int i, j; - if (sy < 0) - {SCATTER;} - else - { - PROP_Z0; - if (x>xmin && xymin && y xmin && x < xmax && y > ymin && y < ymax) { + i = floor ((x - xmin) * nx / (xmax - xmin)); + j = floor ((y - ymin) * ny / (ymax - ymin)); + double p2 = p * p; + #pragma acc atomic + PSD_N[i][j] = PSD_N[i][j] + 1; + #pragma acc atomic + PSD_p[i][j] = PSD_p[i][j] + p; + #pragma acc atomic + PSD_p2[i][j] = PSD_p2[i][j] + p2; + + SCATTER; + } + if (restore_neutron) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } + } %} SAVE %{ - DETECTOR_OUT_2D( - "PSD monitor", - "X position [cm]", - "Y position [cm]", - xmin*100.0, xmax*100.0, ymin*100.0, ymax*100.0, - nx, ny, - &PSD_N[0][0],&PSD_p[0][0],&PSD_p2[0][0], - filename); + DETECTOR_OUT_2D ("PSD monitor", "X position [cm]", "Y position [cm]", xmin * 100.0, xmax * 100.0, ymin * 100.0, ymax * 100.0, nx, ny, &PSD_N[0][0], + &PSD_p[0][0], &PSD_p2[0][0], filename); %} FINALLY %{ @@ -125,12 +124,9 @@ FINALLY %{ MCDISPLAY %{ - magnify("xy"); - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); + magnify ("xy"); + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); %} END diff --git a/mcstas-comps/contrib/PerfectCrystal.comp b/mcstas-comps/contrib/PerfectCrystal.comp index f4a965ded..184729066 100644 --- a/mcstas-comps/contrib/PerfectCrystal.comp +++ b/mcstas-comps/contrib/PerfectCrystal.comp @@ -128,713 +128,579 @@ smartwidth=NAN, exclusive=0, transmit=0, verbose=0 ) SHARE %{ -// convert between spherical (r,tt,phi) and cartesian (x,y,z) coordinates (angles in deg) - // debyescherrer swaps axes - void sph2cart(double *x,double *y,double *z, double r, double tt, double phi, int debyescherrer) - { - tt *= DEG2RAD; - phi *= DEG2RAD; - if (debyescherrer) { - double sintt = sin(tt); - *x = - r * cos(phi) * sintt; - *y = r * sin(phi) * sintt; - *z = r * cos(tt); - } else { - double cosphi = cos(phi); - *x = - r * cosphi * sin(tt); - *y = r * sin(phi); - *z = r * cosphi * cos(tt); - } - } - - /******************************************************************************* + // convert between spherical (r,tt,phi) and cartesian (x,y,z) coordinates (angles in deg) + // debyescherrer swaps axes + void + sph2cart (double* x, double* y, double* z, double r, double tt, double phi, int debyescherrer) { + tt *= DEG2RAD; + phi *= DEG2RAD; + if (debyescherrer) { + double sintt = sin (tt); + *x = -r * cos (phi) * sintt; + *y = r * sin (phi) * sintt; + *z = r * cos (tt); + } else { + double cosphi = cos (phi); + *x = -r * cosphi * sin (tt); + *y = r * sin (phi); + *z = r * cosphi * cos (tt); + } + } + + /******************************************************************************* * grandvec_target_circle: Choose random direction towards target at (x,y,z) * with given radius and gaussian area distribution. * If radius is zero, choose random direction in full 4PI, no target. ******************************************************************************/ - void - grandvec_target_circle(double *xo, double *yo, double *zo, double *solid_angle, - double xi, double yi, double zi, double radius) - { - double l2, phi, theta, nx, ny, nz, xt, yt, zt, xu, yu, zu; - - if(radius == 0.0) - { - /* No target, choose uniformly a direction in full 4PI solid angle. */ - theta = acos (1 - rand0max(2)); - phi = rand0max(2 * PI); - if(solid_angle) - *solid_angle = 4*PI; - nx = 1; - ny = 0; - nz = 0; - yi = sqrt(xi*xi+yi*yi+zi*zi); - zi = 0; - xi = 0; - } - else - { - double costheta0; - l2 = xi*xi + yi*yi + zi*zi; /* sqr Distance to target. */ - costheta0 = sqrt(l2/(radius*radius+l2)); - if (radius < 0) costheta0 *= -1; - if(solid_angle) - { - /* Compute solid angle of target as seen from origin. */ - *solid_angle = 2*PI*(1 - costheta0); - } - - /* Now choose point uniformly on circle surface within angle theta0 */ - double costheta; - costheta = (1 - fabs(randnorm()*(1 - costheta0)) ); - - if (costheta < -1) - costheta = -1; - - theta = acos(costheta); /* radius on circle */ - phi = rand0max(2 * PI); /* rotation on circle at given radius */ - /* Now, to obtain the desired vector rotate (xi,yi,zi) angle theta around a - perpendicular axis u=i x n and then angle phi around i. */ - if(xi == 0 && zi == 0) - { - nx = 1; - ny = 0; - nz = 0; - } - else - { - nx = -zi; - nz = xi; - ny = 0; - } - } - - /* [xyz]u = [xyz]i x n[xyz] (usually vertical) */ - vec_prod(xu, yu, zu, xi, yi, zi, nx, ny, nz); - /* [xyz]t = [xyz]i rotated theta around [xyz]u */ - rotate (xt, yt, zt, xi, yi, zi, theta, xu, yu, zu); - /* [xyz]o = [xyz]t rotated phi around n[xyz] */ - rotate (*xo, *yo, *zo, xt, yt, zt, phi, xi, yi, zi); - } /* randvec_target_circle */ - + void + grandvec_target_circle (double* xo, double* yo, double* zo, double* solid_angle, double xi, double yi, double zi, double radius) { + double l2, phi, theta, nx, ny, nz, xt, yt, zt, xu, yu, zu; + + if (radius == 0.0) { + /* No target, choose uniformly a direction in full 4PI solid angle. */ + theta = acos (1 - rand0max (2)); + phi = rand0max (2 * PI); + if (solid_angle) + *solid_angle = 4 * PI; + nx = 1; + ny = 0; + nz = 0; + yi = sqrt (xi * xi + yi * yi + zi * zi); + zi = 0; + xi = 0; + } else { + double costheta0; + l2 = xi * xi + yi * yi + zi * zi; /* sqr Distance to target. */ + costheta0 = sqrt (l2 / (radius * radius + l2)); + if (radius < 0) + costheta0 *= -1; + if (solid_angle) { + /* Compute solid angle of target as seen from origin. */ + *solid_angle = 2 * PI * (1 - costheta0); + } + /* Now choose point uniformly on circle surface within angle theta0 */ + double costheta; + costheta = (1 - fabs (randnorm () * (1 - costheta0))); + + if (costheta < -1) + costheta = -1; + + theta = acos (costheta); /* radius on circle */ + phi = rand0max (2 * PI); /* rotation on circle at given radius */ + /* Now, to obtain the desired vector rotate (xi,yi,zi) angle theta around a + perpendicular axis u=i x n and then angle phi around i. */ + if (xi == 0 && zi == 0) { + nx = 1; + ny = 0; + nz = 0; + } else { + nx = -zi; + nz = xi; + ny = 0; + } + } + + /* [xyz]u = [xyz]i x n[xyz] (usually vertical) */ + vec_prod (xu, yu, zu, xi, yi, zi, nx, ny, nz); + /* [xyz]t = [xyz]i rotated theta around [xyz]u */ + rotate (xt, yt, zt, xi, yi, zi, theta, xu, yu, zu); + /* [xyz]o = [xyz]t rotated phi around n[xyz] */ + rotate (*xo, *yo, *zo, xt, yt, zt, phi, xi, yi, zi); + } /* randvec_target_circle */ %} DECLARE %{ - // official output variables - double tt; - double phi; - double xi; - double phid; - double vd; - double zd; - double v0; - double vmin; - double vmax; - double vperp; - double E0; - double R; - double eps; - - // internal stuff - double sin_facette_xi; + // official output variables + double tt; + double phi; + double xi; + double phid; + double vd; + double zd; + double v0; + double vmin; + double vmax; + double vperp; + double E0; + double R; + double eps; + + // internal stuff + double sin_facette_xi; %} INITIALIZE %{ - // checks and balances ... - if ( radius < 0 ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: negative radius\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - //****************************************** - // position and size - if ( !radius ) - { - // flat analyzer surface - if ( isnan(width) || isnan(height) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: Need width and height for radius==0\n", - NAME_CURRENT_COMP);); - exit(-1); - } - } - else - { - // curved analyzer surface - - //****************************************** - // Determine analyzer width - - // ttmin / ttmax - if ( !isnan(ttmin) && !isnan(ttmax) && isnan(tt0) && isnan(ttwidth) && isnan(width) ) - { - // all right. - } - // tt0 / ttwidth - else if ( isnan(ttmin) && isnan(ttmax) && !isnan(ttwidth) && isnan(width) ) - { - if ( isnan(tt0) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: Missing parameter: tt0 set to zero\n", - NAME_CURRENT_COMP);); - tt0 = 0; - } - ttmin = tt0 - ttwidth/2.0; - ttmax = tt0 + ttwidth/2.0; - - } - // tt0 / width - else if ( isnan(ttmin) && isnan(ttmax) && isnan(ttwidth) && !isnan(width) ) - { - if ( isnan(tt0) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: Missing parameter: tt0 set to zero\n", - NAME_CURRENT_COMP);); - tt0 = 0; - } - ttwidth = 2.0 * asin( width / 2.0 / radius ) * RAD2DEG; - ttmin = tt0 - ttwidth/2.0; - ttmax = tt0 + ttwidth/2.0; + // checks and balances ... + if (radius < 0) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: negative radius\n", NAME_CURRENT_COMP);); + exit (-1); + } + + //****************************************** + // position and size + if (!radius) { + // flat analyzer surface + if (isnan (width) || isnan (height)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: Need width and height for radius==0\n", NAME_CURRENT_COMP);); + exit (-1); + } + } else { + // curved analyzer surface + + //****************************************** + // Determine analyzer width + + // ttmin / ttmax + if (!isnan (ttmin) && !isnan (ttmax) && isnan (tt0) && isnan (ttwidth) && isnan (width)) { + // all right. + } + // tt0 / ttwidth + else if (isnan (ttmin) && isnan (ttmax) && !isnan (ttwidth) && isnan (width)) { + if (isnan (tt0)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s WARNING: Missing parameter: tt0 set to zero\n", NAME_CURRENT_COMP);); + tt0 = 0; } - else - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: Cannot determine analyzer width/tt\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - //****************************************** - // Determine analyzer height - - // phimin / phimax - if ( !isnan(phimin) && !isnan(phimax) && isnan(phi0) && isnan(phiwidth) && isnan(height) ) - { - // all right, nothing to do. - } - // phi0 / phiwidth - else if ( isnan(phimin) && isnan(phimax) && !isnan(phiwidth) && isnan(height) ) - { - if ( isnan(phi0) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: Missing parameter: phi0 set to zero\n", - NAME_CURRENT_COMP);); - phi0 = 0; - } - phimin = phi0 - phiwidth/2.0; - phimax = phi0 + phiwidth/2.0; - } - // phi0 / height - else if ( isnan(phimin) && isnan(phimax) && isnan(phiwidth) && !isnan(height) ) - { - if ( isnan(phi0) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: Missing parameter: phi0 set to zero\n", - NAME_CURRENT_COMP);); - phi0 = 0; - } - phiwidth = 2.0 * asin( height / 2.0 / radius ) * RAD2DEG; - phimin = phi0 - phiwidth/2.0; - phimax = phi0 + phiwidth/2.0; - } - else - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: Cannot determine analyzer height/phi\n", - NAME_CURRENT_COMP);); - exit(-1); - } - } - - if ( centerfocus && !radius ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: centerfocus doesn't make sense with radius==0\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - //****************************************** - // neutron optics - if ( !ismirror ) - { - if ( isnan(lambda) == isnan(tau) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: provide either tau or lambda\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - if ( isnan(tau) ) - tau = 4*PI / lambda; - - v0 = tau / 2.0 * K2V; - E0 = SQR(v0) * VS2E; - - if ( isnan(dtauovertau) == isnan(sigma) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameters: provide either sigma or dtauovertau, or switch on ismirror\n", - NAME_CURRENT_COMP);); - exit(-1); + ttmin = tt0 - ttwidth / 2.0; + ttmax = tt0 + ttwidth / 2.0; + + } + // tt0 / width + else if (isnan (ttmin) && isnan (ttmax) && isnan (ttwidth) && !isnan (width)) { + if (isnan (tt0)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s WARNING: Missing parameter: tt0 set to zero\n", NAME_CURRENT_COMP);); + tt0 = 0; } - } - else - { - if ( !isnan(dtauovertau) || !isnan(sigma) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: dtauovertau and/or sigma is ignored with ismirror==1\n", - NAME_CURRENT_COMP);); + ttwidth = 2.0 * asin (width / 2.0 / radius) * RAD2DEG; + ttmin = tt0 - ttwidth / 2.0; + ttmax = tt0 + ttwidth / 2.0; + } else { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: Cannot determine analyzer width/tt\n", NAME_CURRENT_COMP);); + exit (-1); + } + + //****************************************** + // Determine analyzer height + + // phimin / phimax + if (!isnan (phimin) && !isnan (phimax) && isnan (phi0) && isnan (phiwidth) && isnan (height)) { + // all right, nothing to do. + } + // phi0 / phiwidth + else if (isnan (phimin) && isnan (phimax) && !isnan (phiwidth) && isnan (height)) { + if (isnan (phi0)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s WARNING: Missing parameter: phi0 set to zero\n", NAME_CURRENT_COMP);); + phi0 = 0; } - } - - - if ( !( R0>=0 && R0<=1.0 ) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameter: R0 must be between 0 and 1\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - if ( transmit < 0.0 || transmit > 1.0 ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: Invalid parameter: transmit must be between 0 and 1\n", - NAME_CURRENT_COMP);); - exit(-1); - } - - // transform Gaussian sigma from energy (meV) to neutron velocity (m/s) - if ( !isnan(sigma) ) - sigma /= 3.29106e-3 * tau; // constant is hbar/2 in appropriate units - - // transform smartwidth from energy (meV) to neutron velocity (m/s) - if ( !isnan(smartwidth) ) - smartwidth /= 3.29106e-3 * tau; // constant is hbar/2 in appropriate units - - // set standard widths for smartphase - if ( isnan(smartwidth) && !isnan(sigma) ) - smartwidth = 5.0 * sigma; - - if ( isnan(smartwidth) && !isnan(dtauovertau) ) - smartwidth = 10.0 * dtauovertau * v0; - - if ( smartphase && !isnan(dtauovertau) ) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s WARNING: Using smartphase for ewald/darwin curves is probably a bad idea, because these curves have very long wings which will be cut off!!!\n", - NAME_CURRENT_COMP);); - } - - if (facette_xi) - { - if (facette_xi < 0) - { - MPI_MASTER(fprintf(stderr, - "PerfectCrystal: %s ERROR: facette_xi must be >= 0\n", - NAME_CURRENT_COMP);); - exit(-1); + phimin = phi0 - phiwidth / 2.0; + phimax = phi0 + phiwidth / 2.0; + } + // phi0 / height + else if (isnan (phimin) && isnan (phimax) && isnan (phiwidth) && !isnan (height)) { + if (isnan (phi0)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s WARNING: Missing parameter: phi0 set to zero\n", NAME_CURRENT_COMP);); + phi0 = 0; } - - sin_facette_xi = sin(DEG2RAD*facette_xi); - } - - // talk to the user ... - if ( verbose ) - { - #define PRINTVAR(str,val) fprintf(stderr,"%s --- %s : %g\n",NAME_CURRENT_COMP,str,val); - MPI_MASTER( - PRINTVAR("ttmin",ttmin); - PRINTVAR("ttmax",ttmax); - PRINTVAR("ttwidth",ttwidth); - PRINTVAR("width",width); - PRINTVAR("phimin",phimin); - PRINTVAR("phimax",phimax); - PRINTVAR("phi0",phi0); - PRINTVAR("phiwidth",phiwidth); - PRINTVAR("height",height); - PRINTVAR("centerfocus",centerfocus); - PRINTVAR("debyescherrer",debyescherrer); - PRINTVAR("radius",radius); - PRINTVAR("facette",facette); - PRINTVAR("facette_xi",facette_xi); - PRINTVAR("sin_facette_xi",sin_facette_xi); - PRINTVAR("tau",tau); - PRINTVAR("lambda",lambda); - PRINTVAR("v0",v0); - PRINTVAR("E0",E0); - PRINTVAR("dtauovertau",dtauovertau); - PRINTVAR("dtauovertau_ext",dtauovertau_ext); - PRINTVAR("ewald",ewald); - PRINTVAR("R0",R0); - PRINTVAR("sigma[m/s]",sigma); - PRINTVAR("ismirror",ismirror); - PRINTVAR("speed",speed); - PRINTVAR("amplitude",amplitude); - PRINTVAR("smartphase",smartphase); - PRINTVAR("smartwidth[m/s]",smartwidth); - PRINTVAR("exclusive",exclusive); - ); - } - + phiwidth = 2.0 * asin (height / 2.0 / radius) * RAD2DEG; + phimin = phi0 - phiwidth / 2.0; + phimax = phi0 + phiwidth / 2.0; + } else { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: Cannot determine analyzer height/phi\n", NAME_CURRENT_COMP);); + exit (-1); + } + } + + if (centerfocus && !radius) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: centerfocus doesn't make sense with radius==0\n", NAME_CURRENT_COMP);); + exit (-1); + } + + //****************************************** + // neutron optics + if (!ismirror) { + if (isnan (lambda) == isnan (tau)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: provide either tau or lambda\n", NAME_CURRENT_COMP);); + exit (-1); + } + + if (isnan (tau)) + tau = 4 * PI / lambda; + + v0 = tau / 2.0 * K2V; + E0 = SQR (v0) * VS2E; + + if (isnan (dtauovertau) == isnan (sigma)) { + MPI_MASTER ( + fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameters: provide either sigma or dtauovertau, or switch on ismirror\n", NAME_CURRENT_COMP);); + exit (-1); + } + } else { + if (!isnan (dtauovertau) || !isnan (sigma)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s WARNING: dtauovertau and/or sigma is ignored with ismirror==1\n", NAME_CURRENT_COMP);); + } + } + + if (!(R0 >= 0 && R0 <= 1.0)) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameter: R0 must be between 0 and 1\n", NAME_CURRENT_COMP);); + exit (-1); + } + + if (transmit < 0.0 || transmit > 1.0) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: Invalid parameter: transmit must be between 0 and 1\n", NAME_CURRENT_COMP);); + exit (-1); + } + + // transform Gaussian sigma from energy (meV) to neutron velocity (m/s) + if (!isnan (sigma)) + sigma /= 3.29106e-3 * tau; // constant is hbar/2 in appropriate units + + // transform smartwidth from energy (meV) to neutron velocity (m/s) + if (!isnan (smartwidth)) + smartwidth /= 3.29106e-3 * tau; // constant is hbar/2 in appropriate units + + // set standard widths for smartphase + if (isnan (smartwidth) && !isnan (sigma)) + smartwidth = 5.0 * sigma; + + if (isnan (smartwidth) && !isnan (dtauovertau)) + smartwidth = 10.0 * dtauovertau * v0; + + if (smartphase && !isnan (dtauovertau)) { + MPI_MASTER (fprintf (stderr, + "PerfectCrystal: %s WARNING: Using smartphase for ewald/darwin curves is probably a bad idea, because these curves have very long wings " + "which will be cut off!!!\n", + NAME_CURRENT_COMP);); + } + + if (facette_xi) { + if (facette_xi < 0) { + MPI_MASTER (fprintf (stderr, "PerfectCrystal: %s ERROR: facette_xi must be >= 0\n", NAME_CURRENT_COMP);); + exit (-1); + } + + sin_facette_xi = sin (DEG2RAD * facette_xi); + } + + // talk to the user ... + if (verbose) { + #define PRINTVAR(str,val) fprintf(stderr,"%s --- %s : %g\n",NAME_CURRENT_COMP,str,val); + MPI_MASTER (PRINTVAR ("ttmin", ttmin); PRINTVAR ("ttmax", ttmax); PRINTVAR ("ttwidth", ttwidth); PRINTVAR ("width", width); PRINTVAR ("phimin", phimin); + PRINTVAR ("phimax", phimax); PRINTVAR ("phi0", phi0); PRINTVAR ("phiwidth", phiwidth); PRINTVAR ("height", height); + PRINTVAR ("centerfocus", centerfocus); PRINTVAR ("debyescherrer", debyescherrer); PRINTVAR ("radius", radius); PRINTVAR ("facette", facette); + PRINTVAR ("facette_xi", facette_xi); PRINTVAR ("sin_facette_xi", sin_facette_xi); PRINTVAR ("tau", tau); PRINTVAR ("lambda", lambda); + PRINTVAR ("v0", v0); PRINTVAR ("E0", E0); PRINTVAR ("dtauovertau", dtauovertau); PRINTVAR ("dtauovertau_ext", dtauovertau_ext); + PRINTVAR ("ewald", ewald); PRINTVAR ("R0", R0); PRINTVAR ("sigma[m/s]", sigma); PRINTVAR ("ismirror", ismirror); PRINTVAR ("speed", speed); + PRINTVAR ("amplitude", amplitude); PRINTVAR ("smartphase", smartphase); PRINTVAR ("smartwidth[m/s]", smartwidth); + PRINTVAR ("exclusive", exclusive);); + } %} TRACE %{ - double dt1, dt2, q0mod; - double nx,ny,nz; - int missed = 0; - - // determine phase of doppler movement - if ( (speed!=0) && smartphase) - { - // do something smart - vmin = v0 - sqrt(SQR(vx)+SQR(vy)+SQR(vz)) - smartwidth; - vmax = vmin + 2.0*smartwidth; - - if ( (vmin>speed) || (vmax<-speed) ) - ABSORB; - - if ( vmin < -speed ) - vmin = -speed; - - if ( vmax > speed ) - vmax = speed; - -// fprintf(stderr,"%g %g\n",vmin,vmax); - - vd = vmin + (vmax-vmin)*rand01(); - phid = acos(vd/speed) + (rand01()<0.5?0:PI); - zd = amplitude * sin(phid); - p *= (vmax-vmin) / 2.0 / speed; - } - else if ( speed!=0 ) - { - // random selection of phase -// phid = rand01() * 2.0 * PI; -// zd = amplitude * sin(phid); -// vd = speed * cos(phid); - - // random selection of speed - phid = acos(randpm1()) + (rand01()<0.5?0:PI); - vd = speed * cos(phid); - zd = amplitude * sin(phid); - } - else - { - // no movement - zd = 0; - vd = 0; - } - - // Propagate to analyzer and determine surface normal - if ( !radius ) - { - // flat analyzer, use height and width + double dt1, dt2, q0mod; + double nx, ny, nz; + int missed = 0; + + // determine phase of doppler movement + if ((speed != 0) && smartphase) { + // do something smart + vmin = v0 - sqrt (SQR (vx) + SQR (vy) + SQR (vz)) - smartwidth; + vmax = vmin + 2.0 * smartwidth; + + if ((vmin > speed) || (vmax < -speed)) + ABSORB; + if (vmin < -speed) + vmin = -speed; + + if (vmax > speed) + vmax = speed; + + // fprintf(stderr,"%g %g\n",vmin,vmax); + + vd = vmin + (vmax - vmin) * rand01 (); + phid = acos (vd / speed) + (rand01 () < 0.5 ? 0 : PI); + zd = amplitude * sin (phid); + p *= (vmax - vmin) / 2.0 / speed; + } else if (speed != 0) { + // random selection of phase + // phid = rand01() * 2.0 * PI; + // zd = amplitude * sin(phid); + // vd = speed * cos(phid); + + // random selection of speed + phid = acos (randpm1 ()) + (rand01 () < 0.5 ? 0 : PI); + vd = speed * cos (phid); + zd = amplitude * sin (phid); + } else { + // no movement + zd = 0; + vd = 0; + } + + // Propagate to analyzer and determine surface normal + if (!radius) { + // flat analyzer, use height and width + + // propoagate to surface + if (!vz) + ABSORB; + dt2 = (-z - zd) / vz; + PROP_DT (dt2); + + // see if the covered area is hit + missed = !inside_rectangle (x, y, width, height); + + // surface normal in this case is simple + nx = 0; + ny = 0; + nz = -1; + } else { + // spherical analyzer, use spherical coordinates ... + + // compute neutron path intersection with analyzer sphere + if (centerfocus) + missed = !sphere_intersect (&dt1, &dt2, x, y, z + zd, vx, vy, vz, radius); + else + missed = !sphere_intersect (&dt1, &dt2, x, y, z + radius + zd, vx, vy, vz, radius); + + if (!missed) { // propoagate to surface - if (!vz) - ABSORB; - dt2 = (-z-zd) / vz; - PROP_DT(dt2); - - // see if the covered area is hit - missed = !inside_rectangle(x,y,width,height); - - // surface normal in this case is simple - nx=0;ny=0;nz=-1; - } - else - { - // spherical analyzer, use spherical coordinates ... - - // compute neutron path intersection with analyzer sphere - if ( centerfocus ) - missed = !sphere_intersect(&dt1,&dt2,x,y,z+zd,vx,vy,vz,radius); - else - missed = !sphere_intersect(&dt1,&dt2,x,y,z+radius+zd,vx,vy,vz,radius); - - if ( !missed ) - { - // propoagate to surface - PROP_DT(dt2); - - // tt (twotheta) is calculated as in IN16B, positive values downstream rightwards - // select coordinate system depending on 'debyescherrer' switch - double zprime = z+(centerfocus?0:radius)+zd; - if (debyescherrer) { - tt = RAD2DEG * atan2( sqrt(SQR(x)+SQR(y)) , zprime ); - phi = RAD2DEG * atan2(y,-x); - } else { - tt = - RAD2DEG * atan2(x,zprime); - phi = RAD2DEG * asin( y/sqrt( SQR(x) + SQR(y) + SQR(zprime) ) ); - } - - missed = (ttttmax || phiphimax); - - if ( !missed ) - { - // analyzer surface normal - if ( facette ) { - // calculate center of the facette hit - // always use spherical coordinates with y main axis (as in debyescherrer=0), - // otherwise the pole will be in the analyzer center! - // for the sake of confusion, use radians in this part. - double tt1, ttfacette, ttn, phi1, phifacette, phin; - if (debyescherrer) { - tt1 = - atan2(x,zprime); - phi1 = asin( y/sqrt( SQR(x) + SQR(y) + SQR(zprime) ) ); - } else { - tt1 = DEG2RAD * tt; - phi1 = DEG2RAD * phi; - } - - phifacette = facette / radius; - phin = floor( phi1 / phifacette + 0.5 ) * phifacette; - ttfacette = facette / (radius*cos(phin)); - ttn = floor( tt1 / ttfacette + 0.5 ) * ttfacette; - - nx = cos(phin)*sin(ttn); - ny = -sin(phin); - nz = -cos(phin)*cos(ttn); - - if (facette_xi) - { - grandvec_target_circle(&nx,&ny,&nz,NULL,nx,ny,nz,sin_facette_xi); - } - } else { - nx = -x; - ny = -y; - nz = -z-(centerfocus?0:radius)-zd; - NORM(nx,ny,nz); - } - } - } - } - - // Do the reflection - if ( !missed ) - { - // velocity vector projected on surface normal - // in moving doppler frame - vperp = scalar_prod(vx,vy,vz+vd,nx,ny,nz); - - // angle between surface normal and velocity (only used as output parameter for monitoring) - xi = RAD2DEG * acos( - vperp / sqrt( SQR(vx) + SQR(vy) + SQR(vz+vd) ) ); - - // energy selection - if (!ismirror) - { - if ( !isnan(dtauovertau) ) - { - // eps is actually abs(y) - // vperp is negative! - double this_tau = tau; - if ( dtauovertau_ext ) - { - this_tau *= 1.0 + 0.5*dtauovertau_ext*randpm1(); - } - - eps = fabs( 4.0*vperp*V2K/this_tau + 2.0 ) / dtauovertau; - - // Darwin/Ewald curve - if ( eps > 1 ) - { - if ( ewald ) - { - // energy selection with Ewald curve - R = 1.0 - sqrt(SQR(eps)-1.0) / eps; - } - else - { - // energy selection with Darwin curve - R = eps - sqrt(SQR(eps)-1.0); - R *= R; - } - - R *= R0; - } - else - { - R = R0; - } - } - else - { - // Gauss curve (vperp is negative!) - eps = fabs(v0 + vperp) / sigma; - R = exp( -SQR(eps) / 2.0 ); - - R *= R0; - } + PROP_DT (dt2); + + // tt (twotheta) is calculated as in IN16B, positive values downstream rightwards + // select coordinate system depending on 'debyescherrer' switch + double zprime = z + (centerfocus ? 0 : radius) + zd; + if (debyescherrer) { + tt = RAD2DEG * atan2 (sqrt (SQR (x) + SQR (y)), zprime); + phi = RAD2DEG * atan2 (y, -x); + } else { + tt = -RAD2DEG * atan2 (x, zprime); + phi = RAD2DEG * asin (y / sqrt (SQR (x) + SQR (y) + SQR (zprime))); } - else - { - R = 1; - eps = NAN; + + missed = (tt < ttmin || tt > ttmax || phi < phimin || phi > phimax); + + if (!missed) { + // analyzer surface normal + if (facette) { + // calculate center of the facette hit + // always use spherical coordinates with y main axis (as in debyescherrer=0), + // otherwise the pole will be in the analyzer center! + // for the sake of confusion, use radians in this part. + double tt1, ttfacette, ttn, phi1, phifacette, phin; + if (debyescherrer) { + tt1 = -atan2 (x, zprime); + phi1 = asin (y / sqrt (SQR (x) + SQR (y) + SQR (zprime))); + } else { + tt1 = DEG2RAD * tt; + phi1 = DEG2RAD * phi; + } + + phifacette = facette / radius; + phin = floor (phi1 / phifacette + 0.5) * phifacette; + ttfacette = facette / (radius * cos (phin)); + ttn = floor (tt1 / ttfacette + 0.5) * ttfacette; + + nx = cos (phin) * sin (ttn); + ny = -sin (phin); + nz = -cos (phin) * cos (ttn); + + if (facette_xi) { + grandvec_target_circle (&nx, &ny, &nz, NULL, nx, ny, nz, sin_facette_xi); + } + } else { + nx = -x; + ny = -y; + nz = -z - (centerfocus ? 0 : radius) - zd; + NORM (nx, ny, nz); + } } + } + } + + // Do the reflection + if (!missed) { + // velocity vector projected on surface normal + // in moving doppler frame + vperp = scalar_prod (vx, vy, vz + vd, nx, ny, nz); + + // angle between surface normal and velocity (only used as output parameter for monitoring) + xi = RAD2DEG * acos (-vperp / sqrt (SQR (vx) + SQR (vy) + SQR (vz + vd))); + + // energy selection + if (!ismirror) { + if (!isnan (dtauovertau)) { + // eps is actually abs(y) + // vperp is negative! + double this_tau = tau; + if (dtauovertau_ext) { + this_tau *= 1.0 + 0.5 * dtauovertau_ext * randpm1 (); + } + + eps = fabs (4.0 * vperp * V2K / this_tau + 2.0) / dtauovertau; + + // Darwin/Ewald curve + if (eps > 1) { + if (ewald) { + // energy selection with Ewald curve + R = 1.0 - sqrt (SQR (eps) - 1.0) / eps; + } else { + // energy selection with Darwin curve + R = eps - sqrt (SQR (eps) - 1.0); + R *= R; + } + + R *= R0; + } else { + R = R0; + } + } else { + // Gauss curve (vperp is negative!) + eps = fabs (v0 + vperp) / sigma; + R = exp (-SQR (eps) / 2.0); - if ( transmit && (R!=1) && (rand01()0.5*yheight ||x<-0.5*xwidth || x>0.5*xwidth) { + if (y < -0.5 * yheight || y > 0.5 * yheight || x < -0.5 * xwidth || x > 0.5 * xwidth) { /*Missed flat face bender. Leave neutron be*/ - channel_no=-1; - RESTORE_NEUTRON(INDEX_CURRENT_COMP,x,y,z,vx,vy,vz,t,sx,sy,sz,p); + channel_no = -1; + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } - fprintf(stderr,"Error(%s): flat face bender tapering is not supported yet. Please use a large entry_raidus instead. Aborting.\n", NAME_CURRENT_COMP); - exit(-1); - }else if(entry_radius){ - status=cylinder_intersect(&t0,&t1,x,y,z-(-entry_radius),vx,vy,vz,entry_radius,1000); - if (entry_radius>0){ - PROP_DT(t1); - }else{ - PROP_DT(t0); + fprintf (stderr, "Error(%s): flat face bender tapering is not supported yet. Please use a large entry_raidus instead. Aborting.\n", NAME_CURRENT_COMP); + exit (-1); + } else if (entry_radius) { + status = cylinder_intersect (&t0, &t1, x, y, z - (-entry_radius), vx, vy, vz, entry_radius, 1000); + if (entry_radius > 0) { + PROP_DT (t1); + } else { + PROP_DT (t0); } - xo=x;yo=y;zo=z; - vox=vx;voy=vy;voz=vz; - if (!status || t1<0 || y<-0.5*yheight || y>0.5*yheight ||xentry_radius*sin(0.5*rw/entry_radius)){ + xo = x; + yo = y; + zo = z; + vox = vx; + voy = vy; + voz = vz; + if (!status || t1 < 0 || y < -0.5 * yheight || y > 0.5 * yheight || x < entry_radius * sin (-0.5 * rw / entry_radius) + || x > entry_radius * sin (0.5 * rw / entry_radius)) { /*Missed curved face bender. leave neutron be*/ - channel_no=-1; - RESTORE_NEUTRON(INDEX_CURRENT_COMP,x,y,z,vx,vy,vz,t,sx,sy,sz,p); + channel_no = -1; + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } } - if(channel_no!=-1){ + if (channel_no != -1) { /*So we actually hit the bender face - proceed*/ - double cphi, sphi, d1,d2, p0x,p0z, p1x,p1z, p2x,p2z, c1x,c1z, c2x,c2z, q0x,q0z, q1x,q1z, q2x,q2z, r1x,r1z, r2x,r2z; + double cphi, sphi, d1, d2, p0x, p0z, p1x, p1z, p2x, p2z, c1x, c1z, c2x, c2z, q0x, q0z, q1x, q1z, q2x, q2z, r1x, r1z, r2x, r2z; if (entry_radius) { - channel_no=0; + channel_no = 0; /*offsets of channel entry - initialize * outer edge (dx2) : bender end + 1 substrate thickness + coating (outer) * inner edge (dx1) : outer edge + channel width*/ - dx2 = -0.5*rw + d_substrate + T.data[channel_no*T.columns + 3]; - if ( x< dx2){ + dx2 = -0.5 * rw + d_substrate + T.data[channel_no * T.columns + 3]; + if (x < dx2) { /*hit first substrate*/ ABSORB; } - dx1 = dx2 +T.data[channel_no*T.columns + 0]; + dx1 = dx2 + T.data[channel_no * T.columns + 0]; - cphi=cos(length/radius); - sphi=sin(length/radius); + cphi = cos (length / radius); + sphi = sin (length / radius); - q0x=radius*(1-cos(length/radius));/*exit point of bender centre*/ - q0z=radius*(sin(length/radius)); + q0x = radius * (1 - cos (length / radius)); /*exit point of bender centre*/ + q0z = radius * (sin (length / radius)); /*the plates will end on a cirle of this radius*/ - outer_radius=entry_radius+length;//sqrt(q0x*q0x + (q0z+entry_radius)*(q0z+entry_radius)); + outer_radius = entry_radius + length; // sqrt(q0x*q0x + (q0z+entry_radius)*(q0z+entry_radius)); - p2x= entry_radius*sin(dx2/entry_radius); /*channel entry coordinates*/ - p2z= entry_radius*(cos(dx2/entry_radius)-1); - p1x= entry_radius*sin(dx1/entry_radius); - p1z= entry_radius*(cos(dx1/entry_radius)-1); + p2x = entry_radius * sin (dx2 / entry_radius); /*channel entry coordinates*/ + p2z = entry_radius * (cos (dx2 / entry_radius) - 1); + p1x = entry_radius * sin (dx1 / entry_radius); + p1z = entry_radius * (cos (dx1 / entry_radius) - 1); - dx2_q = -0.5*rw_q + d_substrate + T.data[channel_no*T.columns + 3]; + dx2_q = -0.5 * rw_q + d_substrate + T.data[channel_no * T.columns + 3]; /*add the offset due to blade curvature to dx2_q*/ - //dx2_q += asin(q0x/outer_radius)*outer_radius; - dx1_q = dx2_q + T.data[channel_no*T.columns + 1]; + // dx2_q += asin(q0x/outer_radius)*outer_radius; + dx1_q = dx2_q + T.data[channel_no * T.columns + 1]; - q2x= q0x - dx2_q*(-cphi);/*exit point of outer channel edge (without correction for channel blade length)*/ - q2z= q0z - dx2_q*(sphi); - q1x= q0x - dx1_q*(-cphi);/*exit point of inner channel edge (without correction for channel blade length)*/ - q1z= q0z - dx1_q*(sphi); + q2x = q0x - dx2_q * (-cphi); /*exit point of outer channel edge (without correction for channel blade length)*/ + q2z = q0z - dx2_q * (sphi); + q1x = q0x - dx1_q * (-cphi); /*exit point of inner channel edge (without correction for channel blade length)*/ + q1z = q0z - dx1_q * (sphi); -#ifdef MCDEBUG - printf("%sPTS: %i %g %g %g %g %g %g %g %g %g %g\n",NAME_CURRENT_COMP,channel_no,p1x,p1z,p2x,p2z,q1x,q1z,q2x,q2z,q0x,q0z); -#endif + #ifdef MCDEBUG + printf ("%sPTS: %i %g %g %g %g %g %g %g %g %g %g\n", NAME_CURRENT_COMP, channel_no, p1x, p1z, p2x, p2z, q1x, q1z, q2x, q2z, q0x, q0z); + #endif - while ( !( x> entry_radius*sin(dx2/entry_radius) && x< entry_radius*sin(dx1/entry_radius) ) ){ + while (!(x > entry_radius * sin (dx2 / entry_radius) && x < entry_radius * sin (dx1 / entry_radius))) { channel_no++; - if(channel_no>T.rows){ - //printf("oops I've missed all channels "); - //printf("%lld %g %g %g %g %g %g %g\n",mcget_run_num(),x,y,z,vx,vy,vz,p); + if (channel_no > T.rows) { + // printf("oops I've missed all channels "); + // printf("%lld %g %g %g %g %g %g %g\n",mcget_run_num(),x,y,z,vx,vy,vz,p); ABSORB; } /*offsets of channel entry - update * outer edge (dx2) : previous inner edge + 1 coating (inner) + substrate thickness + coating (outer) * inner edge (dx1) : outer edge + channel width*/ - dx2=dx1 + T.data[channel_no*T.columns + 3] + d_substrate + T.data[channel_no*T.columns + 4]; + dx2 = dx1 + T.data[channel_no * T.columns + 3] + d_substrate + T.data[channel_no * T.columns + 4]; /*now check if we've hit the blade*/ - //if ( x< dx2 && x>dx1 ){ - /*hit a substrate*/ + // if ( x< dx2 && x>dx1 ){ + /*hit a substrate*/ // ABSORB; //} - dx1=dx2 + T.data[channel_no*T.columns + 0]; - - dx2_q= dx1_q + d_substrate + T.data[channel_no*T.columns + 3]+ T.data[channel_no*T.columns + 4]; - dx1_q= dx2_q+T.data[channel_no*T.columns + 1]; - - - p2x= entry_radius*sin(dx2/entry_radius); - p2z= entry_radius*(cos(dx2/entry_radius)-1); - p1x= entry_radius*sin(dx1/entry_radius); - p1z= entry_radius*(cos(dx1/entry_radius)-1); - - q2x= q0x - dx2_q*(-cphi);/*exit point of outer channel edge (without correction for channel blade length)*/ - q2z= q0z - dx2_q*(sphi); - q1x= q0x - dx1_q*(-cphi);/*exit point of inner channel edge (without correction for channel blade length)*/ - q1z= q0z - dx1_q*(sphi); - - q1x=outer_radius*sin(dx1_q/outer_radius); - q1z=outer_radius*(cos(dx1_q/outer_radius))-entry_radius; - q2x=outer_radius*sin(dx2_q/outer_radius); - q2z=outer_radius*(cos(dx2_q/outer_radius))-entry_radius; - double h1,D1,h2,D2; + dx1 = dx2 + T.data[channel_no * T.columns + 0]; + + dx2_q = dx1_q + d_substrate + T.data[channel_no * T.columns + 3] + T.data[channel_no * T.columns + 4]; + dx1_q = dx2_q + T.data[channel_no * T.columns + 1]; + + p2x = entry_radius * sin (dx2 / entry_radius); + p2z = entry_radius * (cos (dx2 / entry_radius) - 1); + p1x = entry_radius * sin (dx1 / entry_radius); + p1z = entry_radius * (cos (dx1 / entry_radius) - 1); + + q2x = q0x - dx2_q * (-cphi); /*exit point of outer channel edge (without correction for channel blade length)*/ + q2z = q0z - dx2_q * (sphi); + q1x = q0x - dx1_q * (-cphi); /*exit point of inner channel edge (without correction for channel blade length)*/ + q1z = q0z - dx1_q * (sphi); + + q1x = outer_radius * sin (dx1_q / outer_radius); + q1z = outer_radius * (cos (dx1_q / outer_radius)) - entry_radius; + q2x = outer_radius * sin (dx2_q / outer_radius); + q2z = outer_radius * (cos (dx2_q / outer_radius)) - entry_radius; + double h1, D1, h2, D2; /*helper variables to to compute intersection points of circles*/ /*We need to put h1 and h2 to the side the bender is curving to - hence the sign operation*/ - D1=sqrt( (q1x-p1x)*(q1x-p1x) + (q1z-p1z)*(q1z-p1z) ) ; - h1=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D1*D1); - D2=sqrt( (q2x-p2x)*(q2x-p2x) + (q2z-p2z)*(q2z-p2z) ) ; - h2=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D2*D2); + D1 = sqrt ((q1x - p1x) * (q1x - p1x) + (q1z - p1z) * (q1z - p1z)); + h1 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D1 * D1); + D2 = sqrt ((q2x - p2x) * (q2x - p2x) + (q2z - p2z) * (q2z - p2z)); + h2 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D2 * D2); - c1x= p1x + 0.5*(q1x-p1x) + h1/D1 * (q1z-p1z); /*these are the centers around which the channel edges actually rotate*/ - c1z= p1z + 0.5*(q1z-p1z) + h1/D1 * -(q1x-p1x); /*positive*/ + c1x = p1x + 0.5 * (q1x - p1x) + h1 / D1 * (q1z - p1z); /*these are the centers around which the channel edges actually rotate*/ + c1z = p1z + 0.5 * (q1z - p1z) + h1 / D1 * -(q1x - p1x); /*positive*/ - c2x= p2x + 0.5*(q2x-p2x) + h2/D2 * (q2z-p2z); /*negative*/ - c2z= p2z + 0.5*(q2z-p2z) + h2/D2 * -(q2x-p2x); + c2x = p2x + 0.5 * (q2x - p2x) + h2 / D2 * (q2z - p2z); /*negative*/ + c2z = p2z + 0.5 * (q2z - p2z) + h2 / D2 * -(q2x - p2x); /*now find the exit points to place exit plane*/ - r1x=c1x + cphi*(p1x-c1x) + sphi*(p1z-c1z); - r1z=c1z - sphi*(p1x-c1x) + cphi*(p1z-c1z); - - r2x=c2x + cphi*(p2x-c2x) + sphi*(p2z-c2z); - r2z=c2z - sphi*(p2x-c2x) + cphi*(p2z-c2z); - double nx,ny,nz; - vec_prod(nx,ny,nz,0.0,1.0,0.0,r2x-r1x,0,r2z-r1z); - //printf("DEBUG: %d %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",channel_no,p1x,p1z,p2x,p2z, r1x,r1z,r2x,r2z, q1x,q1z,q2x,q2z,outer_radius, q0x,q0z, asin(q0x/outer_radius)*outer_radius, c1x,c1z,c2x,c2z,dx1,dx2,dx1_q,dx2_q); + r1x = c1x + cphi * (p1x - c1x) + sphi * (p1z - c1z); + r1z = c1z - sphi * (p1x - c1x) + cphi * (p1z - c1z); + + r2x = c2x + cphi * (p2x - c2x) + sphi * (p2z - c2z); + r2z = c2z - sphi * (p2x - c2x) + cphi * (p2z - c2z); + double nx, ny, nz; + vec_prod (nx, ny, nz, 0.0, 1.0, 0.0, r2x - r1x, 0, r2z - r1z); + // printf("DEBUG: %d %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",channel_no,p1x,p1z,p2x,p2z, + // r1x,r1z,r2x,r2z, q1x,q1z,q2x,q2z,outer_radius, q0x,q0z, asin(q0x/outer_radius)*outer_radius, c1x,c1z,c2x,c2z,dx1,dx2,dx1_q,dx2_q); } /*set a scatter upon entry*/ SCATTER; - }else{ + } else { /*so it is a flat face bender*/ - channel_no=0; - dx2=-0.5*rw; - dx1=dx2+T.data[channel_no*T.columns + 0] + T.data[channel_no*T.columns + 4] + T.data[channel_no*T.columns + 3]; - while (!(x>dx2 && x dx2 && x < dx1)) { channel_no++; - dx2=dx1; - dx1+=T.data[channel_no*T.columns + 0] + T.data[channel_no*T.columns + 4] + T.data[channel_no*T.columns + 3]; + dx2 = dx1; + dx1 += T.data[channel_no * T.columns + 0] + T.data[channel_no * T.columns + 4] + T.data[channel_no * T.columns + 3]; } - rx=(dx1+dx2)*0.5; + rx = (dx1 + dx2) * 0.5; SCATTER; } /*now the channel number is known. Given the central curvature of bender we may compute the placement of inner and outer cylinders. */ /*Some helper points and variables: q is the end point of the uncurved blade. - r is the end point of the curved blade + r is the end point of the curved blade we get the offset of the curved endpoint from the central blade, and apply it to vectors parallel and perpendicular to QP.*/ - q1x=outer_radius*sin(dx1_q/outer_radius); - q1z=outer_radius*(cos(dx1_q/outer_radius))-entry_radius; - q2x=outer_radius*sin(dx2_q/outer_radius); - q2z=outer_radius*(cos(dx2_q/outer_radius))-entry_radius; - - double L1,L2; - L1=sqrt( (q1x-p1x)*(q1x-p1x) + (q1z-p1z)*(q1z-p1z) ) ; - L2=sqrt( (q2x-p2x)*(q2x-p2x) + (q2z-p2z)*(q2z-p2z) ) ; - r1x=p1x + q0z * (q1x-p1x)/L1 + q0x* (q1z-p1z)/L1; - r1z=p1z + q0z * (q1z-p1z)/L1 + q0x* -(q1x-p1x)/L1; - r2x=p2x + q0z * (q2x-p2x)/L2 + q0x* (q2z-p2z)/L2; - r2z=p2z + q0z * (q2z-p2z)/L2 + q0x* -(q2x-p2x)/L2; - - double h1,D1,h2,D2; + q1x = outer_radius * sin (dx1_q / outer_radius); + q1z = outer_radius * (cos (dx1_q / outer_radius)) - entry_radius; + q2x = outer_radius * sin (dx2_q / outer_radius); + q2z = outer_radius * (cos (dx2_q / outer_radius)) - entry_radius; + + double L1, L2; + L1 = sqrt ((q1x - p1x) * (q1x - p1x) + (q1z - p1z) * (q1z - p1z)); + L2 = sqrt ((q2x - p2x) * (q2x - p2x) + (q2z - p2z) * (q2z - p2z)); + r1x = p1x + q0z * (q1x - p1x) / L1 + q0x * (q1z - p1z) / L1; + r1z = p1z + q0z * (q1z - p1z) / L1 + q0x * -(q1x - p1x) / L1; + r2x = p2x + q0z * (q2x - p2x) / L2 + q0x * (q2z - p2z) / L2; + r2z = p2z + q0z * (q2z - p2z) / L2 + q0x * -(q2x - p2x) / L2; + + double h1, D1, h2, D2; /*helper variables to to compute intersection points of circles*/ /*We need to put h1 and h2 to the side the bender is curving to - hence the sign operation*/ - D1=sqrt( (r1x-p1x)*(r1x-p1x) + (r1z-p1z)*(r1z-p1z) ) ; - h1=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D1*D1); - D2=sqrt( (r2x-p2x)*(r2x-p2x) + (r2z-p2z)*(r2z-p2z) ) ; - h2=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D2*D2); + D1 = sqrt ((r1x - p1x) * (r1x - p1x) + (r1z - p1z) * (r1z - p1z)); + h1 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D1 * D1); + D2 = sqrt ((r2x - p2x) * (r2x - p2x) + (r2z - p2z) * (r2z - p2z)); + h2 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D2 * D2); - c1x= p1x + 0.5*(r1x-p1x) + h1/D1 * (r1z-p1z); /*these are the centers around which the channel edges actually rotate*/ - c1z= p1z + 0.5*(r1z-p1z) + h1/D1 * -(r1x-p1x); /*positive*/ + c1x = p1x + 0.5 * (r1x - p1x) + h1 / D1 * (r1z - p1z); /*these are the centers around which the channel edges actually rotate*/ + c1z = p1z + 0.5 * (r1z - p1z) + h1 / D1 * -(r1x - p1x); /*positive*/ - c2x= p2x + 0.5*(r2x-p2x) + h2/D2 * (r2z-p2z); /*negative*/ - c2z= p2z + 0.5*(r2z-p2z) + h2/D2 * -(r2x-p2x); + c2x = p2x + 0.5 * (r2x - p2x) + h2 / D2 * (r2z - p2z); /*negative*/ + c2z = p2z + 0.5 * (r2z - p2z) + h2 / D2 * -(r2x - p2x); /*now find the exit points to place exit plane*/ -/* r1x=c1x + cphi*(p1x-c1x) + sphi*(p1z-c1z);*/ -/* r1z=c1z - sphi*(p1x-c1x) + cphi*(p1z-c1z);*/ -/**/ -/* r2x=c2x + cphi*(p2x-c2x) + sphi*(p2z-c2z);*/ -/* r2z=c2z - sphi*(p2x-c2x) + cphi*(p2z-c2z);*/ - double nx,ny,nz; - vec_prod(nx,ny,nz,0.0,1.0,0.0,r2x-r1x,0,r2z-r1z); -#ifdef MCDEBUG - printf("%sPTS2: %d %g %g %g %g\n",NAME_CURRENT_COMP,channel_no,r1x,r1z,r2x,r2z); -#endif - //printf("DEBUG: %d %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",channel_no,p1x,p1z,p2x,p2z, r1x,r1z,r2x,r2z, q1x,q1z,q2x,q2z,outer_radius, q0x,q0z, asin(q0x/outer_radius)*outer_radius, c1x,c1z,c2x,c2z); - - int exit=0; - int coat1,coat2; /*are the blades coated at all*/ - coat1=(Table_Index(T,channel_no,3)>0.0);/*positive side coating*/ - coat2=(Table_Index(T,channel_no,4)>0.0);/*negative side coating*/ + /* r1x=c1x + cphi*(p1x-c1x) + sphi*(p1z-c1z);*/ + /* r1z=c1z - sphi*(p1x-c1x) + cphi*(p1z-c1z);*/ + /**/ + /* r2x=c2x + cphi*(p2x-c2x) + sphi*(p2z-c2z);*/ + /* r2z=c2z - sphi*(p2x-c2x) + cphi*(p2z-c2z);*/ + double nx, ny, nz; + vec_prod (nx, ny, nz, 0.0, 1.0, 0.0, r2x - r1x, 0, r2z - r1z); + #ifdef MCDEBUG + printf ("%sPTS2: %d %g %g %g %g\n", NAME_CURRENT_COMP, channel_no, r1x, r1z, r2x, r2z); + #endif + // printf("DEBUG: %d %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",channel_no,p1x,p1z,p2x,p2z, r1x,r1z,r2x,r2z, + // q1x,q1z,q2x,q2z,outer_radius, q0x,q0z, asin(q0x/outer_radius)*outer_radius, c1x,c1z,c2x,c2z); + + int exit = 0; + int coat1, coat2; /*are the blades coated at all*/ + coat1 = (Table_Index (T, channel_no, 3) > 0.0); /*positive side coating*/ + coat2 = (Table_Index (T, channel_no, 4) > 0.0); /*negative side coating*/ do { - int i1,i2,ic,ie,cyl; - double t10,t11,t20,t21,tc,te; + int i1, i2, ic, ie, cyl; + double t10, t11, t20, t21, tc, te; /*initialize times to seomthing known*/ - t10=t11=0; - t20=t21=0; - te=0; - i1=cylinder_intersect(&t10,&t11,x-c1x,y,z-c1z,vx,vy,vz,radius,yheight); - i2=cylinder_intersect(&t20,&t21,x-c2x,y,z-c2z,vx,vy,vz,radius,yheight); - ie=plane_intersect(&te,x,y,z,vx,vy,vz,nx,ny,nz,r1x,0,r1z); + t10 = t11 = 0; + t20 = t21 = 0; + te = 0; + i1 = cylinder_intersect (&t10, &t11, x - c1x, y, z - c1z, vx, vy, vz, radius, yheight); + i2 = cylinder_intersect (&t20, &t21, x - c2x, y, z - c2z, vx, vy, vz, radius, yheight); + ie = plane_intersect (&te, x, y, z, vx, vy, vz, nx, ny, nz, r1x, 0, r1z); /*catch the different cases*/ - if ( (!ie) && ( !i1 && !i2) ){ - fprintf(stderr,"Pol_bender (%s): Neutron xyz=(%g %g %g), v=(%g %g %g) cannot exit the bender or does not intersect either edge cylinder\n",NAME_CURRENT_COMP,x,y,z,vx,vy,vz); - ABSORB;/*this should really not happen*/ + if ((!ie) && (!i1 && !i2)) { + fprintf (stderr, "Pol_bender (%s): Neutron xyz=(%g %g %g), v=(%g %g %g) cannot exit the bender or does not intersect either edge cylinder\n", + NAME_CURRENT_COMP, x, y, z, vx, vy, vz); + ABSORB; /*this should really not happen*/ } /*find the smallest strictly positive intersection time of te, t21 and t10*/ - double tt=FLT_MAX; + double tt = FLT_MAX; /*first we mask strictly nonpositive times with a very large number (FLT_MAX)*/ - t10=t10<=0?FLT_MAX:t10; - t21=t21<=0?FLT_MAX:t21; - te=te<=0?FLT_MAX:te; + t10 = t10 <= 0 ? FLT_MAX : t10; + t21 = t21 <= 0 ? FLT_MAX : t21; + te = te <= 0 ? FLT_MAX : te; /*if radius<0 the edge on the positve x side becomes the outer one. * This means we chould compare t11 with t20, so in that case swap, and the algorithm should work*/ - if (radius<0){ - t10=t11; - t21=t20; + if (radius < 0) { + t10 = t11; + t21 = t20; } - enum{TOPBOTTOM,ENDFACE,CYL,CYL2,CYL1,UNKNOWN} branch; + enum { TOPBOTTOM, ENDFACE, CYL, CYL2, CYL1, UNKNOWN } branch; - if (i2 &&(t21 20 && channel_no!=0 && channel_no!=T.rows-1 && channel_no%100!=0){ + for (channel_no = 0; channel_no < T.rows; channel_no++) { + if (T.rows > 20 && channel_no != 0 && channel_no != T.rows - 1 && channel_no % 100 != 0) { /*update the relative coordinates of the channel entry and exits but don't actually draw anything*/ - dx2=dx1 + T.data[channel_no*T.columns + 3] + d_substrate + T.data[channel_no*T.columns + 4]; - dx1=dx2 + T.data[channel_no*T.columns + 0]; + dx2 = dx1 + T.data[channel_no * T.columns + 3] + d_substrate + T.data[channel_no * T.columns + 4]; + dx1 = dx2 + T.data[channel_no * T.columns + 0]; - dx2_q= dx1_q + d_substrate + T.data[channel_no*T.columns + 3]+ T.data[channel_no*T.columns + 4]; - dx1_q= dx2_q+T.data[channel_no*T.columns + 1]; + dx2_q = dx1_q + d_substrate + T.data[channel_no * T.columns + 3] + T.data[channel_no * T.columns + 4]; + dx1_q = dx2_q + T.data[channel_no * T.columns + 1]; continue; } @@ -617,92 +630,89 @@ MCDISPLAY /*offsets of channel entry - initialize * outer edge (dx2) : bender end + 1 substrate thickness + coating (outer) * inner edge (dx1) : outer edge + channel width*/ - p2x= entry_radius*sin(dx2/entry_radius); /*channel entry coordinates*/ - p2z= entry_radius*(cos(dx2/entry_radius)-1); - p1x= entry_radius*sin(dx1/entry_radius); - p1z= entry_radius*(cos(dx1/entry_radius)-1); + p2x = entry_radius * sin (dx2 / entry_radius); /*channel entry coordinates*/ + p2z = entry_radius * (cos (dx2 / entry_radius) - 1); + p1x = entry_radius * sin (dx1 / entry_radius); + p1z = entry_radius * (cos (dx1 / entry_radius) - 1); } - q0x=radius*(1-cos(length/radius));/*exit point of bender centre*/ - q0z=radius*(sin(length/radius)); + q0x = radius * (1 - cos (length / radius)); /*exit point of bender centre*/ + q0z = radius * (sin (length / radius)); + cphi = cos (length / radius); + sphi = sin (length / radius); - cphi=cos(length/radius); - sphi=sin(length/radius); + q2x = q0x - dx2_q * (-cphi); /*exit point of outer channel edge (without correction for channel blade length)*/ + q2z = q0z - dx2_q * (sphi); + q1x = q0x - dx1_q * (-cphi); /*exit point of inner channel edge (without correction for channel blade length)*/ + q1z = q0z - dx1_q * (sphi); - q2x= q0x - dx2_q*(-cphi);/*exit point of outer channel edge (without correction for channel blade length)*/ - q2z= q0z - dx2_q*(sphi); - q1x= q0x - dx1_q*(-cphi);/*exit point of inner channel edge (without correction for channel blade length)*/ - q1z= q0z - dx1_q*(sphi); + double h1, D1, h2, D2; /*helper variables to to compute intersection points of circles*/ + D1 = sqrt ((q1x - p1x) * (q1x - p1x) + (q1z - p1z) * (q1z - p1z)); + h1 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D1 * D1); + D2 = sqrt ((q2x - p2x) * (q2x - p2x) + (q2z - p2z) * (q2z - p2z)); + h2 = (radius < 0 ? -1 : 1) * sqrt (radius * radius - 0.25 * D2 * D2); + c1x = p1x + 0.5 * (q1x - p1x) + h1 / D1 * (q1z - p1z); /*these are the centers around which the channel edges actually rotate*/ + c1z = p1z + 0.5 * (q1z - p1z) + h1 / D1 * -(q1x - p1x); /*positive*/ - double h1,D1,h2,D2; /*helper variables to to compute intersection points of circles*/ - D1=sqrt( (q1x-p1x)*(q1x-p1x) + (q1z-p1z)*(q1z-p1z) ) ; - h1=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D1*D1); - D2=sqrt( (q2x-p2x)*(q2x-p2x) + (q2z-p2z)*(q2z-p2z) ) ; - h2=(radius<0?-1:1)*sqrt( radius*radius - 0.25*D2*D2); - - c1x= p1x + 0.5*(q1x-p1x) + h1/D1 * (q1z-p1z); /*these are the centers around which the channel edges actually rotate*/ - c1z= p1z + 0.5*(q1z-p1z) + h1/D1 * -(q1x-p1x); /*positive*/ - - c2x= p2x + 0.5*(q2x-p2x) + h2/D2 * (q2z-p2z); /*negative*/ - c2z= p2z + 0.5*(q2z-p2z) + h2/D2 * -(q2x-p2x); + c2x = p2x + 0.5 * (q2x - p2x) + h2 / D2 * (q2z - p2z); /*negative*/ + c2z = p2z + 0.5 * (q2z - p2z) + h2 / D2 * -(q2x - p2x); /*now we know what the circles are - draw N circle segments at +h/2 and -h/2 to mark channels*/ - double dl=length/N; - double ro1x,ro1z,ro2x,ro2z; - ro1x=p1x; - ro1z=p1z; - ro2x=p2x; - ro2z=p2z; - multiline(5,ro1x,yh2,ro1z, ro1x,-yh2,ro1z, ro2x,-yh2,ro2z, ro2x,yh2,ro2z, ro1x,yh2,ro1z); - - cphi=cos(dl/radius); - sphi=sin(dl/radius); + double dl = length / N; + double ro1x, ro1z, ro2x, ro2z; + ro1x = p1x; + ro1z = p1z; + ro2x = p2x; + ro2z = p2z; + multiline (5, ro1x, yh2, ro1z, ro1x, -yh2, ro1z, ro2x, -yh2, ro2z, ro2x, yh2, ro2z, ro1x, yh2, ro1z); + + cphi = cos (dl / radius); + sphi = sin (dl / radius); /*now find the exit points to place exit plane of circle segment*/ - r1x=c1x + cphi*(p1x-c1x) + sphi*(p1z-c1z); - r1z=c1z - sphi*(p1x-c1x) + cphi*(p1z-c1z); + r1x = c1x + cphi * (p1x - c1x) + sphi * (p1z - c1z); + r1z = c1z - sphi * (p1x - c1x) + cphi * (p1z - c1z); - r2x=c2x + cphi*(p2x-c2x) + sphi*(p2z-c2z); - r2z=c2z - sphi*(p2x-c2x) + cphi*(p2z-c2z); + r2x = c2x + cphi * (p2x - c2x) + sphi * (p2z - c2z); + r2z = c2z - sphi * (p2x - c2x) + cphi * (p2z - c2z); /*loop until exit*/ - while (dl<=length){ - line(ro1x, yh2,ro1z,r1x, yh2,r1z); - line(ro2x, yh2,ro2z,r2x, yh2,r2z); - line(ro1x,-yh2,ro1z,r1x,-yh2,r1z); - line(ro2x,-yh2,ro2z,r2x,-yh2,r2z); + while (dl <= length) { + line (ro1x, yh2, ro1z, r1x, yh2, r1z); + line (ro2x, yh2, ro2z, r2x, yh2, r2z); + line (ro1x, -yh2, ro1z, r1x, -yh2, r1z); + line (ro2x, -yh2, ro2z, r2x, -yh2, r2z); /*update dl*/ - dl+=length/N; + dl += length / N; /*store old exit in ro1x etc.*/ - ro1x=r1x; - ro1z=r1z; - ro2x=r2x; - ro2z=r2z; + ro1x = r1x; + ro1z = r1z; + ro2x = r2x; + ro2z = r2z; - cphi=cos(dl/radius); - sphi=sin(dl/radius); + cphi = cos (dl / radius); + sphi = sin (dl / radius); /*now find the exit points to place exit plane of circle segment*/ - r1x=c1x + cphi*(p1x-c1x) + sphi*(p1z-c1z); - r1z=c1z - sphi*(p1x-c1x) + cphi*(p1z-c1z); + r1x = c1x + cphi * (p1x - c1x) + sphi * (p1z - c1z); + r1z = c1z - sphi * (p1x - c1x) + cphi * (p1z - c1z); - r2x=c2x + cphi*(p2x-c2x) + sphi*(p2z-c2z); - r2z=c2z - sphi*(p2x-c2x) + cphi*(p2z-c2z); + r2x = c2x + cphi * (p2x - c2x) + sphi * (p2z - c2z); + r2z = c2z - sphi * (p2x - c2x) + cphi * (p2z - c2z); } /*draw the last segment*/ - line(ro1x, yh2,ro1z,r1x, yh2,r1z); - line(ro2x, yh2,ro2z,r2x, yh2,r2z); - line(ro1x,-yh2,ro1z,r1x,-yh2,r1z); - line(ro2x,-yh2,ro2z,r2x,-yh2,r2z); - multiline(5,ro1x,yh2,ro1z, ro1x,-yh2,ro1z, ro2x,-yh2,ro2z, ro2x,yh2,ro2z, ro1x,yh2,ro1z); + line (ro1x, yh2, ro1z, r1x, yh2, r1z); + line (ro2x, yh2, ro2z, r2x, yh2, r2z); + line (ro1x, -yh2, ro1z, r1x, -yh2, r1z); + line (ro2x, -yh2, ro2z, r2x, -yh2, r2z); + multiline (5, ro1x, yh2, ro1z, ro1x, -yh2, ro1z, ro2x, -yh2, ro2z, ro2x, yh2, ro2z, ro1x, yh2, ro1z); /*update the relative coordinates of the channel entry and exits*/ - dx2=dx1 + T.data[channel_no*T.columns + 3] + d_substrate + T.data[channel_no*T.columns + 4]; - dx1=dx2 + T.data[channel_no*T.columns + 0]; - - dx2_q= dx1_q + d_substrate + T.data[channel_no*T.columns + 3]+ T.data[channel_no*T.columns + 4]; - dx1_q= dx2_q+T.data[channel_no*T.columns + 1]; + dx2 = dx1 + T.data[channel_no * T.columns + 3] + d_substrate + T.data[channel_no * T.columns + 4]; + dx1 = dx2 + T.data[channel_no * T.columns + 0]; + dx2_q = dx1_q + d_substrate + T.data[channel_no * T.columns + 3] + T.data[channel_no * T.columns + 4]; + dx1_q = dx2_q + T.data[channel_no * T.columns + 1]; } } %} diff --git a/mcstas-comps/contrib/Pol_pi_2_rotator.comp b/mcstas-comps/contrib/Pol_pi_2_rotator.comp index 1cd32cc3d..ebb681366 100755 --- a/mcstas-comps/contrib/Pol_pi_2_rotator.comp +++ b/mcstas-comps/contrib/Pol_pi_2_rotator.comp @@ -47,44 +47,39 @@ DECLARE INITIALIZE %{ -double rr=scalar_prod(rx,ry,rz,rx,ry,rz); - if (rr!=1){ - rx=rx/sqrt(rr); - ry=ry/sqrt(rr); - rz=rz/sqrt(rr); + double rr = scalar_prod (rx, ry, rz, rx, ry, rz); + if (rr != 1) { + rx = rx / sqrt (rr); + ry = ry / sqrt (rr); + rz = rz / sqrt (rr); } %} TRACE %{ - double t1,t2=0; - double rxs_x,rxs_y,rxs_z,rdots; + double t1, t2 = 0; + double rxs_x, rxs_y, rxs_z, rdots; /*check to see if we actually hit the component*/ - if(!box_intersect(&t1, &t2, x, y, z, vx, vy, vz,xwidth, yheight, zdepth)) - { + if (!box_intersect (&t1, &t2, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) { ABSORB; } - /*if so, propagate to the halfway point - i.e. the z-center fo the turner*/ - PROP_DT((t2-t1)/2.0); + PROP_DT ((t2 - t1) / 2.0); /*now turn spin and set SCATTERED, This to get a reference pt in mcdisplay*/ /*rodrigues' formula gives a rotation of v around u as: v_rot=cos(phi)v + sin(phi) u x v +(1-cos(phi)) (u.v)u*/ - rdots=scalar_prod(rx,ry,rz,sx,sy,sz); - vec_prod(rxs_x,rxs_y,rxs_z,rx,ry,rz,sx,sy,sz); - sx=rxs_x+ rdots*rx; - sy=rxs_y+ rdots*ry; - sz=rxs_z+ rdots*rz; - - SCATTERED; + rdots = scalar_prod (rx, ry, rz, sx, sy, sz); + vec_prod (rxs_x, rxs_y, rxs_z, rx, ry, rz, sx, sy, sz); + sx = rxs_x + rdots * rx; + sy = rxs_y + rdots * ry; + sz = rxs_z + rdots * rz; + SCATTERED; %} MCDISPLAY %{ - box((double) 0.0,(double) 0.0,(double) 0.0, - (double)xwidth,(double)yheight,(double)zdepth,0, 0, 1, 0); - + box ((double)0.0, (double)0.0, (double)0.0, (double)xwidth, (double)yheight, (double)zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/Pol_triafield.comp b/mcstas-comps/contrib/Pol_triafield.comp index c6a18c157..6208498a7 100644 --- a/mcstas-comps/contrib/Pol_triafield.comp +++ b/mcstas-comps/contrib/Pol_triafield.comp @@ -59,16 +59,17 @@ SETTING PARAMETERS (xwidth, yheight, zdepth, B=0, Bguide=0) SHARE %{ -double IntersectWall(double pos, double vel, double wallpos) { + double + IntersectWall (double pos, double vel, double wallpos) { /* Function to calculate where the neutron hit the wall */ - if(vel==0) + if (vel == 0) return -1; - - if(vel>0) - return (wallpos-pos)/vel; - else - return (-wallpos-pos)/vel; + + if (vel > 0) + return (wallpos - pos) / vel; + else + return (-wallpos - pos) / vel; } %} @@ -81,84 +82,84 @@ DECLARE INITIALIZE %{ - omegaL = 0; - omegaLguide = 0; - + omegaL = 0; + omegaLguide = 0; double velocity = 0, time = 0; - - if ((xwidth<=0) || (yheight<=0) || (zdepth<=0)) { - fprintf(stderr, "Pol_filter: %s: Null or negative volume!\n" - "ERROR (xwidth, yheight, zdepth). Exiting\n", - NAME_CURRENT_COMP); - exit(1); + + if ((xwidth <= 0) || (yheight <= 0) || (zdepth <= 0)) { + fprintf (stderr, + "Pol_filter: %s: Null or negative volume!\n" + "ERROR (xwidth, yheight, zdepth). Exiting\n", + NAME_CURRENT_COMP); + exit (1); } - - omegaL = -1.832472e8 * (B - Bguide); // B and Bguide is in Tesla - omegaLguide = -1.832472e8 * Bguide; // Bguide is in Tesla + + omegaL = -1.832472e8 * (B - Bguide); // B and Bguide is in Tesla + omegaLguide = -1.832472e8 * Bguide; // Bguide is in Tesla %} TRACE %{ double deltaT, deltaTx, deltaTy, sx_in1, sz_in1, sx_in2, sz_in2, iz1, iz2, denom1, denom2, deltaTtria; - + PROP_Z0; - if (!inside_rectangle(x, y, xwidth, yheight)) + if (!inside_rectangle (x, y, xwidth, yheight)) ABSORB; - + // Time spent in Bguide-field - deltaT = zdepth/vz; - + deltaT = zdepth / vz; + // This calculates the intersections on the xz-plane between the neutron trajectory and the triangular field boundaries // The neutron trajectory is given by the points ( x, 0, 0) and ( x+vx, 0, vz) // The first field boundary is given by the points (-xwidth/2, 0, 0) and ( xwidth/2, 0, zdepth/2) // The second field boundary is given by the points ( xwidth/2, 0,zdepth/2) and (-xwidth/2, 0, zdepth) // iz1 and iz2 are the z-values for the intersection - denom1 = (-vz)*((-xwidth/2)-xwidth/2)-(x-(x+vx))*(-zdepth/2); - iz1 = ((-x*vz)*(-zdepth/2)-(-vz)*(-(-xwidth/2)*zdepth/2))/denom1; - - denom2 = (-vz)*(xwidth/2-(-xwidth/2))-(x-(x+vx))*(zdepth/2-zdepth); - iz2 = ((-x*vz)*(zdepth/2-zdepth)-(-vz)*(zdepth/2*(-xwidth/2)-xwidth/2*zdepth))/denom2; + denom1 = (-vz) * ((-xwidth / 2) - xwidth / 2) - (x - (x + vx)) * (-zdepth / 2); + iz1 = ((-x * vz) * (-zdepth / 2) - (-vz) * (-(-xwidth / 2) * zdepth / 2)) / denom1; + + denom2 = (-vz) * (xwidth / 2 - (-xwidth / 2)) - (x - (x + vx)) * (zdepth / 2 - zdepth); + iz2 = ((-x * vz) * (zdepth / 2 - zdepth) - (-vz) * (zdepth / 2 * (-xwidth / 2) - xwidth / 2 * zdepth)) / denom2; // Time spent in triangular B-field - deltaTtria = (iz2-iz1)/vz; + deltaTtria = (iz2 - iz1) / vz; // check that track goes throgh without hitting the walls - if (!inside_rectangle(x+vx*deltaT, y+vy*deltaT, xwidth, yheight)) { - + if (!inside_rectangle (x + vx * deltaT, y + vy * deltaT, xwidth, yheight)) { + // Propagate to the wall and absorb - deltaTx = IntersectWall(x, vx, xwidth/2); - deltaTy = IntersectWall(y, vy, yheight/2); + deltaTx = IntersectWall (x, vx, xwidth / 2); + deltaTy = IntersectWall (y, vy, yheight / 2); - if (deltaTx>=0 && deltaTx= 0 && deltaTx < deltaTy) deltaT = deltaTx; else deltaT = deltaTy; - - PROP_DT(deltaT); - + + PROP_DT (deltaT); + ABSORB; - } - - PROP_DT(deltaT); - - // These are the incoming spin directions + } + + PROP_DT (deltaT); + + // These are the incoming spin directions sx_in1 = sx; sz_in1 = sz; - + // This calculates the spin rotation caused by the guide/precession field - sz_in2 = cos(omegaLguide*deltaT)*sz_in1 - sin(omegaLguide*deltaT)*sx_in1; - sx_in2 = sin(omegaLguide*deltaT)*sz_in1 + cos(omegaLguide*deltaT)*sx_in1; + sz_in2 = cos (omegaLguide * deltaT) * sz_in1 - sin (omegaLguide * deltaT) * sx_in1; + sx_in2 = sin (omegaLguide * deltaT) * sz_in1 + cos (omegaLguide * deltaT) * sx_in1; // This calculated the spin rotation caused by the triangular field - sz = cos(omegaL*deltaTtria)*sz_in2 - sin(omegaL*deltaTtria)*sx_in2; - sx = sin(omegaL*deltaTtria)*sz_in2 + cos(omegaL*deltaTtria)*sx_in2; + sz = cos (omegaL * deltaTtria) * sz_in2 - sin (omegaL * deltaTtria) * sx_in2; + sx = sin (omegaL * deltaTtria) * sz_in2 + cos (omegaL * deltaTtria) * sx_in2; %} MCDISPLAY %{ - - - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + + + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/Radial_div.comp b/mcstas-comps/contrib/Radial_div.comp index 27060a2b8..63f422149 100644 --- a/mcstas-comps/contrib/Radial_div.comp +++ b/mcstas-comps/contrib/Radial_div.comp @@ -69,81 +69,75 @@ INITIALIZE %{ int i; - if (xwidth > 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } if ((xmin >= xmax) || (ymin >= ymax)) { - printf("Div1dLam: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(0); + printf ("Div1dLam: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (0); } - Div_N = create_darr1d(ndiv); - Div_p = create_darr1d(ndiv); - Div_p2 = create_darr1d(ndiv); + Div_N = create_darr1d (ndiv); + Div_p = create_darr1d (ndiv); + Div_p2 = create_darr1d (ndiv); - for (i=0; ixmin && xymin && y Lmin && lambda < Lmax) - { - h_div = RAD2DEG*atan2(vx,vz); - v_div = RAD2DEG*atan2(vy,vz); - r_div=sqrt(h_div*h_div+v_div*v_div); - if (r_div < maxdiv_r) - { - i = floor((r_div)*ndiv/(maxdiv_r)); + if (x > xmin && x < xmax && y > ymin && y < ymax && lambda > Lmin && lambda < Lmax) { + h_div = RAD2DEG * atan2 (vx, vz); + v_div = RAD2DEG * atan2 (vy, vz); + r_div = sqrt (h_div * h_div + v_div * v_div); + if (r_div < maxdiv_r) { + i = floor ((r_div)*ndiv / (maxdiv_r)); Div_N[i]++; Div_p[i] += p; - Div_p2[i] += p*p; + Div_p2[i] += p * p; SCATTER; } } if (restore_neutron) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } %} SAVE %{ - DETECTOR_OUT_1D( - "radial_div", - "radial divergence [deg]", - "Intensity", - "divergence", 0, maxdiv_r, ndiv, - &Div_N[0],&Div_p[0],&Div_p2[0], - filename); + DETECTOR_OUT_1D ("radial_div", "radial divergence [deg]", "Intensity", "divergence", 0, maxdiv_r, ndiv, &Div_N[0], &Div_p[0], &Div_p2[0], filename); %} FINALLY %{ - destroy_darr1d(Div_N); - destroy_darr1d(Div_p); - destroy_darr1d(Div_p2); + destroy_darr1d (Div_N); + destroy_darr1d (Div_p); + destroy_darr1d (Div_p2); %} MCDISPLAY %{ - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); %} diff --git a/mcstas-comps/contrib/SANSCurve.comp b/mcstas-comps/contrib/SANSCurve.comp index b6dd24854..cbe93936d 100644 --- a/mcstas-comps/contrib/SANSCurve.comp +++ b/mcstas-comps/contrib/SANSCurve.comp @@ -49,188 +49,187 @@ string FileWithCurve = "Curve.dat") SHARE %{ -// Function used to determine the number of datapoints in the input file -int CountLines(FILE* File) - { - // Declarations - double Dummy1; - double Dummy2; - char Line[256]; - int NumberOfDatapoints = 0; - - // I/O - while (fgets(Line, sizeof(Line), File) != NULL) { - - if (sscanf(Line, "%lf %lf", &Dummy1, &Dummy2) == 2) { - ++NumberOfDatapoints; - } - } - - return NumberOfDatapoints; + // Function used to determine the number of datapoints in the input file + int + CountLines (FILE* File) { + // Declarations + double Dummy1; + double Dummy2; + char Line[256]; + int NumberOfDatapoints = 0; + + // I/O + while (fgets (Line, sizeof (Line), File) != NULL) { + + if (sscanf (Line, "%lf %lf", &Dummy1, &Dummy2) == 2) { + ++NumberOfDatapoints; + } } - // Function used to extract the scattering profile from a given curve - int LoadCurve(char Filename[], double** Q, double** I) - { - // Declarations - FILE* File; + return NumberOfDatapoints; + } - int i = 0; - int NumberOfDatapoints; + // Function used to extract the scattering profile from a given curve + int + LoadCurve (char Filename[], double** Q, double** I) { + // Declarations + FILE* File; - char Line[256]; + int i = 0; + int NumberOfDatapoints; - double *IntensityArray; - double *qArray; + char Line[256]; - // Reading file - if ((File = fopen(Filename, "r")) == 0) { - printf("Cannot open file: %s...\n", Filename); - exit(0); - } + double* IntensityArray; + double* qArray; - NumberOfDatapoints = CountLines(File); - - qArray = (double *) calloc(NumberOfDatapoints, sizeof(double)); - IntensityArray = (double *) calloc(NumberOfDatapoints, sizeof(double)); + // Reading file + if ((File = fopen (Filename, "r")) == 0) { + printf ("Cannot open file: %s...\n", Filename); + exit (0); + } - rewind(File); + NumberOfDatapoints = CountLines (File); - while (i < NumberOfDatapoints && fgets(Line, sizeof(Line), File) != NULL) { - if (sscanf(Line, "%lf %lf", &qArray[i], &IntensityArray[i]) == 2) { - ++i; - } - } + qArray = (double*)calloc (NumberOfDatapoints, sizeof (double)); + IntensityArray = (double*)calloc (NumberOfDatapoints, sizeof (double)); - *I = IntensityArray; - *Q = qArray; + rewind (File); - return NumberOfDatapoints; + while (i < NumberOfDatapoints && fgets (Line, sizeof (Line), File) != NULL) { + if (sscanf (Line, "%lf %lf", &qArray[i], &IntensityArray[i]) == 2) { + ++i; + } } + + *I = IntensityArray; + *Q = qArray; + + return NumberOfDatapoints; + } %} DECLARE %{ -double Absorption; -double q; -double* Q; -double* I; -double ForwardScattering; -double Prefactor; -int NumberOfDatapoints; -double NumberDensity; + double Absorption; + double q; + double* Q; + double* I; + double ForwardScattering; + double Prefactor; + int NumberOfDatapoints; + double NumberDensity; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; - + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Initializing curve from file - NumberOfDatapoints = LoadCurve(FileWithCurve, &Q, &I); - ForwardScattering = I[0]; + // Initializing curve from file + NumberOfDatapoints = LoadCurve (FileWithCurve, &Q, &I); + ForwardScattering = I[0]; - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; - Prefactor = NumberDensity * pow(DeltaRho * Volume, 2); + Absorption = AbsorptionCrosssection; + Prefactor = NumberDensity * pow (DeltaRho * Volume, 2); %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - double Slope; - double Offset; - int i; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Discard neutron, if q is out of range - if ((q < Q[0]) || (q > Q[NumberOfDatapoints - 1])) { - ABSORB; - } - - // Find the first value of q in the curve larger than that of the neutron - i = 1; - - while (q > Q[i]) { - ++i; - } - - // Do a linear interpolation - l1 = v * t1; - - Slope = (I[i] - I[i - 1]) / (Q[i] - Q[i - 1]); - Offset = I[i] - Slope * Q[i]; - - Intensity = (Slope * q + Offset) / ForwardScattering; - - p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + double Slope; + double Offset; + int i; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Discard neutron, if q is out of range + if ((q < Q[0]) || (q > Q[NumberOfDatapoints - 1])) { + ABSORB; + } + + // Find the first value of q in the curve larger than that of the neutron + i = 1; + + while (q > Q[i]) { + ++i; + } + + // Do a linear interpolation + l1 = v * t1; + + Slope = (I[i] - I[i - 1]) / (Q[i] - Q[i - 1]); + Offset = I[i] - Slope * Q[i]; + + Intensity = (Slope * q + Offset) / ForwardScattering; + + p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSCylinders.comp b/mcstas-comps/contrib/SANSCylinders.comp index a9725dc29..cda555f26 100644 --- a/mcstas-comps/contrib/SANSCylinders.comp +++ b/mcstas-comps/contrib/SANSCylinders.comp @@ -49,118 +49,118 @@ SHARE %{ DECLARE %{ -// Declarations -double Prefactor; -double Absorption; -double NumberDensity; + // Declarations + double Prefactor; + double Absorption; + double NumberDensity; %} INITIALIZE %{ -// Rescale concentration into number of aggregates per m^3 times 10^-4 -NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; -// Computations -if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Prefactor = NumberDensity * pow(PI * Height * pow(R, 2), 2) * pow(DeltaRho, 2); + Prefactor = NumberDensity * pow (PI * Height * pow (R, 2), 2) * pow (DeltaRho, 2); - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Formfactor1; - double Formfactor2; - double Intensity; - double SolidAngle; - double q; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // variables needed for integration over alpha - int i; - const int NumberOfSteps = 30; - double Alpha; - const double AlphaMin = 0; - const double AlphaMax = PI / 2.0; - const double AlphaStep = (AlphaMax - AlphaMin) / (1.0 * NumberOfSteps); - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Intensity = 0.0; - - for (i = 0; i < NumberOfSteps; ++i) { - Alpha = (i + 0.5) * AlphaStep; - - Formfactor1 = gsl_sf_bessel_J1(q * R * sin(Alpha)) / (q * R * sin(Alpha)); - Formfactor2 = sin(q * Height * cos(Alpha) / 2.0) / (q * Height * cos(Alpha) / 2.0); - - Intensity += sin(Alpha) * Prefactor * pow(2 * Formfactor1 * Formfactor2, 2) * AlphaStep; - } - p *= l_full * SolidAngle / (4.0 * PI) * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Formfactor1; + double Formfactor2; + double Intensity; + double SolidAngle; + double q; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // variables needed for integration over alpha + int i; + const int NumberOfSteps = 30; + double Alpha; + const double AlphaMin = 0; + const double AlphaMax = PI / 2.0; + const double AlphaStep = (AlphaMax - AlphaMin) / (1.0 * NumberOfSteps); + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Intensity = 0.0; + + for (i = 0; i < NumberOfSteps; ++i) { + Alpha = (i + 0.5) * AlphaStep; + + Formfactor1 = gsl_sf_bessel_J1 (q * R * sin (Alpha)) / (q * R * sin (Alpha)); + Formfactor2 = sin (q * Height * cos (Alpha) / 2.0) / (q * Height * cos (Alpha) / 2.0); + + Intensity += sin (Alpha) * Prefactor * pow (2 * Formfactor1 * Formfactor2, 2) * AlphaStep; + } + p *= l_full * SolidAngle / (4.0 * PI) * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSEllipticCylinders.comp b/mcstas-comps/contrib/SANSEllipticCylinders.comp index 01df5aab5..521a82928 100644 --- a/mcstas-comps/contrib/SANSEllipticCylinders.comp +++ b/mcstas-comps/contrib/SANSEllipticCylinders.comp @@ -57,133 +57,133 @@ SHARE %} DECLARE %{ -// Declarations -double Prefactor; -double Absorption; -double q; -double NumberDensity; + // Declarations + double Prefactor; + double Absorption; + double q; + double NumberDensity; %} INITIALIZE %{ -// Rescale concentration into number of aggregates per m^3 times 10^-4 -NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; -// Computations -if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Prefactor = NumberDensity * pow(PI * Height * R1 * R2, 2) * pow(DeltaRho, 2); + Prefactor = NumberDensity * pow (PI * Height * R1 * R2, 2) * pow (DeltaRho, 2); - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Formfactor1; - double Formfactor2; - double Intensity; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - double ProjectedRadius; - char Intersect = 0; - - // Variables needed for integration over alpha - int i; - const int NumberOfStepsInAlpha = 30; - double Alpha; - const double AlphaMin = 0.0; - const double AlphaMax = PI / 2.0; - const double AlphaStep = (AlphaMax - AlphaMin) / (1.0 * NumberOfStepsInAlpha); - - // Variables needed in integration over beta - int j; - const int NumberOfStepsInBeta = 30; - double Beta; - const double BetaMin = 0.0; - const double BetaMax = PI / 2.0; - const double BetaStep = (BetaMax - BetaMin) / (1.0 * NumberOfStepsInBeta); - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Intensity = 0.0; - - for (i = 0; i < NumberOfStepsInAlpha; ++i) { - Alpha = (i + 0.5) * AlphaStep; - - for (j = 0; j < NumberOfStepsInBeta; ++j) { - Beta = (j + 0.5) * BetaStep; - ProjectedRadius = sqrt(pow(R1 * sin(Beta), 2) + pow(R2 * cos(Beta), 2)); - - Formfactor1 = gsl_sf_bessel_J1(q * ProjectedRadius * sin(Alpha)) / (q * ProjectedRadius * sin(Alpha)); - Formfactor2 = sin(q * Height * cos(Alpha) / 2.0) / (q * Height * cos(Alpha) / 2.0); - - Intensity += 2 / PI * sin(Alpha) * Prefactor * pow(2 * Formfactor1 * Formfactor2, 2) * AlphaStep * BetaStep; - } - } - - p *= l_full * SolidAngle / (4.0 * PI) * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Formfactor1; + double Formfactor2; + double Intensity; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + double ProjectedRadius; + char Intersect = 0; + + // Variables needed for integration over alpha + int i; + const int NumberOfStepsInAlpha = 30; + double Alpha; + const double AlphaMin = 0.0; + const double AlphaMax = PI / 2.0; + const double AlphaStep = (AlphaMax - AlphaMin) / (1.0 * NumberOfStepsInAlpha); + + // Variables needed in integration over beta + int j; + const int NumberOfStepsInBeta = 30; + double Beta; + const double BetaMin = 0.0; + const double BetaMax = PI / 2.0; + const double BetaStep = (BetaMax - BetaMin) / (1.0 * NumberOfStepsInBeta); + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Intensity = 0.0; + + for (i = 0; i < NumberOfStepsInAlpha; ++i) { + Alpha = (i + 0.5) * AlphaStep; + + for (j = 0; j < NumberOfStepsInBeta; ++j) { + Beta = (j + 0.5) * BetaStep; + ProjectedRadius = sqrt (pow (R1 * sin (Beta), 2) + pow (R2 * cos (Beta), 2)); + + Formfactor1 = gsl_sf_bessel_J1 (q * ProjectedRadius * sin (Alpha)) / (q * ProjectedRadius * sin (Alpha)); + Formfactor2 = sin (q * Height * cos (Alpha) / 2.0) / (q * Height * cos (Alpha) / 2.0); + + Intensity += 2 / PI * sin (Alpha) * Prefactor * pow (2 * Formfactor1 * Formfactor2, 2) * AlphaStep * BetaStep; + } + } + + p *= l_full * SolidAngle / (4.0 * PI) * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSLiposomes.comp b/mcstas-comps/contrib/SANSLiposomes.comp index 7be59390b..b3dbe3099 100644 --- a/mcstas-comps/contrib/SANSLiposomes.comp +++ b/mcstas-comps/contrib/SANSLiposomes.comp @@ -54,189 +54,199 @@ SETTING PARAMETERS (Radius = 800.0, Thickness = 38.89, SigmaRadius = 0.20, SHARE %{ // Functions used for compution the intensity from a given liposome -#pragma acc routine - double FormfactorSphere(double q, double R) - { - return 3 * (sin(q * R) - q * R * cos(q * R)) / pow(q * R, 3); - } - -#pragma acc routine - double IntensityOfLiposome(double q, double R, double ThicknessHead, double ThicknessTail, double ThicknessCH3, double DeltaRhoHead, double DeltaRhoCH2, double DeltaRhoCH3) - { - const double RHeadOut = R + ThicknessHead + ThicknessTail + ThicknessCH3; - const double RTailOut = R + ThicknessTail + ThicknessCH3; - const double RCH3Out = R + ThicknessCH3; - const double RCH3In = R - ThicknessCH3; - const double RTailIn = R - ThicknessTail - ThicknessCH3; - const double RHeadIn = R - ThicknessHead - ThicknessTail - ThicknessCH3; - - const double VolumeHeadOut = 4.0 / 3.0 * PI * pow(RHeadOut, 3) - 4.0 / 3.0 * PI * pow(RTailOut, 3); - const double VolumeTailOut = 4.0 / 3.0 * PI * pow(RTailOut, 3) - 4.0 / 3.0 * PI * pow(RCH3Out, 3); - const double VolumeCH3 = 4.0 / 3.0 * PI * pow(RCH3Out, 3) - 4.0 / 3.0 * PI * pow(RCH3In, 3); - const double VolumeTailIn = 4.0 / 3.0 * PI * pow(RCH3In, 3) - 4.0 / 3.0 * PI * pow(RTailIn, 3); - const double VolumeHeadIn = 4.0 / 3.0 * PI * pow(RTailIn, 3) - 4.0 / 3.0 * PI * pow(RHeadIn, 3); - - const double AmplitudeHeadOut = DeltaRhoHead * VolumeHeadOut * (pow(RHeadOut, 3) * FormfactorSphere(q, RHeadOut) - pow(RTailOut, 3) * FormfactorSphere(q, RTailOut)) / (pow(RHeadOut, 3) - pow(RTailOut, 3)); - const double AmplitudeTailOut = DeltaRhoCH2 * VolumeTailOut * (pow(RTailOut, 3) * FormfactorSphere(q, RTailOut) - pow(RCH3Out, 3) * FormfactorSphere(q, RCH3Out)) / (pow(RTailOut, 3) - pow(RCH3Out, 3)); - const double AmplitudeCH3 = DeltaRhoCH3 * VolumeCH3 * (pow(RCH3Out, 3) * FormfactorSphere(q, RCH3Out) - pow(RCH3In, 3) * FormfactorSphere(q, RCH3In)) / (pow(RCH3Out, 3) - pow(RCH3In, 3)); - const double AmplitudeTailIn = DeltaRhoCH2 * VolumeTailIn * (pow(RCH3In, 3) * FormfactorSphere(q, RCH3In) - pow(RTailIn, 3) * FormfactorSphere(q, RTailIn)) / (pow(RCH3In, 3) - pow(RTailIn, 3)); - const double AmplitudeHeadIn = DeltaRhoHead * VolumeHeadIn * (pow(RTailIn, 3) * FormfactorSphere(q, RTailIn) - pow(RHeadIn, 3) * FormfactorSphere(q, RHeadIn)) / (pow(RTailIn, 3) - pow(RHeadIn, 3)); - const double Intensity = pow(AmplitudeHeadOut + AmplitudeTailOut + AmplitudeCH3 + AmplitudeTailIn + AmplitudeHeadIn, 2); - return Intensity; - } + #pragma acc routine + double + FormfactorSphere (double q, double R) { + return 3 * (sin (q * R) - q * R * cos (q * R)) / pow (q * R, 3); + } + + #pragma acc routine + double + IntensityOfLiposome (double q, double R, double ThicknessHead, double ThicknessTail, double ThicknessCH3, double DeltaRhoHead, double DeltaRhoCH2, + double DeltaRhoCH3) { + const double RHeadOut = R + ThicknessHead + ThicknessTail + ThicknessCH3; + const double RTailOut = R + ThicknessTail + ThicknessCH3; + const double RCH3Out = R + ThicknessCH3; + const double RCH3In = R - ThicknessCH3; + const double RTailIn = R - ThicknessTail - ThicknessCH3; + const double RHeadIn = R - ThicknessHead - ThicknessTail - ThicknessCH3; + + const double VolumeHeadOut = 4.0 / 3.0 * PI * pow (RHeadOut, 3) - 4.0 / 3.0 * PI * pow (RTailOut, 3); + const double VolumeTailOut = 4.0 / 3.0 * PI * pow (RTailOut, 3) - 4.0 / 3.0 * PI * pow (RCH3Out, 3); + const double VolumeCH3 = 4.0 / 3.0 * PI * pow (RCH3Out, 3) - 4.0 / 3.0 * PI * pow (RCH3In, 3); + const double VolumeTailIn = 4.0 / 3.0 * PI * pow (RCH3In, 3) - 4.0 / 3.0 * PI * pow (RTailIn, 3); + const double VolumeHeadIn = 4.0 / 3.0 * PI * pow (RTailIn, 3) - 4.0 / 3.0 * PI * pow (RHeadIn, 3); + + const double AmplitudeHeadOut = DeltaRhoHead * VolumeHeadOut + * (pow (RHeadOut, 3) * FormfactorSphere (q, RHeadOut) - pow (RTailOut, 3) * FormfactorSphere (q, RTailOut)) + / (pow (RHeadOut, 3) - pow (RTailOut, 3)); + const double AmplitudeTailOut = DeltaRhoCH2 * VolumeTailOut + * (pow (RTailOut, 3) * FormfactorSphere (q, RTailOut) - pow (RCH3Out, 3) * FormfactorSphere (q, RCH3Out)) + / (pow (RTailOut, 3) - pow (RCH3Out, 3)); + const double AmplitudeCH3 = DeltaRhoCH3 * VolumeCH3 * (pow (RCH3Out, 3) * FormfactorSphere (q, RCH3Out) - pow (RCH3In, 3) * FormfactorSphere (q, RCH3In)) + / (pow (RCH3Out, 3) - pow (RCH3In, 3)); + const double AmplitudeTailIn = DeltaRhoCH2 * VolumeTailIn + * (pow (RCH3In, 3) * FormfactorSphere (q, RCH3In) - pow (RTailIn, 3) * FormfactorSphere (q, RTailIn)) + / (pow (RCH3In, 3) - pow (RTailIn, 3)); + const double AmplitudeHeadIn = DeltaRhoHead * VolumeHeadIn + * (pow (RTailIn, 3) * FormfactorSphere (q, RTailIn) - pow (RHeadIn, 3) * FormfactorSphere (q, RHeadIn)) + / (pow (RTailIn, 3) - pow (RHeadIn, 3)); + const double Intensity = pow (AmplitudeHeadOut + AmplitudeTailOut + AmplitudeCH3 + AmplitudeTailIn + AmplitudeHeadIn, 2); + return Intensity; + } %} DECLARE %{ - // Declarations - double Absorption; - double NumberDensity; - - int NumberOfStepsInR; - double RMin; - double RMax; - double RStep; - - // Scattering lengths - double DeltaRhoHead; - double DeltaRhoCH2Tail; - double DeltaRhoCH3Tail; - - // Thickness - double ThicknessOfHead; - double ThicknessOfCH2Tail; - double ThicknessOfCH3Tail; + // Declarations + double Absorption; + double NumberDensity; + + int NumberOfStepsInR; + double RMin; + double RMax; + double RStep; + + // Scattering lengths + double DeltaRhoHead; + double DeltaRhoCH2Tail; + double DeltaRhoCH3Tail; + + // Thickness + double ThicknessOfHead; + double ThicknessOfCH2Tail; + double ThicknessOfCH3Tail; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; - // Variables needed for integration over the polydispersity - NumberOfStepsInR = 100; + // Variables needed for integration over the polydispersity + NumberOfStepsInR = 100; - RMin = Radius - 3.0 * SigmaRadius * Radius; + RMin = Radius - 3.0 * SigmaRadius * Radius; - if (RMin < Thickness / 2.0) { - RMin = Thickness / 2.0; - } + if (RMin < Thickness / 2.0) { + RMin = Thickness / 2.0; + } - RMax = Radius + 3.0 * SigmaRadius * Radius; + RMax = Radius + 3.0 * SigmaRadius * Radius; - RStep = (RMax - RMin) / (1.0f * NumberOfStepsInR); + RStep = (RMax - RMin) / (1.0f * NumberOfStepsInR); - // Molecular properties of liposomes - const double RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; - const double RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; - const double RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; + // Molecular properties of liposomes + const double RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; + const double RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; + const double RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; - DeltaRhoHead = RhoHead - RhoSolvent; - DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; - DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; + DeltaRhoHead = RhoHead - RhoSolvent; + DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; + DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; - ThicknessOfHead = Thickness * VolumeOfHeadgroup / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); - ThicknessOfCH2Tail = Thickness * VolumeOfCH2Tail / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); - ThicknessOfCH3Tail = Thickness * VolumeOfCH3Tail / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); + ThicknessOfHead = Thickness * VolumeOfHeadgroup / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); + ThicknessOfCH2Tail = Thickness * VolumeOfCH2Tail / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); + ThicknessOfCH3Tail = Thickness * VolumeOfCH3Tail / (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail); %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight1; - double Weight2; - double IntensityPart; - double SolidAngle; - double q; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - double R; - int i; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Intensity = 0.0; - - Weight1 = 1.0 / (SigmaRadius * Radius * sqrt(2.0 * PI)); - - for (i = 0; i < NumberOfStepsInR; ++i) { - R = RMin + RStep * (i + 0.5); - - IntensityPart = IntensityOfLiposome(q, R, ThicknessOfHead, ThicknessOfCH2Tail, ThicknessOfCH3Tail, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); - - Weight2 = exp(- pow((R - Radius) / (sqrt(2.0) * SigmaRadius * Radius), 2)); - - Intensity += Weight1 * Weight2 * IntensityPart * RStep; - } - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight1; + double Weight2; + double IntensityPart; + double SolidAngle; + double q; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + double R; + int i; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Intensity = 0.0; + + Weight1 = 1.0 / (SigmaRadius * Radius * sqrt (2.0 * PI)); + + for (i = 0; i < NumberOfStepsInR; ++i) { + R = RMin + RStep * (i + 0.5); + + IntensityPart = IntensityOfLiposome (q, R, ThicknessOfHead, ThicknessOfCH2Tail, ThicknessOfCH3Tail, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); + + Weight2 = exp (-pow ((R - Radius) / (sqrt (2.0) * SigmaRadius * Radius), 2)); + + Intensity += Weight1 * Weight2 * IntensityPart * RStep; + } + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSNanodiscs.comp b/mcstas-comps/contrib/SANSNanodiscs.comp index 11bc40198..453fc05ff 100644 --- a/mcstas-comps/contrib/SANSNanodiscs.comp +++ b/mcstas-comps/contrib/SANSNanodiscs.comp @@ -59,148 +59,149 @@ NOACC SHARE %{ -#ifndef NANODISCS -#define NANODISCS -%include "nanodiscs.h" -#endif + #ifndef NANODISCS + #define NANODISCS + %include "nanodiscs.h" + #endif %} DECLARE %{ - // Declarations - double Absorption; - double q; - double NumberDensity; - - // Scattering lengths - double RhoBelt; - double RhoHead; - double RhoCH2Tail; - double RhoCH3Tail; - - double DeltaRhoHead; - double DeltaRhoBelt; - double DeltaRhoCH2Tail; - double DeltaRhoCH3Tail; - - // Geometric properties - double MajorSemiAxis; - double MinorSemiAxis; - double ThicknessOfBelt; - - double HeightOfBelt; - double HeightOfLipids; - double HeightOfTails; - double HeightOfCH3; + // Declarations + double Absorption; + double q; + double NumberDensity; + + // Scattering lengths + double RhoBelt; + double RhoHead; + double RhoCH2Tail; + double RhoCH3Tail; + + double DeltaRhoHead; + double DeltaRhoBelt; + double DeltaRhoCH2Tail; + double DeltaRhoCH3Tail; + + // Geometric properties + double MajorSemiAxis; + double MinorSemiAxis; + double ThicknessOfBelt; + + double HeightOfBelt; + double HeightOfLipids; + double HeightOfTails; + double HeightOfCH3; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; - // Scattering properties of different components - DeltaRhoBelt = RhoBelt - RhoSolvent; - DeltaRhoHead = RhoHead - RhoSolvent; - DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; - DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; + // Scattering properties of different components + DeltaRhoBelt = RhoBelt - RhoSolvent; + DeltaRhoHead = RhoHead - RhoSolvent; + DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; + DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; - // Geometric properties of different components - const double AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; + // Geometric properties of different components + const double AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; - MinorSemiAxis = sqrt(AreaOfLipids / (PI * AxisRatio)); - MajorSemiAxis = MinorSemiAxis * AxisRatio; + MinorSemiAxis = sqrt (AreaOfLipids / (PI * AxisRatio)); + MajorSemiAxis = MinorSemiAxis * AxisRatio; - HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; + HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; - ThicknessOfBelt = sqrt(pow(MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; + ThicknessOfBelt = sqrt (pow (MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Intensity = exp(- pow(q * Roughness, 2)) * IntensityOfEmptyNanodiscs(q, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, - HeightOfTails, HeightOfCH3, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Intensity = exp (-pow (q * Roughness, 2)) + * IntensityOfEmptyNanodiscs (q, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, + DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSNanodiscsFast.comp b/mcstas-comps/contrib/SANSNanodiscsFast.comp index bc11854ae..0b4e2794a 100644 --- a/mcstas-comps/contrib/SANSNanodiscsFast.comp +++ b/mcstas-comps/contrib/SANSNanodiscsFast.comp @@ -64,194 +64,193 @@ NOACC SHARE %{ -#ifndef NANODISCS -#define NANODISCS -%include "nanodiscs.h" -#endif + #ifndef NANODISCS + #define NANODISCS + %include "nanodiscs.h" + #endif %} DECLARE %{ - // Declarations - double RhoBelt; - double RhoHead; - double RhoCH2Tail; - double RhoCH3Tail; - - double DeltaRhoHead; - double DeltaRhoBelt; - double DeltaRhoCH2Tail; - double DeltaRhoCH3Tail; - - double MajorSemiAxis; - double MinorSemiAxis; - double ThicknessOfBelt; - - double HeightOfBelt; - double HeightOfLipids; - double HeightOfTails; - double HeightOfCH3; - - double AreaOfLipids; - // Declarations - double Absorption; - double NumberDensity; - - // Curve used in linear - double *qArray; - double *IArray; - + // Declarations + double RhoBelt; + double RhoHead; + double RhoCH2Tail; + double RhoCH3Tail; + + double DeltaRhoHead; + double DeltaRhoBelt; + double DeltaRhoCH2Tail; + double DeltaRhoCH3Tail; + + double MajorSemiAxis; + double MinorSemiAxis; + double ThicknessOfBelt; + + double HeightOfBelt; + double HeightOfLipids; + double HeightOfTails; + double HeightOfCH3; + + double AreaOfLipids; + // Declarations + double Absorption; + double NumberDensity; + + // Curve used in linear + double* qArray; + double* IArray; %} INITIALIZE %{ - const double ScatteringLengthOfWater = 2.82E-12; - const double VolumeOfWater = 30.0; + const double ScatteringLengthOfWater = 2.82E-12; + const double VolumeOfWater = 30.0; - const double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); - int i; - double qDummy; + const double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); + int i; + double qDummy; - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; - // Scattering properties of different components - RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; - RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; - RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; - RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; + // Scattering properties of different components + RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; + RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; + RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; + RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; - DeltaRhoBelt = RhoBelt - RhoSolvent; - DeltaRhoHead = RhoHead - RhoSolvent; - DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; - DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; + DeltaRhoBelt = RhoBelt - RhoSolvent; + DeltaRhoHead = RhoHead - RhoSolvent; + DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; + DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; - // Geometric properties of different components - AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; + // Geometric properties of different components + AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; - MinorSemiAxis = sqrt(AreaOfLipids / (PI * AxisRatio)); - MajorSemiAxis = MinorSemiAxis * AxisRatio; + MinorSemiAxis = sqrt (AreaOfLipids / (PI * AxisRatio)); + MajorSemiAxis = MinorSemiAxis * AxisRatio; - HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; + HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; - ThicknessOfBelt = sqrt(pow(MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; + ThicknessOfBelt = sqrt (pow (MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; - // Compute scattering from nanodiscs in predecided points - qArray = (double *) calloc(NumberOfQBins, sizeof(double)); - IArray = (double *) calloc(NumberOfQBins, sizeof(double)); + // Compute scattering from nanodiscs in predecided points + qArray = (double*)calloc (NumberOfQBins, sizeof (double)); + IArray = (double*)calloc (NumberOfQBins, sizeof (double)); - for (i = 0; i < NumberOfQBins; ++i) { - qDummy = qMin + (i + 0.5) * qStep; + for (i = 0; i < NumberOfQBins; ++i) { + qDummy = qMin + (i + 0.5) * qStep; - qArray[i] = qDummy; - IArray[i] = IntensityOfEmptyNanodiscs(qDummy, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, - HeightOfTails, HeightOfCH3, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); - } + qArray[i] = qDummy; + IArray[i] = IntensityOfEmptyNanodiscs (qDummy, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, + DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail); + } %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double q; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - int i; - double Slope; - double Offset; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Discard neutron, if q is out of range - if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { - ABSORB; - } - - // Find the first value of q in the curve larger than that of the neutron - i = 1; - - while (q > qArray[i]) { - ++i; - } - - // Do a linear interpolation - l1 = v * t1; - - Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); - Offset = IArray[i] - Slope * qArray[i]; - - Intensity = (Slope * q + Offset) * exp(- pow(q * Roughness, 2)); - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double q; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + int i; + double Slope; + double Offset; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Discard neutron, if q is out of range + if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { + ABSORB; + } + + // Find the first value of q in the curve larger than that of the neutron + i = 1; + + while (q > qArray[i]) { + ++i; + } + + // Do a linear interpolation + l1 = v * t1; + + Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); + Offset = IArray[i] - Slope * qArray[i]; + + Intensity = (Slope * q + Offset) * exp (-pow (q * Roughness, 2)); + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSNanodiscsWithTags.comp b/mcstas-comps/contrib/SANSNanodiscsWithTags.comp index 83e91df78..2a49103e9 100644 --- a/mcstas-comps/contrib/SANSNanodiscsWithTags.comp +++ b/mcstas-comps/contrib/SANSNanodiscsWithTags.comp @@ -64,161 +64,163 @@ NOACC SHARE %{ -#ifndef NANODISCS -#define NANODISCS -%include "nanodiscs.h" -#endif - -#ifndef NANODISCS -#define NANODISCS -#endif + #ifndef NANODISCS + #define NANODISCS + %include "nanodiscs.h" + #endif + + #ifndef NANODISCS + #define NANODISCS + #endif %} DECLARE %{ - // Declarations - double Absorption; - double q; - double NumberDensity; - - // Scattering lengths - double RhoBelt; - double RhoHead; - double RhoCH2Tail; - double RhoCH3Tail; - double RhoTag; - - double DeltaRhoHead; - double DeltaRhoBelt; - double DeltaRhoCH2Tail; - double DeltaRhoCH3Tail; - double DeltaRhoTag; - - // Geometric properties - double MajorSemiAxis; - double MinorSemiAxis; - double ThicknessOfBelt; - - double HeightOfBelt; - double HeightOfLipids; - double HeightOfTails; - double HeightOfCH3; + // Declarations + double Absorption; + double q; + double NumberDensity; + + // Scattering lengths + double RhoBelt; + double RhoHead; + double RhoCH2Tail; + double RhoCH3Tail; + double RhoTag; + + double DeltaRhoHead; + double DeltaRhoBelt; + double DeltaRhoCH2Tail; + double DeltaRhoCH3Tail; + double DeltaRhoTag; + + // Geometric properties + double MajorSemiAxis; + double MinorSemiAxis; + double ThicknessOfBelt; + + double HeightOfBelt; + double HeightOfLipids; + double HeightOfTails; + double HeightOfCH3; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; - // Scattering properties of different components - RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; - RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; - RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; - RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; - RhoTag = ScatteringLengthOfOneHisTag / VolumeOfOneHisTag; + // Scattering properties of different components + RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; + RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; + RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; + RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; + RhoTag = ScatteringLengthOfOneHisTag / VolumeOfOneHisTag; - DeltaRhoBelt = RhoBelt - RhoSolvent; - DeltaRhoHead = RhoHead - RhoSolvent; - DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; - DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; - DeltaRhoTag = RhoTag - RhoSolvent; + DeltaRhoBelt = RhoBelt - RhoSolvent; + DeltaRhoHead = RhoHead - RhoSolvent; + DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; + DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; + DeltaRhoTag = RhoTag - RhoSolvent; - // Geometric properties of different components - const double AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0f; + // Geometric properties of different components + const double AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0f; - MinorSemiAxis = sqrt(AreaOfLipids / (PI * AxisRatio)); - MajorSemiAxis = MinorSemiAxis * AxisRatio; + MinorSemiAxis = sqrt (AreaOfLipids / (PI * AxisRatio)); + MajorSemiAxis = MinorSemiAxis * AxisRatio; - HeightOfLipids = 2.0f * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfTails = 2.0f * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfCH3 = 2.0f * VolumeOfCH3Tail / AreaPerLipidHeadgroup; + HeightOfLipids = 2.0f * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfTails = 2.0f * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfCH3 = 2.0f * VolumeOfCH3Tail / AreaPerLipidHeadgroup; - ThicknessOfBelt = sqrt(pow(MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; + ThicknessOfBelt = sqrt (pow (MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Intensity = exp(- pow(q * Roughness, 2)) * IntensityOfEmptyNanodiscsWithTags(q, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, - RadiusOfGyrationForHisTag, VolumeOfOneHisTag, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail, DeltaRhoTag); - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Intensity = exp (-pow (q * Roughness, 2)) + * IntensityOfEmptyNanodiscsWithTags (q, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, + RadiusOfGyrationForHisTag, VolumeOfOneHisTag, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail, + DeltaRhoTag); + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSNanodiscsWithTagsFast.comp b/mcstas-comps/contrib/SANSNanodiscsWithTagsFast.comp index c81379ab2..c93949713 100644 --- a/mcstas-comps/contrib/SANSNanodiscsWithTagsFast.comp +++ b/mcstas-comps/contrib/SANSNanodiscsWithTagsFast.comp @@ -67,18 +67,18 @@ DEPENDENCY " @GSLFLAGS@ " SHARE %{ -#ifndef NANODISCS -#define NANODISCS -%include "nanodiscs.h" -#endif + #ifndef NANODISCS + #define NANODISCS + %include "nanodiscs.h" + #endif %} DECLARE %{ double Absorption; double NumberDensity; - double *qArray; - double *IArray; + double* qArray; + double* IArray; double RhoHead; double RhoCH2Tail; double RhoCH3Tail; @@ -103,150 +103,151 @@ INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; - const double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); - int i; - double qDummy; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; + const double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); + int i; + double qDummy; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; - // Scattering properties of different components - RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; - RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; - RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; - RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; - RhoTag = ScatteringLengthOfOneHisTag / VolumeOfOneHisTag; + // Scattering properties of different components + RhoBelt = ScatteringLengthOfOneMSP / VolumeOfOneMSP; + RhoHead = ScatteringLengthOfHeadgroup / VolumeOfHeadgroup; + RhoCH2Tail = ScatteringLengthOfCH2Tail / VolumeOfCH2Tail; + RhoCH3Tail = ScatteringLengthOfCH3Tail / VolumeOfCH3Tail; + RhoTag = ScatteringLengthOfOneHisTag / VolumeOfOneHisTag; - DeltaRhoBelt = RhoBelt - RhoSolvent; - DeltaRhoHead = RhoHead - RhoSolvent; - DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; - DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; - DeltaRhoTag = RhoTag - RhoSolvent; + DeltaRhoBelt = RhoBelt - RhoSolvent; + DeltaRhoHead = RhoHead - RhoSolvent; + DeltaRhoCH2Tail = RhoCH2Tail - RhoSolvent; + DeltaRhoCH3Tail = RhoCH3Tail - RhoSolvent; + DeltaRhoTag = RhoTag - RhoSolvent; - // Geometric properties of different components - AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; + // Geometric properties of different components + AreaOfLipids = NumberOfLipids * AreaPerLipidHeadgroup / 2.0; - MinorSemiAxis = sqrt(AreaOfLipids / (PI * AxisRatio)); - MajorSemiAxis = MinorSemiAxis * AxisRatio; + MinorSemiAxis = sqrt (AreaOfLipids / (PI * AxisRatio)); + MajorSemiAxis = MinorSemiAxis * AxisRatio; - HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; - HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; + HeightOfLipids = 2.0 * (VolumeOfHeadgroup + VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfTails = 2.0 * (VolumeOfCH2Tail + VolumeOfCH3Tail) / AreaPerLipidHeadgroup; + HeightOfCH3 = 2.0 * VolumeOfCH3Tail / AreaPerLipidHeadgroup; - ThicknessOfBelt = sqrt(pow(MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; + ThicknessOfBelt = sqrt (pow (MinorSemiAxis + MajorSemiAxis, 2) / 4.0 + 2.0 * VolumeOfOneMSP / (PI * HeightOfMSP)) - (MajorSemiAxis + MinorSemiAxis) / 2.0; - // Compute scattering from nanodiscs in predecided points - qArray = (double *) calloc(NumberOfQBins, sizeof(double)); - IArray = (double *) calloc(NumberOfQBins, sizeof(double)); + // Compute scattering from nanodiscs in predecided points + qArray = (double*)calloc (NumberOfQBins, sizeof (double)); + IArray = (double*)calloc (NumberOfQBins, sizeof (double)); - for (i = 0; i < NumberOfQBins; ++i) { - qDummy = qMin + (i + 0.5) * qStep; + for (i = 0; i < NumberOfQBins; ++i) { + qDummy = qMin + (i + 0.5) * qStep; - qArray[i] = qDummy; - IArray[i] = IntensityOfEmptyNanodiscsWithTags(qDummy, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, RadiusOfGyrationForHisTag, - VolumeOfOneHisTag, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail, DeltaRhoTag); - } + qArray[i] = qDummy; + IArray[i] = IntensityOfEmptyNanodiscsWithTags (qDummy, MajorSemiAxis, MinorSemiAxis, ThicknessOfBelt, HeightOfMSP, HeightOfLipids, HeightOfTails, HeightOfCH3, + RadiusOfGyrationForHisTag, VolumeOfOneHisTag, DeltaRhoBelt, DeltaRhoHead, DeltaRhoCH2Tail, DeltaRhoCH3Tail, + DeltaRhoTag); + } %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double q; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - int i; - double Slope; - double Offset; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Discard neutron, if q is out of range - if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { - ABSORB; - } - - // Find the first value of q in the curve larger than that of the neutron - i = 1; - - while (q > qArray[i]) { - ++i; - } - - // Do a linear interpolation - l1 = v * t1; - - Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); - Offset = IArray[i] - Slope * qArray[i]; - - Intensity = (Slope * q + Offset) * exp(- pow(q * Roughness, 2)); - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double q; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + int i; + double Slope; + double Offset; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Discard neutron, if q is out of range + if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { + ABSORB; + } + + // Find the first value of q in the curve larger than that of the neutron + i = 1; + + while (q > qArray[i]) { + ++i; + } + + // Do a linear interpolation + l1 = v * t1; + + Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); + Offset = IArray[i] - Slope * qArray[i]; + + Intensity = (Slope * q + Offset) * exp (-pow (q * Roughness, 2)); + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSPDB.comp b/mcstas-comps/contrib/SANSPDB.comp index dfe17e72b..25e383ab4 100644 --- a/mcstas-comps/contrib/SANSPDB.comp +++ b/mcstas-comps/contrib/SANSPDB.comp @@ -61,169 +61,163 @@ EXTEND %{ DECLARE %{ - double Absorption; - double NumberDensity; + double Absorption; + double NumberDensity; - // Protein properties - // cdouble Matrix[SANSPDBOrderOfHarmonics+1][SANSPDBOrderOfHarmonics+1]; - ProteinStruct Protein; + // Protein properties + // cdouble Matrix[SANSPDBOrderOfHarmonics+1][SANSPDBOrderOfHarmonics+1]; + ProteinStruct Protein; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Standard sample handling - if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr, "SANSPDB: %s: ERROR: Sample has no volume - check parameters.\n", NAME_CURRENT_COMP)); - } + // Standard sample handling + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "SANSPDB: %s: ERROR: Sample has no volume - check parameters.\n", NAME_CURRENT_COMP)); + } // count the number of residues - Absorption = AbsorptionCrosssection; - Protein.NumberOfResidues = CountResidues(PDBFilepath); - Protein.Beads = calloc(Protein.NumberOfResidues,sizeof(BeadStruct)); - if (Protein.Beads == NULL) - exit(fprintf(stderr, "SANSPDB: %s: ERROR: memory allocation\n", NAME_CURRENT_COMP)); + Absorption = AbsorptionCrosssection; + Protein.NumberOfResidues = CountResidues (PDBFilepath); + Protein.Beads = calloc (Protein.NumberOfResidues, sizeof (BeadStruct)); + if (Protein.Beads == NULL) + exit (fprintf (stderr, "SANSPDB: %s: ERROR: memory allocation\n", NAME_CURRENT_COMP)); // initialize the protein from the PDB - ReadAminoPDB(PDBFilepath, &Protein); - MPI_MASTER( - printf("SANSPDB: %s: Scattering from %s with %d residues\n", - NAME_CURRENT_COMP, PDBFilepath, Protein.NumberOfResidues); - ); - + ReadAminoPDB (PDBFilepath, &Protein); + MPI_MASTER (printf ("SANSPDB: %s: Scattering from %s with %d residues\n", NAME_CURRENT_COMP, PDBFilepath, Protein.NumberOfResidues);); %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double q; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - double Slope; - double Offset; - int i,j,ResidueID; - cdouble** Matrix=(cdouble**)matrix2d_new(sizeof(cdouble),SANSPDBOrderOfHarmonics+1,SANSPDBOrderOfHarmonics+1); - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "SANSPDB %s: Photon already inside sample - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering for a given q-value - // ResetMatrix(Matrix, SANSPDBOrderOfHarmonics); - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) - for (j = 0; j <= SANSPDBOrderOfHarmonics; ++j) - Matrix[i][j] = cplx(0,0); - - for (ResidueID = 0; ResidueID < Protein.NumberOfResidues; ++ResidueID) { - // ExpandStructure(Matrix, &Protein, ResidueID, qDummy, RhoSolvent); - double Legendre[SANSPDBOrderOfHarmonics + 1]; - double Bessel[SANSPDBOrderOfHarmonics + 1]; - - // Residue information - BeadStruct Residue = Protein.Beads[ResidueID]; - const double Volume = Residue.Volume; - const double DeltaRhoProtein = Residue.ScatteringLength - Volume * RhoSolvent; - - double X,Y,Z; - Protein_Beads_get_coords(Residue, &X, &Y, &Z); - X = (X * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].xv) / DeltaRhoProtein; - - Y = (Y * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].yv) / DeltaRhoProtein; - - Z = (Z * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].zv) / DeltaRhoProtein; - - // Convert bead position to spherical coordinates - const double Radius = sqrt(pow(X, 2) + pow(Y, 2) + pow(Z, 2)); - const double Theta = acos(Z / Radius); - const double C = acos(X / (Radius * sin(Theta))) * Sign(Y); - - // Expand protein structure on harmonics - gsl_sf_bessel_jl_array(SANSPDBOrderOfHarmonics, q * Radius, Bessel); - - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { - gsl_sf_legendre_sphPlm_array(SANSPDBOrderOfHarmonics, i, cos(Theta), &Legendre[i]); - - for(j = i; j <= SANSPDBOrderOfHarmonics; ++j) { - Matrix[j][i] = cadd(Matrix[j][i],rmul(sqrt(4.0 * PI) * DeltaRhoProtein * Bessel[j] * Legendre[j] , cmul(cpow(cplx(0,1), cplx(j,0)), Polar(1.0, -i * C)))); - } - } - - } // for ResidueID - - Intensity = 0; - // ComputeIntensity(Matrix, SANSPDBOrderOfHarmonics); - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { - for (j = 0; j <= i; ++j) { - Intensity += ((j > 0) + 1.0) * pow(cabs(Matrix[i][j]), 2); - } - } - - // Compute new weight - l1 = v * t1; - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double q; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + double Slope; + double Offset; + int i, j, ResidueID; + cdouble** Matrix = (cdouble**)matrix2d_new (sizeof (cdouble), SANSPDBOrderOfHarmonics + 1, SANSPDBOrderOfHarmonics + 1); + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "SANSPDB %s: Photon already inside sample - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering for a given q-value + // ResetMatrix(Matrix, SANSPDBOrderOfHarmonics); + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) + for (j = 0; j <= SANSPDBOrderOfHarmonics; ++j) + Matrix[i][j] = cplx (0, 0); + + for (ResidueID = 0; ResidueID < Protein.NumberOfResidues; ++ResidueID) { + // ExpandStructure(Matrix, &Protein, ResidueID, qDummy, RhoSolvent); + double Legendre[SANSPDBOrderOfHarmonics + 1]; + double Bessel[SANSPDBOrderOfHarmonics + 1]; + + // Residue information + BeadStruct Residue = Protein.Beads[ResidueID]; + const double Volume = Residue.Volume; + const double DeltaRhoProtein = Residue.ScatteringLength - Volume * RhoSolvent; + + double X, Y, Z; + Protein_Beads_get_coords (Residue, &X, &Y, &Z); + X = (X * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].xv) / DeltaRhoProtein; + + Y = (Y * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].yv) / DeltaRhoProtein; + + Z = (Z * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].zv) / DeltaRhoProtein; + + // Convert bead position to spherical coordinates + const double Radius = sqrt (pow (X, 2) + pow (Y, 2) + pow (Z, 2)); + const double Theta = acos (Z / Radius); + const double C = acos (X / (Radius * sin (Theta))) * Sign (Y); + + // Expand protein structure on harmonics + gsl_sf_bessel_jl_array (SANSPDBOrderOfHarmonics, q * Radius, Bessel); + + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { + gsl_sf_legendre_sphPlm_array (SANSPDBOrderOfHarmonics, i, cos (Theta), &Legendre[i]); + + for (j = i; j <= SANSPDBOrderOfHarmonics; ++j) { + Matrix[j][i] = cadd (Matrix[j][i], + rmul (sqrt (4.0 * PI) * DeltaRhoProtein * Bessel[j] * Legendre[j], cmul (cpow (cplx (0, 1), cplx (j, 0)), Polar (1.0, -i * C)))); + } + } + + } // for ResidueID + + Intensity = 0; + // ComputeIntensity(Matrix, SANSPDBOrderOfHarmonics); + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { + for (j = 0; j <= i; ++j) { + Intensity += ((j > 0) + 1.0) * pow (cabs (Matrix[i][j]), 2); + } + } + + // Compute new weight + l1 = v * t1; + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSPDBFast.comp b/mcstas-comps/contrib/SANSPDBFast.comp index 5b8239003..757eb58bc 100644 --- a/mcstas-comps/contrib/SANSPDBFast.comp +++ b/mcstas-comps/contrib/SANSPDBFast.comp @@ -57,501 +57,494 @@ NOACC SHARE %{ %include "read_table-lib"; // for Open_File - - #include - #include - %include "mccode-complex-lib" -#ifndef SANSPDB -#define SANSPDB - #define SANSPDBOrderOfHarmonics 21 - -void** matrix2d_new( size_t esize, size_t idim, size_t jdim ) { - size_t const ptrs_size = sizeof(void*) * idim; - size_t const row_size = esize * jdim; - void **const rows = malloc( ptrs_size ); - for ( size_t i = 0; i < idim; ++i ) { - void *const row = malloc( row_size ); - if (!row) { - fprintf(stderr,"SANSPDB(fast): Error allocating 2D-mem\n"); - exit(-1); + + #include + #include + %include "mccode-complex-lib" + #ifndef SANSPDB + #define SANSPDB + #define SANSPDBOrderOfHarmonics 21 + + void** + matrix2d_new (size_t esize, size_t idim, size_t jdim) { + size_t const ptrs_size = sizeof (void*) * idim; + size_t const row_size = esize * jdim; + void** const rows = malloc (ptrs_size); + for (size_t i = 0; i < idim; ++i) { + void* const row = malloc (row_size); + if (!row) { + fprintf (stderr, "SANSPDB(fast): Error allocating 2D-mem\n"); + exit (-1); + } else { + rows[i] = row; + } + } + return rows; + } + // Simple mathematical functions + int + Sign (double x) { + int Sign; + + if (x > 0) { + Sign = 1; + } else if (x < 0) { + Sign = -1; } else { - rows[i] = row; + Sign = 0; } + + return Sign; } - return rows; -} - // Simple mathematical functions - int Sign(double x) { - int Sign; - - if (x > 0) { - Sign = 1; - } else if (x < 0) { - Sign = -1; - } else { - Sign = 0; - } - - return Sign; - } - - void complex_print_matrix(cdouble **Matrix, int N, int M) - { - int i,j; - for (i = 0; i < N; ++i) - { - for (j = 0; j < M; ++j) - { - cdouble z = Matrix[i][j]; - fprintf(stderr, - "(%.12e,%.12e)%s", - creal(z), - cimag(z), - (j < M - 1) ? " " : "\n"); - } + + void + complex_print_matrix (cdouble** Matrix, int N, int M) { + int i, j; + for (i = 0; i < N; ++i) { + for (j = 0; j < M; ++j) { + cdouble z = Matrix[i][j]; + fprintf (stderr, "(%.12e,%.12e)%s", creal (z), cimag (z), (j < M - 1) ? " " : "\n"); + } + } + } + + cdouble + Polar (double R, double Concentration) { + cdouble Polar; + + Polar = cplx (R * cos (Concentration), R * sin (Concentration)); + + return Polar; + } + + // Protein structs + struct Bead { + double x; + double y; + double z; + + double xv; + double yv; + double zv; + + double Volume; + double ScatteringLength; + char Atom; + }; + typedef struct Bead BeadStruct; + + struct Protein { + BeadStruct* Beads; + int NumberOfResidues; + }; + typedef struct Protein ProteinStruct; + + // functions for the INITIALIZE ---------------------------------------------- + + // Function used to determine the number of residues in the .pdb-file + int + CountResidues (char* PDBFilepath) { + // Declarations + double Dummy1; + double Dummy2; + double Dummy3; + char Line[65535]; + char DummyChar; + char Atom; + int NumberOfResidues = 0; + int ResidueID; + int PreviousResidueID = 0; + FILE* PDBFile; + + // I/O + PDBFile = Open_File (PDBFilepath, "r", NULL); + if (PDBFile == NULL) { + exit (fprintf (stderr, "SANSPDBFast: %s: ERROR: Cannot open %s... \n", __FILE__, PDBFilepath)); + } + + while (fgets (Line, sizeof (Line), PDBFile) != NULL) { + ResidueID = 0; + if (strncmp (Line, "ATOM", 4)) + continue; + if (sscanf (Line, "ATOM%*18c%d%*4c%lf%lf%lf", &ResidueID, &Dummy1, &Dummy2, &Dummy3) == 4) { + if (ResidueID != PreviousResidueID && ResidueID != 0) + ++NumberOfResidues; + PreviousResidueID = ResidueID; + } } - } - - cdouble Polar(double R, double Concentration) { - cdouble Polar; - - Polar = cplx(R * cos(Concentration) , R* sin(Concentration)); - - return Polar; - } - - // Protein structs - struct Bead - { - double x; - double y; - double z; - - double xv; - double yv; - double zv; - - double Volume; - double ScatteringLength; - char Atom; - }; - typedef struct Bead BeadStruct; - - struct Protein - { - BeadStruct *Beads; - int NumberOfResidues; - }; - typedef struct Protein ProteinStruct; - - // functions for the INITIALIZE ---------------------------------------------- - - // Function used to determine the number of residues in the .pdb-file - int CountResidues(char *PDBFilepath) - { - // Declarations - double Dummy1; - double Dummy2; - double Dummy3; - char Line[65535]; - char DummyChar; - char Atom; - int NumberOfResidues = 0; - int ResidueID; - int PreviousResidueID = 0; - FILE *PDBFile; - - // I/O - PDBFile = Open_File(PDBFilepath, "r",NULL); - if (PDBFile == NULL) { - exit(fprintf(stderr, "SANSPDBFast: %s: ERROR: Cannot open %s... \n", __FILE__, PDBFilepath)); - } - - while (fgets(Line, sizeof(Line), PDBFile) != NULL) { - ResidueID = 0; - if (strncmp(Line, "ATOM", 4)) continue; - if (sscanf(Line, "ATOM%*18c%d%*4c%lf%lf%lf", &ResidueID, &Dummy1, &Dummy2, &Dummy3) == 4) { - if (ResidueID != PreviousResidueID && ResidueID != 0) ++NumberOfResidues; - PreviousResidueID = ResidueID; - } - } - fclose(PDBFile); - return NumberOfResidues; - } // CountResidues - - // Function used to read .pdb-file - int ReadAminoPDB(char *PDBFilename, ProteinStruct *Protein) - { - // Declarations and input - int NumberOfResidues = Protein->NumberOfResidues; - BeadStruct *Residue = Protein->Beads; - FILE *PDBFile; - - int i = 0; - int PreviousResidueID = 0; - int ResidueID = 0; - - double Weight = 0.0; - double W = 0.0; - - double Aweight = 0.0; - double A = 0.0; - - double x; - double y; - double z; - - double X = 0.0; - double Y = 0.0; - double Z = 0.0; - - double XA = 0.0; - double YA = 0.0; - double ZA = 0.0; - - char Atom; - - char Buffer[65535]; - char DummyChar; - - // Atomic weighing factors - const double WH = 5.15; - const double WC = 16.44; - const double WN = 2.49; - const double WO = 9.13; - const double WS = 19.86; - const double WP = 5.73; - - // Scattering lengths - const double AH = - 3.741e-15; - const double AD = 6.674e-15; - const double AC = 6.648e-15; - const double AN = 9.360e-15; - const double AO = 5.805e-15; - const double AP = 5.130e-15; - const double AS = 2.847e-15; - - // Program - if (NumberOfResidues <= 0 || (PDBFile = Open_File(PDBFilename, "r",NULL)) == 0) { - exit(printf("ERROR: Cannot open file: %s. \n", PDBFilename)); - } - - while (fgets(Buffer, sizeof(Buffer), PDBFile) != NULL) { - // a typical line is: - // ATOM 8726 N VAL B 576 76.450 47.214 58.026 1.00111.85 N - Atom = 0; - ResidueID = 0; - if (strncmp(Buffer, "ATOM", 4)) continue; - if (!sscanf(Buffer,"ATOM%*9c%c%*8c%d%*4c%lf%lf%lf%*23c%c", &DummyChar, &ResidueID, &x, &y, &z, &Atom)) { - fprintf(stderr, "SANSPDBFast: %s: ReadAminoPDB: [%i] invalid PDB line %s\n", __FILE__, i, Buffer); - continue; + fclose (PDBFile); + return NumberOfResidues; + } // CountResidues + + // Function used to read .pdb-file + int + ReadAminoPDB (char* PDBFilename, ProteinStruct* Protein) { + // Declarations and input + int NumberOfResidues = Protein->NumberOfResidues; + BeadStruct* Residue = Protein->Beads; + FILE* PDBFile; + + int i = 0; + int PreviousResidueID = 0; + int ResidueID = 0; + + double Weight = 0.0; + double W = 0.0; + + double Aweight = 0.0; + double A = 0.0; + + double x; + double y; + double z; + + double X = 0.0; + double Y = 0.0; + double Z = 0.0; + + double XA = 0.0; + double YA = 0.0; + double ZA = 0.0; + + char Atom; + + char Buffer[65535]; + char DummyChar; + + // Atomic weighing factors + const double WH = 5.15; + const double WC = 16.44; + const double WN = 2.49; + const double WO = 9.13; + const double WS = 19.86; + const double WP = 5.73; + + // Scattering lengths + const double AH = -3.741e-15; + const double AD = 6.674e-15; + const double AC = 6.648e-15; + const double AN = 9.360e-15; + const double AO = 5.805e-15; + const double AP = 5.130e-15; + const double AS = 2.847e-15; + + // Program + if (NumberOfResidues <= 0 || (PDBFile = Open_File (PDBFilename, "r", NULL)) == 0) { + exit (printf ("ERROR: Cannot open file: %s. \n", PDBFilename)); + } + + while (fgets (Buffer, sizeof (Buffer), PDBFile) != NULL) { + // a typical line is: + // ATOM 8726 N VAL B 576 76.450 47.214 58.026 1.00111.85 N + Atom = 0; + ResidueID = 0; + if (strncmp (Buffer, "ATOM", 4)) + continue; + if (!sscanf (Buffer, "ATOM%*9c%c%*8c%d%*4c%lf%lf%lf%*23c%c", &DummyChar, &ResidueID, &x, &y, &z, &Atom)) { + fprintf (stderr, "SANSPDBFast: %s: ReadAminoPDB: [%i] invalid PDB line %s\n", __FILE__, i, Buffer); + continue; + } + + if (ResidueID != PreviousResidueID && ResidueID != 0) { + + if (PreviousResidueID != 0 && Aweight && Weight) { + + // Assign center of scattering + Residue[i].xv = X / Weight; + Residue[i].yv = Y / Weight; + Residue[i].zv = Z / Weight; + + // Assign center of mass + Residue[i].x = XA / Aweight; + Residue[i].y = YA / Aweight; + Residue[i].z = ZA / Aweight; + + // Other residue attributes + Residue[i].Volume = Weight; + Residue[i].ScatteringLength = Aweight; + Residue[i].Atom = Atom; + + X = Y = Z = Weight = 0.0; + XA = YA = ZA = Aweight = 0.0; + + ++i; } - if (ResidueID != PreviousResidueID && ResidueID != 0) { - - if (PreviousResidueID != 0 && Aweight && Weight) { - - // Assign center of scattering - Residue[i].xv = X / Weight; - Residue[i].yv = Y / Weight; - Residue[i].zv = Z / Weight; - - // Assign center of mass - Residue[i].x = XA / Aweight; - Residue[i].y = YA / Aweight; - Residue[i].z = ZA / Aweight; - - // Other residue attributes - Residue[i].Volume = Weight; - Residue[i].ScatteringLength = Aweight; - Residue[i].Atom = Atom; - - X = Y = Z = Weight = 0.0; - XA = YA = ZA = Aweight = 0.0; - - ++i; - - } - - PreviousResidueID = ResidueID; - } - - // Finish the final amino acid - if (i == NumberOfResidues - 1 && Aweight && Weight) { - Residue[i].xv = X / Weight; - Residue[i].yv = Y / Weight; - Residue[i].zv = Z / Weight; - - // Assign center of mass - Residue[i].x = XA / Aweight; - Residue[i].y = YA / Aweight; - Residue[i].z = ZA / Aweight; - - // Other residue attributes - Residue[i].Volume = Weight; - Residue[i].ScatteringLength = Aweight; - Residue[i].Atom = 'X'; - } - - switch(Atom) { - case 'C': - A = AC; - W = WC; - break; - - case 'N': - A = AN; - W = WN; - break; - - case 'O': - A = AO; - W = WO; - break; - - case 'S': - A = AS; - W = WS; - break; - - case 'H': - A = AH; - W = WH; - break; - - case 'P': - A = AP; - W = WP; - break; - - default: - A = 0.0; - W = 0.0; - } - - Weight += W; - Aweight += A; - - X += W * x; - Y += W * y; - Z += W * z; - - XA += A * x; - YA += A * y; - ZA += A * z; - } - - fclose(PDBFile); - - return(NumberOfResidues); - } // ReadAminoPDB\ - - -#endif /*SANSPDB*/ + PreviousResidueID = ResidueID; + } + + // Finish the final amino acid + if (i == NumberOfResidues - 1 && Aweight && Weight) { + Residue[i].xv = X / Weight; + Residue[i].yv = Y / Weight; + Residue[i].zv = Z / Weight; + + // Assign center of mass + Residue[i].x = XA / Aweight; + Residue[i].y = YA / Aweight; + Residue[i].z = ZA / Aweight; + + // Other residue attributes + Residue[i].Volume = Weight; + Residue[i].ScatteringLength = Aweight; + Residue[i].Atom = 'X'; + } + + switch (Atom) { + case 'C': + A = AC; + W = WC; + break; + + case 'N': + A = AN; + W = WN; + break; + + case 'O': + A = AO; + W = WO; + break; + + case 'S': + A = AS; + W = WS; + break; + + case 'H': + A = AH; + W = WH; + break; + + case 'P': + A = AP; + W = WP; + break; + + default: + A = 0.0; + W = 0.0; + } + + Weight += W; + Aweight += A; + + X += W * x; + Y += W * y; + Z += W * z; + + XA += A * x; + YA += A * y; + ZA += A * z; + } + + fclose (PDBFile); + + return (NumberOfResidues); + } // ReadAminoPDB\ + + + #endif /*SANSPDB*/ %} DECLARE %{ - double Absorption; - double NumberDensity; + double Absorption; + double NumberDensity; - // Arrays for storing q and I(q) - DArray1d qArray; - DArray1d IArray; + // Arrays for storing q and I(q) + DArray1d qArray; + DArray1d IArray; %} INITIALIZE %{ - // Protein properties - ProteinStruct Protein; - int qbin; - - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; - - // Standard sample handling - if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr, "SANSPDBFast: %s: ERROR: Sample has no volume - check parameters.\n", NAME_CURRENT_COMP)); - } + // Protein properties + ProteinStruct Protein; + int qbin; + + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; + + // Standard sample handling + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "SANSPDBFast: %s: ERROR: Sample has no volume - check parameters.\n", NAME_CURRENT_COMP)); + } // count the number of residues - Absorption = AbsorptionCrosssection; - Protein.NumberOfResidues = CountResidues(PDBFilepath); - Protein.Beads = calloc(Protein.NumberOfResidues,sizeof(BeadStruct)); - if (Protein.Beads == NULL) - exit(fprintf(stderr, "SANSPDB: %s: ERROR: memory allocation\n", NAME_CURRENT_COMP)); + Absorption = AbsorptionCrosssection; + Protein.NumberOfResidues = CountResidues (PDBFilepath); + Protein.Beads = calloc (Protein.NumberOfResidues, sizeof (BeadStruct)); + if (Protein.Beads == NULL) + exit (fprintf (stderr, "SANSPDB: %s: ERROR: memory allocation\n", NAME_CURRENT_COMP)); - qArray = create_darr1d(NumberOfQBins); - IArray = create_darr1d(NumberOfQBins); + qArray = create_darr1d (NumberOfQBins); + IArray = create_darr1d (NumberOfQBins); // initialize the protein from the PDB - ReadAminoPDB(PDBFilepath, &Protein); - MPI_MASTER( - printf("SANSPDBFast: %s: Initializing scattering from %s with %d residues on %d Q-values\n", - NAME_CURRENT_COMP, PDBFilepath, Protein.NumberOfResidues, NumberOfQBins); - ); - - // Computing scattering profile I(q) - for (qbin = 0; qbin < NumberOfQBins; ++qbin) { - int i,j,ResidueID; - double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); - double q = qMin + qStep * (qbin + 0.5); - cdouble** Matrix = (cdouble**)matrix2d_new(sizeof(cdouble),SANSPDBOrderOfHarmonics+1,SANSPDBOrderOfHarmonics+1); - // init Matrix = 0 - // ResetMatrix(Matrix, SANSPDBOrderOfHarmonics); - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) - for (j = 0; j <= SANSPDBOrderOfHarmonics; ++j) - Matrix[i][j] = cplx(0,0); - - - for (ResidueID = 0; ResidueID < Protein.NumberOfResidues; ++ResidueID) { - // ExpandStructure(Matrix, &Protein, ResidueID, qDummy, RhoSolvent); - double Legendre[SANSPDBOrderOfHarmonics + 1]; - double Bessel[SANSPDBOrderOfHarmonics + 1]; - - // Residue information - const double Volume = Protein.Beads[ResidueID].Volume; - const double DeltaRhoProtein = Protein.Beads[ResidueID].ScatteringLength - Volume * RhoSolvent; - - const double x = (Protein.Beads[ResidueID].x * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].xv) / DeltaRhoProtein; - - const double y = (Protein.Beads[ResidueID].y * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].yv) / DeltaRhoProtein; - - const double z = (Protein.Beads[ResidueID].z * Protein.Beads[ResidueID].ScatteringLength - - RhoSolvent * Volume * Protein.Beads[ResidueID].zv) / DeltaRhoProtein; - - // Convert bead position to spherical coordinates - const double Radius = sqrt(pow(x, 2) + pow(y, 2) + pow(z, 2)); - const double Theta = acos(z / Radius); - const double C = acos(x / (Radius * sin(Theta))) * Sign(y); - - // Expand protein structure on harmonics - gsl_sf_bessel_jl_array(SANSPDBOrderOfHarmonics, q * Radius, Bessel); - - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { - gsl_sf_legendre_sphPlm_array(SANSPDBOrderOfHarmonics, i, cos(Theta), &Legendre[i]); - - for(j = 0; j <= SANSPDBOrderOfHarmonics; ++j) { - if (j < i) Matrix[j][i] = cplx(0,0); - else - Matrix[j][i] = cadd(Matrix[j][i],rmul(sqrt(4.0 * PI) * DeltaRhoProtein * Bessel[j] * Legendre[j] , cmul(cpow(cplx(0,1), cplx(j,0)), Polar(1.0, -i * C)))); - } - } - - } // for ResidueID - - qArray[qbin] = q; - // IArray[qbin] = ComputeIntensity(Matrix, SANSPDBOrderOfHarmonics); - IArray[qbin] = 0; - for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { - for (j = 0; j <= i; ++j) { - IArray[qbin] += ((j > 0) + 1.0) * pow(cabs(Matrix[i][j]), 2); - } - } - // printf("I(q=%g) = %g\n", q, IArray[qbin]); - } // for qbin - MPI_MASTER( - printf("SANSPDBFast: %s: %s initialization I(q) done\n", NAME_CURRENT_COMP, PDBFilepath); - ); + ReadAminoPDB (PDBFilepath, &Protein); + MPI_MASTER (printf ("SANSPDBFast: %s: Initializing scattering from %s with %d residues on %d Q-values\n", NAME_CURRENT_COMP, PDBFilepath, + Protein.NumberOfResidues, NumberOfQBins);); + + // Computing scattering profile I(q) + for (qbin = 0; qbin < NumberOfQBins; ++qbin) { + int i, j, ResidueID; + double qStep = (qMax - qMin) / (1.0 * NumberOfQBins); + double q = qMin + qStep * (qbin + 0.5); + cdouble** Matrix = (cdouble**)matrix2d_new (sizeof (cdouble), SANSPDBOrderOfHarmonics + 1, SANSPDBOrderOfHarmonics + 1); + // init Matrix = 0 + // ResetMatrix(Matrix, SANSPDBOrderOfHarmonics); + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) + for (j = 0; j <= SANSPDBOrderOfHarmonics; ++j) + Matrix[i][j] = cplx (0, 0); + + for (ResidueID = 0; ResidueID < Protein.NumberOfResidues; ++ResidueID) { + // ExpandStructure(Matrix, &Protein, ResidueID, qDummy, RhoSolvent); + double Legendre[SANSPDBOrderOfHarmonics + 1]; + double Bessel[SANSPDBOrderOfHarmonics + 1]; + + // Residue information + const double Volume = Protein.Beads[ResidueID].Volume; + const double DeltaRhoProtein = Protein.Beads[ResidueID].ScatteringLength - Volume * RhoSolvent; + + const double x + = (Protein.Beads[ResidueID].x * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].xv) / DeltaRhoProtein; + + const double y + = (Protein.Beads[ResidueID].y * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].yv) / DeltaRhoProtein; + + const double z + = (Protein.Beads[ResidueID].z * Protein.Beads[ResidueID].ScatteringLength - RhoSolvent * Volume * Protein.Beads[ResidueID].zv) / DeltaRhoProtein; + + // Convert bead position to spherical coordinates + const double Radius = sqrt (pow (x, 2) + pow (y, 2) + pow (z, 2)); + const double Theta = acos (z / Radius); + const double C = acos (x / (Radius * sin (Theta))) * Sign (y); + + // Expand protein structure on harmonics + gsl_sf_bessel_jl_array (SANSPDBOrderOfHarmonics, q * Radius, Bessel); + + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { + gsl_sf_legendre_sphPlm_array (SANSPDBOrderOfHarmonics, i, cos (Theta), &Legendre[i]); + + for (j = 0; j <= SANSPDBOrderOfHarmonics; ++j) { + if (j < i) + Matrix[j][i] = cplx (0, 0); + else + Matrix[j][i] = cadd (Matrix[j][i], + rmul (sqrt (4.0 * PI) * DeltaRhoProtein * Bessel[j] * Legendre[j], cmul (cpow (cplx (0, 1), cplx (j, 0)), Polar (1.0, -i * C)))); + } + } + + } // for ResidueID + qArray[qbin] = q; + // IArray[qbin] = ComputeIntensity(Matrix, SANSPDBOrderOfHarmonics); + IArray[qbin] = 0; + for (i = 0; i <= SANSPDBOrderOfHarmonics; ++i) { + for (j = 0; j <= i; ++j) { + IArray[qbin] += ((j > 0) + 1.0) * pow (cabs (Matrix[i][j]), 2); + } + } + // printf("I(q=%g) = %g\n", q, IArray[qbin]); + } // for qbin + MPI_MASTER (printf ("SANSPDBFast: %s: %s initialization I(q) done\n", NAME_CURRENT_COMP, PDBFilepath);); %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double q; - double Intensity; - double Weight; - double IntensityPart; - double SolidAngle; - - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - double Slope; - double Offset; - int i; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Discard neutron, if q is out of range - if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { - ABSORB; - } - - // Find the first value of q in the curve larger than that of the neutron - i = 1; - - while (q > qArray[i]) { - ++i; - } - - // Do a linear interpolation - l1 = v * t1; - - Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); - Offset = IArray[i] - Slope * qArray[i]; - - Intensity = (Slope * q + Offset); - - p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double q; + double Intensity; + double Weight; + double IntensityPart; + double SolidAngle; + + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + double Slope; + double Offset; + int i; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Discard neutron, if q is out of range + if ((q < qArray[0]) || (q > qArray[NumberOfQBins - 1])) { + ABSORB; + } + + // Find the first value of q in the curve larger than that of the neutron + i = 1; + + while (q > qArray[i]) { + ++i; + } + + // Do a linear interpolation + l1 = v * t1; + + Slope = (IArray[i] - IArray[i - 1]) / (qArray[i] - qArray[i - 1]); + Offset = IArray[i] - Slope * qArray[i]; + + Intensity = (Slope * q + Offset); + + p *= l_full * SolidAngle / (4.0 * PI) * NumberDensity * Intensity * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSQMonitor.comp b/mcstas-comps/contrib/SANSQMonitor.comp index 756b7c40b..d43f3d8df 100644 --- a/mcstas-comps/contrib/SANSQMonitor.comp +++ b/mcstas-comps/contrib/SANSQMonitor.comp @@ -61,157 +61,135 @@ INITIALIZE // Declarations int i; - Nofq = create_darr1d(NumberOfBins); - Iofq = create_darr1d(NumberOfBins); - IofqSquared = create_darr1d(NumberOfBins); + Nofq = create_darr1d (NumberOfBins); + Iofq = create_darr1d (NumberOfBins); + IofqSquared = create_darr1d (NumberOfBins); - NofR = create_darr1d(NumberOfBins); - IofR = create_darr1d(NumberOfBins); - IofRSquared = create_darr1d(NumberOfBins); + NofR = create_darr1d (NumberOfBins); + IofR = create_darr1d (NumberOfBins); + IofRSquared = create_darr1d (NumberOfBins); // Initializations for (i = 0; i < NumberOfBins; ++i) { - Nofq[i] = 0.0; - Iofq[i] = 0.0; - IofqSquared[i] = 0.0; + Nofq[i] = 0.0; + Iofq[i] = 0.0; + IofqSquared[i] = 0.0; } - TwoThetaMax = atan(RadiusDetector / DistanceFromSample); - qMax = 4 * PI * sin(TwoThetaMax / 2.0) / LambdaMin; + TwoThetaMax = atan (RadiusDetector / DistanceFromSample); + qMax = 4 * PI * sin (TwoThetaMax / 2.0) / LambdaMin; %} TRACE %{ - // Declarations + // Declarations int i; double TwoTheta; - double Lambda; + double Lambda; - double R; - double RLow; - double RHigh; + double R; + double RLow; + double RHigh; double q; - double qLow; - double qHigh; + double qLow; + double qHigh; - double TwoThetaLow; - double TwoThetaHigh; - double AreaOfSlice; + double TwoThetaLow; + double TwoThetaHigh; + double AreaOfSlice; PROP_Z0; - // Computation of R - R = sqrt(pow(x, 2) + pow(y, 2)); - - // Computation of q - if (Lambda0 <= 0.0) { - Lambda = 2.0 * PI / (V2K * sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2))); - } else { - Lambda = Lambda0; - } - - TwoTheta = atan(R / DistanceFromSample); - q = 4.0 * PI * sin(TwoTheta / 2.0) / Lambda; - - // Put neutron in the correct r-bin - if (R < RadiusDetector) { - i = floor(NumberOfBins * R / RadiusDetector); - - RLow = RadiusDetector / NumberOfBins * i; - RHigh = RadiusDetector / NumberOfBins * (i + 1); - - TwoThetaLow = atan(RLow / DistanceFromSample); - TwoThetaHigh = atan(RHigh / DistanceFromSample); - - AreaOfSlice = fabs((cos(2.0 * TwoThetaLow) - cos(2.0 * TwoThetaHigh)) * 2.0 * PI); - #pragma acc atomic - NofR[i] = NofR[i] + 1; - double p_A=p/AreaOfSlice; - #pragma acc atomic - IofR[i] = IofR[i] + p_A; - double p2_A2= p*p/(AreaOfSlice*AreaOfSlice); - #pragma acc atomic - IofRSquared[i] = IofRSquared[i] + p2_A2; - } - - // Put neutron in the correct q-bin - if (q < qMax) { - i = floor(NumberOfBins * q / qMax); - - qLow = qMax / NumberOfBins * i; - qHigh = qMax / NumberOfBins * (i + 1); - - TwoThetaLow = asin(qLow * Lambda / (4.0 * PI)); - TwoThetaHigh = asin(qHigh * Lambda / (4.0 * PI)); - - AreaOfSlice = fabs((cos(2.0 * TwoThetaLow) - cos(2.0 * TwoThetaHigh)) * 2.0 * PI); - - #pragma acc atomic - Nofq[i] = Nofq[i] + 1; - double p_A=p/AreaOfSlice; - #pragma acc atomic - Iofq[i] = Iofq[i] + p_A; - double p2_A2= p*p/(AreaOfSlice*AreaOfSlice); - #pragma acc atomic - IofqSquared[i] = IofqSquared[i] + p2_A2; - - SCATTER; - } - - // Restore neutron if requested + // Computation of R + R = sqrt (pow (x, 2) + pow (y, 2)); + + // Computation of q + if (Lambda0 <= 0.0) { + Lambda = 2.0 * PI / (V2K * sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2))); + } else { + Lambda = Lambda0; + } + + TwoTheta = atan (R / DistanceFromSample); + q = 4.0 * PI * sin (TwoTheta / 2.0) / Lambda; + + // Put neutron in the correct r-bin + if (R < RadiusDetector) { + i = floor (NumberOfBins * R / RadiusDetector); + + RLow = RadiusDetector / NumberOfBins * i; + RHigh = RadiusDetector / NumberOfBins * (i + 1); + + TwoThetaLow = atan (RLow / DistanceFromSample); + TwoThetaHigh = atan (RHigh / DistanceFromSample); + + AreaOfSlice = fabs ((cos (2.0 * TwoThetaLow) - cos (2.0 * TwoThetaHigh)) * 2.0 * PI); + #pragma acc atomic + NofR[i] = NofR[i] + 1; + double p_A = p / AreaOfSlice; + #pragma acc atomic + IofR[i] = IofR[i] + p_A; + double p2_A2 = p * p / (AreaOfSlice * AreaOfSlice); + #pragma acc atomic + IofRSquared[i] = IofRSquared[i] + p2_A2; + } + + // Put neutron in the correct q-bin + if (q < qMax) { + i = floor (NumberOfBins * q / qMax); + + qLow = qMax / NumberOfBins * i; + qHigh = qMax / NumberOfBins * (i + 1); + + TwoThetaLow = asin (qLow * Lambda / (4.0 * PI)); + TwoThetaHigh = asin (qHigh * Lambda / (4.0 * PI)); + + AreaOfSlice = fabs ((cos (2.0 * TwoThetaLow) - cos (2.0 * TwoThetaHigh)) * 2.0 * PI); + + #pragma acc atomic + Nofq[i] = Nofq[i] + 1; + double p_A = p / AreaOfSlice; + #pragma acc atomic + Iofq[i] = Iofq[i] + p_A; + double p2_A2 = p * p / (AreaOfSlice * AreaOfSlice); + #pragma acc atomic + IofqSquared[i] = IofqSquared[i] + p2_A2; + + SCATTER; + } + + // Restore neutron if requested if (restore_neutron) { -// RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + // RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); } %} SAVE %{ - // Output I(r) - DETECTOR_OUT_1D( - "QMonitor - Radially averaged distribution", - "Radius [m]", - "I(r)", - "r", - 0.0, - RadiusDetector, - NumberOfBins, - &NofR[0], - &IofR[0], - &IofRSquared[0], - RFilename - ); - - // Output I(q) - DETECTOR_OUT_1D( - "QMonitor - Distribution in q (Radially averaged)", - "q [1 / AA]", - "I(q)", - "q", - 0.0, - qMax, - NumberOfBins, - &Nofq[0], - &Iofq[0], - &IofqSquared[0], - qFilename - ); + // Output I(r) + DETECTOR_OUT_1D ("QMonitor - Radially averaged distribution", "Radius [m]", "I(r)", "r", 0.0, RadiusDetector, NumberOfBins, &NofR[0], &IofR[0], &IofRSquared[0], + RFilename); + + // Output I(q) + DETECTOR_OUT_1D ("QMonitor - Distribution in q (Radially averaged)", "q [1 / AA]", "I(q)", "q", 0.0, qMax, NumberOfBins, &Nofq[0], &Iofq[0], &IofqSquared[0], + qFilename); %} FINALLY %{ - destroy_darr1d(Nofq); - destroy_darr1d(Iofq); - destroy_darr1d(IofqSquared); + destroy_darr1d (Nofq); + destroy_darr1d (Iofq); + destroy_darr1d (IofqSquared); - destroy_darr1d(NofR); - destroy_darr1d(IofR); - destroy_darr1d(IofRSquared); + destroy_darr1d (NofR); + destroy_darr1d (IofR); + destroy_darr1d (IofRSquared); %} MCDISPLAY %{ - circle("xy", 0, 0, 0, RadiusDetector); + circle ("xy", 0, 0, 0, RadiusDetector); %} END diff --git a/mcstas-comps/contrib/SANSShells.comp b/mcstas-comps/contrib/SANSShells.comp index 2362601e8..4117c6b8c 100644 --- a/mcstas-comps/contrib/SANSShells.comp +++ b/mcstas-comps/contrib/SANSShells.comp @@ -43,124 +43,124 @@ xwidth, yheight, zdepth, SampleToDetectorDistance, DetectorRadius) DECLARE %{ -// Declarations -double Prefactor; -double Absorption; -double q; -double NumberDensity; - -double RBig; -double RSmall; - -double VolumeBigSphere; -double VolumeSmallSphere; -double Volume; + // Declarations + double Prefactor; + double Absorption; + double q; + double NumberDensity; + + double RBig; + double RSmall; + + double VolumeBigSphere; + double VolumeSmallSphere; + double Volume; %} INITIALIZE %{ -// Rescale concentration into number of aggregates per m^3 times 10^-4 -NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; -// Computations -if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - if (Thickness >= R) { - printf("%s: Thickness of shell larger than radius of shell!\n", NAME_CURRENT_COMP); - } + if (Thickness >= R) { + printf ("%s: Thickness of shell larger than radius of shell!\n", NAME_CURRENT_COMP); + } - RBig = R + Thickness / 2.0; - RSmall = R - Thickness / 2.0; + RBig = R + Thickness / 2.0; + RSmall = R - Thickness / 2.0; - VolumeBigSphere = 4.0 / 3.0 * PI * pow(RBig, 3); - VolumeSmallSphere = 4.0 / 3.0 * PI * pow(RSmall, 3); + VolumeBigSphere = 4.0 / 3.0 * PI * pow (RBig, 3); + VolumeSmallSphere = 4.0 / 3.0 * PI * pow (RSmall, 3); - Volume = VolumeBigSphere - VolumeSmallSphere; + Volume = VolumeBigSphere - VolumeSmallSphere; - Prefactor = NumberDensity * pow(Volume, 2) * pow(DeltaRho, 2); + Prefactor = NumberDensity * pow (Volume, 2) * pow (DeltaRho, 2); - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double FormfactorBigSphere; - double FormfactorSmallSphere; - double Formfactor; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - FormfactorBigSphere = 3.0 * (sin(q * RBig) - q * RBig * cos(q * RBig)) / pow(q * RBig, 3); - FormfactorSmallSphere = 3.0 * (sin(q * RSmall) - q * RSmall * cos(q * RSmall)) / pow(q * RSmall, 3); - Formfactor = (FormfactorBigSphere * VolumeBigSphere - FormfactorSmallSphere * VolumeSmallSphere) / (VolumeBigSphere - VolumeSmallSphere); - - p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow(Formfactor, 2) * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double FormfactorBigSphere; + double FormfactorSmallSphere; + double Formfactor; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + FormfactorBigSphere = 3.0 * (sin (q * RBig) - q * RBig * cos (q * RBig)) / pow (q * RBig, 3); + FormfactorSmallSphere = 3.0 * (sin (q * RSmall) - q * RSmall * cos (q * RSmall)) / pow (q * RSmall, 3); + Formfactor = (FormfactorBigSphere * VolumeBigSphere - FormfactorSmallSphere * VolumeSmallSphere) / (VolumeBigSphere - VolumeSmallSphere); + + p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow (Formfactor, 2) * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSSpheres.comp b/mcstas-comps/contrib/SANSSpheres.comp index 13d29475f..acf095f96 100644 --- a/mcstas-comps/contrib/SANSSpheres.comp +++ b/mcstas-comps/contrib/SANSSpheres.comp @@ -45,103 +45,103 @@ xwidth, yheight, zdepth, SampleToDetectorDistance, DetectorRadius) DECLARE %{ -// Declarations -double Prefactor; -double Absorption; -double q; -double NumberDensity; + // Declarations + double Prefactor; + double Absorption; + double q; + double NumberDensity; %} INITIALIZE %{ -// Rescale concentration into number of aggregates per m^3 times 10^-4 -NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; -// Computations -if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Prefactor = NumberDensity * pow(4.0 / 3.0 * PI * pow(R, 3), 2) * pow(DeltaRho, 2); + Prefactor = NumberDensity * pow (4.0 / 3.0 * PI * pow (R, 3), 2) * pow (DeltaRho, 2); - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Formfactor; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // Set radius if polydisperse spheres - R = R + randnorm()*dR; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Formfactor = 3.0 * (sin(q * R) - q * R * cos(q * R)) / pow(q * R, 3); - - p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow(Formfactor, 2) * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Formfactor; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // Set radius if polydisperse spheres + R = R + randnorm () * dR; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Formfactor = 3.0 * (sin (q * R) - q * R * cos (q * R)) / pow (q * R, 3); + + p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow (Formfactor, 2) * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANSSpheresPolydisperse.comp b/mcstas-comps/contrib/SANSSpheresPolydisperse.comp index 5de1b9d76..9f568f6e3 100644 --- a/mcstas-comps/contrib/SANSSpheresPolydisperse.comp +++ b/mcstas-comps/contrib/SANSSpheresPolydisperse.comp @@ -46,103 +46,103 @@ DEFINE COMPONENT SANSSpheresPolydisperse DECLARE %{ - // Declarations - double Prefactor; - double Absorption; - double q; - double NumberDensity; + // Declarations + double Prefactor; + double Absorption; + double q; + double NumberDensity; %} INITIALIZE %{ - // Rescale concentration into number of aggregates per m^3 times 10^-4 - NumberDensity = Concentration * 6.02214129e19; + // Rescale concentration into number of aggregates per m^3 times 10^-4 + NumberDensity = Concentration * 6.02214129e19; - // Computations - if (!xwidth || !yheight || !zdepth) { - printf("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); - } + // Computations + if (!xwidth || !yheight || !zdepth) { + printf ("%s: Sample has no volume, check parameters!\n", NAME_CURRENT_COMP); + } - Prefactor = NumberDensity * pow(4.0 / 3.0 * PI * pow(R, 3), 2) * pow(DeltaRho, 2); + Prefactor = NumberDensity * pow (4.0 / 3.0 * PI * pow (R, 3), 2) * pow (DeltaRho, 2); - Absorption = AbsorptionCrosssection; + Absorption = AbsorptionCrosssection; %} TRACE %{ - // Declarations - double t0; - double t1; - double l_full; - double l; - double l1; - double Formfactor; - double SolidAngle; - double qx; - double qy; - double qz; - double v; - double dt; - double vx_i; - double vy_i; - double vz_i; - char Intersect = 0; - - // Set radius if polydisperse spheres - R = R + randnorm()*dR; - - // Computation - Intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - - if (Intersect) { - - if (t0 < 0.0) { - fprintf(stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); - ABSORB; - } - - // Compute properties of neutron - v = sqrt(pow(vx, 2) + pow(vy, 2) + pow(vz, 2)); - l_full = v * (t1 - t0); - dt = rand01() * (t1 - t0) + t0; - PROP_DT(dt); - l = v * (dt - t0); - - // Store properties of incoming neutron - vx_i = vx; - vy_i = vy; - vz_i = vz; - - // Generate new direction of neutron - randvec_target_circle(&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); - - NORM(vx, vy, vz); - - vx *= v; - vy *= v; - vz *= v; - - // Compute q - qx = V2K * (vx_i - vx); - qy = V2K * (vy_i - vy); - qz = V2K * (vz_i - vz); - - q = sqrt(pow(qx, 2) + pow(qy, 2) + pow(qz, 2)); - - // Compute scattering - l1 = v * t1; - - Formfactor = 3.0 * (sin(q * R) - q * R * cos(q * R)) / pow(q * R, 3); - - p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow(Formfactor, 2) * exp(- Absorption * (l + l1) / v); - - SCATTER; - } + // Declarations + double t0; + double t1; + double l_full; + double l; + double l1; + double Formfactor; + double SolidAngle; + double qx; + double qy; + double qz; + double v; + double dt; + double vx_i; + double vy_i; + double vz_i; + char Intersect = 0; + + // Set radius if polydisperse spheres + R = R + randnorm () * dR; + + // Computation + Intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + + if (Intersect) { + + if (t0 < 0.0) { + fprintf (stderr, "Neutron already inside sample %s - absorbing...\n", NAME_CURRENT_COMP); + ABSORB; + } + + // Compute properties of neutron + v = sqrt (pow (vx, 2) + pow (vy, 2) + pow (vz, 2)); + l_full = v * (t1 - t0); + dt = rand01 () * (t1 - t0) + t0; + PROP_DT (dt); + l = v * (dt - t0); + + // Store properties of incoming neutron + vx_i = vx; + vy_i = vy; + vz_i = vz; + + // Generate new direction of neutron + randvec_target_circle (&vx, &vy, &vz, &SolidAngle, 0, 0, SampleToDetectorDistance, DetectorRadius); + + NORM (vx, vy, vz); + + vx *= v; + vy *= v; + vz *= v; + + // Compute q + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + + q = sqrt (pow (qx, 2) + pow (qy, 2) + pow (qz, 2)); + + // Compute scattering + l1 = v * t1; + + Formfactor = 3.0 * (sin (q * R) - q * R * cos (q * R)) / pow (q * R, 3); + + p *= l_full * SolidAngle / (4.0 * PI) * Prefactor * pow (Formfactor, 2) * exp (-Absorption * (l + l1) / v); + + SCATTER; + } %} MCDISPLAY %{ - box(0, 0, 0, xwidth, yheight, zdepth,0, 0, 1, 0); + box (0, 0, 0, xwidth, yheight, zdepth, 0, 0, 1, 0); %} END diff --git a/mcstas-comps/contrib/SANS_AnySamp.comp b/mcstas-comps/contrib/SANS_AnySamp.comp index 991989cc2..d86350c4f 100644 --- a/mcstas-comps/contrib/SANS_AnySamp.comp +++ b/mcstas-comps/contrib/SANS_AnySamp.comp @@ -63,93 +63,92 @@ xwidth=0.01, yheight=0.01, zdepth=0.001) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ DECLARE %{ -double isq; + double isq; %} INITIALIZE %{ -if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr,"SANS_AnySamp: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - } + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "SANS_AnySamp: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + } - int iqmax=30000,iq=iqmax; // number of intervals - double q,sq; + int iqmax = 30000, iq = iqmax; // number of intervals + double q, sq; - double a=Rg*Rg/3.0; // internal for function sq + double a = Rg * Rg / 3.0; // internal for function sq - isq = 0.0; // integral = 0 + isq = 0.0; // integral = 0 - while (iq > 1) // start integrating with low intensities at large q - { // MODIFIY HERE - q = (iq-0.5)*qmax/iqmax; // q always slightly larger than 0 - sq = exp(-a*q*q); // define this function in INITIALIZE and TRACE part - sq*= q; - isq+= sq; - --iq; + while (iq > 1) // start integrating with low intensities at large q + { // MODIFIY HERE + q = (iq - 0.5) * qmax / iqmax; // q always slightly larger than 0 + sq = exp (-a * q * q); // define this function in INITIALIZE and TRACE part + sq *= q; + isq += sq; + --iq; } - isq*=qmax/iqmax; - + isq *= qmax / iqmax; %} TRACE %{ - double a,q,qm,sq,q_v; - double transsim=0.03; // portion of paths for transmission + double a, q, qm, sq, q_v; + double transsim = 0.03; // portion of paths for transmission double transmr, t0, t1, v, l_full, l, dt, d_phi, theta; double axis_x, axis_y, axis_z; double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; - char intersect=0; - + char intersect = 0; - transmr = transm; /* real transmission */ - if (transmr<1e-10) transmr = 1e-10; - if (transmr>0.99 ) transmr = 0.99; + transmr = transm; /* real transmission */ + if (transmr < 1e-10) + transmr = 1e-10; + if (transmr > 0.99) + transmr = 0.99; - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - if(intersect) - { - if(t0 < 0) ABSORB; /* Neutron enters at t=t0. */ + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + if (intersect) { + if (t0 < 0) + ABSORB; /* Neutron enters at t=t0. */ - v = sqrt(vx*vx + vy*vy + vz*vz); - l_full = v * (t1 - t0); /* Length of full path through sample */ - transmr = exp(log(transmr)*l_full/zdepth); /* real transmission */ + v = sqrt (vx * vx + vy * vy + vz * vz); + l_full = v * (t1 - t0); /* Length of full path through sample */ + transmr = exp (log (transmr) * l_full / zdepth); /* real transmission */ - dt = rand01()*(t1 - t0) + t0; /* Time of scattering */ - PROP_DT(dt); /* Point of scattering */ - l = v*dt; /* Penetration in sample */ + dt = rand01 () * (t1 - t0) + t0; /* Time of scattering */ + PROP_DT (dt); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ - qm = qmax; // adjust maximal q - if (qm > 2.0*v/K2V) qm = 2.0*v/K2V; // should not be totally wrong - q = sqrt(rand01())*qm; // otherwise normalization with isq is wrong + qm = qmax; // adjust maximal q + if (qm > 2.0 * v / K2V) + qm = 2.0 * v / K2V; // should not be totally wrong + q = sqrt (rand01 ()) * qm; // otherwise normalization with isq is wrong - q_v = q*K2V; /* scattering possible ??? */ - arg = q_v/(2.0*v); + q_v = q * K2V; /* scattering possible ??? */ + arg = q_v / (2.0 * v); - if(rand01()>transsim) - { - a = Rg*Rg/3.0; // MODIFIY HERE - sq= exp(-a*q*q); // identical to INITIALIZE + if (rand01 () > transsim) { + a = Rg * Rg / 3.0; // MODIFIY HERE + sq = exp (-a * q * q); // identical to INITIALIZE - p*= sq*(qmax*qmax*0.5)*(1.0-transmr)/(1.0-transsim)/isq; + p *= sq * (qmax * qmax * 0.5) * (1.0 - transmr) / (1.0 - transsim) / isq; - theta = asin(arg); /* Bragg scattering law */ - d_phi = 2*PI*rand01(); + theta = asin (arg); /* Bragg scattering law */ + d_phi = 2 * PI * rand01 (); - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2*theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2 * theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); - vx = vout_x; - vy = vout_y; - vz = vout_z; + vx = vout_x; + vy = vout_y; + vz = vout_z; - if(!box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) fprintf(stderr, "SANS_AnySamp: FATAL ERROR: Did not hit box from inside.\n"); - } - else - { - p*= transmr / transsim; + if (!box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) + fprintf (stderr, "SANS_AnySamp: FATAL ERROR: Did not hit box from inside.\n"); + } else { + p *= transmr / transsim; } SCATTER; @@ -160,29 +159,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - + { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zdepth; - double zmax = 0.5*zdepth; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zdepth; + double zmax = 0.5 * zdepth; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/SANS_DebyeS.comp b/mcstas-comps/contrib/SANS_DebyeS.comp index 6502209b8..1210f2b1b 100644 --- a/mcstas-comps/contrib/SANS_DebyeS.comp +++ b/mcstas-comps/contrib/SANS_DebyeS.comp @@ -59,53 +59,54 @@ DECLARE INITIALIZE %{ -if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr,"SANS_DebyeS: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - } + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "SANS_DebyeS: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + } %} TRACE %{ - double transmr, t0, t1, v, l_full, l, dt, d_phi, theta,q_v; + double transmr, t0, t1, v, l_full, l, dt, d_phi, theta, q_v; double axis_x, axis_y, axis_z; double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; - char intersect=0; - + char intersect = 0; - transmr = transm; /* real transmission */ - if (transmr<1e-10) transmr = 1e-10; - if (transmr>1e0 ) transmr = 1e0; + transmr = transm; /* real transmission */ + if (transmr < 1e-10) + transmr = 1e-10; + if (transmr > 1e0) + transmr = 1e0; - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - if(intersect) - { - if(t0 < 0) ABSORB; /* Neutron enters at t=t0. */ + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + if (intersect) { + if (t0 < 0) + ABSORB; /* Neutron enters at t=t0. */ - v = sqrt(vx*vx + vy*vy + vz*vz); - l_full = v * (t1 - t0); /* Length of full path through sample */ - transmr = exp(log(transmr)*l_full/zdepth); /* real transmission */ + v = sqrt (vx * vx + vy * vy + vz * vz); + l_full = v * (t1 - t0); /* Length of full path through sample */ + transmr = exp (log (transmr) * l_full / zdepth); /* real transmission */ - dt = rand01()*(t1 - t0) + t0; /* Time of scattering */ - PROP_DT(dt); /* Point of scattering */ - l = v*dt; /* Penetration in sample */ + dt = rand01 () * (t1 - t0) + t0; /* Time of scattering */ + PROP_DT (dt); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ - q_v = qDS*K2V; /* scattering possible ??? */ - arg = q_v/(2.0*v); + q_v = qDS * K2V; /* scattering possible ??? */ + arg = q_v / (2.0 * v); - if(arg<1.0 && rand01()>transmr) - { - theta = asin(arg); /* Bragg scattering law */ - d_phi = 2*PI*rand01(); + if (arg < 1.0 && rand01 () > transmr) { + theta = asin (arg); /* Bragg scattering law */ + d_phi = 2 * PI * rand01 (); - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2*theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2 * theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); - vx = vout_x; - vy = vout_y; - vz = vout_z; + vx = vout_x; + vy = vout_y; + vz = vout_z; - if(!box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) fprintf(stderr, "SANS_DebyeS: FATAL ERROR: Did not hit box from inside.\n"); + if (!box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) + fprintf (stderr, "SANS_DebyeS: FATAL ERROR: Did not hit box from inside.\n"); } SCATTER; @@ -116,29 +117,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - + { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zdepth; - double zmax = 0.5*zdepth; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zdepth; + double zmax = 0.5 * zdepth; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/SANS_Guinier.comp b/mcstas-comps/contrib/SANS_Guinier.comp index 34af077a9..44ee12545 100644 --- a/mcstas-comps/contrib/SANS_Guinier.comp +++ b/mcstas-comps/contrib/SANS_Guinier.comp @@ -66,62 +66,65 @@ DECLARE INITIALIZE %{ -if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr,"SANS_Guinier: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - } + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "SANS_Guinier: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + } %} TRACE %{ - double a,qm,q,q_v; + double a, qm, q, q_v; double transmr, t0, t1, v, l_full, l, dt, d_phi, theta; double axis_x, axis_y, axis_z; double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; - char intersect=0; - + char intersect = 0; - transmr = transm; /* real transmission */ - if (transmr<1e-10) transmr = 1e-10; - if (transmr>1e0 ) transmr = 1e0; + transmr = transm; /* real transmission */ + if (transmr < 1e-10) + transmr = 1e-10; + if (transmr > 1e0) + transmr = 1e0; - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - if(intersect) - { - if(t0 < 0) ABSORB; /* Neutron enters at t=t0. */ + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + if (intersect) { + if (t0 < 0) + ABSORB; /* Neutron enters at t=t0. */ - v = sqrt(vx*vx + vy*vy + vz*vz); - l_full = v * (t1 - t0); /* Length of full path through sample */ - transmr = exp(log(transmr)*l_full/zdepth); /* real transmission */ + v = sqrt (vx * vx + vy * vy + vz * vz); + l_full = v * (t1 - t0); /* Length of full path through sample */ + transmr = exp (log (transmr) * l_full / zdepth); /* real transmission */ - dt = rand01()*(t1 - t0) + t0; /* Time of scattering */ - PROP_DT(dt); /* Point of scattering */ - l = v*dt; /* Penetration in sample */ + dt = rand01 () * (t1 - t0) + t0; /* Time of scattering */ + PROP_DT (dt); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ - a = Rg*Rg/3.0; - qm= qmax; + a = Rg * Rg / 3.0; + qm = qmax; - if (qm<1.0/Rg) qm = 1.0/Rg; - if (qm>sqrt(log(1e6)/a)) qm = sqrt(log(1e6)/a); + if (qm < 1.0 / Rg) + qm = 1.0 / Rg; + if (qm > sqrt (log (1e6) / a)) + qm = sqrt (log (1e6) / a); - q = sqrt(-log(1.0-rand01()*(1.0-exp(-a*qm*qm)))/a); + q = sqrt (-log (1.0 - rand01 () * (1.0 - exp (-a * qm * qm))) / a); - q_v = q*K2V; /* scattering possible ??? */ - arg = q_v/(2.0*v); + q_v = q * K2V; /* scattering possible ??? */ + arg = q_v / (2.0 * v); - if(arg<1.0 && rand01()>transmr) - { - theta = asin(arg); /* Bragg scattering law */ - d_phi = 2*PI*rand01(); + if (arg < 1.0 && rand01 () > transmr) { + theta = asin (arg); /* Bragg scattering law */ + d_phi = 2 * PI * rand01 (); - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2*theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2 * theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); - vx = vout_x; - vy = vout_y; - vz = vout_z; + vx = vout_x; + vy = vout_y; + vz = vout_z; - if(!box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) fprintf(stderr, "SANS_Guinier: FATAL ERROR: Did not hit box from inside.\n"); + if (!box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) + fprintf (stderr, "SANS_Guinier: FATAL ERROR: Did not hit box from inside.\n"); } SCATTER; @@ -132,29 +135,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - + { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zdepth; - double zmax = 0.5*zdepth; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zdepth; + double zmax = 0.5 * zdepth; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/SANS_Liposomes_Abs.comp b/mcstas-comps/contrib/SANS_Liposomes_Abs.comp index dd9a61a1e..b397df06e 100644 --- a/mcstas-comps/contrib/SANS_Liposomes_Abs.comp +++ b/mcstas-comps/contrib/SANS_Liposomes_Abs.comp @@ -70,122 +70,120 @@ DECLARE INITIALIZE %{ - if (!xwidth || !yheight || !zthick) { - exit(fprintf(stderr,"SANS_AnySamp: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - } - - int iqmax=30000,iq=iqmax; // number of intervals - double q,sq,f; - - isq = 0.0; // integral = 0 - - while (iq > 1) // start integrating with low intensities at large q - { // MODIFIY HERE - q = (iq-0.5)*qmax/iqmax; // q always slightly larger than 0 - if(Ri<=0) - fi = 0; -else - fi = 3*(sin(q*Ri) - q*Ri*cos(q*Ri))/(q*Ri*q*Ri*q*Ri); - - sq = fi*fi; // define this function in INITIALIZE and TRACE part - sq*= q; - isq+= sq; - --iq; + if (!xwidth || !yheight || !zthick) { + exit (fprintf (stderr, "SANS_AnySamp: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); } - isq*=qmax/iqmax; - my_a_v = sigma_a*2200*100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ + int iqmax = 30000, iq = iqmax; // number of intervals + double q, sq, f; + + isq = 0.0; // integral = 0 + + while (iq > 1) // start integrating with low intensities at large q + { // MODIFIY HERE + q = (iq - 0.5) * qmax / iqmax; // q always slightly larger than 0 + if (Ri <= 0) + fi = 0; + else + fi = 3 * (sin (q * Ri) - q * Ri * cos (q * Ri)) / (q * Ri * q * Ri * q * Ri); + + sq = fi * fi; // define this function in INITIALIZE and TRACE part + sq *= q; + isq += sq; + --iq; + } + isq *= qmax / iqmax; + my_a_v = sigma_a * 2200 * 100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ %} TRACE %{ - double a,q,qm,sq,f; - double Vi,Vo; - double RiTrace,Ro; + double a, q, qm, sq, f; + double Vi, Vo; + double RiTrace, Ro; double fiTrace, fo; - double transsim=0.5; // portion of paths for transmission, ~ 0.03 for SANS, 0.5 for SESANS + double transsim = 0.5; // portion of paths for transmission, ~ 0.03 for SANS, 0.5 for SESANS double my_s_pre; double q_v; double transmr, t0, t1, v, l_full, l, dt, d_phi, theta; double axis_x, axis_y, axis_z; double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; - char intersect=0; - - RiTrace=Ri; - fiTrace=fi; - - Ro=R+randnorm()*dR; - RiTrace = Ro-dbilayer; /* Calculate inner radius of liposphere */ - if(dbilayer==R) - RiTrace=0; /* Treat sample as solid spheres */ - Vi = 4/3*PI*RiTrace*RiTrace*RiTrace; - Vo = 4/3*PI*Ro*Ro*Ro; - my_s_pre = Phi * (Vo-Vi) * Delta_rho*Delta_rho; - - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - if(intersect) - { - if(t0 < 0) ABSORB; /* Neutron enters at t=t0. */ + char intersect = 0; - v = sqrt(vx*vx + vy*vy + vz*vz); + RiTrace = Ri; + fiTrace = fi; + + Ro = R + randnorm () * dR; + RiTrace = Ro - dbilayer; /* Calculate inner radius of liposphere */ + if (dbilayer == R) + RiTrace = 0; /* Treat sample as solid spheres */ + Vi = 4 / 3 * PI * RiTrace * RiTrace * RiTrace; + Vo = 4 / 3 * PI * Ro * Ro * Ro; + my_s_pre = Phi * (Vo - Vi) * Delta_rho * Delta_rho; + + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (intersect) { + if (t0 < 0) + ABSORB; /* Neutron enters at t=t0. */ + + v = sqrt (vx * vx + vy * vy + vz * vz); /* amount of scattering is described by \lambda^2 zthick Delta_rho^2 phi 3/2 R */ /* for example J. Schelten, W. Schmatz: J. Appl. Crystallogr. 13, 385 (1980) */ /* units perfectly cancel each other \AA^2 m fm^2 \AA^-6 \AA = 1 */ - transmr = 1.0 - 4.0*PI*PI/V2K/V2K/v/v*zthick*Delta_rho*Delta_rho*Phi*1.5*R; /* transmission for single scattering */ -/* if (transmr<1e-10) transmr = 1e-10; */ -/* if (transmr>0.99 ) transmr = 0.99; */ + transmr = 1.0 - 4.0 * PI * PI / V2K / V2K / v / v * zthick * Delta_rho * Delta_rho * Phi * 1.5 * R; /* transmission for single scattering */ + /* if (transmr<1e-10) transmr = 1e-10; */ + /* if (transmr>0.99 ) transmr = 0.99; */ - l_full = v * (t1 - t0); /* Length of full path through sample */ - transmr = exp(log(transmr)*l_full/zthick); /* real transmission */ + l_full = v * (t1 - t0); /* Length of full path through sample */ + transmr = exp (log (transmr) * l_full / zthick); /* real transmission */ - dt = rand01()*(t1 - t0) + t0; /* Time of scattering */ - PROP_DT(dt); /* Point of scattering */ - l = v*dt; /* Penetration in sample */ + dt = rand01 () * (t1 - t0) + t0; /* Time of scattering */ + PROP_DT (dt); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ - qm = qmax; // adjust maximal q - if (qm > 2.0*v/K2V) qm = 2.0*v/K2V; // should not be totally wrong - q = sqrt(rand01())*qm; // otherwise normalization with isq is wrong + qm = qmax; // adjust maximal q + if (qm > 2.0 * v / K2V) + qm = 2.0 * v / K2V; // should not be totally wrong + q = sqrt (rand01 ()) * qm; // otherwise normalization with isq is wrong - q_v = q*K2V; /* scattering possible ??? */ - arg = q_v/(2.0*v); + q_v = q * K2V; /* scattering possible ??? */ + arg = q_v / (2.0 * v); - if(rand01()>transsim) - { + if (rand01 () > transsim) { // f = 3 * (sin(q*R) - q*R*cos(q*R))/(q*R*q*R*q*R); - fo = 3*(sin(q*Ro) - q*Ro*cos(q*Ro))/(q*Ro*q*Ro*q*Ro); - -if(RiTrace<=0) - fiTrace = 0; -else - fiTrace = 3*(sin(q*RiTrace) - q*RiTrace*cos(q*RiTrace))/(q*RiTrace*q*RiTrace*q*RiTrace); - - f= (Vo*fo-Vi*fiTrace)/(Vo-Vi); + fo = 3 * (sin (q * Ro) - q * Ro * cos (q * Ro)) / (q * Ro * q * Ro * q * Ro); - sq = f*f; // define this function in INITIALIZE and TRACE part + if (RiTrace <= 0) + fiTrace = 0; + else + fiTrace = 3 * (sin (q * RiTrace) - q * RiTrace * cos (q * RiTrace)) / (q * RiTrace * q * RiTrace * q * RiTrace); - p*= sq*(qmax*qmax*0.5)*(1.0-transmr)/(1.0-transsim)/isq; + f = (Vo * fo - Vi * fiTrace) / (Vo - Vi); - theta = asin(arg); /* Bragg scattering law */ - d_phi = 2*PI*rand01(); + sq = f * f; // define this function in INITIALIZE and TRACE part - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2*theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + p *= sq * (qmax * qmax * 0.5) * (1.0 - transmr) / (1.0 - transsim) / isq; - vx = vout_x; - vy = vout_y; - vz = vout_z; + theta = asin (arg); /* Bragg scattering law */ + d_phi = 2 * PI * rand01 (); - if(!box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick)) fprintf(stderr, "SANS_AnySamp: FATAL ERROR: Did not hit box from inside.\n"); - } - else - { - p*= transmr / transsim; + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 2 * theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, d_phi, vx, vy, vz); + + vx = vout_x; + vy = vout_y; + vz = vout_z; + + if (!box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick)) + fprintf (stderr, "SANS_AnySamp: FATAL ERROR: Did not hit box from inside.\n"); + } else { + p *= transmr / transsim; } - p *= exp(-my_a_v*(l_full)/v); + p *= exp (-my_a_v * (l_full) / v); SCATTER; } %} @@ -194,30 +192,21 @@ MCDISPLAY %{ double radius = 0; double h = 0; - magnify("xyz"); + magnify ("xyz"); { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zthick; - double zmax = 0.5*zthick; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zthick; + double zmax = 0.5 * zthick; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/SANS_benchmark2.comp b/mcstas-comps/contrib/SANS_benchmark2.comp index 92fbaf79b..1c7ea1440 100644 --- a/mcstas-comps/contrib/SANS_benchmark2.comp +++ b/mcstas-comps/contrib/SANS_benchmark2.comp @@ -74,760 +74,831 @@ SETTING PARAMETERS (xwidth=0.01, yheight=0.01, zthick=0.001, model=1.0, dsdw_inc SHARE %{ -#include -#include - -double sb_min(double A, double B) { -if (AB) return A; else return B; -}; - -int sb_imin(int A, int B) { -if (AB) return A; else return B; -}; - - -double gamma(double X) { + #include + #include + + double + sb_min (double A, double B) { + if (A < B) + return A; + else + return B; + }; -double A[10]; -A[0] = 8.333333333333333e-02; -A[1] = -2.777777777777778e-03; -A[2] = 7.936507936507937e-04; -A[3] = -5.952380952380952e-04; -A[4] = 8.417508417508418e-04; -A[5] = -1.917526917526918e-03; -A[6] = 6.410256410256410e-03; -A[7] = -2.955065359477124e-02; -A[8] = 1.796443723688307e-01; -A[9] = -1.392432216905900e+00; + double + sb_max (double A, double B) { + if (A > B) + return A; + else + return B; + }; -double X0=X; -double GL=0.0; -double N =0.0; + int + sb_imin (int A, int B) { + if (A < B) + return A; + else + return B; + }; -if (X!=1.0 && X!=2.0) { + int + sb_imax (int A, int B) { + if (A > B) + return A; + else + return B; + }; - if (X<=7.0) { - N = floor(7.0-X); - X0= X+N; - }; + double + gamma (double X) { + + double A[10]; + A[0] = 8.333333333333333e-02; + A[1] = -2.777777777777778e-03; + A[2] = 7.936507936507937e-04; + A[3] = -5.952380952380952e-04; + A[4] = 8.417508417508418e-04; + A[5] = -1.917526917526918e-03; + A[6] = 6.410256410256410e-03; + A[7] = -2.955065359477124e-02; + A[8] = 1.796443723688307e-01; + A[9] = -1.392432216905900e+00; + + double X0 = X; + double GL = 0.0; + double N = 0.0; + + if (X != 1.0 && X != 2.0) { + + if (X <= 7.0) { + N = floor (7.0 - X); + X0 = X + N; + }; - double X2 = 1.0/(X0*X0); - double XP = 6.283185307179586477; + double X2 = 1.0 / (X0 * X0); + double XP = 6.283185307179586477; - double GL0 = A[9]; - int K=8; + double GL0 = A[9]; + int K = 8; - for (K=8;K>=0;K--) {GL0=GL0*X2+A[K];}; + for (K = 8; K >= 0; K--) { + GL0 = GL0 * X2 + A[K]; + }; - GL = GL0/X0 + .5*log(XP) + (X0-.5)*log(X0) - X0; + GL = GL0 / X0 + .5 * log (XP) + (X0 - .5) * log (X0) - X0; - if (X<=7.0) { - for (K=1;K<=N;K++) { - GL -= log(X0-1.0); - X0 = X0-1.0; + if (X <= 7.0) { + for (K = 1; K <= N; K++) { + GL -= log (X0 - 1.0); + X0 = X0 - 1.0; + }; + }; }; - }; -}; - - GL = exp(GL); - return GL; -}; - - -double errf(double arg1) { /* precision approx. 1e-5, i.e. good enough for simulations */ - -double Pic = 3.141592653589793238462643; -double arg2,erf; -if (arg1<0.86) -{arg2=arg1*arg1; - erf = (2.0+(-2.0/3.0+(0.2+(-1.0/21.0+(1.0/108.0-1.0/660.0*arg2)*arg2)*arg2)*arg2)*arg2)*arg1/sqrt(Pic); } -else -{if (arg1<2.12) - {arg2=arg1-1.5; - erf = 0.9661051465+( .1189302893 - +(-.1783954339 - +( .1387520041 - +(-.04459885846 - +(-.01486628616 - +( .01932617201 - +(-.004743053202 - +(-.002362677620 - +( .001709819553 - +(-.00009291428874 - +(-.0002544483936 )*arg2)*arg2)*arg2)*arg2)*arg2)*arg2)*arg2)*arg2)*arg2)*arg2)*arg2; } - else - {arg2=arg1*arg1; - erf = 1.0+(-1.0+(0.5+(-0.75+(1.875+(-6.5625+29.53125/arg2)/arg2)/arg2)/arg2)/arg2)/(arg1*sqrt(Pic)*exp(arg2)); }; -}; + GL = exp (GL); + return GL; + }; -return erf; + double + errf (double arg1) { /* precision approx. 1e-5, i.e. good enough for simulations */ + + double Pic = 3.141592653589793238462643; + double arg2, erf; + + if (arg1 < 0.86) { + arg2 = arg1 * arg1; + erf = (2.0 + (-2.0 / 3.0 + (0.2 + (-1.0 / 21.0 + (1.0 / 108.0 - 1.0 / 660.0 * arg2) * arg2) * arg2) * arg2) * arg2) * arg1 / sqrt (Pic); + } else { + if (arg1 < 2.12) { + arg2 = arg1 - 1.5; + erf = 0.9661051465 + + (.1189302893 + + (-.1783954339 + + (.1387520041 + + (-.04459885846 + + (-.01486628616 + + (.01932617201 + + (-.004743053202 + (-.002362677620 + (.001709819553 + (-.00009291428874 + (-.0002544483936) * arg2) * arg2) * arg2) * arg2) + * arg2) + * arg2) + * arg2) + * arg2) + * arg2) + * arg2) + * arg2; + } else { + arg2 = arg1 * arg1; + erf = 1.0 + (-1.0 + (0.5 + (-0.75 + (1.875 + (-6.5625 + 29.53125 / arg2) / arg2) / arg2) / arg2) / arg2) / (arg1 * sqrt (Pic) * exp (arg2)); + }; + }; -}; + return erf; + }; + double + J1 (double arg0) { + + double Pic = 3.141592653589793238462643; + double J1o, cs, sn; + + if (arg0 < 6.11) { + arg0 = arg0 * arg0; + J1o = 1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 + * (1.0 + - arg0 * (1.0 - arg0 * (1.0 - arg0 * (1.0 - arg0 / 528.0) / 440.0) / 360.0) / 288.0) + / 224.0) + / 168.0) + / 120.0) + / 80.0) + / 48.0) + / 24.0) + / 8.0; + } else { + cs = cos (arg0 + 0.25 * Pic); + sn = sin (arg0 + 0.25 * Pic); + J1o = (-1.12837916709551 * cs + + (.423142187660818 * sn + + (-.132231933644006 * cs + + (-.115702941938505 * sn + + (.162707262101022 * cs + + (.313211479544468 * sn + + (-.763452981389644 * cs + (-2.24945967730876 * sn + (7.76766544820683 * cs + (30.7470090658187 * sn) / arg0) / arg0) / arg0) / arg0) + / arg0) + / arg0) + / arg0) + / arg0) + / arg0) + / (arg0 * sqrt (arg0 * .5)); + }; -double J1(double arg0) { - -double Pic = 3.141592653589793238462643; -double J1o,cs,sn; - -if (arg0<6.11) -{arg0=arg0*arg0; - J1o = 1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0*(1.0-arg0/528.0) - /440.0)/360.0)/288.0)/224.0)/168.0)/120.0)/80.0)/48.0)/24.0)/8.0; -} -else -{cs = cos(arg0+0.25*Pic); - sn = sin(arg0+0.25*Pic); - J1o= (-1.12837916709551*cs - +( .423142187660818*sn - +(-.132231933644006*cs - +(-.115702941938505*sn - +( .162707262101022*cs - +( .313211479544468*sn - +(-.763452981389644*cs - +(-2.24945967730876*sn - +( 7.76766544820683*cs - +( 30.7470090658187*sn) /arg0)/arg0)/arg0)/arg0)/arg0)/arg0)/arg0)/arg0)/arg0)/(arg0*sqrt(arg0*.5)); }; - -return J1o; - -}; - - -double dSigdW(int sw, double Q, double* Qtab, double* Itab) { - -int i; - -double drho = 6e10; -double Na = 6.0221413e23; -double Pi = 3.14159265358979323846264338328; - -double out; - -double Rg,Mw,rho,phi,fle,sig; -double G,P,gam,B,k,AAA,BBB,erf,QQ; - -double dd,xi; -double xim2,k0p2; - -double L,b,R2,Rg0,Lb,alpha; -double u,uu,Sdeb,Sdebp,W,Wp,Sexv,Sexvp,Ssb,Ssbp,C,a1,a2; -double q0,y; -double ar2; - -double R,qR; - -double qRg2; - -double f,debye1,debyef,debye1f; - -double R0,n,d; -double eps,VorF,Fv,qa,Sv; -double qhpt,qmod; - -double I0,Qpeak,dQpeak,Qpeak1,Qpeak2,npeaks,delta; - -int imi,ima,inew; - -switch(sw){ - -case 1: /* Polymer with Mw = 2.000g/mol */ -Rg = 18.0; /* radius of gyration in Angstroem */ -Mw = 2000.0; /* molecular weight in g/mol */ -rho = 1.00; /* density in g/cm^3 */ -phi = 0.005; /* concentration vol/vol */ -fle = 0.588; /* Flory exponent 0.6 or 0.588 or...*/ -sig = 1.5; /* cutoff (monomer size) Angstroem */ - -G = drho*drho*phi*(Mw/rho/Na); -P = 1.0/fle; -gam = gamma(P); -B = G*P/gam; -k = 1.06; -AAA = k*Rg*0.40824829; -erf = errf(Q*AAA); -QQ = erf*erf*erf/(Q*Rg); - -out = ( G * exp(-Q*Q*Rg*Rg/3.0) + B * pow(QQ,P) ) * exp(-sig*sig*Q*Q); -break; - - -case 2: /* Polymer with Mw = 1.000.000g/mol */ -Rg = 408.0; /* radius of gyration in Angstroem */ -Mw = 1e6; /* molecular weight in g/mol */ -rho = 1.00; /* density in g/cm^3 */ -phi = 0.0002; /* concentration vol/vol */ -fle = 0.588; /* Flory exponent 0.6 or 0.588 or...*/ -sig = 1.5; /* cutoff (monomer size) Angstroem */ - -G = drho*drho*phi*(Mw/rho/Na); -P = 1.0/fle; -gam = gamma(P); -B = G*P/gam; -k = 1.06; -AAA = k*Rg*0.40824829; -erf = errf(Q*AAA); -QQ = erf*erf*erf/(Q*Rg); - -out = ( G * exp(-Q*Q*Rg*Rg/3.0) + B * pow(QQ,P) ) * exp(-sig*sig*Q*Q); -break; - - -case 3: /* Microemulsion */ -dd = 230.0; /* domain spacing Angstroem */ -xi = 100.0; /* correlation length Angstroem */ -gam = 0.17; /* surfactant content vol/vol */ -sig = 1.5; /* roughness of surfactant film in AA*/ - -xim2 = 1.0/(xi*xi); -k0p2 = pow(2.0*Pi/dd,2); -AAA = drho*drho*8e-24*Pi*0.25/xi; -out = AAA/(pow(k0p2+xim2,2)-2.0*(k0p2-xim2)*Q*Q+Q*Q*Q*Q); - -Rg = dd*0.3; -G = AAA*2.001001001; -P = 4.0; -gam = 6.0; -B = G*P/gam; -k = 1.06; -AAA = k*Rg*0.40824829; -erf = errf(Q*AAA); -QQ = erf*erf*erf/Q; - -out = ( out + B * pow(QQ,P) ) * exp(-sig*sig*Q*Q); -break; - - -case 4: /* wormlike micelle */ -L = 20000.0; /* contour length in Angstroem */ -b = 300.0; /* Kuhn length in Angstroem */ -R2 = 10.0; /* cross section radius in AA */ -phi= 2e-4; /* concentration vol/vol */ - -Rg0 = sqrt(L*b/6.0); -Lb = L/b; -alpha= pow(1.0+pow(Lb/3.12,2)+pow(Lb/8.67,3),0.5*0.17/3.0); -Rg = Rg0*alpha; - -if (Lb>=4.0) { - if (Q*b<=3.1) { - u = Rg*Q; - uu = u*u; - Sdeb = 2.0*(exp(-uu)+uu-1.0)/(uu*uu); - W = (1.0-tanh((u-1.523)/0.1477))*0.5; - Sexv = W*Sdeb + (1.0-W)*(1.22*pow(u,-5.0/3.0)+0.4288*pow(u,-10.0/3.0)-1.651*pow(u,-15.0/3.0)); - if (Lb>=10.0) {C = 3.06/pow(Lb,0.44);} else {C = 1.0;}; - Ssb = Sexv+C/Lb*(4.0/15.0+7.0/(15.0*uu)-(11.0/15.0+7.0/(15.0*uu))*exp(-uu)); - y = Ssb; - } - else { - QQ = 3.1/b; - u = Rg*QQ; - uu = u*u; - Sdeb = 2.0*(exp(-uu)+uu-1.0)/(uu*uu); - Sdebp= (2.0*(-exp(-uu)+1.0)/(uu*uu)-2.0/uu*Sdeb)*2.0*u*Rg; - W = (1.0-tanh((u-1.523)/0.1477))*0.5; - Wp = Rg*0.5/0.1477/cosh((u-1.523)/0.1477); - Sexv = W*Sdeb + (1.0-W)*(1.22*pow(u,-5.0/3.0)+0.4288*pow(u,-10.0/3.0)-1.651*pow(u,-15.0/3.0)); - Sexvp= Wp * (Sdeb - (1.22*pow(u,-5.0/3.0)+0.4288*pow(u,-10.0/3.0)-1.651*pow(u,(-15.0/3.0)))) - + W * Sdebp + (1.0-W) * (- 5.0/3.0*1.22 * pow(u, -8.0/3.0) - -10.0/3.0*0.4288* pow(u,-13.0/3.0) - +15.0/3.0*1.651 * pow(u,-18.0/3.0))*Rg; - if (Lb>=10.0) {C = 3.06/pow(Lb,0.44);} else {C = 1.0;}; - Ssb = Sexv+ C/Lb*(4.0/15.0+7.0/(15.0*uu)-(11.0/15.0+7.0/(15.0*uu))*exp(-uu)); - Ssbp = Sexvp+C/Lb*(-7.0/(15.0*uu*uu) +(11.0/15.0+7.0/(15.0*uu)+7.0/(15.0*uu*uu))*exp(-uu))*2.0*u*Rg; - a2 = (Ssb+Ssbp*QQ/4.12-Pi/(QQ*L)*(1.0-1.0/4.12))*4.12*pow(QQ*b,4.42)/(4.12-4.42); - a1 = (Ssb*pow(QQ,4.12)-a2*pow(QQ,4.12-4.42)*pow(b,-4.42) - Pi/L*pow(QQ,4.12-1.0)) * pow(b,4.12); - y = a1/pow(Q*b,4.12)+a2/pow(Q*b,4.42)+Pi/(Q*L); - }; -} -else { - if (1.9*b/Rg>=3.0) {q0=1.9*b/Rg;} else {q0=3.0;}; - if (Q*b<=q0) { - u = Rg*Q; - uu = u*u; - Sdeb = 2.0*(exp(-uu)+uu-1.0)/(uu*uu); - y = Sdeb; - } - else { - QQ = q0/b; - u = Rg*QQ; - uu = u*u; - Sdeb = 2.0*(exp(-uu)+uu-1.0)/(uu*uu); - Sdebp= (2.0*(-exp(-uu)+1.0)/(uu*uu)-2.0/uu*Sdeb)*2.0*u*Rg; - a2 = (Sdeb+Sdebp*QQ/4.12-Pi/(QQ*L)*(1.0-1.0/4.12))*4.12*pow(QQ*b,4.12)/(4.12-4.42); - a1 = (Sdeb*pow(QQ,4.12)-a2*pow(QQ,4.12-4.42)*pow(b,-4.42) - Pi/L*pow(QQ,4.12-1.0)) * pow(b,4.12); - y = a1/pow(Q*b,4.12)+a2/pow(Q*b,4.42)+Pi/(Q*L); - }; -}; - -ar2= Q*R2; -G = drho*drho*Pi*R2*R2*L*1e-24*phi; -out = G * pow(J1(ar2),2) * y; -break; - - -case 5: /* sphere, small */ -R = 25.0; /* radius Angstroem */ -phi = 0.001; /* concentration vol/vol */ - -qR = Q*R; -G = (drho*drho*phi*4e-24*Pi*R*R*R/3.0); - -out = 3.0*(sin(qR)-qR*cos(qR))/(qR*qR*qR); -out *= G * out; -break; - - -case 15: /* sphere, medium */ -R = 150.0; /* radius Angstroem */ -phi = 0.001; /* concentration vol/vol */ - -qR = Q*R; -G = (drho*drho*phi*4e-24*Pi*R*R*R/3.0); - -out = 3.0*(sin(qR)-qR*cos(qR))/(qR*qR*qR); -out *= G * out; -break; - - - - -case 6: /* sphere, large */ -R = 500.0; /* radius Angstroem */ -phi = 0.001; /* concentration vol/vol */ - -qR = Q*R; -G = (drho*drho*phi*4e-24*Pi*R*R*R/3.0); - -out = 3.0*(sin(qR)-qR*cos(qR))/(qR*qR*qR); -out *= G * out; -break; - - -case 7: /* polymer blend */ -Rg = 22.0; /* radius of gyration Angstroem */ -Mw = 2000.0; /* molar mass g/mol */ -rho = 1.00; /* density g/cm^3 */ -gam = 7.8e-4; /* Flory Huggins parameter (mol/cm^3)*/ -sig = 1.5; /* cutoff (monomer size) Angstroem */ - -qRg2 = pow(Q*Rg,2); - -out = (Mw/rho)*0.5*2.0*(exp(-qRg2)-1.0+qRg2)/(qRg2*qRg2); -out = 0.5*drho*drho/(1.0/out-gam)/Na * exp(-sig*sig*Q*Q); -break; - - -case 8: /* diblock copolymer */ -Rg = 105.0; /* radius of gyration Angstroem */ -Mw = 83400.0; /* molar mass g/mol */ -rho = 1.00; /* density g/cm^3 */ -f = 0.65; /* chainlength ratio */ -gam = 1.42e-4; /* Flory Huggins parameter (mol/cm^3)*/ -sig = 1.5; /* cutoff (monomer size) Angstroem */ - -qRg2 = pow(Q*Rg,2); - -debye1 = 2.0*(exp(-qRg2) -1.0+qRg2 )/(qRg2*qRg2); -debyef = 2.0*(exp(-qRg2*f) -1.0+qRg2*f )/(qRg2*qRg2); -debye1f= 2.0*(exp(-qRg2*(1.0-f))-1.0+qRg2*(1.0-f))/(qRg2*qRg2); - -out = debye1 / (debyef*debye1f-0.25*pow(debye1-debyef-debye1f,2)) / (Mw/rho); -out = drho*drho/(out-2.0*gam)/Na * exp(-sig*sig*Q*Q); -break; - - -case 9: /* multilamellar vesicles */ -R0 = 70.0; /* distance of lamellae Angstroem */ -n = 14.0; /* number of concentric shells */ -phi = 0.0002; /* concentration vol/vol */ -d = 10.0; /* tickness of single lamellae */ - -eps = 1e-6; -VorF = drho*drho * phi * 4e-24*Pi*R0*R0*d * 6.0/(((2.0*n+3.0)*n+1.0)*n); -Fv = sin(0.5*Q*d)/(0.5*Q*d); -qa = fabs(Q*R0); + return J1o; + }; -qhpt= Pi*floor(qa/Pi+0.5); -qmod= qa - qhpt; + double + dSigdW (int sw, double Q, double* Qtab, double* Itab) { + + int i; + + double drho = 6e10; + double Na = 6.0221413e23; + double Pi = 3.14159265358979323846264338328; + + double out; + + double Rg, Mw, rho, phi, fle, sig; + double G, P, gam, B, k, AAA, BBB, erf, QQ; + + double dd, xi; + double xim2, k0p2; + + double L, b, R2, Rg0, Lb, alpha; + double u, uu, Sdeb, Sdebp, W, Wp, Sexv, Sexvp, Ssb, Ssbp, C, a1, a2; + double q0, y; + double ar2; + + double R, qR; + + double qRg2; + + double f, debye1, debyef, debye1f; + + double R0, n, d; + double eps, VorF, Fv, qa, Sv; + double qhpt, qmod; + + double I0, Qpeak, dQpeak, Qpeak1, Qpeak2, npeaks, delta; + + int imi, ima, inew; + + switch (sw) { + + case 1: /* Polymer with Mw = 2.000g/mol */ + Rg = 18.0; /* radius of gyration in Angstroem */ + Mw = 2000.0; /* molecular weight in g/mol */ + rho = 1.00; /* density in g/cm^3 */ + phi = 0.005; /* concentration vol/vol */ + fle = 0.588; /* Flory exponent 0.6 or 0.588 or...*/ + sig = 1.5; /* cutoff (monomer size) Angstroem */ + + G = drho * drho * phi * (Mw / rho / Na); + P = 1.0 / fle; + gam = gamma (P); + B = G * P / gam; + k = 1.06; + AAA = k * Rg * 0.40824829; + erf = errf (Q * AAA); + QQ = erf * erf * erf / (Q * Rg); + + out = (G * exp (-Q * Q * Rg * Rg / 3.0) + B * pow (QQ, P)) * exp (-sig * sig * Q * Q); + break; + + case 2: /* Polymer with Mw = 1.000.000g/mol */ + Rg = 408.0; /* radius of gyration in Angstroem */ + Mw = 1e6; /* molecular weight in g/mol */ + rho = 1.00; /* density in g/cm^3 */ + phi = 0.0002; /* concentration vol/vol */ + fle = 0.588; /* Flory exponent 0.6 or 0.588 or...*/ + sig = 1.5; /* cutoff (monomer size) Angstroem */ + + G = drho * drho * phi * (Mw / rho / Na); + P = 1.0 / fle; + gam = gamma (P); + B = G * P / gam; + k = 1.06; + AAA = k * Rg * 0.40824829; + erf = errf (Q * AAA); + QQ = erf * erf * erf / (Q * Rg); + + out = (G * exp (-Q * Q * Rg * Rg / 3.0) + B * pow (QQ, P)) * exp (-sig * sig * Q * Q); + break; + + case 3: /* Microemulsion */ + dd = 230.0; /* domain spacing Angstroem */ + xi = 100.0; /* correlation length Angstroem */ + gam = 0.17; /* surfactant content vol/vol */ + sig = 1.5; /* roughness of surfactant film in AA*/ + + xim2 = 1.0 / (xi * xi); + k0p2 = pow (2.0 * Pi / dd, 2); + AAA = drho * drho * 8e-24 * Pi * 0.25 / xi; + out = AAA / (pow (k0p2 + xim2, 2) - 2.0 * (k0p2 - xim2) * Q * Q + Q * Q * Q * Q); + + Rg = dd * 0.3; + G = AAA * 2.001001001; + P = 4.0; + gam = 6.0; + B = G * P / gam; + k = 1.06; + AAA = k * Rg * 0.40824829; + erf = errf (Q * AAA); + QQ = erf * erf * erf / Q; + + out = (out + B * pow (QQ, P)) * exp (-sig * sig * Q * Q); + break; + + case 4: /* wormlike micelle */ + L = 20000.0; /* contour length in Angstroem */ + b = 300.0; /* Kuhn length in Angstroem */ + R2 = 10.0; /* cross section radius in AA */ + phi = 2e-4; /* concentration vol/vol */ + + Rg0 = sqrt (L * b / 6.0); + Lb = L / b; + alpha = pow (1.0 + pow (Lb / 3.12, 2) + pow (Lb / 8.67, 3), 0.5 * 0.17 / 3.0); + Rg = Rg0 * alpha; + + if (Lb >= 4.0) { + if (Q * b <= 3.1) { + u = Rg * Q; + uu = u * u; + Sdeb = 2.0 * (exp (-uu) + uu - 1.0) / (uu * uu); + W = (1.0 - tanh ((u - 1.523) / 0.1477)) * 0.5; + Sexv = W * Sdeb + (1.0 - W) * (1.22 * pow (u, -5.0 / 3.0) + 0.4288 * pow (u, -10.0 / 3.0) - 1.651 * pow (u, -15.0 / 3.0)); + if (Lb >= 10.0) { + C = 3.06 / pow (Lb, 0.44); + } else { + C = 1.0; + }; + Ssb = Sexv + C / Lb * (4.0 / 15.0 + 7.0 / (15.0 * uu) - (11.0 / 15.0 + 7.0 / (15.0 * uu)) * exp (-uu)); + y = Ssb; + } else { + QQ = 3.1 / b; + u = Rg * QQ; + uu = u * u; + Sdeb = 2.0 * (exp (-uu) + uu - 1.0) / (uu * uu); + Sdebp = (2.0 * (-exp (-uu) + 1.0) / (uu * uu) - 2.0 / uu * Sdeb) * 2.0 * u * Rg; + W = (1.0 - tanh ((u - 1.523) / 0.1477)) * 0.5; + Wp = Rg * 0.5 / 0.1477 / cosh ((u - 1.523) / 0.1477); + Sexv = W * Sdeb + (1.0 - W) * (1.22 * pow (u, -5.0 / 3.0) + 0.4288 * pow (u, -10.0 / 3.0) - 1.651 * pow (u, -15.0 / 3.0)); + Sexvp = Wp * (Sdeb - (1.22 * pow (u, -5.0 / 3.0) + 0.4288 * pow (u, -10.0 / 3.0) - 1.651 * pow (u, (-15.0 / 3.0)))) + W * Sdebp + + (1.0 - W) * (-5.0 / 3.0 * 1.22 * pow (u, -8.0 / 3.0) - 10.0 / 3.0 * 0.4288 * pow (u, -13.0 / 3.0) + 15.0 / 3.0 * 1.651 * pow (u, -18.0 / 3.0)) + * Rg; + if (Lb >= 10.0) { + C = 3.06 / pow (Lb, 0.44); + } else { + C = 1.0; + }; + Ssb = Sexv + C / Lb * (4.0 / 15.0 + 7.0 / (15.0 * uu) - (11.0 / 15.0 + 7.0 / (15.0 * uu)) * exp (-uu)); + Ssbp = Sexvp + C / Lb * (-7.0 / (15.0 * uu * uu) + (11.0 / 15.0 + 7.0 / (15.0 * uu) + 7.0 / (15.0 * uu * uu)) * exp (-uu)) * 2.0 * u * Rg; + a2 = (Ssb + Ssbp * QQ / 4.12 - Pi / (QQ * L) * (1.0 - 1.0 / 4.12)) * 4.12 * pow (QQ * b, 4.42) / (4.12 - 4.42); + a1 = (Ssb * pow (QQ, 4.12) - a2 * pow (QQ, 4.12 - 4.42) * pow (b, -4.42) - Pi / L * pow (QQ, 4.12 - 1.0)) * pow (b, 4.12); + y = a1 / pow (Q * b, 4.12) + a2 / pow (Q * b, 4.42) + Pi / (Q * L); + }; + } else { + if (1.9 * b / Rg >= 3.0) { + q0 = 1.9 * b / Rg; + } else { + q0 = 3.0; + }; + if (Q * b <= q0) { + u = Rg * Q; + uu = u * u; + Sdeb = 2.0 * (exp (-uu) + uu - 1.0) / (uu * uu); + y = Sdeb; + } else { + QQ = q0 / b; + u = Rg * QQ; + uu = u * u; + Sdeb = 2.0 * (exp (-uu) + uu - 1.0) / (uu * uu); + Sdebp = (2.0 * (-exp (-uu) + 1.0) / (uu * uu) - 2.0 / uu * Sdeb) * 2.0 * u * Rg; + a2 = (Sdeb + Sdebp * QQ / 4.12 - Pi / (QQ * L) * (1.0 - 1.0 / 4.12)) * 4.12 * pow (QQ * b, 4.12) / (4.12 - 4.42); + a1 = (Sdeb * pow (QQ, 4.12) - a2 * pow (QQ, 4.12 - 4.42) * pow (b, -4.42) - Pi / L * pow (QQ, 4.12 - 1.0)) * pow (b, 4.12); + y = a1 / pow (Q * b, 4.12) + a2 / pow (Q * b, 4.42) + Pi / (Q * L); + }; + }; -if (fabs(qmod)<=eps) { - if (qmod<0.0) {qmod = -eps;} else {qmod = eps;}; - qa = qhpt + qmod; -}; + ar2 = Q * R2; + G = drho * drho * Pi * R2 * R2 * L * 1e-24 * phi; + out = G * pow (J1 (ar2), 2) * y; + break; + + case 5: /* sphere, small */ + R = 25.0; /* radius Angstroem */ + phi = 0.001; /* concentration vol/vol */ + + qR = Q * R; + G = (drho * drho * phi * 4e-24 * Pi * R * R * R / 3.0); + + out = 3.0 * (sin (qR) - qR * cos (qR)) / (qR * qR * qR); + out *= G * out; + break; + + case 15: /* sphere, medium */ + R = 150.0; /* radius Angstroem */ + phi = 0.001; /* concentration vol/vol */ + + qR = Q * R; + G = (drho * drho * phi * 4e-24 * Pi * R * R * R / 3.0); + + out = 3.0 * (sin (qR) - qR * cos (qR)) / (qR * qR * qR); + out *= G * out; + break; + + case 6: /* sphere, large */ + R = 500.0; /* radius Angstroem */ + phi = 0.001; /* concentration vol/vol */ + + qR = Q * R; + G = (drho * drho * phi * 4e-24 * Pi * R * R * R / 3.0); + + out = 3.0 * (sin (qR) - qR * cos (qR)) / (qR * qR * qR); + out *= G * out; + break; + + case 7: /* polymer blend */ + Rg = 22.0; /* radius of gyration Angstroem */ + Mw = 2000.0; /* molar mass g/mol */ + rho = 1.00; /* density g/cm^3 */ + gam = 7.8e-4; /* Flory Huggins parameter (mol/cm^3)*/ + sig = 1.5; /* cutoff (monomer size) Angstroem */ + + qRg2 = pow (Q * Rg, 2); + + out = (Mw / rho) * 0.5 * 2.0 * (exp (-qRg2) - 1.0 + qRg2) / (qRg2 * qRg2); + out = 0.5 * drho * drho / (1.0 / out - gam) / Na * exp (-sig * sig * Q * Q); + break; + + case 8: /* diblock copolymer */ + Rg = 105.0; /* radius of gyration Angstroem */ + Mw = 83400.0; /* molar mass g/mol */ + rho = 1.00; /* density g/cm^3 */ + f = 0.65; /* chainlength ratio */ + gam = 1.42e-4; /* Flory Huggins parameter (mol/cm^3)*/ + sig = 1.5; /* cutoff (monomer size) Angstroem */ + + qRg2 = pow (Q * Rg, 2); + + debye1 = 2.0 * (exp (-qRg2) - 1.0 + qRg2) / (qRg2 * qRg2); + debyef = 2.0 * (exp (-qRg2 * f) - 1.0 + qRg2 * f) / (qRg2 * qRg2); + debye1f = 2.0 * (exp (-qRg2 * (1.0 - f)) - 1.0 + qRg2 * (1.0 - f)) / (qRg2 * qRg2); + + out = debye1 / (debyef * debye1f - 0.25 * pow (debye1 - debyef - debye1f, 2)) / (Mw / rho); + out = drho * drho / (out - 2.0 * gam) / Na * exp (-sig * sig * Q * Q); + break; + + case 9: /* multilamellar vesicles */ + R0 = 70.0; /* distance of lamellae Angstroem */ + n = 14.0; /* number of concentric shells */ + phi = 0.0002; /* concentration vol/vol */ + d = 10.0; /* tickness of single lamellae */ + + eps = 1e-6; + VorF = drho * drho * phi * 4e-24 * Pi * R0 * R0 * d * 6.0 / (((2.0 * n + 3.0) * n + 1.0) * n); + Fv = sin (0.5 * Q * d) / (0.5 * Q * d); + qa = fabs (Q * R0); + + qhpt = Pi * floor (qa / Pi + 0.5); + qmod = qa - qhpt; + + if (fabs (qmod) <= eps) { + if (qmod < 0.0) { + qmod = -eps; + } else { + qmod = eps; + }; + qa = qhpt + qmod; + }; -Sv = (-.50*cos(qa*(n+.5))*(n+.5) + .25*sin(qa*(n+.5))/tan(.5*qa)) / (qa*sin(.5*qa)); + Sv = (-.50 * cos (qa * (n + .5)) * (n + .5) + .25 * sin (qa * (n + .5)) / tan (.5 * qa)) / (qa * sin (.5 * qa)); -out = VorF * Fv*Fv * Sv*Sv; -break; + out = VorF * Fv * Fv * Sv * Sv; + break; -case 10: /* series of peaks */ -case 11: /* series of peaks (dummy) */ -Qpeak1 = 0.0001; /* Peak location */ -Qpeak2 = 2.154434690031883; -npeaks = 13.00; -I0 = 0.0001; /* Peak height */ + case 10: /* series of peaks */ + case 11: /* series of peaks (dummy) */ + Qpeak1 = 0.0001; /* Peak location */ + Qpeak2 = 2.154434690031883; + npeaks = 13.00; + I0 = 0.0001; /* Peak height */ -delta = (log10(Qpeak2) - log10(Qpeak1))/npeaks; + delta = (log10 (Qpeak2) - log10 (Qpeak1)) / npeaks; -out = 0.0; + out = 0.0; -for (i = 0; i <= npeaks; i++){ - Qpeak = Qpeak1*pow(10.0,i*delta); - dQpeak = Qpeak*0.1; /* Peak width */ - out += I0/(PI*Qpeak*dQpeak)*exp(-pow((Q-Qpeak)/dQpeak,2)); - }; -break; + for (i = 0; i <= npeaks; i++) { + Qpeak = Qpeak1 * pow (10.0, i * delta); + dQpeak = Qpeak * 0.1; /* Peak width */ + out += I0 / (PI * Qpeak * dQpeak) * exp (-pow ((Q - Qpeak) / dQpeak, 2)); + }; + break; + + case 12: + case 13: + phi = 1.0; // vol percent already + i = (sw - 12) * 256; + imi = 0; + ima = 255; + if (Q <= Qtab[i + imi]) { + out = Itab[i + imi]; + break; + }; + if (Q >= Qtab[i + ima]) { + out = Itab[i + ima]; + break; + }; + while (ima - imi > 1) { + inew = (imi + ima) / 2; + if (Qtab[i + inew] >= Q) + ima = inew; + else + imi = inew; + }; + out = phi * ((Q - Qtab[i + imi]) * Itab[i + ima] + (Qtab[i + ima] - Q) * Itab[i + imi]) / (Qtab[i + ima] - Qtab[i + imi]); + /* fprintf(stdout,"%12.4e %12.4e\n",Q,out); */ + break; -case 12: -case 13: -phi = 1.0; // vol percent already -i = (sw-12)*256; -imi = 0; -ima = 255; -if (Q<=Qtab[i+imi]) { out = Itab[i+imi]; break; }; -if (Q>=Qtab[i+ima]) { out = Itab[i+ima]; break; }; -while (ima-imi>1) { - inew = (imi+ima)/2; - if (Qtab[i+inew]>=Q) ima = inew; else imi = inew; -}; -out = phi*((Q-Qtab[i+imi])*Itab[i+ima]+(Qtab[i+ima]-Q)*Itab[i+imi])/(Qtab[i+ima]-Qtab[i+imi]); -/* fprintf(stdout,"%12.4e %12.4e\n",Q,out); */ -break; - -default: -out = 0.0000; -}; - -return out; -}; + default: + out = 0.0000; + }; + return out; + }; %} DECLARE %{ DArray2d Idsdw; - double Qmind; /* AA-1 somehow SANS limit -- the total range should be reasonably large, so Qmind close enough to ZERO */ - double Qmaxd; /* AA-1 approx. model Q-limit, where coh. scatt. becomes zero -- practical limit -- 1.0 for most SANS problems */ + double Qmind; /* AA-1 somehow SANS limit -- the total range should be reasonably large, so Qmind close enough to ZERO */ + double Qmaxd; /* AA-1 approx. model Q-limit, where coh. scatt. becomes zero -- practical limit -- 1.0 for most SANS problems */ - double Qminl; /* logarithms of Qmind, Qmaxd and constant ln(10) */ + double Qminl; /* logarithms of Qmind, Qmaxd and constant ln(10) */ double Qmaxl; double l10; - + double Qtab[512]; double Itab[512]; %} INITIALIZE %{ - Idsdw=create_darr2d(31,19); + Idsdw = create_darr2d (31, 19); Qmind = 0.0001; Qmaxd = 2.1544346900319; - - if (!xwidth || !yheight || !zthick) - { - exit(fprintf(stderr,"SANS_DebyeS: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + if (!xwidth || !yheight || !zthick) { + exit (fprintf (stderr, "SANS_DebyeS: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); } - int iii,jjj,kkk; + int iii, jjj, kkk; - FILE *f1,*f2; - char o1,o2; + FILE *f1, *f2; + char o1, o2; char line1[80]; - double d1,d2,d3; - - f1 = fopen("Apoferritin.txt", "r"); - f2 = fopen("humanserumalbumin.txt", "r"); - o1 = (f1!=NULL); - o2 = (f2!=NULL); - - if (o1) o1=(fgets(line1,80,f1)!=NULL); - if (o2) o2=(fgets(line1,80,f2)!=NULL); - - if (o1) o1=!feof(f1); - if (o2) o2=!feof(f2); - - for (iii=0;iii<256;iii++) { - - if (o1) {o1 = (fscanf(f1,"%lf %lf %lf %lf %lf",&Qtab[iii], &Itab[iii], &d1,&d2,&d3)!=0); Itab[iii] *= 0.01/752.2e3; if (o1) o1=!feof(f1); }; - if (!o1) {Qtab[iii] = 1.0; - Itab[iii] = 0.0; }; + double d1, d2, d3; + + f1 = fopen ("Apoferritin.txt", "r"); + f2 = fopen ("humanserumalbumin.txt", "r"); + o1 = (f1 != NULL); + o2 = (f2 != NULL); + + if (o1) + o1 = (fgets (line1, 80, f1) != NULL); + if (o2) + o2 = (fgets (line1, 80, f2) != NULL); + + if (o1) + o1 = !feof (f1); + if (o2) + o2 = !feof (f2); + + for (iii = 0; iii < 256; iii++) { + + if (o1) { + o1 = (fscanf (f1, "%lf %lf %lf %lf %lf", &Qtab[iii], &Itab[iii], &d1, &d2, &d3) != 0); + Itab[iii] *= 0.01 / 752.2e3; + if (o1) + o1 = !feof (f1); + }; + if (!o1) { + Qtab[iii] = 1.0; + Itab[iii] = 0.0; + }; - if (o2) {o2 = (fscanf(f2,"%lf %lf %lf %lf %lf",&Qtab[256+iii],&Itab[256+iii],&d1,&d2,&d3)!=0); Itab[256+iii]*= 0.01/110.3e3; if (o2) o2=!feof(f2); }; - if (!o2) {Qtab[256+iii] = 1.0; - Itab[256+iii] = 0.0; }; -/* - fprintf(stdout,"%12.4e %12.4e\n",Qtab[iii],Itab[iii]); - fprintf(stdout,"%12.4e %12.4e\n",Qtab[256+iii],Itab[256+iii]); -*/ + if (o2) { + o2 = (fscanf (f2, "%lf %lf %lf %lf %lf", &Qtab[256 + iii], &Itab[256 + iii], &d1, &d2, &d3) != 0); + Itab[256 + iii] *= 0.01 / 110.3e3; + if (o2) + o2 = !feof (f2); + }; + if (!o2) { + Qtab[256 + iii] = 1.0; + Itab[256 + iii] = 0.0; + }; + /* + fprintf(stdout,"%12.4e %12.4e\n",Qtab[iii],Itab[iii]); + fprintf(stdout,"%12.4e %12.4e\n",Qtab[256+iii],Itab[256+iii]); + */ }; - if(o1) fclose(f1); - if(o2) fclose(f2); - - Qminl = log10(Qmind); - Qmaxl = log10(Qmaxd); - l10 = log(10.00); - - double q,Isq; - double qmin,qmax,step; - int istp; - - istp = floor((Qmaxl-Qminl)*300.0+0.5); - - for (jjj=0;jjj<19;jjj++) {Idsdw[0][jjj]=0.0;}; /* wavelength 0 in AA */ - - for (iii=1;iii<=30;iii++) { /* wavelength in AA, up to 30 */ - for (jjj=0;jjj<19;jjj++) { - Idsdw[iii][jjj] = 0.0; - Isq = 0.0; - qmin = 0.0; - step = (log10(sb_min(Qmaxd,4.0*PI/iii))-Qminl)/istp; - for (kkk=0;kkk<=istp;kkk++) { - qmax = pow(10.0,Qminl+kkk*step); - q = 0.5*(qmin+qmax); - Isq += dSigdW(jjj,q,Qtab,Itab)*q*(qmax-qmin); - qmin = qmax; + if (o1) + fclose (f1); + if (o2) + fclose (f2); + + Qminl = log10 (Qmind); + Qmaxl = log10 (Qmaxd); + l10 = log (10.00); + + double q, Isq; + double qmin, qmax, step; + int istp; + + istp = floor ((Qmaxl - Qminl) * 300.0 + 0.5); + + for (jjj = 0; jjj < 19; jjj++) { + Idsdw[0][jjj] = 0.0; + }; /* wavelength 0 in AA */ + + for (iii = 1; iii <= 30; iii++) { /* wavelength in AA, up to 30 */ + for (jjj = 0; jjj < 19; jjj++) { + Idsdw[iii][jjj] = 0.0; + Isq = 0.0; + qmin = 0.0; + step = (log10 (sb_min (Qmaxd, 4.0 * PI / iii)) - Qminl) / istp; + for (kkk = 0; kkk <= istp; kkk++) { + qmax = pow (10.0, Qminl + kkk * step); + q = 0.5 * (qmin + qmax); + Isq += dSigdW (jjj, q, Qtab, Itab) * q * (qmax - qmin); + qmin = qmax; + }; + Idsdw[iii][jjj] = Isq; }; - Idsdw[iii][jjj] = Isq; - }; }; %} TRACE %{ - double sc_a = sb_max(0.01,sb_min(0.99,sc_aim)); - double sans_a = sb_max(0.01,sb_min(0.99,sans_aim)); + double sc_a = sb_max (0.01, sb_min (0.99, sc_aim)); + double sans_a = sb_max (0.01, sb_min (0.99, sans_aim)); - int modl,sngsp; - double v,k0,lambda; - int Ilam,Ilam2; + int modl, sngsp; + double v, k0, lambda; + int Ilam, Ilam2; double Scoh; - double qmax,qmaxl,Ymax,Xmax,thmax; - double Sinc1,Sinc2,S1,Stot; - double NNN,I0,icut; + double qmax, qmaxl, Ymax, Xmax, thmax; + double Sinc1, Sinc2, S1, Stot; + double NNN, I0, icut; - double rcut,fcut; + double rcut, fcut; double Q, Xsc, theta, phi; - int iscatt; + int iscatt; - char intersect; + char intersect; double t0, t1, dt; double axis_x, axis_y, axis_z; double tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; iscatt = 0; - modl = sb_imax(0,sb_imin(18,floor(model+0.5))); - sngsp = floor(singlesp+0.5); + modl = sb_imax (0, sb_imin (18, floor (model + 0.5))); + sngsp = floor (singlesp + 0.5); - v = sqrt(vx*vx + vy*vy + vz*vz); - k0 = v / K2V; - lambda = 2.0*PI / k0; + v = sqrt (vx * vx + vy * vy + vz * vz); + k0 = v / K2V; + lambda = 2.0 * PI / k0; - if (modl!=11) { + if (modl != 11) { - Ilam = sb_imax(floor(lambda),1); - Ilam2 = sb_imin(Ilam+1,30); - if (lambda<=1.0) Scoh = 200.0*PI*Idsdw[1][modl] / (k0*k0); - else - {if (lambda>=30.0) Scoh = 200.0*PI*Idsdw[30][modl] / (k0*k0); - else Scoh = 200.0*PI*((Ilam2-lambda)*Idsdw[Ilam][modl]+(lambda-Ilam)*Idsdw[Ilam2][modl]) / (k0*k0); - }; + Ilam = sb_imax (floor (lambda), 1); + Ilam2 = sb_imin (Ilam + 1, 30); + if (lambda <= 1.0) + Scoh = 200.0 * PI * Idsdw[1][modl] / (k0 * k0); + else { + if (lambda >= 30.0) + Scoh = 200.0 * PI * Idsdw[30][modl] / (k0 * k0); + else + Scoh = 200.0 * PI * ((Ilam2 - lambda) * Idsdw[Ilam][modl] + (lambda - Ilam) * Idsdw[Ilam2][modl]) / (k0 * k0); + }; - qmax = sb_min(Qmaxd,2.0*k0); - qmaxl = log10(qmax); - Ymax = 0.25*qmax*qmax/(k0*k0); - if (Ymax>=0.9999) Ymax=1.0; /* if rounding errors occurr, this will help to avoid problems */ - Xmax = 1.0 - 2.0*Ymax; - thmax = acos(Xmax); - - Sinc1 = 100.0*PI*( qmax*qmax/(k0*k0)) * fabs(dsdw_inc); - Sinc2 = 100.0*PI*(4.0-qmax*qmax/(k0*k0)) * fabs(dsdw_inc); - S1 = Sinc1 + Scoh; - Stot = Sinc2 + S1; - } - else { - - qmax = sb_min(Qmaxd,2.0*k0); - Ymax = 0.25*qmax*qmax/(k0*k0); - if (Ymax>=0.9999) Ymax=1.0; /* if rounding errors occurr, this will help to avoid problems */ - Xmax = 1.0 - 2.0*Ymax; - thmax = acos(Xmax); - I0 = 0.0001; - icut = 0.85; - - NNN = floor(3.0*log10(qmax)+1e-10); - if (pow(10.0,NNN/3.0)>2.0*k0) NNN--; - qmaxl = NNN/3.0; - qmax = pow(10.0,qmaxl); - - NNN += -Qminl*3.0 + 1.0; - Scoh = 200.0*PI*I0*NNN/(sqrt(PI)*k0*k0); - Sinc2 = 400.0*PI*fabs(dsdw_inc); - Stot = Sinc2 + Scoh; + qmax = sb_min (Qmaxd, 2.0 * k0); + qmaxl = log10 (qmax); + Ymax = 0.25 * qmax * qmax / (k0 * k0); + if (Ymax >= 0.9999) + Ymax = 1.0; /* if rounding errors occurr, this will help to avoid problems */ + Xmax = 1.0 - 2.0 * Ymax; + thmax = acos (Xmax); + + Sinc1 = 100.0 * PI * (qmax * qmax / (k0 * k0)) * fabs (dsdw_inc); + Sinc2 = 100.0 * PI * (4.0 - qmax * qmax / (k0 * k0)) * fabs (dsdw_inc); + S1 = Sinc1 + Scoh; + Stot = Sinc2 + S1; + } else { + + qmax = sb_min (Qmaxd, 2.0 * k0); + Ymax = 0.25 * qmax * qmax / (k0 * k0); + if (Ymax >= 0.9999) + Ymax = 1.0; /* if rounding errors occurr, this will help to avoid problems */ + Xmax = 1.0 - 2.0 * Ymax; + thmax = acos (Xmax); + I0 = 0.0001; + icut = 0.85; + + NNN = floor (3.0 * log10 (qmax) + 1e-10); + if (pow (10.0, NNN / 3.0) > 2.0 * k0) + NNN--; + qmaxl = NNN / 3.0; + qmax = pow (10.0, qmaxl); + + NNN += -Qminl * 3.0 + 1.0; + Scoh = 200.0 * PI * I0 * NNN / (sqrt (PI) * k0 * k0); + Sinc2 = 400.0 * PI * fabs (dsdw_inc); + Stot = Sinc2 + Scoh; }; + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (intersect && Stot > 0.0) { - if (intersect && Stot>0.0) { + if (t0 < 0.0) + ABSORB; - if(t0<0.0) ABSORB; + rcut = exp (-Stot * (t1 - t0) * v); - rcut = exp(-Stot*(t1-t0)*v); - - if (1.0-rcut > sc_a) dt = -1.0/(v*Stot)*log(rand01()); + if (1.0 - rcut > sc_a) + dt = -1.0 / (v * Stot) * log (rand01 ()); else { - if (rand01()<=sc_a) { - dt = -1.0/(v*Stot)*log(1.0-(1.0-rcut)*rand01()); - p *= (1.0-rcut)/sc_a; - } - else { - dt = -1.0/(v*Stot)*log(rcut*rand01()); - dt = 1e33; /* run out of sample ... */ - p *= rcut/(1.0-sc_a); - }; + if (rand01 () <= sc_a) { + dt = -1.0 / (v * Stot) * log (1.0 - (1.0 - rcut) * rand01 ()); + p *= (1.0 - rcut) / sc_a; + } else { + dt = -1.0 / (v * Stot) * log (rcut * rand01 ()); + dt = 1e33; /* run out of sample ... */ + p *= rcut / (1.0 - sc_a); + }; }; - if (t0+dt<=t1) { + if (t0 + dt <= t1) { - PROP_DT(t0+dt); + PROP_DT (t0 + dt); SCATTER; iscatt = 1; - fcut = sb_max(Ymax,sans_a); + fcut = sb_max (Ymax, sans_a); - if (modl!=11) { + if (modl != 11) { - if (rand01()<=fcut) { - Q = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); - p *= 200.0*PI*Q*Q/(k0*k0)*(qmaxl-Qminl)*l10*(dSigdW(modl,Q,Qtab,Itab)+fabs(dsdw_inc))/(Stot*fcut); - Xsc = 1.0 - 0.5*(Q*Q/(k0*k0)); - theta = 2.0 * asin(0.5*Q/k0); - } - else { - Xsc = -1.0 + (Xmax+1.0)*rand01(); - p *= (1.0-Ymax)/(1.0-fcut); - theta = acos(Xsc); - }; - } - else { - if (rand01()<=fcut) { - if (rand01()<=icut) { - Q = pow(10.0,Qminl+floor(rand01()*NNN)/3.0); - p *= 200.0*PI*I0*NNN/(3.0*sqrt(PI)*k0*k0*Scoh*fcut*icut); - Xsc = 1.0 - 0.5*(Q*Q/(k0*k0)); - theta = 2.0 * asin(0.5*Q/k0); - } - else { - Xsc = 1.0-2.0*Ymax*rand01(); - p *= Ymax/(fcut*(1.0-icut)); - theta = acos(Xsc); + if (rand01 () <= fcut) { + Q = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + p *= 200.0 * PI * Q * Q / (k0 * k0) * (qmaxl - Qminl) * l10 * (dSigdW (modl, Q, Qtab, Itab) + fabs (dsdw_inc)) / (Stot * fcut); + Xsc = 1.0 - 0.5 * (Q * Q / (k0 * k0)); + theta = 2.0 * asin (0.5 * Q / k0); + } else { + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) / (1.0 - fcut); + theta = acos (Xsc); + }; + } else { + if (rand01 () <= fcut) { + if (rand01 () <= icut) { + Q = pow (10.0, Qminl + floor (rand01 () * NNN) / 3.0); + p *= 200.0 * PI * I0 * NNN / (3.0 * sqrt (PI) * k0 * k0 * Scoh * fcut * icut); + Xsc = 1.0 - 0.5 * (Q * Q / (k0 * k0)); + theta = 2.0 * asin (0.5 * Q / k0); + } else { + Xsc = 1.0 - 2.0 * Ymax * rand01 (); + p *= Ymax / (fcut * (1.0 - icut)); + theta = acos (Xsc); + }; + } else { + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) / (1.0 - fcut); + theta = acos (Xsc); }; - } - else { - Xsc = -1.0 + (Xmax+1.0)*rand01(); - p *= (1.0-Ymax)/(1.0-fcut); - theta = acos(Xsc); - }; }; - phi = 2.0*PI*rand01(); + phi = 2.0 * PI * rand01 (); - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, vx, vy, vz); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, vx, vy, vz); vx = vout_x; vy = vout_y; vz = vout_z; - while (iscatt<10 && sngsp==0) { + while (iscatt < 10 && sngsp == 0) { - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - if (!intersect) ABSORB; + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (!intersect) + ABSORB; - dt = -1.0/(v*Stot)*log(rand01()); + dt = -1.0 / (v * Stot) * log (rand01 ()); - if (dt<=t1) { + if (dt <= t1) { - PROP_DT(dt); + PROP_DT (dt); SCATTER; iscatt++; - fcut = sb_max(Ymax,sans_a); + fcut = sb_max (Ymax, sans_a); - if (modl!=11) { + if (modl != 11) { - if (rand01()<=fcut) { - Q = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); - p *= 200.0*PI*Q*Q/(k0*k0)*(qmaxl-Qminl)*l10*(dSigdW(modl,Q,Qtab,Itab)+fabs(dsdw_inc))/(Stot*fcut); - Xsc = 1.0 - 0.5*(Q*Q/(k0*k0)); - theta = 2.0 * asin(0.5*Q/k0); - } - else { - Xsc = -1.0 + (Xmax+1.0)*rand01(); - p *= (1.0-Ymax)/(1.0-fcut); - theta = acos(Xsc); - }; - } - else { - if (rand01()<=fcut) { - if (rand01()<=icut) { - Q = pow(10.0,Qminl+floor(rand01()*NNN)/3.0); - p *= 200.0*PI*I0*NNN/(3.0*sqrt(PI)*k0*k0*Scoh*fcut*icut); - Xsc = 1.0 - 0.5*(Q*Q/(k0*k0)); - theta = 2.0 * asin(0.5*Q/k0); - } - else { - Xsc = 1.0-2.0*Ymax*rand01(); - p *= Ymax/(fcut*(1.0-icut)); - theta = acos(Xsc); + if (rand01 () <= fcut) { + Q = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + p *= 200.0 * PI * Q * Q / (k0 * k0) * (qmaxl - Qminl) * l10 * (dSigdW (modl, Q, Qtab, Itab) + fabs (dsdw_inc)) / (Stot * fcut); + Xsc = 1.0 - 0.5 * (Q * Q / (k0 * k0)); + theta = 2.0 * asin (0.5 * Q / k0); + } else { + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) / (1.0 - fcut); + theta = acos (Xsc); + }; + } else { + if (rand01 () <= fcut) { + if (rand01 () <= icut) { + Q = pow (10.0, Qminl + floor (rand01 () * NNN) / 3.0); + p *= 200.0 * PI * I0 * NNN / (3.0 * sqrt (PI) * k0 * k0 * Scoh * fcut * icut); + Xsc = 1.0 - 0.5 * (Q * Q / (k0 * k0)); + theta = 2.0 * asin (0.5 * Q / k0); + } else { + Xsc = 1.0 - 2.0 * Ymax * rand01 (); + p *= Ymax / (fcut * (1.0 - icut)); + theta = acos (Xsc); + }; + } else { + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) / (1.0 - fcut); + theta = acos (Xsc); }; - } - else { - Xsc = -1.0 + (Xmax+1.0)*rand01(); - p *= (1.0-Ymax)/(1.0-fcut); - theta = acos(Xsc); - }; }; - phi = 2.0*PI*rand01(); + phi = 2.0 * PI * rand01 (); - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); - rotate(tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, theta, axis_x, axis_y, axis_z); - rotate(vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, vx, vy, vz); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + rotate (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, theta, axis_x, axis_y, axis_z); + rotate (vout_x, vout_y, vout_z, tmp_vx, tmp_vy, tmp_vz, phi, vx, vy, vz); vx = vout_x; vy = vout_y; vz = vout_z; - } - else break; + } else + break; }; - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - if (!intersect) ABSORB; - PROP_DT(t1); + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (!intersect) + ABSORB; + PROP_DT (t1); - } - else { - PROP_DT(t1); + } else { + PROP_DT (t1); }; }; - %} FINALLY %{ @@ -838,29 +909,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - + { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zthick; - double zmax = 0.5*zthick; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zthick; + double zmax = 0.5 * zthick; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/SNS_source.comp b/mcstas-comps/contrib/SNS_source.comp index 5953582e8..6d8b14272 100644 --- a/mcstas-comps/contrib/SNS_source.comp +++ b/mcstas-comps/contrib/SNS_source.comp @@ -490,20 +490,20 @@ void tPcalc(double (*func)(double,double,double*,double*),double llim, double hl DECLARE %{ double p_in; - double *inxvec; + double* inxvec; #pragma acc shape(inxvec[0:500]) - double *inyvec; + double* inyvec; #pragma acc shape(inyvec[0:500]) - double *Pvec; + double* Pvec; #pragma acc shape(Pvec[0:500]) int xylength; - double *tcol; + double* tcol; #pragma acc shape(tcol[0:200]) - double *Ecol; + double* Ecol; #pragma acc shape(Ecol[0:200]) - double *tPvec; + double* tPvec; #pragma acc shape(tPvec[0:500]) - double **Ptmat; + double** Ptmat; #pragma acc shape(Ptmat[0:200][0:200]) double EPmax; double EPmin; @@ -520,175 +520,178 @@ DECLARE INITIALIZE %{ - FILE *fp; - double llim, hlim,ltlim,htlim,junk; - double **Imat; - int idx1,idx2; - double *tmp; + FILE* fp; + double llim, hlim, ltlim, htlim, junk; + double** Imat; + int idx1, idx2; + double* tmp; double tyval[500]; double txval[500]; - Pvec=malloc(500*sizeof(double)); - inxvec=malloc(500*sizeof(double)); - inyvec=malloc(500*sizeof(double)); - tcol=malloc(200*sizeof(double)); - Ecol=malloc(200*sizeof(double)); - tPvec=malloc(500*sizeof(double)); - Ptmat=malloc(200*sizeof(double *)); - Imat=malloc(200*sizeof(double*)); + Pvec = malloc (500 * sizeof (double)); + inxvec = malloc (500 * sizeof (double)); + inyvec = malloc (500 * sizeof (double)); + tcol = malloc (200 * sizeof (double)); + Ecol = malloc (200 * sizeof (double)); + tPvec = malloc (500 * sizeof (double)); + Ptmat = malloc (200 * sizeof (double*)); + Imat = malloc (200 * sizeof (double*)); if (!Pvec || !inxvec || !inyvec || !tcol || !Ecol || !tPvec || !Ptmat || !Imat) { - fprintf(stderr,"SNS_Source: malloc() failure in INIT. Exit!\n"); - exit(-1); + fprintf (stderr, "SNS_Source: malloc() failure in INIT. Exit!\n"); + exit (-1); } - for(idx1=0;idx1<200;idx1++){ - Ptmat[idx1]=malloc(200*sizeof(double)); - tmp=Ptmat[idx1]; - if(!tmp) { - fprintf(stderr,"SNS_Source: malloc() failure in INIT: Ptmat[%i] Exit!\n",idx1); - exit(-1); + for (idx1 = 0; idx1 < 200; idx1++) { + Ptmat[idx1] = malloc (200 * sizeof (double)); + tmp = Ptmat[idx1]; + if (!tmp) { + fprintf (stderr, "SNS_Source: malloc() failure in INIT: Ptmat[%i] Exit!\n", idx1); + exit (-1); } } - for(idx1=0;idx1<200;idx1++){ - Imat[idx1]=malloc(500*sizeof(double)); - tmp=Imat[idx1]; - if(!tmp) { - fprintf(stderr,"SNS_Source: malloc() failure in INIT. Itmat[%i] Exit!!\n",idx1); - exit(-1); + for (idx1 = 0; idx1 < 200; idx1++) { + Imat[idx1] = malloc (500 * sizeof (double)); + tmp = Imat[idx1]; + if (!tmp) { + fprintf (stderr, "SNS_Source: malloc() failure in INIT. Itmat[%i] Exit!!\n", idx1); + exit (-1); } } - ltlim=0.1; - htlim=1.8e3; - /* read file */ - printf("%s%s\n","Loading moderator file ",filename); - sns_source_load(filename,inxvec,inyvec,0,2,&xylength,tcol,Ecol,Imat,&ntvals,&nEvals); - /* calculate probabilty distribution function points for use in interpolation routine */ - - llim=inxvec[1];hlim=inxvec[xylength]; - printf("Start calculating probability distribution\n"); - /* calculate total number of neutrons in specified energy window */ - INorm2=integ1(xonly,Emin/1000.0,Emax/1000.0,0.001, xylength,inxvec,inyvec); - Pcalc(xonly,llim,hlim,inxvec,Pvec,xylength,&idxstart,&idxstop, - inyvec); + ltlim = 0.1; + htlim = 1.8e3; + /* read file */ + printf ("%s%s\n", "Loading moderator file ", filename); + sns_source_load (filename, inxvec, inyvec, 0, 2, &xylength, tcol, Ecol, Imat, &ntvals, &nEvals); + /* calculate probabilty distribution function points for use in interpolation routine */ + + llim = inxvec[1]; + hlim = inxvec[xylength]; + printf ("Start calculating probability distribution\n"); + /* calculate total number of neutrons in specified energy window */ + INorm2 = integ1 (xonly, Emin / 1000.0, Emax / 1000.0, 0.001, xylength, inxvec, inyvec); + Pcalc (xonly, llim, hlim, inxvec, Pvec, xylength, &idxstart, &idxstop, inyvec); /*calculate probability distribution as a function of t for each energy value */ - tyval[0]=Imat[0][0]; - //printf("outntvals %i\n",ntvals); - //printf("%g \n",tyval[0]); - for(idx1=0;idx1 0.0) { #ifndef OPENACC - Eval=zero_find(Pfunc,randp,inxvec[idxstart],inxvec[idxstop],1e-7, - xylength,inxvec,Pvec); - #else - Eval=zero_find_gpu1(randp,inxvec[idxstart],inxvec[idxstop],1e-7, - xylength,inxvec,Pvec); - #endif - /* from a known E value generate an emission time value */ - /* find the index of the E values that bracket the random E value */ - idx1=0; - while((idx10.0){ - #ifndef OPENACC - tval=zero_find(tPfunc,randp,txval[tidxstart],txval[tidxstop-1],1e-5, - ntvals,txval,tyval); } - #else - tval=zero_find_gpu2(randp,txval[tidxstart],txval[tidxstop-1],1e-5, - ntvals,txval,tyval); } - #endif - else{ - tval=0;} - E = Eval*1000.0; /* Convert Energy from Ev to meV */ - t = tval*1e-6; /* Convert time from mus to S */ - v = SE2V*sqrt(E); + tval = zero_find (tPfunc, randp, txval[tidxstart], txval[tidxstop - 1], 1e-5, ntvals, txval, tyval); + } + #else + tval = zero_find_gpu2 (randp, txval[tidxstart], txval[tidxstop - 1], 1e-5, ntvals, txval, tyval); + } + #endif + else { + tval = 0; + } + E = Eval * 1000.0; /* Convert Energy from Ev to meV */ + t = tval * 1e-6; /* Convert time from mus to S */ + v = SE2V * sqrt (E); /* Calculate components of velocity vector such that the neutron is within the focusing rectangle */ - vz = v*cos(phi)*cos(theta); /* Small angle approx. */ - vy = v*sin(phi); - vx = v*cos(phi)*sin(theta); - - p*=(xwidth*yheight/(0.1*0.12))*INorm2*pmul; + vz = v * cos (phi) * cos (theta); /* Small angle approx. */ + vy = v * sin (phi); + vx = v * cos (phi) * sin (theta); + p *= (xwidth * yheight / (0.1 * 0.12)) * INorm2 * pmul; %} FINALLY %{ int idxf; - free(tPvec); - free(inxvec);free(inyvec);free(Pvec);free(tcol);free(Ecol); - for(idxf=0;idxf<200;idxf++){ - free(Ptmat[idxf]); + free (tPvec); + free (inxvec); + free (inyvec); + free (Pvec); + free (tcol); + free (Ecol); + for (idxf = 0; idxf < 200; idxf++) { + free (Ptmat[idxf]); } - free(Ptmat); - + free (Ptmat); %} MCDISPLAY %{ - double x1,y1,x2,y2; - x1=-xwidth/2.0;y1=-yheight/2.0;x2=xwidth/2.0;y2=yheight/2.0; - multiline(4,(double)x1,(double)y1,0.0,(double)x1,(double)y2,0.0,(double)x2,(double)y2,0.0,(double)x2,(double)y1,0.0,(double)x1,(double)y1,0.0); + double x1, y1, x2, y2; + x1 = -xwidth / 2.0; + y1 = -yheight / 2.0; + x2 = xwidth / 2.0; + y2 = yheight / 2.0; + multiline (4, (double)x1, (double)y1, 0.0, (double)x1, (double)y2, 0.0, (double)x2, (double)y2, 0.0, (double)x2, (double)y1, 0.0, (double)x1, (double)y1, 0.0); %} END diff --git a/mcstas-comps/contrib/SNS_source_analytic.comp b/mcstas-comps/contrib/SNS_source_analytic.comp index 6453e1153..da98fd0fd 100644 --- a/mcstas-comps/contrib/SNS_source_analytic.comp +++ b/mcstas-comps/contrib/SNS_source_analytic.comp @@ -101,664 +101,667 @@ SETTING PARAMETERS ( SHARE %{ -#ifdef OPENACC - /* there's no abort() on the GPU */ - #define _ABORT() -#else - #define _ABORT() abort() -#endif - - -/*############################################################################################ -# -# slowing-down spectrum and two Maxwellians joined by a modified Wescott function -# -# I(E) = I*1e12 * exp(-c/sqrt(E)) -# * ( R1*E/(kT1)**2*exp(-E/kT1) + R2*E/(kT2)**2*exp(-E/kT2) -# + R3*E/(kT3)**2*exp(-(E/kT3)**b) + D(E)*rho(E)/E**(1-a) ) -# with -# D(E) = 1/(1+(Ecut/E)**s) -# rho(E) = 1 + delta*exp(-x)(1 + x +0.5*x**2) -# x(E) = g*(E-2B); for E>2B -# = 0; for E<=2B -# -# constants: -# k = 1.3805e-23 J/K = 8.617e-5 eV/K -# B = 7.36e-3 eV -# -# parameters: -# I1 -# c -# R1 -# T1 -# R2 -# T2 -# R3 -# T3 -# a -# b -# Ecut -# s -# delta -# g -#*/ -#pragma acc routine seq -double spectral_function( double para[14], double E ) -{ - double c, R1, T1, R2, T2, R3, T3, a, b, Ecut, s, delta, g, Io; - double D, x, B, k, rho, arg1, arg2, arg3, arg4, arg5, arg6; - - /* constants */ - k = 8.617e-5; - B = 7.36e-3; - - /* initialization of parameters */ - c = para[0]; ; - R1 = para[1]; - T1 = para[2]; - R2 = para[3]; - T2 = para[4]; - R3 = para[5]; - T3 = para[6]; - a = para[7]; - b = para[8]; - Ecut = para[9]; - s = para[10]; - delta= para[11]; - g = para[12]; - Io = para[13]; - - /* evaluation of spectral function */ - D = 1.0/(1+pow(Ecut/E,s)); - x = 0.0; - if(E>2.0*B) {x = g*(E-2.0*B);} - rho = 1.0 + delta*exp(-x)*(1 + x +0.5*x*x); - arg1 = Io*1.0e12 * exp(-c/sqrt(E)); - arg2 = R1*E/pow(k*T1,2) *exp(-E/(k*T1)); - arg3 = R2*E/pow(k*T2,2) *exp(-E/(k*T2)); - arg4 = R3*E/pow(k*T3,2) *exp(-pow(E/(k*T3),b)); - arg5 = D*rho/pow(E,1-a); - arg6 =(arg1 * ( arg2 + arg3 + arg4 + arg5 )); - return(arg6); -} - -/*############################################################################################ -# -# prepares a vector of 1000 equiprobable energies in the range of Emin to Emax -# from the spectral distribution function -# returns the 1001 bin boundaries in array csfE -# returns the specctral integral in the range Emin to Emax in CItot -# -*/ -double prepare_cumulative_spectral_function ( double *csfE, double Emin, double Emax, - double para[14] ) -{ - double E, E0, E1, CI, dCI, CItot, I0, I1, arg; - double u, umax, umin, du; - int i; + #ifdef OPENACC + /* there's no abort() on the GPU */ + #define _ABORT() + #else + #define _ABORT() abort() + #endif - umax = log(Emax*1e-3); - umin = log(Emin*1e-3); - du = (umax - umin)*1e-5; - CItot=0.0; - E0=0.0; - I0 = spectral_function( para, Emin ); - for(u=umin+du; u<=umax; u+=du) { - E1=exp(u); - I1 = spectral_function( para, E1 ); - CItot += (E1-E0)*(I1+I0)*0.5; - I0 = I1; - E0 = E1; - } - printf("\n CItot = %12.4e\n", CItot); - CI = 0.0; - dCI = 1.0e-3; - E0 = Emin*1e-3; - u = umin; - I0 = spectral_function( para, E0 ); - i=0; - csfE[0]= Emin*1e-3; - while (i<1000) { - E1 = exp(u+du); - I1 = spectral_function( para, E1 ); - arg = (I1+I0)*0.5/CItot; - if(CI+arg*(E1-E0)>dCI) { - E = E0 + (dCI-CI)/arg; - i++; - csfE[i] = E; - // printf("E-%d = %12.4e\n", i, csfE[i]); - CI=0.0; - I0 = spectral_function( para, E ); - E0 = E; - u = log(E); + /*############################################################################################ + # + # slowing-down spectrum and two Maxwellians joined by a modified Wescott function + # + # I(E) = I*1e12 * exp(-c/sqrt(E)) + # * ( R1*E/(kT1)**2*exp(-E/kT1) + R2*E/(kT2)**2*exp(-E/kT2) + # + R3*E/(kT3)**2*exp(-(E/kT3)**b) + D(E)*rho(E)/E**(1-a) ) + # with + # D(E) = 1/(1+(Ecut/E)**s) + # rho(E) = 1 + delta*exp(-x)(1 + x +0.5*x**2) + # x(E) = g*(E-2B); for E>2B + # = 0; for E<=2B + # + # constants: + # k = 1.3805e-23 J/K = 8.617e-5 eV/K + # B = 7.36e-3 eV + # + # parameters: + # I1 + # c + # R1 + # T1 + # R2 + # T2 + # R3 + # T3 + # a + # b + # Ecut + # s + # delta + # g + #*/ + #pragma acc routine seq + double + spectral_function (double para[14], double E) { + double c, R1, T1, R2, T2, R3, T3, a, b, Ecut, s, delta, g, Io; + double D, x, B, k, rho, arg1, arg2, arg3, arg4, arg5, arg6; + + /* constants */ + k = 8.617e-5; + B = 7.36e-3; + + /* initialization of parameters */ + c = para[0]; + ; + R1 = para[1]; + T1 = para[2]; + R2 = para[3]; + T2 = para[4]; + R3 = para[5]; + T3 = para[6]; + a = para[7]; + b = para[8]; + Ecut = para[9]; + s = para[10]; + delta = para[11]; + g = para[12]; + Io = para[13]; + + /* evaluation of spectral function */ + D = 1.0 / (1 + pow (Ecut / E, s)); + x = 0.0; + if (E > 2.0 * B) { + x = g * (E - 2.0 * B); } - else { - u = u+du; - CI += arg*(E1-E0); + rho = 1.0 + delta * exp (-x) * (1 + x + 0.5 * x * x); + arg1 = Io * 1.0e12 * exp (-c / sqrt (E)); + arg2 = R1 * E / pow (k * T1, 2) * exp (-E / (k * T1)); + arg3 = R2 * E / pow (k * T2, 2) * exp (-E / (k * T2)); + arg4 = R3 * E / pow (k * T3, 2) * exp (-pow (E / (k * T3), b)); + arg5 = D * rho / pow (E, 1 - a); + arg6 = (arg1 * (arg2 + arg3 + arg4 + arg5)); + return (arg6); + } + + /*############################################################################################ + # + # prepares a vector of 1000 equiprobable energies in the range of Emin to Emax + # from the spectral distribution function + # returns the 1001 bin boundaries in array csfE + # returns the specctral integral in the range Emin to Emax in CItot + # + */ + double + prepare_cumulative_spectral_function (double* csfE, double Emin, double Emax, double para[14]) { + double E, E0, E1, CI, dCI, CItot, I0, I1, arg; + double u, umax, umin, du; + int i; + + umax = log (Emax * 1e-3); + umin = log (Emin * 1e-3); + du = (umax - umin) * 1e-5; + CItot = 0.0; + E0 = 0.0; + I0 = spectral_function (para, Emin); + for (u = umin + du; u <= umax; u += du) { + E1 = exp (u); + I1 = spectral_function (para, E1); + CItot += (E1 - E0) * (I1 + I0) * 0.5; I0 = I1; E0 = E1; } + printf ("\n CItot = %12.4e\n", CItot); + CI = 0.0; + dCI = 1.0e-3; + E0 = Emin * 1e-3; + u = umin; + I0 = spectral_function (para, E0); + i = 0; + csfE[0] = Emin * 1e-3; + while (i < 1000) { + E1 = exp (u + du); + I1 = spectral_function (para, E1); + arg = (I1 + I0) * 0.5 / CItot; + if (CI + arg * (E1 - E0) > dCI) { + E = E0 + (dCI - CI) / arg; + i++; + csfE[i] = E; + // printf("E-%d = %12.4e\n", i, csfE[i]); + CI = 0.0; + I0 = spectral_function (para, E); + E0 = E; + u = log (E); + } else { + u = u + du; + CI += arg * (E1 - E0); + I0 = I1; + E0 = E1; + } + } + return (CItot); } - return(CItot); -} - -/*############################################################################################# -# -# Short-pulse Ikeda Carpenter energy-time brightness function -# -# f(E,t) = a/2 *( (1-R)(a*t)**2 *exp(-a*t) -# +2*R*a**2*b/(a-b)**3 *[ exp(-b*t) - exp(-a*t)*(1+(a-b)*t+0.5*(a-b)**2*t**2) ] } -# with -# -# t=t-to -# -# parameters: -# -# a -# b -# R -# to -#*/ -#pragma acc routine seq -double f_sp (double para[4], double t) -{ - double a, b, R, to; - double tt, eat, ebt, arg1, arg2, arg3, arg4; - a = para[0]; - b = para[1]; - R = para[2]; - to= para[3]; - - tt = t - to*10.0; - if(tt<0.0) {tt=0.0;} - eat = exp(-a*tt); - ebt = exp(-b*tt); - arg1 = (1-R) *pow(a*tt,2) *eat; - arg2 = 2*R*a*a *b/pow(a-b,3); - arg3 = 1 + (a-b)*tt + 0.5*pow(a-b,2) *tt*tt; - arg4 = 0.5*a *( arg1 + arg2 *( ebt - eat*arg3 ) ); - - return(arg4); -} - - -/*############################################################################################# -# -# cummulative f_sp short pulse distribution function -# derived anlytically -# -# F(t) = (1-R)*(1-(gamma*exp(-a*(t-to))) for t-to >0 -# *R *(1-delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) -# *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma)) -# = 0 for t-to <=0 -# -# with -# gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 -# delta = a**3/(a-b)**3 -# tm = max(to,(t-T)) -# -# f_sp(t) = F(tm) -F(t) -# -# parameters: -# a = proportial to scattering cross section -# b = decay constant of longest living flux eigenfunction -# R = fraction of slowing down term -# to = delay time -# T = proton pulse length -#*/ -#pragma acc routine seq -double cummulative_f_sp (double para[4], double t) -{ - double a, b, R, to; - double tt, eat, ebt, arg1, arg2, arg3, arg4, arg5; - double delta, gt, ambda, ambda2; - - a = para[0]; - b = para[1]; - R = para[2]; - to= para[3]; - - ambda = (a-b)/a; - ambda2= ambda*ambda; - delta = pow(1/ambda,3); - - tt=t-to*10.0; - if(tt<0.0) {tt=0.0;} - - gt = 0.5*pow(a*tt,2) + a*tt + 1.0; - eat = exp(-a*tt); - ebt = exp(-b*tt); - arg1 = 1.0-gt*eat; - arg2 = delta*(1 -ebt); - arg3 = delta*b/a*eat*(1.0 + ambda*(a*tt+1.0) + ambda2*gt); - arg4 = delta*b/a*(1+ambda+ambda2); - arg5 = (1.0-R)*arg1 + R*(arg2+arg3-arg4); - - return(arg5); -} - -/*############################################################################################# -# -# samples t from f_sp within interval [tmin,tmax] -# -# F(t) = (1-R)*(1-(gamma*exp(-a*(t-to))) for t-to >0 -# *R *(1-delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) -# *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma)) -# = 0 for t-to <=0 -# -# with -# gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 -# delta = a**3/(a-b)**3 -# tm = max(to,(t-T)) -# -# f_sp(t) = F(tm) -F(t) -# -# parameters: -# a = proportial to scattering cross section -# b = decay constant of longest living flux eigenfunction -# R = fraction of slowing down term -# to = delay time -# T = proton pulse length -#*/ -#pragma acc routine seq -double sample_t_from_f_sp (double para[4], double tmin, double tmax, double randd, double *p_t) -{ - double arg; - double t, tm, tp, fm, fp, renorm, Imin, Imax; - int n; - double diff, eps; - - eps = 1.0e-4; - - Imax = cummulative_f_sp(para, tmax); - /* - printf(" tmax=%e",tmax); - printf(" Imax=%e",Imax); - printf("\n"); - */ - Imin = cummulative_f_sp(para, tmin); - /* - printf(" tmin=%e",tmin); - printf(" Imin=%e",Imin); - printf("\n"); - */ - renorm = 1.0 /(Imax-Imin); - tm = tmin; - fm = 0.0; - tp = tmax; - fp = 1.0; - n = 0; - t = 0; - diff = 1.0; - while(fabs(diff)>eps) { - n++; - if(n<10) { - t = 0.5*(tp+tm); + /*############################################################################################# + # + # Short-pulse Ikeda Carpenter energy-time brightness function + # + # f(E,t) = a/2 *( (1-R)(a*t)**2 *exp(-a*t) + # +2*R*a**2*b/(a-b)**3 *[ exp(-b*t) - exp(-a*t)*(1+(a-b)*t+0.5*(a-b)**2*t**2) ] } + # with + # + # t=t-to + # + # parameters: + # + # a + # b + # R + # to + #*/ + #pragma acc routine seq + double + f_sp (double para[4], double t) { + double a, b, R, to; + double tt, eat, ebt, arg1, arg2, arg3, arg4; + a = para[0]; + b = para[1]; + R = para[2]; + to = para[3]; + + tt = t - to * 10.0; + if (tt < 0.0) { + tt = 0.0; } - else { - t = tm +(tp-tm)/(fp-fm)*(randd-fm); + eat = exp (-a * tt); + ebt = exp (-b * tt); + arg1 = (1 - R) * pow (a * tt, 2) * eat; + arg2 = 2 * R * a * a * b / pow (a - b, 3); + arg3 = 1 + (a - b) * tt + 0.5 * pow (a - b, 2) * tt * tt; + arg4 = 0.5 * a * (arg1 + arg2 * (ebt - eat * arg3)); + + return (arg4); + } + + /*############################################################################################# + # + # cummulative f_sp short pulse distribution function + # derived anlytically + # + # F(t) = (1-R)*(1-(gamma*exp(-a*(t-to))) for t-to >0 + # *R *(1-delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) + # *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma)) + # = 0 for t-to <=0 + # + # with + # gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 + # delta = a**3/(a-b)**3 + # tm = max(to,(t-T)) + # + # f_sp(t) = F(tm) -F(t) + # + # parameters: + # a = proportial to scattering cross section + # b = decay constant of longest living flux eigenfunction + # R = fraction of slowing down term + # to = delay time + # T = proton pulse length + #*/ + #pragma acc routine seq + double + cummulative_f_sp (double para[4], double t) { + double a, b, R, to; + double tt, eat, ebt, arg1, arg2, arg3, arg4, arg5; + double delta, gt, ambda, ambda2; + + a = para[0]; + b = para[1]; + R = para[2]; + to = para[3]; + + ambda = (a - b) / a; + ambda2 = ambda * ambda; + delta = pow (1 / ambda, 3); + + tt = t - to * 10.0; + if (tt < 0.0) { + tt = 0.0; } - arg = cummulative_f_sp(para, t); - arg = (arg -Imin)*renorm; - - diff = arg - randd; - if(n>50){ - printf(" sample_t_from_f_sp exeeds 50 iterations!\n"); - printf(" tmax=%01.4e tmin=%10.4e " , tmax, tmin); - printf(" Imax=%01.4e Imin=%10.4e arg4=%10.4e" , Imax, Imin, arg); - printf(" randd=%10.4e diff=%10.4e t=%10.4e\n", randd, diff, t); - _ABORT(); + + gt = 0.5 * pow (a * tt, 2) + a * tt + 1.0; + eat = exp (-a * tt); + ebt = exp (-b * tt); + arg1 = 1.0 - gt * eat; + arg2 = delta * (1 - ebt); + arg3 = delta * b / a * eat * (1.0 + ambda * (a * tt + 1.0) + ambda2 * gt); + arg4 = delta * b / a * (1 + ambda + ambda2); + arg5 = (1.0 - R) * arg1 + R * (arg2 + arg3 - arg4); + + return (arg5); + } + + /*############################################################################################# + # + # samples t from f_sp within interval [tmin,tmax] + # + # F(t) = (1-R)*(1-(gamma*exp(-a*(t-to))) for t-to >0 + # *R *(1-delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) + # *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma)) + # = 0 for t-to <=0 + # + # with + # gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 + # delta = a**3/(a-b)**3 + # tm = max(to,(t-T)) + # + # f_sp(t) = F(tm) -F(t) + # + # parameters: + # a = proportial to scattering cross section + # b = decay constant of longest living flux eigenfunction + # R = fraction of slowing down term + # to = delay time + # T = proton pulse length + #*/ + #pragma acc routine seq + double + sample_t_from_f_sp (double para[4], double tmin, double tmax, double randd, double* p_t) { + double arg; + double t, tm, tp, fm, fp, renorm, Imin, Imax; + int n; + double diff, eps; + + eps = 1.0e-4; + + Imax = cummulative_f_sp (para, tmax); + /* + printf(" tmax=%e",tmax); + printf(" Imax=%e",Imax); + printf("\n"); + */ + + Imin = cummulative_f_sp (para, tmin); + /* + printf(" tmin=%e",tmin); + printf(" Imin=%e",Imin); + printf("\n"); + */ + renorm = 1.0 / (Imax - Imin); + tm = tmin; + fm = 0.0; + tp = tmax; + fp = 1.0; + n = 0; + t = 0; + diff = 1.0; + while (fabs (diff) > eps) { + n++; + if (n < 10) { + t = 0.5 * (tp + tm); + } else { + t = tm + (tp - tm) / (fp - fm) * (randd - fm); + } + arg = cummulative_f_sp (para, t); + arg = (arg - Imin) * renorm; + + diff = arg - randd; + if (n > 50) { + printf (" sample_t_from_f_sp exeeds 50 iterations!\n"); + printf (" tmax=%01.4e tmin=%10.4e ", tmax, tmin); + printf (" Imax=%01.4e Imin=%10.4e arg4=%10.4e", Imax, Imin, arg); + printf (" randd=%10.4e diff=%10.4e t=%10.4e\n", randd, diff, t); + _ABORT (); + } + if (arg < randd) { + tm = t; + fm = arg; + } else if (arg > randd) { + tp = t; + fp = arg; + } } - if(arg0 + # (-1/T)*delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) + # *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma) + # = 0 for t-to <=0 + # + # with + # gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 + # delta = R*a**3/(a-b)**3 + # tm = max(to,(t-T)) + # + # f_lp(t) = F(tm) - F(t) + # + # parameters: + # a = proportial to scattering cross section + # b = decay constant of longest living flux eigenfunction + # R = fraction of slowing down term + # to = delay time + # T = proton pulse length + #*/ + #pragma acc routine seq + double + f_lp (double para[4], double t, double T) { + double a, b, R, to; + double tt, eat, ebt, arg1, arg2, Imax, Imin, Itot, delta, ambda, ambda2, gt; + a = para[0]; + b = para[1]; + R = para[2]; + to = para[3]; + + ambda = (a - b) / a; + ambda2 = ambda * ambda; + delta = pow (ambda, -3); + + /* upper time boundary */ + tt = t - to * 10.0; + if (tt < 0.0) { + tt = 0.0; } - else if(arg>randd) { - tp = t; - fp = arg; + eat = exp (-a * tt); + ebt = exp (-b * tt); + gt = 0.5 * pow (a * tt, 2) + a * tt + 1.0; + arg1 = gt * eat; + arg2 = delta * (ebt - eat * b / a * (1.0 + ambda * (a * tt + 1.0) + ambda2 * gt)); + Imax = (1.0 - R) * arg1 + R * arg2; + /* + printf(" tt =%e",tt); + printf(" eatm=%e",eat); + printf(" ebtm=%e",ebt); + printf(" gtm=%e",gt); + printf(" arg1=%e",arg1); + printf(" arg2=%e",arg2); + printf(" Imax=%e",Imax); + printf("\n"); + */ + /* lower time boundary */ + tt = tt - T; + if (tt < 0.0) { + tt = 0.0; } + eat = exp (-a * tt); + ebt = exp (-b * tt); + gt = 0.5 * pow (a * tt, 2) + a * tt + 1.0; + arg1 = gt * eat; + arg2 = delta * (ebt - eat * b / a * (1.0 + ambda * (a * tt + 1.0) + ambda2 * gt)); + Imin = (1.0 - R) * arg1 + R * arg2; + + Itot = (Imin - Imax) / T; + /* + printf(" tto =%e",tt); + printf(" eat =%e",eat); + printf(" ebt =%e",ebt); + printf(" gt =%e",gt); + printf(" arg1=%e",arg1); + printf(" arg2=%e",arg2); + printf(" Imin=%e",Imin); + printf(" Itot=%e",Itot); + printf("\n"); + */ + return (Itot); } - /* printf("tmin=%f tmax=%f Imin=%e Imax=%e t=%e n=%d\n", ttmin, ttmax, Imin, Imax, t, n); */ - *p_t = Imax-Imin; - return(t); -} - -/*############################################################################################# -# -# Long-pulse Ikeda Carpenter function -# -# proton pulse is a atep function with pulse length T (Heavyside function) -# -# folded with the Ikeada Carpenter Function f_sp -# -# F(t) = (-1/T)*(1-R)*(gamma*exp(-a*(t-to)) for t-to >0 -# (-1/T)*delta *(exp(-b*(t-to)) -exp(-a*(t-to)) *(b/a) -# *(1 + (a-b)/a *(a*(t-to) +1) +((a-b)/a)**2 *gamma) -# = 0 for t-to <=0 -# -# with -# gamma = 0.5*((a*(t-to))**2 +a*(t-to) +1 -# delta = R*a**3/(a-b)**3 -# tm = max(to,(t-T)) -# -# f_lp(t) = F(tm) - F(t) -# -# parameters: -# a = proportial to scattering cross section -# b = decay constant of longest living flux eigenfunction -# R = fraction of slowing down term -# to = delay time -# T = proton pulse length -#*/ -#pragma acc routine seq -double f_lp (double para[4], double t, double T) -{ - double a, b, R, to; - double tt, eat, ebt, arg1, arg2, Imax, Imin, Itot, delta, ambda, ambda2, gt; - a = para[0]; - b = para[1]; - R = para[2]; - to= para[3]; - - ambda = (a-b)/a; - ambda2= ambda*ambda; - delta = pow(ambda,-3); - - /* upper time boundary */ - tt = t - to*10.0; - if(tt<0.0) {tt=0.0;} - eat = exp(-a*tt); - ebt = exp(-b*tt); - gt = 0.5*pow(a*tt,2) + a*tt + 1.0; - arg1 = gt*eat; - arg2 = delta*(ebt - eat*b/a*(1.0 + ambda*(a*tt+1.0) + ambda2*gt)); - Imax = (1.0-R)*arg1 + R*arg2; -/* - printf(" tt =%e",tt); + + /*############################################################################################# + # + # Ikeda carpenter function integrated twice over time + # base function used for calculating cumulative long-pulse time distribution function + # + # FF(t) = (-1/T)*(1-R)*(-1/a)*gamma*exp(-a*(t-to)) for t-to >0 + # +(-1/T)*R*delta*(-1/b)*(exp(-b*(t-to)) + # +(-1/T)*R*delta*(b/a**2) + # *(1+2*ambda + ambda*a*t + ambda**2*gamma) + # *exp(-a*(t-to)) + # = 0 for t-to <=0 + # + # with + # gamma = 0.5*(a*(t-to))**2 +2*a*(t-to) +3 + # ambda =(a-b)/a + # delta = ambda**(-3) + # + # remember: + # F(t) = integral(f_sp(t)) + # f_sp(t) = short-pulse emission time distribution + # f_lp(t) = integral_(T-t^t(f_sp(t)) + # = (F(t)-F((t-T))/T + # hence: + # FF(t) = integral(F(t)) + # + # parameters: + # a = proportial to scattering cross section + # b = decay constant of longest living flux eigenfunction + # R = fraction of slowing down term + # to = delay time + # T = proton pulse length + #*/ + #pragma acc routine seq + double + integral_integral_IC (double para[4], double t, double T) { + double a, b, R, to; + double eat, ebt, arg1, arg2, arg3, arg4; + double tt, delta, gamma, ambda, ambda2; + + a = para[0]; + b = para[1]; + R = para[2]; + to = para[3]; + tt = t - to * 10.0; + if (tt < 0.0) { + tt = 0.0; + } + ambda = (a - b) / a; + ambda2 = ambda * ambda; + delta = pow (ambda, -3); + + /* integrate 0 to T */ + eat = exp (-a * tt); + ebt = exp (-b * tt); + gamma = 0.5 * pow (a * tt, 2) + 2.0 * a * tt + 3.0; + arg1 = gamma / a * eat; + arg2 = delta / b * ebt; + arg3 = delta * b / a / a * (1.0 + 2.0 * ambda + ambda * a * tt + ambda2 * gamma) * eat; + arg4 = ((1.0 - R) * arg1 + R * arg2 - R * arg3) / T; + /* + printf(" t=%e", t); printf(" eatm=%e",eat); printf(" ebtm=%e",ebt); - printf(" gtm=%e",gt); + printf(" gtm=%e",gamma); printf(" arg1=%e",arg1); printf(" arg2=%e",arg2); - printf(" Imax=%e",Imax); + printf(" arg3=%e",arg3); + printf(" arg4=%e",arg4); printf("\n"); -*/ - /* lower time boundary */ - tt = tt - T; - if(tt<0.0) {tt=0.0;} - eat = exp(-a*tt); - ebt = exp(-b*tt); - gt = 0.5*pow(a*tt,2) + a*tt + 1.0; - arg1 = gt*eat; - arg2 = delta*(ebt - eat*b/a*(1.0 + ambda*(a*tt+1.0) + ambda2*gt)); - Imin = (1.0-R)*arg1 + R*arg2; - - Itot = (Imin - Imax)/T; -/* - printf(" tto =%e",tt); - printf(" eat =%e",eat); - printf(" ebt =%e",ebt); - printf(" gt =%e",gt); - printf(" arg1=%e",arg1); - printf(" arg2=%e",arg2); - printf(" Imin=%e",Imin); - printf(" Itot=%e",Itot); - printf("\n"); -*/ - return(Itot); -} - -/*############################################################################################# -# -# Ikeda carpenter function integrated twice over time -# base function used for calculating cumulative long-pulse time distribution function -# -# FF(t) = (-1/T)*(1-R)*(-1/a)*gamma*exp(-a*(t-to)) for t-to >0 -# +(-1/T)*R*delta*(-1/b)*(exp(-b*(t-to)) -# +(-1/T)*R*delta*(b/a**2) -# *(1+2*ambda + ambda*a*t + ambda**2*gamma) -# *exp(-a*(t-to)) -# = 0 for t-to <=0 -# -# with -# gamma = 0.5*(a*(t-to))**2 +2*a*(t-to) +3 -# ambda =(a-b)/a -# delta = ambda**(-3) -# -# remember: -# F(t) = integral(f_sp(t)) -# f_sp(t) = short-pulse emission time distribution -# f_lp(t) = integral_(T-t^t(f_sp(t)) -# = (F(t)-F((t-T))/T -# hence: -# FF(t) = integral(F(t)) -# -# parameters: -# a = proportial to scattering cross section -# b = decay constant of longest living flux eigenfunction -# R = fraction of slowing down term -# to = delay time -# T = proton pulse length -#*/ -#pragma acc routine seq -double integral_integral_IC (double para[4], double t, double T) -{ - double a, b, R, to; - double eat, ebt, arg1, arg2, arg3, arg4; - double tt, delta, gamma, ambda, ambda2; - - a = para[0]; - b = para[1]; - R = para[2]; - to= para[3]; - tt = t-to*10.0; - if(tt<0.0) {tt=0.0;} - ambda = (a-b)/a; - ambda2 = ambda*ambda; - delta = pow(ambda,-3); - - /* integrate 0 to T */ - eat = exp(-a*tt); - ebt = exp(-b*tt); - gamma = 0.5*pow(a*tt,2) + 2.0*a*tt + 3.0; - arg1 = gamma/a*eat; - arg2 = delta/b*ebt; - arg3 = delta*b/a/a*(1.0+2.0*ambda+ambda*a*tt+ambda2*gamma)*eat; - arg4 = ((1.0-R)*arg1 + R*arg2 -R*arg3)/T; - /* - printf(" t=%e", t); - printf(" eatm=%e",eat); - printf(" ebtm=%e",ebt); - printf(" gtm=%e",gamma); - printf(" arg1=%e",arg1); - printf(" arg2=%e",arg2); - printf(" arg3=%e",arg3); - printf(" arg4=%e",arg4); - printf("\n"); - */ - return(arg4); -} - - - -/*############################################################################################# -# -# cummulative distribution function f_lp -# integrated analytically:from f_lp -# -# FF(t) = (-1/T)*(1-R)*(-1/a)*gamma*exp(-a*(t-to)) for t-to >0 -# +(-1/T)*R*delta*(-1/b)*(exp(-b*(t-to)) -# +(-1/T)*R*delta*(b/a**2) -# *(1+2*ambda + ambda*a*t + ambda**2*gamma) -# *exp(-a*(t-to)) -# = 0 for t-to <=0 -# -# with -# gamma = 0.5*(a*(t-to))**2 +2*a*(t-to) +3 -# ambda =(a-b)/a -# delta = ambda**(-3) -# tm = max(to,(t-T)) -# -# remember: -# F(t) = integral(f_sp(t)) -# f_sp(t) = short-pulse emission time distribution -# f_lp(t) = integral_(T-t^t(f_sp(t)) -# = (F(t)-F((t-T))/T -# hence: -# FF(t) = integral(F(t)) -# CI(t) = integral_0^t(f_lp(t)) -# = FF(t) - FF(tm) + f_lp(0)*(t-to) -# with -# tm=max(0,t-T) -# -# parameters: -# a = proportial to scattering cross section -# b = decay constant of longest living flux eigenfunction -# R = fraction of slowing down term -# to = delay time -# T = proton pulse length -#*/ -#pragma acc routine seq -double cummulative_f_lp (double para[4], double t, double T) -{ - double a, b, R, to; - double arg; - double tt, delta, ambda, ambda2, phi; - - a = para[0]; - b = para[1]; - R = para[2]; - to= para[3]; - tt = t-to*10.0; - if(tt<0.0) {tt=0.0;} - ambda = (a-b)/a; - ambda2 = ambda*ambda; - delta = pow(ambda,-3); - phi = (1.0-R)+ R*delta*(1.0 - b/a*(1.0+ambda+ambda2)); - - /* integrate 0 to T */ - tt=t-to*10.; - if(tt<0.0) {tt=0.0;} - if(tt-1e-5 ) {CImin = 0.0;} - if(CImax>0.0 && CImin>=0.0) { - renorm = 1.0 /(CImax-CImin); - } - else { - printf("troubble in sample_t_from_f_lp\n"); - printf(" E=%e tmax=%e tmin=%e CImax=%e CImin=%e\n", E, tmax, tmin, CImax, CImin); - _ABORT(); - } + /*############################################################################################# + # + # cummulative distribution function f_lp + # integrated analytically:from f_lp + # + # FF(t) = (-1/T)*(1-R)*(-1/a)*gamma*exp(-a*(t-to)) for t-to >0 + # +(-1/T)*R*delta*(-1/b)*(exp(-b*(t-to)) + # +(-1/T)*R*delta*(b/a**2) + # *(1+2*ambda + ambda*a*t + ambda**2*gamma) + # *exp(-a*(t-to)) + # = 0 for t-to <=0 + # + # with + # gamma = 0.5*(a*(t-to))**2 +2*a*(t-to) +3 + # ambda =(a-b)/a + # delta = ambda**(-3) + # tm = max(to,(t-T)) + # + # remember: + # F(t) = integral(f_sp(t)) + # f_sp(t) = short-pulse emission time distribution + # f_lp(t) = integral_(T-t^t(f_sp(t)) + # = (F(t)-F((t-T))/T + # hence: + # FF(t) = integral(F(t)) + # CI(t) = integral_0^t(f_lp(t)) + # = FF(t) - FF(tm) + f_lp(0)*(t-to) + # with + # tm=max(0,t-T) + # + # parameters: + # a = proportial to scattering cross section + # b = decay constant of longest living flux eigenfunction + # R = fraction of slowing down term + # to = delay time + # T = proton pulse length + #*/ + #pragma acc routine seq + double + cummulative_f_lp (double para[4], double t, double T) { + double a, b, R, to; + double arg; + double tt, delta, ambda, ambda2, phi; - tm = tmin; - fm = 0.0; - tp = tmax; - fp = 1.0; - n = 0; - t = 0; - diff = 1.0; - while(fabs(diff)>eps) { - n++; - if(n<10) { - t = 0.5*(tp+tm); + a = para[0]; + b = para[1]; + R = para[2]; + to = para[3]; + tt = t - to * 10.0; + if (tt < 0.0) { + tt = 0.0; } - else { - t = tm +(tp-tm)/(fp-fm)*(randd-fm); + ambda = (a - b) / a; + ambda2 = ambda * ambda; + delta = pow (ambda, -3); + phi = (1.0 - R) + R * delta * (1.0 - b / a * (1.0 + ambda + ambda2)); + + /* integrate 0 to T */ + tt = t - to * 10.; + if (tt < 0.0) { + tt = 0.0; } - arg = cummulative_f_lp(para,t,T); - arg = (arg -CImin)*renorm; - diff = arg - randd; - if(n<50){ + if (tt < T) { + arg = integral_integral_IC (para, t, T) - integral_integral_IC (para, 0.0, T) + tt / T * phi; + } else { + // need to check why we need to add 1.0 here + arg = integral_integral_IC (para, t, T) - integral_integral_IC (para, t - T, T) + phi; } - else { - if(fabs(diff) -1e-5) { + CImin = 0.0; } - if(arg 0.0 && CImin >= 0.0) { + renorm = 1.0 / (CImax - CImin); + } else { + printf ("troubble in sample_t_from_f_lp\n"); + printf (" E=%e tmax=%e tmin=%e CImax=%e CImin=%e\n", E, tmax, tmin, CImax, CImin); + _ABORT (); } - else if(arg>randd) { - tp = t; - fp = arg; + + tm = tmin; + fm = 0.0; + tp = tmax; + fp = 1.0; + n = 0; + t = 0; + diff = 1.0; + while (fabs (diff) > eps) { + n++; + if (n < 10) { + t = 0.5 * (tp + tm); + } else { + t = tm + (tp - tm) / (fp - fm) * (randd - fm); + } + arg = cummulative_f_lp (para, t, T); + arg = (arg - CImin) * renorm; + diff = arg - randd; + if (n < 50) { + } else { + if (fabs (diff) < eps2) { + break; + } + printf (" sample_t_from_f_lp used 50 iterations!\n"); + printf (" E=%10.4e", E); + printf (" CImax=%01.4e CImin=%10.4e arg4=%10.4e", CImax, CImin, arg); + printf (" randd=%10.4e diff=%10.4e t=%10.4e\n", randd, diff, t); + _ABORT (); + } + if (arg < randd) { + tm = t; + fm = arg; + } else if (arg > randd) { + tp = t; + fp = arg; + } } + /* printf("tmin=%f tmax=%f Imin=%e Imax=%e t=%e n=%d\n", ttmin, ttmax, CImin, CImax, t, n); */ + *p_t = CImax - CImin; + return (t); } - /* printf("tmin=%f tmax=%f Imin=%e Imax=%e t=%e n=%d\n", ttmin, ttmax, CImin, CImax, t, n); */ - *p_t = CImax-CImin; - return(t); -} - - -/*############################################################################################# -# -# Pade type fitting function -# -# f(x) = log(a*x**b*(1+c*x+d*x**2+(x/f)**g)/(1+h*x+i*x**2+(x/j)**k)) -# -# with -# a,b,c,d,f,g,h,i,j,k -# -# -#*/ -#pragma acc routine seq -double pade_function (double para[10], double E) -{ - double a, b, c, d, f, g, h, i, j, k; + + /*############################################################################################# + # + # Pade type fitting function + # + # f(x) = log(a*x**b*(1+c*x+d*x**2+(x/f)**g)/(1+h*x+i*x**2+(x/j)**k)) + # + # with + # a,b,c,d,f,g,h,i,j,k + # + # + #*/ + #pragma acc routine seq + double + pade_function (double para[10], double E) { + double a, b, c, d, f, g, h, i, j, k; a = para[0]; b = para[1]; @@ -771,9 +774,8 @@ double pade_function (double para[10], double E) j = para[8]; k = para[9]; - return(a*pow(E,b)*(1+c*E+d*E*E+pow(E/f,g))/(1+h*E+i*E*E+pow(E/j,k))); -} - + return (a * pow (E, b) * (1 + c * E + d * E * E + pow (E / f, g)) / (1 + h * E + i * E * E + pow (E / j, k))); + } %} @@ -797,163 +799,157 @@ DECLARE INITIALIZE %{ char line[1000]; - int linelength=1000; + int linelength = 1000; int k, kk; - FILE *fp, *fopen(); + FILE *fp, *fopen (); - fp = fopen(filename,"r"); - if (fp==NULL){ - fprintf(stderr,"Error opening file\n"); - exit(-1); + fp = fopen (filename, "r"); + if (fp == NULL) { + fprintf (stderr, "Error opening file\n"); + exit (-1); + } else { + printf ("%s\n", "File opened..."); } - else { - printf("%s\n","File opened..."); - } /* spectral parameters */ - while( (fgets(line,linelength,fp) != NULL) && (strchr(line,'#') != NULL) ){ - printf("%s",line); + while ((fgets (line, linelength, fp) != NULL) && (strchr (line, '#') != NULL)) { + printf ("%s", line); } - kk=sscanf(line," %le %le %le %le %le %le %le %le %le %le %le %le %le %le", ¶_sp[0], ¶_sp[1], ¶_sp[2], - ¶_sp[3], ¶_sp[4], ¶_sp[5], ¶_sp[6], ¶_sp[7], ¶_sp[8], ¶_sp[9], ¶_sp[10], - ¶_sp[11], ¶_sp[12], ¶_sp[13]); + kk = sscanf (line, " %le %le %le %le %le %le %le %le %le %le %le %le %le %le", ¶_sp[0], ¶_sp[1], ¶_sp[2], ¶_sp[3], ¶_sp[4], ¶_sp[5], + ¶_sp[6], ¶_sp[7], ¶_sp[8], ¶_sp[9], ¶_sp[10], ¶_sp[11], ¶_sp[12], ¶_sp[13]); /* a parameter of emission time distribuation */ - while( (fgets(line,linelength,fp) != NULL) && (strchr(line,'#') != NULL) ){ - printf("%s",line); + while ((fgets (line, linelength, fp) != NULL) && (strchr (line, '#') != NULL)) { + printf ("%s", line); } - kk=sscanf(line," %le %le %le %le %le %le %le %le %le %le", ¶_a[0], ¶_a[1], ¶_a[2], - ¶_a[3], ¶_a[4], ¶_a[5], ¶_a[6], ¶_a[7], ¶_a[8], ¶_a[9]); - if(kk!=10) { - printf("para_a: insufficient number of data entries read\n"); - _ABORT(); + kk = sscanf (line, " %le %le %le %le %le %le %le %le %le %le", ¶_a[0], ¶_a[1], ¶_a[2], ¶_a[3], ¶_a[4], ¶_a[5], ¶_a[6], ¶_a[7], + ¶_a[8], ¶_a[9]); + if (kk != 10) { + printf ("para_a: insufficient number of data entries read\n"); + _ABORT (); } /* b parameter of emission time distribuation */ - while((fgets(line,linelength,fp)!=NULL)&&(strchr(line,'#')!=NULL)){ - printf("%s",line); + while ((fgets (line, linelength, fp) != NULL) && (strchr (line, '#') != NULL)) { + printf ("%s", line); } - kk=sscanf(line," %le %le %le %le %le %le %le %le %le %le", ¶_b[0], ¶_b[1], ¶_b[2], - ¶_b[3], ¶_b[4], ¶_b[5], ¶_b[6], ¶_b[7], ¶_b[8], ¶_b[9]); - if(kk!=10) { - printf("para_b: insufficient number of data entries read\n"); - _ABORT(); + kk = sscanf (line, " %le %le %le %le %le %le %le %le %le %le", ¶_b[0], ¶_b[1], ¶_b[2], ¶_b[3], ¶_b[4], ¶_b[5], ¶_b[6], ¶_b[7], + ¶_b[8], ¶_b[9]); + if (kk != 10) { + printf ("para_b: insufficient number of data entries read\n"); + _ABORT (); } /* R parameter of emission time distribuation */ - while((fgets(line,linelength,fp)!=NULL)&&(strchr(line,'#')!=NULL)){ - printf("%s",line); + while ((fgets (line, linelength, fp) != NULL) && (strchr (line, '#') != NULL)) { + printf ("%s", line); } - kk=sscanf(line," %le %le %le %le %le %le %le %le %le %le", ¶_R[0], ¶_R[1], ¶_R[2], - ¶_R[3], ¶_R[4], ¶_R[5], ¶_R[6], ¶_R[7], ¶_R[8], ¶_R[9]); - if(kk!=10) { - printf("para_R: kk=%d insufficient number of data entries read\n", kk); - _ABORT(); + kk = sscanf (line, " %le %le %le %le %le %le %le %le %le %le", ¶_R[0], ¶_R[1], ¶_R[2], ¶_R[3], ¶_R[4], ¶_R[5], ¶_R[6], ¶_R[7], + ¶_R[8], ¶_R[9]); + if (kk != 10) { + printf ("para_R: kk=%d insufficient number of data entries read\n", kk); + _ABORT (); } /* to parameter of emission time distribuation */ - while((fgets(line,linelength,fp)!=NULL)&&(strchr(line,'#')!=NULL)){ - printf("%s",line); + while ((fgets (line, linelength, fp) != NULL) && (strchr (line, '#') != NULL)) { + printf ("%s", line); } - kk=sscanf(line," %le %le %le %le %le %le %le %le %le %le", ¶_to[0], ¶_to[1], ¶_to[2], - ¶_to[3], ¶_to[4], ¶_to[5], ¶_to[6], ¶_to[7], ¶_to[8], ¶_to[9]); - if(kk!=10) { - printf("para_R: insufficient number of data entries read\n"); - _ABORT(); + kk = sscanf (line, " %le %le %le %le %le %le %le %le %le %le", ¶_to[0], ¶_to[1], ¶_to[2], ¶_to[3], ¶_to[4], ¶_to[5], ¶_to[6], + ¶_to[7], ¶_to[8], ¶_to[9]); + if (kk != 10) { + printf ("para_R: insufficient number of data entries read\n"); + _ABORT (); } - printf("\n"); - for(k=0; k<14; k++){ - printf(" para_sp(%d)=%e\n",k,para_sp[k]); + printf ("\n"); + for (k = 0; k < 14; k++) { + printf (" para_sp(%d)=%e\n", k, para_sp[k]); } - printf("\n"); - for(k=0; k<10; k++){ - printf(" para_a(%d)=%e\n",k,para_a[k]); + printf ("\n"); + for (k = 0; k < 10; k++) { + printf (" para_a(%d)=%e\n", k, para_a[k]); } - printf("\n"); - for(k=0; k<10; k++){ - printf(" para_b(%d)=%e\n",k,para_b[k]); + printf ("\n"); + for (k = 0; k < 10; k++) { + printf (" para_b(%d)=%e\n", k, para_b[k]); } - printf("\n"); - for(k=0; k<8; k++){ - printf(" para_R(%d)=%e\n",k,para_R[k]); + printf ("\n"); + for (k = 0; k < 8; k++) { + printf (" para_R(%d)=%e\n", k, para_R[k]); } - printf("\n"); - for(k=0; k<10; k++){ - printf(" para_to(%d)=%e\n",k,para_to[k]); + printf ("\n"); + for (k = 0; k < 10; k++) { + printf (" para_to(%d)=%e\n", k, para_to[k]); } - if(sample_E==0) { - CItot = prepare_cumulative_spectral_function ( csfE, Emin, Emax, para_sp ); - if(CItot<=0.0) { - printf(" choice of Emin and Emax gives zero neutron intensity\n"); - _ABORT(); + if (sample_E == 0) { + CItot = prepare_cumulative_spectral_function (csfE, Emin, Emax, para_sp); + if (CItot <= 0.0) { + printf (" choice of Emin and Emax gives zero neutron intensity\n"); + _ABORT (); } // for(i=0;i<=1000;i++){ // printf("E-%d = %12.4e\n", i, csfE[i]); // } } -/* some checks */ - if(dist<=0.0) { - printf(" dist must be greater zero\n"); - _ABORT(); - } - else if(focus_xw<=0.0) { - printf(" focus_xw must be greater zero\n"); - _ABORT(); - } - else if(focus_yh<=0.0) { - printf(" focus_yh must be greater zero\n"); - _ABORT(); - } - else if(p_power<=0) { - printf(" p_power must be greater zero\n"); - _ABORT(); - } - else if(n_pulses<=0) { - printf(" n_pulses must be greater zero\n"); - _ABORT(); + /* some checks */ + if (dist <= 0.0) { + printf (" dist must be greater zero\n"); + _ABORT (); + } else if (focus_xw <= 0.0) { + printf (" focus_xw must be greater zero\n"); + _ABORT (); + } else if (focus_yh <= 0.0) { + printf (" focus_yh must be greater zero\n"); + _ABORT (); + } else if (p_power <= 0) { + printf (" p_power must be greater zero\n"); + _ABORT (); + } else if (n_pulses <= 0) { + printf (" n_pulses must be greater zero\n"); + _ABORT (); } -/* Normalization */ + /* Normalization */ // Calculate solid Angle - p_in = focus_xw*focus_yh/(dist*dist); + p_in = focus_xw * focus_yh / (dist * dist); // Normalize to viewed area - p_in *= xwidth*yheight/0.1/0.12; + p_in *= xwidth * yheight / 0.1 / 0.12; // Normalize to proton power - p_in *= p_power/2.0; + p_in *= p_power / 2.0; // Normalize to number of pulses p_in *= n_pulses; -/* constants for conversion into wavelength and lethargy units */ - CL = (1.0/sqrt(Emin*1e-3)-1.0/sqrt(Emax*1e-3))/(Emax-Emin)*1e3; - CU = (log(Emax*1e-3)-log(Emin*1e-3))/(Emax-Emin)*1e3; + /* constants for conversion into wavelength and lethargy units */ + CL = (1.0 / sqrt (Emin * 1e-3) - 1.0 / sqrt (Emax * 1e-3)) / (Emax - Emin) * 1e3; + CU = (log (Emax * 1e-3) - log (Emin * 1e-3)) / (Emax - Emin) * 1e3; #ifdef USE_MPI p_in /= mpi_node_count; #endif - p_in /= mcget_ncount(); + p_in /= mcget_ncount (); %} TRACE %{ - double theta,phi,v,E,Eval,tval; - double hdivmin,hdivmax,vdivmin,vdivmax; + double theta, phi, v, E, Eval, tval; + double hdivmin, hdivmax, vdivmin, vdivmax; double p_E, p_t, para_t[4], p_sa, randd, ttmin, ttmax; int i; - p=p_in; - z=0; - x = (rand01()-0.5)*xwidth; /* choose points uniformly distributed on the source */ - y = (rand01()-0.5)*yheight; - hdivmax=atan((focus_xw/2.0-x)/dist); - hdivmin=atan(-(focus_xw/2.0+x)/dist); - vdivmax=atan((focus_yh/2.0-y)/dist); - vdivmin=atan(-(focus_yh/2.0+y)/dist); - theta = hdivmin + (hdivmax-hdivmin)*rand01(); /* Small angle approx. */ - phi = vdivmin + (vdivmax-vdivmin)*rand01(); - hdiv=theta; - vdiv=phi; + p = p_in; + z = 0; + x = (rand01 () - 0.5) * xwidth; /* choose points uniformly distributed on the source */ + y = (rand01 () - 0.5) * yheight; + hdivmax = atan ((focus_xw / 2.0 - x) / dist); + hdivmin = atan (-(focus_xw / 2.0 + x) / dist); + vdivmax = atan ((focus_yh / 2.0 - y) / dist); + vdivmin = atan (-(focus_yh / 2.0 + y) / dist); + theta = hdivmin + (hdivmax - hdivmin) * rand01 (); /* Small angle approx. */ + phi = vdivmin + (vdivmax - vdivmin) * rand01 (); + hdiv = theta; + vdiv = phi; /* find E value corresponding to randomly in E range sample_E=0 draws uniformly from probability distribution @@ -961,38 +957,34 @@ TRACE sample_E=2 draws uniformly from wavelength range sample_E=3 draws uniformly from lethargy range */ - if(sample_E==0) { - randd = rand01(); - i = randd*1e3; - Eval = csfE[i] + (csfE[i+1]-csfE[i])*(randd*1e3-i); + if (sample_E == 0) { + randd = rand01 (); + i = randd * 1e3; + Eval = csfE[i] + (csfE[i + 1] - csfE[i]) * (randd * 1e3 - i); p_sa = 1.0; p_E = CItot; - } - else if(sample_E==1){ - Eval=(Emin+(Emax-Emin)*rand01())*1e-3; + } else if (sample_E == 1) { + Eval = (Emin + (Emax - Emin) * rand01 ()) * 1e-3; p_sa = 1.0; - p_E = spectral_function(para_sp, Eval) * (Emax-Emin)*1e-3; - } - else if(sample_E==2) { - Eval = pow(1.0/(1.0/sqrt(Emax) +(1.0/sqrt(Emin)-1.0/sqrt(Emax))*rand01()),2)*1e-3; - p_sa = CL*2.0*pow(Eval,1.5); - p_E = spectral_function(para_sp, Eval) * (Emax-Emin)*1e-3; - } - else if(sample_E==3) { - Eval = exp(log(Emin) +(log(Emax)-log(Emin))*rand01())*1e-3; - p_sa = CU*Eval; - p_E = spectral_function(para_sp, Eval) * (Emax-Emin)*1e-3; - } - else { - printf("sample_E allows only values 0, 1, 2 or 3!\n"); - _ABORT(); + p_E = spectral_function (para_sp, Eval) * (Emax - Emin) * 1e-3; + } else if (sample_E == 2) { + Eval = pow (1.0 / (1.0 / sqrt (Emax) + (1.0 / sqrt (Emin) - 1.0 / sqrt (Emax)) * rand01 ()), 2) * 1e-3; + p_sa = CL * 2.0 * pow (Eval, 1.5); + p_E = spectral_function (para_sp, Eval) * (Emax - Emin) * 1e-3; + } else if (sample_E == 3) { + Eval = exp (log (Emin) + (log (Emax) - log (Emin)) * rand01 ()) * 1e-3; + p_sa = CU * Eval; + p_E = spectral_function (para_sp, Eval) * (Emax - Emin) * 1e-3; + } else { + printf ("sample_E allows only values 0, 1, 2 or 3!\n"); + _ABORT (); } /* determine tval from emisstime distribution */ - para_t[0] = pade_function(para_a, Eval); - para_t[1] = pade_function(para_b, Eval); - para_t[2] = pade_function(para_R, Eval); - para_t[3] = pade_function(para_to, Eval); + para_t[0] = pade_function (para_a, Eval); + para_t[1] = pade_function (para_b, Eval); + para_t[2] = pade_function (para_R, Eval); + para_t[3] = pade_function (para_to, Eval); // printf("para1=%f para_b=%f para_R=%f para_to=%f\n", para_t[0], para_t[1], para_t[2], para_t[3]); /* find t value corresponding to random probability @@ -1001,57 +993,69 @@ TRACE from interval [0,20/beta+proton_T] for long-pulse */ - if(sample_t==0) { - randd = rand01(); - if(proton_T<=0.0) { - ttmax = 20.0/para_t[1]+para_t[3]*10.; - if(ttmax>tinmax) {ttmax=tinmax;} - ttmin = para_t[3]*10.; - if(tinmin>ttmin) {ttmin = tinmin;} + if (sample_t == 0) { + randd = rand01 (); + if (proton_T <= 0.0) { + ttmax = 20.0 / para_t[1] + para_t[3] * 10.; + if (ttmax > tinmax) { + ttmax = tinmax; + } + ttmin = para_t[3] * 10.; + if (tinmin > ttmin) { + ttmin = tinmin; + } tval = sample_t_from_f_sp (para_t, ttmin, ttmax, randd, &p_t); - } - else { - ttmax = proton_T+20.0/para_t[1]+para_t[3]*10.; - if(ttmax>tinmax) {ttmax=tinmax;} - ttmin = para_t[3]*10.; - if(tinmin>ttmin) {ttmin = tinmin;} + } else { + ttmax = proton_T + 20.0 / para_t[1] + para_t[3] * 10.; + if (ttmax > tinmax) { + ttmax = tinmax; + } + ttmin = para_t[3] * 10.; + if (tinmin > ttmin) { + ttmin = tinmin; + } tval = sample_t_from_f_lp (para_t, Eval, ttmin, ttmax, proton_T, randd, &p_t); } - } - else if(sample_t==1) { - if(proton_T<=0.0) { - ttmax = 20.0/para_t[1]+para_t[3]*10.; - if(tinmaxttmin) {ttmin = tinmin;} - tval=ttmin+(ttmax-tinmin)*rand01(); - p_t = f_sp(para_t, tval); - } - else { - ttmax = proton_T+20.0/para_t[1]+para_t[3]*10.; - if(tinmaxttmin) {ttmin = tinmin;} - tval=ttmin+(ttmax-ttmin)*rand01(); - p_t = f_lp(para_t, tval, proton_T); + } else if (sample_t == 1) { + if (proton_T <= 0.0) { + ttmax = 20.0 / para_t[1] + para_t[3] * 10.; + if (tinmax < ttmax) { + ttmax = tinmax; + } + ttmin = para_t[3] * 10.; + if (tinmin > ttmin) { + ttmin = tinmin; + } + tval = ttmin + (ttmax - tinmin) * rand01 (); + p_t = f_sp (para_t, tval); + } else { + ttmax = proton_T + 20.0 / para_t[1] + para_t[3] * 10.; + if (tinmax < ttmax) { + ttmax = tinmax; + } + ttmin = para_t[3] * 10.; + if (tinmin > ttmin) { + ttmin = tinmin; + } + tval = ttmin + (ttmax - ttmin) * rand01 (); + p_t = f_lp (para_t, tval, proton_T); } - p_t *= (ttmax-ttmin); - } - else { - printf("sample_t allows only values 0 or 1!\n"); + p_t *= (ttmax - ttmin); + } else { + printf ("sample_t allows only values 0 or 1!\n"); } - E = Eval*1000.0; /* Convert Energy from eV to meV */ - t = tval*1e-6; /* Convert time from mus to S */ - v = SE2V*sqrt(E); + E = Eval * 1000.0; /* Convert Energy from eV to meV */ + t = tval * 1e-6; /* Convert time from mus to S */ + v = SE2V * sqrt (E); /* Calculate components of velocity vector such that the neutron is within the focusing rectangle */ - vz = v*cos(phi)*cos(theta); /* Small angle approx. */ - vy = v*sin(phi); - vx = v*cos(phi)*sin(theta); + vz = v * cos (phi) * cos (theta); /* Small angle approx. */ + vy = v * sin (phi); + vx = v * cos (phi) * sin (theta); - p*=p_E*p_sa*p_t; + p *= p_E * p_sa * p_t; - //printf("Eval=%e tval=%e p_E=%e p_t=%e p_sa=%e p=%e\n", Eval, tval, p_E, p_t, p_sa, p); + // printf("Eval=%e tval=%e p_E=%e p_t=%e p_sa=%e p=%e\n", Eval, tval, p_E, p_t, p_sa, p); %} @@ -1063,9 +1067,12 @@ FINALLY MCDISPLAY %{ - double x1,y1,x2,y2; - x1=-xwidth/2.0;y1=-yheight/2.0;x2=xwidth/2.0;y2=yheight/2.0; - multiline(4,(double)x1,(double)y1,0.0,(double)x1,(double)y2,0.0,(double)x2,(double)y2,0.0,(double)x2,(double)y1,0.0,(double)x1,(double)y1,0.0); + double x1, y1, x2, y2; + x1 = -xwidth / 2.0; + y1 = -yheight / 2.0; + x2 = xwidth / 2.0; + y2 = yheight / 2.0; + multiline (4, (double)x1, (double)y1, 0.0, (double)x1, (double)y2, 0.0, (double)x2, (double)y2, 0.0, (double)x2, (double)y1, 0.0, (double)x1, (double)y1, 0.0); %} END diff --git a/mcstas-comps/contrib/Sans_liposomes_new.comp b/mcstas-comps/contrib/Sans_liposomes_new.comp index 15bc5a268..998898137 100644 --- a/mcstas-comps/contrib/Sans_liposomes_new.comp +++ b/mcstas-comps/contrib/Sans_liposomes_new.comp @@ -66,17 +66,17 @@ DECLARE %} INITIALIZE %{ - if (!xwidth || !yheight || !zthick) { - exit(fprintf(stderr,"Sans_spheres: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - if (qmax) printf("Sans_spheres: %s: Parameter qmax is not used anymore. Ignoring.\n", NAME_CURRENT_COMP); - } + if (!xwidth || !yheight || !zthick) { + exit (fprintf (stderr, "Sans_spheres: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + if (qmax) + printf ("Sans_spheres: %s: Parameter qmax is not used anymore. Ignoring.\n", NAME_CURRENT_COMP); + } - my_a_v = sigma_a*2200*100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ + my_a_v = sigma_a * 2200 * 100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ /*my_s_pre = Phi * 4*PI*R*R*R/3 * Delta_rho*Delta_rho;*/ - /* my_s_pre = 1;*/ - + /* my_s_pre = 1;*/ %} TRACE %{ @@ -94,59 +94,58 @@ TRACE double aim_x, aim_y, aim_z, axis_x, axis_y, axis_z; double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; double f, solid_angle, vx_i, vy_i, vz_i, qx, qy, qz; - char intersect=0; - - Ro=R+randnorm()*dR; - Ri = Ro-dbilayer; /* Calculate inner radius of liposphere */ - if(dbilayer==R) - Ri=0; /* Treat sample as solid spheres */ - Vi = 4/3*PI*Ri*Ri*Ri; - Vo = 4/3*PI*Ro*Ro*Ro; - my_s_pre = Phi * (Vo-Vi) * Delta_rho*Delta_rho; - - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - if(intersect) - { - if(t0 < 0) + char intersect = 0; + + Ro = R + randnorm () * dR; + Ri = Ro - dbilayer; /* Calculate inner radius of liposphere */ + if (dbilayer == R) + Ri = 0; /* Treat sample as solid spheres */ + Vi = 4 / 3 * PI * Ri * Ri * Ri; + Vo = 4 / 3 * PI * Ro * Ro * Ro; + my_s_pre = Phi * (Vo - Vi) * Delta_rho * Delta_rho; + + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (intersect) { + if (t0 < 0) ABSORB; /* Neutron enters at t=t0. */ - v = sqrt(vx*vx + vy*vy + vz*vz); - l_full = v * (t1 - t0); /* Length of full path through sample */ - dt = rand01()*(t1 - t0) + t0; /* Time of scattering */ - PROP_DT(dt); /* Point of scattering */ - l = v*(dt-t0); /* Penetration in sample */ - - vx_i=vx; - vy_i=vy; - vz_i=vz; - randvec_target_circle(&vx, &vy, &vz, &solid_angle, 0, 0, dist, Rdet); -/* printf("solid angle %g \n",solid_angle); */ - NORM(vx, vy, vz); + v = sqrt (vx * vx + vy * vy + vz * vz); + l_full = v * (t1 - t0); /* Length of full path through sample */ + dt = rand01 () * (t1 - t0) + t0; /* Time of scattering */ + PROP_DT (dt); /* Point of scattering */ + l = v * (dt - t0); /* Penetration in sample */ + + vx_i = vx; + vy_i = vy; + vz_i = vz; + randvec_target_circle (&vx, &vy, &vz, &solid_angle, 0, 0, dist, Rdet); + /* printf("solid angle %g \n",solid_angle); */ + NORM (vx, vy, vz); vx *= v; vy *= v; vz *= v; - qx = V2K*(vx_i-vx); - qy = V2K*(vy_i-vy); - qz = V2K*(vz_i-vz); - q = sqrt(qx*qx+qy*qy+qz*qz); + qx = V2K * (vx_i - vx); + qy = V2K * (vy_i - vy); + qz = V2K * (vz_i - vz); + q = sqrt (qx * qx + qy * qy + qz * qz); /* f = 3 * (sin(q*R) - q*R*cos(q*R))/(q*R*q*R*q*R);*/ - - fo = 3*(sin(q*Ro) - q*Ro*cos(q*Ro))/(q*Ro*q*Ro*q*Ro); - -if(Ri<=0) - fi = 0; -else - fi = 3*(sin(q*Ri) - q*Ri*cos(q*Ri))/(q*Ri*q*Ri*q*Ri); - - f= (Vo*fo-Vi*fi)/(Vo-Vi); - - if(!box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick)) fprintf(stderr, "Sans_spheres: FATAL ERROR: Did not hit box from inside.\n"); - - - l_1 = v*t1; -/* fprintf(stderr, "l_full: %g, qmax: %g p: %g my_s_pre: %g, f: %g, my_a_v/v: %g\n",l_full,qmax,p,my_s_pre,f,my_a_v/v);*/ - p *= l_full*solid_angle/(4*PI)*my_s_pre*f*f*exp(-my_a_v*(l+l_1)/v); + + fo = 3 * (sin (q * Ro) - q * Ro * cos (q * Ro)) / (q * Ro * q * Ro * q * Ro); + + if (Ri <= 0) + fi = 0; + else + fi = 3 * (sin (q * Ri) - q * Ri * cos (q * Ri)) / (q * Ri * q * Ri * q * Ri); + + f = (Vo * fo - Vi * fi) / (Vo - Vi); + + if (!box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick)) + fprintf (stderr, "Sans_spheres: FATAL ERROR: Did not hit box from inside.\n"); + + l_1 = v * t1; + /* fprintf(stderr, "l_full: %g, qmax: %g p: %g my_s_pre: %g, f: %g, my_a_v/v: %g\n",l_full,qmax,p,my_s_pre,f,my_a_v/v);*/ + p *= l_full * solid_angle / (4 * PI) * my_s_pre * f * f * exp (-my_a_v * (l + l_1) / v); SCATTER; } %} @@ -155,29 +154,20 @@ MCDISPLAY %{ double radius = 0; double h = 0; - magnify("xyz"); + magnify ("xyz"); { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zthick; - double zmax = 0.5*zthick; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zthick; + double zmax = 0.5 * zthick; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } - %} END diff --git a/mcstas-comps/contrib/Sapphire_Filter.comp b/mcstas-comps/contrib/Sapphire_Filter.comp index dd35ad623..1551d6ff0 100755 --- a/mcstas-comps/contrib/Sapphire_Filter.comp +++ b/mcstas-comps/contrib/Sapphire_Filter.comp @@ -54,35 +54,30 @@ SETTING PARAMETERS (xmin=-0.16, xmax=0.16, ymin=-0.16, ymax=0.16, len=0.1,A=0.81 TRACE %{ - double L,L2,Filt_T; + double L, L2, Filt_T; double dt; PROP_Z0; - L = (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); - if (xxmax || yymax) ABSORB; - dt = len/vz; - PROP_DT(dt); - L2=L*L; - Filt_T=(A*L+C*(1-exp(-B/L2-D/L2/L2))); - Filt_T = exp(-Filt_T*len); - p*=Filt_T; + L = (2 * PI / V2K) / sqrt (vx * vx + vy * vy + vz * vz); + if (x < xmin || x > xmax || y < ymin || y > ymax) + ABSORB; + dt = len / vz; + PROP_DT (dt); + L2 = L * L; + Filt_T = (A * L + C * (1 - exp (-B / L2 - D / L2 / L2))); + Filt_T = exp (-Filt_T * len); + p *= Filt_T; %} MCDISPLAY %{ - - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); - multiline(5, (double)xmin, (double)ymin, (double)len, - (double)xmax, (double)ymin, (double)len, - (double)xmax, (double)ymax, (double)len, - (double)xmin, (double)ymax, (double)len, - (double)xmin, (double)ymin, (double)len); - line(xmin, ymin, 0.0, xmin, ymin, len); - line(xmax, ymin, 0.0, xmax, ymin, len); - line(xmin, ymax, 0.0, xmin, ymax, len); - line(xmax, ymax, 0.0 , xmax, ymax, len); + + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); + multiline (5, (double)xmin, (double)ymin, (double)len, (double)xmax, (double)ymin, (double)len, (double)xmax, (double)ymax, (double)len, (double)xmin, + (double)ymax, (double)len, (double)xmin, (double)ymin, (double)len); + line (xmin, ymin, 0.0, xmin, ymin, len); + line (xmax, ymin, 0.0, xmax, ymin, len); + line (xmin, ymax, 0.0, xmin, ymax, len); + line (xmax, ymax, 0.0, xmax, ymax, len); %} END diff --git a/mcstas-comps/contrib/SiC.comp b/mcstas-comps/contrib/SiC.comp index 3088874e9..8df610bab 100644 --- a/mcstas-comps/contrib/SiC.comp +++ b/mcstas-comps/contrib/SiC.comp @@ -47,8 +47,8 @@ INITIALIZE for (i = 0; i < 85; ++i) ScatGrad[i] = 0; - ScatGrad[1]=7.3106e-6; - ScatGrad[81]=2.073e-6-7.3106e-6; + ScatGrad[1] = 7.3106e-6; + ScatGrad[81] = 2.073e-6 - 7.3106e-6; %} TRACE @@ -56,48 +56,42 @@ TRACE double dt, q; /* Variables added for Rayleigh Appproximation. */ - double realZ,imagZ; - double csZ,snZ,Qc,R0; - int i,Z,q_count; + double realZ, imagZ; + double csZ, snZ, Qc, R0; + int i, Z, q_count; - Qc=0.010208; - R0=1.0; + Qc = 0.010208; + R0 = 1.0; /* First check if neutron has the right direction. */ - if(vz != 0.0 && (dt = -z/vz) >= 0) - { + if (vz != 0.0 && (dt = -z / vz) >= 0) { double old_x = x, old_y = y; - x += vx*dt; - y += vy*dt; + x += vx * dt; + y += vy * dt; /* Now check if neutron intersects mirror. */ - if(x >= 0 && x <= xlength && y >= 0 && y <= yheight) - { + if (x >= 0 && x <= xlength && y >= 0 && y <= yheight) { z = 0; t += dt; - q = fabs(2*vz*V2Q); + q = fabs (2 * vz * V2Q); vz = -vz; /* Reflectivity (see component Guide). - Changed to calculate from real sample. */ + Changed to calculate from real sample. */ - if(q > Qc) - { + if (q > Qc) { realZ = 0; imagZ = 0; - for (Z = 0; Z < 85; Z++) - { - csZ = cos(-1.*q*Z); - snZ = sin(-1.*q*Z); + for (Z = 0; Z < 85; Z++) { + csZ = cos (-1. * q * Z); + snZ = sin (-1. * q * Z); realZ = realZ + ScatGrad[Z] * csZ; imagZ = imagZ + ScatGrad[Z] * snZ; - } - p *=16.*PI*PI*((realZ*realZ)+(imagZ*imagZ))/(q*q*q*q); + } + p *= 16. * PI * PI * ((realZ * realZ) + (imagZ * imagZ)) / (q * q * q * q); } p *= R0; SCATTER; - } - else - { + } else { x = old_x; y = old_y; } diff --git a/mcstas-comps/contrib/Single_crystal_inelastic.comp b/mcstas-comps/contrib/Single_crystal_inelastic.comp index 882baa78d..2733ca176 100644 --- a/mcstas-comps/contrib/Single_crystal_inelastic.comp +++ b/mcstas-comps/contrib/Single_crystal_inelastic.comp @@ -122,291 +122,310 @@ SHARE /* used for reading data table from file */ %include "read_table-lib" %include "interoff-lib" -/* Declare structures and functions only once in each instrument. */ -#ifndef SINGLE_CRYSTAL_DECL -#define SINGLE_CRYSTAL_DECL - - struct hkl_data - { - double h,k,l,en; /* Indices for this reflection */ - double SQW; /* Value of scattering function */ - double qx, qy, qz; /* Coordinates in Cartesian reciprocal space */ - double qmod; /* Length of (qx, qy, qz) */ - double chki; /* |Q|+(2m/hbar^2)*E/|Q| - should be less than 2ki to satisfy conservation */ - }; - - struct hkl_store - { - double kx,ky,kz; /* Momentum direction (in crystal) for this ki */ - int *hkl; /* Indices into hkl_data *list */ - double *CDF; /* Cumulative distribution function */ - int nhkl; /* Number of hkl,en points accessible from this ki */ - }; - - struct hkl_info_struct - { - struct hkl_data *list; /* Reflection array */ - int count; /* Number of reflections */ - 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 aix,aiy,aiz; /* First reciprocal lattice axis (1/AA) */ - double bix,biy,biz; /* Second reciprocal lattice axis */ - double cix,ciy,ciz; /* 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 is_sorted; /* S(Q,w) is sorted first by en, then by |Q| in that order */ - double *SwCDF; /* Cumulative dist. func. of S(|Q|) for inv. transform sampling */ - int nSw; /* Number of points in CDF */ - int **SwQi; - int *nQ; /* Number of q-points at each energy */ - double *SqwCDF; /* Cumulative dist. func. of S(E) at particular values of |Q| */ - int *iSqwCDF; /* Index into CDF of S(E) */ - int maxecount; /* Maximum number of E-slice for each |Q| */ - struct hkl_store *stored; /* Stored list of allowed hkl for particular ki vector */ - int stored_ki_max; /* Maximum number of saved hkl/ki to store */ - int last_stored; /* Index of the last hkl/ki list computed */ - double *badx,*bady,*badz; /* kx,ky,kz of bad ki which cannot satisfy any E(hkl) */ - int nbad; /* Number of bad ki's found */ - int nextbad; - int maxbad; - }; + /* Declare structures and functions only once in each instrument. */ + #ifndef SINGLE_CRYSTAL_DECL + #define SINGLE_CRYSTAL_DECL + + struct hkl_data { + double h, k, l, en; /* Indices for this reflection */ + double SQW; /* Value of scattering function */ + double qx, qy, qz; /* Coordinates in Cartesian reciprocal space */ + double qmod; /* Length of (qx, qy, qz) */ + double chki; /* |Q|+(2m/hbar^2)*E/|Q| - should be less than 2ki to satisfy conservation */ + }; + + struct hkl_store { + double kx, ky, kz; /* Momentum direction (in crystal) for this ki */ + int* hkl; /* Indices into hkl_data *list */ + double* CDF; /* Cumulative distribution function */ + int nhkl; /* Number of hkl,en points accessible from this ki */ + }; + + struct hkl_info_struct { + struct hkl_data* list; /* Reflection array */ + int count; /* Number of reflections */ + 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 aix, aiy, aiz; /* First reciprocal lattice axis (1/AA) */ + double bix, biy, biz; /* Second reciprocal lattice axis */ + double cix, ciy, ciz; /* 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 is_sorted; /* S(Q,w) is sorted first by en, then by |Q| in that order */ + double* SwCDF; /* Cumulative dist. func. of S(|Q|) for inv. transform sampling */ + int nSw; /* Number of points in CDF */ + int** SwQi; + int* nQ; /* Number of q-points at each energy */ + double* SqwCDF; /* Cumulative dist. func. of S(E) at particular values of |Q| */ + int* iSqwCDF; /* Index into CDF of S(E) */ + int maxecount; /* Maximum number of E-slice for each |Q| */ + struct hkl_store* stored; /* Stored list of allowed hkl for particular ki vector */ + int stored_ki_max; /* Maximum number of saved hkl/ki to store */ + int last_stored; /* Index of the last hkl/ki list computed */ + double *badx, *bady, *badz; /* kx,ky,kz of bad ki which cannot satisfy any E(hkl) */ + int nbad; /* Number of bad ki's found */ + int nextbad; + int maxbad; + }; /* Quicksort modified from public domain implementation by Darel Rex Finley. http://alienryderflex.com/quicksort/ */ void - quickSort(int *id, double *val, int elements) - { + quickSort (int* id, double* val, int elements) { #define MAX_LEVELS 300 double piv, lval, rval; - int beg[MAX_LEVELS], end[MAX_LEVELS], i=0, L, R, C, swap; - beg[0]=0; end[0]=elements; - while (i>=0) { - L=beg[i]; R=end[i]-1; - if (L=piv && L= 0) { + L = beg[i]; + R = end[i] - 1; + if (L < R) { + piv = val[id[L]]; + C = id[L]; + while (L < R) { + while (val[id[R]] >= piv && L < R) + R--; + if (L < R) + id[L++] = id[R]; + while (val[id[L]] <= piv && L < R) + L++; + if (L < R) + id[R--] = id[L]; } - id[L]=C; beg[i+1]=L+1; end[i+1]=end[i]; end[i++]=L; - if (end[i]-beg[i]>end[i-1]-beg[i-1]) - { - swap=beg[i]; beg[i]=beg[i-1]; beg[i-1]=swap; - swap=end[i]; end[i]=end[i-1]; end[i-1]=swap; + id[L] = C; + beg[i + 1] = L + 1; + end[i + 1] = end[i]; + end[i++] = L; + if (end[i] - beg[i] > end[i - 1] - beg[i - 1]) { + swap = beg[i]; + beg[i] = beg[i - 1]; + beg[i - 1] = swap; + swap = end[i]; + end[i] = end[i - 1]; + end[i - 1] = swap; } - } - else i--; + } else + i--; } } int - read_hkl_data(char *SC_file, struct hkl_info_struct *info, - double SC_mosaic, double SC_mosaic_a, double SC_mosaic_b, double SC_mosaic_c, double *SC_mosaic_AB, double qwidth) - { - struct hkl_data *list = NULL; + read_hkl_data (char* SC_file, struct hkl_info_struct* info, double SC_mosaic, double SC_mosaic_a, double SC_mosaic_b, double SC_mosaic_c, double* SC_mosaic_AB, + double qwidth) { + struct hkl_data* list = NULL; int size = 0; t_Table sTable; /* sample data table structure from SC_file */ - int i=0; + int i = 0; double tmp_x, tmp_y, tmp_z; - char **parsing; - char flag=0; - double nb_atoms=1; + char** parsing; + char flag = 0; + double nb_atoms = 1; info->is_sorted = 0; - FILE *index; + FILE* index; - if (!SC_file || !strlen(SC_file) || !strcmp(SC_file,"NULL") || !strcmp(SC_file,"0")) { + if (!SC_file || !strlen (SC_file) || !strcmp (SC_file, "NULL") || !strcmp (SC_file, "0")) { info->count = 0; - flag=1; + flag = 1; } if (!flag) { - Table_Read(&sTable, SC_file, 1); /* read 1st block data from SC_file into sTable*/ + Table_Read (&sTable, SC_file, 1); /* read 1st block data from SC_file into sTable*/ if (sTable.columns < 5) { - fprintf(stderr, "Single_crystal_inelastic: Error: The number of columns in %s should be at least %d for [h,k,l,en,S]\n", SC_file, 4); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error: The number of columns in %s should be at least %d for [h,k,l,en,S]\n", SC_file, 4); + return (0); } if (!sTable.rows) { - fprintf(stderr, "Single_crystal_inelastic: Error: The number of rows in %s should be at least %d\n", SC_file, 1); - return(0); - } else size = sTable.rows; + fprintf (stderr, "Single_crystal_inelastic: 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_E ", - "column_S ", - "Delta_d/d", - "lattice_a ", - "lattice_b ", - "lattice_c ", - "lattice_aa", - "lattice_bb", - "lattice_cc", - "nb_atoms", - "sorted", - NULL); + parsing = Table_ParseHeader (sTable.header, "sigma_abs", "sigma_a ", "sigma_inc", "sigma_i ", "column_h", "column_k", "column_l", "column_E ", "column_S ", + "Delta_d/d", "lattice_a ", "lattice_b ", "lattice_c ", "lattice_aa", "lattice_bb", "lattice_cc", "nb_atoms", "sorted", 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]) info->is_sorted=1; - for (i=0; i<=17; i++) if (parsing[i]) free(parsing[i]); - free(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]) + info->is_sorted = 1; + 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; } + 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; + 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; + 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; + 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; + 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_inelastic: Error:Wrong a lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: 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_inelastic: Error:Wrong b lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: 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_inelastic: Error:Wrong c lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: 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_inelastic: Error: Selecting reciprocal cell and angles is unmeaningful\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error: Selecting reciprocal cell and angles is unmeaningful\n"); + return (0); } - 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); + 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); // Single crystal definition of B-matrix with z||b, x||cross(a,b), y||cross(x,z) [real-space] // [ 0, 0, sqrt( c*c*( 1-cos(beta)-[(cos(a)-cos(g)*cos(b))/sin(g)]**2 ) ] // [ b*sin(gamma), 0, c*(cos(alpha)-cos(gamma)*cos(beta))/sin(gamma) ] // [ b*cos(gamma), a, c*cos(beta) ] - 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_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); -/* - // Matlab definition of b-matrix with x||a*, z||cross(a*,b*), y||cross(x,z) [reciprocal space] - double ca = cos(info->m_aa*DEG2RAD), cb = cos(info->m_bb*DEG2RAD), cc = cos(info->m_cc*DEG2RAD); - double sa = sin(info->m_aa*DEG2RAD), sb = sin(info->m_bb*DEG2RAD), sc = sin(info->m_cc*DEG2RAD); - double v = 1-ca*ca-cb*cb-cc*cc+2*ca*cb*cc; - if(v<0) { fprintf(stderr,"Unit cell parameters: alpha=%f,beta=%f,gamma=%f are not geometrically consistent.\n",info->m_aa,info->m_bb,info->m_cc); exit(-1); } - v = sqrt(v); - double ar = (2*PI/v)*(fabs(sa))/as, br = (2*PI/v)*(fabs(sb))/bs, cr = (2*PI/v)*(fabs(sc))/cs; - double r_aa = acos( (cb*cc-ca)/fabs(sb*sc) ), r_bb = acos( (cc*ca-cb)/fabs(sc*sa) ), r_cc = acos( (ca*cb-cc)/fabs(sa*sb) ); - info->m_ax = ar; info->m_bx = br*cos(r_cc); info->m_cx = cr*cos(r_bb); - info->m_ay = 0.; info->m_by = bs*sin(r_cc); info->m_cy = -cr*fabs(sin(r_bb))*cos(r_aa); - info->m_az = 0.; info->m_bz = 0.; info->m_cz = 2*PI/cs; - info->recip = 1; -*/ - printf("B-matrix = \n\t\t % 8.5g,% 8.5g,% 8.5g\n\t\t % 8.5g,% 8.5g,% 8.5g\n\t\t % 8.5g,% 8.5g,% 8.5g\n", - info->m_ax,info->m_bx,info->m_cx,info->m_ay,info->m_by,info->m_cy,info->m_az,info->m_bz,info->m_cz); - - printf("Single_crystal_inelastic: %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); + 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); + /* + // Matlab definition of b-matrix with x||a*, z||cross(a*,b*), y||cross(x,z) [reciprocal space] + double ca = cos(info->m_aa*DEG2RAD), cb = cos(info->m_bb*DEG2RAD), cc = cos(info->m_cc*DEG2RAD); + double sa = sin(info->m_aa*DEG2RAD), sb = sin(info->m_bb*DEG2RAD), sc = sin(info->m_cc*DEG2RAD); + double v = 1-ca*ca-cb*cb-cc*cc+2*ca*cb*cc; + if(v<0) { fprintf(stderr,"Unit cell parameters: alpha=%f,beta=%f,gamma=%f are not geometrically consistent.\n",info->m_aa,info->m_bb,info->m_cc); + exit(-1); } v = sqrt(v); double ar = (2*PI/v)*(fabs(sa))/as, br = (2*PI/v)*(fabs(sb))/bs, cr = (2*PI/v)*(fabs(sc))/cs; double r_aa = acos( + (cb*cc-ca)/fabs(sb*sc) ), r_bb = acos( (cc*ca-cb)/fabs(sc*sa) ), r_cc = acos( (ca*cb-cc)/fabs(sa*sb) ); info->m_ax = ar; info->m_bx = br*cos(r_cc); + info->m_cx = cr*cos(r_bb); info->m_ay = 0.; info->m_by = bs*sin(r_cc); info->m_cy = -cr*fabs(sin(r_bb))*cos(r_aa); info->m_az = 0.; info->m_bz = 0.; + info->m_cz = 2*PI/cs; info->recip = 1; + */ + printf ("B-matrix = \n\t\t % 8.5g,% 8.5g,% 8.5g\n\t\t % 8.5g,% 8.5g,% 8.5g\n\t\t % 8.5g,% 8.5g,% 8.5g\n", info->m_ax, info->m_bx, info->m_cx, info->m_ay, + info->m_by, info->m_cy, info->m_az, info->m_bz, info->m_cz); + + printf ("Single_crystal_inelastic: %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_inelastic: %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); + printf ("Single_crystal_inelastic: %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_inelastic: %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); + printf ("Single_crystal_inelastic: %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("rV0=%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; + 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 ("rV0=%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; @@ -418,64 +437,66 @@ SHARE 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); + 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; + 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 (flag) + return (-1); if (!info->column_order[0] || !info->column_order[1] || !info->column_order[2] || !info->column_order[3]) { - fprintf(stderr, - "Single_crystal_inelastic: Error:Wrong h,k,l,E column definition\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error:Wrong h,k,l,E column definition\n"); + return (0); } if (!info->column_order[4]) { - fprintf(stderr, - "Single_crystal_inelastic: Error:Wrong S(q,w) column definition\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error:Wrong S(q,w) column definition\n"); + return (0); } - + /* allocate hkl_data array */ - list = (struct hkl_data*)malloc(size*sizeof(struct hkl_data)); + list = (struct hkl_data*)malloc (size * sizeof (struct hkl_data)); /* Sorts the table, if not sorted by |Q| and energy */ - int *id = (int*)malloc(size*sizeof(int)); + int* id = (int*)malloc (size * sizeof (int)); double en, Qx, Qy, Qz, Qm, *vl; - vl = (double*)malloc(size*sizeof(double)); + vl = (double*)malloc (size * sizeof (double)); if (!list || !id || !vl) { - fprintf(stderr, - "Single_crystal_inelastic: Error allocating reflection / id lists or vl array\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error allocating reflection / id lists or vl array\n"); + return (0); } - double h, k, l, Emax=0, Qmax=0, Emul, Qmul; - for (i=0; icolumn_order[0]-1); - k = Table_Index(sTable, i, info->column_order[1]-1); - l = Table_Index(sTable, i, info->column_order[2]-1); - Qx = h*info->asx + k*info->bsx + l*info->csx; - Qy = h*info->asy + k*info->bsy + l*info->csy; - Qz = h*info->asz + k*info->bsz + l*info->csz; - Qm = sqrt(Qx*Qx+Qy*Qy+Qz*Qz); - en = Table_Index(sTable, i, info->column_order[3]-1); - id[i] = i; if(Qm>Qmax) Qmax=Qm; if(en>Emax) Emax=en; + double h, k, l, Emax = 0, Qmax = 0, Emul, Qmul; + for (i = 0; i < size; i++) { + 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); + Qx = h * info->asx + k * info->bsx + l * info->csx; + Qy = h * info->asy + k * info->bsy + l * info->csy; + Qz = h * info->asz + k * info->bsz + l * info->csz; + Qm = sqrt (Qx * Qx + Qy * Qy + Qz * Qz); + en = Table_Index (sTable, i, info->column_order[3] - 1); + id[i] = i; + if (Qm > Qmax) + Qmax = Qm; + if (en > Emax) + Emax = en; list[i].h = h; list[i].k = k; list[i].l = l; @@ -483,136 +504,161 @@ SHARE list[i].qy = Qy; list[i].qz = Qz; list[i].en = en; - list[i].SQW = Table_Index(sTable, i, info->column_order[4]-1); + list[i].SQW = Table_Index (sTable, i, info->column_order[4] - 1); list[i].qmod = Qm; - list[i].chki = (Qm + 0.4825966246*en/Qm)/2.; // |Q|+(2m/hbar^2)*E/|Q| <= 2|ki| to satisfy conservation. - if(i>0 && list[i].chkiis_sorted = 0; + list[i].chki = (Qm + 0.4825966246 * en / Qm) / 2.; // |Q|+(2m/hbar^2)*E/|Q| <= 2|ki| to satisfy conservation. + if (i > 0 && list[i].chki < list[i - 1].chki) + info->is_sorted = 0; } - if(!info->is_sorted) - { - printf("Sorting\n"); + if (!info->is_sorted) { + printf ("Sorting\n"); // Sorts by |Q|+(2m/hbar^2)*E/|Q| - if 2*|ki| > first entry, that neutron cannot scatter from the sample - for (i=0; iis_sorted ? i : id[i]; int iip = info->is_sorted ? i+1 : id[i+1]; - if(list[ii].SQW==0) continue; + int ecount = 0, maxecount = 0; + double oldQ = 0; + for (i = 0; i < size; i++) + Sw[i] = 0.; + for (i = 0; i < (size - 1); i++) { + int ii = info->is_sorted ? i : id[i]; + int iip = info->is_sorted ? i + 1 : id[i + 1]; + if (list[ii].SQW == 0) + continue; Sw[isw] += list[ii].SQW; SwQt[ecount++] = ii; - if(fabs(list[iip].chki-oldQ)>1e-8 || i==(size-1)) - { + if (fabs (list[iip].chki - oldQ) > 1e-8 || i == (size - 1)) { int ii2; - SwQi[isw] = (int*)malloc(ecount*sizeof(int)); + SwQi[isw] = (int*)malloc (ecount * sizeof (int)); nQ[isw] = ecount; - for(ii2=0; ii2maxecount) maxecount=ecount; - ecount=0; + if (ecount > maxecount) + maxecount = ecount; + ecount = 0; } } - printf("\n"); - double *SwCDF = (double*)malloc(isw*sizeof(double)); + printf ("\n"); + double* SwCDF = (double*)malloc (isw * sizeof (double)); if (!SwCDF) { - fprintf(stderr, - "Single_crystal_inelastic: Error allocating SwCDF array\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error allocating SwCDF array\n"); + return (0); } - SwCDF[0] = Sw[0]; for (i=1; iSwCDF = SwCDF; + SwCDF[0] = Sw[0]; + for (i = 1; i < isw; i++) { + SwCDF[i] = SwCDF[i - 1] + Sw[i]; + } + info->SwCDF = SwCDF; info->nSw = isw; - FILE *cdf = fopen("mcdisp_sqw.cdf","w"); + FILE* cdf = fopen ("mcdisp_sqw.cdf", "w"); if (!cdf) { - fprintf(stderr, - "Single_crystal_inelastic: Could not open 'mcdisp_sqw.cdf' in write mode!\n"); - exit(-1); + fprintf (stderr, "Single_crystal_inelastic: Could not open 'mcdisp_sqw.cdf' in write mode!\n"); + exit (-1); } int j; - for (i=0; iSwQi = SwQi; + for (i = 0; i < isw; i++) { + fprintf (cdf, "%f %f\n", list[SwQi[i][0]].chki, SwCDF[i]); + for (j = 0; j < nQ[i]; j++) + fprintf (cdf, "\t%f (%f %f %f, %f) %f\n", list[SwQi[i][j]].qmod, list[SwQi[i][j]].h, list[SwQi[i][j]].k, list[SwQi[i][j]].l, list[SwQi[i][j]].en, + list[SwQi[i][j]].SQW); + } + fclose (cdf); + info->SwQi = SwQi; info->nQ = nQ; - double *SqwCDF; SqwCDF = (double*)malloc(maxecount*sizeof(double)); info->SqwCDF = SqwCDF; - int *iSqwCDF; iSqwCDF= (int*)malloc(maxecount*sizeof(int)); info->iSqwCDF = iSqwCDF; + double* SqwCDF; + SqwCDF = (double*)malloc (maxecount * sizeof (double)); + info->SqwCDF = SqwCDF; + int* iSqwCDF; + iSqwCDF = (int*)malloc (maxecount * sizeof (int)); + info->iSqwCDF = iSqwCDF; if (!SqwCDF || !iSqwCDF) { - fprintf(stderr, - "Single_crystal_inelastic: Error allocating SqwCDF or iSqwCDF array\n"); - return(0); + fprintf (stderr, "Single_crystal_inelastic: Error allocating SqwCDF or iSqwCDF array\n"); + return (0); } info->maxecount = maxecount; - Table_Free(&sTable); - free(id); + Table_Free (&sTable); + free (id); info->list = list; - double a11,a12,a13,a21,a22,a23,a31,a32,a33; - a11 = info->asx; a12 = info->bsx; a13 = info->csx; - a21 = info->asy; a22 = info->bsy; a23 = info->csy; - a31 = info->asz; a32 = info->bsz; a33 = info->csz; - double deta = a11*a22*a33 - a11*a23*a32 - a12*a21*a33 + a12*a23*a31 + a13*a21*a32 - a13*a22*a31; - if(deta==0.) { printf("bad deta\n"); exit(-1); } - info->aix = (a22*a33-a23*a32)/deta; info->bix = (a13*a32-a12*a33)/deta; info->cix = (a12*a23-a13*a22)/deta; - info->aiy = (a23*a31-a21*a33)/deta; info->biy = (a11*a33-a13*a31)/deta; info->ciy = (a13*a21-a11*a23)/deta; - info->aiz = (a21*a32-a22*a31)/deta; info->biz = (a12*a31-a11*a32)/deta; info->ciz = (a11*a22-a12*a21)/deta; - - return(info->count = size); + double a11, a12, a13, a21, a22, a23, a31, a32, a33; + a11 = info->asx; + a12 = info->bsx; + a13 = info->csx; + a21 = info->asy; + a22 = info->bsy; + a23 = info->csy; + a31 = info->asz; + a32 = info->bsz; + a33 = info->csz; + double deta = a11 * a22 * a33 - a11 * a23 * a32 - a12 * a21 * a33 + a12 * a23 * a31 + a13 * a21 * a32 - a13 * a22 * a31; + if (deta == 0.) { + printf ("bad deta\n"); + exit (-1); + } + info->aix = (a22 * a33 - a23 * a32) / deta; + info->bix = (a13 * a32 - a12 * a33) / deta; + info->cix = (a12 * a23 - a13 * a22) / deta; + info->aiy = (a23 * a31 - a21 * a33) / deta; + info->biy = (a11 * a33 - a13 * a31) / deta; + info->ciy = (a13 * a21 - a11 * a23) / deta; + info->aiz = (a21 * a32 - a22 * a31) / deta; + info->biz = (a12 * a31 - a11 * a32) / deta; + info->ciz = (a11 * a22 - a12 * a21) / deta; + + return (info->count = size); } /* read_hkl_data */ -#endif /* !SINGLE_CRYSTAL_DECL */ - + #endif /* !SINGLE_CRYSTAL_DECL */ %} DECLARE %{ struct hkl_info_struct hkl_info; off_struct offdata; - FILE *hist; + FILE* hist; %} INITIALIZE %{ - hist = fopen("energies.hist","w"); + hist = fopen ("energies.hist", "w"); double as, bs, cs; /* transfer input parameters */ hkl_info.m_delta_d_d = delta_d_d; - hkl_info.m_a = 0; - hkl_info.m_b = 0; - hkl_info.m_c = 0; + hkl_info.m_a = 0; + hkl_info.m_b = 0; + hkl_info.m_c = 0; hkl_info.m_aa = aa; hkl_info.m_bb = bb; hkl_info.m_cc = cc; @@ -627,49 +673,54 @@ INITIALIZE hkl_info.m_cz = cz; hkl_info.sigma_a = sigma_abs; hkl_info.sigma_i = sigma_inc; - hkl_info.recip = recip_cell; + hkl_info.recip = recip_cell; /* default format h,k,l,en,S */ - hkl_info.column_order[0]=1; - hkl_info.column_order[1]=2; - hkl_info.column_order[2]=3; - hkl_info.column_order[3]=4; - hkl_info.column_order[4]=5; + hkl_info.column_order[0] = 1; + hkl_info.column_order[1] = 2; + hkl_info.column_order[2] = 3; + hkl_info.column_order[3] = 4; + hkl_info.column_order[4] = 5; /*this is necessary to allow a numerical array to be passed through as a DEFINITION parameter*/ - double* mosaic_ABin=mosaic_AB; + double* mosaic_ABin = mosaic_AB; /* Read in structure factors, and do some pre-calculations. */ - if (!read_hkl_data(sqw, &hkl_info, mosaic, mosaic_a, mosaic_b, mosaic_c, mosaic_ABin, qwidth)) - exit(-1); + if (!read_hkl_data (sqw, &hkl_info, mosaic, mosaic_a, mosaic_b, mosaic_c, mosaic_ABin, qwidth)) + exit (-1); - if (hkl_info.sigma_a<0) hkl_info.sigma_a=0; - if (hkl_info.sigma_i<0) hkl_info.sigma_i=0; + if (hkl_info.sigma_a < 0) + hkl_info.sigma_a = 0; + if (hkl_info.sigma_i < 0) + hkl_info.sigma_i = 0; if (hkl_info.count) - printf("Single_crystal_inelastic: %s: Read %d (Q,w) points from file '%s'\n", - NAME_CURRENT_COMP, hkl_info.count, sqw); - else printf("Single_crystal_inelastic: %s: Using incoherent elastic scattering with cross-section %f only.\n", - NAME_CURRENT_COMP, hkl_info.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; + printf ("Single_crystal_inelastic: %s: Read %d (Q,w) points from file '%s'\n", NAME_CURRENT_COMP, hkl_info.count, sqw); + else + printf ("Single_crystal_inelastic: %s: Using incoherent elastic scattering with cross-section %f only.\n", NAME_CURRENT_COMP, hkl_info.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 */ + } 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_inelastic: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "Single_crystal_inelastic: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); /* Allocates space for saved ki */ int i; hkl_info.stored_ki_max = max_stored_ki; - hkl_info.stored = (struct hkl_store*)malloc(max_stored_ki*sizeof(struct hkl_store)); - for(i=0; i 0) - PROP_DT(t1); /* Move to crystal surface if not inside */ - v = sqrt(vx*vx + vy*vy + vz*vz); - ki = V2K*v; + if (intersect) { /* Neutron intersects crystal */ + if (t1 > 0) + PROP_DT (t1); /* Move to crystal surface if not inside */ + v = sqrt (vx * vx + vy * vy + vz * vz); + ki = V2K * v; event_counter = 0; - abs_xsect = hkl_info.sigma_a*2200/v; + abs_xsect = hkl_info.sigma_a * 2200 / v; inc_xsect = hkl_info.sigma_i; - V0= hkl_info.V0; - abs_xlen = abs_xsect/V0; - inc_xlen = inc_xsect/V0; + V0 = hkl_info.V0; + abs_xlen = abs_xsect / V0; + inc_xlen = inc_xsect / V0; if (barns) { - /*If cross sections are given in barns, we need a scaling factor of 100 + /*If cross sections are given in barns, we need a scaling factor of 100 to get scattering lengths in m, since V0 is assumed to be in AA*/ - abs_xlen *= 100; inc_xlen *= 100; + abs_xlen *= 100; + inc_xlen *= 100; } /* else assume fm^2 */ L = hkl_info.list; hkl_info.type = '\0'; - do { // Loop over multiple scattering events // + do { // Loop over multiple scattering events // if (hkl_info.shape == 0) - intersect = cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius, yheight); else if (hkl_info.shape == 1) - intersect = box_intersect(&t1, &t2, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t1, &t2, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else if (hkl_info.shape == 2) - intersect = sphere_intersect(&t1, &t2, x, y, z, vx, vy, vz, radius); + intersect = sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius); else if (hkl_info.shape == 3) - intersect = off_intersect(&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, offdata ); - if(!intersect || t2*v < -1e-9 || t1*v > 1e-9) - { + intersect = off_intersect (&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, offdata); + if (!intersect || t2 * v < -1e-9 || t1 * v > 1e-9) { /* neutron is leaving the sample */ if (hkl_info.flag_warning < 100) - fprintf(stderr, - "Single_crystal_inelastic: %s: Warning: neutron has unexpectedly left the crystal!\n" - " t1=%g t2=%g x=%g y=%g z=%g vx=%g vy=%g vz=%g\n", - NAME_CURRENT_COMP, t1, t2, x, y, z, vx, vy, vz); + fprintf (stderr, + "Single_crystal_inelastic: %s: Warning: neutron has unexpectedly left the crystal!\n" + " t1=%g t2=%g x=%g y=%g z=%g vx=%g vy=%g vz=%g\n", + NAME_CURRENT_COMP, t1, t2, x, y, z, vx, vy, vz); hkl_info.flag_warning++; break; } - l_full = t2*v; + l_full = t2 * v; /* (1). Compute incoming wave vector ki */ /* lattice curvature option: rotate neutron velocity */ if (RX || RY || RZ) { - if (RX) { rotate(b1x,b1y,b1z,vx,vy,vz, atan2(x,RX),0,0,1); } - else { b1x=vx; b1y=vy; b1z=vz; } - if (RY) { rotate(b2x,b2y,b2z,b1x,b1y,b1z, atan2(y,RY),1,0,0); } - else { b2x=b1x; b2y=b1y; b2z=b1z; } - if (RZ) { rotate(b1x,b1y,b1z,b2x,b2y,b2z, atan2(z,RZ),0,1,0); } - else { b1x=b2x; b1y=b2y; b1z=b2z; } - kix = V2K*b1x; - kiy = V2K*b1y; - kiz = V2K*b1z; + if (RX) { + rotate (b1x, b1y, b1z, vx, vy, vz, atan2 (x, RX), 0, 0, 1); + } else { + b1x = vx; + b1y = vy; + b1z = vz; + } + if (RY) { + rotate (b2x, b2y, b2z, b1x, b1y, b1z, atan2 (y, RY), 1, 0, 0); + } else { + b2x = b1x; + b2y = b1y; + b2z = b1z; + } + if (RZ) { + rotate (b1x, b1y, b1z, b2x, b2y, b2z, atan2 (z, RZ), 0, 1, 0); + } else { + b1x = b2x; + b1y = b2y; + b1z = b2z; + } + kix = V2K * b1x; + kiy = V2K * b1y; + kiz = V2K * b1z; } else { - kix = V2K*vx; - kiy = V2K*vy; - kiz = V2K*vz; + kix = V2K * vx; + kiy = V2K * vy; + kiz = V2K * vz; } - ki2 = kix*kix + kiy*kiy + kiz*kiz; + ki2 = kix * kix + kiy * kiy + kiz * kiz; - if(hkl_info.list[hkl_info.SwQi[0][0]].chki > (2*ki)) { // No hkl point can satisfy kinematics for this ki. - ABSORB; // Should propagate it out of the crystal ... + if (hkl_info.list[hkl_info.SwQi[0][0]].chki > (2 * ki)) { // No hkl point can satisfy kinematics for this ki. + ABSORB; // Should propagate it out of the crystal ... break; } // Goes through the full S(q,w) list to find points which are kinematically accessible with this ki, then save this // to an array which is then re-used for ki's similar to this one in future. int klist = -1; - double kdir,kmag; + double kdir, kmag; // Checks previously generated list of ki's which cannot scatter from the sample due to orientation. - for(i1=0; i10) { - kmag = sqrt(hkl_info.stored[i1].kx*hkl_info.stored[i1].kx + hkl_info.stored[i1].ky*hkl_info.stored[i1].ky + hkl_info.stored[i1].kz*hkl_info.stored[i1].kz); - kdir = (kix*hkl_info.stored[i1].kx + kiy*hkl_info.stored[i1].ky + kiz*hkl_info.stored[i1].kz) / ki / kmag; - if(fabs(kdir-1)<1e-4 && fabs(kmag-ki)<0.01) { + for (i1 = 0; i1 < hkl_info.stored_ki_max; i1++) { + if (hkl_info.stored[i1].nhkl > 0) { + kmag = sqrt (hkl_info.stored[i1].kx * hkl_info.stored[i1].kx + hkl_info.stored[i1].ky * hkl_info.stored[i1].ky + + hkl_info.stored[i1].kz * hkl_info.stored[i1].kz); + kdir = (kix * hkl_info.stored[i1].kx + kiy * hkl_info.stored[i1].ky + kiz * hkl_info.stored[i1].kz) / ki / kmag; + if (fabs (kdir - 1) < 1e-4 && fabs (kmag - ki) < 0.01) { klist = i1; break; } @@ -852,80 +920,89 @@ TRACE } // If no previous ki's that can scatter is in the list, generate it. - if(klist<0) { - int *tmp_list; tmp_list = (int*)malloc(hkl_info.count*sizeof(int)); + if (klist < 0) { + int* tmp_list; + tmp_list = (int*)malloc (hkl_info.count * sizeof (int)); klist = hkl_info.last_stored; - hkl_info.last_stored++; - if (hkl_info.last_stored>=hkl_info.stored_ki_max) hkl_info.last_stored=0; + hkl_info.last_stored++; + if (hkl_info.last_stored >= hkl_info.stored_ki_max) + hkl_info.last_stored = 0; hkl_info.stored[klist].nhkl = 0; hkl_info.stored[klist].kx = kix; hkl_info.stored[klist].ky = kiy; hkl_info.stored[klist].kz = kiz; - for(i1=0; i1 (2*ki)) break; // Further hkl points not kinematically possible - for(i2=0; i2 (2 * ki)) + break; // Further hkl points not kinematically possible + for (i2 = 0; i2 < hkl_info.nQ[i1]; i2++) { kfx = kix - hkl_info.list[hkl_info.SwQi[i1][i2]].qx; kfy = kiy - hkl_info.list[hkl_info.SwQi[i1][i2]].qy; kfz = kiz - hkl_info.list[hkl_info.SwQi[i1][i2]].qz; - kf2 = kfx*kfx + kfy*kfy + kfz*kfz; - en = 2.072124*(ki2 - kf2); + kf2 = kfx * kfx + kfy * kfy + kfz * kfz; + en = 2.072124 * (ki2 - kf2); // If the energy transfer for this S(q,w) point matches |ki|-|kf|, add to list - if(fabs(en-hkl_info.list[hkl_info.SwQi[i1][i2]].en)<0.001) { // energy fudge factor + if (fabs (en - hkl_info.list[hkl_info.SwQi[i1][i2]].en) < 0.001) { // energy fudge factor tmp_list[hkl_info.stored[klist].nhkl] = hkl_info.SwQi[i1][i2]; hkl_info.stored[klist].nhkl++; } } } - if(hkl_info.stored[klist].nhkl == 0) { // No dispersion surface E(hkl) can be satisfied with this ki direction. + if (hkl_info.stored[klist].nhkl == 0) { // No dispersion surface E(hkl) can be satisfied with this ki direction. // Add current ki to "bad" list hkl_info.badx[hkl_info.nextbad] = kix; hkl_info.bady[hkl_info.nextbad] = kiy; hkl_info.badz[hkl_info.nextbad] = kiz; - hkl_info.nbad++; - hkl_info.nextbad++; - if(hkl_info.nbad>hkl_info.maxbad) hkl_info.nbad=hkl_info.maxbad; - if(hkl_info.nextbad>hkl_info.maxbad) hkl_info.nextbad=0; - ABSORB; // Should propagate it out of the crystal ... + hkl_info.nbad++; + hkl_info.nextbad++; + if (hkl_info.nbad > hkl_info.maxbad) + hkl_info.nbad = hkl_info.maxbad; + if (hkl_info.nextbad > hkl_info.maxbad) + hkl_info.nextbad = 0; + ABSORB; // Should propagate it out of the crystal ... break; - } - else { + } else { // Add current ki to "good" list - hkl_info.stored[klist].hkl = (int*)malloc(hkl_info.stored[klist].nhkl*sizeof(int)); - hkl_info.stored[klist].CDF = (double*)malloc(hkl_info.stored[klist].nhkl*sizeof(double)); + hkl_info.stored[klist].hkl = (int*)malloc (hkl_info.stored[klist].nhkl * sizeof (int)); + hkl_info.stored[klist].CDF = (double*)malloc (hkl_info.stored[klist].nhkl * sizeof (double)); // Construct a cumulative distribution of the found hkle hkl_info.stored[klist].CDF[0] = hkl_info.list[tmp_list[0]].SQW; - for(i1=0; i10) hkl_info.stored[klist].CDF[i1] = hkl_info.stored[klist].CDF[i1-1] + hkl_info.list[tmp_list[i1]].SQW; + if (i1 > 0) + hkl_info.stored[klist].CDF[i1] = hkl_info.stored[klist].CDF[i1 - 1] + hkl_info.list[tmp_list[i1]].SQW; } } - free(tmp_list); + free (tmp_list); } int notfound = 1; do { // Sample from the generated CDF, but double check that EN matches |ki|-|kf| for this actual ki // since we could be using saved values from a slightly different ki. - double u = rand0max(hkl_info.stored[klist].CDF[hkl_info.stored[klist].nhkl-1]); - for(i1=0; i10) { - i1 = (u-hkl_info.stored[klist].CDF[i1])<(hkl_info.stored[klist].CDF[i1]-u) ? i1-1 : i1; + double u = rand0max (hkl_info.stored[klist].CDF[hkl_info.stored[klist].nhkl - 1]); + for (i1 = 0; i1 < hkl_info.stored[klist].nhkl; i1++) + if (u < hkl_info.stored[klist].CDF[i1]) + break; + if (i1 > 0) { + i1 = (u - hkl_info.stored[klist].CDF[i1]) < (hkl_info.stored[klist].CDF[i1] - u) ? i1 - 1 : i1; } j = hkl_info.stored[klist].hkl[i1]; en = hkl_info.list[j].en; kfx = kix - hkl_info.list[j].qx; kfy = kiy - hkl_info.list[j].qy; kfz = kiz - hkl_info.list[j].qz; - kf2 = kfx*kfx + kfy*kfy + kfz*kfz; - kf = sqrt(kf2); - notfound++; - if(notfound>100) { + kf2 = kfx * kfx + kfy * kfy + kfz * kfz; + kf = sqrt (kf2); + notfound++; + if (notfound > 100) { break; } - if(fabs(en-2.072124*(ki2-kf2))<0.001) { notfound = 0; } //else { printf("retry\n"); } + if (fabs (en - 2.072124 * (ki2 - kf2)) < 0.001) { + notfound = 0; + } // else { printf("retry\n"); } } while (notfound); - if(notfound>100) { + if (notfound > 100) { // Should continue to propagate the neutron... ABSORB; break; @@ -933,13 +1010,19 @@ TRACE // Ignore absorption, multiple scattering and incoherent scattering for the moment (!) p = p0 * hkl_info.list[j].SQW; - vx = K2V*kfx; vy = K2V*kfy; vz = K2V*kfz; - fprintf(hist,"%12.8f %12.8f (%12.8f %12.8f, %12.8f) %12.8f %12.8f %6d\n",ki,kf,en,2.072124*(ki*ki-kf*kf),fabs(en-2.072124*(ki*ki-kf*kf)),u,hkl_info.list[j].SQW,j); + vx = K2V * kfx; + vy = K2V * kfy; + vz = K2V * kfz; + fprintf (hist, "%12.8f %12.8f (%12.8f %12.8f, %12.8f) %12.8f %12.8f %6d\n", ki, kf, en, 2.072124 * (ki * ki - kf * kf), + fabs (en - 2.072124 * (ki * ki - kf * kf)), u, hkl_info.list[j].SQW, j); SCATTER; break; /* exit if multiple scattering order has been reached */ - if (order && event_counter >= order) { intersect=0; break; } + if (order && event_counter >= order) { + intersect = 0; + break; + } /* Repeat loop for next scattering event. */ } while (intersect); /* end do (intersect) (multiple scattering loop) */ } /* if intersect */ @@ -947,52 +1030,40 @@ TRACE FINALLY %{ - fclose(hist); + fclose (hist); if (hkl_info.flag_warning) - fprintf(stderr, "Single_crystal_inelastic: %s: Error message was repeated %i times with absorbed neutrons.\n", - NAME_CURRENT_COMP, hkl_info.flag_warning); + fprintf (stderr, "Single_crystal_inelastic: %s: Error message was repeated %i times with absorbed neutrons.\n", NAME_CURRENT_COMP, hkl_info.flag_warning); %} MCDISPLAY %{ - magnify("xyz"); - if (hkl_info.shape == 0) { /* cylinder */ - circle("xz", 0, yheight/2.0, 0, radius); - circle("xz", 0, -yheight/2.0, 0, radius); - line(-radius, -yheight/2.0, 0, -radius, +yheight/2.0, 0); - line(+radius, -yheight/2.0, 0, +radius, +yheight/2.0, 0); - line(0, -yheight/2.0, -radius, 0, +yheight/2.0, -radius); - line(0, -yheight/2.0, +radius, 0, +yheight/2.0, +radius); - } - else if (hkl_info.shape == 1) { /* box */ - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zdepth; - double zmax = 0.5*zdepth; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); - } - else if (hkl_info.shape == 2) { /* sphere */ - circle("xy", 0, 0.0, 0, radius); - circle("xz", 0, 0.0, 0, radius); - circle("yz", 0, 0.0, 0, radius); - } - else if (hkl_info.shape == 3) { /* OFF file */ - off_display(offdata); + magnify ("xyz"); + if (hkl_info.shape == 0) { /* cylinder */ + circle ("xz", 0, yheight / 2.0, 0, radius); + circle ("xz", 0, -yheight / 2.0, 0, radius); + line (-radius, -yheight / 2.0, 0, -radius, +yheight / 2.0, 0); + line (+radius, -yheight / 2.0, 0, +radius, +yheight / 2.0, 0); + line (0, -yheight / 2.0, -radius, 0, +yheight / 2.0, -radius); + line (0, -yheight / 2.0, +radius, 0, +yheight / 2.0, +radius); + } else if (hkl_info.shape == 1) { /* box */ + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zdepth; + double zmax = 0.5 * zdepth; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); + } else if (hkl_info.shape == 2) { /* sphere */ + circle ("xy", 0, 0.0, 0, radius); + circle ("xz", 0, 0.0, 0, radius); + circle ("yz", 0, 0.0, 0, radius); + } else if (hkl_info.shape == 3) { /* OFF file */ + off_display (offdata); } %} END diff --git a/mcstas-comps/contrib/Source_custom.comp b/mcstas-comps/contrib/Source_custom.comp index 83ac8c846..173b83203 100644 --- a/mcstas-comps/contrib/Source_custom.comp +++ b/mcstas-comps/contrib/Source_custom.comp @@ -141,87 +141,88 @@ SHARE %{ /* Normalized Maxwellian distribution */ #pragma acc routine - double maxwell(double lmbd, double temperature){ - double a, M=0.0; - if (temperature > 0.0 && lmbd > 0.0){ + double + maxwell (double lmbd, double temperature) { + double a, M = 0.0; + if (temperature > 0.0 && lmbd > 0.0) { a = 949.29 / temperature; - M = 2.0 * a*a * exp(-a/(lmbd*lmbd)) / pow(lmbd, 5); + M = 2.0 * a * a * exp (-a / (lmbd * lmbd)) / pow (lmbd, 5); } return M; } /* Distribution of under-moderated neutrons */ #pragma acc routine - double joining_function(double lmbd, double chi, double kappa){ + double + joining_function (double lmbd, double chi, double kappa) { if (lmbd > 0.0) - return 1.0 / ((1.0 + exp(chi * lmbd - kappa)) * lmbd); + return 1.0 / ((1.0 + exp (chi * lmbd - kappa)) * lmbd); else return 0.0; } /* Normalised time-dependent pulse structure */ #pragma acc routine - double pulse_carpenter(double time, double tau, double n, double pulse_length){ - if (time <= 0.0 || tau <= 0.0 || n <= 0.0 || pulse_length <= 0.0) + double + pulse_carpenter (double time, double tau, double n, double pulse_length) { + if (time <= 0.0 || tau <= 0.0 || n <= 0.0 || pulse_length <= 0.0) return 0.0; - double integral = pulse_length + tau - tau/n; + double integral = pulse_length + tau - tau / n; if (time <= pulse_length) - return (1 - exp(-time/(tau/n))) / integral; + return (1 - exp (-time / (tau / n))) / integral; else - return (exp(-(time-pulse_length)/tau) - exp(-time/(tau/n))) / integral; + return (exp (-(time - pulse_length) / tau) - exp (-time / (tau / n))) / integral; } %} DECLARE %{ - double area; /* [cm^2] Moderator surface area */ - double t_period; /* [s] Period of the pulse cycle */ - double alpha; /* [1] Duty cycle */ - double p_in; /* [1/Ang/s] Flux normalisation factor */ + double area; /* [cm^2] Moderator surface area */ + double t_period; /* [s] Period of the pulse cycle */ + double alpha; /* [1] Duty cycle */ + double p_in; /* [1/Ang/s] Flux normalisation factor */ %} INITIALIZE %{ /* Initial check of the input parameters */ - if ( xwidth < 0.0 || yheight < 0.0 || radius < 0.0 - || r_i < 0.0 || Lmin < 0.0 || Lmax < 0.0 - || dist < 0.0 || focus_xw < 0.0 || focus_yh < 0.0 - || freq < 0.0 || t_pulse < 0.0 || tmax_multiplier < 0.0 - || T1 < 0.0 || I1 < 0.0 || tau1 < 0.0 - || T2 < 0.0 || I2 < 0.0 || tau2 < 0.0 - || T3 < 0.0 || I3 < 0.0 || tau3 < 0.0 - || n_mod < 0.0 || I_um < 0.0 || tau_um < 0.0 - || n_um < 0.0){ - printf("Source_custom: %s: Error: negative input parameter!\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); + if (xwidth < 0.0 || yheight < 0.0 || radius < 0.0 || r_i < 0.0 || Lmin < 0.0 || Lmax < 0.0 || dist < 0.0 || focus_xw < 0.0 || focus_yh < 0.0 || freq < 0.0 + || t_pulse < 0.0 || tmax_multiplier < 0.0 || T1 < 0.0 || I1 < 0.0 || tau1 < 0.0 || T2 < 0.0 || I2 < 0.0 || tau2 < 0.0 || T3 < 0.0 || I3 < 0.0 || tau3 < 0.0 + || n_mod < 0.0 || I_um < 0.0 || tau_um < 0.0 || n_um < 0.0) { + printf ("Source_custom: %s: Error: negative input parameter!\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); } - if (Lmax <= Lmin){ - printf("Source_custom: %s: Error: wavelengths should be Lmin < Lmax!\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); + if (Lmax <= Lmin) { + printf ("Source_custom: %s: Error: wavelengths should be Lmin < Lmax!\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); } - if (T1 == 0.0 && T2 == 0.0 && T3 == 0.0){ - printf("Source_custom: %s: Error: No temperature T1, T2 nor T3 defined!\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); + if (T1 == 0.0 && T2 == 0.0 && T3 == 0.0) { + printf ("Source_custom: %s: Error: No temperature T1, T2 nor T3 defined!\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); } - if (I1 == 0.0 && I2 == 0.0 && I3 == 0.0){ - printf("Source_custom: %s: Error: No flux I1, I2 nor I3 defined!\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); + if (I1 == 0.0 && I2 == 0.0 && I3 == 0.0) { + printf ("Source_custom: %s: Error: No flux I1, I2 nor I3 defined!\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); } /* Automatic distance to the target */ - if (target_index > 0 && dist == 0.0){ + if (target_index > 0 && dist == 0.0) { Coords ToTarget; - double tx,ty,tz; - ToTarget = coords_sub(POS_A_COMP_INDEX(INDEX_CURRENT_COMP + target_index), POS_A_CURRENT_COMP); - ToTarget = rot_apply(ROT_A_CURRENT_COMP, ToTarget); - coords_get(ToTarget, &tx, &ty, &tz); - dist=sqrt(tx*tx + ty*ty + tz*tz); + double tx, ty, tz; + ToTarget = coords_sub (POS_A_COMP_INDEX (INDEX_CURRENT_COMP + target_index), POS_A_CURRENT_COMP); + ToTarget = rot_apply (ROT_A_CURRENT_COMP, ToTarget); + coords_get (ToTarget, &tx, &ty, &tz); + dist = sqrt (tx * tx + ty * ty + tz * tz); } /* Pulse parameters */ @@ -230,58 +231,57 @@ INITIALIZE /* The source is assumed to be continuous if the input pulse length is equal or greater than the pulse period. The pulse length is then matched to the pulse period to avoid spurious neutron counts. */ - if (t_pulse >= t_period){ + if (t_pulse >= t_period) { t_pulse = t_period; tmax_multiplier = 1.0; n_pulses = 1.0; } /* Area for different moderator shapes */ - if (xwidth > 0.0 && yheight > 0.0){ - area = 10000.0 * xwidth * yheight; + if (xwidth > 0.0 && yheight > 0.0) { + area = 10000.0 * xwidth * yheight; + } else if (radius > 0.0) { + area = 10000.0 * PI * radius * radius; + } else { + printf ("Source_custom: %s: Error: The shape of the source is not set! Use xwidth/yheight or radius\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); } - else if (radius > 0.0){ - area = 10000.0 * PI * radius*radius; - } - else{ - printf("Source_custom: %s: Error: The shape of the source is not set! Use xwidth/yheight or radius\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); - } - p_in = (Lmax - Lmin) * (t_pulse * tmax_multiplier) / mcget_ncount(); + p_in = (Lmax - Lmin) * (t_pulse * tmax_multiplier) / mcget_ncount (); /* Set the number of desired pulses to an integer */ - n_pulses = (double)floor(n_pulses); - if (n_pulses < 1) n_pulses = 1; + n_pulses = (double)floor (n_pulses); + if (n_pulses < 1) + n_pulses = 1; %} TRACE %{ - double phi, /* [rad] Orientation of the starting point for a spherical moderator */ - r, /* [m] Distance of the starting point from moderator center */ - v, /* [m/s] Speed of the neutron */ - time, /* [s] Time */ - lambda, /* [Ang] Wavelength of the neutron */ - xf, /* [m] Horizontal position on the target */ - yf, /* [m] Vertical position on the target */ - rf, /* [m] Distance between point on moderator and point on target */ - dx, /* [m] Horizontal shift from moderator to target */ - dy, /* [m] Vertical shift from moderator to target */ - Omega, /* [sr] Solid angle of the target */ - flux; /* [1/(cm^2 s Ang sr] Flux(lambda,time) */ + double phi, /* [rad] Orientation of the starting point for a spherical moderator */ + r, /* [m] Distance of the starting point from moderator center */ + v, /* [m/s] Speed of the neutron */ + time, /* [s] Time */ + lambda, /* [Ang] Wavelength of the neutron */ + xf, /* [m] Horizontal position on the target */ + yf, /* [m] Vertical position on the target */ + rf, /* [m] Distance between point on moderator and point on target */ + dx, /* [m] Horizontal shift from moderator to target */ + dy, /* [m] Vertical shift from moderator to target */ + Omega, /* [sr] Solid angle of the target */ + flux; /* [1/(cm^2 s Ang sr] Flux(lambda,time) */ /* Choose the starting point on the moderator surface with uniform distribution for different moderator shapes */ - if (xwidth > 0.0 && yheight > 0.0){ - x = xwidth * (rand01() - 0.5); - y = yheight * (rand01() - 0.5); - } - else{ - phi = 2 * PI * rand01(); - r = sqrt(rand01()) * radius; - x = r * cos(phi); - y = r * sin(phi); + if (xwidth > 0.0 && yheight > 0.0) { + x = xwidth * (rand01 () - 0.5); + y = yheight * (rand01 () - 0.5); + } else { + phi = 2 * PI * rand01 (); + r = sqrt (rand01 ()) * radius; + x = r * cos (phi); + y = r * sin (phi); } z = 0.0; @@ -291,39 +291,37 @@ TRACE sz = 0.0; /* Choose random wavelength and starting time */ - lambda = Lmin + (Lmax - Lmin) * rand01(); - t = t_pulse * tmax_multiplier * rand01(); + lambda = Lmin + (Lmax - Lmin) * rand01 (); + t = t_pulse * tmax_multiplier * rand01 (); /* Propagate to the target */ - randvec_target_rect_real(&xf, &yf, &rf, &Omega, - 0, 0, dist, focus_xw, focus_yh, - ROT_A_CURRENT_COMP, x, y, z, 2); + randvec_target_rect_real (&xf, &yf, &rf, &Omega, 0, 0, dist, focus_xw, focus_yh, ROT_A_CURRENT_COMP, x, y, z, 2); /* Length of the flight path */ dx = xf - x; dy = yf - y; - rf = sqrt(dx*dx + dy*dy + dist*dist); + rf = sqrt (dx * dx + dy * dy + dist * dist); /* Speed of the neutron */ - v = 3956.0346 / lambda; + v = 3956.0346 / lambda; vx = v * dx / rf; vy = v * dy / rf; vz = v * dist / rf; /* The input flux variables Ix are in [1/(cm^2 s AA sr)] The flux variable below gets the flux per unit of time (s) */ - flux = I_um * joining_function(lambda, chi_um, kap_um) * pulse_carpenter(t, tau_um, n_um, t_pulse); - if (r_i==0.0 || r <= r_i) - flux += I1 * maxwell(lambda, T1) * pulse_carpenter(t, tau1, n_mod, t_pulse); - if (r_i==0.0 || r > r_i) - flux += I2 * maxwell(lambda, T2) * pulse_carpenter(t, tau2, n_mod, t_pulse); - flux += I3 * maxwell(lambda, T3) * pulse_carpenter(t, tau3, n_mod, t_pulse); + flux = I_um * joining_function (lambda, chi_um, kap_um) * pulse_carpenter (t, tau_um, n_um, t_pulse); + if (r_i == 0.0 || r <= r_i) + flux += I1 * maxwell (lambda, T1) * pulse_carpenter (t, tau1, n_mod, t_pulse); + if (r_i == 0.0 || r > r_i) + flux += I2 * maxwell (lambda, T2) * pulse_carpenter (t, tau2, n_mod, t_pulse); + flux += I3 * maxwell (lambda, T3) * pulse_carpenter (t, tau3, n_mod, t_pulse); /* Assign this neutron to a random pulse among the specified n_pulses. The value of p remains consistent since the intensity now spreads over n_pulses */ - t += (double)floor((n_pulses)*rand01()) * t_period; + t += (double)floor ((n_pulses)*rand01 ()) * t_period; /* The p McStas parameter gets the neutrons per second that reach the target component */ - p = flux * area * Omega * p_in; /* [1/s] time averaged intensity */ + p = flux * area * Omega * p_in; /* [1/s] time averaged intensity */ SCATTER; %} @@ -331,25 +329,24 @@ TRACE MCDISPLAY %{ - double edge; /* [m] x and y position on the circle */ + double edge; /* [m] x and y position on the circle */ - if (dist > 0.0){ - if (xwidth > 0.0 && yheight > 0.0){ - rectangle("xy", 0,0,0, xwidth,yheight); - dashed_line(-xwidth/2, -yheight/2, 0, -focus_xw/2, -focus_yh/2, dist, 4); - dashed_line( xwidth/2, -yheight/2, 0, focus_xw/2, -focus_yh/2, dist, 4); - dashed_line( xwidth/2, yheight/2, 0, focus_xw/2, focus_yh/2, dist, 4); - dashed_line(-xwidth/2, yheight/2, 0, -focus_xw/2, focus_yh/2, dist, 4); - } - else{ - circle("xy", 0,0,0, radius); + if (dist > 0.0) { + if (xwidth > 0.0 && yheight > 0.0) { + rectangle ("xy", 0, 0, 0, xwidth, yheight); + dashed_line (-xwidth / 2, -yheight / 2, 0, -focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (xwidth / 2, -yheight / 2, 0, focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (xwidth / 2, yheight / 2, 0, focus_xw / 2, focus_yh / 2, dist, 4); + dashed_line (-xwidth / 2, yheight / 2, 0, -focus_xw / 2, focus_yh / 2, dist, 4); + } else { + circle ("xy", 0, 0, 0, radius); if (r_i > 0.0) - circle("xy", 0,0,0, r_i); - edge = radius/sqrt(2.0); - dashed_line(-edge, -edge, 0, -focus_xw/2, -focus_yh/2, dist, 4); - dashed_line( edge, -edge, 0, focus_xw/2, -focus_yh/2, dist, 4); - dashed_line( edge, edge, 0, focus_xw/2, focus_yh/2, dist, 4); - dashed_line(-edge, edge, 0, -focus_xw/2, focus_yh/2, dist, 4); + circle ("xy", 0, 0, 0, r_i); + edge = radius / sqrt (2.0); + dashed_line (-edge, -edge, 0, -focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (edge, -edge, 0, focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (edge, edge, 0, focus_xw / 2, focus_yh / 2, dist, 4); + dashed_line (-edge, edge, 0, -focus_xw / 2, focus_yh / 2, dist, 4); } } %} diff --git a/mcstas-comps/contrib/Source_gen4.comp b/mcstas-comps/contrib/Source_gen4.comp index 563d49464..38f7cc35e 100644 --- a/mcstas-comps/contrib/Source_gen4.comp +++ b/mcstas-comps/contrib/Source_gen4.comp @@ -128,39 +128,38 @@ SETTING PARAMETERS ( SHARE %{ -%include "read_table-lib" - -#ifndef SOURCE_GEN_DEF -#define SOURCE_GEN_DEF -/******************************************************************************* -* str_dup_numeric: makes a clean copy of a string and allocate as numeric -*******************************************************************************/ -char *str_dup_numeric(char *orig) -{ - long i; - char *valid; - - if (!orig || !strlen(orig)) return(NULL); - - for (i=0; i < strlen(orig); i++) - { - if ( (orig[i] > 122) - || (orig[i] < 32) - || (strchr("!\"#$%&'()*,:;<=>?@[\\]^`/ ", orig[i]) != NULL) ) - { - orig[i] = ' '; + %include "read_table-lib" + + #ifndef SOURCE_GEN_DEF + #define SOURCE_GEN_DEF + /******************************************************************************* + * str_dup_numeric: makes a clean copy of a string and allocate as numeric + *******************************************************************************/ + char* + str_dup_numeric (char* orig) { + long i; + char* valid; + + if (!orig || !strlen (orig)) + return (NULL); + + for (i = 0; i < strlen (orig); i++) { + if ((orig[i] > 122) || (orig[i] < 32) || (strchr ("!\"#$%&'()*,:;<=>?@[\\]^`/ ", orig[i]) != NULL)) { + orig[i] = ' '; + } + } + orig[i] = '\0'; + /* now skip spaces */ + for (i = 0; i < strlen (orig); i++) { + if (*orig == ' ') + orig++; + else + break; } - } - orig[i] = '\0'; - /* now skip spaces */ - for (i=0; i < strlen(orig); i++) { - if (*orig == ' ') orig++; - else break; - } - return(orig); -} /* str_dup_numeric */ -#endif + return (orig); + } /* str_dup_numeric */ + #endif %} DECLARE @@ -195,373 +194,358 @@ DECLARE INITIALIZE %{ double source_area, k; - pTable_xsum=pTable_ysum=0; + pTable_xsum = pTable_ysum = 0; /* spectrum characteristics */ - if (flux_file && strlen(flux_file) > 0) { - if (Table_Read(&pTable, flux_file, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, flux_file)); + if (flux_file && strlen (flux_file) > 0) { + if (Table_Read (&pTable, flux_file, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, flux_file)); /* put table in Log scale */ int i; - if (pTable.columns < 2) exit(fprintf(stderr, "Source_gen: %s: Flux file %s should contain at least 2 columns\n", NAME_CURRENT_COMP, flux_file)); - double table_lmin=FLT_MAX, table_lmax=-FLT_MAX; - double tmin=FLT_MAX, tmax=-FLT_MAX; - for (i=0; i tmax) tmax=val; - if (val < tmin) tmin=val; + if (pTable.columns < 2) + exit (fprintf (stderr, "Source_gen: %s: Flux file %s should contain at least 2 columns\n", NAME_CURRENT_COMP, flux_file)); + double table_lmin = FLT_MAX, table_lmax = -FLT_MAX; + double tmin = FLT_MAX, tmax = -FLT_MAX; + for (i = 0; i < pTable.rows; i++) { + double val = Table_Index (pTable, i, 1); + val = Table_Index (pTable, i, 0); /* lambda */ + if (val > tmax) + tmax = val; + if (val < tmin) + tmin = val; } - for (i=0; i 0 ? val : tmin/10); - Table_SetElement(&pTable, i, 1, val); - val = Table_Index(pTable, i,0); /* lambda */ - if (val > table_lmax) table_lmax=val; - if (val < table_lmin) table_lmin=val; + val = log (val > 0 ? val : tmin / 10); + Table_SetElement (&pTable, i, 1, val); + val = Table_Index (pTable, i, 0); /* lambda */ + if (val > table_lmax) + table_lmax = val; + if (val < table_lmin) + table_lmin = val; } if (!Lmin && !Lmax && !Lambda0 && !dLambda && !E0 && !dE && !Emin && !Emax) { - Lmin = table_lmin; Lmax = table_lmax; + Lmin = table_lmin; + Lmax = table_lmax; } if (Lmax > table_lmax) { - if (verbose) fprintf(stderr, "Source_gen: %s: Maximum wavelength %g is beyond table range upper limit %g. Constraining.\n", NAME_CURRENT_COMP, Lmax, table_lmax); + if (verbose) + fprintf (stderr, "Source_gen: %s: Maximum wavelength %g is beyond table range upper limit %g. Constraining.\n", NAME_CURRENT_COMP, Lmax, table_lmax); Lmax = table_lmax; } if (Lmin < table_lmin) { - if (verbose) fprintf(stderr, "Source_gen: %s: Minimum wavelength %g is below table range lower limit %g. Constraining.\n", NAME_CURRENT_COMP, Lmin, table_lmin); + if (verbose) + fprintf (stderr, "Source_gen: %s: Minimum wavelength %g is below table range lower limit %g. Constraining.\n", NAME_CURRENT_COMP, Lmin, table_lmin); Lmin = table_lmin; } - } else - { - k = 1.38066e-23; /* k_B */ - if (T1 > 0) - { - lambda0 = 1.0e10*sqrt(HBAR*HBAR*4.0*PI*PI/2.0/MNEUTRON/k/T1); - lambda02 = lambda0*lambda0; - L2P = 2*lambda02*lambda02; + } else { + k = 1.38066e-23; /* k_B */ + if (T1 > 0) { + lambda0 = 1.0e10 * sqrt (HBAR * HBAR * 4.0 * PI * PI / 2.0 / MNEUTRON / k / T1); + lambda02 = lambda0 * lambda0; + L2P = 2 * lambda02 * lambda02; + } else { + lambda0 = Lambda0; } - else - { lambda0 = Lambda0; } - if (T2 > 0) - { - lambda0b = 1.0e10*sqrt(HBAR*HBAR*4.0*PI*PI/2.0/MNEUTRON/k/T2); - lambda02b = lambda0b*lambda0b; - L2Pb = 2*lambda02b*lambda02b; + if (T2 > 0) { + lambda0b = 1.0e10 * sqrt (HBAR * HBAR * 4.0 * PI * PI / 2.0 / MNEUTRON / k / T2); + lambda02b = lambda0b * lambda0b; + L2Pb = 2 * lambda02b * lambda02b; + } else { + lambda0b = Lambda0; } - else - { lambda0b = Lambda0; } - if (T3 > 0) - { - lambda0c = 1.0e10*sqrt(HBAR*HBAR*4.0*PI*PI/2.0/MNEUTRON/k/T3); - lambda02c = lambda0c*lambda0c; - L2Pc = 2*lambda02c*lambda02c; + if (T3 > 0) { + lambda0c = 1.0e10 * sqrt (HBAR * HBAR * 4.0 * PI * PI / 2.0 / MNEUTRON / k / T3); + lambda02c = lambda0c * lambda0c; + L2Pc = 2 * lambda02c * lambda02c; + } else { + lambda0c = Lambda0; } - else - { lambda0c = Lambda0; } } /* now read position-divergence files, if any */ - if (xdiv_file && strlen(xdiv_file) > 0) { - int i,j; - if (Table_Read(&pTable_x, xdiv_file, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, xdiv_file)); + if (xdiv_file && strlen (xdiv_file) > 0) { + int i, j; + if (Table_Read (&pTable_x, xdiv_file, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, xdiv_file)); pTable_xsum = 0; - for (i=0; i 0) { - int i,j; - if (Table_Read(&pTable_y, ydiv_file, 1) <= 0) /* read 1st block data from file into pTable */ - exit(fprintf(stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, ydiv_file)); + if (ydiv_file && strlen (ydiv_file) > 0) { + int i, j; + if (Table_Read (&pTable_y, ydiv_file, 1) <= 0) /* read 1st block data from file into pTable */ + exit (fprintf (stderr, "Source_gen: %s: can not read file %s\n", NAME_CURRENT_COMP, ydiv_file)); pTable_ysum = 0; - for (i=0; i 0) || (dE > 0 && dE >= E0)) - { - fprintf(stderr,"Source_gen: %s: Error: minimal energy cannot be less or equal zero\n", - NAME_CURRENT_COMP); - exit(-1); + if ((Emin == 0 && Emax > 0) || (dE > 0 && dE >= E0)) { + fprintf (stderr, "Source_gen: %s: Error: minimal energy cannot be less or equal zero\n", NAME_CURRENT_COMP); + exit (-1); } - if ((Emax >= Emin) && (Emin > 0)) - { E0 = (Emax+Emin)/2; - dE = (Emax-Emin)/2; + if ((Emax >= Emin) && (Emin > 0)) { + E0 = (Emax + Emin) / 2; + dE = (Emax - Emin) / 2; } - if ((E0 > dE) && (dE >= 0)) - { - Lmin = sqrt(81.81/(E0+dE)); /* Angstroem */ - Lmax = sqrt(81.81/(E0-dE)); + if ((E0 > dE) && (dE >= 0)) { + Lmin = sqrt (81.81 / (E0 + dE)); /* Angstroem */ + Lmax = sqrt (81.81 / (E0 - dE)); } - if (Lmax > 0) - { Lambda0 = (Lmax+Lmin)/2; - dLambda = (Lmax-Lmin)/2; + if (Lmax > 0) { + Lambda0 = (Lmax + Lmin) / 2; + dLambda = (Lmax - Lmin) / 2; } - if ((Lambda0 < dLambda) || (dLambda < 0)) - { fprintf(stderr,"Source_gen: %s: Error: Wavelength range %.3f +/- %.3f AA calculated \n", - NAME_CURRENT_COMP, Lambda0, dLambda); - fprintf(stderr,"- whole wavelength range must be >= 0 \n"); - fprintf(stderr,"- range must be > 0; otherwise intensity gets zero, use other sources in this case \n\n"); - exit(-1); + if ((Lambda0 < dLambda) || (dLambda < 0)) { + fprintf (stderr, "Source_gen: %s: Error: Wavelength range %.3f +/- %.3f AA calculated \n", NAME_CURRENT_COMP, Lambda0, dLambda); + fprintf (stderr, "- whole wavelength range must be >= 0 \n"); + fprintf (stderr, "- range must be > 0; otherwise intensity gets zero, use other sources in this case \n\n"); + exit (-1); } - radius = fabs(radius); w=fabs(w); h=fabs(h); I1=fabs(I1); - Lambda0=fabs(Lambda0); dLambda=fabs(dLambda); - xw = fabs(xw); yh=fabs(yh); dist=fabs(dist); - - if (dist == 0) - { - fprintf(stderr,"Source_gen: %s: warning: focusing distance is null.\n" - " xw and yh interpreted as full divergence in [deg]\n", - NAME_CURRENT_COMP); + radius = fabs (radius); + w = fabs (w); + h = fabs (h); + I1 = fabs (I1); + Lambda0 = fabs (Lambda0); + dLambda = fabs (dLambda); + xw = fabs (xw); + yh = fabs (yh); + dist = fabs (dist); + + if (dist == 0) { + fprintf (stderr, + "Source_gen: %s: warning: focusing distance is null.\n" + " xw and yh interpreted as full divergence in [deg]\n", + NAME_CURRENT_COMP); } Lmin = Lambda0 - dLambda; /* Angstroem */ Lmax = Lambda0 + dLambda; /* compute initial weight factor p_in to get [n/s] */ - if ((I1 > 0 && T1 >= 0) || (flux_file && strlen(flux_file) > 0)) - { /* the I1,2,3 are usually in [n/s/cm2/st/AA] */ + if ((I1 > 0 && T1 >= 0) || (flux_file && strlen (flux_file) > 0)) { /* the I1,2,3 are usually in [n/s/cm2/st/AA] */ if (radius) - source_area = radius*radius*PI*1e4; /* circular cm^2 */ + source_area = radius * radius * PI * 1e4; /* circular cm^2 */ else - source_area = h*w*1e4; /* square cm^2 */ - p_in = source_area; /* cm2 */ - p_in *= (Lmax-Lmin); /* AA. 1 bin=AA/n */ - if (flux_file && strlen(flux_file) && !flux_file_perAA) p_in *= pTable.rows/(Lmax-Lmin); - } - else - p_in = (I1 > 0? I1 : 1)/4/PI; /* Small angle approx. */ - p_in /= mcget_ncount(); - if (!T1 && I1) p_in *= I1; - - if (radius == 0 && h == 0 && w == 0) - { - fprintf(stderr,"Source_gen: %s: Error: Please specify source geometry (radius, h, w)\n", - NAME_CURRENT_COMP); - exit(-1); + source_area = h * w * 1e4; /* square cm^2 */ + p_in = source_area; /* cm2 */ + p_in *= (Lmax - Lmin); /* AA. 1 bin=AA/n */ + if (flux_file && strlen (flux_file) && !flux_file_perAA) + p_in *= pTable.rows / (Lmax - Lmin); + } else + p_in = (I1 > 0 ? I1 : 1) / 4 / PI; /* Small angle approx. */ + p_in /= mcget_ncount (); + if (!T1 && I1) + p_in *= I1; + + if (radius == 0 && h == 0 && w == 0) { + fprintf (stderr, "Source_gen: %s: Error: Please specify source geometry (radius, h, w)\n", NAME_CURRENT_COMP); + exit (-1); } - if (xw*yh == 0) - { - fprintf(stderr,"Source_gen: %s: Error: Please specify source target (xw, yh)\n", - NAME_CURRENT_COMP); - exit(-1); + if (xw * yh == 0) { + fprintf (stderr, "Source_gen: %s: Error: Please specify source target (xw, yh)\n", NAME_CURRENT_COMP); + exit (-1); } - if (verbose) - { - printf("Source_gen: component %s ", NAME_CURRENT_COMP); + if (verbose) { + printf ("Source_gen: component %s ", NAME_CURRENT_COMP); if ((h == 0) || (w == 0)) - printf("(disk, radius=%g)", radius); + printf ("(disk, radius=%g)", radius); else - printf("(square %g x %g)",h,w); - printf("\n spectra "); - printf("%.3f to %.3f AA (%.3f to %.3f meV)", Lmin, Lmax, 81.81/Lmax/Lmax, 81.81/Lmin/Lmin); + printf ("(square %g x %g)", h, w); + printf ("\n spectra "); + printf ("%.3f to %.3f AA (%.3f to %.3f meV)", Lmin, Lmax, 81.81 / Lmax / Lmax, 81.81 / Lmin / Lmin); if (gaussian) - printf(", gaussian divergence beam"); - printf("\n"); - if (flux_file && strlen(flux_file) > 0) - { printf(" File %s for flux distribution used. Flux is dPhi/dLambda in [n/s/AA]. \n", flux_file); - Table_Info(pTable); - } - else if (T1>=0 && I1) - { if (T1 != 0) - printf(" T1=%.1f K (%.3f AA)", T1, lambda0); - if (T2*I2 != 0) - printf(", T2=%.1f K (%.3f AA)", T2, lambda0b); - if (T3*I3 != 0) - printf(", T3=%.1f K (%.3f AA)", T3, lambda0c); - if (T1) printf("\n"); - printf(" Flux is dPhi/dLambda in [n/s/cm2].\n"); + printf (", gaussian divergence beam"); + printf ("\n"); + if (flux_file && strlen (flux_file) > 0) { + printf (" File %s for flux distribution used. Flux is dPhi/dLambda in [n/s/AA]. \n", flux_file); + Table_Info (pTable); + } else if (T1 >= 0 && I1) { + if (T1 != 0) + printf (" T1=%.1f K (%.3f AA)", T1, lambda0); + if (T2 * I2 != 0) + printf (", T2=%.1f K (%.3f AA)", T2, lambda0b); + if (T3 * I3 != 0) + printf (", T3=%.1f K (%.3f AA)", T3, lambda0c); + if (T1) + printf ("\n"); + printf (" Flux is dPhi/dLambda in [n/s/cm2].\n"); + } else { + printf (" Flux is Phi in [n/s].\n"); } - else - { printf(" Flux is Phi in [n/s].\n"); - } - if (xdiv_file && strlen(xdiv_file) > 0) - printf(" File %s x=[%g:%g] [m] xdiv=[%g:%g] [deg] used as horizontal phase space distribution.\n", xdiv_file, pTable_xmin, pTable_xmax, pTable_dxmin, pTable_dxmax); - if (ydiv_file && strlen(ydiv_file) > 0) - printf(" File %s y=[%g:%g] [m] ydiv=[%g:%g] [deg] used as vertical phase space distribution.\n", ydiv_file, pTable_ymin, pTable_ymax, pTable_dymin, pTable_dymax); - } - else - if (verbose == -1) - printf("Source_gen: component %s inactivated", NAME_CURRENT_COMP); + if (xdiv_file && strlen (xdiv_file) > 0) + printf (" File %s x=[%g:%g] [m] xdiv=[%g:%g] [deg] used as horizontal phase space distribution.\n", xdiv_file, pTable_xmin, pTable_xmax, pTable_dxmin, + pTable_dxmax); + if (ydiv_file && strlen (ydiv_file) > 0) + printf (" File %s y=[%g:%g] [m] ydiv=[%g:%g] [deg] used as vertical phase space distribution.\n", ydiv_file, pTable_ymin, pTable_ymax, pTable_dymin, + pTable_dymax); + } else if (verbose == -1) + printf ("Source_gen: component %s inactivated", NAME_CURRENT_COMP); %} TRACE %{ - double theta0,phi0,theta1,phi1,chi,theta,phi,v,r, lambda; + double theta0, phi0, theta1, phi1, chi, theta, phi, v, r, lambda; double tan_h, tan_v, Maxwell, lambda2, lambda5; - if (verbose >= 0) - { + if (verbose >= 0) { - z=0; + z = 0; - if ((h == 0) || (w == 0)) - { - chi=2*PI*rand01(); /* Choose point on source */ - r=sqrt(rand01())*radius; /* with uniform distribution. */ - x=r*cos(chi); - y=r*sin(chi); - } - else - { - x = w*randpm1()/2; /* select point on source (uniform) */ - y = h*randpm1()/2; + if ((h == 0) || (w == 0)) { + chi = 2 * PI * rand01 (); /* Choose point on source */ + r = sqrt (rand01 ()) * radius; /* with uniform distribution. */ + x = r * cos (chi); + y = r * sin (chi); + } else { + x = w * randpm1 () / 2; /* select point on source (uniform) */ + y = h * randpm1 () / 2; } if (length != 0) - z = length*randpm1()/2; - - if (dist == 0) - { - theta0 = DEG2RAD*xw/2; - phi0 = DEG2RAD*yh/2; - theta1 = -DEG2RAD*xw/2; - phi1 = -DEG2RAD*yh/2; - } - else - { - theta0= -atan((x-xw/2.0)/dist)+theta_init/180*3.1415; /* Angles to aim at target */ - phi0 = -atan((y-yh/2.0)/dist)+phi_init/180*3.1415; - theta1= -atan((x+xw/2.0)/dist)+theta_init/180*3.1415; - phi1 = -atan((y+yh/2.0)/dist)+phi_init/180*3.1415; + z = length * randpm1 () / 2; + + if (dist == 0) { + theta0 = DEG2RAD * xw / 2; + phi0 = DEG2RAD * yh / 2; + theta1 = -DEG2RAD * xw / 2; + phi1 = -DEG2RAD * yh / 2; + } else { + theta0 = -atan ((x - xw / 2.0) / dist) + theta_init / 180 * 3.1415; /* Angles to aim at target */ + phi0 = -atan ((y - yh / 2.0) / dist) + phi_init / 180 * 3.1415; + theta1 = -atan ((x + xw / 2.0) / dist) + theta_init / 180 * 3.1415; + phi1 = -atan ((y + yh / 2.0) / dist) + phi_init / 180 * 3.1415; } /* shot towards target : flat distribution */ - if (gaussian) - { - theta= theta0+(theta1- theta0)*(randnorm()*FWHM2RMS+0.5); - phi = phi0 +(phi1 - phi0) *(randnorm()*FWHM2RMS+0.5); - } - else - { - theta= theta0+(theta1- theta0)*rand01(); - phi = phi0 +(phi1 - phi0) *rand01(); + if (gaussian) { + theta = theta0 + (theta1 - theta0) * (randnorm () * FWHM2RMS + 0.5); + phi = phi0 + (phi1 - phi0) * (randnorm () * FWHM2RMS + 0.5); + } else { + theta = theta0 + (theta1 - theta0) * rand01 (); + phi = phi0 + (phi1 - phi0) * rand01 (); } /* Assume linear distribution */ - lambda = Lambda0+dLambda*randpm1(); - if (lambda <= 0) ABSORB; + lambda = Lambda0 + dLambda * randpm1 (); + if (lambda <= 0) + ABSORB; - v = K2V*(2*PI/lambda); + v = K2V * (2 * PI / lambda); p = p_in; - if (!flux_file || !strlen(flux_file)) - p *= 2 * fabs((theta1 - theta0)*sin((phi1 - phi0)/2)); /* solid angle */ - p *= cos(phi)*cos(theta); - if (flux_file && strlen(flux_file) > 0) - { - double W=Table_Value(pTable, lambda, 1); - if (flux_file_log) W=exp(W); - p *= W; - } - else if (T1 > 0 && I1 > 0) - { - lambda2 = lambda*lambda; - lambda5 = lambda2*lambda2*lambda; - Maxwell = I1 * L2P/lambda5 * exp(-lambda02/lambda2); /* 1/AA */ - - if ((T2 > 0) && (I2 > 0)) - { - Maxwell += I2 * L2Pb/lambda5 * exp(-lambda02b/lambda2); + if (!flux_file || !strlen (flux_file)) + p *= 2 * fabs ((theta1 - theta0) * sin ((phi1 - phi0) / 2)); /* solid angle */ + p *= cos (phi) * cos (theta); + if (flux_file && strlen (flux_file) > 0) { + double W = Table_Value (pTable, lambda, 1); + if (flux_file_log) + W = exp (W); + p *= W; + } else if (T1 > 0 && I1 > 0) { + lambda2 = lambda * lambda; + lambda5 = lambda2 * lambda2 * lambda; + Maxwell = I1 * L2P / lambda5 * exp (-lambda02 / lambda2); /* 1/AA */ + + if ((T2 > 0) && (I2 > 0)) { + Maxwell += I2 * L2Pb / lambda5 * exp (-lambda02b / lambda2); } - if ((T3 > 0) && (I3 > 0)) - { - Maxwell += I3 * L2Pc/lambda5 * exp(-lambda02c/lambda2); + if ((T3 > 0) && (I3 > 0)) { + Maxwell += I3 * L2Pc / lambda5 * exp (-lambda02c / lambda2); } - if (HEtailA>0) - { - Maxwell+=HEtailA/(lambda-HEtailL0)/(lambda-HEtailL0); + if (HEtailA > 0) { + Maxwell += HEtailA / (lambda - HEtailL0) / (lambda - HEtailL0); } p *= Maxwell; } /* Perform the correct treatment - no small angle approx. here! */ - tan_h = tan(theta); - tan_v = tan(phi); - vz = v / sqrt(1 + tan_v*tan_v + tan_h*tan_h); + tan_h = tan (theta); + tan_v = tan (phi); + vz = v / sqrt (1 + tan_v * tan_v + tan_h * tan_h); vy = tan_v * vz; vx = tan_h * vz; /* optional x-xdiv and y-ydiv weightening: position=along columns, div=along rows */ - if (xdiv_file && strlen(xdiv_file) > 0 && pTable_xsum > 0) { - double i,j; - j = (x- pTable_xmin) /(pTable_xmax -pTable_xmin) *pTable_x.columns; - i = (theta*RAD2DEG-pTable_dxmin)/(pTable_dxmax-pTable_dxmin)*pTable_x.rows; - r = Table_Value2d(pTable_x, i,j); /* row, column */ - p *= r/pTable_xsum; + if (xdiv_file && strlen (xdiv_file) > 0 && pTable_xsum > 0) { + double i, j; + j = (x - pTable_xmin) / (pTable_xmax - pTable_xmin) * pTable_x.columns; + i = (theta * RAD2DEG - pTable_dxmin) / (pTable_dxmax - pTable_dxmin) * pTable_x.rows; + r = Table_Value2d (pTable_x, i, j); /* row, column */ + p *= r / pTable_xsum; } - if (ydiv_file && strlen(ydiv_file) > 0 && pTable_ysum > 0) { - double i,j; - j = (y- pTable_ymin) /(pTable_ymax -pTable_ymin) *pTable_y.columns; - i = (phi*RAD2DEG- pTable_dymin)/(pTable_dymax-pTable_dymin)*pTable_y.rows; - r = Table_Value2d(pTable_y, i,j); - p *= r/pTable_ysum; + if (ydiv_file && strlen (ydiv_file) > 0 && pTable_ysum > 0) { + double i, j; + j = (y - pTable_ymin) / (pTable_ymax - pTable_ymin) * pTable_y.columns; + i = (phi * RAD2DEG - pTable_dymin) / (pTable_dymax - pTable_dymin) * pTable_y.rows; + r = Table_Value2d (pTable_y, i, j); + p *= r / pTable_ysum; } SCATTER; } @@ -569,9 +553,9 @@ TRACE FINALLY %{ - Table_Free(&pTable); - Table_Free(&pTable_x); - Table_Free(&pTable_y); + Table_Free (&pTable); + Table_Free (&pTable_x); + Table_Free (&pTable_y); %} MCDISPLAY @@ -581,26 +565,21 @@ MCDISPLAY double ymin; double ymax; - if ((h == 0) || (w == 0)) - { - - circle("xy",0,0,0,radius); + if ((h == 0) || (w == 0)) { + + circle ("xy", 0, 0, 0, radius); if (gaussian) - circle("xy",0,0,0,radius/2); - } - else - { - xmin = -w/2; xmax = w/2; - ymin = -h/2; ymax = h/2; - - - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); + circle ("xy", 0, 0, 0, radius / 2); + } else { + xmin = -w / 2; + xmax = w / 2; + ymin = -h / 2; + ymax = h / 2; + + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, + (double)xmin, (double)ymin, 0.0); if (gaussian) - circle("xy",0,0,0,sqrt(w*w+h*h)/4); + circle ("xy", 0, 0, 0, sqrt (w * w + h * h) / 4); } %} diff --git a/mcstas-comps/contrib/Source_multi_surfaces.comp b/mcstas-comps/contrib/Source_multi_surfaces.comp index 04915a6a9..9604dfef7 100644 --- a/mcstas-comps/contrib/Source_multi_surfaces.comp +++ b/mcstas-comps/contrib/Source_multi_surfaces.comp @@ -94,33 +94,29 @@ Emin=0.0,Emax=0.0,Lmin=0.0,Lmax=0.0) SHARE %{ -%include "read_table-lib" - -char *get_token(char **src, char *token_sep) -{ - char *tok; - if (!src || !*src || !**src) - return(NULL); - while(**src && strchr(token_sep,**src)) - (*src)++; - if (**src) - tok = *src; - else - return(NULL); - *src = strpbrk(*src,token_sep); - if (*src) - { - **src = 0; - (*src)++; - while(**src && strchr(token_sep,**src)) - (*src)++; - } - else - *src = ""; - return(tok); -} - + %include "read_table-lib" + char* + get_token (char** src, char* token_sep) { + char* tok; + if (!src || !*src || !**src) + return (NULL); + while (**src && strchr (token_sep, **src)) + (*src)++; + if (**src) + tok = *src; + else + return (NULL); + *src = strpbrk (*src, token_sep); + if (*src) { + **src = 0; + (*src)++; + while (**src && strchr (token_sep, **src)) + (*src)++; + } else + *src = ""; + return (tok); + } %} DECLARE @@ -132,230 +128,221 @@ DECLARE INITIALIZE %{ - int n_surf=1,c_surf=1; /*numbers of subsurfaces*/ - int rows_surf; /*number of Source_multi_surfaces.comp rows*/ - int i, j, string_num,k; /*filename_table indices*/ + int n_surf = 1, c_surf = 1; /*numbers of subsurfaces*/ + int rows_surf; /*number of Source_multi_surfaces.comp rows*/ + int i, j, string_num, k; /*filename_table indices*/ - char *token; - FILE *files_name; + char* token; + FILE* files_name; char fu[50]; - struct filename_table{ - int index1; - char spec_name[128]; - char tmp_name[512]; - }; - struct filename_table values[50]; - - for (i=0;i<50;i++) - { - values[i].index1=i; - sprintf(values[i].spec_name,"empty"); + struct filename_table { + int index1; + char spec_name[128]; + char tmp_name[512]; + }; + struct filename_table values[50]; + + for (i = 0; i < 50; i++) { + values[i].index1 = i; + sprintf (values[i].spec_name, "empty"); } - - if ((yheight == 0) || (xwidth == 0)) - { - fprintf(stderr,"Source_multi_surfaces: Error: Please precise source geometry (yheight, xwidth)\n"); - exit(-1); + + if ((yheight == 0) || (xwidth == 0)) { + fprintf (stderr, "Source_multi_surfaces: Error: Please precise source geometry (yheight, xwidth)\n"); + exit (-1); + } + if (xw * yh == 0) { + fprintf (stderr, "Source_multi_surfaces: Error: Please precise source target (xw, yh)\n"); + exit (-1); } - if (xw*yh == 0) - { - fprintf(stderr,"Source_multi_surfaces: Error: Please precise source target (xw, yh)\n"); - exit(-1); + if ((xdim >= 8) || (ydim >= 8)) { + fprintf (stderr, "Source_multi_surfaces: Error: Number of subdivision in x or y too big (>=8)\n"); + exit (-1); } - if ((xdim >= 8) || (ydim >= 8)) - { - fprintf(stderr,"Source_multi_surfaces: Error: Number of subdivision in x or y too big (>=8)\n"); - exit(-1); + if (dist == 0) { + fprintf (stderr, "Source_multi_surfaces: Error: dist = 0\n"); + exit (-1); } - if (dist == 0) - { - fprintf(stderr,"Source_multi_surfaces: Error: dist = 0\n"); - exit(-1); + if ((Emin < 0) || (Emax < 0)) { + fprintf (stderr, "Source_multi_surfaces: Error: Energy will reach negative values (Emin or Emax < 0)\n"); + exit (-1); } - if ((Emin < 0) || (Emax < 0)) - { - fprintf(stderr,"Source_multi_surfaces: Error: Energy will reach negative values (Emin or Emax < 0)\n"); - exit(-1); - } - if ((Lmin < 0) || (Lmax < 0)) - { - fprintf(stderr,"Source_multi_surfaces: Error: Wavelength will reach negative values (Lmin or Lmax < 0)\n"); - exit(-1); + if ((Lmin < 0) || (Lmax < 0)) { + fprintf (stderr, "Source_multi_surfaces: Error: Wavelength will reach negative values (Lmin or Lmax < 0)\n"); + exit (-1); } - - if ((Emax != 0) && (Emin != 0)) - { - Lmin=sqrt(81.82/Emax/1e3); /* wavelength in AA */ - Lmax=sqrt(81.82/Emin/1e3); + + if ((Emax != 0) && (Emin != 0)) { + Lmin = sqrt (81.82 / Emax / 1e3); /* wavelength in AA */ + Lmax = sqrt (81.82 / Emin / 1e3); + } + + delta_lambda = Lmax - Lmin; + + n_surf = xdim * ydim; + + /*read files_name.dat, generate a table with the files filename*/ + + files_name = fopen (filename, "r"); + + i = 0; + rows_surf = 0; + while (1) { + if (feof (files_name)) + break; + fgets (values[i].tmp_name, 512, files_name); + i = i + 1; + rows_surf = i; + } /*we do not consider the number of line*/ + + j = 0; + i = 0; + k = 0; + for (j = 0; j < rows_surf; j++) { + token = strtok (values[j].tmp_name, " "); + if (j > 0) + i = i + (7 - xdim); + sprintf (values[i].spec_name, "%s\n", token); + i = i + 1; + k = k + 1; + while (token = strtok (0, " ")) { + sprintf (values[i].spec_name, "%s\n", token); + i = i + 1; + k = k + 1; + c_surf = k; + } + } + sprintf (values[i - 1].spec_name, "%s", "empty"); + fclose (files_name); + rows_surf = rows_surf - 1; + + if (n_surf != c_surf) { + fprintf (stderr, "Source_multi_surfaces: Error: Number of subdivision (xdim*ydim) and number of input file not equal (files_name.dat)\n"); + exit (-1); } - delta_lambda=Lmax-Lmin; - - n_surf = xdim*ydim; - - /*read files_name.dat, generate a table with the files filename*/ - - files_name = fopen(filename, "r"); - - i=0; - rows_surf=0; - while(1) - { - if (feof(files_name)) break; - fgets(values[i].tmp_name,512,files_name); - i=i+1; - rows_surf=i; - } /*we do not consider the number of line*/ - - j=0;i=0;k=0; - for (j=0;j0) i=i+(7-xdim); - sprintf(values[i].spec_name,"%s\n",token); - i=i+1; - k=k+1; - while (token = strtok(0," ")) - { - sprintf(values[i].spec_name,"%s\n",token); - i=i+1; - k=k+1; - c_surf=k; - } - } - sprintf(values[i-1].spec_name,"%s","empty"); - fclose(files_name); - rows_surf=rows_surf-1; - - if (n_surf!=c_surf) - { - fprintf(stderr,"Source_multi_surfaces: Error: Number of subdivision (xdim*ydim) and number of input file not equal (files_name.dat)\n"); - exit(-1); - } - /*read each input file and fill in 49 arrays*/ - - for (i=0;i<7;i++) - { - for (j=0;j<7;j++) - { - k=i*7+j; - if (strcmp(values[k].spec_name,"empty")) - { - switch(j) - { - case 0 : - if (xdim > 1) { - string_num=strlen(values[k].spec_name)-1; - } else { - string_num=strlen(values[k].spec_name)-2; - } - break; - case 6 : - if (xdim==7) { - string_num=strlen(values[k].spec_name)-2; - } - break; - default : - if (xdim==j+1) { - string_num=strlen(values[k].spec_name)-2; - } else { - string_num=strlen(values[k].spec_name)-1; - } - } - strncpy(fu,values[k].spec_name ,string_num); - fu[string_num] = '\0'; - Table_Read(&Tables[k], fu, 0); - if (Lmax > Table_Index(Tables[k],0,0)) { - fprintf(stderr,"Source_multi_surfaces: Error: Lmax or Emin not present in %s",values[k].spec_name); - fprintf(stderr,"Source_multi_surfaces: Choosen Lmax or Emin is %2.8f larger as the given Lmax-value in the file %s . \n",(Lmax-Table_Index(Tables[k],(Tables[k].rows-1),0)),values[k].spec_name); - exit(-1); - } - if (Lmin < Table_Index(Tables[k],(Tables[k].rows-1),0)) { - fprintf(stderr,"Source_multi_surfaces: Error: Lmin or Emax not present in %s",values[k].spec_name); - fprintf(stderr,"Source_multi_surfaces: Choosen Lmin or Emax is %2.8f smaller as the given Lmin-value in the file %s . \n",(Table_Index(Tables[k],0,0)-Lmin),values[k].spec_name); - exit(-1); - } - } + + for (i = 0; i < 7; i++) { + for (j = 0; j < 7; j++) { + k = i * 7 + j; + if (strcmp (values[k].spec_name, "empty")) { + switch (j) { + case 0: + if (xdim > 1) { + string_num = strlen (values[k].spec_name) - 1; + } else { + string_num = strlen (values[k].spec_name) - 2; + } + break; + case 6: + if (xdim == 7) { + string_num = strlen (values[k].spec_name) - 2; + } + break; + default: + if (xdim == j + 1) { + string_num = strlen (values[k].spec_name) - 2; + } else { + string_num = strlen (values[k].spec_name) - 1; + } + } + strncpy (fu, values[k].spec_name, string_num); + fu[string_num] = '\0'; + Table_Read (&Tables[k], fu, 0); + if (Lmax > Table_Index (Tables[k], 0, 0)) { + fprintf (stderr, "Source_multi_surfaces: Error: Lmax or Emin not present in %s", values[k].spec_name); + fprintf (stderr, "Source_multi_surfaces: Choosen Lmax or Emin is %2.8f larger as the given Lmax-value in the file %s . \n", + (Lmax - Table_Index (Tables[k], (Tables[k].rows - 1), 0)), values[k].spec_name); + exit (-1); + } + if (Lmin < Table_Index (Tables[k], (Tables[k].rows - 1), 0)) { + fprintf (stderr, "Source_multi_surfaces: Error: Lmin or Emax not present in %s", values[k].spec_name); + fprintf (stderr, "Source_multi_surfaces: Choosen Lmin or Emax is %2.8f smaller as the given Lmin-value in the file %s . \n", + (Table_Index (Tables[k], 0, 0) - Lmin), values[k].spec_name); + exit (-1); + } + } } } - xwidth=fabs(xwidth); yheight=fabs(yheight); - xw = fabs(xw); yh=fabs(yh); dist=fabs(dist); + xwidth = fabs (xwidth); + yheight = fabs (yheight); + xw = fabs (xw); + yh = fabs (yh); + dist = fabs (dist); /*generate p_in*/ - p_in = 1.0/mcget_ncount(); - + p_in = 1.0 / mcget_ncount (); %} TRACE %{ - double theta0,phi0,theta1,phi1,theta,phi; - double v,xpos,ypos; - double intensity,lambda; - double a,tan_v,tan_yheight; - int i,j,k; - - z = 0; - x = xwidth*randpm1()*0.5; /*select point on the source (uniform)*/ - y = yheight*randpm1()*0.5; - - xpos = (x/xwidth+0.5)*xdim; /*select the corresponding subsurface*/ - ypos = (y/yheight+0.5)*ydim; - - /* printf("xpos %f, ypos %f \n", xpos, ypos); */ - - theta0= -atan((x-xw/2.0)/dist); /*Angles to aim at target*/ - phi0 = -atan((y-yh/2.0)/dist); - theta1= -atan((x+xw/2.0)/dist); - phi1 = -atan((y+yh/2.0)/dist); - - theta= theta0+(theta1- theta0)*rand01(); /*shot towards target*/ - phi = phi0 +(phi1 - phi0) *rand01(); - - lambda=Lmin+delta_lambda*rand01(); /*select the lambda randomly*/ - - intensity=0; a=0; - - /*select the correct neutron in the correct table and give its intensity*/ - - /*assume a linear distribution between the values given in the files*/ - - k = floor(ypos)*7+floor(xpos); - - for (i=0;i<(Tables[k].rows+1);i++) - { - if ((lambda <= Table_Index(Tables[k],i,0)) && (lambda > Table_Index(Tables[k],i+1,0))) - { - a=(Table_Index(Tables[k],i+1,1)-Table_Index(Tables[k],i,1))/(Table_Index(Tables[k],i+1,0)-Table_Index(Tables[k],i,0)); - intensity=a*lambda+(Table_Index(Tables[k],i,1)-a*Table_Index(Tables[k],i,0)); - } - } - - /*calculate the speed*/ - - v = K2V*(2*PI/lambda); - - /*calculate the p-value*/ - - p = p*intensity*p_in*fabs((theta1 - theta0)*(phi1 - phi0)); - - tan_yheight = tan(theta); - tan_v = tan(phi); - vz = v / sqrt(1 + tan_v*tan_v + tan_yheight*tan_yheight); - vy = tan_v * vz; - vx = tan_yheight * vz; - - SCATTER; - - /*printf("intensity: %f lambda: %f \n", intensity, lambda);*/ + double theta0, phi0, theta1, phi1, theta, phi; + double v, xpos, ypos; + double intensity, lambda; + double a, tan_v, tan_yheight; + int i, j, k; + + z = 0; + x = xwidth * randpm1 () * 0.5; /*select point on the source (uniform)*/ + y = yheight * randpm1 () * 0.5; + + xpos = (x / xwidth + 0.5) * xdim; /*select the corresponding subsurface*/ + ypos = (y / yheight + 0.5) * ydim; + + /* printf("xpos %f, ypos %f \n", xpos, ypos); */ + + theta0 = -atan ((x - xw / 2.0) / dist); /*Angles to aim at target*/ + phi0 = -atan ((y - yh / 2.0) / dist); + theta1 = -atan ((x + xw / 2.0) / dist); + phi1 = -atan ((y + yh / 2.0) / dist); + + theta = theta0 + (theta1 - theta0) * rand01 (); /*shot towards target*/ + phi = phi0 + (phi1 - phi0) * rand01 (); + + lambda = Lmin + delta_lambda * rand01 (); /*select the lambda randomly*/ + + intensity = 0; + a = 0; + + /*select the correct neutron in the correct table and give its intensity*/ + + /*assume a linear distribution between the values given in the files*/ + + k = floor (ypos) * 7 + floor (xpos); + + for (i = 0; i < (Tables[k].rows + 1); i++) { + if ((lambda <= Table_Index (Tables[k], i, 0)) && (lambda > Table_Index (Tables[k], i + 1, 0))) { + a = (Table_Index (Tables[k], i + 1, 1) - Table_Index (Tables[k], i, 1)) / (Table_Index (Tables[k], i + 1, 0) - Table_Index (Tables[k], i, 0)); + intensity = a * lambda + (Table_Index (Tables[k], i, 1) - a * Table_Index (Tables[k], i, 0)); + } + } + + /*calculate the speed*/ + + v = K2V * (2 * PI / lambda); + + /*calculate the p-value*/ + + p = p * intensity * p_in * fabs ((theta1 - theta0) * (phi1 - phi0)); + + tan_yheight = tan (theta); + tan_v = tan (phi); + vz = v / sqrt (1 + tan_v * tan_v + tan_yheight * tan_yheight); + vy = tan_v * vz; + vx = tan_yheight * vz; + + SCATTER; + + /*printf("intensity: %f lambda: %f \n", intensity, lambda);*/ %} FINALLY %{ int i; - for (i=0;i<49;i++) - Table_Free(&Tables[i]); - - fprintf(stderr,"Source_multi_surfaces: Memory cleared\n"); + for (i = 0; i < 49; i++) + Table_Free (&Tables[i]); + + fprintf (stderr, "Source_multi_surfaces: Memory cleared\n"); %} MCDISPLAY %{ @@ -365,27 +352,24 @@ MCDISPLAY double ymax; double xline; double yline; - - xmin = -xwidth/2; xmax = xwidth/2; - ymin = -yheight/2; ymax = yheight/2; - - - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); - + + xmin = -xwidth / 2; + xmax = xwidth / 2; + ymin = -yheight / 2; + ymax = yheight / 2; + + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); + /*the grid*/ - - for (xline=(xwidth/xdim)-(xwidth/2); xline < xwidth/2; xline=xline+(xwidth/xdim)) { - line((double)xline, (double)ymin, 0.0, (double)xline, (double)ymax, 0.0); - } - - for (yline=(yheight/ydim)-(yheight/2); yline < yheight/2; yline=yline+(yheight/ydim)) { - line((double)xmin, (double)yline, 0.0, (double)xmax, (double)yline, 0.0); - } + for (xline = (xwidth / xdim) - (xwidth / 2); xline < xwidth / 2; xline = xline + (xwidth / xdim)) { + line ((double)xline, (double)ymin, 0.0, (double)xline, (double)ymax, 0.0); + } + + for (yline = (yheight / ydim) - (yheight / 2); yline < yheight / 2; yline = yline + (yheight / ydim)) { + line ((double)xmin, (double)yline, 0.0, (double)xmax, (double)yline, 0.0); + } %} END diff --git a/mcstas-comps/contrib/Source_pulsed.comp b/mcstas-comps/contrib/Source_pulsed.comp index 096ec9321..018b792bf 100644 --- a/mcstas-comps/contrib/Source_pulsed.comp +++ b/mcstas-comps/contrib/Source_pulsed.comp @@ -1,287 +1,270 @@ -/******************************************************************************* -* -* Mcstas, neutron ray-tracing package -* Copyright (C) 1997-2020, All rights reserved -* DTU Physics, Kongens Lyngby, Denmark -* Institut Laue Langevin, Grenoble, France -* -* Component: Source_pulsed -* -* %I -* Written by: Klaus Lieutenant, based on component 'Moderator' by K. Nielsen, M. Hagen and 'ESS_moderator_long_2001' by K. Lefmann -* Date : Aug 2020 -* Origin: FZ Juelich -* -* A pulsed source for variable proton pulse lenghts -* -* %D -* Produces a long pulse spectrum with a wavelength distribution as a sum of up to 3 Maxwellian distributions and one of undermoderated neutrons -* -* It uses the time dependence of long pulses. Short pulses can, however, also be simulated by setting the proton pulse short. -* -* If moderator width and height are given, it assumes a rectangular moderator, and otherwise a circular -* -* Usage example: -* Source_pulsed(xwidth=0.04, yheight=0.04, Lmin=1.0, Lmax=3.0, t_min=0.0, t_max=0.5, dist=0.700, focus_xw=0.020, focus_yh=0.020, -* freq=96.0, t_pulse=0.000208, T1=325.0, I1=7.6e09, tau1=0.000170, I_um=2.7e08, chi_um=2.5) -* -* Parameters for some sources: -* HBS thermal source: xwidth=0.04, yheight=0.04, T1=325.0, I1=0.68e+12/freq, tau1=0.000125, n_mod=10, I_um=2.47e+10/freq, chi_um=2.5, t_pulse=0.016/freq, freq=96.0 or 24.0 -* HBS cold source : radius=0.010, T1= 60.0, I1=1.75e+12/freq, tau2=0.000170, n_mod= 5, I_um=3.82e+10/freq, chi_um=0.9, t_pulse=0.016/freq, freq=24.0 or 96.0 -* HBS bi-spectral : radius=0.022, r_i=0.010, T1= 60.0, I1=1.75e+12/freq, tau2=0.000170, -* T2=305.0, I2=0.56e+12/freq, tau1=0.000130, n_mod= 5, I_um=3.82e+10/freq, chi_um=2.5, t_pulse=0.016/freq, freq=24.0 or 96.0 -* -* %P -* Input parameters: -* -* xwidth: [m] Width of the source -* yheight: [m] Height of the source -* radius: [m] Outer radius of the source -* r_i: [m] Radius of a central circle that is sorrounded by a ring of different temperature -* Lmin: [Ang] Lower edge of the wavelength distribution -* Lmax: [Ang] Upper edge of the wavelength distribution -* t_min: [s] Lower edge of the time interval -* t_max: [s] Upper edge of the time interval -* target_index: [1] relative index of component to focus at, e.g. next is +1 this is used to compute 'dist' automatically. -* dist: [m] Distance from the source to the target -* focus_xw: [m] Width of the target (= focusing rectangle) -* focus_yh: [m] Height of the target (= focusing rectangle) -* freq: [Hz] Frequency of pulses -* t_pulse: [s] Proton pulse length -* T1: [K] Temperature of the 1st Maxwellian distribution, for r_i > 0 only for radii r in the range 0 < r < r_i -* I1: [1/(cm**2*sr)] Flux per solid angle of the 1st Maxwellian distribution (integrated over the whole wavelength range). -* tau1: [s] Pulse decay constant of the 1st Maxwellian distribution -* T2: [K] Temperature of the 2nd Maxwellian distribution, 0=none, for r_i > 0 only for radii r in the range r_i < r < radius -* I2: [1/(cm**2*sr)] Flux per solid angle of the 2nd Maxwellian distribution -* tau2: [s] Pulse decay constant of the 2nd Maxwellian distribution -* T3: [K] Temperature of the 3rd Maxwellian distribution, 0=none -* I3: [1/(cm**2*sr)] Flux per solid angle of the 3rd Maxwellian distribution -* tau3: [s] Pulse decay constant of the 3rd Maxwellian distribution -* n_mod: [1] Ratio of pulse decay constant to pulse ascend constant of moderated neutrons -* I_um: [1/(cm**2*sr)] Flux per solid angle for the under-moderated neutrons -* tau_um: [s] Pulse decay constant of under-moderated neutrons -* n_um: [1] Ratio of pulse decay constant to pulse ascend constant of under-moderated neutrons -* chi_um: [1/Ang] Factor for the wavelength dependence of under-moderated neutrons -* kap_um: [1] Scaling factor for the flux of under-moderated neutrons -* -* %E -*******************************************************************************/ - -DEFINE COMPONENT Source_pulsed - -SETTING PARAMETERS (xwidth=0.0, yheight=0.0, radius=0.010, r_i=0.0, - Lmin, Lmax, t_min=0.0, t_max=0.001, - int target_index=1, dist=0.0, focus_xw=0.02, focus_yh=0.02, freq, t_pulse, - T1=0.0, I1=0.0, tau1=0.000125, T2=0.0, I2=0.0, tau2=0.0, T3=0.0, I3=0.0, tau3=0.0, n_mod=10, - I_um=0.0, tau_um=0.000012, n_um=5, chi_um=2.5, kap_um=2.2) - -/* Neutron parameters: (x,y,z, vx,vy,vz, t, sx,sy,sz, p) */ - - -SHARE -%{ - /* Normalized Maxwellian distribution*/ - #pragma acc routine - double Maxwell(double lmbd, double temp) - { - double a, M=0.0; - - if (temp > 0.0 && lmbd > 0.0) - { a = 949.29/temp; - M = 2.0*a*a*exp(-a/(lmbd*lmbd))/pow(lmbd,5); - } - return M; - } - - /* distribution of under-moderated neutrons */ - #pragma acc routine - double Mezei_N_fct(double lmbd, double chi, double kappa) - { - if (lmbd > 0.0) - return 1.0 / (1.0 + exp(chi*lmbd-kappa)) / lmbd; - else - return 0.0; - } - - /* integral of the short pulse function */ - #pragma acc routine - double Mezei_i_fct(double time, double tau, double n) - { - if (n > 1.0 && tau > 0.0) - return (exp(-time/(tau/n)) - n*exp(-time/tau)) / (n-1); - else - return 0.0; - } - - /* Normalized long pulse function */ - #pragma acc routine - double Mezei_I_fct(double time, double tau, double n, double length) - { - if (time <= 0.0 || tau <= 0.0 || n <= 1.0 || length <= 0.0) - return 0.0; - else if (time <= length) - return (Mezei_i_fct(time, tau, n)+1.0) / length; - else - return ( Mezei_i_fct(time, tau, n) - - Mezei_i_fct(time-length, tau, n)) / length; - } -%} - - -DECLARE -%{ - double area; /* [cm^2] moderator surface area */ - double t_period; /* [s] period of the pulse cycle */ - double alpha; /* [1] duty cycle */ - double p_in; /* [1/Ang/s] flux normalisation factor */ -%} - - -INITIALIZE -%{ - /* check of the input parameters */ - if ( xwidth < 0.0 || yheight < 0.0 || radius < 0.0 || r_i < 0.0 || Lmin < 0.0 || Lmax < 0.0 - || dist < 0.0 || focus_xw < 0.0 || focus_yh < 0.0 || freq < 0.0 || t_pulse < 0.0 - || T1 < 0.0 || I1 < 0.0 || tau1 < 0.0 || T2 < 0.0 || I2 < 0.0 - || tau2 < 0.0 || T3 < 0.0 || I3 < 0.0 || tau3 < 0.0 || n_mod < 0.0 - || I_um < 0.0 || tau_um < 0.0 || n_um < 0.0 || chi_um < 0.0 || kap_um < 0.0) - { - printf("Source_pulsed: %s: Error: negative input parameter!\n" - "ERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); - } - if (Lmax <= Lmin || t_max <= t_min) - { - printf("Source_pulsed: %s: Error: wavelength or time parameters do not match!\nERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); - } - - /* automatic distance */ - if (target_index > 0 && dist==0.0) - { - Coords ToTarget; - double tx,ty,tz; - ToTarget = coords_sub(POS_A_COMP_INDEX(INDEX_CURRENT_COMP+target_index),POS_A_CURRENT_COMP); - ToTarget = rot_apply(ROT_A_CURRENT_COMP, ToTarget); - coords_get(ToTarget, &tx, &ty, &tz); - dist=sqrt(tx*tx+ty*ty+tz*tz); - } - - /* pulse parameters */ - t_period = 1.0/freq; - alpha = t_pulse / t_period; - - /* area for different moderator shapes */ - if (xwidth > 0.0 && yheight > 0.0) - { - area = 10000.0 * xwidth * yheight; - } - else if (radius > 0.0) - { - area = 10000.0 * PI*radius*radius; - } - else - { - printf("Source_pulsed: %s: Error: wavelength or time parameters do not match!\nERROR Exiting\n", NAME_CURRENT_COMP); - exit(-1); - } - p_in = (Lmax - Lmin) * (t_max - t_min) / mcget_ncount(); -%} - - -TRACE -%{ - double phi, /* [rad] orientation of the starting point for a spherical moderator */ - r, /* [m] distance of the starting point from moderator center */ - v, /* [m/s] speed of the neutron */ - time, /* [s] */ - lambda, /* [Ang] wavelength of the neutron */ - xf, /* [m] horizontal position on the target */ - yf, /* [m] vertical position on the target */ - rf, /* [m] distance between point on moderator and point on target */ - dx, /* [m] horizontal shift from moderator to target */ - dy, /* [m] vertical shift from moderator to target */ - Omega, /* [sr] solid angle of the target */ - flux; /* [1/(cm^2 s Ang sr] flux(lambda,time) */ - - /* Choose the starting point on the moderator surface with uniform distribution for different moderator shapes */ - if (xwidth > 0.0 && yheight > 0.0) - { - x = xwidth* (rand01() - 0.5); - y = yheight*(rand01() - 0.5); - } - else - { phi = 2*PI*rand01(); - r = sqrt(rand01())*radius; - x = r*cos(phi); - y = r*sin(phi); - } - z = 0.0; - - /* Set zero polarization, choose wavelength and starting time */ - sx = 0.0; - sy = 0.0; - sz = 0.0; - - lambda = Lmin + (Lmax - Lmin) * rand01(); - t = t_min + (t_max - t_min) * rand01(); - - /* Propagate to target */ - randvec_target_rect_real(&xf, &yf, &rf, &Omega, - 0, 0, dist, focus_xw, focus_yh, ROT_A_CURRENT_COMP, x, y, z, 2); - - /* Length of the flight path */ - dx = xf - x; - dy = yf - y; - rf = sqrt(dx*dx + dy*dy + dist*dist); - - /* speed of the neutron */ - v = 3956.0346 / lambda; - vx = v*dx/rf; - vy = v*dy/rf; - vz = v*dist/rf; - - /* Weight: flux in [1/(cm^2 s Ang sr] */ - flux = I_um * Mezei_N_fct(lambda, chi_um, kap_um) * Mezei_I_fct(t, tau_um, n_um, t_pulse); - if (r_i==0.0 || r <= r_i) - flux += I1 * Maxwell(lambda, T1) * Mezei_I_fct(t, tau1, n_mod, t_pulse); - if (r_i==0.0 || r > r_i) - flux += I2 * Maxwell(lambda, T2) * Mezei_I_fct(t, tau2, n_mod, t_pulse); - flux += I3 * Maxwell(lambda, T3) * Mezei_I_fct(t, tau3, n_mod, t_pulse); - - p = flux * area* Omega * p_in; /* [1] neutrons per pulse */ - p /= t_period; /* [1/s] time averaged intensity */ - - SCATTER; -%} - - -MCDISPLAY -%{ - double edge; /* [m] x and y position on the circle */ - - if (dist > 0.0) - { - if (xwidth > 0.0 && yheight > 0.0) - { - rectangle("xy", 0,0,0, xwidth,yheight); - dashed_line(-xwidth/2, -yheight/2, 0, -focus_xw/2,-focus_yh/2, dist, 4); - dashed_line( xwidth/2, -yheight/2, 0, focus_xw/2,-focus_yh/2, dist, 4); - dashed_line( xwidth/2, yheight/2, 0, focus_xw/2, focus_yh/2, dist, 4); - dashed_line(-xwidth/2, yheight/2, 0, -focus_xw/2, focus_yh/2, dist, 4); - } - else - { - circle("xy", 0,0,0, radius); - if (r_i > 0.0) - circle("xy", 0,0,0, r_i); - edge = radius/sqrt(2.0); - dashed_line(-edge, -edge, 0, -focus_xw/2,-focus_yh/2, dist, 4); - dashed_line( edge, -edge, 0, focus_xw/2,-focus_yh/2, dist, 4); - dashed_line( edge, edge, 0, focus_xw/2, focus_yh/2, dist, 4); - dashed_line(-edge, edge, 0, -focus_xw/2, focus_yh/2, dist, 4); - } - } -%} - -END +/******************************************************************************* +* +* Mcstas, neutron ray-tracing package +* Copyright (C) 1997-2020, All rights reserved +* DTU Physics, Kongens Lyngby, Denmark +* Institut Laue Langevin, Grenoble, France +* +* Component: Source_pulsed +* +* %I +* Written by: Klaus Lieutenant, based on component 'Moderator' by K. Nielsen, M. Hagen and 'ESS_moderator_long_2001' by K. Lefmann +* Date : Aug 2020 +* Origin: FZ Juelich +* +* A pulsed source for variable proton pulse lenghts +* +* %D +* Produces a long pulse spectrum with a wavelength distribution as a sum of up to 3 Maxwellian distributions and one of undermoderated neutrons +* +* It uses the time dependence of long pulses. Short pulses can, however, also be simulated by setting the proton pulse short. +* +* If moderator width and height are given, it assumes a rectangular moderator, and otherwise a circular +* +* Usage example: +* Source_pulsed(xwidth=0.04, yheight=0.04, Lmin=1.0, Lmax=3.0, t_min=0.0, t_max=0.5, dist=0.700, focus_xw=0.020, focus_yh=0.020, +* freq=96.0, t_pulse=0.000208, T1=325.0, I1=7.6e09, tau1=0.000170, I_um=2.7e08, chi_um=2.5) +* +* Parameters for some sources: +* HBS thermal source: xwidth=0.04, yheight=0.04, T1=325.0, I1=0.68e+12/freq, tau1=0.000125, n_mod=10, I_um=2.47e+10/freq, chi_um=2.5, t_pulse=0.016/freq, freq=96.0 or 24.0 +* HBS cold source : radius=0.010, T1= 60.0, I1=1.75e+12/freq, tau2=0.000170, n_mod= 5, I_um=3.82e+10/freq, chi_um=0.9, t_pulse=0.016/freq, freq=24.0 or 96.0 +* HBS bi-spectral : radius=0.022, r_i=0.010, T1= 60.0, I1=1.75e+12/freq, tau2=0.000170, +* T2=305.0, I2=0.56e+12/freq, tau1=0.000130, n_mod= 5, I_um=3.82e+10/freq, chi_um=2.5, t_pulse=0.016/freq, freq=24.0 or 96.0 +* +* %P +* Input parameters: +* +* xwidth: [m] Width of the source +* yheight: [m] Height of the source +* radius: [m] Outer radius of the source +* r_i: [m] Radius of a central circle that is sorrounded by a ring of different temperature +* Lmin: [Ang] Lower edge of the wavelength distribution +* Lmax: [Ang] Upper edge of the wavelength distribution +* t_min: [s] Lower edge of the time interval +* t_max: [s] Upper edge of the time interval +* target_index: [1] relative index of component to focus at, e.g. next is +1 this is used to compute 'dist' automatically. +* dist: [m] Distance from the source to the target +* focus_xw: [m] Width of the target (= focusing rectangle) +* focus_yh: [m] Height of the target (= focusing rectangle) +* freq: [Hz] Frequency of pulses +* t_pulse: [s] Proton pulse length +* T1: [K] Temperature of the 1st Maxwellian distribution, for r_i > 0 only for radii r in the range 0 < r < r_i +* I1: [1/(cm**2*sr)] Flux per solid angle of the 1st Maxwellian distribution (integrated over the whole wavelength range). +* tau1: [s] Pulse decay constant of the 1st Maxwellian distribution +* T2: [K] Temperature of the 2nd Maxwellian distribution, 0=none, for r_i > 0 only for radii r in the range r_i < r < radius +* I2: [1/(cm**2*sr)] Flux per solid angle of the 2nd Maxwellian distribution +* tau2: [s] Pulse decay constant of the 2nd Maxwellian distribution +* T3: [K] Temperature of the 3rd Maxwellian distribution, 0=none +* I3: [1/(cm**2*sr)] Flux per solid angle of the 3rd Maxwellian distribution +* tau3: [s] Pulse decay constant of the 3rd Maxwellian distribution +* n_mod: [1] Ratio of pulse decay constant to pulse ascend constant of moderated neutrons +* I_um: [1/(cm**2*sr)] Flux per solid angle for the under-moderated neutrons +* tau_um: [s] Pulse decay constant of under-moderated neutrons +* n_um: [1] Ratio of pulse decay constant to pulse ascend constant of under-moderated neutrons +* chi_um: [1/Ang] Factor for the wavelength dependence of under-moderated neutrons +* kap_um: [1] Scaling factor for the flux of under-moderated neutrons +* +* %E +*******************************************************************************/ + +DEFINE COMPONENT Source_pulsed + +SETTING PARAMETERS (xwidth=0.0, yheight=0.0, radius=0.010, r_i=0.0, + Lmin, Lmax, t_min=0.0, t_max=0.001, + int target_index=1, dist=0.0, focus_xw=0.02, focus_yh=0.02, freq, t_pulse, + T1=0.0, I1=0.0, tau1=0.000125, T2=0.0, I2=0.0, tau2=0.0, T3=0.0, I3=0.0, tau3=0.0, n_mod=10, + I_um=0.0, tau_um=0.000012, n_um=5, chi_um=2.5, kap_um=2.2) + +/* Neutron parameters: (x,y,z, vx,vy,vz, t, sx,sy,sz, p) */ + + +SHARE +%{ + /* Normalized Maxwellian distribution*/ + #pragma acc routine + double + Maxwell (double lmbd, double temp) { + double a, M = 0.0; + + if (temp > 0.0 && lmbd > 0.0) { + a = 949.29 / temp; + M = 2.0 * a * a * exp (-a / (lmbd * lmbd)) / pow (lmbd, 5); + } + return M; + } + + /* distribution of under-moderated neutrons */ + #pragma acc routine + double + Mezei_N_fct (double lmbd, double chi, double kappa) { + if (lmbd > 0.0) + return 1.0 / (1.0 + exp (chi * lmbd - kappa)) / lmbd; + else + return 0.0; + } + + /* integral of the short pulse function */ + #pragma acc routine + double + Mezei_i_fct (double time, double tau, double n) { + if (n > 1.0 && tau > 0.0) + return (exp (-time / (tau / n)) - n * exp (-time / tau)) / (n - 1); + else + return 0.0; + } + + /* Normalized long pulse function */ + #pragma acc routine + double + Mezei_I_fct (double time, double tau, double n, double length) { + if (time <= 0.0 || tau <= 0.0 || n <= 1.0 || length <= 0.0) + return 0.0; + else if (time <= length) + return (Mezei_i_fct (time, tau, n) + 1.0) / length; + else + return (Mezei_i_fct (time, tau, n) - Mezei_i_fct (time - length, tau, n)) / length; + } +%} + + +DECLARE +%{ + double area; /* [cm^2] moderator surface area */ + double t_period; /* [s] period of the pulse cycle */ + double alpha; /* [1] duty cycle */ + double p_in; /* [1/Ang/s] flux normalisation factor */ +%} + + +INITIALIZE +%{ + /* check of the input parameters */ + if (xwidth < 0.0 || yheight < 0.0 || radius < 0.0 || r_i < 0.0 || Lmin < 0.0 || Lmax < 0.0 || dist < 0.0 || focus_xw < 0.0 || focus_yh < 0.0 || freq < 0.0 + || t_pulse < 0.0 || T1 < 0.0 || I1 < 0.0 || tau1 < 0.0 || T2 < 0.0 || I2 < 0.0 || tau2 < 0.0 || T3 < 0.0 || I3 < 0.0 || tau3 < 0.0 || n_mod < 0.0 + || I_um < 0.0 || tau_um < 0.0 || n_um < 0.0 || chi_um < 0.0 || kap_um < 0.0) { + printf ("Source_pulsed: %s: Error: negative input parameter!\n" + "ERROR Exiting\n", + NAME_CURRENT_COMP); + exit (-1); + } + if (Lmax <= Lmin || t_max <= t_min) { + printf ("Source_pulsed: %s: Error: wavelength or time parameters do not match!\nERROR Exiting\n", NAME_CURRENT_COMP); + exit (-1); + } + + /* automatic distance */ + if (target_index > 0 && dist == 0.0) { + Coords ToTarget; + double tx, ty, tz; + ToTarget = coords_sub (POS_A_COMP_INDEX (INDEX_CURRENT_COMP + target_index), POS_A_CURRENT_COMP); + ToTarget = rot_apply (ROT_A_CURRENT_COMP, ToTarget); + coords_get (ToTarget, &tx, &ty, &tz); + dist = sqrt (tx * tx + ty * ty + tz * tz); + } + + /* pulse parameters */ + t_period = 1.0 / freq; + alpha = t_pulse / t_period; + + /* area for different moderator shapes */ + if (xwidth > 0.0 && yheight > 0.0) { + area = 10000.0 * xwidth * yheight; + } else if (radius > 0.0) { + area = 10000.0 * PI * radius * radius; + } else { + printf ("Source_pulsed: %s: Error: wavelength or time parameters do not match!\nERROR Exiting\n", NAME_CURRENT_COMP); + exit (-1); + } + p_in = (Lmax - Lmin) * (t_max - t_min) / mcget_ncount (); +%} + + +TRACE +%{ + double phi, /* [rad] orientation of the starting point for a spherical moderator */ + r, /* [m] distance of the starting point from moderator center */ + v, /* [m/s] speed of the neutron */ + time, /* [s] */ + lambda, /* [Ang] wavelength of the neutron */ + xf, /* [m] horizontal position on the target */ + yf, /* [m] vertical position on the target */ + rf, /* [m] distance between point on moderator and point on target */ + dx, /* [m] horizontal shift from moderator to target */ + dy, /* [m] vertical shift from moderator to target */ + Omega, /* [sr] solid angle of the target */ + flux; /* [1/(cm^2 s Ang sr] flux(lambda,time) */ + + /* Choose the starting point on the moderator surface with uniform distribution for different moderator shapes */ + if (xwidth > 0.0 && yheight > 0.0) { + x = xwidth * (rand01 () - 0.5); + y = yheight * (rand01 () - 0.5); + } else { + phi = 2 * PI * rand01 (); + r = sqrt (rand01 ()) * radius; + x = r * cos (phi); + y = r * sin (phi); + } + z = 0.0; + + /* Set zero polarization, choose wavelength and starting time */ + sx = 0.0; + sy = 0.0; + sz = 0.0; + + lambda = Lmin + (Lmax - Lmin) * rand01 (); + t = t_min + (t_max - t_min) * rand01 (); + + /* Propagate to target */ + randvec_target_rect_real (&xf, &yf, &rf, &Omega, 0, 0, dist, focus_xw, focus_yh, ROT_A_CURRENT_COMP, x, y, z, 2); + + /* Length of the flight path */ + dx = xf - x; + dy = yf - y; + rf = sqrt (dx * dx + dy * dy + dist * dist); + + /* speed of the neutron */ + v = 3956.0346 / lambda; + vx = v * dx / rf; + vy = v * dy / rf; + vz = v * dist / rf; + + /* Weight: flux in [1/(cm^2 s Ang sr] */ + flux = I_um * Mezei_N_fct (lambda, chi_um, kap_um) * Mezei_I_fct (t, tau_um, n_um, t_pulse); + if (r_i == 0.0 || r <= r_i) + flux += I1 * Maxwell (lambda, T1) * Mezei_I_fct (t, tau1, n_mod, t_pulse); + if (r_i == 0.0 || r > r_i) + flux += I2 * Maxwell (lambda, T2) * Mezei_I_fct (t, tau2, n_mod, t_pulse); + flux += I3 * Maxwell (lambda, T3) * Mezei_I_fct (t, tau3, n_mod, t_pulse); + + p = flux * area * Omega * p_in; /* [1] neutrons per pulse */ + p /= t_period; /* [1/s] time averaged intensity */ + + SCATTER; +%} + + +MCDISPLAY +%{ + double edge; /* [m] x and y position on the circle */ + + if (dist > 0.0) { + if (xwidth > 0.0 && yheight > 0.0) { + rectangle ("xy", 0, 0, 0, xwidth, yheight); + dashed_line (-xwidth / 2, -yheight / 2, 0, -focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (xwidth / 2, -yheight / 2, 0, focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (xwidth / 2, yheight / 2, 0, focus_xw / 2, focus_yh / 2, dist, 4); + dashed_line (-xwidth / 2, yheight / 2, 0, -focus_xw / 2, focus_yh / 2, dist, 4); + } else { + circle ("xy", 0, 0, 0, radius); + if (r_i > 0.0) + circle ("xy", 0, 0, 0, r_i); + edge = radius / sqrt (2.0); + dashed_line (-edge, -edge, 0, -focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (edge, -edge, 0, focus_xw / 2, -focus_yh / 2, dist, 4); + dashed_line (edge, edge, 0, focus_xw / 2, focus_yh / 2, dist, 4); + dashed_line (-edge, edge, 0, -focus_xw / 2, focus_yh / 2, dist, 4); + } + } +%} + +END diff --git a/mcstas-comps/contrib/Spherical_Backscattering_Analyser.comp b/mcstas-comps/contrib/Spherical_Backscattering_Analyser.comp index 092d84430..e51dfce36 100644 --- a/mcstas-comps/contrib/Spherical_Backscattering_Analyser.comp +++ b/mcstas-comps/contrib/Spherical_Backscattering_Analyser.comp @@ -50,10 +50,10 @@ SETTING PARAMETERS (xmin=0, xmax=0, ymin=0, ymax=0, mosaic=21.0, dspread=0.00035 SHARE %{ - double z_sphere(double xin, double yin, double rin) { - return -(rin - sqrt(rin*rin - xin*xin - yin*yin)); + double + z_sphere (double xin, double yin, double rin) { + return -(rin - sqrt (rin * rin - xin * xin - yin * yin)); } - %} DECLARE @@ -65,121 +65,126 @@ DECLARE INITIALIZE %{ - mos_rms = MIN2RAD*mosaic/sqrt(8*log(2)); - + mos_rms = MIN2RAD * mosaic / sqrt (8 * log (2)); + mono_Q = Q; - if (DM != 0) - mono_Q = 2*PI/DM; - - DM = 2*PI/mono_Q; - d_rms = dspread*DM/sqrt(8*log(2)); + if (DM != 0) + mono_Q = 2 * PI / DM; + + DM = 2 * PI / mono_Q; + d_rms = dspread * DM / sqrt (8 * log (2)); %} TRACE %{ double vel; - double sinTheta, lambdaBragg, lambda, dLambda2, sigmaLambda2; + double sinTheta, lambdaBragg, lambda, dLambda2, sigmaLambda2; double old_x, old_y, old_z, old_t, x0, y0, z0, xi, yi, zi; double a, b, c, dt1, dt2, dt; double nx, ny, nz, nmod, v; - double kproj, ydarwin, dkz, p_reflect; + double kproj, ydarwin, dkz, p_reflect; double q0mod, q0x, q0y, q0z, kix, kiy, kiz, kfx, kfy, kfz; - + double omega_doppler; double v_doppler_inst; - - omega_doppler=2*PI*f_doppler; - old_x=x; old_y=y; old_z=z; old_t=t; - - // Time interval necessary for the neutron to reach the sphere: solve equation: neutron path (line) crosses monochromator (sphere). Center of sphere is at (0,0,-radius). - -//point on neutron path satisfies: xpath= x+vx*t, ypath=y+vy*t, zpath=z+vz*t; -//point on monochromator sphere satisfies: radius^2=x^2+y^2+(z+r)^2 -//settings these equal gives an equation for t: - a = vx*vx + vy*vy + vz*vz; - b = 2.0 * ( vx*x + vy*y + vz*(z+radius) ); - c = x*x+y*y+z*z + 2*z*radius; - if ((b*b-4*a*c) < 0) - { - printf("Imaginary solutions. Something has gone wrong. Unphysical.\n"); - ABSORB; - } - dt1 = (-b + sqrt(b*b-4*a*c)) / (2.0*a); - dt2 = (-b - sqrt(b*b-4*a*c)) / (2.0*a); + + omega_doppler = 2 * PI * f_doppler; + old_x = x; + old_y = y; + old_z = z; + old_t = t; + + // Time interval necessary for the neutron to reach the sphere: solve equation: neutron path (line) crosses monochromator (sphere). Center of sphere is at + // (0,0,-radius). + + // point on neutron path satisfies: xpath= x+vx*t, ypath=y+vy*t, zpath=z+vz*t; + // point on monochromator sphere satisfies: radius^2=x^2+y^2+(z+r)^2 + // settings these equal gives an equation for t: + a = vx * vx + vy * vy + vz * vz; + b = 2.0 * (vx * x + vy * y + vz * (z + radius)); + c = x * x + y * y + z * z + 2 * z * radius; + if ((b * b - 4 * a * c) < 0) { + printf ("Imaginary solutions. Something has gone wrong. Unphysical.\n"); + ABSORB; + } + dt1 = (-b + sqrt (b * b - 4 * a * c)) / (2.0 * a); + dt2 = (-b - sqrt (b * b - 4 * a * c)) / (2.0 * a); if (dt1 > 0) - dt = dt1; + dt = dt1; else - dt = dt2; + dt = dt2; // propagates the neutron the time dt, so it arrives to the sphere - PROP_DT(dt); - -// ABSORB if neutron hits outside sphere - if (xxmax || yymax) + PROP_DT (dt); + + // ABSORB if neutron hits outside sphere + if (x < xmin || x > xmax || y < ymin || y > ymax) ABSORB; -//n is a vector pointing along the radius of the sphere - nx =x; - ny= y; - nz=(z+radius); -//modulus of the vector n -nmod = sqrt(nx*nx+ny*ny+nz*nz); - -// change to moving coordinates (doppler motion parallel to Z) - v_doppler_inst=A_doppler*omega_doppler*cos(omega_doppler*t); - kix = vx*V2K; kiy = vy*V2K ; kiz = vz*V2K + v_doppler_inst*V2K; - -// projection of the incident vector on the normal - kproj = (kix*nx + kiy*ny + kiz*nz) / nmod; - - vel=sqrt(a); - - sinTheta = fabs(K2V*kproj)/vel; - - // calculate lambdaBragg - lambdaBragg = 2.0*DM*sinTheta; - - // calculate lambda of neutron - lambda = 2*PI/kproj; - - // calculate deltaLambda squared and sigmaLambda squared - dLambda2 = (lambda-lambdaBragg)*(lambda-lambdaBragg); - // The sigmaLambda is propagated by differentiating the bragg - // condition: Lambda = 2*d*sinTheta - - sigmaLambda2 = 2.0*2.0 * sinTheta*sinTheta * d_rms*d_rms+2.0*2.0 * DM*DM * (1.0-sinTheta*sinTheta) * mos_rms*mos_rms; - - p_reflect = R0*exp(-dLambda2/(2.0*sigmaLambda2)); - - if (p_reflect < 1e-5) - { - ABSORB; - } - else - { - // reflection: kf = ki - Q0 (the projection): q points along the normal and to scatter elastically, the component of ki along the normal must change sign, i.e. q0mod=2kproj + // n is a vector pointing along the radius of the sphere + nx = x; + ny = y; + nz = (z + radius); + // modulus of the vector n + nmod = sqrt (nx * nx + ny * ny + nz * nz); + + // change to moving coordinates (doppler motion parallel to Z) + v_doppler_inst = A_doppler * omega_doppler * cos (omega_doppler * t); + kix = vx * V2K; + kiy = vy * V2K; + kiz = vz * V2K + v_doppler_inst * V2K; + + // projection of the incident vector on the normal + kproj = (kix * nx + kiy * ny + kiz * nz) / nmod; + + vel = sqrt (a); + + sinTheta = fabs (K2V * kproj) / vel; + + // calculate lambdaBragg + lambdaBragg = 2.0 * DM * sinTheta; + + // calculate lambda of neutron + lambda = 2 * PI / kproj; + + // calculate deltaLambda squared and sigmaLambda squared + dLambda2 = (lambda - lambdaBragg) * (lambda - lambdaBragg); + // The sigmaLambda is propagated by differentiating the bragg + // condition: Lambda = 2*d*sinTheta + + sigmaLambda2 = 2.0 * 2.0 * sinTheta * sinTheta * d_rms * d_rms + 2.0 * 2.0 * DM * DM * (1.0 - sinTheta * sinTheta) * mos_rms * mos_rms; + + p_reflect = R0 * exp (-dLambda2 / (2.0 * sigmaLambda2)); + + if (p_reflect < 1e-5) { + ABSORB; + } else { + // reflection: kf = ki - Q0 (the projection): q points along the normal and to scatter elastically, the component of ki along the normal must change sign, + // i.e. q0mod=2kproj q0mod = 2.0 * kproj; - q0x = (nx/nmod)*q0mod; q0y = (ny/nmod)*q0mod; q0z = (nz/nmod)*q0mod; + q0x = (nx / nmod) * q0mod; + q0y = (ny / nmod) * q0mod; + q0z = (nz / nmod) * q0mod; kfx = kix - q0x; kfy = kiy - q0y; kfz = kiz - q0z; - - /* change to static coordinates */ - kfz = kfz - v_doppler_inst*V2K; - - vx = K2V*kfx; - vy = K2V*kfy; - vz = K2V*kfz; - - p *= p_reflect; + + /* change to static coordinates */ + kfz = kfz - v_doppler_inst * V2K; + + vx = K2V * kfx; + vy = K2V * kfy; + vz = K2V * kfz; + + p *= p_reflect; SCATTER; } - - if(debug > 0) { - printf("\n Lambda: %f, Lambda_Bragg: %f\n", lambda, lambdaBragg); - printf("sigmaLambda: %f, R0: %f, p_reflect: %f\n", - sqrt(sigmaLambda2), R0, p_reflect);} + + if (debug > 0) { + printf ("\n Lambda: %f, Lambda_Bragg: %f\n", lambda, lambdaBragg); + printf ("sigmaLambda: %f, R0: %f, p_reflect: %f\n", sqrt (sigmaLambda2), R0, p_reflect); + } %} MCDISPLAY @@ -190,55 +195,59 @@ MCDISPLAY dashed_line(xmax,ymax,0,xmax,ymin,0,5); dashed_line(xmax,ymin,0,xmin,ymin,0,5);*/ -/* Step across the sphere in 11x11 steps to show the analyzer geometry */ - int i,j,N; - double yv1,yv2,zv1,zv2; - double xh1,xh2,zh1,zh2; - double xd1,xd2,yd1,yd2,xd3,xd4,yd3,yd4,zd1,zd2,zd3,zd4; - double dx,dy,dd; - N=11; - dx = (xmax-xmin)/(N-1); - dy = (ymax-ymin)/(N-1); + /* Step across the sphere in 11x11 steps to show the analyzer geometry */ + int i, j, N; + double yv1, yv2, zv1, zv2; + double xh1, xh2, zh1, zh2; + double xd1, xd2, yd1, yd2, xd3, xd4, yd3, yd4, zd1, zd2, zd3, zd4; + double dx, dy, dd; + N = 11; + dx = (xmax - xmin) / (N - 1); + dy = (ymax - ymin) / (N - 1); /* Horizontal, vertical, diagonal lines... */ - xh1=xmin; - yv1=ymin; - xd1=xmin; - yd1=ymin; - xd3=xmin; - yd3=ymax; - for (i=0; i 0) - {sy = 1.0; S_check=1;} - }while (S_check == 0); + int S_check; + sx = 0.0; + sz = 0.0; + do { + sy = randpm1 (); + S_check = 0; + if (sy < 0) { + sy = -1.0; + S_check = 1; + } + if (sy > 0) { + sy = 1.0; + S_check = 1; + } + } while (S_check == 0); %} END diff --git a/mcstas-comps/contrib/Spot_sample.comp b/mcstas-comps/contrib/Spot_sample.comp index 5de91cd40..b41b979ab 100644 --- a/mcstas-comps/contrib/Spot_sample.comp +++ b/mcstas-comps/contrib/Spot_sample.comp @@ -72,14 +72,13 @@ xwidth=0, yheight=0, zthick=0, Eideal=100.0,w=50.0,two_theta=25.0,n_spots=4) SHARE %{ -struct StructVarsVspot -{ -double sigma_a; /* Absorption cross section per atom (barns) */ + struct StructVarsVspot { + double sigma_a; /* Absorption cross section per atom (barns) */ double sigma_i; /* Incoherent scattering cross section per atom (barns) */ double rho; /* Density of atoms (AA-3) */ double my_s; double my_a_v; - char isrect; /* true when sample is a box */ + char isrect; /* true when sample is a box */ }; %} @@ -91,122 +90,113 @@ INITIALIZE %{ if (!radius_o || !h) { - if (!xwidth || !yheight || !zthick) exit(fprintf(stderr,"V_sample: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - else VarsV.isrect=1; } - else VarsV.isrect=0; - - VarsV.sigma_a=5.08; /* in barns */ - VarsV.sigma_i=4.935; - VarsV.rho = (2*pack/(3.024*3.024*3.024)); - VarsV.my_s=(VarsV.rho * 100 * VarsV.sigma_i); - VarsV.my_a_v=(VarsV.rho * 100 * VarsV.sigma_a * 2200); + if (!xwidth || !yheight || !zthick) + exit (fprintf (stderr, "V_sample: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + else + VarsV.isrect = 1; + } else + VarsV.isrect = 0; + + VarsV.sigma_a = 5.08; /* in barns */ + VarsV.sigma_i = 4.935; + VarsV.rho = (2 * pack / (3.024 * 3.024 * 3.024)); + VarsV.my_s = (VarsV.rho * 100 * VarsV.sigma_i); + VarsV.my_a_v = (VarsV.rho * 100 * VarsV.sigma_a * 2200); /* now compute target coords if a component index is supplied */ - %} TRACE %{ - double t0, t3; /* Entry/exit time for outer cylinder */ - double t1, t2; /* Entry/exit time for inner cylinder */ - double v; /* Neutron velocity */ - double dt0, dt1, dt2, dt; /* Flight times through sample */ - double l_full; /* Flight path length for non-scattered neutron */ - double l_i, l_o=0; /* Flight path lenght in/out for scattered neutron */ - double my_a; /* Velocity-dependent attenuation factor */ - double solid_angle=0; /* Solid angle of target as seen from scattering point */ - double aim_x, aim_y, aim_z; /* Position of target relative to scattering point */ - double kix,kiy,kiz,qx,qy,qz; - double kf,kfx,kfy,kfz,kiideal,kfideal,Efideal; - double Ef,Ei,pol,rbool; + double t0, t3; /* Entry/exit time for outer cylinder */ + double t1, t2; /* Entry/exit time for inner cylinder */ + double v; /* Neutron velocity */ + double dt0, dt1, dt2, dt; /* Flight times through sample */ + double l_full; /* Flight path length for non-scattered neutron */ + double l_i, l_o = 0; /* Flight path lenght in/out for scattered neutron */ + double my_a; /* Velocity-dependent attenuation factor */ + double solid_angle = 0; /* Solid angle of target as seen from scattering point */ + double aim_x, aim_y, aim_z; /* Position of target relative to scattering point */ + double kix, kiy, kiz, qx, qy, qz; + double kf, kfx, kfy, kfz, kiideal, kfideal, Efideal; + double Ef, Ei, pol, rbool; int spot; - int intersect=0; + int intersect = 0; if (VarsV.isrect) - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zthick); else - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius_o, h); - if(intersect) - { - if(t0 < 0) ABSORB; /* we already passed the sample */ + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius_o, h); + if (intersect) { + if (t0 < 0) + ABSORB; /* we already passed the sample */ /* Neutron enters at t=t0. */ - dt0 = t3-t0; /* Time in sample, */ - v = sqrt(vx*vx + vy*vy + vz*vz); - kix=vx*V2K;kiy=vy*V2K;kiz=vz*V2K; - Ei=v*v*VS2E; - l_full = v * (dt0); /* Length of full path through sample */ - dt = rand01()*(dt0); /* Time of scattering (relative to t0) */ - l_i = v*dt; /* Penetration in sample */ - - PROP_DT(dt+t0); /* Point of scattering */ - - Efideal=Eideal-w; - kfideal=sqrt(Efideal/2.0723); - kiideal=SE2V*sqrt(Eideal)*V2K; - spot=floor(n_spots*rand01())+1; - pol=(spot-1)*2.0*PI/n_spots; - qz=kiideal-kfideal*cos(two_theta*DEG2RAD); - qx=-kfideal*cos(pol)*sin(two_theta*DEG2RAD); - qy=-kfideal*sin(pol)*sin(two_theta*DEG2RAD); - kfx=kix-qx; - kfy=kiy-qy; - kfz=kiz-qz; - - - - if(!VarsV.isrect) { - if(!cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius_o, h)) - { + dt0 = t3 - t0; /* Time in sample, */ + v = sqrt (vx * vx + vy * vy + vz * vz); + kix = vx * V2K; + kiy = vy * V2K; + kiz = vz * V2K; + Ei = v * v * VS2E; + l_full = v * (dt0); /* Length of full path through sample */ + dt = rand01 () * (dt0); /* Time of scattering (relative to t0) */ + l_i = v * dt; /* Penetration in sample */ + + PROP_DT (dt + t0); /* Point of scattering */ + + Efideal = Eideal - w; + kfideal = sqrt (Efideal / 2.0723); + kiideal = SE2V * sqrt (Eideal) * V2K; + spot = floor (n_spots * rand01 ()) + 1; + pol = (spot - 1) * 2.0 * PI / n_spots; + qz = kiideal - kfideal * cos (two_theta * DEG2RAD); + qx = -kfideal * cos (pol) * sin (two_theta * DEG2RAD); + qy = -kfideal * sin (pol) * sin (two_theta * DEG2RAD); + kfx = kix - qx; + kfy = kiy - qy; + kfz = kiz - qz; + + if (!VarsV.isrect) { + if (!cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius_o, h)) { /* ??? did not hit cylinder */ - printf("FATAL ERROR: Did not hit cylinder from inside.\n"); - exit(1); + printf ("FATAL ERROR: Did not hit cylinder from inside.\n"); + exit (1); } dt = t3; } - vx = kfx*K2V; - vy = kfy*K2V; - vz = kfz*K2V; + vx = kfx * K2V; + vy = kfy * K2V; + vz = kfz * K2V; /*printf("vx:%g vy:%g vz:%g \n", vx,vy,vz);*/ - my_a = VarsV.my_a_v/v; - p*=1; + my_a = VarsV.my_a_v / v; + p *= 1; SCATTER; } %} MCDISPLAY %{ - + if (!VarsV.isrect) { - circle("xz", 0, h/2.0, 0, radius_o); - circle("xz", 0, -h/2.0, 0, radius_o); - line(-radius_o, -h/2.0, 0, -radius_o, +h/2.0, 0); - line(+radius_o, -h/2.0, 0, +radius_o, +h/2.0, 0); - line(0, -h/2.0, -radius_o, 0, +h/2.0, -radius_o); - line(0, -h/2.0, +radius_o, 0, +h/2.0, +radius_o); - } - else - { - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double zmin = -0.5*zthick; - double zmax = 0.5*zthick; - multiline(5, xmin, ymin, zmin, - xmax, ymin, zmin, - xmax, ymax, zmin, - xmin, ymax, zmin, - xmin, ymin, zmin); - multiline(5, xmin, ymin, zmax, - xmax, ymin, zmax, - xmax, ymax, zmax, - xmin, ymax, zmax, - xmin, ymin, zmax); - line(xmin, ymin, zmin, xmin, ymin, zmax); - line(xmax, ymin, zmin, xmax, ymin, zmax); - line(xmin, ymax, zmin, xmin, ymax, zmax); - line(xmax, ymax, zmin, xmax, ymax, zmax); + circle ("xz", 0, h / 2.0, 0, radius_o); + circle ("xz", 0, -h / 2.0, 0, radius_o); + line (-radius_o, -h / 2.0, 0, -radius_o, +h / 2.0, 0); + line (+radius_o, -h / 2.0, 0, +radius_o, +h / 2.0, 0); + line (0, -h / 2.0, -radius_o, 0, +h / 2.0, -radius_o); + line (0, -h / 2.0, +radius_o, 0, +h / 2.0, +radius_o); + } else { + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double zmin = -0.5 * zthick; + double zmax = 0.5 * zthick; + multiline (5, xmin, ymin, zmin, xmax, ymin, zmin, xmax, ymax, zmin, xmin, ymax, zmin, xmin, ymin, zmin); + multiline (5, xmin, ymin, zmax, xmax, ymin, zmax, xmax, ymax, zmax, xmin, ymax, zmax, xmin, ymin, zmax); + line (xmin, ymin, zmin, xmin, ymin, zmax); + line (xmax, ymin, zmin, xmax, ymin, zmax); + line (xmin, ymax, zmin, xmin, ymax, zmax); + line (xmax, ymax, zmin, xmax, ymax, zmax); } %} diff --git a/mcstas-comps/contrib/StatisticalChopper.comp b/mcstas-comps/contrib/StatisticalChopper.comp index c81871731..a2fd2a8df 100644 --- a/mcstas-comps/contrib/StatisticalChopper.comp +++ b/mcstas-comps/contrib/StatisticalChopper.comp @@ -53,135 +53,138 @@ string sequence="NULL") DECLARE %{ -double delta_y; -double height; -double omega; -int *Sequence; /* Array containing 0=closed and 1=opened*/ -int *SequenceIndex; /* index of '1' in the sequence */ -int nslit; -int m; /* sum of opened slits ('1' in sequence) */ + double delta_y; + double height; + double omega; + int* Sequence; /* Array containing 0=closed and 1=opened*/ + int* SequenceIndex; /* index of '1' in the sequence */ + int nslit; + int m; /* sum of opened slits ('1' in sequence) */ %} INITIALIZE %{ - Sequence=NULL; - SequenceIndex=NULL; - nslit=0; - m=0; - + Sequence = NULL; + SequenceIndex = NULL; + nslit = 0; + m = 0; /* If slit height 'unset', assume full opening */ if (yheight == 0) { - height=radius; + height = radius; } else { - height=yheight; + height = yheight; } - delta_y = radius-height/2; /* radius at beam center */ - omega=2.0*PI*nu; /* rad/s */ - + delta_y = radius - height / 2; /* radius at beam center */ + omega = 2.0 * PI * nu; /* rad/s */ + if (!sequence) { - fprintf(stderr,"StatisticalChopper: %s: sequence is NULL. \n", NAME_CURRENT_COMP); - exit(-1); + fprintf (stderr, "StatisticalChopper: %s: sequence is NULL. \n", NAME_CURRENT_COMP); + exit (-1); + } + if (strlen (sequence) <= 2) { + fprintf (stderr, "StatisticalChopper: %s: Sequence is too short (length=%i). Use conventional DiskChopper instead.\n", NAME_CURRENT_COMP, nslit); + exit (-1); + } + if (!strlen (sequence) || !strcmp (sequence, "NULL")) + strcpy (sequence, "100000010101001101110010010011110111111001011000011101001010111100101011111011010011011111000100011011100010000010001101101010100001110111" + "001011111011001110001100011011011110101010000000110000011110011010100101011100000001001101000111100010110110001100100"); + + if (yheight && yheight > radius) { + fprintf (stderr, "StatisticalChopper: %s: yheight must be < radius\n", NAME_CURRENT_COMP); + exit (-1); } - if (strlen(sequence) <=2) { - fprintf(stderr,"StatisticalChopper: %s: Sequence is too short (length=%i). Use conventional DiskChopper instead.\n", NAME_CURRENT_COMP, nslit); - exit(-1); + if (isfirst && n_pulse <= 0) { + fprintf (stderr, "StatisticalChopper: %s: wrong First chopper pulse number (n_pulse=%g)\n", NAME_CURRENT_COMP, n_pulse); + exit (-1); } - if (!strlen(sequence) || !strcmp(sequence,"NULL")) - strcpy(sequence, -"100000010101001101110010010011110111111001011000011101001010111100101011111011010011011111000100011011100010000010001101101010100001110111001011111011001110001100011011011110101010000000110000011110011010100101011100000001001101000111100010110110001100100" - ); - - if (yheight && yheight>radius) { - fprintf(stderr,"StatisticalChopper: %s: yheight must be < radius\n", NAME_CURRENT_COMP); - exit(-1); } - if (isfirst && n_pulse <=0) { - fprintf(stderr,"StatisticalChopper: %s: wrong First chopper pulse number (n_pulse=%g)\n", NAME_CURRENT_COMP, n_pulse); - exit(-1); } if (!omega) { - fprintf(stderr,"StatisticalChopper: %s WARNING: chopper frequency is 0!\n", NAME_CURRENT_COMP); + fprintf (stderr, "StatisticalChopper: %s WARNING: chopper frequency is 0!\n", NAME_CURRENT_COMP); omega = 1e-15; /* We should actually use machine epsilon here... */ } if (!abs_out) { - fprintf(stderr,"StatisticalChopper: %s WARNING: chopper will NOT absorb neutrons outside radius %g [m]\n", NAME_CURRENT_COMP, radius); + fprintf (stderr, "StatisticalChopper: %s WARNING: chopper will NOT absorb neutrons outside radius %g [m]\n", NAME_CURRENT_COMP, radius); } - + /* Calulate delay from phase and vice versa, 'direction' moderated by sign of omega */ - delay *=omega/fabs(omega); + delay *= omega / fabs (omega); if (phase) { if (delay) { - fprintf(stderr,"StatisticalChopper: %s WARNING: delay AND phase specified. Using phase setting\n", NAME_CURRENT_COMP); + fprintf (stderr, "StatisticalChopper: %s WARNING: delay AND phase specified. Using phase setting\n", NAME_CURRENT_COMP); } - phase*=DEG2RAD; + phase *= DEG2RAD; /* 'Delay' should always be a delay, taking rotation direction into account: */ - delay=omega*phase/(omega*omega); + delay = omega * phase / (omega * omega); } else { - phase=delay*omega; /* rad */ + phase = delay * omega; /* rad */ } - + if (verbose && nu) { - printf("StatisticalChopper: %s: frequency=%g [Hz] %g [rpm] time frame=%g [s] phase=%g [deg]\n", - NAME_CURRENT_COMP, nu, nu*60, fabs(1/nu), phase*RAD2DEG); - printf(" height=%g [m], slits centered at radius=%g [m]\n", - height, delta_y); + printf ("StatisticalChopper: %s: frequency=%g [Hz] %g [rpm] time frame=%g [s] phase=%g [deg]\n", NAME_CURRENT_COMP, nu, nu * 60, fabs (1 / nu), + phase * RAD2DEG); + printf (" height=%g [m], slits centered at radius=%g [m]\n", height, delta_y); } - - nslit=strlen(sequence); - - if (nslit>1) { - int i=0,j=0; - double c=0; - int index=0; - - Sequence = malloc(nslit * sizeof(int)); - SequenceIndex = malloc(nslit * sizeof(int)); - - if (!Sequence){ - fprintf(stderr,"StatisticalChopper: %s: Memory exhausted when allocating chopper sequence.\n", NAME_CURRENT_COMP); - exit(-1); + + nslit = strlen (sequence); + + if (nslit > 1) { + int i = 0, j = 0; + double c = 0; + int index = 0; + + Sequence = malloc (nslit * sizeof (int)); + SequenceIndex = malloc (nslit * sizeof (int)); + + if (!Sequence) { + fprintf (stderr, "StatisticalChopper: %s: Memory exhausted when allocating chopper sequence.\n", NAME_CURRENT_COMP); + exit (-1); } - if (!SequenceIndex){ - fprintf(stderr,"StatisticalChopper: %s: Memory exhausted when allocating chopper sequence table lookup.\n", NAME_CURRENT_COMP); + if (!SequenceIndex) { + fprintf (stderr, "StatisticalChopper: %s: Memory exhausted when allocating chopper sequence table lookup.\n", NAME_CURRENT_COMP); } /* build sequence index (where sequence==1) */ - for (i=0;iradius*radius) { + if (abs_out && (x * x + yprime * yprime) > radius * radius) { ABSORB; } /* Does neutron hit inner solid part of chopper in case of yheight!=radius ? */ - if ((x*x+yprime*yprime)<(radius-height)*(radius-height)) { + if ((x * x + yprime * yprime) < (radius - height) * (radius - height)) { ABSORB; } - + if (isfirst && SequenceIndex) { /* choose a slit in the sequence and set time accordingly */ - t = atan2(x,yprime)/omega + SequenceIndex[(int)(rand01()*m)]/nslit/nu - -delay +jitter*randnorm()+ (n_pulse > 1 ? floor(n_pulse*rand01()/fabs(nu)) : 0); - p *= (double)m/(double)nslit; /* transmission */ + t = atan2 (x, yprime) / omega + SequenceIndex[(int)(rand01 () * m)] / nslit / nu - delay + jitter * randnorm () + + (n_pulse > 1 ? floor (n_pulse * rand01 () / fabs (nu)) : 0); + p *= (double)m / (double)nslit; /* transmission */ } else { /* check if we pass through a slit */ int seq; - double angle = 2*PI*nu*(t-atan2(x,yprime)/omega+jitter*randnorm()) - phase; - seq=(int) floor(angle*nslit/(2*PI)) % nslit; - if ( seq < 0 ) seq += nslit; - if (Sequence[seq]) SCATTER; - else ABSORB; + double angle = 2 * PI * nu * (t - atan2 (x, yprime) / omega + jitter * randnorm ()) - phase; + seq = (int)floor (angle * nslit / (2 * PI)) % nslit; + if (seq < 0) + seq += nslit; + if (Sequence[seq]) + SCATTER; + else + ABSORB; } %} FINALLY %{ - free(Sequence); Sequence=NULL; - free(SequenceIndex); SequenceIndex=NULL; + free (Sequence); + Sequence = NULL; + free (SequenceIndex); + SequenceIndex = NULL; %} MCDISPLAY %{ int i; - double radius_min=radius-height; - - circle("xy", 0.0, -radius, 0.0, radius); - for (i=0; i= 1 && f >= 1 && nslit > 1 && detector.m > 1 && c < 1 && nu > 0 && Sequence) { double S_sum = 0; - int i,j,k; /* indices for loops */ + int i, j, k; /* indices for loops */ /* copy raw detector as correlation base */ - long correlation_m = detector.m/f; /* new time binning for autocorrelation */ + long correlation_m = detector.m / f; /* new time binning for autocorrelation */ - double *p0=malloc(correlation_m*detector.n*detector.p*sizeof(double)); /* Arrays to store correlation monitor */ - double *p1=malloc(correlation_m*detector.n*detector.p*sizeof(double)); - double *p2=malloc(correlation_m*detector.n*detector.p*sizeof(double)); - if(p0 && p1 && p2) { + double* p0 = malloc (correlation_m * detector.n * detector.p * sizeof (double)); /* Arrays to store correlation monitor */ + double* p1 = malloc (correlation_m * detector.n * detector.p * sizeof (double)); + double* p2 = malloc (correlation_m * detector.n * detector.p * sizeof (double)); + if (p0 && p1 && p2) { /* initialize arrays to zero */ - for (i=0;i 0) p2[i] = (p0[i] > 1 ? ((p0[i]-1)*p2[i]*p2[i] + p1[i]*p1[i]/p0[i])/p0[i] - : p1[i]); + for (i = 0; i < correlation_m * detector.n * detector.p; i++) { + p2[i] /= (double)(m * m * f * f * (1 - c) * (1 - c)); + if (p2[i] > 0) + p2[i] = (p0[i] > 1 ? ((p0[i] - 1) * p2[i] * p2[i] + p1[i] * p1[i] / p0[i]) / p0[i] : p1[i]); } char file[CHAR_BUF_LENGTH]; - sprintf(file, "%s_corr", filename ? filename : NAME_CURRENT_COMP); + sprintf (file, "%s_corr", filename ? filename : NAME_CURRENT_COMP); if (detector.rank == 1) - DETECTOR_OUT_1D("Correlation monitor", - detector.xlabel,detector.ylabel, - detector.xvar,detector.xmin,detector.xmax,correlation_m, - p0,p1,p2,file); + DETECTOR_OUT_1D ("Correlation monitor", detector.xlabel, detector.ylabel, detector.xvar, detector.xmin, detector.xmax, correlation_m, p0, p1, p2, file); else if (detector.rank == 2) - DETECTOR_OUT_2D("Correlation monitor", - detector.xlabel,detector.ylabel, - detector.xmin,detector.xmax,detector.ymin,detector.ymax, - correlation_m,detector.n, - p0,p1,p2,file); - free(p0);free(p1);free(p2); + DETECTOR_OUT_2D ("Correlation monitor", detector.xlabel, detector.ylabel, detector.xmin, detector.xmax, detector.ymin, detector.ymax, correlation_m, + detector.n, p0, p1, p2, file); + free (p0); + free (p1); + free (p2); } else { - fprintf(stderr,"WARNING: StatisticalChopper_monitor %s: Could not allocate arrays for monitor output. Skipped writing...\n",NAME_CURRENT_COMP); + fprintf (stderr, "WARNING: StatisticalChopper_monitor %s: Could not allocate arrays for monitor output. Skipped writing...\n", NAME_CURRENT_COMP); } } - %} FINALLY INHERIT Monitor_nD diff --git a/mcstas-comps/contrib/SupermirrorFlat.comp b/mcstas-comps/contrib/SupermirrorFlat.comp index 4a7b11812..0b2555c08 100644 --- a/mcstas-comps/contrib/SupermirrorFlat.comp +++ b/mcstas-comps/contrib/SupermirrorFlat.comp @@ -199,243 +199,226 @@ NOACC SHARE %{ -#ifndef SUPERMIRROR -%include "supermirror-lib" -#define SUPERMIRROR -#endif - + #ifndef SUPERMIRROR + %include "supermirror-lib" + #define SUPERMIRROR + #endif %} DECLARE %{ - Coords translation_second_coords; - Coords side_edge_normal_coords; - Coords side_edge_point_coords; - - Supermirror sm; - - int initialised; - - int i; - int j; - int n; - int m; - double xx; - double yy; - double zz; - - double w_sm; - double t_sm; - Coords p_sm; - Coords v_sm; - Coords s_sm; - double last_exit_time; - Coords last_exit_point; - int last_exit_plane; - - int num_intersect; - double first_intersect_dtime; - Coords first_intersect_dpoint; - double first_intersect_time; - Coords first_intersect_point; - int is_tracking; - int first_intersect_plane; - int outcome1; - int outcome2; - - NeutronRecord *neutron_record; - int number_of_neutron_records; + Coords translation_second_coords; + Coords side_edge_normal_coords; + Coords side_edge_point_coords; + + Supermirror sm; + + int initialised; + + int i; + int j; + int n; + int m; + double xx; + double yy; + double zz; + + double w_sm; + double t_sm; + Coords p_sm; + Coords v_sm; + Coords s_sm; + double last_exit_time; + Coords last_exit_point; + int last_exit_plane; + + int num_intersect; + double first_intersect_dtime; + Coords first_intersect_dpoint; + double first_intersect_time; + Coords first_intersect_point; + int is_tracking; + int first_intersect_plane; + int outcome1; + int outcome2; + + NeutronRecord* neutron_record; + int number_of_neutron_records; %} INITIALIZE %{ - printf("\tSupermirrorFlat.comp: INITIALIZE \n"); - printf("\tname=%s\n",NAME_CURRENT_COMP); - printf("\tlength = %g m, thickness_in_mm = %g mm\n",length,thickness_in_mm); - printf("\tside_edge normal,point = (%g,%g,%g), (%g,%g,%g) m\n", - side_edge_normal[0], side_edge_normal[1], side_edge_normal[2], - side_edge_point[0], side_edge_point[1], side_edge_point[2] - ); - printf("\tmirror_coated_side = %s\n",mirror_coated_side); - printf("\tmirror_spin_plus_material name,m = %s, %g\n",mirror_spin_plus_material_name, mirror_spin_plus_m); - printf("\tmirror_spin_minus_material name,m = %s, %g\n",mirror_spin_minus_material_name, mirror_spin_minus_m); - printf("\tsubstrate_material name = %s\n",substrate_material_name); - printf("\tabsorber_coated_side = %s\n",absorber_coated_side); - printf("\tabsorber_material name,thickness in micron = %s, %g\n",absorber_material_name, absorber_thickness_in_micron); - printf("\tinitial_placement_at_origin = %s\n",initial_placement_at_origin); - printf("\ttilt_y_axis_location = %s\n",tilt_y_axis_location); - printf("\ttilt_about_y_first_in_degree, translation_second, rot_about_z_third_in_degree = %g deg, (%g,%g,%g) m, %g deg\n", - tilt_about_y_first_in_degree, - translation_second_x, translation_second_y, translation_second_z, - rot_about_z_third_in_degree - ); - - side_edge_normal_coords = coords_set(side_edge_normal[0], side_edge_normal[1], side_edge_normal[2]); - side_edge_point_coords = coords_set(side_edge_point[0], side_edge_point[1], side_edge_point[2]); - translation_second_coords = coords_set(translation_second_x, translation_second_y, translation_second_z); - - if (strcmp(tracking, "DetailTracking") == 0) { - is_tracking = 1; - } - else { - is_tracking = 0; - } - - //Initialise using simplified initialise function - initialised = InitialiseStdSupermirrorFlat( - - NAME_CURRENT_COMP, - - length, //m supermirror length projection along z-axis - thickness_in_mm, //mm - side_edge_normal_coords, side_edge_point_coords, - - mirror_coated_side, //Sequential combination of keywords of - //position: "Both", "Top", "Bottom"; - //surface property: "Coated", "Substrate", "NoReflection"; - //e.g. "BothCoated", "BottomCoatedTopSubstrate", - //case-insensitive. - mirror_spin_plus_material_name, mirror_spin_plus_m, - mirror_spin_minus_material_name, mirror_spin_minus_m, - absorber_coated_side, //"BothCoated", "TopCoated", "BottomCoated", "BothNotCoated" - absorber_material_name, absorber_thickness_in_micron, - substrate_material_name, - - initial_placement_at_origin, //"TopFrontEdgeCentre","FrontSubstrateCentre","BottomFrontEdgeCentre" - tilt_y_axis_location, //"TopFrontEdge","TopMirrorCentre","TopBackEdge" - //"FrontSubstrateCentre","SubstrateCentre","BackSubstrateCentre", - //"BottomFrontEdge","BottomMirrorCentre","BottomBackEdge" - tilt_about_y_first_in_degree, //first, tile about x-axis at selected location - translation_second_coords, //second, translate reference point - rot_about_z_third_in_degree, //third, rotate about global z-axis - - is_tracking, - - &sm); - - if (is_tracking == 1) { - neutron_record = (sm.proc).nr; - } - + printf ("\tSupermirrorFlat.comp: INITIALIZE \n"); + printf ("\tname=%s\n", NAME_CURRENT_COMP); + printf ("\tlength = %g m, thickness_in_mm = %g mm\n", length, thickness_in_mm); + printf ("\tside_edge normal,point = (%g,%g,%g), (%g,%g,%g) m\n", side_edge_normal[0], side_edge_normal[1], side_edge_normal[2], side_edge_point[0], + side_edge_point[1], side_edge_point[2]); + printf ("\tmirror_coated_side = %s\n", mirror_coated_side); + printf ("\tmirror_spin_plus_material name,m = %s, %g\n", mirror_spin_plus_material_name, mirror_spin_plus_m); + printf ("\tmirror_spin_minus_material name,m = %s, %g\n", mirror_spin_minus_material_name, mirror_spin_minus_m); + printf ("\tsubstrate_material name = %s\n", substrate_material_name); + printf ("\tabsorber_coated_side = %s\n", absorber_coated_side); + printf ("\tabsorber_material name,thickness in micron = %s, %g\n", absorber_material_name, absorber_thickness_in_micron); + printf ("\tinitial_placement_at_origin = %s\n", initial_placement_at_origin); + printf ("\ttilt_y_axis_location = %s\n", tilt_y_axis_location); + printf ("\ttilt_about_y_first_in_degree, translation_second, rot_about_z_third_in_degree = %g deg, (%g,%g,%g) m, %g deg\n", tilt_about_y_first_in_degree, + translation_second_x, translation_second_y, translation_second_z, rot_about_z_third_in_degree); + + side_edge_normal_coords = coords_set (side_edge_normal[0], side_edge_normal[1], side_edge_normal[2]); + side_edge_point_coords = coords_set (side_edge_point[0], side_edge_point[1], side_edge_point[2]); + translation_second_coords = coords_set (translation_second_x, translation_second_y, translation_second_z); + + if (strcmp (tracking, "DetailTracking") == 0) { + is_tracking = 1; + } else { + is_tracking = 0; + } + + // Initialise using simplified initialise function + initialised = InitialiseStdSupermirrorFlat ( + + NAME_CURRENT_COMP, + + length, // m supermirror length projection along z-axis + thickness_in_mm, // mm + side_edge_normal_coords, side_edge_point_coords, + + mirror_coated_side, // Sequential combination of keywords of + // position: "Both", "Top", "Bottom"; + // surface property: "Coated", "Substrate", "NoReflection"; + // e.g. "BothCoated", "BottomCoatedTopSubstrate", + // case-insensitive. + mirror_spin_plus_material_name, mirror_spin_plus_m, mirror_spin_minus_material_name, mirror_spin_minus_m, + absorber_coated_side, //"BothCoated", "TopCoated", "BottomCoated", "BothNotCoated" + absorber_material_name, absorber_thickness_in_micron, substrate_material_name, + + initial_placement_at_origin, //"TopFrontEdgeCentre","FrontSubstrateCentre","BottomFrontEdgeCentre" + tilt_y_axis_location, //"TopFrontEdge","TopMirrorCentre","TopBackEdge" + //"FrontSubstrateCentre","SubstrateCentre","BackSubstrateCentre", + //"BottomFrontEdge","BottomMirrorCentre","BottomBackEdge" + tilt_about_y_first_in_degree, // first, tile about x-axis at selected location + translation_second_coords, // second, translate reference point + rot_about_z_third_in_degree, // third, rotate about global z-axis + + is_tracking, + + &sm); + + if (is_tracking == 1) { + neutron_record = (sm.proc).nr; + } %} TRACE %{ - - if (initialised != 0) { - - w_sm = p; - t_sm = t; - p_sm = coords_set(x, y, z); - v_sm = coords_set(vx, vy, vz); - s_sm = coords_set(sx, sy, sz); - - last_exit_time = F_INDETERMINED; - last_exit_point = coords_set(F_INDETERMINED,F_INDETERMINED,F_INDETERMINED); - last_exit_plane = I_INDETERMINED; - - //First check if neutron intersect supermirror - //IntersectStdSupermirrorFlat - //outcome: sm_Intersected, sm_Missed, sm_Error - outcome1 = IntersectStdSupermirrorFlat( - t_sm, p_sm, v_sm, last_exit_time, last_exit_point, last_exit_plane, - &sm, - &num_intersect, &first_intersect_dtime, &first_intersect_dpoint, &first_intersect_time, &first_intersect_point, &first_intersect_plane); - - switch (outcome1) { - case sm_Intersected: - { - //update neutron parameters - t = first_intersect_time; - coords_get(first_intersect_point, &x, &y, &z); - - SCATTER; - - //StdSupermirrorFlat - //outcome2: sm_Exited, sm_Absorbed, sm_Error - outcome2 = StdSupermirrorFlat( - &w_sm, &t_sm, &p_sm, &v_sm, &s_sm, &last_exit_time, &last_exit_point, &last_exit_plane, - &sm); - - if (is_tracking) { - number_of_neutron_records = (sm.proc).n_nr; - - //first output detail tracking - if (number_of_neutron_records > 1) { - for (i = 0; i < number_of_neutron_records; i++) { - p = (((sm.proc).nr)[i]).nr_w; - t = (((sm.proc).nr)[i]).nr_t; - coords_get((((sm.proc).nr)[i]).nr_p, &x, &y, &z); - coords_get((((sm.proc).nr)[i]).nr_v, &vx, &vy, &vz); - coords_get((((sm.proc).nr)[i]).nr_s, &sx, &sy, &sz); - - SCATTER; - } - } - } - - //get the final neutron parameters - p = w_sm; - t = t_sm; - coords_get(p_sm, &x, &y, &z); - coords_get(v_sm, &vx, &vy, &vz); - coords_get(s_sm, &sx, &sy, &sz); - - //outcome: sm_Exited, sm_Absorbed, sm_Error - switch (outcome2) { - case sm_Exited: - SCATTER; - break; - case sm_Absorbed: - ABSORB; - break; - case sm_Error: - p = 0; - printf("SupermirrorFlat.comp: StdSupermirrorFlat: outcome2=%s(%d), something's wrong.\n", - ((sm.proc).event)[outcome2], outcome2); - break; //something's wrong - default: - p = 0; - printf("SupermirrorFlat.comp: StdSupermirrorFlat returns outcome2=%d, something's wrong.\n", outcome2); - break; - } - } - case sm_Missed: - if (keep_if_missed == 0) p = 0; - break; - case sm_Error: - p = 0; //something's wrong - printf("SupermirrorFlat.comp: IntersectStdSupermirrorFlat returns outcome1=%s(%d), something's wrong.\n", - ((sm.proc).event)[outcome1], outcome1); - break; - default: - p = 0; - printf("SupermirrorFlat.comp: IntersectStdSupermirrorFlat returns outcome1=%d, something's wrong.\n", outcome1); - break; - } - } + + if (initialised != 0) { + + w_sm = p; + t_sm = t; + p_sm = coords_set (x, y, z); + v_sm = coords_set (vx, vy, vz); + s_sm = coords_set (sx, sy, sz); + + last_exit_time = F_INDETERMINED; + last_exit_point = coords_set (F_INDETERMINED, F_INDETERMINED, F_INDETERMINED); + last_exit_plane = I_INDETERMINED; + + // First check if neutron intersect supermirror + // IntersectStdSupermirrorFlat + // outcome: sm_Intersected, sm_Missed, sm_Error + outcome1 = IntersectStdSupermirrorFlat (t_sm, p_sm, v_sm, last_exit_time, last_exit_point, last_exit_plane, &sm, &num_intersect, &first_intersect_dtime, + &first_intersect_dpoint, &first_intersect_time, &first_intersect_point, &first_intersect_plane); + + switch (outcome1) { + case sm_Intersected: { + // update neutron parameters + t = first_intersect_time; + coords_get (first_intersect_point, &x, &y, &z); + + SCATTER; + + // StdSupermirrorFlat + // outcome2: sm_Exited, sm_Absorbed, sm_Error + outcome2 = StdSupermirrorFlat (&w_sm, &t_sm, &p_sm, &v_sm, &s_sm, &last_exit_time, &last_exit_point, &last_exit_plane, &sm); + + if (is_tracking) { + number_of_neutron_records = (sm.proc).n_nr; + + // first output detail tracking + if (number_of_neutron_records > 1) { + for (i = 0; i < number_of_neutron_records; i++) { + p = (((sm.proc).nr)[i]).nr_w; + t = (((sm.proc).nr)[i]).nr_t; + coords_get ((((sm.proc).nr)[i]).nr_p, &x, &y, &z); + coords_get ((((sm.proc).nr)[i]).nr_v, &vx, &vy, &vz); + coords_get ((((sm.proc).nr)[i]).nr_s, &sx, &sy, &sz); + + SCATTER; + } + } + } + + // get the final neutron parameters + p = w_sm; + t = t_sm; + coords_get (p_sm, &x, &y, &z); + coords_get (v_sm, &vx, &vy, &vz); + coords_get (s_sm, &sx, &sy, &sz); + + // outcome: sm_Exited, sm_Absorbed, sm_Error + switch (outcome2) { + case sm_Exited: + SCATTER; + break; + case sm_Absorbed: + ABSORB; + break; + case sm_Error: + p = 0; + printf ("SupermirrorFlat.comp: StdSupermirrorFlat: outcome2=%s(%d), something's wrong.\n", ((sm.proc).event)[outcome2], outcome2); + break; // something's wrong + default: + p = 0; + printf ("SupermirrorFlat.comp: StdSupermirrorFlat returns outcome2=%d, something's wrong.\n", outcome2); + break; + } + } + case sm_Missed: + if (keep_if_missed == 0) + p = 0; + break; + case sm_Error: + p = 0; // something's wrong + printf ("SupermirrorFlat.comp: IntersectStdSupermirrorFlat returns outcome1=%s(%d), something's wrong.\n", ((sm.proc).event)[outcome1], outcome1); + break; + default: + p = 0; + printf ("SupermirrorFlat.comp: IntersectStdSupermirrorFlat returns outcome1=%d, something's wrong.\n", outcome1); + break; + } + } %} FINALLY %{ - EmptySupermirrorFlatData(&sm); + EmptySupermirrorFlatData (&sm); %} MCDISPLAY %{ - Coords *vp1; - int *ifvi1; - int k1,k2; - n=sm.geo.nf; - vp1=sm.geo.vp; - for (i=0; i0) /* Neutron hits cylinder from the outside */ - ABSORB; - dt=cyl_t1; - PROP_DT(dt); - if(y>=(height/2-1E-7) || y<= -(height/2-1E-7)) /* Neutron hits cylinder ends; no detectors here */ - ABSORB; - -// Make the detector pixelated or continuos - if(pixel==0) - { - L_tot=L_chop2samp+sqrt(y*y+radius*radius); - lambda=(t-t_chop)/alpha/L_tot; - - lambda_real = 2*PI/(sqrt(vx*vx+vy*vy +vz*vz)*V2K); -// printf("dt = %g Delta-t= %g L0 = %g L-tot = %g x= %g y= %g z= %g lambda= %g lambda-real=%g \n", dt, t-t_chop, L_chop2samp, L_tot, x ,y, z, lambda, lambda_real); - } - - if(pixel==1) - { - L_tot=L_chop2samp+sqrt(y*y+radius*radius); - lambda=(t-t_chop)/alpha/L_tot; - phi_inplane = atan2(x,z); - phi_inplane =PI/nphi*round(phi_inplane*nphi/PI); - x = radius*sin(phi_inplane); - z = radius*cos(phi_inplane); - y = height/nh*round(y*nh/height); -// printf("x= %g y= %g z= %g lambda= %g \n", x ,y, z, lambda); - } - -// Calculate where the neutron hits the detector - phi = acos(z/sqrt(x*x+y*y+z*z)); /* x-axis value */ - q = (2*sin(sqrt(phi*phi)/2)) / lambda *2*PI; /* y-axis value */ - j = floor((q - q_min)*nq / (q_max - q_min)); /* Bin number */ - i = round(RAD2DEG*phi/(double)binphi); /* Bin number */ - -// printf("lambda=%g phi= %g q= %g i= %d j=%d \n",lambda,phi,q,i,j); - - if (j < 0 || j >= nq) /* Do not detect */ - { - phi=phi*RAD2DEG; - // printf("Ops! q value is not in detector range: q= %g lambda= %g 2theta= %g \n", q ,lambda, phi); - } - if (i < 0 || i >= nphi) - { - // printf("Ops! 2theta value is not in detector range: q= %g lambda= %g 2theta= %g \n", q ,lambda, phi); - } - else - { - double p2 = p*p; - #pragma acc atomic - TOFq_N[i][j] = TOFq_N[i][j] + 1; - #pragma acc atomic - TOFq_p[i][j] = TOFq_p[i][j] + p; - #pragma acc atomic - TOFq_p2[i][j] = TOFq_p2[i][j] + p2; - } - if (restore_neutron) { - RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); - } + double lambda_real, lambda, phi_inplane, q; + int i, j; + double cyl_t0, cyl_t1, dt, phi, phi_deg, L_tot; + + // Check if the neutron hits the detector + if (!cylinder_intersect (&cyl_t0, &cyl_t1, x, y, z, vx, vy, vz, radius, height)) /* No hit */ + ABSORB; + if (cyl_t0 > 0) /* Neutron hits cylinder from the outside */ + ABSORB; + dt = cyl_t1; + PROP_DT (dt); + if (y >= (height / 2 - 1E-7) || y <= -(height / 2 - 1E-7)) /* Neutron hits cylinder ends; no detectors here */ + ABSORB; + + // Make the detector pixelated or continuos + if (pixel == 0) { + L_tot = L_chop2samp + sqrt (y * y + radius * radius); + lambda = (t - t_chop) / alpha / L_tot; + + lambda_real = 2 * PI / (sqrt (vx * vx + vy * vy + vz * vz) * V2K); + // printf("dt = %g Delta-t= %g L0 = %g L-tot = %g x= %g y= %g z= %g lambda= %g lambda-real=%g \n", dt, t-t_chop, L_chop2samp, L_tot, x ,y, z, lambda, + // lambda_real); + } + + if (pixel == 1) { + L_tot = L_chop2samp + sqrt (y * y + radius * radius); + lambda = (t - t_chop) / alpha / L_tot; + phi_inplane = atan2 (x, z); + phi_inplane = PI / nphi * round (phi_inplane * nphi / PI); + x = radius * sin (phi_inplane); + z = radius * cos (phi_inplane); + y = height / nh * round (y * nh / height); + // printf("x= %g y= %g z= %g lambda= %g \n", x ,y, z, lambda); + } + + // Calculate where the neutron hits the detector + phi = acos (z / sqrt (x * x + y * y + z * z)); /* x-axis value */ + q = (2 * sin (sqrt (phi * phi) / 2)) / lambda * 2 * PI; /* y-axis value */ + j = floor ((q - q_min) * nq / (q_max - q_min)); /* Bin number */ + i = round (RAD2DEG * phi / (double)binphi); /* Bin number */ + + // printf("lambda=%g phi= %g q= %g i= %d j=%d \n",lambda,phi,q,i,j); + + if (j < 0 || j >= nq) /* Do not detect */ + { + phi = phi * RAD2DEG; + // printf("Ops! q value is not in detector range: q= %g lambda= %g 2theta= %g \n", q ,lambda, phi); + } + if (i < 0 || i >= nphi) { + // printf("Ops! 2theta value is not in detector range: q= %g lambda= %g 2theta= %g \n", q ,lambda, phi); + } else { + double p2 = p * p; + #pragma acc atomic + TOFq_N[i][j] = TOFq_N[i][j] + 1; + #pragma acc atomic + TOFq_p[i][j] = TOFq_p[i][j] + p; + #pragma acc atomic + TOFq_p2[i][j] = TOFq_p2[i][j] + p2; + } + if (restore_neutron) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + } %} SAVE %{ - DETECTOR_OUT_2D( - "Cylindrical Time-of-flight 2theta v. q monitor", - "Scattering angle (2theta) [deg]", - "q [1/AA]", - 0, 180, q_min, q_max, - nphi, nq, - &TOFq_N[0][0],&TOFq_p[0][0],&TOFq_p2[0][0], - filename); + DETECTOR_OUT_2D ("Cylindrical Time-of-flight 2theta v. q monitor", "Scattering angle (2theta) [deg]", "q [1/AA]", 0, 180, q_min, q_max, nphi, nq, &TOFq_N[0][0], + &TOFq_p[0][0], &TOFq_p2[0][0], filename); %} FINALLY %{ - destroy_darr2d(TOFq_N); - destroy_darr2d(TOFq_p); - destroy_darr2d(TOFq_p2); + destroy_darr2d (TOFq_N); + destroy_darr2d (TOFq_p); + destroy_darr2d (TOFq_p2); %} MCDISPLAY %{ - magnify("y"); - circle("xz", 0,0,0,radius); + magnify ("y"); + circle ("xz", 0, 0, 0, radius); %} END diff --git a/mcstas-comps/contrib/TOFSANSdet.comp b/mcstas-comps/contrib/TOFSANSdet.comp index 7e0c2b9d7..4207d286c 100644 --- a/mcstas-comps/contrib/TOFSANSdet.comp +++ b/mcstas-comps/contrib/TOFSANSdet.comp @@ -97,20 +97,36 @@ SHARE #define sectnIe(i,j) sectnIef[i+Nqc*(j)] #define sectnWt(i,j) sectnWtf[i+Nqc*(j)] - double ddmin(double A, double B) { - if (AB) return A; else return B; + double + ddmax (double A, double B) { + if (A > B) + return A; + else + return B; }; - int iimin(int A, int B) { - if (AB) return A; else return B; + int + iimax (int A, int B) { + if (A > B) + return A; + else + return B; }; %} @@ -120,9 +136,9 @@ DECLARE int Nyc; int Ntc; int Nqc; - double *TSdNf; - double *TSdpf; - double *TSdp2f; + double* TSdNf; + double* TSdpf; + double* TSdp2f; double ds1c; double ds2c; double ds3c; @@ -152,59 +168,80 @@ INITIALIZE %{ int i, j, s, k; - simplN = create_darr1d(Nq); - simplI = create_darr1d(Nq); - simplIe = create_darr1d(Nq); + simplN = create_darr1d (Nq); + simplI = create_darr1d (Nq); + simplIe = create_darr1d (Nq); storez = 0.0; storen = 0.0; - Nxc = floor( ddmin(ddmax(Nx,16.0),512.0) + 0.50); - Nyc = floor( ddmin(ddmax(Ny,16.0),512.0) + 0.50); - Ntc = floor( ddmin(ddmax(Nt,10.0),2000.0)+ 0.50); - Nqc = floor( ddmin(ddmax(Nq,1.00),2000.0)+ 0.50); + Nxc = floor (ddmin (ddmax (Nx, 16.0), 512.0) + 0.50); + Nyc = floor (ddmin (ddmax (Ny, 16.0), 512.0) + 0.50); + Ntc = floor (ddmin (ddmax (Nt, 10.0), 2000.0) + 0.50); + Nqc = floor (ddmin (ddmax (Nq, 1.00), 2000.0) + 0.50); #ifndef USE_MPI - printf("%s: Attempting allocation of 3 arrays sized (%lu bytes/double) x %lu elements = %lu Mb\n",_comp->_name,sizeof(double),Nxc*Nyc*Ntc*3,sizeof(double)*Nxc*Nyc*Ntc*3/(1024*1024)); + printf ("%s: Attempting allocation of 3 arrays sized (%lu bytes/double) x %lu elements = %lu Mb\n", _comp->_name, sizeof (double), Nxc * Nyc * Ntc * 3, + sizeof (double) * Nxc * Nyc * Ntc * 3 / (1024 * 1024)); #else - MPI_MASTER( - printf("%s: Attempting allocation %i copies of 3 arrays sized (%lu double) x %lu elements = %lu Mb\n",_comp->_name,mpi_node_count,sizeof(double),Nxc*Nyc*Ntc*3,mpi_node_count*sizeof(double)*Nxc*Nyc*Ntc*3/(1024*1024)); - ); + MPI_MASTER (printf ("%s: Attempting allocation %i copies of 3 arrays sized (%lu double) x %lu elements = %lu Mb\n", _comp->_name, mpi_node_count, + sizeof (double), Nxc * Nyc * Ntc * 3, mpi_node_count * sizeof (double) * Nxc * Nyc * Ntc * 3 / (1024 * 1024));); #endif - TSdNf = (double*)calloc(Nxc*Nyc*Ntc*3,sizeof(double)); - TSdpf = (double*)calloc(Nxc*Nyc*Ntc*3,sizeof(double)); - TSdp2f= (double*)calloc(Nxc*Nyc*Ntc*3,sizeof(double)); - MPI_MASTER( - printf("Done with big-array allocations\n"); - ); - - ds1c = ddmax(ds1,0.0); - ds2c = ddmax(ds2,0.0); - ds3c = ddmax(ds3,0.0); - if (ds2c>=ds3c) ds2c = 0.0; - if (ds1c>=ds2c) ds1c = 0.0; - xw1c = ddmax(xw1,0.0); - yh1c = ddmax(yh1,0.0); - xw2c = ddmax(xw2,0.0); - yh2c = ddmax(yh2,0.0); - xw3c = ddmax(xw3,0.0); - yh3c = ddmax(yh3,0.0); + TSdNf = (double*)calloc (Nxc * Nyc * Ntc * 3, sizeof (double)); + TSdpf = (double*)calloc (Nxc * Nyc * Ntc * 3, sizeof (double)); + TSdp2f = (double*)calloc (Nxc * Nyc * Ntc * 3, sizeof (double)); + MPI_MASTER (printf ("Done with big-array allocations\n");); + + ds1c = ddmax (ds1, 0.0); + ds2c = ddmax (ds2, 0.0); + ds3c = ddmax (ds3, 0.0); + if (ds2c >= ds3c) + ds2c = 0.0; + if (ds1c >= ds2c) + ds1c = 0.0; + xw1c = ddmax (xw1, 0.0); + yh1c = ddmax (yh1, 0.0); + xw2c = ddmax (xw2, 0.0); + yh2c = ddmax (yh2, 0.0); + xw3c = ddmax (xw3, 0.0); + yh3c = ddmax (yh3, 0.0); hl1c = hl1; hl2c = hl2; hl3c = hl3; - if (ds3c==0.0) {xw3c=0.0; yh3c=0.0; hl3c=0.0;}; - if (ds2c==0.0) {xw2c=0.0; yh2c=0.0; hl2c=0.0;}; - if (ds1c==0.0) {xw1c=0.0; yh1c=0.0; hl1c=0.0;}; - if (hl1c<=0.0) {hl1c = 0.0;} else {hl1c=ddmax(hl1c,ddmax(xw1c/Nx,yh1c/Ny)*3.0);}; - if (hl2c<=0.0) {hl2c = 0.0;} else {hl2c=ddmax(hl2c,ddmax(xw2c/Nx,yh2c/Ny)*3.0);}; - hl3c=ddmax(hl3c,ddmax(xw3c/Nx,yh3c/Ny)*3.0); /* leave some space for other data */ - vx3c = ddmin(ddmax(vx3,1.0),15.0); + if (ds3c == 0.0) { + xw3c = 0.0; + yh3c = 0.0; + hl3c = 0.0; + }; + if (ds2c == 0.0) { + xw2c = 0.0; + yh2c = 0.0; + hl2c = 0.0; + }; + if (ds1c == 0.0) { + xw1c = 0.0; + yh1c = 0.0; + hl1c = 0.0; + }; + if (hl1c <= 0.0) { + hl1c = 0.0; + } else { + hl1c = ddmax (hl1c, ddmax (xw1c / Nx, yh1c / Ny) * 3.0); + }; + if (hl2c <= 0.0) { + hl2c = 0.0; + } else { + hl2c = ddmax (hl2c, ddmax (xw2c / Nx, yh2c / Ny) * 3.0); + }; + hl3c = ddmax (hl3c, ddmax (xw3c / Nx, yh3c / Ny) * 3.0); /* leave some space for other data */ + vx3c = ddmin (ddmax (vx3, 1.0), 15.0); - if (!fname || !strlen(fname)) exit(printf("TOFSANSdet: %s: invalid output filename fname.\n", NAME_CURRENT_COMP)); + if (!fname || !strlen (fname)) + exit (printf ("TOFSANSdet: %s: invalid output filename fname.\n", NAME_CURRENT_COMP)); /* if (fname.empty()) fname="SANSareaDet"; */ - Pic = 3.141592653589793238462643; + Pic = 3.141592653589793238462643; Ncount = 0.0; Pcount = 0.0; @@ -212,7 +249,7 @@ INITIALIZE TRACE %{ - int i,j,s,k; + int i, j, s, k; double tt, zpos; double absflg; @@ -220,106 +257,108 @@ TRACE zpos = 0.0; absflg = 0.0; - storez += vz*t; + storez += vz * t; storen++; k = 0; - if (xw1c>0.0 && yh1c>0.0) { - tt = (ds1c-zpos)/vz; // for all functionality the gravity direction should be in -y direction - PROP_DT(tt); - zpos = ds1c; - if (fabs(x)<0.5*xw1c && fabs(y)<0.5*yh1c && (fabs(x)>0.5*hl1c || fabs(y)>0.5*hl1c)) { - tt = t - 0.5*plength; // Actual time of flight minus one half pulsewidth. - absflg = 1.0; - s = floor( (tt-tmin) *Ntc/(tmax-tmin) ); /* Bin number */ - i = floor( (x+0.5*xw1c)*Nxc/ xw1c ); - j = floor( (y+0.5*yh1c)*Nyc/ yh1c ); - if (s>=0 && s 0.0 && yh1c > 0.0) { + tt = (ds1c - zpos) / vz; // for all functionality the gravity direction should be in -y direction + PROP_DT (tt); + zpos = ds1c; + if (fabs (x) < 0.5 * xw1c && fabs (y) < 0.5 * yh1c && (fabs (x) > 0.5 * hl1c || fabs (y) > 0.5 * hl1c)) { + tt = t - 0.5 * plength; // Actual time of flight minus one half pulsewidth. + absflg = 1.0; + s = floor ((tt - tmin) * Ntc / (tmax - tmin)); /* Bin number */ + i = floor ((x + 0.5 * xw1c) * Nxc / xw1c); + j = floor ((y + 0.5 * yh1c) * Nyc / yh1c); + if (s >= 0 && s < Ntc) { + TSdN (i, j, s, k)++; + TSdp (i, j, s, k) += p; + TSdp2 (i, j, s, k) += p * p; + }; + SCATTER; + }; }; k = 1; - if (xw2c>0.0 && yh2c>0.0 && absflg==0.0) { - tt = (ds2c-zpos)/vz; - PROP_DT(tt); - zpos = ds2c; - if (fabs(x)<0.5*xw2c && fabs(y)<0.5*yh2c && (fabs(x)>0.5*hl2c || fabs(y)>0.5*hl2c)) { - tt = t - 0.5*plength; // Actual time of flight minus one half pulsewidth. - absflg = 1.0; - s = floor( (tt-tmin) *Ntc/(tmax-tmin) ); /* Bin number */ - i = floor( (x+0.5*xw2c)*Nxc/ xw2c ); - j = floor( (y+0.5*yh2c)*Nyc/ yh2c ); - if (s>=0 && s 0.0 && yh2c > 0.0 && absflg == 0.0) { + tt = (ds2c - zpos) / vz; + PROP_DT (tt); + zpos = ds2c; + if (fabs (x) < 0.5 * xw2c && fabs (y) < 0.5 * yh2c && (fabs (x) > 0.5 * hl2c || fabs (y) > 0.5 * hl2c)) { + tt = t - 0.5 * plength; // Actual time of flight minus one half pulsewidth. + absflg = 1.0; + s = floor ((tt - tmin) * Ntc / (tmax - tmin)); /* Bin number */ + i = floor ((x + 0.5 * xw2c) * Nxc / xw2c); + j = floor ((y + 0.5 * yh2c) * Nyc / yh2c); + if (s >= 0 && s < Ntc) { + TSdN (i, j, s, k)++; + TSdp (i, j, s, k) += p; + TSdp2 (i, j, s, k) += p * p; + }; + SCATTER; + }; }; k = 2; - if (xw3c>0.0 && yh3c>0.0 && absflg==0.0) { - tt = (ds3c-zpos)/vz; - PROP_DT(tt); - zpos = ds3c; - if (fabs(x)<0.5*xw3c && fabs(y)<0.5*yh3c && (fabs(x)>0.5*hl3c || y>0.5*hl3c || y<(0.5-vx3c)*hl3c)) { - tt = t - 0.5*plength; // Actual time of flight minus one half pulsewidth. - absflg = 1.0; - s = floor( (tt-tmin) *Ntc/(tmax-tmin) ); /* Bin number */ - i = floor( (x+0.5*xw3c)*Nxc/ xw3c ); - j = floor( (y+0.5*yh3c)*Nyc/ yh3c ); - if (s>=0 && s 0.0 && yh3c > 0.0 && absflg == 0.0) { + tt = (ds3c - zpos) / vz; + PROP_DT (tt); + zpos = ds3c; + if (fabs (x) < 0.5 * xw3c && fabs (y) < 0.5 * yh3c && (fabs (x) > 0.5 * hl3c || y > 0.5 * hl3c || y < (0.5 - vx3c) * hl3c)) { + tt = t - 0.5 * plength; // Actual time of flight minus one half pulsewidth. + absflg = 1.0; + s = floor ((tt - tmin) * Ntc / (tmax - tmin)); /* Bin number */ + i = floor ((x + 0.5 * xw3c) * Nxc / xw3c); + j = floor ((y + 0.5 * yh3c) * Nyc / yh3c); + if (s >= 0 && s < Ntc) { + TSdN (i, j, s, k)++; + TSdp (i, j, s, k) += p; + TSdp2 (i, j, s, k) += p * p; + }; + SCATTER; + }; }; Ncount += absflg; k = 2; - tt = (ds3c-zpos)/vz; - if (tt>0.0) PROP_DT(tt); + tt = (ds3c - zpos) / vz; + if (tt > 0.0) + PROP_DT (tt); zpos = ds3c; - if (fabs(x)<=0.5*hl3c && y<=0.5*hl3c && y>=(0.5-vx3c)*hl3c) { - tt = t - 0.5*plength; // Actual time of flight minus one half pulsewidth. + if (fabs (x) <= 0.5 * hl3c && y <= 0.5 * hl3c && y >= (0.5 - vx3c) * hl3c) { + tt = t - 0.5 * plength; // Actual time of flight minus one half pulsewidth. absflg = 1.0; - s = floor( (tt-tmin) *Ntc/(tmax-tmin) ); /* Bin number */ - i = Nxc/2; - j = Nyc/2; - if (s>=0 && s= 0 && s < Ntc) { + TSdN (i, j, s, k)++; + TSdp (i, j, s, k) += p; + TSdp2 (i, j, s, k) += p * p; + TSdN (i - 1, j, s, k)++; /* weight for x */ + TSdp (i - 1, j, s, k) += p; + TSdp2 (i - 1, j, s, k) += p * x; + TSdN (i, j - 1, s, k)++; /* weight for y */ + TSdp (i, j - 1, s, k) += p; + TSdp2 (i, j - 1, s, k) += p * y; }; SCATTER; Pcount++; }; -/* if (absflg!=0.0) ABSORB; */ - - if (rstneu!=0.0) { RESTORE_NEUTRON(INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); }; + /* if (absflg!=0.0) ABSORB; */ + if (rstneu != 0.0) { + RESTORE_NEUTRON (INDEX_CURRENT_COMP, x, y, z, vx, vy, vz, t, sx, sy, sz, p); + }; %} SAVE %{ - int i,j,s,k,qi,si; - double dsA[3],xwA[3],yhA[3],hlA[3]; + int i, j, s, k, qi, si; + double dsA[3], xwA[3], yhA[3], hlA[3]; dsA[0] = ds1c; dsA[1] = ds2c; dsA[2] = ds3c; @@ -333,30 +372,30 @@ SAVE hlA[1] = hl2c; hlA[2] = hl3c; - double q1,q2,qstp,qminl,qmaxl,qcalf; - double time,time3,s3cl,s3sw; - int s3,s3sg,kfl; - double wght1,wght2; - double xcen,ycen,prIn,vvz,yguess,maxint; - double ic1,ic2,ic3,ic4,jc1,jc2,jc3,jc4; - int imn,imx,im3,im4,jmn,jmx,jm3,jm4; - double cimn,cimx,cjmn,cjmx; - double Xi,Yj,Ni,Nj,delN,scali,scalj,scal; - double TNw2, CSw, SNwh; - double dsA2, DIS1, DIS2, LAM, QQQ, OMG, AREA, AR2, FAK, determ; - double Q11,Q21,Q12,Q22; - double N11,N21,N12,N22; - double Qx,Qy; - double Nmn,Nmx,T00,Tmn,Tmx; - double Nit,Njt,NNt,Ttt,Qstp; - double Qmn,Qmx; - int qq1,qq2; - double qmn,qmx,qst,qqq; - double tmn,tmx,tst,ttt; - double NNN,Int,Err,Wt; - double Qxx,Qyy,Qdx,Qdy; - - char filename[99]; + double q1, q2, qstp, qminl, qmaxl, qcalf; + double time, time3, s3cl, s3sw; + int s3, s3sg, kfl; + double wght1, wght2; + double xcen, ycen, prIn, vvz, yguess, maxint; + double ic1, ic2, ic3, ic4, jc1, jc2, jc3, jc4; + int imn, imx, im3, im4, jmn, jmx, jm3, jm4; + double cimn, cimx, cjmn, cjmx; + double Xi, Yj, Ni, Nj, delN, scali, scalj, scal; + double TNw2, CSw, SNwh; + double dsA2, DIS1, DIS2, LAM, QQQ, OMG, AREA, AR2, FAK, determ; + double Q11, Q21, Q12, Q22; + double N11, N21, N12, N22; + double Qx, Qy; + double Nmn, Nmx, T00, Tmn, Tmx; + double Nit, Njt, NNt, Ttt, Qstp; + double Qmn, Qmx; + int qq1, qq2; + double qmn, qmx, qst, qqq; + double tmn, tmx, tst, ttt; + double NNN, Int, Err, Wt; + double Qxx, Qyy, Qdx, Qdy; + + char filename[99]; double* calibNf; double* calibIf; @@ -367,556 +406,608 @@ SAVE double* sectnIef; double* sectnWtf; - calibNf = (double*)malloc(sizeof(double)*Nqc*4); - calibIf = (double*)malloc(sizeof(double)*Nqc*4); - calibIef= (double*)malloc(sizeof(double)*Nqc*4); - calibWtf= (double*)malloc(sizeof(double)*Nqc*4); - sectnNf = (double*)malloc(sizeof(double)*Nqc*20); - sectnIf = (double*)malloc(sizeof(double)*Nqc*20); - sectnIef= (double*)malloc(sizeof(double)*Nqc*20); - sectnWtf= (double*)malloc(sizeof(double)*Nqc*20); + calibNf = (double*)malloc (sizeof (double) * Nqc * 4); + calibIf = (double*)malloc (sizeof (double) * Nqc * 4); + calibIef = (double*)malloc (sizeof (double) * Nqc * 4); + calibWtf = (double*)malloc (sizeof (double) * Nqc * 4); + sectnNf = (double*)malloc (sizeof (double) * Nqc * 20); + sectnIf = (double*)malloc (sizeof (double) * Nqc * 20); + sectnIef = (double*)malloc (sizeof (double) * Nqc * 20); + sectnWtf = (double*)malloc (sizeof (double) * Nqc * 20); if (!calibNf || !calibIf || !calibIef || !calibWtf || !sectnNf || !sectnIf || !sectnIef || !sectnWtf) { - fprintf(stderr, "TOFSANSdet %s: Memory allocation error in SAVE. Fatal exit!\n", NAME_CURRENT_COMP); - exit(-1); + fprintf (stderr, "TOFSANSdet %s: Memory allocation error in SAVE. Fatal exit!\n", NAME_CURRENT_COMP); + exit (-1); } storez /= storen; - i = Nxc/2; /* calculate center values on beam stop */ - j = Nyc/2; + i = Nxc / 2; /* calculate center values on beam stop */ + j = Nyc / 2; k = 2; maxint = 0.0; - for (s=0; s0.0) { - TSdp2(i-1,j,s,k) /= TSdp(i-1,j,s,k); - TSdp2(i,j-1,s,k) /= TSdp(i,j-1,s,k); - maxint = ddmax(maxint,TSdp(i,j,s,k)); + for (s = 0; s < Ntc; s++) { + if (TSdp (i, j, s, k) > 0.0) { + TSdp2 (i - 1, j, s, k) /= TSdp (i - 1, j, s, k); + TSdp2 (i, j - 1, s, k) /= TSdp (i, j - 1, s, k); + maxint = ddmax (maxint, TSdp (i, j, s, k)); }; }; maxint *= inttol; + qstp = log (qmax / qmin) / Nqc; + qminl = log (qmin); + qmaxl = log (qmax); - qstp = log(qmax/qmin)/Nqc; - qminl= log(qmin); - qmaxl= log(qmax); - - for (qi=0; qi0.0 && xwA[k]>0.0 && yhA[k]>0.0) { - for (s=0; s=0 && s3=maxint) {wght1=1.0-fabs(s3sw);} else {wght1=0.0;}; + for (k = 0; k < 3; k++) { + if (dsA[k] > 0.0 && xwA[k] > 0.0 && yhA[k] > 0.0) { + for (s = 0; s < Ntc; s++) { + time = tmin + (s + 0.5) * (tmax - tmin) / Ntc; + time3 = time * (ssdist + ds3c) / (ssdist + dsA[k]); + s3cl = (time3 - tmin) * Ntc / (tmax - tmin); + s3 = floor (s3cl); + s3sw = s3cl - s3 - 0.5; + if (s3sw < 0.0) { + s3sg = -1; + } else { + s3sg = 1; + }; + if (s3 >= 0 && s3 < Ntc) { + i = Nxc / 2; + j = Nyc / 2; + xcen = TSdp2 (i - 1, j, s3, 2); + ycen = TSdp2 (i, j - 1, s3, 2); + prIn = TSdp (i, j, s3, 2); + if (prIn >= maxint) { + wght1 = 1.0 - fabs (s3sw); + } else { + wght1 = 0.0; + }; wght2 = 0.0; - if (s3+s3sg>=0 && s3+s3sg=maxint) wght2=fabs(s3sw); - if (wght1+wght2>0.0) { - xcen = (wght2*TSdp2(i-1,j,s3+s3sg,2) + wght1*xcen)/(wght1+wght2); - ycen = (wght2*TSdp2(i,j-1,s3+s3sg,2) + wght1*ycen)/(wght1+wght2); - prIn = (wght2*TSdp(i,j,s3+s3sg,2) + wght1*prIn)/(wght1+wght2); + if (s3 + s3sg >= 0 && s3 + s3sg < Ntc) { + if (TSdp (i, j, s3 + s3sg, 2) >= maxint) + wght2 = fabs (s3sw); + if (wght1 + wght2 > 0.0) { + xcen = (wght2 * TSdp2 (i - 1, j, s3 + s3sg, 2) + wght1 * xcen) / (wght1 + wght2); + ycen = (wght2 * TSdp2 (i, j - 1, s3 + s3sg, 2) + wght1 * ycen) / (wght1 + wght2); + prIn = (wght2 * TSdp (i, j, s3 + s3sg, 2) + wght1 * prIn) / (wght1 + wght2); } else { xcen = 0.0; ycen = 0.0; prIn = 0.0; }; }; - prIn *= (ssdist+ds3c)/(ssdist+dsA[k]); // correct for spreading of times - if (fabs(xcen)>hlA[2]*centol) {xcen=0.0;} else {xcen *= dsA[k]/ds3c;}; - if (mcgravitation==0) {if (fabs(ycen)>hlA[2]*centol) {ycen=0.0;} else {ycen *= dsA[k]/ds3c;}; } - else {vvz = (ssdist+ds3c)/time3; - yguess = 0.5*GRAVITY*(pow(0.5*coldis+ds3c,2)-0.25*coldis*coldis)/(vvz*vvz); - if (fabs(ycen-yguess)>hlA[2]*centol) {ycen=yguess;} else - {ycen*=(pow(0.5*coldis+dsA[k],2)-0.25*coldis*coldis)/(pow(0.5*coldis+ds3c,2)-0.25*coldis*coldis);}; }; - if (kfl==0) { + prIn *= (ssdist + ds3c) / (ssdist + dsA[k]); // correct for spreading of times + if (fabs (xcen) > hlA[2] * centol) { + xcen = 0.0; + } else { + xcen *= dsA[k] / ds3c; + }; + if (mcgravitation == 0) { + if (fabs (ycen) > hlA[2] * centol) { + ycen = 0.0; + } else { + ycen *= dsA[k] / ds3c; + }; + } else { + vvz = (ssdist + ds3c) / time3; + yguess = 0.5 * GRAVITY * (pow (0.5 * coldis + ds3c, 2) - 0.25 * coldis * coldis) / (vvz * vvz); + if (fabs (ycen - yguess) > hlA[2] * centol) { + ycen = yguess; + } else { + ycen *= (pow (0.5 * coldis + dsA[k], 2) - 0.25 * coldis * coldis) / (pow (0.5 * coldis + ds3c, 2) - 0.25 * coldis * coldis); + }; + }; + if (kfl == 0) { ic1 = -0.5; - ic2 = Nxc-0.5; + ic2 = Nxc - 0.5; jc1 = -0.5; - jc2 = Nyc-0.5; + jc2 = Nyc - 0.5; imn = 0; - imx = Nxc-1; + imx = Nxc - 1; jmn = 0; - jmx = Nyc-1; + jmx = Nyc - 1; } else { - ic1 = ddmax((-0.5*hlA[k-1]*dsA[k]/dsA[k-1]+xcen)*Nxc/xwA[k]+0.5*(Nxc-1), -0.5); - ic2 = ddmin(( 0.5*hlA[k-1]*dsA[k]/dsA[k-1]+xcen)*Nxc/xwA[k]+0.5*(Nxc-1),Nxc-0.5); - jc1 = ddmax((-0.5*hlA[k-1]*dsA[k]/dsA[k-1]+ycen)*Nyc/yhA[k]+0.5*(Nyc-1), -0.5); - jc2 = ddmin(( 0.5*hlA[k-1]*dsA[k]/dsA[k-1]+ycen)*Nyc/yhA[k]+0.5*(Nyc-1),Nyc-0.5); - imn = floor( ic1+0.5); - imx = -floor(-ic2+0.5); - jmn = floor( jc1+0.5); - jmx = -floor(-jc2+0.5); + ic1 = ddmax ((-0.5 * hlA[k - 1] * dsA[k] / dsA[k - 1] + xcen) * Nxc / xwA[k] + 0.5 * (Nxc - 1), -0.5); + ic2 = ddmin ((0.5 * hlA[k - 1] * dsA[k] / dsA[k - 1] + xcen) * Nxc / xwA[k] + 0.5 * (Nxc - 1), Nxc - 0.5); + jc1 = ddmax ((-0.5 * hlA[k - 1] * dsA[k] / dsA[k - 1] + ycen) * Nyc / yhA[k] + 0.5 * (Nyc - 1), -0.5); + jc2 = ddmin ((0.5 * hlA[k - 1] * dsA[k] / dsA[k - 1] + ycen) * Nyc / yhA[k] + 0.5 * (Nyc - 1), Nyc - 0.5); + imn = floor (ic1 + 0.5); + imx = -floor (-ic2 + 0.5); + jmn = floor (jc1 + 0.5); + jmx = -floor (-jc2 + 0.5); }; - ic3 = -0.5*hlA[k]*Nxc/xwA[k]+0.5*(Nxc-1); - ic4 = 0.5*hlA[k]*Nxc/xwA[k]+0.5*(Nxc-1); - jc3 = -0.5*hlA[k]*Nyc/yhA[k]+0.5*(Nyc-1); - jc4 = 0.5*hlA[k]*Nyc/yhA[k]+0.5*(Nyc-1); - im3 = -floor(-ic3-0.5); - im4 = floor( ic4-0.5); - jm3 = -floor(-jc3-0.5); - jm4 = floor( jc4-0.5); - - - for (i=imn; i<=imx; i++) - for (j=jmn; j<=jmx; j++) - { if (iim4 || jjm4) { - - - cimn = i-0.5; - cimx = i+0.5; - cjmn = j-0.5; - cjmx = j+0.5; - if (i==imn) cimn=ic1; - if (i==imx) cimx=ic2; - if (cimn<=ic3 && cimx>=ic3) cimx = ic3; - if (cimn<=ic4 && cimx>=ic4) cimn = ic4; - if (j==jmn) cjmn=jc1; - if (j==jmx) cjmx=jc2; - if (cjmn<=jc3 && cjmx>=jc3) cjmx = jc3; - if (cjmn<=jc4 && cjmx>=jc4) cjmn = jc4; - AREA = (cimx-cimn)*(cjmx-cjmn); - - dsA2 = dsA[k]*dsA[k]; - - delN = 0.1; /* variation size for derivatives */ - - Xi= (-0.5+(i+0.5+delN)/Nxc)*xwA[k]-xcen; /* derivative in X */ - Yj= (-0.5+(j+0.5 )/Nyc)*yhA[k]-ycen; - DIS1 = Xi*Xi+Yj*Yj; - DIS2 = dsA2+DIS1; - LAM = (2.0*Pic/V2K)*time/(ssdist+sqrt(DIS2)); - TNw2 = DIS1/dsA2; /* tan (theta) squared */ - CSw = 1.0/sqrt(1.0+TNw2); /* cos (theta) */ - SNwh = sqrt(0.5*(1.0-CSw)); /* sin (theta/2) */ - QQQ = 4.0*Pic*SNwh/LAM; - Q21 = QQQ/sqrt(DIS1); - Q11 = Xi*Q21; - Q21 *= Yj; - - Xi= (-0.5+(i+0.5 )/Nxc)*xwA[k]-xcen; /* derivative in Y */ - Yj= (-0.5+(j+0.5+delN)/Nyc)*yhA[k]-ycen; - DIS1 = Xi*Xi+Yj*Yj; - DIS2 = dsA2+DIS1; - LAM = (2.0*Pic/V2K)*time/(ssdist+sqrt(DIS2)); - TNw2 = DIS1/dsA2; /* tan (theta) squared */ - CSw = 1.0/sqrt(1.0+TNw2); /* cos (theta) */ - SNwh = sqrt(0.5*(1.0-CSw)); /* sin (theta/2) */ - QQQ = 4.0*Pic*SNwh/LAM; - Q22 = QQQ/sqrt(DIS1); - Q12 = Xi*Q22; - Q22 *= Yj; - - Xi= (-0.5+(i+0.5)/Nxc)*xwA[k]-xcen; /* main Q */ - Yj= (-0.5+(j+0.5)/Nyc)*yhA[k]-ycen; - DIS1 = Xi*Xi+Yj*Yj; - DIS2 = dsA2+DIS1; - LAM = (2.0*Pic/V2K)*time/(ssdist+sqrt(DIS2)); - TNw2 = DIS1/dsA2; /* tan (theta) squared */ - CSw = 1.0/sqrt(1.0+TNw2); /* cos (theta) */ - SNwh = sqrt(0.5*(1.0-CSw)); /* sin (theta/2) */ - QQQ = 4.0*Pic*SNwh/LAM; - Qy = QQQ/sqrt(DIS1); - Qx = Xi*Qy; - Qy *= Yj; - - Q11 = (Q11-Qx)/delN; - Q21 = (Q21-Qy)/delN; - Q12 = (Q12-Qx)/delN; - Q22 = (Q22-Qy)/delN; - - determ = Q11*Q22-Q21*Q12; - N11 = Q22/determ; - N21 = -Q21/determ; - N12 = -Q12/determ; - N22 = Q11/determ; - - OMG = CSw*xwA[k]*yhA[k]/((Nxc*Nyc)*DIS2); - - qi = floor(log(QQQ/qmin)/qstp); /* dump the original intensities */ - if (qi>=0 && qi im4 || j < jm3 || j > jm4) { + + cimn = i - 0.5; + cimx = i + 0.5; + cjmn = j - 0.5; + cjmx = j + 0.5; + if (i == imn) + cimn = ic1; + if (i == imx) + cimx = ic2; + if (cimn <= ic3 && cimx >= ic3) + cimx = ic3; + if (cimn <= ic4 && cimx >= ic4) + cimn = ic4; + if (j == jmn) + cjmn = jc1; + if (j == jmx) + cjmx = jc2; + if (cjmn <= jc3 && cjmx >= jc3) + cjmx = jc3; + if (cjmn <= jc4 && cjmx >= jc4) + cjmn = jc4; + AREA = (cimx - cimn) * (cjmx - cjmn); + + dsA2 = dsA[k] * dsA[k]; + + delN = 0.1; /* variation size for derivatives */ + + Xi = (-0.5 + (i + 0.5 + delN) / Nxc) * xwA[k] - xcen; /* derivative in X */ + Yj = (-0.5 + (j + 0.5) / Nyc) * yhA[k] - ycen; + DIS1 = Xi * Xi + Yj * Yj; + DIS2 = dsA2 + DIS1; + LAM = (2.0 * Pic / V2K) * time / (ssdist + sqrt (DIS2)); + TNw2 = DIS1 / dsA2; /* tan (theta) squared */ + CSw = 1.0 / sqrt (1.0 + TNw2); /* cos (theta) */ + SNwh = sqrt (0.5 * (1.0 - CSw)); /* sin (theta/2) */ + QQQ = 4.0 * Pic * SNwh / LAM; + Q21 = QQQ / sqrt (DIS1); + Q11 = Xi * Q21; + Q21 *= Yj; + + Xi = (-0.5 + (i + 0.5) / Nxc) * xwA[k] - xcen; /* derivative in Y */ + Yj = (-0.5 + (j + 0.5 + delN) / Nyc) * yhA[k] - ycen; + DIS1 = Xi * Xi + Yj * Yj; + DIS2 = dsA2 + DIS1; + LAM = (2.0 * Pic / V2K) * time / (ssdist + sqrt (DIS2)); + TNw2 = DIS1 / dsA2; /* tan (theta) squared */ + CSw = 1.0 / sqrt (1.0 + TNw2); /* cos (theta) */ + SNwh = sqrt (0.5 * (1.0 - CSw)); /* sin (theta/2) */ + QQQ = 4.0 * Pic * SNwh / LAM; + Q22 = QQQ / sqrt (DIS1); + Q12 = Xi * Q22; + Q22 *= Yj; + + Xi = (-0.5 + (i + 0.5) / Nxc) * xwA[k] - xcen; /* main Q */ + Yj = (-0.5 + (j + 0.5) / Nyc) * yhA[k] - ycen; + DIS1 = Xi * Xi + Yj * Yj; + DIS2 = dsA2 + DIS1; + LAM = (2.0 * Pic / V2K) * time / (ssdist + sqrt (DIS2)); + TNw2 = DIS1 / dsA2; /* tan (theta) squared */ + CSw = 1.0 / sqrt (1.0 + TNw2); /* cos (theta) */ + SNwh = sqrt (0.5 * (1.0 - CSw)); /* sin (theta/2) */ + QQQ = 4.0 * Pic * SNwh / LAM; + Qy = QQQ / sqrt (DIS1); + Qx = Xi * Qy; + Qy *= Yj; + + Q11 = (Q11 - Qx) / delN; + Q21 = (Q21 - Qy) / delN; + Q12 = (Q12 - Qx) / delN; + Q22 = (Q22 - Qy) / delN; + + determ = Q11 * Q22 - Q21 * Q12; + N11 = Q22 / determ; + N21 = -Q21 / determ; + N12 = -Q12 / determ; + N22 = Q11 / determ; + + OMG = CSw * xwA[k] * yhA[k] / ((Nxc * Nyc) * DIS2); + + qi = floor (log (QQQ / qmin) / qstp); /* dump the original intensities */ + if (qi >= 0 && qi < Nqc) { + qcalf = 1.0; + if (qcal != 0.0) { + q1 = qmin * exp (qi * qstp); + q2 = q1 * exp (qstp); + qcalf = q2 - q1; }; + simplN[qi] += TSdN (i, j, s, k); + simplI[qi] += TSdp (i, j, s, k) / qcalf; + simplIe[qi] += TSdp2 (i, j, s, k) / (qcalf * qcalf); + }; - if (prIn>=maxint) { + if (prIn >= maxint) { - if (yhA[k]/Nyc>xwA[k]/Nxc) { + if (yhA[k] / Nyc > xwA[k] / Nxc) { scali = 1.0; - scalj = yhA[k]*Nxc/(xwA[k]*Nyc); - scal = xwA[k]/Nxc; + scalj = yhA[k] * Nxc / (xwA[k] * Nyc); + scal = xwA[k] / Nxc; } else { - scali = xwA[k]*Nyc/(yhA[k]*Nxc); + scali = xwA[k] * Nyc / (yhA[k] * Nxc); scalj = 1.0; - scal = yhA[k]/Nyc; + scal = yhA[k] / Nyc; }; - Ni = i+0.5-(0.5+xcen/xwA[k])*Nxc*scali; /* (0,0) center */ - Nj = j+0.5-(0.5+ycen/yhA[k])*Nyc*scalj; - Nmn = Ni*Ni+Nj*Nj; /* find minimal and maximal Qs and phis */ - Nmx = Nmn; - T00 = atan2(Nj,Ni); - Tmn = T00; - Tmx = T00; - - Nit = Ni+scali; /* (1,0) */ - Njt = Nj; - NNt = Nit*Nit+Njt*Njt; - Ttt = atan2(Njt,Nit); - if (fabs(Ttt+2.0*Pic-T00)=2.0*Pic) tmx = tmn + 2.0*Pic + 1e-6*tst; - for (ttt=tmn; ttt<=tmx; ttt+=tst) { - Qxx = qqq*cos(ttt)-Qx; - Qyy = qqq*sin(ttt)-Qy; - Ni = fabs(N11*Qxx+N12*Qyy); - Nj = fabs(N21*Qxx+N22*Qyy); - if (Ni<1.0 && Nj<1.0) { - AR2 = (1.0-Ni)*(1.0-Nj); - FAK = prIn * Sthckn * OMG; - NNN = AR2*TSdN(i,j,s,k); - Int = AR2*TSdp(i,j,s,k) / FAK; - Err = AR2*TSdp2(i,j,s,k)/(FAK*FAK); - Wt = AR2*AREA; - - calibN(qi,k) += NNN; - calibI(qi,k) += Int; - calibIe(qi,k)+= Err; - calibWt(qi,k)+= Wt; - calibN(qi,3) += NNN; - calibI(qi,3) += Int; - calibIe(qi,3)+= Err; - calibWt(qi,3)+= Wt; - - si = floor(s3cl*20.0/Ntc); - sectnN(qi,si) += NNN; - sectnI(qi,si) += Int; - sectnIe(qi,si)+= Err; - sectnWt(qi,si)+= Wt; - + for (qqq = qmn; qqq <= qmx; qqq += qst) { + tst = 2.0 * Pic / ddmax (floor (4.0 * Pic * qqq / Qstp + 0.5), 12.0); + tmn = tst * floor (Tmn / tst - 1.0); + tmx = -tst * (floor (-Tmx / tst - 1.0) - 1e-6); + if (tmx - tmn >= 2.0 * Pic) + tmx = tmn + 2.0 * Pic + 1e-6 * tst; + for (ttt = tmn; ttt <= tmx; ttt += tst) { + Qxx = qqq * cos (ttt) - Qx; + Qyy = qqq * sin (ttt) - Qy; + Ni = fabs (N11 * Qxx + N12 * Qyy); + Nj = fabs (N21 * Qxx + N22 * Qyy); + if (Ni < 1.0 && Nj < 1.0) { + AR2 = (1.0 - Ni) * (1.0 - Nj); + FAK = prIn * Sthckn * OMG; + NNN = AR2 * TSdN (i, j, s, k); + Int = AR2 * TSdp (i, j, s, k) / FAK; + Err = AR2 * TSdp2 (i, j, s, k) / (FAK * FAK); + Wt = AR2 * AREA; + + calibN (qi, k) += NNN; + calibI (qi, k) += Int; + calibIe (qi, k) += Err; + calibWt (qi, k) += Wt; + calibN (qi, 3) += NNN; + calibI (qi, 3) += Int; + calibIe (qi, 3) += Err; + calibWt (qi, 3) += Wt; + + si = floor (s3cl * 20.0 / Ntc); + sectnN (qi, si) += NNN; + sectnI (qi, si) += Int; + sectnIe (qi, si) += Err; + sectnWt (qi, si) += Wt; }; }; }; - }; // here check if primary intensity was enough - - }; + }; // here check if primary intensity was enough }; }; + }; }; }; kfl = 1; }; }; - - for (qi=0; qi0.0 && calibWt(qi,si)>0.0) { - calibI(qi,si) /= calibWt(qi,si); - calibIe(qi,si)/= calibWt(qi,si)*calibWt(qi,si); + for (qi = 0; qi < Nqc; qi++) { + for (si = 0; si < 4; si++) { + if (calibI (qi, si) > 0.0 && calibWt (qi, si) > 0.0) { + calibI (qi, si) /= calibWt (qi, si); + calibIe (qi, si) /= calibWt (qi, si) * calibWt (qi, si); }; }; - for (si=0; si<20; si++) { - if (sectnI(qi,si)>0.0 && sectnWt(qi,si)>0.0) { - sectnI(qi,si) /= sectnWt(qi,si); - sectnIe(qi,si)/= sectnWt(qi,si)*sectnWt(qi,si); + for (si = 0; si < 20; si++) { + if (sectnI (qi, si) > 0.0 && sectnWt (qi, si) > 0.0) { + sectnI (qi, si) /= sectnWt (qi, si); + sectnIe (qi, si) /= sectnWt (qi, si) * sectnWt (qi, si); }; }; }; - i=0; - while(i<99 && fname[i]>0) {filename[i]=fname[i]; i++;} - i=iimin(i,87); - j=i; - filename[j] = '_'; j++; - filename[j] = 'c'; j++; - filename[j] = 'p'; j++; - filename[j] = 's'; j++; - filename[j] = '_'; j++; - filename[j] = 'a'; j++; - filename[j] = 'l'; j++; - filename[j] = 'l'; j++; - filename[j] = '.'; j++; - filename[j] = 'd'; j++; - filename[j] = 'a'; j++; - filename[j] = 't'; j++; + i = 0; + while (i < 99 && fname[i] > 0) { + filename[i] = fname[i]; + i++; + } + i = iimin (i, 87); + j = i; + filename[j] = '_'; + j++; + filename[j] = 'c'; + j++; + filename[j] = 'p'; + j++; + filename[j] = 's'; + j++; + filename[j] = '_'; + j++; + filename[j] = 'a'; + j++; + filename[j] = 'l'; + j++; + filename[j] = 'l'; + j++; + filename[j] = '.'; + j++; + filename[j] = 'd'; + j++; + filename[j] = 'a'; + j++; + filename[j] = 't'; + j++; filename[j] = 0; - DETECTOR_OUT_1D( - "TOFSANSdet.comp", - "log(Q) [AA^(-1)]", - "I(Q) [cps]", - "log(Q) [AA^(-1)]", qminl, qmaxl, Nq, - &simplN[0], &simplI[0], &simplIe[0], filename - ); - - for (si=0; si<4; si++) { - - j=i+1; - filename[j] = 'c'; j++; - filename[j] = 'a'; j++; - filename[j] = 'l'; j++; - filename[j] = 'i'; j++; - filename[j] = 'b'; j++; - filename[j] = '_'; j++; - filename[j] = 49+si; - - for (qi=0; qi=ds3c) ds2c = 0.0; - if (ds1c>=ds2c) ds1c = 0.0; - xw1c = ddmax(xw1,0.0); - yh1c = ddmax(yh1,0.0); - xw2c = ddmax(xw2,0.0); - yh2c = ddmax(yh2,0.0); - xw3c = ddmax(xw3,0.0); - yh3c = ddmax(yh3,0.0); + ds1c = ddmax (ds1, 0.0); + ds2c = ddmax (ds2, 0.0); + ds3c = ddmax (ds3, 0.0); + if (ds2c >= ds3c) + ds2c = 0.0; + if (ds1c >= ds2c) + ds1c = 0.0; + xw1c = ddmax (xw1, 0.0); + yh1c = ddmax (yh1, 0.0); + xw2c = ddmax (xw2, 0.0); + yh2c = ddmax (yh2, 0.0); + xw3c = ddmax (xw3, 0.0); + yh3c = ddmax (yh3, 0.0); hl1c = hl1; hl2c = hl2; hl3c = hl3; - if (ds3c==0.0) {xw3c=0.0; yh3c=0.0; hl3c=0.0;}; - if (ds2c==0.0) {xw2c=0.0; yh2c=0.0; hl2c=0.0;}; - if (ds1c==0.0) {xw1c=0.0; yh1c=0.0; hl1c=0.0;}; - if (hl1c<=0.0) {hl1c = 0.0;} else {hl1c=ddmax(hl1c,ddmax(xw1c/Nx,yh1c/Ny));}; - if (hl2c<=0.0) {hl2c = 0.0;} else {hl2c=ddmax(hl2c,ddmax(xw2c/Nx,yh2c/Ny));}; - hl3c=ddmax(hl3c,ddmax(xw3c/Nx,yh3c/Ny)*3.0); /* leave some space for other data */ - vx3c = ddmin(ddmax(vx3,1.0),15.0); - - - - if (ds1c>0.0 && xw1c>0.0 && yh1c>0.0) { - multiline(5, -0.5*xw1c, -0.5*yh1c, ds1c, - 0.5*xw1c, -0.5*yh1c, ds1c, - 0.5*xw1c, 0.5*yh1c, ds1c, - -0.5*xw1c, 0.5*yh1c, ds1c, - -0.5*xw1c, -0.5*yh1c, ds1c); - multiline(5, -0.5*hl1c, -0.5*hl1c, ds1c, - 0.5*hl1c, -0.5*hl1c, ds1c, - 0.5*hl1c, 0.5*hl1c, ds1c, - -0.5*hl1c, 0.5*hl1c, ds1c, - -0.5*hl1c, -0.5*hl1c, ds1c); }; - - if (ds2c>0.0 && xw2c>0.0 && yh2c>0.0) { - multiline(5, -0.5*xw2c, -0.5*yh2c, ds2c, - 0.5*xw2c, -0.5*yh2c, ds2c, - 0.5*xw2c, 0.5*yh2c, ds2c, - -0.5*xw2c, 0.5*yh2c, ds2c, - -0.5*xw2c, -0.5*yh2c, ds2c); - multiline(5, -0.5*hl2c, -0.5*hl2c, ds2c, - 0.5*hl2c, -0.5*hl2c, ds2c, - 0.5*hl2c, 0.5*hl2c, ds2c, - -0.5*hl2c, 0.5*hl2c, ds2c, - -0.5*hl2c, -0.5*hl2c, ds2c); }; - - if (ds3c>0.0 && xw3c>0.0 && yh3c>0.0) { - multiline(5, -0.5*xw3c, -0.5*yh3c, ds3c, - 0.5*xw3c, -0.5*yh3c, ds3c, - 0.5*xw3c, 0.5*yh3c, ds3c, - -0.5*xw3c, 0.5*yh3c, ds3c, - -0.5*xw3c, -0.5*yh3c, ds3c); - multiline(5, -0.5*hl3c, (0.5-vx3c)*hl3c, ds3c, - 0.5*hl3c, (0.5-vx3c)*hl3c, ds3c, - 0.5*hl3c, 0.5 *hl3c, ds3c, - -0.5*hl3c, 0.5 *hl3c, ds3c, - -0.5*hl3c, (0.5-vx3c)*hl3c, ds3c); }; + if (ds3c == 0.0) { + xw3c = 0.0; + yh3c = 0.0; + hl3c = 0.0; + }; + if (ds2c == 0.0) { + xw2c = 0.0; + yh2c = 0.0; + hl2c = 0.0; + }; + if (ds1c == 0.0) { + xw1c = 0.0; + yh1c = 0.0; + hl1c = 0.0; + }; + if (hl1c <= 0.0) { + hl1c = 0.0; + } else { + hl1c = ddmax (hl1c, ddmax (xw1c / Nx, yh1c / Ny)); + }; + if (hl2c <= 0.0) { + hl2c = 0.0; + } else { + hl2c = ddmax (hl2c, ddmax (xw2c / Nx, yh2c / Ny)); + }; + hl3c = ddmax (hl3c, ddmax (xw3c / Nx, yh3c / Ny) * 3.0); /* leave some space for other data */ + vx3c = ddmin (ddmax (vx3, 1.0), 15.0); + + if (ds1c > 0.0 && xw1c > 0.0 && yh1c > 0.0) { + multiline (5, -0.5 * xw1c, -0.5 * yh1c, ds1c, 0.5 * xw1c, -0.5 * yh1c, ds1c, 0.5 * xw1c, 0.5 * yh1c, ds1c, -0.5 * xw1c, 0.5 * yh1c, ds1c, -0.5 * xw1c, + -0.5 * yh1c, ds1c); + multiline (5, -0.5 * hl1c, -0.5 * hl1c, ds1c, 0.5 * hl1c, -0.5 * hl1c, ds1c, 0.5 * hl1c, 0.5 * hl1c, ds1c, -0.5 * hl1c, 0.5 * hl1c, ds1c, -0.5 * hl1c, + -0.5 * hl1c, ds1c); + }; + + if (ds2c > 0.0 && xw2c > 0.0 && yh2c > 0.0) { + multiline (5, -0.5 * xw2c, -0.5 * yh2c, ds2c, 0.5 * xw2c, -0.5 * yh2c, ds2c, 0.5 * xw2c, 0.5 * yh2c, ds2c, -0.5 * xw2c, 0.5 * yh2c, ds2c, -0.5 * xw2c, + -0.5 * yh2c, ds2c); + multiline (5, -0.5 * hl2c, -0.5 * hl2c, ds2c, 0.5 * hl2c, -0.5 * hl2c, ds2c, 0.5 * hl2c, 0.5 * hl2c, ds2c, -0.5 * hl2c, 0.5 * hl2c, ds2c, -0.5 * hl2c, + -0.5 * hl2c, ds2c); + }; + + if (ds3c > 0.0 && xw3c > 0.0 && yh3c > 0.0) { + multiline (5, -0.5 * xw3c, -0.5 * yh3c, ds3c, 0.5 * xw3c, -0.5 * yh3c, ds3c, 0.5 * xw3c, 0.5 * yh3c, ds3c, -0.5 * xw3c, 0.5 * yh3c, ds3c, -0.5 * xw3c, + -0.5 * yh3c, ds3c); + multiline (5, -0.5 * hl3c, (0.5 - vx3c) * hl3c, ds3c, 0.5 * hl3c, (0.5 - vx3c) * hl3c, ds3c, 0.5 * hl3c, 0.5 * hl3c, ds3c, -0.5 * hl3c, 0.5 * hl3c, ds3c, + -0.5 * hl3c, (0.5 - vx3c) * hl3c, ds3c); + }; %} END diff --git a/mcstas-comps/contrib/TOF_PSDmonitor.comp b/mcstas-comps/contrib/TOF_PSDmonitor.comp index 02bf1a291..403f2af67 100644 --- a/mcstas-comps/contrib/TOF_PSDmonitor.comp +++ b/mcstas-comps/contrib/TOF_PSDmonitor.comp @@ -45,63 +45,60 @@ SETTING PARAMETERS (int ny=90, int nchan=100, xwidth=0.1, xmin=0, xmax=0, yheigh DECLARE %{ - DArray2d tofPSD_N; - DArray2d tofPSD_p; - DArray2d tofPSD_p2; + DArray2d tofPSD_N; + DArray2d tofPSD_p; + DArray2d tofPSD_p2; %} INITIALIZE %{ - if (xwidth > 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } - if ((xmin >= xmax) || (ymin >= ymax)){ - printf("PSD_monitor: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(0); - } - tofPSD_N = create_darr2d(nchan, ny); - tofPSD_p = create_darr2d(nchan, ny); - tofPSD_p2 = create_darr2d(nchan, ny); - // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + if ((xmin >= xmax) || (ymin >= ymax)) { + printf ("PSD_monitor: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (0); + } + tofPSD_N = create_darr2d (nchan, ny); + tofPSD_p = create_darr2d (nchan, ny); + tofPSD_p2 = create_darr2d (nchan, ny); + // Use instance name for monitor output if no input was given + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ - int i,j; + int i, j; - PROP_Z0; - if (x>xmin && xymin && y= (nchan-1)) - { - j = floor((y - ymin)*ny/(ymax - ymin)); - tofPSD_N[nchan-1][j]++; - tofPSD_p[nchan-1][j] += p; - tofPSD_p2[nchan-1][j] += p*p; - } - else - { - j = floor((y - ymin)*ny/(ymax - ymin)); - tofPSD_N[i][j]++; - tofPSD_p[i][j] += p; - tofPSD_p2[i][j] += p*p; - } - SCATTER; + PROP_Z0; + if (x > xmin && x < xmax && y > ymin && y < ymax) { + i = floor ((1e6 * t - TOFmin) * nchan / (TOFmax - TOFmin)); + if (i < 0 || i >= (nchan - 1)) { + j = floor ((y - ymin) * ny / (ymax - ymin)); + tofPSD_N[nchan - 1][j]++; + tofPSD_p[nchan - 1][j] += p; + tofPSD_p2[nchan - 1][j] += p * p; + } else { + j = floor ((y - ymin) * ny / (ymax - ymin)); + tofPSD_N[i][j]++; + tofPSD_p[i][j] += p; + tofPSD_p2[i][j] += p * p; } + SCATTER; + } %} SAVE %{ if (!nowritefile) { - DETECTOR_OUT_2D( - "Time-of-flight PSD monitor", - "Time-of-flight [\\gms]", - "Y position [mm]", - TOFmin, TOFmax, ymin*1000.0, ymax*1000.0, - nchan, ny, - &tofPSD_N[0][0],&tofPSD_p[0][0],&tofPSD_p2[0][0], - filename); + DETECTOR_OUT_2D ("Time-of-flight PSD monitor", "Time-of-flight [\\gms]", "Y position [mm]", TOFmin, TOFmax, ymin * 1000.0, ymax * 1000.0, nchan, ny, + &tofPSD_N[0][0], &tofPSD_p[0][0], &tofPSD_p2[0][0], filename); } %} @@ -113,12 +110,9 @@ FINALLY %{ MCDISPLAY %{ - magnify("xy"); - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); + magnify ("xy"); + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); %} END diff --git a/mcstas-comps/contrib/TOF_PSDmonitor_toQ.comp b/mcstas-comps/contrib/TOF_PSDmonitor_toQ.comp index 2ba1a8b03..0537605a8 100644 --- a/mcstas-comps/contrib/TOF_PSDmonitor_toQ.comp +++ b/mcstas-comps/contrib/TOF_PSDmonitor_toQ.comp @@ -53,81 +53,78 @@ SETTING PARAMETERS (int ny=90, int nqbin=500, xwidth=0.1, xmin=0, xmax=0, yheigh DECLARE %{ - DArray1d Q_N; - DArray1d Q_p; - DArray1d Q_p2; + DArray1d Q_N; + DArray1d Q_p; + DArray1d Q_p2; %} INITIALIZE %{ - - if (xwidth > 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } - if ((xmin >= xmax) || (ymin >= ymax)){ - printf("PSD_monitor: %s: Null detection area !\n" - "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", - NAME_CURRENT_COMP); - exit(0); - } - Q_N = create_darr1d(nqbin); - Q_p = create_darr1d(nqbin); - Q_p2 = create_darr1d(nqbin); - // Use instance name for monitor output if no input was given - if (!strcmp(filename,"\0")) sprintf(filename,"%s",NAME_CURRENT_COMP); + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } + + if ((xmin >= xmax) || (ymin >= ymax)) { + printf ("PSD_monitor: %s: Null detection area !\n" + "ERROR (xwidth,yheight,xmin,xmax,ymin,ymax). Exiting", + NAME_CURRENT_COMP); + exit (0); + } + Q_N = create_darr1d (nqbin); + Q_p = create_darr1d (nqbin); + Q_p2 = create_darr1d (nqbin); + // Use instance name for monitor output if no input was given + if (!strcmp (filename, "\0")) + sprintf (filename, "%s", NAME_CURRENT_COMP); %} TRACE %{ - int i,j; - double dy,theta,dist,vel,L; - double Q; + int i, j; + double dy, theta, dist, vel, L; + double Q; - PROP_Z0; - if (x>xmin && xymin && y xmin && x < xmax && y > ymin && y < ymax) { + // which pixel have we hit? + i = floor ((y - ymin) * ny / (ymax - ymin)); + // find the centre of the pixel we've hit + dy = (i * (ymax - ymin) / ny) - ny * (ymax - ymin) / (2.0 * ny); + // calculate theta + theta = atan (dy / L2); - // instead of calculating L from velocity use TOF to calculate wavelength - // we'll also assume that we are using event mode so there are essentially no - // wavelength bins to worry about - dist=L1+sqrt(dy*dy+L2*L2); - //only count the neutrons if they arrive in the required time window - // might do something more with this later - if (t*1e6 > tmin && t*1e6 < tmax) - { - vel=dist/t; - L=3956.03397606/vel; - //L = (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); - Q = 4*PI*sin((theta+(detTheta*PI/180.0)))/L; - //printf("Q= %g, Qmin= %g, Qmax= %g \n",Q,qmin,qmax); - //printf("theta= %g\n",theta*180.0/PI); + // instead of calculating L from velocity use TOF to calculate wavelength + // we'll also assume that we are using event mode so there are essentially no + // wavelength bins to worry about + dist = L1 + sqrt (dy * dy + L2 * L2); + // only count the neutrons if they arrive in the required time window + // might do something more with this later + if (t * 1e6 > tmin && t * 1e6 < tmax) { + vel = dist / t; + L = 3956.03397606 / vel; + // L = (2*PI/V2K)/sqrt(vx*vx + vy*vy + vz*vz); + Q = 4 * PI * sin ((theta + (detTheta * PI / 180.0))) / L; + // printf("Q= %g, Qmin= %g, Qmax= %g \n",Q,qmin,qmax); + // printf("theta= %g\n",theta*180.0/PI); - i = floor((Q-qmin)*nqbin/(qmax-qmin)); - if(i >= 0 && i < nqbin) - { - Q_N[i]++; - Q_p[i] += p; - Q_p2[i] += p*p; - SCATTER; - } + i = floor ((Q - qmin) * nqbin / (qmax - qmin)); + if (i >= 0 && i < nqbin) { + Q_N[i]++; + Q_p[i] += p; + Q_p2[i] += p * p; + SCATTER; } - } + } %} SAVE %{ if (!nowritefile) { - DETECTOR_OUT_1D( - "Q monitor", - "Q [AA^-1]", - "Intensity", - "Q", qmin, qmax, nqbin, - &Q_N[0],&Q_p[0],&Q_p2[0], - filename); + DETECTOR_OUT_1D ("Q monitor", "Q [AA^-1]", "Intensity", "Q", qmin, qmax, nqbin, &Q_N[0], &Q_p[0], &Q_p2[0], filename); } %} @@ -139,18 +136,15 @@ FINALLY %{ MCDISPLAY %{ - magnify("xy"); - multiline(5, (double)xmin, (double)ymin, 0.0, - (double)xmax, (double)ymin, 0.0, - (double)xmax, (double)ymax, 0.0, - (double)xmin, (double)ymax, 0.0, - (double)xmin, (double)ymin, 0.0); - double dy=(ymax-ymin)/(ny); + magnify ("xy"); + multiline (5, (double)xmin, (double)ymin, 0.0, (double)xmax, (double)ymin, 0.0, (double)xmax, (double)ymax, 0.0, (double)xmin, (double)ymax, 0.0, (double)xmin, + (double)ymin, 0.0); + double dy = (ymax - ymin) / (ny); int j; - double ytmp=ymin; - for(j=0; jN_reflection[i++] = 0); - for (i=0; i<8; aVars->M[i++] = 0); + for (i = 0; i < 9; aVars->N_reflection[i++] = 0) + ; + for (i = 0; i < 8; aVars->M[i++] = 0) + ; aVars->w1c = a_w1; aVars->w2c = a_w2; - if (a_mleft >= 0) aVars->M[1] =a_mleft ; - if (a_mright >= 0) aVars->M[2] =a_mright ; - if (a_mtop >= 0) aVars->M[3] =a_mtop ; - if (a_mbottom >= 0) aVars->M[4] =a_mbottom; - - - aVars->nx[1] = a_l; aVars->ny[1] = 0; aVars->nz[1] = -0.5*(aVars->w2c-aVars->w1c); /* 1:+X left */ - aVars->nx[2] = -a_l; aVars->ny[2] = 0; aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ - aVars->nx[3] = 0; aVars->ny[3] = a_l; aVars->nz[3] = -0.5*(a_h2-a_h1); /* 3:+Y top */ - aVars->nx[4] = 0; aVars->ny[4] = -a_l; aVars->nz[4] = aVars->nz[3]; /* 4:-Y bottom */ - aVars->nx[5] = 0; aVars->ny[5] = 0; aVars->nz[5] = a_l; /* 5:+Z exit */ - aVars->nx[0] = 0; aVars->ny[0] = 0; aVars->nz[0] = -a_l; /* 0:Z0 input */ - aVars->nx[6] = a_l; aVars->ny[6] = 0; aVars->nz[6] = -0.5*(aVars->w2c); /* 1:+X left FeSi waver */ - aVars->nx[7] = -a_l; aVars->ny[7] = 0; aVars->nz[7] = -0.5*(aVars->w2c); /* 1:+X right FeSi waver */ - - - aVars->wx[1] = +(aVars->w1c)/2; aVars->wy[1] = 0; aVars->wz[1] = 0; /* 1:+X left */ - aVars->wx[2] = -(aVars->w1c)/2; aVars->wy[2] = 0; aVars->wz[2] = 0; /* 2:-X right */ - aVars->wx[3] = 0; aVars->wy[3] = +a_h1/2; aVars->wz[3] = 0; /* 3:+Y top */ - aVars->wx[4] = 0; aVars->wy[4] = -a_h1/2; aVars->wz[4] = 0; /* 4:-Y bottom */ - aVars->wx[5] = 0; aVars->wy[5] = 0; aVars->wz[5] = a_l; /* 5:+Z exit */ - aVars->wx[0] = 0; aVars->wy[0] = 0; aVars->wz[0] = 0; /* 0:Z0 input */ - aVars->wx[6] = 0; aVars->wy[6] = 0; aVars->wz[6] = 0; /* 1:+X left FeSi waver */ - aVars->wx[7] = 0; aVars->wy[7] = 0; aVars->wz[7] = 0; /* 1:+X right FeSi waver */ - - - for (i=0; i <= 7; i++) - { - aVars->A[i] = 0; /* gravitation is not taken into account A.O.*/ - aVars->norm_n2[i] = aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i] + aVars->nz[i]*aVars->nz[i]; - if (aVars->norm_n2[i] <= 0) - { fprintf(stderr,"%s: Fatal: normal vector norm %i is null/negative ! Check guide dimensions.\n", aVars->compcurname, i); exit(-1); } /* should never occur */ + if (a_mleft >= 0) + aVars->M[1] = a_mleft; + if (a_mright >= 0) + aVars->M[2] = a_mright; + if (a_mtop >= 0) + aVars->M[3] = a_mtop; + if (a_mbottom >= 0) + aVars->M[4] = a_mbottom; + + aVars->nx[1] = a_l; + aVars->ny[1] = 0; + aVars->nz[1] = -0.5 * (aVars->w2c - aVars->w1c); /* 1:+X left */ + aVars->nx[2] = -a_l; + aVars->ny[2] = 0; + aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ + aVars->nx[3] = 0; + aVars->ny[3] = a_l; + aVars->nz[3] = -0.5 * (a_h2 - a_h1); /* 3:+Y top */ + aVars->nx[4] = 0; + aVars->ny[4] = -a_l; + aVars->nz[4] = aVars->nz[3]; /* 4:-Y bottom */ + aVars->nx[5] = 0; + aVars->ny[5] = 0; + aVars->nz[5] = a_l; /* 5:+Z exit */ + aVars->nx[0] = 0; + aVars->ny[0] = 0; + aVars->nz[0] = -a_l; /* 0:Z0 input */ + aVars->nx[6] = a_l; + aVars->ny[6] = 0; + aVars->nz[6] = -0.5 * (aVars->w2c); /* 1:+X left FeSi waver */ + aVars->nx[7] = -a_l; + aVars->ny[7] = 0; + aVars->nz[7] = -0.5 * (aVars->w2c); /* 1:+X right FeSi waver */ + + aVars->wx[1] = +(aVars->w1c) / 2; + aVars->wy[1] = 0; + aVars->wz[1] = 0; /* 1:+X left */ + aVars->wx[2] = -(aVars->w1c) / 2; + aVars->wy[2] = 0; + aVars->wz[2] = 0; /* 2:-X right */ + aVars->wx[3] = 0; + aVars->wy[3] = +a_h1 / 2; + aVars->wz[3] = 0; /* 3:+Y top */ + aVars->wx[4] = 0; + aVars->wy[4] = -a_h1 / 2; + aVars->wz[4] = 0; /* 4:-Y bottom */ + aVars->wx[5] = 0; + aVars->wy[5] = 0; + aVars->wz[5] = a_l; /* 5:+Z exit */ + aVars->wx[0] = 0; + aVars->wy[0] = 0; + aVars->wz[0] = 0; /* 0:Z0 input */ + aVars->wx[6] = 0; + aVars->wy[6] = 0; + aVars->wz[6] = 0; /* 1:+X left FeSi waver */ + aVars->wx[7] = 0; + aVars->wy[7] = 0; + aVars->wz[7] = 0; /* 1:+X right FeSi waver */ + + for (i = 0; i <= 7; i++) { + aVars->A[i] = 0; /* gravitation is not taken into account A.O.*/ + aVars->norm_n2[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i] + aVars->nz[i] * aVars->nz[i]; + if (aVars->norm_n2[i] <= 0) { + fprintf (stderr, "%s: Fatal: normal vector norm %i is null/negative ! Check guide dimensions.\n", aVars->compcurname, i); + exit (-1); + } /* should never occur */ else - aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); } - } - int Polarizer_guide_Trace(double *dt, double *dt0, - Polarizer_guide_Vars_type *aVars, - double cx, double cy, double cz, - double cvx, double cvy, double cvz) - { + int + Polarizer_guide_Trace (double* dt, double* dt0, Polarizer_guide_Vars_type* aVars, double cx, double cy, double cz, double cvx, double cvy, double cvz) { double B, C, ret; - int side=0; - double n1,n2; - + int side = 0; + double n1, n2; /* 3=+Y side: n=(0, l, -0.5*(h2-h1)) ; W = (0, +h1/2, 0) (up) */ - B = aVars->ny[3]*cvy + aVars->nz[3]*cvz; C = aVars->ny[3]*(cy-aVars->wy[3]) + aVars->nz[3]*cz; /* aVars->nx=aVars->wz=0 */ - ret = solve_2nd_order(&*dt0, NULL, aVars->A[3], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=3; aVars->n_dot_v[3] = B; } - + B = aVars->ny[3] * cvy + aVars->nz[3] * cvz; + C = aVars->ny[3] * (cy - aVars->wy[3]) + aVars->nz[3] * cz; /* aVars->nx=aVars->wz=0 */ + ret = solve_2nd_order (&*dt0, NULL, aVars->A[3], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 3; + aVars->n_dot_v[3] = B; + } /* 4=-Y side: n=(0, l, +0.5*(h2-h1)) ; W = (0, -h1/2, 0) (down) */ - B = aVars->ny[4]*cvy + aVars->nz[4]*cvz; C = aVars->ny[4]*(cy-aVars->wy[4]) + aVars->nz[4]*cz; /* aVars->nx=aVars->wz=0 */ - ret = solve_2nd_order(&*dt0, NULL, aVars->A[4], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=4; aVars->n_dot_v[4] = B; } - + B = aVars->ny[4] * cvy + aVars->nz[4] * cvz; + C = aVars->ny[4] * (cy - aVars->wy[4]) + aVars->nz[4] * cz; /* aVars->nx=aVars->wz=0 */ + ret = solve_2nd_order (&*dt0, NULL, aVars->A[4], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 4; + aVars->n_dot_v[4] = B; + } - /* 1=+X side: n=(l, 0, -0.5*(w2-w1)) ; W = (+w1/2, 0, 0) (left)*/ + /* 1=+X side: n=(l, 0, -0.5*(w2-w1)) ; W = (+w1/2, 0, 0) (left)*/ - B = aVars->nx[1]*cvx + aVars->nz[1]*cvz; C = aVars->nx[1]*(cx-aVars->wx[1]) + aVars->nz[1]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(&*dt0, NULL, aVars->A[1], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=1; aVars->n_dot_v[1] = B; } - + B = aVars->nx[1] * cvx + aVars->nz[1] * cvz; + C = aVars->nx[1] * (cx - aVars->wx[1]) + aVars->nz[1] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (&*dt0, NULL, aVars->A[1], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 1; + aVars->n_dot_v[1] = B; + } /* 2=-X side: n=(l, 0, +0.5*(w2-w1)) ; W = (-w1/2, 0, 0) (right) */ - B = aVars->nx[2]*cvx + aVars->nz[2]*cvz; C = aVars->nx[2]*(cx-aVars->wx[2]) + aVars->nz[2]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(&*dt0, NULL, aVars->A[2], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=2; aVars->n_dot_v[2] = B; } - - - /* 6=+X side: n=(l, 0, -0.5*w2) ; W = (0, 0, 0) (left FeSi waver) */ + B = aVars->nx[2] * cvx + aVars->nz[2] * cvz; + C = aVars->nx[2] * (cx - aVars->wx[2]) + aVars->nz[2] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (&*dt0, NULL, aVars->A[2], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 2; + aVars->n_dot_v[2] = B; + } - B = aVars->nx[6]*cvx + aVars->nz[6]*cvz; C = aVars->nx[6]*(cx-aVars->wx[6]) + aVars->nz[6]*cz; - ret = solve_2nd_order(&*dt0, NULL, aVars->A[6], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=6; aVars->n_dot_v[6] = B; } + /* 6=+X side: n=(l, 0, -0.5*w2) ; W = (0, 0, 0) (left FeSi waver) */ + B = aVars->nx[6] * cvx + aVars->nz[6] * cvz; + C = aVars->nx[6] * (cx - aVars->wx[6]) + aVars->nz[6] * cz; + ret = solve_2nd_order (&*dt0, NULL, aVars->A[6], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 6; + aVars->n_dot_v[6] = B; + } /* 7=-X side: n=(-l, 0, -0.5*w2) ; W = (0, 0, 0) (right FeSi waver) */ - B = aVars->nx[7]*cvx + aVars->nz[7]*cvz; C = aVars->nx[7]*(cx-aVars->wx[7]) + aVars->nz[7]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(&*dt0, NULL, aVars->A[7], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=7; aVars->n_dot_v[7] = B; } + B = aVars->nx[7] * cvx + aVars->nz[7] * cvz; + C = aVars->nx[7] * (cx - aVars->wx[7]) + aVars->nz[7] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (&*dt0, NULL, aVars->A[7], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 7; + aVars->n_dot_v[7] = B; + } - return (side); } -%include "read_table-lib" + %include "read_table-lib" %} DECLARE @@ -211,45 +257,43 @@ DECLARE INITIALIZE %{ - - if (W < 0 || R0 < 0 || Qc < 0) - { fprintf(stderr,"Polarizer_guide: %s W R0 Qc must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } - - strcpy(Vars.compcurname, NAME_CURRENT_COMP); - Polarizer_guide_Init(&Vars, - w1, h1, w2, h2, l, R0, - Qc, alpha, W, - mleft, mright, mtop, mbottom); - - Si_sig_i=Si_i; - Si_sig_a=Si_a; - Si_cross_i= 2.33 / 28.09 * Si_sig_i * 6.022 * 10; - Si_cross_a_v= 2.33 / 28.09 * Si_sig_a * 6.022 * 10 * 2200.0; - - Fe_sig_i=0.4; - Fe_sig_a=3.4; - Fe_cross_i= 7.87 / 55.85 * Fe_sig_i * 6.022 * 10; - Fe_cross_a_v= 7.87 / 55.85 * Fe_sig_a * 6.022 * 10 * 2200.0; - /** (density / rel. atomic mass * sig * 6.022 * 10 * v(1.8A)) **/ - if (reflectUP != NULL) - { - Table_Read(&upTable, reflectUP, 1); /* read 1st block data from file into upTable */ - Table_Rebin(&upTable); /* rebin as evenly, increasing array */ - if (upTable.rows < 2) Table_Free(&upTable); - Table_Info(upTable); - } else upTable.data = NULL; + if (W < 0 || R0 < 0 || Qc < 0) { + fprintf (stderr, "Polarizer_guide: %s W R0 Qc must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } + + strcpy (Vars.compcurname, NAME_CURRENT_COMP); + Polarizer_guide_Init (&Vars, w1, h1, w2, h2, l, R0, Qc, alpha, W, mleft, mright, mtop, mbottom); - if (reflectDW != NULL) - { - Table_Read(&dwTable, reflectDW, 1); /* read 1st block data from file into dwTable */ - Table_Rebin(&dwTable); /* rebin as evenly, increasing array */ - if (dwTable.rows < 2) Table_Free(&dwTable); - Table_Info(dwTable); - } else dwTable.data = NULL; + Si_sig_i = Si_i; + Si_sig_a = Si_a; + Si_cross_i = 2.33 / 28.09 * Si_sig_i * 6.022 * 10; + Si_cross_a_v = 2.33 / 28.09 * Si_sig_a * 6.022 * 10 * 2200.0; + Fe_sig_i = 0.4; + Fe_sig_a = 3.4; + Fe_cross_i = 7.87 / 55.85 * Fe_sig_i * 6.022 * 10; + Fe_cross_a_v = 7.87 / 55.85 * Fe_sig_a * 6.022 * 10 * 2200.0; + /** (density / rel. atomic mass * sig * 6.022 * 10 * v(1.8A)) **/ + if (reflectUP != NULL) { + Table_Read (&upTable, reflectUP, 1); /* read 1st block data from file into upTable */ + Table_Rebin (&upTable); /* rebin as evenly, increasing array */ + if (upTable.rows < 2) + Table_Free (&upTable); + Table_Info (upTable); + } else + upTable.data = NULL; + + if (reflectDW != NULL) { + Table_Read (&dwTable, reflectDW, 1); /* read 1st block data from file into dwTable */ + Table_Rebin (&dwTable); /* rebin as evenly, increasing array */ + if (dwTable.rows < 2) + Table_Free (&dwTable); + Table_Info (dwTable); + } else + dwTable.data = NULL; %} @@ -258,47 +302,43 @@ TRACE %{ double B, C, dt0, dt; double q, arg, selectF, Rtemp; - int ret, side, side0; + int ret, side, side0; double edge; double n1, n2; - int bounces = 0; + int bounces = 0; double v, L, sinW, Wlen_Si, Wlen_Fe; /* On the GPU we need Polarizer_guide_Vars pr. thread... */ #ifdef OPENACC - Polarizer_guide_Vars_type Vars_thread=Vars; + Polarizer_guide_Vars_type Vars_thread = Vars; /* whereas on CPU we can make do with a single, shared structure: */ #else #define Vars_thread Vars #endif - - dt = -1; dt0 = -1; + + dt = -1; + dt0 = -1; /* propagate to box input (with gravitation) in comp local coords */ /* 0=Z0 side: n=(0, 0, 1) ; W = (0, 0, 0) (at z=0, guide input)*/ - B = -vz; C = -z; + B = -vz; + C = -z; - ret = solve_2nd_order(&dt0, NULL, Vars_thread.A[0], B, C); - if (ret && dt0>0) - { - dt = dt0; - PROP_DT(dt); + ret = solve_2nd_order (&dt0, NULL, Vars_thread.A[0], B, C); + if (ret && dt0 > 0) { + dt = dt0; + PROP_DT (dt); Vars_thread.N_reflection[8]++; } /* check if we are in the box input, else absorb */ - if(dt > 0 && fabs(x) <= w1/2 && fabs(y) <= h1/2) - { + if (dt > 0 && fabs (x) <= w1 / 2 && fabs (y) <= h1 / 2) { /* neutron is now in the input window of the guide */ /* do loops on reflections in the box */ - - - - for(;;) - { + for (;;) { /* get intersections for all box sides */ /* A = 0; B = n.v; C = n.(r-W); */ - + bounces++; side = 0; @@ -306,219 +346,192 @@ TRACE /* starts with the exit side intersection (the last one !)*/ /* 5=+Z side: n=(0, 0, 1) ; W = (0, 0, l) (at z=l, guide exit)*/ - B = vz; C = z - Vars_thread.wz[5]; - ret = solve_2nd_order(&dt0, NULL, Vars_thread.A[5], B, C); - if (ret && dt0>0) - { dt = dt0; side=5; - Vars_thread.n_dot_v[5] = B; } - else - { fprintf(stderr,"%s: warning: neutron trajectory is parallel to guide exit, and thus can not exit\n", Vars_thread.compcurname); ABSORB; } - - + B = vz; + C = z - Vars_thread.wz[5]; + ret = solve_2nd_order (&dt0, NULL, Vars_thread.A[5], B, C); + if (ret && dt0 > 0) { + dt = dt0; + side = 5; + Vars_thread.n_dot_v[5] = B; + } else { + fprintf (stderr, "%s: warning: neutron trajectory is parallel to guide exit, and thus can not exit\n", Vars_thread.compcurname); + ABSORB; + } /* now look if there is a previous intersection with guide sides */ - side0 = Polarizer_guide_Trace(&dt, &dt0, &Vars_thread, x, y, z, vx, vy, vz); - if (side0) side= side0; + side0 = Polarizer_guide_Trace (&dt, &dt0, &Vars_thread, x, y, z, vx, vy, vz); + if (side0) + side = side0; /* only positive dt are valid */ /* exit reflection loops if no intersection (neutron is after box) */ - if (side == 0 || dt < 0) - { fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", Vars_thread.compcurname); ABSORB; } /* should never occur */ - + if (side == 0 || dt < 0) { + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", Vars_thread.compcurname); + ABSORB; + } /* should never occur */ /* propagate to dt */ - PROP_DT(dt); - + PROP_DT (dt); /* do reflection on speed for l/r/u/d sides */ if (side == 5) /* neutron reaches end of guide: end loop and exit comp */ - { Vars_thread.N_reflection[side]++; SCATTER; break; } + { + Vars_thread.N_reflection[side]++; + SCATTER; + break; + } /* else reflection on a guide wall */ - if (side == 1 || side == 2 || side == 3 || side == 4) + if (side == 1 || side == 2 || side == 3 || side == 4) { + if (Vars_thread.M[side] == 0 || Qc == 0) /* walls are absorbing */ { - if(Vars_thread.M[side] == 0 || Qc == 0) /* walls are absorbing */ - { ABSORB; } + ABSORB; } + } - - if (side == 6 || side == 7 ) - { + if (side == 6 || side == 7) { if (sy < 0) /* spin down */ - { - q = 2*V2Q*fabs(Vars_thread.n_dot_v[side])/Vars_thread.norm_n[side]; - v = sqrt(vx*vx + vy*vy + vz*vz); - L = (2*PI/V2K)/v; - sinW=(q*L)/(4*PI); - Wlen_Si=(waferD/sinW); - Wlen_Fe=(FeD/sinW); - Si_cross_tot=Si_cross_i + Si_cross_a_v / v; - Fe_cross_tot=Fe_cross_i + Fe_cross_a_v / v; - - + { + q = 2 * V2Q * fabs (Vars_thread.n_dot_v[side]) / Vars_thread.norm_n[side]; + v = sqrt (vx * vx + vy * vy + vz * vz); + L = (2 * PI / V2K) / v; + sinW = (q * L) / (4 * PI); + Wlen_Si = (waferD / sinW); + Wlen_Fe = (FeD / sinW); + Si_cross_tot = Si_cross_i + Si_cross_a_v / v; + Fe_cross_tot = Fe_cross_i + Fe_cross_a_v / v; + + selectF = rand01 (); + if (selectF <= Table_Value (dwTable, q, 1)) { + Vars_thread.N_reflection[side]++; + dt0 = 2 * Vars_thread.n_dot_v[side] / Vars_thread.norm_n2[side]; + vx -= Vars_thread.nx[side] * dt0; + vy -= Vars_thread.ny[side] * dt0; + vz -= Vars_thread.nz[side] * dt0; + SCATTER; + } - selectF = rand01(); - if(selectF <= Table_Value(dwTable, q, 1)) - { - Vars_thread.N_reflection[side]++; - dt0 = 2*Vars_thread.n_dot_v[side]/Vars_thread.norm_n2[side]; - vx -= Vars_thread.nx[side]*dt0; - vy -= Vars_thread.ny[side]*dt0; - vz -= Vars_thread.nz[side]*dt0; - SCATTER; - } + if (selectF > Table_Value (dwTable, q, 1)) { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + } - if(selectF > Table_Value(dwTable, q, 1)) - { - SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - } + Vars_thread.N_reflection[0]++; - Vars_thread.N_reflection[0]++; + } /* sy<0 */ - } /* sy<0 */ + if (sy > 0) /* spin up */ + { + q = 2 * V2Q * fabs (Vars_thread.n_dot_v[side]) / Vars_thread.norm_n[side]; + v = sqrt (vx * vx + vy * vy + vz * vz); + L = (2 * PI / V2K) / v; + sinW = (q * L) / (4 * PI); + Wlen_Si = (waferD / sinW); + Wlen_Fe = (FeD / sinW); + Si_cross_tot = Si_cross_i + Si_cross_a_v / v; + Fe_cross_tot = Fe_cross_i + Fe_cross_a_v / v; + + selectF = rand01 (); + if (selectF <= Table_Value (upTable, q, 1)) { + Vars_thread.N_reflection[side]++; + dt0 = 2 * Vars_thread.n_dot_v[side] / Vars_thread.norm_n2[side]; + vx -= Vars_thread.nx[side] * dt0; + vy -= Vars_thread.ny[side] * dt0; + vz -= Vars_thread.nz[side] * dt0; + SCATTER; + } + if (selectF > Table_Value (upTable, q, 1)) { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + } + Vars_thread.N_reflection[0]++; + } /* sy>0 */ - if (sy > 0) /* spin up */ - { - q = 2*V2Q*fabs(Vars_thread.n_dot_v[side])/Vars_thread.norm_n[side]; - v = sqrt(vx*vx + vy*vy + vz*vz); - L = (2*PI/V2K)/v; - sinW=(q*L)/(4*PI); - Wlen_Si=(waferD/sinW); - Wlen_Fe=(FeD/sinW); - Si_cross_tot=Si_cross_i + Si_cross_a_v / v; - Fe_cross_tot=Fe_cross_i + Fe_cross_a_v / v; - - - - selectF = rand01(); - if(selectF <= Table_Value(upTable, q, 1)) - { - Vars_thread.N_reflection[side]++; - dt0 = 2*Vars_thread.n_dot_v[side]/Vars_thread.norm_n2[side]; - vx -= Vars_thread.nx[side]*dt0; - vy -= Vars_thread.ny[side]*dt0; - vz -= Vars_thread.nz[side]*dt0; - SCATTER; - } - - if(selectF > Table_Value(upTable, q, 1)) - { - SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - } - - Vars_thread.N_reflection[0]++; - - } /* sy>0 */ - - - } /* side 6,7 */ + } /* side 6,7 */ - else - { + else { /*************************************************************************************************/ - /* change/mirror velocity: v_f = v - n.2*n.v/|n|^2 */ + /* change/mirror velocity: v_f = v - n.2*n.v/|n|^2 */ - Vars_thread.N_reflection[side]++; /* Vars_thread.norm_n2 > 0 was checked at INIT */ - dt0 = 2*Vars_thread.n_dot_v[side]/Vars_thread.norm_n2[side]; /* 2*n.v/|n|^2 */ - vx -= Vars_thread.nx[side]*dt0; - vy -= Vars_thread.ny[side]*dt0; - vz -= Vars_thread.nz[side]*dt0; + Vars_thread.N_reflection[side]++; /* Vars_thread.norm_n2 > 0 was checked at INIT */ + dt0 = 2 * Vars_thread.n_dot_v[side] / Vars_thread.norm_n2[side]; /* 2*n.v/|n|^2 */ + vx -= Vars_thread.nx[side] * dt0; + vy -= Vars_thread.ny[side] * dt0; + vz -= Vars_thread.nz[side] * dt0; /* compute q and modify neutron weight */ /* scattering q=|k_i-k_f| = V2Q*|vf - v| = V2Q*2*n.v/|n| */ - q = 2*V2Q*fabs(Vars_thread.n_dot_v[side])/Vars_thread.norm_n[side]; + q = 2 * V2Q * fabs (Vars_thread.n_dot_v[side]) / Vars_thread.norm_n[side]; B = R0; - if(q > Qc) - { - if (W>0) - arg = (q-Vars_thread.M[side]*Qc)/W; + if (q > Qc) { + if (W > 0) + arg = (q - Vars_thread.M[side] * Qc) / W; else - arg = (q-Vars_thread.M[side]*Qc)*10000; /* W = 0.00001 */ + arg = (q - Vars_thread.M[side] * Qc) * 10000; /* W = 0.00001 */ - if(arg < 10) - { - B *= .5*(1-tanh(arg))*(1-alpha*(q-Qc)); - } - else - { ABSORB; }; /* Cutoff ~ 1E-10 */ - } - if (B < 0) B=0; - if (B > 1) B=1; - p *= B; - SCATTER; - - Vars_thread.N_reflection[0]++; + if (arg < 10) { + B *= .5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc)); + } else { + ABSORB; + }; /* Cutoff ~ 1E-10 */ + } + if (B < 0) + B = 0; + if (B > 1) + B = 1; + p *= B; + SCATTER; + + Vars_thread.N_reflection[0]++; /*************************************************************************************************/ - } - - - /* go to the next reflection */ - if (bounces > 1000) ABSORB; - } /* end for */ - } - else - ABSORB; + } + + /* go to the next reflection */ + if (bounces > 1000) + ABSORB; + } /* end for */ + } else + ABSORB; %} FINALLY %{ - Table_Free(&upTable); - Table_Free(&dwTable); + Table_Free (&upTable); + Table_Free (&dwTable); %} MCDISPLAY %{ - double x; + double x; int i; - magnify("xy"); - multiline(5, - -w1/2.0, -h1/2.0, 0.0, - w1/2.0, -h1/2.0, 0.0, - w1/2.0, h1/2.0, 0.0, - -w1/2.0, h1/2.0, 0.0, - -w1/2.0, -h1/2.0, 0.0); - multiline(5, - -w2/2.0, -h2/2.0, (double)l, - w2/2.0, -h2/2.0, (double)l, - w2/2.0, h2/2.0, (double)l, - -w2/2.0, h2/2.0, (double)l, - -w2/2.0, -h2/2.0, (double)l); - multiline(5, - 0.0, -h1/2.0, 0.0, - 0.0, h1/2.0, 0.0, - -w2/2.0, h1/2.0, (double)l, - -w2/2.0, -h1/2.0, (double)l, - 0.0, -h1/2.0, 0.0); - multiline(5, - 0.0, -h1/2.0, 0.0, - 0.0, h1/2.0, 0.0, - w2/2.0, h1/2.0, (double)l, - w2/2.0, -h1/2.0, (double)l, - 0.0, -h1/2.0, 0.0); - line(-w1/2.0, -h1/2.0, 0, -w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, -h1/2.0, 0, w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, h1/2.0, 0, w2/2.0, h2/2.0, (double)l); - line(-w1/2.0, h1/2.0, 0, -w2/2.0, h2/2.0, (double)l); + magnify ("xy"); + multiline (5, -w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, -h1 / 2.0, 0.0); + multiline (5, -w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, + -h2 / 2.0, (double)l); + multiline (5, 0.0, -h1 / 2.0, 0.0, 0.0, h1 / 2.0, 0.0, -w2 / 2.0, h1 / 2.0, (double)l, -w2 / 2.0, -h1 / 2.0, (double)l, 0.0, -h1 / 2.0, 0.0); + multiline (5, 0.0, -h1 / 2.0, 0.0, 0.0, h1 / 2.0, 0.0, w2 / 2.0, h1 / 2.0, (double)l, w2 / 2.0, -h1 / 2.0, (double)l, 0.0, -h1 / 2.0, 0.0); + line (-w1 / 2.0, -h1 / 2.0, 0, -w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, -h1 / 2.0, 0, w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, h1 / 2.0, 0, w2 / 2.0, h2 / 2.0, (double)l); + line (-w1 / 2.0, h1 / 2.0, 0, -w2 / 2.0, h2 / 2.0, (double)l); %} END diff --git a/mcstas-comps/contrib/Transmission_polarisatorABSnT.comp b/mcstas-comps/contrib/Transmission_polarisatorABSnT.comp index 5ea561423..c117bb681 100644 --- a/mcstas-comps/contrib/Transmission_polarisatorABSnT.comp +++ b/mcstas-comps/contrib/Transmission_polarisatorABSnT.comp @@ -70,133 +70,180 @@ SHARE %{ -typedef struct Polarizer_guide_Vars -{ -double nx[8], ny[8], nz[8]; -double wx[8], wy[8], wz[8]; -double A[8], norm_n2[8], norm_n[8]; -long N_reflection[9]; -double M[8]; -double w1c; -double w2c; -double n_dot_v[8]; -char compcurname[256]; -} Polarizer_guide_Vars_type; - -void Polarizer_guide_Init(Polarizer_guide_Vars_type *aVars, -MCNUM a_w1, MCNUM a_h1, MCNUM a_w2, MCNUM a_h2, MCNUM a_l, -MCNUM a_R0, MCNUM a_Qc, MCNUM a_alpha, MCNUM a_W, -MCNUM a_mleft, MCNUM a_mright, MCNUM a_mtop, MCNUM a_mbottom, MCNUM a_mup, MCNUM a_mdown) - { + typedef struct Polarizer_guide_Vars { + double nx[8], ny[8], nz[8]; + double wx[8], wy[8], wz[8]; + double A[8], norm_n2[8], norm_n[8]; + long N_reflection[9]; + double M[8]; + double w1c; + double w2c; + double n_dot_v[8]; + char compcurname[256]; + } Polarizer_guide_Vars_type; + + void + Polarizer_guide_Init (Polarizer_guide_Vars_type* aVars, MCNUM a_w1, MCNUM a_h1, MCNUM a_w2, MCNUM a_h2, MCNUM a_l, MCNUM a_R0, MCNUM a_Qc, MCNUM a_alpha, + MCNUM a_W, MCNUM a_mleft, MCNUM a_mright, MCNUM a_mtop, MCNUM a_mbottom, MCNUM a_mup, MCNUM a_mdown) { int i; - for (i=0; i<9; aVars->N_reflection[i++] = 0); - for (i=0; i<8; aVars->M[i++] = 0); + for (i = 0; i < 9; aVars->N_reflection[i++] = 0) + ; + for (i = 0; i < 8; aVars->M[i++] = 0) + ; aVars->w1c = a_w1; aVars->w2c = a_w2; - if (a_mleft >= 0) aVars->M[1] =a_mleft ; - if (a_mright >= 0) aVars->M[2] =a_mright ; - if (a_mtop >= 0) aVars->M[3] =a_mtop ; - if (a_mbottom >= 0) aVars->M[4] =a_mbottom; - if (a_mup >= 0) aVars->M[6] =a_mup ; - if (a_mdown >= 0) aVars->M[7] =a_mdown ; - - - aVars->nx[1] = a_l; aVars->ny[1] = 0; aVars->nz[1] = -0.5*(aVars->w2c-aVars->w1c); /* 1:+X left */ - aVars->nx[2] = -a_l; aVars->ny[2] = 0; aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ - aVars->nx[3] = 0; aVars->ny[3] = a_l; aVars->nz[3] = -0.5*(a_h2-a_h1); /* 3:+Y top */ - aVars->nx[4] = 0; aVars->ny[4] = -a_l; aVars->nz[4] = aVars->nz[3]; /* 4:-Y bottom */ - aVars->nx[5] = 0; aVars->ny[5] = 0; aVars->nz[5] = a_l; /* 5:+Z exit */ - aVars->nx[0] = 0; aVars->ny[0] = 0; aVars->nz[0] = -a_l; /* 0:Z0 input */ - aVars->nx[6] = a_l; aVars->ny[6] = 0; aVars->nz[6] = -0.5*(aVars->w2c); /* 1:+X left FeSi waver */ - aVars->nx[7] = -a_l; aVars->ny[7] = 0; aVars->nz[7] = -0.5*(aVars->w2c); /* 1:+X right FeSi waver */ - - - aVars->wx[1] = +(aVars->w1c)/2; aVars->wy[1] = 0; aVars->wz[1] = 0; /* 1:+X left */ - aVars->wx[2] = -(aVars->w1c)/2; aVars->wy[2] = 0; aVars->wz[2] = 0; /* 2:-X right */ - aVars->wx[3] = 0; aVars->wy[3] = +a_h1/2; aVars->wz[3] = 0; /* 3:+Y top */ - aVars->wx[4] = 0; aVars->wy[4] = -a_h1/2; aVars->wz[4] = 0; /* 4:-Y bottom */ - aVars->wx[5] = 0; aVars->wy[5] = 0; aVars->wz[5] = a_l; /* 5:+Z exit */ - aVars->wx[0] = 0; aVars->wy[0] = 0; aVars->wz[0] = 0; /* 0:Z0 input */ - aVars->wx[6] = 0; aVars->wy[6] = 0; aVars->wz[6] = 0; /* 1:+X left FeSi waver */ - aVars->wx[7] = 0; aVars->wy[7] = 0; aVars->wz[7] = 0; /* 1:+X right FeSi waver */ - - - for (i=0; i <= 7; i++) - { - aVars->A[i] = 0; /* gravitation is not taken into account A.O.*/ - aVars->norm_n2[i] = aVars->nx[i]*aVars->nx[i] + aVars->ny[i]*aVars->ny[i] + aVars->nz[i]*aVars->nz[i]; - if (aVars->norm_n2[i] <= 0) - { fprintf(stderr,"%s: Fatal: normal vector norm %i is null/negative ! Check guide dimensions.\n", aVars->compcurname, i); exit(-1); } /* should never occur */ + if (a_mleft >= 0) + aVars->M[1] = a_mleft; + if (a_mright >= 0) + aVars->M[2] = a_mright; + if (a_mtop >= 0) + aVars->M[3] = a_mtop; + if (a_mbottom >= 0) + aVars->M[4] = a_mbottom; + if (a_mup >= 0) + aVars->M[6] = a_mup; + if (a_mdown >= 0) + aVars->M[7] = a_mdown; + + aVars->nx[1] = a_l; + aVars->ny[1] = 0; + aVars->nz[1] = -0.5 * (aVars->w2c - aVars->w1c); /* 1:+X left */ + aVars->nx[2] = -a_l; + aVars->ny[2] = 0; + aVars->nz[2] = -aVars->nz[1]; /* 2:-X right */ + aVars->nx[3] = 0; + aVars->ny[3] = a_l; + aVars->nz[3] = -0.5 * (a_h2 - a_h1); /* 3:+Y top */ + aVars->nx[4] = 0; + aVars->ny[4] = -a_l; + aVars->nz[4] = aVars->nz[3]; /* 4:-Y bottom */ + aVars->nx[5] = 0; + aVars->ny[5] = 0; + aVars->nz[5] = a_l; /* 5:+Z exit */ + aVars->nx[0] = 0; + aVars->ny[0] = 0; + aVars->nz[0] = -a_l; /* 0:Z0 input */ + aVars->nx[6] = a_l; + aVars->ny[6] = 0; + aVars->nz[6] = -0.5 * (aVars->w2c); /* 1:+X left FeSi waver */ + aVars->nx[7] = -a_l; + aVars->ny[7] = 0; + aVars->nz[7] = -0.5 * (aVars->w2c); /* 1:+X right FeSi waver */ + + aVars->wx[1] = +(aVars->w1c) / 2; + aVars->wy[1] = 0; + aVars->wz[1] = 0; /* 1:+X left */ + aVars->wx[2] = -(aVars->w1c) / 2; + aVars->wy[2] = 0; + aVars->wz[2] = 0; /* 2:-X right */ + aVars->wx[3] = 0; + aVars->wy[3] = +a_h1 / 2; + aVars->wz[3] = 0; /* 3:+Y top */ + aVars->wx[4] = 0; + aVars->wy[4] = -a_h1 / 2; + aVars->wz[4] = 0; /* 4:-Y bottom */ + aVars->wx[5] = 0; + aVars->wy[5] = 0; + aVars->wz[5] = a_l; /* 5:+Z exit */ + aVars->wx[0] = 0; + aVars->wy[0] = 0; + aVars->wz[0] = 0; /* 0:Z0 input */ + aVars->wx[6] = 0; + aVars->wy[6] = 0; + aVars->wz[6] = 0; /* 1:+X left FeSi waver */ + aVars->wx[7] = 0; + aVars->wy[7] = 0; + aVars->wz[7] = 0; /* 1:+X right FeSi waver */ + + for (i = 0; i <= 7; i++) { + aVars->A[i] = 0; /* gravitation is not taken into account A.O.*/ + aVars->norm_n2[i] = aVars->nx[i] * aVars->nx[i] + aVars->ny[i] * aVars->ny[i] + aVars->nz[i] * aVars->nz[i]; + if (aVars->norm_n2[i] <= 0) { + fprintf (stderr, "%s: Fatal: normal vector norm %i is null/negative ! Check guide dimensions.\n", aVars->compcurname, i); + exit (-1); + } /* should never occur */ else - aVars->norm_n[i] = sqrt(aVars->norm_n2[i]); + aVars->norm_n[i] = sqrt (aVars->norm_n2[i]); } - } - int Polarizer_guide_Trace(double *dt, double *dt0, - Polarizer_guide_Vars_type *aVars, - double cx, double cy, double cz, - double cvx, double cvy, double cvz) - { + int + Polarizer_guide_Trace (double* dt, double* dt0, Polarizer_guide_Vars_type* aVars, double cx, double cy, double cz, double cvx, double cvy, double cvz) { double B, C, ret; - int side=0; - double n1,n2; - + int side = 0; + double n1, n2; /* 3=+Y side: n=(0, l, -0.5*(h2-h1)) ; W = (0, +h1/2, 0) (up) */ - B = aVars->ny[3]*cvy + aVars->nz[3]*cvz; C = aVars->ny[3]*(cy-aVars->wy[3]) + aVars->nz[3]*cz; /* aVars->nx=aVars->wz=0 */ - ret = solve_2nd_order(dt0, NULL, aVars->A[3], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=3; aVars->n_dot_v[3] = B; } - + B = aVars->ny[3] * cvy + aVars->nz[3] * cvz; + C = aVars->ny[3] * (cy - aVars->wy[3]) + aVars->nz[3] * cz; /* aVars->nx=aVars->wz=0 */ + ret = solve_2nd_order (dt0, NULL, aVars->A[3], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 3; + aVars->n_dot_v[3] = B; + } /* 4=-Y side: n=(0, l, +0.5*(h2-h1)) ; W = (0, -h1/2, 0) (down) */ - B = aVars->ny[4]*cvy + aVars->nz[4]*cvz; C = aVars->ny[4]*(cy-aVars->wy[4]) + aVars->nz[4]*cz; /* aVars->nx=aVars->wz=0 */ - ret = solve_2nd_order(dt0, NULL, aVars->A[4], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=4; aVars->n_dot_v[4] = B; } - + B = aVars->ny[4] * cvy + aVars->nz[4] * cvz; + C = aVars->ny[4] * (cy - aVars->wy[4]) + aVars->nz[4] * cz; /* aVars->nx=aVars->wz=0 */ + ret = solve_2nd_order (dt0, NULL, aVars->A[4], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 4; + aVars->n_dot_v[4] = B; + } - /* 1=+X side: n=(l, 0, -0.5*(w2-w1)) ; W = (+w1/2, 0, 0) (left)*/ + /* 1=+X side: n=(l, 0, -0.5*(w2-w1)) ; W = (+w1/2, 0, 0) (left)*/ - B = aVars->nx[1]*cvx + aVars->nz[1]*cvz; C = aVars->nx[1]*(cx-aVars->wx[1]) + aVars->nz[1]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(dt0, NULL, aVars->A[1], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=1; aVars->n_dot_v[1] = B; } - + B = aVars->nx[1] * cvx + aVars->nz[1] * cvz; + C = aVars->nx[1] * (cx - aVars->wx[1]) + aVars->nz[1] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (dt0, NULL, aVars->A[1], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 1; + aVars->n_dot_v[1] = B; + } /* 2=-X side: n=(l, 0, +0.5*(w2-w1)) ; W = (-w1/2, 0, 0) (right) */ - B = aVars->nx[2]*cvx + aVars->nz[2]*cvz; C = aVars->nx[2]*(cx-aVars->wx[2]) + aVars->nz[2]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(dt0, NULL, aVars->A[2], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=2; aVars->n_dot_v[2] = B; } - - - /* 6=+X side: n=(l, 0, -0.5*w2) ; W = (0, 0, 0) (left FeSi waver) */ + B = aVars->nx[2] * cvx + aVars->nz[2] * cvz; + C = aVars->nx[2] * (cx - aVars->wx[2]) + aVars->nz[2] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (dt0, NULL, aVars->A[2], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 2; + aVars->n_dot_v[2] = B; + } - B = aVars->nx[6]*cvx + aVars->nz[6]*cvz; C = aVars->nx[6]*(cx-aVars->wx[6]) + aVars->nz[6]*cz; - ret = solve_2nd_order(dt0, NULL, aVars->A[6], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=6; aVars->n_dot_v[6] = B; } + /* 6=+X side: n=(l, 0, -0.5*w2) ; W = (0, 0, 0) (left FeSi waver) */ + B = aVars->nx[6] * cvx + aVars->nz[6] * cvz; + C = aVars->nx[6] * (cx - aVars->wx[6]) + aVars->nz[6] * cz; + ret = solve_2nd_order (dt0, NULL, aVars->A[6], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 6; + aVars->n_dot_v[6] = B; + } /* 7=-X side: n=(-l, 0, -0.5*w2) ; W = (0, 0, 0) (right FeSi waver) */ - B = aVars->nx[7]*cvx + aVars->nz[7]*cvz; C = aVars->nx[7]*(cx-aVars->wx[7]) + aVars->nz[7]*cz; /* aVars->ny=aVars->wz=0 */ - ret = solve_2nd_order(dt0, NULL, aVars->A[7], B, C); - if (ret && *dt0>10e-10 && *dt0<*dt) - { *dt = *dt0; side=7; aVars->n_dot_v[7] = B; } + B = aVars->nx[7] * cvx + aVars->nz[7] * cvz; + C = aVars->nx[7] * (cx - aVars->wx[7]) + aVars->nz[7] * cz; /* aVars->ny=aVars->wz=0 */ + ret = solve_2nd_order (dt0, NULL, aVars->A[7], B, C); + if (ret && *dt0 > 10e-10 && *dt0 < *dt) { + *dt = *dt0; + side = 7; + aVars->n_dot_v[7] = B; + } - return (side); } - %} DECLARE @@ -217,31 +264,28 @@ DECLARE double Fe_cross_a_v; double Fe_cross_tot; double lwafer_Fe; - %} INITIALIZE %{ - - if (W < 0 || R0 < 0 || Qc < 0) - { fprintf(stderr,"Polarizer_guide: %s W R0 Qc must be >0.\n", NAME_CURRENT_COMP); - exit(-1); } - - strcpy(Vars.compcurname, NAME_CURRENT_COMP); - Polarizer_guide_Init(&Vars, - w1, h1, w2, h2, l, R0, - Qc, alpha, W, - mleft, mright, mtop, mbottom, mup, mdown); - - Si_sig_i=Si_i; - Si_sig_a=Si_a; - Si_cross_i= 2.33 / 28.09 * Si_sig_i * 6.022 * 10; - Si_cross_a_v= 2.33 / 28.09 * Si_sig_a * 6.022 * 10 * 2200.0; - - Fe_sig_i=0.0001; - Fe_sig_a=0.0001; - Fe_cross_i= 7.87 / 55.85 * Fe_sig_i * 6.022 * 10; - Fe_cross_a_v= 7.87 / 55.85 * Fe_sig_a * 6.022 * 10 * 2200.0; + + if (W < 0 || R0 < 0 || Qc < 0) { + fprintf (stderr, "Polarizer_guide: %s W R0 Qc must be >0.\n", NAME_CURRENT_COMP); + exit (-1); + } + + strcpy (Vars.compcurname, NAME_CURRENT_COMP); + Polarizer_guide_Init (&Vars, w1, h1, w2, h2, l, R0, Qc, alpha, W, mleft, mright, mtop, mbottom, mup, mdown); + + Si_sig_i = Si_i; + Si_sig_a = Si_a; + Si_cross_i = 2.33 / 28.09 * Si_sig_i * 6.022 * 10; + Si_cross_a_v = 2.33 / 28.09 * Si_sig_a * 6.022 * 10 * 2200.0; + + Fe_sig_i = 0.0001; + Fe_sig_a = 0.0001; + Fe_cross_i = 7.87 / 55.85 * Fe_sig_i * 6.022 * 10; + Fe_cross_a_v = 7.87 / 55.85 * Fe_sig_a * 6.022 * 10 * 2200.0; /** (density / rel. atomic mass * sig * 6.022 * 10 * v(1.8A)) **/ %} @@ -251,40 +295,35 @@ TRACE %{ double B, C, dt0, dt; double q, arg, selectF, Rtemp; - int ret, side, side0; + int ret, side, side0; double edge; double n1, n2; - int bounces = 0; + int bounces = 0; double v, L, sinW, Wlen_Si, Wlen_Fe; - - - dt = -1; dt0 = -1; + + dt = -1; + dt0 = -1; /* propagate to box input (with gravitation) in comp local coords */ /* 0=Z0 side: n=(0, 0, 1) ; W = (0, 0, 0) (at z=0, guide input)*/ - B = -vz; C = -z; + B = -vz; + C = -z; - ret = solve_2nd_order(&dt0, NULL, Vars.A[0], B, C); - if (ret && dt0>0) - { - dt = dt0; - PROP_DT(dt); + ret = solve_2nd_order (&dt0, NULL, Vars.A[0], B, C); + if (ret && dt0 > 0) { + dt = dt0; + PROP_DT (dt); Vars.N_reflection[8]++; } /* check if we are in the box input, else absorb */ - if(dt > 0 && fabs(x) <= w1/2 && fabs(y) <= h1/2) - { + if (dt > 0 && fabs (x) <= w1 / 2 && fabs (y) <= h1 / 2) { /* neutron is now in the input window of the guide */ /* do loops on reflections in the box */ - - - - for(;;) - { + for (;;) { /* get intersections for all box sides */ /* A = 0; B = n.v; C = n.(r-W); */ - + bounces++; side = 0; @@ -292,267 +331,231 @@ TRACE /* starts with the exit side intersection (the last one !)*/ /* 5=+Z side: n=(0, 0, 1) ; W = (0, 0, l) (at z=l, guide exit)*/ - B = vz; C = z - Vars.wz[5]; - ret = solve_2nd_order(&dt0, NULL, Vars.A[5], B, C); - if (ret && dt0>0) - { dt = dt0; side=5; - Vars.n_dot_v[5] = B; } - else - { fprintf(stderr,"%s: warning: neutron trajectory is parallel to guide exit, and thus can not exit\n", Vars.compcurname); ABSORB; } - - + B = vz; + C = z - Vars.wz[5]; + ret = solve_2nd_order (&dt0, NULL, Vars.A[5], B, C); + if (ret && dt0 > 0) { + dt = dt0; + side = 5; + Vars.n_dot_v[5] = B; + } else { + fprintf (stderr, "%s: warning: neutron trajectory is parallel to guide exit, and thus can not exit\n", Vars.compcurname); + ABSORB; + } /* now look if there is a previous intersection with guide sides */ - side0 = Polarizer_guide_Trace(&dt, &dt0, &Vars, x, y, z, vx, vy, vz); - if (side0) side= side0; + side0 = Polarizer_guide_Trace (&dt, &dt0, &Vars, x, y, z, vx, vy, vz); + if (side0) + side = side0; /* only positive dt are valid */ /* exit reflection loops if no intersection (neutron is after box) */ - if (side == 0 || dt < 0) - { fprintf(stderr,"%s: warning: neutron has entered guide, but can not exit !\n", Vars.compcurname); ABSORB; } /* should never occur */ - + if (side == 0 || dt < 0) { + fprintf (stderr, "%s: warning: neutron has entered guide, but can not exit !\n", Vars.compcurname); + ABSORB; + } /* should never occur */ /* propagate to dt */ - PROP_DT(dt); - + PROP_DT (dt); /* do reflection on speed for l/r/u/d sides */ if (side == 5) /* neutron reaches end of guide: end loop and exit comp */ - { Vars.N_reflection[side]++; SCATTER; break; } + { + Vars.N_reflection[side]++; + SCATTER; + break; + } /* else reflection on a guide wall */ - if(Vars.M[side] == 0 || Qc == 0) /* walls are absorbing */ - { ABSORB; } + if (Vars.M[side] == 0 || Qc == 0) /* walls are absorbing */ + { + ABSORB; + } - - if (side == 6 || side == 7 ) - { + if (side == 6 || side == 7) { if (sy < 0) /* spin down */ - { - q = 2*V2Q*fabs(Vars.n_dot_v[side])/Vars.norm_n[side]; - v = sqrt(vx*vx + vy*vy + vz*vz); - L = (2*PI/V2K)/v; - sinW=(q*L)/(4*PI); - Wlen_Si=(waferD/sinW); - Wlen_Fe=(FeD/sinW); - Si_cross_tot=Si_cross_i + Si_cross_a_v / v; - Fe_cross_tot=Fe_cross_i + Fe_cross_a_v / v; - - - if(q < Qc_down) - { - selectF = rand01(); - - if(selectF <= R0_down) - { - Vars.N_reflection[side]++; - dt0 = 2*Vars.n_dot_v[side]/Vars.norm_n2[side]; - vx -= Vars.nx[side]*dt0; - vy -= Vars.ny[side]*dt0; - vz -= Vars.nz[side]*dt0; + { + q = 2 * V2Q * fabs (Vars.n_dot_v[side]) / Vars.norm_n[side]; + v = sqrt (vx * vx + vy * vy + vz * vz); + L = (2 * PI / V2K) / v; + sinW = (q * L) / (4 * PI); + Wlen_Si = (waferD / sinW); + Wlen_Fe = (FeD / sinW); + Si_cross_tot = Si_cross_i + Si_cross_a_v / v; + Fe_cross_tot = Fe_cross_i + Fe_cross_a_v / v; + + if (q < Qc_down) { + selectF = rand01 (); + + if (selectF <= R0_down) { + Vars.N_reflection[side]++; + dt0 = 2 * Vars.n_dot_v[side] / Vars.norm_n2[side]; + vx -= Vars.nx[side] * dt0; + vy -= Vars.ny[side] * dt0; + vz -= Vars.nz[side] * dt0; SCATTER; - } + } - if(selectF > R0_down) - { + if (selectF > R0_down) { SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - } - } /* q Qc_down) - { - arg = (q-mdown*Qc_down)/W_down; - - if(arg < 10) - { - Rtemp = R0_down*0.5*(1-tanh(arg))*(1-alpha_down*(q-Qc_down)); - selectF = rand01(); - - if(selectF <= Rtemp) - { - Vars.N_reflection[side]++; - dt0 = 2*Vars.n_dot_v[side]/Vars.norm_n2[side]; - vx -= Vars.nx[side]*dt0; - vy -= Vars.ny[side]*dt0; - vz -= Vars.nz[side]*dt0; - SCATTER; - } - - if(selectF > Rtemp) - { - SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - } - } - else - { SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - }; /* Cutoff ~ 1E-10, delete ABSORB A.O. */ + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); } - Vars.N_reflection[0]++; - } /* sy<0 */ - + } /* q Qc_down) { + arg = (q - mdown * Qc_down) / W_down; + + if (arg < 10) { + Rtemp = R0_down * 0.5 * (1 - tanh (arg)) * (1 - alpha_down * (q - Qc_down)); + selectF = rand01 (); + + if (selectF <= Rtemp) { + Vars.N_reflection[side]++; + dt0 = 2 * Vars.n_dot_v[side] / Vars.norm_n2[side]; + vx -= Vars.nx[side] * dt0; + vy -= Vars.ny[side] * dt0; + vz -= Vars.nz[side] * dt0; + SCATTER; + } + + if (selectF > Rtemp) { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + } + } else { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + }; /* Cutoff ~ 1E-10, delete ABSORB A.O. */ + } + Vars.N_reflection[0]++; + } /* sy<0 */ if (sy > 0) /* spin up */ - { - q = 2*V2Q*fabs(Vars.n_dot_v[side])/Vars.norm_n[side]; - v = sqrt(vx*vx + vy*vy + vz*vz); - L = (2*PI/V2K)/v; - sinW=(q*L)/(4*PI); - Wlen_Si=(waferD/sinW); - Wlen_Fe=(FeD/sinW); - Si_cross_tot=Si_cross_i + Si_cross_a_v / v; - Fe_cross_tot=Fe_cross_i + Fe_cross_a_v / v; - - - - if(q < Qc_up) - { - selectF = rand01(); - if (selectF <= R0_up) - { - Vars.N_reflection[side]++; - dt0 = 2*Vars.n_dot_v[side]/Vars.norm_n2[side]; - vx -= Vars.nx[side]*dt0; - vy -= Vars.ny[side]*dt0; - vz -= Vars.nz[side]*dt0; - SCATTER; - } - if(selectF > R0_up) - { - SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); + { + q = 2 * V2Q * fabs (Vars.n_dot_v[side]) / Vars.norm_n[side]; + v = sqrt (vx * vx + vy * vy + vz * vz); + L = (2 * PI / V2K) / v; + sinW = (q * L) / (4 * PI); + Wlen_Si = (waferD / sinW); + Wlen_Fe = (FeD / sinW); + Si_cross_tot = Si_cross_i + Si_cross_a_v / v; + Fe_cross_tot = Fe_cross_i + Fe_cross_a_v / v; + + if (q < Qc_up) { + selectF = rand01 (); + if (selectF <= R0_up) { + Vars.N_reflection[side]++; + dt0 = 2 * Vars.n_dot_v[side] / Vars.norm_n2[side]; + vx -= Vars.nx[side] * dt0; + vy -= Vars.ny[side] * dt0; + vz -= Vars.nz[side] * dt0; + SCATTER; } - } /* q Qc_up) - { - arg = (q-mup*Qc_up)/W_up; - - if(arg < 10) - { - Rtemp = R0_up*0.5*(1-tanh(arg))*(1-alpha_up*(q-Qc_up)); - selectF = rand01(); - - if(selectF <= Rtemp) - { - Vars.N_reflection[side]++; - dt0 = 2*Vars.n_dot_v[side]/Vars.norm_n2[side]; - vx -= Vars.nx[side]*dt0; - vy -= Vars.ny[side]*dt0; - vz -= Vars.nz[side]*dt0; - SCATTER; - } - - if(selectF > Rtemp) - { - SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - } - } - else - { SCATTER; - p=p*exp(-1.0*((Si_cross_tot*Wlen_Si)+(Fe_cross_tot*Wlen_Fe))); - }; /* Cutoff ~ 1E-10, delete ABSORB A.O. */ + if (selectF > R0_up) { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); } - Vars.N_reflection[0]++; - } /* sy>0 */ + } /* q Qc_up) { + arg = (q - mup * Qc_up) / W_up; + + if (arg < 10) { + Rtemp = R0_up * 0.5 * (1 - tanh (arg)) * (1 - alpha_up * (q - Qc_up)); + selectF = rand01 (); + + if (selectF <= Rtemp) { + Vars.N_reflection[side]++; + dt0 = 2 * Vars.n_dot_v[side] / Vars.norm_n2[side]; + vx -= Vars.nx[side] * dt0; + vy -= Vars.ny[side] * dt0; + vz -= Vars.nz[side] * dt0; + SCATTER; + } + + if (selectF > Rtemp) { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + } + } else { + SCATTER; + p = p * exp (-1.0 * ((Si_cross_tot * Wlen_Si) + (Fe_cross_tot * Wlen_Fe))); + }; /* Cutoff ~ 1E-10, delete ABSORB A.O. */ + } + Vars.N_reflection[0]++; + } /* sy>0 */ - } /* side 6,7 */ + } /* side 6,7 */ - else - { + else { /*************************************************************************************************/ - /* change/mirror velocity: v_f = v - n.2*n.v/|n|^2 */ + /* change/mirror velocity: v_f = v - n.2*n.v/|n|^2 */ - Vars.N_reflection[side]++; /* Vars.norm_n2 > 0 was checked at INIT */ - dt0 = 2*Vars.n_dot_v[side]/Vars.norm_n2[side]; /* 2*n.v/|n|^2 */ - vx -= Vars.nx[side]*dt0; - vy -= Vars.ny[side]*dt0; - vz -= Vars.nz[side]*dt0; + Vars.N_reflection[side]++; /* Vars.norm_n2 > 0 was checked at INIT */ + dt0 = 2 * Vars.n_dot_v[side] / Vars.norm_n2[side]; /* 2*n.v/|n|^2 */ + vx -= Vars.nx[side] * dt0; + vy -= Vars.ny[side] * dt0; + vz -= Vars.nz[side] * dt0; /* compute q and modify neutron weight */ /* scattering q=|k_i-k_f| = V2Q*|vf - v| = V2Q*2*n.v/|n| */ - q = 2*V2Q*fabs(Vars.n_dot_v[side])/Vars.norm_n[side]; + q = 2 * V2Q * fabs (Vars.n_dot_v[side]) / Vars.norm_n[side]; B = R0; - if(q > Qc) - { - if (W>0) - arg = (q-Vars.M[side]*Qc)/W; + if (q > Qc) { + if (W > 0) + arg = (q - Vars.M[side] * Qc) / W; else - arg = (q-Vars.M[side]*Qc)*10000; /* W = 0.00001 */ - - if(arg < 10) - { - B *= .5*(1-tanh(arg))*(1-alpha*(q-Qc)); - } - else - { ABSORB; }; /* Cutoff ~ 1E-10 */ - } - if (B < 0) B=0; - if (B > 1) B=1; - p *= B; - SCATTER; - - Vars.N_reflection[0]++; + arg = (q - Vars.M[side] * Qc) * 10000; /* W = 0.00001 */ + + if (arg < 10) { + B *= .5 * (1 - tanh (arg)) * (1 - alpha * (q - Qc)); + } else { + ABSORB; + }; /* Cutoff ~ 1E-10 */ + } + if (B < 0) + B = 0; + if (B > 1) + B = 1; + p *= B; + SCATTER; + + Vars.N_reflection[0]++; /*************************************************************************************************/ - } - - - /* go to the next reflection */ - if (bounces > 1000) ABSORB; - } /* end for */ - } - else - ABSORB; + } + + /* go to the next reflection */ + if (bounces > 1000) + ABSORB; + } /* end for */ + } else + ABSORB; %} MCDISPLAY %{ - double x; + double x; int i; - - multiline(5, - -w1/2.0, -h1/2.0, 0.0, - w1/2.0, -h1/2.0, 0.0, - w1/2.0, h1/2.0, 0.0, - -w1/2.0, h1/2.0, 0.0, - -w1/2.0, -h1/2.0, 0.0); - multiline(5, - -w2/2.0, -h2/2.0, (double)l, - w2/2.0, -h2/2.0, (double)l, - w2/2.0, h2/2.0, (double)l, - -w2/2.0, h2/2.0, (double)l, - -w2/2.0, -h2/2.0, (double)l); - multiline(5, - 0.0, -h1/2.0, 0.0, - 0.0, h1/2.0, 0.0, - -w2/2.0, h1/2.0, (double)l, - -w2/2.0, -h1/2.0, (double)l, - 0.0, -h1/2.0, 0.0); - multiline(5, - 0.0, -h1/2.0, 0.0, - 0.0, h1/2.0, 0.0, - w2/2.0, h1/2.0, (double)l, - w2/2.0, -h1/2.0, (double)l, - 0.0, -h1/2.0, 0.0); - line(-w1/2.0, -h1/2.0, 0, -w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, -h1/2.0, 0, w2/2.0, -h2/2.0, (double)l); - line( w1/2.0, h1/2.0, 0, w2/2.0, h2/2.0, (double)l); - line(-w1/2.0, h1/2.0, 0, -w2/2.0, h2/2.0, (double)l); + multiline (5, -w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, -h1 / 2.0, 0.0, w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, h1 / 2.0, 0.0, -w1 / 2.0, -h1 / 2.0, 0.0); + multiline (5, -w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, -h2 / 2.0, (double)l, w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, h2 / 2.0, (double)l, -w2 / 2.0, + -h2 / 2.0, (double)l); + multiline (5, 0.0, -h1 / 2.0, 0.0, 0.0, h1 / 2.0, 0.0, -w2 / 2.0, h1 / 2.0, (double)l, -w2 / 2.0, -h1 / 2.0, (double)l, 0.0, -h1 / 2.0, 0.0); + multiline (5, 0.0, -h1 / 2.0, 0.0, 0.0, h1 / 2.0, 0.0, w2 / 2.0, h1 / 2.0, (double)l, w2 / 2.0, -h1 / 2.0, (double)l, 0.0, -h1 / 2.0, 0.0); + line (-w1 / 2.0, -h1 / 2.0, 0, -w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, -h1 / 2.0, 0, w2 / 2.0, -h2 / 2.0, (double)l); + line (w1 / 2.0, h1 / 2.0, 0, w2 / 2.0, h2 / 2.0, (double)l); + line (-w1 / 2.0, h1 / 2.0, 0, -w2 / 2.0, h2 / 2.0, (double)l); %} END diff --git a/mcstas-comps/contrib/Vertical_Bender.comp b/mcstas-comps/contrib/Vertical_Bender.comp index 9755c4b39..6360fe3d8 100644 --- a/mcstas-comps/contrib/Vertical_Bender.comp +++ b/mcstas-comps/contrib/Vertical_Bender.comp @@ -101,7 +101,6 @@ SHARE %{ %include "ref-lib" - /****************************************************************************** * horiz_tube_intersect: compute intersection with a horizontal tube, allowing for gravity * i.e. one with length along x axis @@ -116,7 +115,7 @@ SHARE * Here Rtop > Rbottom, regardless of which way up the bend is. * idown = 1 for a downhill bender, where radius is negative, idown =0 for uphill bender, with radius positive * Find a crossing using tstep1, then go back to start of that step and check with smaller steps, tstep2. - * NOTE we need the first of possibly two wall crossings that may be very close together, so have to go + * NOTE we need the first of possibly two wall crossings that may be very close together, so have to go * to start of previous step, then forwards again with smaller steps (i.e. cannot do a classic Newton-Raphson search here). * If tstep1 is too large we may miss one or even two collisions with a wall. * 8/8/17 makes sure that t11 cannot return zero, else can get stuck in infinite loop, so aim for mid point of the crossing step @@ -128,49 +127,53 @@ SHARE * * *******************************************************************************/ - - // RKH need a c++ expert to check which variables should be passed by reference (or not) etc for greater efficiancy - // the original code passed *t11 - int - horiz_tube_intersect(double *t11, double tStep1, double tStep2, double tMax, double y, double z, - double vy, double vz, double Rtop, double Rbottom, double Gy, double Gz, int idown, int debug ) - { + + // RKH need a c++ expert to check which variables should be passed by reference (or not) etc for greater efficiancy + // the original code passed *t11 + int + horiz_tube_intersect (double* t11, double tStep1, double tStep2, double tMax, double y, double z, double vy, double vz, double Rtop, double Rbottom, double Gy, + double Gz, int idown, int debug) { double t, t2, Rtop2, Rbottom2, znew, ynew, Rneutron2; - if(debug>5)printf("hti Gy: %f,tStep1: %f,tStep2: %f,tMax: %f,y: %f, z: %f,vy: %f,vz: %f\n",Gy,tStep1,tStep2,tMax,y,z,vy,vz); + if (debug > 5) + printf ("hti Gy: %f,tStep1: %f,tStep2: %f,tMax: %f,y: %f, z: %f,vy: %f,vz: %f\n", Gy, tStep1, tStep2, tMax, y, z, vy, vz); *t11 = 0.0; t = 0.0; Rtop2 = Rtop * Rtop; Rbottom2 = Rbottom * Rbottom; - do{ - t += tStep1; - t2 = 0.5*t*t; - znew = z + vz*t +Gz*t2; - ynew = y + vy*t +Gy*t2; - Rneutron2 = znew*znew + ynew*ynew; - if(debug>9)printf("t1: %f, z: %f, y: %f, r: %f\n",t, znew, ynew, sqrt(Rneutron2)); - - if ((Rneutron2 > Rtop2) || (Rneutron2 < Rbottom2)) { - t-=tStep1; + do { + t += tStep1; + t2 = 0.5 * t * t; + znew = z + vz * t + Gz * t2; + ynew = y + vy * t + Gy * t2; + Rneutron2 = znew * znew + ynew * ynew; + if (debug > 9) + printf ("t1: %f, z: %f, y: %f, r: %f\n", t, znew, ynew, sqrt (Rneutron2)); + + if ((Rneutron2 > Rtop2) || (Rneutron2 < Rbottom2)) { + t -= tStep1; do { t += tStep2; - t2 = 0.5*t*t; - znew = z + vz*t + Gz*t2; - ynew = y + vy*t + Gy*t2; - Rneutron2 = znew*znew + ynew*ynew; - if(debug>9)printf("t2: %f, z: %f, y: %f, r: %f\n",t, znew, ynew, sqrt(Rneutron2)); - if (Rneutron2 > Rtop2){ - *t11 = t - tStep2*0.5; // 8/8/17 subtract only half the step here, so t11 is never zero - return idown + 1; } // 2 for downhill, hit top; 1 for uphill hit bottom - else if (Rneutron2 < Rbottom2) { - *t11 = t - tStep2*0.5; // 8/8/17 subtract only half the step here, so t11 is never zero - return 2 - idown; } // 1 for downhill, hit bottom; 2 for uphill hit top - } while (t < tMax); // tMax limit is excessive here, but will guarantee success - } // end of IF + t2 = 0.5 * t * t; + znew = z + vz * t + Gz * t2; + ynew = y + vy * t + Gy * t2; + Rneutron2 = znew * znew + ynew * ynew; + if (debug > 9) + printf ("t2: %f, z: %f, y: %f, r: %f\n", t, znew, ynew, sqrt (Rneutron2)); + if (Rneutron2 > Rtop2) { + *t11 = t - tStep2 * 0.5; // 8/8/17 subtract only half the step here, so t11 is never zero + return idown + 1; + } // 2 for downhill, hit top; 1 for uphill hit bottom + else if (Rneutron2 < Rbottom2) { + *t11 = t - tStep2 * 0.5; // 8/8/17 subtract only half the step here, so t11 is never zero + return 2 - idown; + } // 1 for downhill, hit bottom; 2 for uphill hit top + } while (t < tMax); // tMax limit is excessive here, but will guarantee success + } // end of IF } while (t < tMax); - - return 0; // escape without collision - /* horiz_tube_intersect */ - } + + return 0; // escape without collision + /* horiz_tube_intersect */ + } %} DECLARE @@ -182,7 +185,7 @@ DECLARE Coords pointLeft; Coords pointRight; Coords pointIn; - Coords pointOut; + Coords pointOut; %} INITIALIZE%{ @@ -244,338 +247,341 @@ INITIALIZE%{ TRACE %{ - // RKH there is no "stuck in infinite loop" checking here ... - // RKH not used const double whalf = 0.5*xwidth; /* half width of guide */ + // RKH there is no "stuck in infinite loop" checking here ... + // RKH not used const double whalf = 0.5*xwidth; /* half width of guide */ double Gx, Gy, Gz; - const double hhalf = 0.5*yheight; /* half height of guide */ -// RKH, not used const double z_off = radius*sin(length/radius); /* z-comp of guide length */ - const double dThreshold = 1e-10; /* distance threshold */ - const double tThreshold = dThreshold/sqrt(vx*vx + vy*vy + vz*vz); + const double hhalf = 0.5 * yheight; /* half height of guide */ + // RKH, not used const double z_off = radius*sin(length/radius); /* z-comp of guide length */ + const double dThreshold = 1e-10; /* distance threshold */ + const double tThreshold = dThreshold / sqrt (vx * vx + vy * vy + vz * vz); double angle_z_vout; /* angle between z-axis and v_out */ - //Variables for multiple slits - const double channelWidth = yheight/nchan; // slitWidth - const double bladeHalf = 0.5*d; /* half width of spacers */ - int channelHit; // decide which channel is hit - double posInChannel; // position in channel + // Variables for multiple slits + const double channelWidth = yheight / nchan; // slitWidth + const double bladeHalf = 0.5 * d; /* half width of spacers */ + int channelHit; // decide which channel is hit + double posInChannel; // position in channel double t11, theta, alpha, endtime, phi; double weight; - double Rtop; /* larger radius of channel */ + double Rtop; /* larger radius of channel */ double Rbottom; /* smaller radius of channel */ - double absR = fabs(radius); + double absR = fabs (radius); int i_bounce = 0; if (mcgravitation) { - coords_get(localG, &Gx, &Gy, &Gz); - } - else - Gy = Gz =0; + coords_get (localG, &Gx, &Gy, &Gz); + } else + Gy = Gz = 0; -// are we tracking the neutron inside the cylindrical cross section or not + // are we tracking the neutron inside the cylindrical cross section or not int itrack = 0; - if (Gy != 0 || Gz != 0 ) itrack = 1; - if (alwaystrack == 1 ) itrack = 1; + if (Gy != 0 || Gz != 0) + itrack = 1; + if (alwaystrack == 1) + itrack = 1; int idown = 0; - if (radius<0) + if (radius < 0) idown = 1; /* Propagate neutron to entrance */ PROP_Z0; - if (!inside_rectangle(x, y, xwidth, yheight)) + if (!inside_rectangle (x, y, xwidth, yheight)) ABSORB; - if (nchan>1){ + if (nchan > 1) { // check if neutron gets absorbed in spacers - posInChannel = fmod(y+hhalf, channelWidth); - if(posInChannel <= bladeHalf || - posInChannel >= channelWidth-bladeHalf) + posInChannel = fmod (y + hhalf, channelWidth); + if (posInChannel <= bladeHalf || posInChannel >= channelWidth - bladeHalf) ABSORB; // determine which channel neutron enters, (don't really need channelHit, but its nice to know it, there may be a more elegant way here still) - if (idown == 1) - channelHit = (int)((y+hhalf)/channelWidth); // downhill, channels 0,1,2,3 from bottom to top + if (idown == 1) + channelHit = (int)((y + hhalf) / channelWidth); // downhill, channels 0,1,2,3 from bottom to top else - channelHit = (int)((hhalf-y)/channelWidth); // uphill, channels 0,1,2,3 from top to bottom + channelHit = (int)((hhalf - y) / channelWidth); // uphill, channels 0,1,2,3 from top to bottom // Modify radii according to the channel entered, Rtop is always the larger here (could have renamed it) - Rtop = absR - hhalf +(channelHit+1)*channelWidth - bladeHalf; - Rbottom = absR - hhalf + channelHit*channelWidth + bladeHalf; + Rtop = absR - hhalf + (channelHit + 1) * channelWidth - bladeHalf; + Rbottom = absR - hhalf + channelHit * channelWidth + bladeHalf; - if(debug > 0) - printf("\nchannelHit: %d/%f, idown:%i, Rtop: %f, Rbottom: %f\n", - channelHit, (y+hhalf)/channelWidth, idown, Rtop, Rbottom); - } else { // only 1 slit + if (debug > 0) + printf ("\nchannelHit: %d/%f, idown:%i, Rtop: %f, Rbottom: %f\n", channelHit, (y + hhalf) / channelWidth, idown, Rtop, Rbottom); + } else { // only 1 slit - Rtop = absR + hhalf; - Rbottom = absR - hhalf; + Rtop = absR + hhalf; + Rbottom = absR - hhalf; + } - } - - int counter=0; - for(;;) { + int counter = 0; + for (;;) { counter++; double tLeft, tRight, tTop, tBot, tIn, tOut, tMirror; double tUp, tSide, time, endtime; double R, Q; Coords vVec, xVec; double vel_yz; - int ibend, ibendnew; // 1 bottom, 2 top, 3 left, 4 right, 5 exit, 6 entrance, 0 no collision + int ibend, ibendnew; // 1 bottom, 2 top, 3 left, 4 right, 5 exit, 6 entrance, 0 no collision double tStep1, tStep2, tMax; // long & short time step (calc from diststep1 & diststep2); longest time to track until in top/bottom of bender channel - tMax=0; + tMax = 0; - xVec = coords_set(x, y, z); - vVec = coords_set(vx, vy, vz); - - // RKH has simplified the logic of the original here, to use ibend integer to keep up with the fate of the neutron, + xVec = coords_set (x, y, z); + vVec = coords_set (vx, vy, vz); + + // RKH has simplified the logic of the original here, to use ibend integer to keep up with the fate of the neutron, // and to avoid repeatedly comparing double precision time values ibend = 0; - //solve for transport to flat sides of bender, - // could assume we can only hit either right or left depending on vx <0 or >0, but not both, however a VERY slow neutron in a narrow channel - // could hit both sides in a horizontal bender, so check both separately, note these have gravity. - // solve_2nd_order is in mccode-r.c, with 2nd param NULL it finds the smallest positve solution to A.t^2 + B.t + C = 0 - solve_2nd_order(&tLeft, NULL, 0.5*coords_sp(normSides,localG), - coords_sp(normSides, vVec), - coords_sp(normSides, coords_sub(xVec, pointLeft))); - if(tLeft>tThreshold){ tMax = tLeft; - ibend = 3;} - - solve_2nd_order(&tRight, NULL, 0.5*coords_sp(normSides,localG), - coords_sp(normSides, vVec), - coords_sp(normSides, coords_sub(xVec, pointRight)) ); - if ( (tRight > tThreshold) && ( (tRight < tMax) || ibend == 0)) {tMax = tRight; - ibend =4; } - - // solve transport for entrance & exit planes of bender - solve_2nd_order(&tIn, NULL, 0.5*coords_sp(normIn,localG), - coords_sp(normIn, vVec), - coords_sp(normIn, coords_sub(xVec, pointIn))); - if( (tIn>tThreshold ) && (tIn < tMax || ibend ==0)){ tMax = tIn; - ibend = 6;} - - solve_2nd_order(&tOut, NULL, 0.5*coords_sp(normOut,localG), - coords_sp(normOut, vVec), - coords_sp(normOut, coords_sub(xVec, pointOut))); - if( (tOut>tThreshold) && (tOut < tMax || ibend ==0)){ tMax = tOut; - ibend = 5;} - - tStep1 = diststep1/coords_len(vVec); // could just use vz, but would come unstuck if vz=0, so play safe here - tStep2 = tStep1*diststep2/diststep1; - + // solve for transport to flat sides of bender, + // could assume we can only hit either right or left depending on vx <0 or >0, but not both, however a VERY slow neutron in a narrow channel + // could hit both sides in a horizontal bender, so check both separately, note these have gravity. + // solve_2nd_order is in mccode-r.c, with 2nd param NULL it finds the smallest positve solution to A.t^2 + B.t + C = 0 + solve_2nd_order (&tLeft, NULL, 0.5 * coords_sp (normSides, localG), coords_sp (normSides, vVec), coords_sp (normSides, coords_sub (xVec, pointLeft))); + if (tLeft > tThreshold) { + tMax = tLeft; + ibend = 3; + } + + solve_2nd_order (&tRight, NULL, 0.5 * coords_sp (normSides, localG), coords_sp (normSides, vVec), coords_sp (normSides, coords_sub (xVec, pointRight))); + if ((tRight > tThreshold) && ((tRight < tMax) || ibend == 0)) { + tMax = tRight; + ibend = 4; + } + + // solve transport for entrance & exit planes of bender + solve_2nd_order (&tIn, NULL, 0.5 * coords_sp (normIn, localG), coords_sp (normIn, vVec), coords_sp (normIn, coords_sub (xVec, pointIn))); + if ((tIn > tThreshold) && (tIn < tMax || ibend == 0)) { + tMax = tIn; + ibend = 6; + } + + solve_2nd_order (&tOut, NULL, 0.5 * coords_sp (normOut, localG), coords_sp (normOut, vVec), coords_sp (normOut, coords_sub (xVec, pointOut))); + if ((tOut > tThreshold) && (tOut < tMax || ibend == 0)) { + tMax = tOut; + ibend = 5; + } + + tStep1 = diststep1 / coords_len (vVec); // could just use vz, but would come unstuck if vz=0, so play safe here + tStep2 = tStep1 * diststep2 / diststep1; + /* Find intersection points with top and bottom (curved) guide walls */ - if(debug>4)printf("get1 Gy: %f,tStep1: %f,tStep2: %f,tMax: %f\n",Gy,tStep1,tStep2,tMax); + if (debug > 4) + printf ("get1 Gy: %f,tStep1: %f,tStep2: %f,tMax: %f\n", Gy, tStep1, tStep2, tMax); // adjust y so centre of bender arcs are at origin double yshift = y - radius; - + // either track in steps - // RKH 08/08/17 oops, issue here, getting stuck when returning t11 = 0 - if ( itrack == 1){ - ibendnew = horiz_tube_intersect(&t11, tStep1, tStep2, tMax, yshift, z, vy, vz, - Rtop, Rbottom, Gy, Gz, idown, debug); - - if(debug > 3) - printf("ibend: %i, ibendnew: %i, tLeft: %f,tRight: %f,tIn: %f,tOut: %f,t11: %f\n", - ibend,ibendnew,tLeft,tRight,tIn,tOut,t11); - - if (ibendnew != 0 ) { ibend = ibendnew; - tMax = t11;} // by definition here, t11 <= tMax - } - else{ - // or if no gravity, solve straight line intersecting circles - double AA = (vy*vy + vz*vz); - double BB = 2.0*( z*vz + yshift*vy); - double CC = z*z + yshift*yshift; - solve_2nd_order(&t11, NULL, AA, BB, (CC - Rtop*Rtop)); - if( (t11>tThreshold) && (t11 < tMax || ibend ==0)){ tMax = t11; - ibend = idown + 1;} - - solve_2nd_order(&t11, NULL, AA, BB, (CC - Rbottom*Rbottom)); - if( (t11>tThreshold) && (t11 < tMax || ibend ==0)){ tMax = t11; - ibend = 2 - idown;} + // RKH 08/08/17 oops, issue here, getting stuck when returning t11 = 0 + if (itrack == 1) { + ibendnew = horiz_tube_intersect (&t11, tStep1, tStep2, tMax, yshift, z, vy, vz, Rtop, Rbottom, Gy, Gz, idown, debug); + + if (debug > 3) + printf ("ibend: %i, ibendnew: %i, tLeft: %f,tRight: %f,tIn: %f,tOut: %f,t11: %f\n", ibend, ibendnew, tLeft, tRight, tIn, tOut, t11); + + if (ibendnew != 0) { + ibend = ibendnew; + tMax = t11; + } // by definition here, t11 <= tMax + } else { + // or if no gravity, solve straight line intersecting circles + double AA = (vy * vy + vz * vz); + double BB = 2.0 * (z * vz + yshift * vy); + double CC = z * z + yshift * yshift; + solve_2nd_order (&t11, NULL, AA, BB, (CC - Rtop * Rtop)); + if ((t11 > tThreshold) && (t11 < tMax || ibend == 0)) { + tMax = t11; + ibend = idown + 1; + } + + solve_2nd_order (&t11, NULL, AA, BB, (CC - Rbottom * Rbottom)); + if ((t11 > tThreshold) && (t11 < tMax || ibend == 0)) { + tMax = t11; + ibend = 2 - idown; + } } - if(debug > 3) - printf("Rtop: %f, Rbottom: %f, yshift: %f, z: %f, vy: %f, vz: %f t11: %f, Gy: %f, Gz: %f\n", - Rtop, Rbottom, y-radius, z, vy, vz, t11, Gy, Gz); + if (debug > 3) + printf ("Rtop: %f, Rbottom: %f, yshift: %f, z: %f, vy: %f, vz: %f t11: %f, Gy: %f, Gz: %f\n", Rtop, Rbottom, y - radius, z, vy, vz, t11, Gy, Gz); // RKH at this point ibend should not be zero ! - but it often is.... Also why won't ABSORB work here? - if (ibend == 0){ - printf("ERROR? ibend: %i, ibendnew: %i, tLeft: %f,tRight: %f,tIn: %f,tOut: %f,t11: %f\n", - ibend,ibendnew,tLeft,tRight,tIn,tOut,t11); + if (ibend == 0) { + printf ("ERROR? ibend: %i, ibendnew: %i, tLeft: %f,tRight: %f,tIn: %f,tOut: %f,t11: %f\n", ibend, ibendnew, tLeft, tRight, tIn, tOut, t11); break; - } - + } + // Has the neutron left the guide? Note we pass put the number pf bounces. // RKH - presume that somewhere else the neutron is propagated into next component?? - if (ibend > 4 ) break; + if (ibend > 4) + break; if (mcgravitation) { -// coords_get(localG, &Gx, &Gy, &Gz); // RKH works fine with this commented out - if(debug>4)printf("get2 Gxyz: %f,%f,%f\n",Gx,Gy,Gz); - PROP_GRAV_DT(tMax,Gx,Gy,Gz); // this is in PSI_DMC.c, updates mcnlx, mcnvx etc. - } - else - PROP_DT(tMax); // this actually checks for gravity, but repeats component gravity vector rotation - -// RKH depending how well we found the intersection, the neutron may not be exactly at the top or bottom wall. -// The reflection angle is being calculated for the wall using new z value. + // coords_get(localG, &Gx, &Gy, &Gz); // RKH works fine with this commented out + if (debug > 4) + printf ("get2 Gxyz: %f,%f,%f\n", Gx, Gy, Gz); + PROP_GRAV_DT (tMax, Gx, Gy, Gz); // this is in PSI_DMC.c, updates mcnlx, mcnvx etc. + } else + PROP_DT (tMax); // this actually checks for gravity, but repeats component gravity vector rotation + + // RKH depending how well we found the intersection, the neutron may not be exactly at the top or bottom wall. + // The reflection angle is being calculated for the wall using new z value. SCATTER; i_bounce += 1; /* Find reflection surface */ - if(ibend == 1 || ibend ==2) { /* bottom or top surface */ - if(ibend == 2){ - if(idown == 1) + if (ibend == 1 || ibend == 2) { /* bottom or top surface */ + if (ibend == 2) { + if (idown == 1) R = -Rtop; - else - R = Rbottom;} - else - {if(idown == 1) + else + R = Rbottom; + } else { + if (idown == 1) R = -Rbottom; - else - R = Rtop;} + else + R = Rtop; + } - phi = atan(vy/vz); /* angle of neutron trajectory */ - alpha = asin(z/R); /* angle of guide wall */ - theta = fabs(phi-alpha); /* angle of reflection */ - angle_z_vout = 2.0*alpha - phi; + phi = atan (vy / vz); /* angle of neutron trajectory */ + alpha = asin (z / R); /* angle of guide wall */ + theta = fabs (phi - alpha); /* angle of reflection */ + angle_z_vout = 2.0 * alpha - phi; - vel_yz = sqrt(vy*vy + vz*vz); /* in plane velocity */ - vz = vel_yz*cos(angle_z_vout); - vy = vel_yz*sin(angle_z_vout); + vel_yz = sqrt (vy * vy + vz * vz); /* in plane velocity */ + vz = vel_yz * cos (angle_z_vout); + vy = vel_yz * sin (angle_z_vout); } else { /* left or right walls */ - theta = fabs(atan(vx/vz)); + theta = fabs (atan (vx / vz)); vx = -vx; } /* Let's compute reflectivity! */ - Q = 2.0*sin(theta)*sqrt(vx*vx + vy*vy + vz*vz)*V2K; + Q = 2.0 * sin (theta) * sqrt (vx * vx + vy * vy + vz * vz) * V2K; /* and the probability ... */ if (ibend == 2) { - StdReflecFunc(Q, rTopPar, &weight); - if (debug > 0) fprintf(stdout, "\tTop hit:\n"); + StdReflecFunc (Q, rTopPar, &weight); + if (debug > 0) + fprintf (stdout, "\tTop hit:\n"); } else if (ibend == 1) { - StdReflecFunc(Q, rBottomPar, &weight); - if (debug > 0) fprintf(stdout, "\tBottom hit:\n"); + StdReflecFunc (Q, rBottomPar, &weight); + if (debug > 0) + fprintf (stdout, "\tBottom hit:\n"); } else if (ibend == 4) { - StdReflecFunc(Q, rSidesPar, &weight); - if (debug > 0) fprintf(stdout, "\tRight hit:\n"); + StdReflecFunc (Q, rSidesPar, &weight); + if (debug > 0) + fprintf (stdout, "\tRight hit:\n"); } else if (ibend == 3) { - StdReflecFunc(Q, rSidesPar, &weight); - if (debug > 0) fprintf(stdout, "\tLeft hit:\n"); + StdReflecFunc (Q, rSidesPar, &weight); + if (debug > 0) + fprintf (stdout, "\tLeft hit:\n"); } /* Check that weight is meaningful. If not force it.*/ - if (weight <= 0) ABSORB; - if (weight > 1) weight = 1; + if (weight <= 0) + ABSORB; + if (weight > 1) + weight = 1; /* Twiddle the neutron weight */ p *= weight; - if(p == 0) { + if (p == 0) { // Neutron is dead. Kill it! ABSORB; break; } - if (counter>recurse_max) { + if (counter > recurse_max) { // Neutron is dead. Kill it! ABSORB; break; } - } - %} MCDISPLAY %{ double y1, y2, z1, z2; - y1=y2=z1=z2=0; + y1 = y2 = z1 = z2 = 0; const int n = 90; double yplot[90], zplot[90]; int ns = 0; int j = 1; - const double lengthOfGuide = sin(length/radius)*radius; - const double channelWidth = yheight/nchan; + const double lengthOfGuide = sin (length / radius) * radius; + const double channelWidth = yheight / nchan; double R = 0; /* radius of arc */ int nChansMax = nchan; - int nMax = n; + int nMax = n; - if (lengthOfGuide<=0) - exit(fprintf(stdout,"Vertical_bender: %s: Negative guide length ! lengthOfGuide=%g\n", - NAME_CURRENT_COMP, lengthOfGuide)); + if (lengthOfGuide <= 0) + exit (fprintf (stdout, "Vertical_bender: %s: Negative guide length ! lengthOfGuide=%g\n", NAME_CURRENT_COMP, lengthOfGuide)); - if (drawOption==2) { + if (drawOption == 2) { - if(nChansMax>20) + if (nChansMax > 20) nChansMax = 20; nMax = 40; - } else if (drawOption==3) { + } else if (drawOption == 3) { - if(nChansMax>5) + if (nChansMax > 5) nChansMax = 5; nMax = 10; } - magnify("xy"); + magnify ("xy"); // draw opening - rectangle("xy", 0, 0, 0, xwidth, yheight); + rectangle ("xy", 0, 0, 0, xwidth, yheight); - for(ns=0; ns < nChansMax+1; ns++) { + for (ns = 0; ns < nChansMax + 1; ns++) { // to make sure the sides are drawn properly - if(ns==nChansMax && nChansMax0) - yplot[j] = radius - sqrt(R*R - zplot[j]*zplot[j]); + if (radius > 0) + yplot[j] = radius - sqrt (R * R - zplot[j] * zplot[j]); else - yplot[j] = radius + sqrt(R*R - zplot[j]*zplot[j]); + yplot[j] = radius + sqrt (R * R - zplot[j] * zplot[j]); } // To be able to draw end we store some of the point values - if(ns==0) { // first wall + if (ns == 0) { // first wall - y1 = yplot[nMax-1]; - z1 = zplot[nMax-1]; - } else if(ns==nchan) { //last wall + y1 = yplot[nMax - 1]; + z1 = zplot[nMax - 1]; + } else if (ns == nchan) { // last wall - y2 = yplot[nMax-1]; - z2 = zplot[nMax-1]; + y2 = yplot[nMax - 1]; + z2 = zplot[nMax - 1]; } - for(j=0; j0.0){ - return acos(x); - } - return 2.0*PI-acos(x); + #ifndef FERMI_CHOP_DEFS + #define FERMI_CHOP_DEFS + /* routine to calculate acos in proper quadrant range = 0 to 2PI*/ + #pragma acc routine + double + acos0_2pi (double x, double y) { + if (y > 0.0) { + return acos (x); } + return 2.0 * PI - acos (x); + } - /*routine to calculate x and y positions of a neutron in a fermi chopper */ - #pragma acc routine - void neutxypos(double *x, double *y, double phi, double inrad, double* c) - { - *x=c[0]+inrad*cos(phi); - *y=c[1]+inrad*sin(phi); - } + /*routine to calculate x and y positions of a neutron in a fermi chopper */ + #pragma acc routine + void + neutxypos (double* x, double* y, double phi, double inrad, double* c) { + *x = c[0] + inrad * cos (phi); + *y = c[1] + inrad * sin (phi); + } - /* routine to calculate the origin of a circle that describes the neutron path through the chopper */ - #pragma acc routine - void calccenter(double* c, double* zr, double* xr){ - double denom, A,B,C,D,a,b; - denom=2*(-zr[0]*xr[2] +zr[0]*xr[1]+ zr[1]*xr[2]+xr[0]*zr[2]-xr[0]*zr[1] - xr[1]*zr[2]); - A=xr[1]-xr[2];B=xr[0]-xr[1];C=zr[2]-zr[1];D=zr[1]-zr[0]; - a=zr[0]*zr[0]-zr[1]*zr[1]+xr[0]*xr[0]-xr[1]*xr[1]; - b=zr[2]*zr[2]-zr[1]*zr[1]+xr[2]*xr[2]-xr[1]*xr[1]; - c[0]=1.0/denom*(A*a+B*b); - c[1]=1.0/denom*(C*a+D*b); - } + /* routine to calculate the origin of a circle that describes the neutron path through the chopper */ + #pragma acc routine + void + calccenter (double* c, double* zr, double* xr) { + double denom, A, B, C, D, a, b; + denom = 2 * (-zr[0] * xr[2] + zr[0] * xr[1] + zr[1] * xr[2] + xr[0] * zr[2] - xr[0] * zr[1] - xr[1] * zr[2]); + A = xr[1] - xr[2]; + B = xr[0] - xr[1]; + C = zr[2] - zr[1]; + D = zr[1] - zr[0]; + a = zr[0] * zr[0] - zr[1] * zr[1] + xr[0] * xr[0] - xr[1] * xr[1]; + b = zr[2] * zr[2] - zr[1] * zr[1] + xr[2] * xr[2] - xr[1] * xr[1]; + c[0] = 1.0 / denom * (A * a + B * b); + c[1] = 1.0 / denom * (C * a + D * b); + } -#endif -/* function to calculate if the neutron is in the channel or not - * return 0 if neutron does not transmit return 1 if neutron will pass*/ - int t0checkabsorb(double phi, double inrad,double inw1, double inw2, double* c){ - double xtmp,neuzr,neuxr; - neutxypos(&neuzr,&neuxr,phi,inrad,c); - // printf("xr:%g zr:%g phi: %g r: %g c[0]: %g c[1]: %g\n",neuxr,neuzr,phi,inrad,c[0],c[1]); - if (fabs(neuxr)>inw1/2.0+(inw2-inw1)/(inrad/2.0)*fabs(neuzr)) // check if neutron x position is outside of channel - return 0; - return 1; - } + #endif + /* function to calculate if the neutron is in the channel or not + * return 0 if neutron does not transmit return 1 if neutron will pass*/ + int + t0checkabsorb (double phi, double inrad, double inw1, double inw2, double* c) { + double xtmp, neuzr, neuxr; + neutxypos (&neuzr, &neuxr, phi, inrad, c); + // printf("xr:%g zr:%g phi: %g r: %g c[0]: %g c[1]: %g\n",neuxr,neuzr,phi,inrad,c[0],c[1]); + if (fabs (neuxr) > inw1 / 2.0 + (inw2 - inw1) / (inrad / 2.0) * fabs (neuzr)) // check if neutron x position is outside of channel + return 0; + return 1; + } %} DECLARE %{ - double omega; - double off; - double splen; - double rad; - double sw; - + double omega; + double off; + double splen; + double rad; + double sw; %} INITIALIZE %{ - splen=len/2.0; - omega=2.0*PI*nu; - rad=sqrt(w2*w2/4.0+splen*splen); //radius of cylinder containing slit package. + splen = len / 2.0; + omega = 2.0 * PI * nu; + rad = sqrt (w2 * w2 / 4.0 + splen * splen); // radius of cylinder containing slit package. %} TRACE %{ - - double t0,t1,dphi,dt2,tneuzr,tneuxr,nrad; - double phivec[200],tpt[3],xpt[3],ypt[3],zpt[3],zr[3],xr[3],yr[3],theta[3],c[2]; - int chan_num,chan_num0,idx1,idx3; - if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, rad, ymax-ymin)){ - if (t0 < 0) /*Neutron started inside cylinder */ - ABSORB; - dt2=t1-t0; - PROP_DT(t0); /*propagate neutron to edge of chopper*/ - /*calculate neutron position and velocity in chopper frame + + double t0, t1, dphi, dt2, tneuzr, tneuxr, nrad; + double phivec[200], tpt[3], xpt[3], ypt[3], zpt[3], zr[3], xr[3], yr[3], theta[3], c[2]; + int chan_num, chan_num0, idx1, idx3; + if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, rad, ymax - ymin)) { + if (t0 < 0) /*Neutron started inside cylinder */ + ABSORB; + dt2 = t1 - t0; + PROP_DT (t0); /*propagate neutron to edge of chopper*/ + /*calculate neutron position and velocity in chopper frame calculate 3 points in the instrument frame and put them into the - chopper frame inorder to determine the radius and center of a circle + chopper frame inorder to determine the radius and center of a circle that describes the path of the neutron in the chopper frame. */ - tpt[1]=t; - tpt[2]=t+dt2; - tpt[0]=t+dt2/2.0; - //set local 0 in time as tc and calculate angle of rotation for each point - for(idx3=0;idx3<3;idx3++){ - theta[idx3]=(tpt[idx3]-tc)*omega; + tpt[1] = t; + tpt[2] = t + dt2; + tpt[0] = t + dt2 / 2.0; + // set local 0 in time as tc and calculate angle of rotation for each point + for (idx3 = 0; idx3 < 3; idx3++) { + theta[idx3] = (tpt[idx3] - tc) * omega; } - zpt[1]=-sqrt(rad*rad-x*x); xpt[1]=x; ypt[1]=y; /* point where neutron intersects chopper */ - zpt[2]=zpt[1]+vz*(dt2); xpt[2]=xpt[1]+vx*(dt2); ypt[2]=ypt[1]+vy*(dt2); /* point where neutron leaves the chopper */ - xpt[0]=xpt[1]+vx*(dt2/2.0); ypt[0]=ypt[1]+vy*(dt2/2.0); zpt[0]=zpt[1]+vz*(dt2/2.0); /*point half way between in time */ - /* do the rotation */ - for(idx3=0;idx3<3;idx3++){ - rotate(xr[idx3],yr[idx3],zr[idx3],xpt[idx3],ypt[idx3],zpt[idx3],theta[idx3],0,1,0); - } - calccenter(c,zr,xr); /* calculate the center */ - nrad=sqrt((zr[0]-c[0])*(zr[0]-c[0])+(xr[0]-c[1])*(xr[0]-c[1])); /*calculate the radius of curvature for the neutron path */ - /* calculate points along path of neutron through cylinder quit on absorption - * or transmit neutron if 200 points are calculated - * calculate phi for first and last points */ - phivec[0]=acos0_2pi((zr[1]-c[0])/nrad,xr[1]-c[1]);phivec[1]=acos0_2pi((zr[2]-c[0])/nrad,xr[2]-c[1]); - neutxypos(&tneuzr,&tneuxr,phivec[0],nrad,c); - /* reset phi[0] and phi[1] to match the length of the slit package rather than cylinder radius*/ - if(tneuzr<-splen){ - phivec[0]=acos0_2pi((-c[0]-splen)/nrad,-c[1]); + zpt[1] = -sqrt (rad * rad - x * x); + xpt[1] = x; + ypt[1] = y; /* point where neutron intersects chopper */ + zpt[2] = zpt[1] + vz * (dt2); + xpt[2] = xpt[1] + vx * (dt2); + ypt[2] = ypt[1] + vy * (dt2); /* point where neutron leaves the chopper */ + xpt[0] = xpt[1] + vx * (dt2 / 2.0); + ypt[0] = ypt[1] + vy * (dt2 / 2.0); + zpt[0] = zpt[1] + vz * (dt2 / 2.0); /*point half way between in time */ + /* do the rotation */ + for (idx3 = 0; idx3 < 3; idx3++) { + rotate (xr[idx3], yr[idx3], zr[idx3], xpt[idx3], ypt[idx3], zpt[idx3], theta[idx3], 0, 1, 0); } - neutxypos(&tneuzr,&tneuxr,phivec[1],nrad,c); - if(tneuzr>splen){ - phivec[1]=acos0_2pi((-c[0]+splen/2.0)/nrad,-c[1]); + calccenter (c, zr, xr); /* calculate the center */ + nrad = sqrt ((zr[0] - c[0]) * (zr[0] - c[0]) + (xr[0] - c[1]) * (xr[0] - c[1])); /*calculate the radius of curvature for the neutron path */ + /* calculate points along path of neutron through cylinder quit on absorption + * or transmit neutron if 200 points are calculated + * calculate phi for first and last points */ + phivec[0] = acos0_2pi ((zr[1] - c[0]) / nrad, xr[1] - c[1]); + phivec[1] = acos0_2pi ((zr[2] - c[0]) / nrad, xr[2] - c[1]); + neutxypos (&tneuzr, &tneuxr, phivec[0], nrad, c); + /* reset phi[0] and phi[1] to match the length of the slit package rather than cylinder radius*/ + if (tneuzr < -splen) { + phivec[0] = acos0_2pi ((-c[0] - splen) / nrad, -c[1]); } - dphi=phivec[1]-phivec[0]; /* initial dphi */ - idx1=2; - phivec[idx1]=phivec[0]+dphi/2.0; /* calculate center point */ - if (!t0checkabsorb(phivec[idx1],nrad,w1,w2,c)) - ABSORB; - while (idx1<129){ - dphi=phivec[1]-phivec[idx1]; - idx1++; - phivec[idx1]=phivec[0]+dphi/2.0; - if (!t0checkabsorb(phivec[idx1],nrad,w1,w2,c)) + neutxypos (&tneuzr, &tneuxr, phivec[1], nrad, c); + if (tneuzr > splen) { + phivec[1] = acos0_2pi ((-c[0] + splen / 2.0) / nrad, -c[1]); + } + dphi = phivec[1] - phivec[0]; /* initial dphi */ + idx1 = 2; + phivec[idx1] = phivec[0] + dphi / 2.0; /* calculate center point */ + if (!t0checkabsorb (phivec[idx1], nrad, w1, w2, c)) ABSORB; - if (dphi>0){ - while ((phivec[idx1]=phivec[1]) idx1--; //remove the point that is beyond phivec[1] - } - else if (dphi<0){ - while ((phivec[idx1]>phivec[1])&&(idx1<129)){ - /* printf("phivec[%i]: %g\n", idx1,phivec[idx1]);*/ - idx1++; - phivec[idx1]=phivec[idx1-1]+dphi; - if (!t0checkabsorb(phivec[idx1],nrad,w1,w2,c)) - ABSORB; - } - if (phivec[idx1]<=phivec[1]) idx1--; //remove the point that is beyond phivec[1] - } - else + while (idx1 < 129) { + dphi = phivec[1] - phivec[idx1]; + idx1++; + phivec[idx1] = phivec[0] + dphi / 2.0; + if (!t0checkabsorb (phivec[idx1], nrad, w1, w2, c)) + ABSORB; + if (dphi > 0) { + while ((phivec[idx1] < phivec[1]) && (idx1 < 129)) { + /* printf("phivec[%i]: %g dphi: %g phivec[1]: %g\n", idx1,phivec[idx1],dphi,phivec[1]);*/ + idx1++; + phivec[idx1] = phivec[idx1 - 1] + dphi; + if (!t0checkabsorb (phivec[idx1], nrad, w1, w2, c)) + ABSORB; + } + if (phivec[idx1] >= phivec[1]) + idx1--; // remove the point that is beyond phivec[1] + } else if (dphi < 0) { + while ((phivec[idx1] > phivec[1]) && (idx1 < 129)) { + /* printf("phivec[%i]: %g\n", idx1,phivec[idx1]);*/ + idx1++; + phivec[idx1] = phivec[idx1 - 1] + dphi; + if (!t0checkabsorb (phivec[idx1], nrad, w1, w2, c)) + ABSORB; + } + if (phivec[idx1] <= phivec[1]) + idx1--; // remove the point that is beyond phivec[1] + } else ABSORB; /* dphi =0? */ - } - } - else /* The neutron failed to even hit the chopper */ + } + } else /* The neutron failed to even hit the chopper */ ABSORB; - %} MCDISPLAY %{ -double zstep,x1,x2,x3,x4,z1,z2; -int idx, idx2; -line(w2/2.0,ymin,splen,w2/2.0,ymax,splen); -line(w2/2.0,ymin,-splen,w2/2.0,ymax,-splen); -line(-w2/2.0,ymin,splen,-w2/2.0,ymax,splen); -line(-w2/2.0,ymin,-splen,-w2/2.0,ymax,-splen); -line(w2/2.0,ymax,splen,w1/2.0,ymax,0); -line(w1/2.0,ymax,0,w2/2.0,ymax,-splen); -line(-w2/2.0,ymax,splen,-w1/2.0,ymax,0); -line(-w1/2.0,ymax,0,-w2/2.0,ymax,-splen); -line(w2/2.0,ymin,splen,w1/2.0,ymin,0); -line(w1/2.0,ymin,0,w2/2.0,ymin,-splen); -line(-w2/2.0,ymin,splen,-w1/2.0,ymin,0); -line(-w1/2.0,ymin,0,-w2/2.0,ymin,-splen); -circle("zx",0,ymin,0,rad); -circle("zx",0,ymax,0,rad); -zstep=2.0*splen/10.0; + double zstep, x1, x2, x3, x4, z1, z2; + int idx, idx2; + line (w2 / 2.0, ymin, splen, w2 / 2.0, ymax, splen); + line (w2 / 2.0, ymin, -splen, w2 / 2.0, ymax, -splen); + line (-w2 / 2.0, ymin, splen, -w2 / 2.0, ymax, splen); + line (-w2 / 2.0, ymin, -splen, -w2 / 2.0, ymax, -splen); + line (w2 / 2.0, ymax, splen, w1 / 2.0, ymax, 0); + line (w1 / 2.0, ymax, 0, w2 / 2.0, ymax, -splen); + line (-w2 / 2.0, ymax, splen, -w1 / 2.0, ymax, 0); + line (-w1 / 2.0, ymax, 0, -w2 / 2.0, ymax, -splen); + line (w2 / 2.0, ymin, splen, w1 / 2.0, ymin, 0); + line (w1 / 2.0, ymin, 0, w2 / 2.0, ymin, -splen); + line (-w2 / 2.0, ymin, splen, -w1 / 2.0, ymin, 0); + line (-w1 / 2.0, ymin, 0, -w2 / 2.0, ymin, -splen); + circle ("zx", 0, ymin, 0, rad); + circle ("zx", 0, ymax, 0, rad); + zstep = 2.0 * splen / 10.0; %} END diff --git a/mcstas-comps/contrib/ViewModISIS.comp b/mcstas-comps/contrib/ViewModISIS.comp index 60889cafc..077feeb84 100644 --- a/mcstas-comps/contrib/ViewModISIS.comp +++ b/mcstas-comps/contrib/ViewModISIS.comp @@ -73,54 +73,54 @@ SETTING PARAMETERS (string Face="TS1_S04_Merlin.mcstas",E0, E1, modPosition=0, SHARE %{ -#include - -typedef struct -{ - int nEnergy; ///< Number of energy bins - int nTime; ///< number of time bins - - double XAxis; - double ZAxis; - - double rdumMid; ///< tally time Window mid point - double timeOffset; ///< Time separation - double* TimeBin; ///< Time bins - double* EnergyBin; ///< Energy bins - - double** Flux; ///< Flux per bin (integrated) - double* EInt; ///< Integrated Energy point - double Total; ///< Integrated Total - -} Source_ViewMod; - - -double** -matrix(const int m,const int n) - /*! - Determine a double matrix - */ -{ - int i; - double* pv; - double** pd; - - if (m<1) return 0; - if (n<1) return 0; - pv = (double*) malloc(m*n*sizeof(double)); - pd = (double**) malloc(m*sizeof(double*)); - if (!pd) - { - fprintf(stderr,"No room for matrix!\n"); - exit(1); - } - for (i=0;i + + typedef struct { + int nEnergy; ///< Number of energy bins + int nTime; ///< number of time bins + + double XAxis; + double ZAxis; + + double rdumMid; ///< tally time Window mid point + double timeOffset; ///< Time separation + double* TimeBin; ///< Time bins + double* EnergyBin; ///< Energy bins + + double** Flux; ///< Flux per bin (integrated) + double* EInt; ///< Integrated Energy point + double Total; ///< Integrated Total -#pragma acc routine seq -double polInterp(double* X,double* Y,int Psize,double Aim) + } Source_ViewMod; + + double** + matrix (const int m, const int n) + /*! + Determine a double matrix + */ + { + int i; + double* pv; + double** pd; + + if (m < 1) + return 0; + if (n < 1) + return 0; + pv = (double*)malloc (m * n * sizeof (double)); + pd = (double**)malloc (m * sizeof (double*)); + if (!pd) { + fprintf (stderr, "No room for matrix!\n"); + exit (1); + } + for (i = 0; i < m; i++) + pd[i] = pv + (i * n); + return pd; + } /* matrix */ + + #pragma acc routine seq + double + polInterp (double* X, double* Y, int Psize, double Aim) /*! returns the interpolated polynomial between Epnts and the integration @@ -130,928 +130,869 @@ double polInterp(double* X,double* Y,int Psize,double Aim) \param Aim :: Aim point to intepolate result (X coordinate) \returns Energy point */ -{ - double out,errOut; /* out put variables */ - double *C = malloc(Psize*sizeof(double)); - double *D = malloc(Psize*sizeof(double)); - if (!C || !D) { - #ifndef OPENACC - fprintf(stderr,"Error in ISIS_moderator: memory allocation failure. Exit!\n"); - exit(-1); - #endif - } - double testDiff,diff; - - double w,den,ho,hp; /* intermediate variables */ - int i,m,ns; - - - ns=0; - diff=fabs(Aim-X[0]); - C[0]=Y[0]; - D[0]=Y[0]; - for(i=1;itestDiff) - { - ns=i; - diff=testDiff; - } - C[i]=Y[i]; - D[i]=Y[i]; + { + double out, errOut; /* out put variables */ + double* C = malloc (Psize * sizeof (double)); + double* D = malloc (Psize * sizeof (double)); + if (!C || !D) { + #ifndef OPENACC + fprintf (stderr, "Error in ISIS_moderator: memory allocation failure. Exit!\n"); + exit (-1); + #endif + } + double testDiff, diff; + + double w, den, ho, hp; /* intermediate variables */ + int i, m, ns; + + ns = 0; + diff = fabs (Aim - X[0]); + C[0] = Y[0]; + D[0] = Y[0]; + for (i = 1; i < Psize; i++) { + testDiff = fabs (Aim - X[i]); + if (diff > testDiff) { + ns = i; + diff = testDiff; + } + C[i] = Y[i]; + D[i] = Y[i]; } - out=Y[ns]; - ns--; /* Now can be -1 !!!! */ + out = Y[ns]; + ns--; /* Now can be -1 !!!! */ + + for (m = 1; m < Psize; m++) { + for (i = 0; i < Psize - m; i++) { + ho = X[i] - Aim; + hp = X[i + m] - Aim; + w = C[i + 1] - D[i]; + /* den=ho-hp; -- test !=0.0 */ + den = w / (ho - hp); + D[i] = hp * den; + C[i] = ho * den; + } - for(m=1;mAR[Npts-1]) - return Npts; + { + int klo, khi, k; + if (Npts <= 0) + return 0; + if (V > AR[Npts - 1]) + return Npts; - if(AR[0]>0.0)AR[0]=0.0; + if (AR[0] > 0.0) + AR[0] = 0.0; - if (V0.0)AR[0]=0.0; return 0; } - klo=0; - khi= Npts-1; - while (khi-klo >1) - { - k=(khi+klo) >> 1; // quick division by 2 - if (AR[k]>V) - khi=k; + klo = 0; + khi = Npts - 1; + while (khi - klo > 1) { + k = (khi + klo) >> 1; // quick division by 2 + if (AR[k] > V) + khi = k; else - klo=k; + klo = k; } - return khi; -} /* binSearch */ - -int -cmdnumberD(char *mc,double* num) - /*! - \returns 1 on success 0 on failure - */ -{ - int i,j; - char* ss; - char **endptr; - double nmb; - int len; - - len=strlen(mc); - j=0; - - for(i=0;i*B) - { - tmp=*A; - *A=*B; - *B=tmp; + *num = (double)nmb; + for (j = 0; j < i && mc[j]; j++) + mc[j] = ' '; + free (endptr); + free (ss); + return 1; + } /* cmdnumberD */ + + int + notComment (char* Line) + /*! + \returns 0 on a comment, 1 on a non-comment + */ + { + int len, i; + + len = strlen (Line); + for (i = 0; i < len && isspace (Line[i]); i++) + ; + + if (!Line[i] || Line[i] == 'c' || Line[i] == 'C' || Line[i] == '!' || Line[i] == '#') + return 0; + return 1; + } /* notComment */ + + void + orderEnergy (double* A, double* B) { + double tmp; + if (*A > *B) { + tmp = *A; + *A = *B; + *B = tmp; } - return; -} /* orderEnergy */ - -int -timeStart(char* Line) - /*! - Search for a word time at the start of - the line. - \param Line :: Line to search - \returns 1 on success 0 on failure - */ -{ - int len,i; - - len=strlen(Line); - for(i=0;i0.0) ? E : 81.793936/(E*E); -} /* convertEnergy */ + { + return (E > 0.0) ? E : 81.793936 / (E * E); + } /* convertEnergy */ -double -EtoLambda(double E) + double + EtoLambda (double E) /*! Convert the energy from eV [not change] o to lambda [A] */ -{ - return sqrt(81.793936/E); -} /* EtoLambda */ - - -int -timeEnd(char* Line) - /*! - Search for a word time at the start of - the line. - \param Line :: Line to search - \returns 1 on success 0 on failure - */ -{ - int len,i; - - len=strlen(Line); - for(i=0;iEinit && *Ea Eb - that is encompassed by EI->EE - */ -{ - double frac; - double dRange; + if (strncmp (Line + i, "energy bin:", 11)) + return 0; + + i += 11; + if (!cmdnumberD (Line + i, &A)) + return 0; + // remove 'to' + for (; i < len - 1 && Line[i] != 'o'; i++) + ; + i++; + if (!cmdnumberD (Line + i, &B)) + return 0; + A *= 1e9; + B *= 1e9; + *Ea = A; + *Eb = B; + if (*Eb > Einit && *Ea < Eend) + return 1; + return 0; + } /* energyBin */ - if (EI>Eb) - return 0.0; - if (EE Eb + that is encompassed by EI->EE + */ + { + double frac; + double dRange; - dRange=Eb-Ea; - frac=(EI>Ea) ? (Eb-EI)/dRange : 1.0; + if (EI > Eb) + return 0.0; + if (EE < Ea) + return 0.0; + dRange = Eb - Ea; + frac = (EI > Ea) ? (Eb - EI) / dRange : 1.0; - frac-=(EEtimeOffset=toff; + double toff; + timeOffsetFlag = findTimeOffset (ss, &toff); + TS->timeOffset = toff; } if (!rdumCnt) - rdumCnt=findRDUM(ss); - if (rdumCnt && rdumCnt<5) - { - cutToNumber(ss); - for(i=0;i<3 && cmdnumberD(ss,&D);i++) - RPts[(rdumCnt-1)*3+i]=D; - rdumCnt++; - } + rdumCnt = findRDUM (ss); + if (rdumCnt && rdumCnt < 5) { + cutToNumber (ss); + for (i = 0; i < 3 && cmdnumberD (ss, &D); i++) + RPts[(rdumCnt - 1) * 3 + i] = D; + rdumCnt++; + } // EXIT CONDITION: - if (rdumCnt*timeOffsetFlag==5) - { - for(j=0;j<3;j++) - { - TS->ZAxis+=(RPts[3+j]-RPts[j])*(RPts[3+j]-RPts[j]); - TS->XAxis+=(RPts[6+j]-RPts[3+j])*(RPts[6+j]-RPts[3+j]); - } - - - TS->ZAxis=sqrt(TS->ZAxis)/100.0; // convert to metres from cm - TS->XAxis=sqrt(TS->XAxis)/100.0; - if (!modPosition) - { - TS->ZAxis=yheight; - TS->XAxis=xwidth; - } - fprintf(stderr,"Time off sec == %g \n",TS->timeOffset); - fprintf(stderr,"mod size z == %g \n",TS->ZAxis); - // TS.rdumMid=calcRDum(RPts, TS); - TS->rdumMid=TS->timeOffset; // Goran - return; - } + if (rdumCnt * timeOffsetFlag == 5) { + for (j = 0; j < 3; j++) { + TS->ZAxis += (RPts[3 + j] - RPts[j]) * (RPts[3 + j] - RPts[j]); + TS->XAxis += (RPts[6 + j] - RPts[3 + j]) * (RPts[6 + j] - RPts[3 + j]); + } + + TS->ZAxis = sqrt (TS->ZAxis) / 100.0; // convert to metres from cm + TS->XAxis = sqrt (TS->XAxis) / 100.0; + if (!modPosition) { + TS->ZAxis = yheight; + TS->XAxis = xwidth; + } + fprintf (stderr, "Time off sec == %g \n", TS->timeOffset); + fprintf (stderr, "mod size z == %g \n", TS->ZAxis); + // TS.rdumMid=calcRDum(RPts, TS); + TS->rdumMid = TS->timeOffset; // Goran + return; + } } - return; -} /* processHeader */ - - - -int -readHtable(FILE* TFile,const double Einit,const double Eend, - Source_ViewMod *TS, double modPosition, double xwidth, double yheight, int verbose) -/*! - Process a general h.o file to create an integrated - table of results from Einit -> Eend - \param Einit :: inital Energy - \param Eend :: final energy -*/ -{ - char ss[255]; /* BIG space for line */ - double Ea,Eb; - double T,D; - double Efrac; // Fraction of an Energy Bin - int Ftime; // time Flag - int eIndex; // energy Index - int tIndex; // time Index - double Tsum; // Running integration - double Efraction; // Amount to use for an energy/time bin - - // extern Source TS; - - int DebugCnt; - int i; - /*! - Status Flag:: - Ftime=1 :: [time ] Reading Time : Data : Err [Exit on Total] + return; + } /* processHeader */ - Double Read File to determine how many bins and - memory size + int + readHtable (FILE* TFile, const double Einit, const double Eend, Source_ViewMod* TS, double modPosition, double xwidth, double yheight, int verbose) + /*! + Process a general h.o file to create an integrated + table of results from Einit -> Eend + \param Einit :: inital Energy + \param Eend :: final energy */ - if (!TFile) return(0); - Ea=0.0; - Eb=0.0; - fprintf(stderr,"Energy == %g %g\n",Einit,Eend); - eIndex= -1; - DebugCnt=0; - Ftime=0; - tIndex=0; - TS->nTime=0; - TS->nEnergy=0; - processHeader(TFile, TS, modPosition, xwidth, yheight); - - // Read file and get time bins: - while(fgets(ss,255,TFile) && Eend>Ea) - { - if (notComment(ss)) - { - DebugCnt++; - if (!Ftime) - { - // find :: energy bin: to - if (energyBin(ss,Einit,Eend,&Ea,&Eb)) - { - if (eIndex==0) - TS->nTime=tIndex; - eIndex++; - } - else if (timeStart(ss)) - { - Ftime=1; - tIndex=0; - } - } - else // In the time section - { - if (timeEnd(ss)) // Found "total" - Ftime=0; - else - { - // Need to read the line in the case of first run - if (TS->nTime==0) - { - if (cmdnumberD(ss,&T) && - cmdnumberD(ss,&D)) - tIndex++; - } - } - } - } - } - // Plus 2 since we have a 0 counter and we have missed the last line. - TS->nEnergy=eIndex+2; - if (!TS->nTime && tIndex) - TS->nTime=tIndex; - // printf("tIndex %d %d %d %d \n",tIndex,eIndex,TS->nEnergy,TS->nTime); - - /* SECOND TIME THROUGH:: */ - rewind(TFile); - - TS->Flux=matrix(TS->nEnergy,TS->nTime); - TS->EInt=(double*) malloc(TS->nEnergy*sizeof(double)); - TS->TimeBin=(double*) malloc(TS->nTime*sizeof(double)); - TS->EnergyBin=(double*) malloc(TS->nEnergy*sizeof(double)); - - Tsum=0.0; - Ea=0.0; - Eb=0.0; - eIndex=-1; - DebugCnt=0; - Ftime=0; - tIndex=0; - TS->EInt[0]=0.0; - // Read file and get time bins - while(fgets(ss,255,TFile) && Eend>Ea) - { - if (notComment(ss)) - { - DebugCnt++; - if (!Ftime) - { - if (energyBin(ss,Einit,Eend,&Ea,&Eb)) - { - eIndex++; - TS->EnergyBin[eIndex]=(Einit>Ea) ? Einit : Ea; - Efraction=calcFraction(Einit,Eend,Ea,Eb); - Ftime++; - } - } - else if (Ftime==1) - { - if (timeStart(ss)) - { - Ftime=2; - tIndex=0; - } - } - else // In the time section - { - if (timeEnd(ss)) // Found "total" - { - Ftime=0; - TS->EInt[eIndex+1]=Tsum; - } - else - { - // Need to read the line in the case of first run - if (cmdnumberD(ss,&T) && - cmdnumberD(ss,&D)) - { - TS->TimeBin[tIndex]=T/1e8; // convert Time into second (from shakes) - Tsum+=D*Efraction; - TS->Flux[eIndex][tIndex]=Tsum; - tIndex++; - } - } - } - } + { + char ss[255]; /* BIG space for line */ + double Ea, Eb; + double T, D; + double Efrac; // Fraction of an Energy Bin + int Ftime; // time Flag + int eIndex; // energy Index + int tIndex; // time Index + double Tsum; // Running integration + double Efraction; // Amount to use for an energy/time bin + + // extern Source TS; + + int DebugCnt; + int i; + /*! + Status Flag:: + Ftime=1 :: [time ] Reading Time : Data : Err [Exit on Total] + + Double Read File to determine how many bins and + memory size + */ + if (!TFile) + return (0); + Ea = 0.0; + Eb = 0.0; + fprintf (stderr, "Energy == %g %g\n", Einit, Eend); + eIndex = -1; + DebugCnt = 0; + Ftime = 0; + tIndex = 0; + TS->nTime = 0; + TS->nEnergy = 0; + processHeader (TFile, TS, modPosition, xwidth, yheight); + + // Read file and get time bins: + while (fgets (ss, 255, TFile) && Eend > Ea) { + if (notComment (ss)) { + DebugCnt++; + if (!Ftime) { + // find :: energy bin: to + if (energyBin (ss, Einit, Eend, &Ea, &Eb)) { + if (eIndex == 0) + TS->nTime = tIndex; + eIndex++; + } else if (timeStart (ss)) { + Ftime = 1; + tIndex = 0; + } + } else // In the time section + { + if (timeEnd (ss)) // Found "total" + Ftime = 0; + else { + // Need to read the line in the case of first run + if (TS->nTime == 0) { + if (cmdnumberD (ss, &T) && cmdnumberD (ss, &D)) + tIndex++; + } + } + } + } } - TS->EnergyBin[eIndex+1]=Eend; - TS->Total=Tsum; - - // printf("tIndex %d %d %d \n",tIndex,eIndex,TS.nTime); - //printf("Tsum %g \n",Tsum); - //fprintf(stderr,"ebin1 ebinN %g %g\n",TS.EnergyBin[0],TS.EnergyBin[TS.nEnergy-1]); - - return 1; -} // readHtable - - -#pragma acc routine seq -void getPoint(double* TV,double* EV,double* lim1, double* lim2, Source_ViewMod TS, _class_particle *_particle) - /*! - Calculate the Time and Energy - by sampling the file. - Uses TS table to find the point - \param TV :: - \param EV :: - \param lim1 :: - \param lim2 :: - */ -{ - int i; - - double R0,R1,R,Rend; - int Epnt; ///< Points to the next higher index of the neutron integral - int Tpnt; - int iStart,iEnd; - double TRange,Tspread; - double Espread,Estart; - double *EX; - - // So that lowPoly+highPoly==maxPoly - const int maxPoly=6; - const int highPoly=maxPoly/2; - const int lowPoly=maxPoly-highPoly; - - // static int testVar=0; - - R0=rand01(); - /* if (testVar==0) - { - R0=1.0e-8; - testVar=1; + // Plus 2 since we have a 0 counter and we have missed the last line. + TS->nEnergy = eIndex + 2; + if (!TS->nTime && tIndex) + TS->nTime = tIndex; + // printf("tIndex %d %d %d %d \n",tIndex,eIndex,TS->nEnergy,TS->nTime); + + /* SECOND TIME THROUGH:: */ + rewind (TFile); + + TS->Flux = matrix (TS->nEnergy, TS->nTime); + TS->EInt = (double*)malloc (TS->nEnergy * sizeof (double)); + TS->TimeBin = (double*)malloc (TS->nTime * sizeof (double)); + TS->EnergyBin = (double*)malloc (TS->nEnergy * sizeof (double)); + + Tsum = 0.0; + Ea = 0.0; + Eb = 0.0; + eIndex = -1; + DebugCnt = 0; + Ftime = 0; + tIndex = 0; + TS->EInt[0] = 0.0; + // Read file and get time bins + while (fgets (ss, 255, TFile) && Eend > Ea) { + if (notComment (ss)) { + DebugCnt++; + if (!Ftime) { + if (energyBin (ss, Einit, Eend, &Ea, &Eb)) { + eIndex++; + TS->EnergyBin[eIndex] = (Einit > Ea) ? Einit : Ea; + Efraction = calcFraction (Einit, Eend, Ea, Eb); + Ftime++; + } + } else if (Ftime == 1) { + if (timeStart (ss)) { + Ftime = 2; + tIndex = 0; + } + } else // In the time section + { + if (timeEnd (ss)) // Found "total" + { + Ftime = 0; + TS->EInt[eIndex + 1] = Tsum; + } else { + // Need to read the line in the case of first run + if (cmdnumberD (ss, &T) && cmdnumberD (ss, &D)) { + TS->TimeBin[tIndex] = T / 1e8; // convert Time into second (from shakes) + Tsum += D * Efraction; + TS->Flux[eIndex][tIndex] = Tsum; + tIndex++; + } + } + } + } } + TS->EnergyBin[eIndex + 1] = Eend; + TS->Total = Tsum; + + // printf("tIndex %d %d %d \n",tIndex,eIndex,TS.nTime); + // printf("Tsum %g \n",Tsum); + // fprintf(stderr,"ebin1 ebinN %g %g\n",TS.EnergyBin[0],TS.EnergyBin[TS.nEnergy-1]); + + return 1; + } // readHtable + + #pragma acc routine seq + void + getPoint (double* TV, double* EV, double* lim1, double* lim2, Source_ViewMod TS, _class_particle* _particle) + /*! + Calculate the Time and Energy + by sampling the file. + Uses TS table to find the point + \param TV :: + \param EV :: + \param lim1 :: + \param lim2 :: */ - Rend=R=TS.Total*R0; - // This gives Eint[Epnt-1] > R > Eint[Epnt] - Epnt=binSearch(TS.nEnergy-1,TS.EInt,R); - - // if (Epnt < 0) - // Epnt=1; - Tpnt=binSearch(TS.nTime-1,TS.Flux[Epnt-1],R); - // fprintf(stderr,"TBoundaryX == %12.6e %12.6e \n",TS.TimeBin[Tpnt-1],TS.TimeBin[Tpnt]); - // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); - // if (Epnt == -1) - //{ - // Epnt=0; - // fprintf(stderr,"\n Rvals == %g %d %d %g\n",R,Epnt,Tpnt,TS.TimeBin[0]); - // fprintf(stderr,"EInt == %d %12.6e %12.6e %12.6e %12.6e \n",Epnt,TS.EInt[Epnt-1],R,TS.EInt[Epnt],TS.EInt[Epnt+1]); - // printf("EBoundary == %12.6e %12.6e \n",TS.EnergyBin[Epnt],TS.EnergyBin[Epnt+1]); - - // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt+1][Tpnt],R,TS.Flux[Epnt+1][Tpnt+1]); - // } - - if(R < TS.Flux[Epnt-1][Tpnt-1] || R >TS.Flux[Epnt-1][Tpnt] ) - { -#ifndef OPENACC - fprintf(stderr, "outside bin limits Tpnt/Epnt problem %12.6e %12.6e %12.6e \n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); -#endif + { + int i; + + double R0, R1, R, Rend; + int Epnt; ///< Points to the next higher index of the neutron integral + int Tpnt; + int iStart, iEnd; + double TRange, Tspread; + double Espread, Estart; + double* EX; + + // So that lowPoly+highPoly==maxPoly + const int maxPoly = 6; + const int highPoly = maxPoly / 2; + const int lowPoly = maxPoly - highPoly; + + // static int testVar=0; + + R0 = rand01 (); + /* if (testVar==0) + { + R0=1.0e-8; + testVar=1; + } + */ + Rend = R = TS.Total * R0; + // This gives Eint[Epnt-1] > R > Eint[Epnt] + Epnt = binSearch (TS.nEnergy - 1, TS.EInt, R); + + // if (Epnt < 0) + // Epnt=1; + Tpnt = binSearch (TS.nTime - 1, TS.Flux[Epnt - 1], R); + // fprintf(stderr,"TBoundaryX == %12.6e %12.6e \n",TS.TimeBin[Tpnt-1],TS.TimeBin[Tpnt]); + // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt-1][Tpnt-1],R,TS.Flux[Epnt-1][Tpnt]); + // if (Epnt == -1) + //{ + // Epnt=0; + // fprintf(stderr,"\n Rvals == %g %d %d %g\n",R,Epnt,Tpnt,TS.TimeBin[0]); + // fprintf(stderr,"EInt == %d %12.6e %12.6e %12.6e %12.6e \n",Epnt,TS.EInt[Epnt-1],R,TS.EInt[Epnt],TS.EInt[Epnt+1]); + // printf("EBoundary == %12.6e %12.6e \n",TS.EnergyBin[Epnt],TS.EnergyBin[Epnt+1]); + + // fprintf(stderr,"TFlux == %12.6e %12.6e %12.6e \n\n",TS.Flux[Epnt+1][Tpnt],R,TS.Flux[Epnt+1][Tpnt+1]); + // } + + if (R < TS.Flux[Epnt - 1][Tpnt - 1] || R > TS.Flux[Epnt - 1][Tpnt]) { + #ifndef OPENACC + fprintf (stderr, "outside bin limits Tpnt/Epnt problem %12.6e %12.6e %12.6e \n", TS.Flux[Epnt - 1][Tpnt - 1], R, TS.Flux[Epnt - 1][Tpnt]); + #endif } - if(Epnt == 0) - { - Estart=0.0; - Espread=TS.EInt[0]; - *EV=TS.EnergyBin[1]; - } - else - { - Estart=TS.EInt[Epnt-1]; - Espread=TS.EInt[Epnt]-TS.EInt[Epnt-1]; - *EV=TS.EnergyBin[Epnt+1]; + if (Epnt == 0) { + Estart = 0.0; + Espread = TS.EInt[0]; + *EV = TS.EnergyBin[1]; + } else { + Estart = TS.EInt[Epnt - 1]; + Espread = TS.EInt[Epnt] - TS.EInt[Epnt - 1]; + *EV = TS.EnergyBin[Epnt + 1]; } - if (Tpnt==0 || Epnt==0) - { -#ifndef OPENACC - fprintf(stderr,"BIG ERROR WITH Tpnt: %d and Epnt: %d\n",Tpnt,Epnt); - exit(1); -#endif + if (Tpnt == 0 || Epnt == 0) { + #ifndef OPENACC + fprintf (stderr, "BIG ERROR WITH Tpnt: %d and Epnt: %d\n", Tpnt, Epnt); + exit (1); + #endif } - if (Tpnt==TS.nTime) - { -#ifndef OPENACC - fprintf(stderr,"BIG ERROR WITH Tpnt and Epnt\n"); - exit(1); -#endif - - *TV=0.0; - Tspread=TS.Flux[Epnt-1][0]-TS.EInt[Epnt-1]; - TRange=TS.TimeBin[0]; - R-=TS.EInt[Epnt-1]; + if (Tpnt == TS.nTime) { + #ifndef OPENACC + fprintf (stderr, "BIG ERROR WITH Tpnt and Epnt\n"); + exit (1); + #endif + + *TV = 0.0; + Tspread = TS.Flux[Epnt - 1][0] - TS.EInt[Epnt - 1]; + TRange = TS.TimeBin[0]; + R -= TS.EInt[Epnt - 1]; + } else { + *TV = TS.TimeBin[Tpnt - 1]; + TRange = TS.TimeBin[Tpnt] - TS.TimeBin[Tpnt - 1]; + Tspread = TS.Flux[Epnt - 1][Tpnt] - TS.Flux[Epnt - 1][Tpnt - 1]; + R -= TS.Flux[Epnt - 1][Tpnt - 1]; } - else - { - *TV=TS.TimeBin[Tpnt-1]; - TRange=TS.TimeBin[Tpnt]-TS.TimeBin[Tpnt-1]; - Tspread=TS.Flux[Epnt-1][Tpnt]-TS.Flux[Epnt-1][Tpnt-1]; - R-=TS.Flux[Epnt-1][Tpnt-1]; - } - // printf("R == %12.6e\n",R); - R/=Tspread; - *TV+=TRange*R; - + // printf("R == %12.6e\n",R); + R /= Tspread; + *TV += TRange * R; - R1=TS.EInt[Epnt-1]+Espread*rand01(); - iStart=Epnt>lowPoly ? Epnt-lowPoly : 0; // max(Epnt-halfPoly,0) - iEnd=TS.nEnergy>Epnt+highPoly ? Epnt+highPoly : TS.nEnergy-1; // min(nEnergy-1,Epnt+highPoly + R1 = TS.EInt[Epnt - 1] + Espread * rand01 (); + iStart = Epnt > lowPoly ? Epnt - lowPoly : 0; // max(Epnt-halfPoly,0) + iEnd = TS.nEnergy > Epnt + highPoly ? Epnt + highPoly : TS.nEnergy - 1; // min(nEnergy-1,Epnt+highPoly - *EV=polInterp(TS.EInt+iStart,TS.EnergyBin+iStart,1+iEnd-iStart,R1); + *EV = polInterp (TS.EInt + iStart, TS.EnergyBin + iStart, 1 + iEnd - iStart, R1); - // fprintf(stderr,"Energy == %d %d %12.6e %12.6e \n",iStart,iEnd,R1,*EV); - // fprintf(stderr,"bins == %12.6e %12.6e %12.6e %12.6e \n",TS.EnergyBin[iStart],TS.EnergyBin[iEnd], - // TS.EInt[Epnt],TS.EInt[Epnt-1]); + // fprintf(stderr,"Energy == %d %d %12.6e %12.6e \n",iStart,iEnd,R1,*EV); + // fprintf(stderr,"bins == %12.6e %12.6e %12.6e %12.6e \n",TS.EnergyBin[iStart],TS.EnergyBin[iEnd], + // TS.EInt[Epnt],TS.EInt[Epnt-1]); - if(*TV < TS.TimeBin[Tpnt-1] || *TV > TS.TimeBin[Tpnt]) - { -#ifndef OPENACC - fprintf(stderr,"%d Tpnt %d Tval %g Epnt %d \n",TS.nTime,Tpnt,*TV,Epnt); - fprintf(stderr,"TBoundary == %12.6e,%g , %12.6e \n\n",TS.TimeBin[Tpnt-1],*TV,TS.TimeBin[Tpnt]); -#endif + if (*TV < TS.TimeBin[Tpnt - 1] || *TV > TS.TimeBin[Tpnt]) { + #ifndef OPENACC + fprintf (stderr, "%d Tpnt %d Tval %g Epnt %d \n", TS.nTime, Tpnt, *TV, Epnt); + fprintf (stderr, "TBoundary == %12.6e,%g , %12.6e \n\n", TS.TimeBin[Tpnt - 1], *TV, TS.TimeBin[Tpnt]); + #endif } + if (*EV < *lim1 || *EV > *lim2) { + #ifndef OPENACC + fprintf (stderr, "outside boundaries\n Epnt= %d, Tpnt= %d binlo %g|%g| binhi %g \n", Epnt, Tpnt, TS.EnergyBin[Epnt - 1], *EV, TS.EnergyBin[Epnt]); - if(*EV < *lim1 || *EV > *lim2) - { -#ifndef OPENACC - fprintf(stderr,"outside boundaries\n Epnt= %d, Tpnt= %d binlo %g|%g| binhi %g \n",Epnt,Tpnt,TS.EnergyBin[Epnt-1],*EV,TS.EnergyBin[Epnt]); - - fprintf(stderr,"TS == %g %g :: %d %d \n",TS.EInt[Epnt-1],TS.EInt[Epnt],iStart,iEnd); - fprintf(stderr,"Points (%g) == ",R1); - for(i=0;i512) - { - fprintf(stderr,"Filename excessivley long [EXIT]:\n %s\n",FileName); - exit(1); + *num = (double)nmb; + for (j = 0; j < i && mc[j]; j++) + mc[j] = ' '; + free (endptr); + free (ss); + return 1; + } /* cmdnumberI */ + + FILE* + openFile (char* FileName) + /* + Tries to open the file: + (i) In current working directory + (ii) In MC_Path directory + ISIS_tables extension + */ + { + FILE* efile = 0; + int fLen; + char extFileName[1024]; + char testFileName[2048]; + char mct[2048]; + + fLen = strlen (FileName); + + if (fLen > 512) { + fprintf (stderr, "Filename excessivley long [EXIT]:\n %s\n", FileName); + exit (1); } - - - strcpy(extFileName,FileName); - strcpy(extFileName+fLen,".mcstas"); - - /* Now check for the requested moderator file. In terms of precedence, - 1) Use MCTABLES location if available - 2) Is a local file available in PWD? - 3) Is there an ISIS_tables in PWD? - 4) Is the file available from the MCSTAS/contrib/ISIS_tables folder? - - otherwise fail */ - - fprintf(stderr,"Searching for %s in multiple locations... -- \n",FileName); - - /* 1) Is MCTABLES set and file located there? */ - if (getenv("MCTABLES")) - { - strcpy(mct, getenv("MCTABLES")); - sprintf(testFileName, "%s%c%s", mct, MC_PATHSEP_C, FileName); - efile=fopen(testFileName,"r"); + + strcpy (extFileName, FileName); + strcpy (extFileName + fLen, ".mcstas"); + + /* Now check for the requested moderator file. In terms of precedence, + 1) Use MCTABLES location if available + 2) Is a local file available in PWD? + 3) Is there an ISIS_tables in PWD? + 4) Is the file available from the MCSTAS/contrib/ISIS_tables folder? + - otherwise fail */ + + fprintf (stderr, "Searching for %s in multiple locations... -- \n", FileName); + + /* 1) Is MCTABLES set and file located there? */ + if (getenv ("MCTABLES")) { + strcpy (mct, getenv ("MCTABLES")); + sprintf (testFileName, "%s%c%s", mct, MC_PATHSEP_C, FileName); + efile = fopen (testFileName, "r"); if (efile) { - fprintf(stderr," - Found in MCTABLES folder %s!\n",mct); - return efile; + fprintf (stderr, " - Found in MCTABLES folder %s!\n", mct); + return efile; } } - /* 2) Is the file located in working dir? */ - efile=fopen(FileName,"r"); - if (efile) { - fprintf(stderr," - Found in current directory!\n"); - return efile; - } - - efile=fopen(extFileName,"r"); - if (efile) return efile; - - /* 3) Is the file in a local 'tablefiles' folder? */ - sprintf(testFileName,"%s%c%s","ISIS_tables",MC_PATHSEP_C,FileName); - efile=fopen(testFileName,"r"); - if (efile) { - fprintf(stderr," - Found in local ISIS_tables directory!\n"); - return efile; - } + /* 2) Is the file located in working dir? */ + efile = fopen (FileName, "r"); + if (efile) { + fprintf (stderr, " - Found in current directory!\n"); + return efile; + } - /* 4) Is the file available within the MCSTAS install dir? */ - sprintf(testFileName,"%s%c%s%c%s%c%s", - MCSTAS,MC_PATHSEP_C,"data",MC_PATHSEP_C,"ISIS_tables",MC_PATHSEP_C,FileName); - efile=fopen(testFileName,"r"); - if (efile) { - fprintf(stderr," - Found in MCSTAS system dir: \n %s%c%s%c%s\n", - MCSTAS,MC_PATHSEP_C,"contrib",MC_PATHSEP_C,"ISIS_tables"); - return efile; - } + efile = fopen (extFileName, "r"); + if (efile) + return efile; - /* If we reach here, the file was not found - raise fatal error */ - fprintf(stderr,"%s - Not found! \nPlease check your McStas installation and/or MCTABLES environment variable!\n",FileName); - exit(1); - return efile; -} /* openFile */ + /* 3) Is the file in a local 'tablefiles' folder? */ + sprintf (testFileName, "%s%c%s", "ISIS_tables", MC_PATHSEP_C, FileName); + efile = fopen (testFileName, "r"); + if (efile) { + fprintf (stderr, " - Found in local ISIS_tables directory!\n"); + return efile; + } -double strArea(Source_ViewMod TS, double focus_xw, double focus_yh, double dist) -{ - /* - Returns the mean Str view of the viewport - This integrates over each point on the window focus_xw to focus_yh - View port is symmetric so use only 1/4 of the view - for the calcuation. - Control Values TS.XAxis TS.ZAxis focus_xw focus_yh - */ - - double A; - double Vx,Vy; // view temp points - double Mx,My; // moderator x,y - double D2; // Distance ^2 - double projArea; // viewport projection to moderator - int i,j,aa,bb; // loop variables - int NStep; - - NStep=50; - D2=dist*dist; - A=0.0; - fprintf(stderr,"TS axis == %g %g\n",TS.XAxis,TS.ZAxis); - fprintf(stderr,"AW axis == %g %g\n",focus_xw,focus_yh); - for(i=0;imax var in param space */ - double Ival,Tval,Eval; + double v, r, E; + double xf, yf, dx, dy; /* mxp ->max var in param space */ + double Ival, Tval, Eval; Ncount++; - x = TS.XAxis*(0.5-rand01()); /* Get point on shutter enterance */ - y = TS.ZAxis*(0.5-rand01()); /* Get point on shutter enterance */ - - - xf = focus_xw*(0.5-rand01()); /* Choose focusing position uniformly */ - yf = focus_yh*(0.5-rand01()); /* Choose focusing position uniformly */ + x = TS.XAxis * (0.5 - rand01 ()); /* Get point on shutter enterance */ + y = TS.ZAxis * (0.5 - rand01 ()); /* Get point on shutter enterance */ - getPoint(&Tval,&Eval,&rtE0,&rtE1, TS, _particle); - - Ival=TS.Total*6.2415093e+12; // Number of proton in 1uAmp + xf = focus_xw * (0.5 - rand01 ()); /* Choose focusing position uniformly */ + yf = focus_yh * (0.5 - rand01 ()); /* Choose focusing position uniformly */ - dx = xf-x; - dy = yf-y; - r = sqrt(dx*dx+dy*dy+dist*dist); // Actual distance to point - v = SE2V*sqrt(Eval); // Calculate the velocity - vz = v*fabs(dist)/r; - vy = v*dy/r; - vx = v*dx/r; + getPoint (&Tval, &Eval, &rtE0, &rtE1, TS, _particle); + Ival = TS.Total * 6.2415093e+12; // Number of proton in 1uAmp - t=Tval-(TS.rdumMid-TS.timeOffset)/vz; - - if (modPosition) - { - t+=TS.rdumMid/vz; - } + dx = xf - x; + dy = yf - y; + r = sqrt (dx * dx + dy * dy + dist * dist); // Actual distance to point + v = SE2V * sqrt (Eval); // Calculate the velocity + vz = v * fabs (dist) / r; + vy = v * dy / r; + vx = v * dx / r; - p=beamcurrent*angleArea*Ival/Nsim; + t = Tval - (TS.rdumMid - TS.timeOffset) / vz; + if (modPosition) { + t += TS.rdumMid / vz; + } -#ifndef OPENACC - if (verbose && !(Ncount % 100000)) - { - fprintf(stderr,"FPos[%d]=> %g %g %g \n",Ncount,x,y,z); - fprintf(stderr,"FDir[%d]=> %g %g %g \n",Ncount,vx,vy,vz); - fprintf(stderr,"PlaneAxis %g %g \n",TS.XAxis,fullAngle); - fprintf(stderr,"RMID %g \n",TS.rdumMid); - fprintf(stderr,"TimeMid[%d]=> %g\n",Ncount,TS.rdumMid); - fprintf(stderr,"TimeOffset[%d]=> %g\n",Ncount,TS.timeOffset); - fprintf(stderr,"TimeTval[%d]=> %g\n",Ncount,Tval); - fprintf(stderr,"TimeZero[%d]=> %g\n",Ncount,t); - } -#endif + p = beamcurrent * angleArea * Ival / Nsim; + + #ifndef OPENACC + if (verbose && !(Ncount % 100000)) { + fprintf (stderr, "FPos[%d]=> %g %g %g \n", Ncount, x, y, z); + fprintf (stderr, "FDir[%d]=> %g %g %g \n", Ncount, vx, vy, vz); + fprintf (stderr, "PlaneAxis %g %g \n", TS.XAxis, fullAngle); + fprintf (stderr, "RMID %g \n", TS.rdumMid); + fprintf (stderr, "TimeMid[%d]=> %g\n", Ncount, TS.rdumMid); + fprintf (stderr, "TimeOffset[%d]=> %g\n", Ncount, TS.timeOffset); + fprintf (stderr, "TimeTval[%d]=> %g\n", Ncount, Tval); + fprintf (stderr, "TimeZero[%d]=> %g\n", Ncount, t); + } + #endif %} MCDISPLAY %{ - double cirp=0.0,cirq=0.3,pi=3.141592654; - int pp=0; /* circle drawing parameter*/ - + double cirp = 0.0, cirq = 0.3, pi = 3.141592654; + int pp = 0; /* circle drawing parameter*/ - - magnify("xy"); - multiline(5,-0.5*TS.XAxis,-0.5*TS.ZAxis,0.0, - 0.5*TS.XAxis,-0.5*TS.ZAxis,0.0, - 0.5*TS.XAxis,0.5*TS.ZAxis,0.0, - -0.5*TS.XAxis,0.5*TS.ZAxis,0.0, - -0.5*TS.XAxis,-0.5*TS.ZAxis,0.0); + magnify ("xy"); + multiline (5, -0.5 * TS.XAxis, -0.5 * TS.ZAxis, 0.0, 0.5 * TS.XAxis, -0.5 * TS.ZAxis, 0.0, 0.5 * TS.XAxis, 0.5 * TS.ZAxis, 0.0, -0.5 * TS.XAxis, 0.5 * TS.ZAxis, + 0.0, -0.5 * TS.XAxis, -0.5 * TS.ZAxis, 0.0); /* circle("xy",0.0,0.0,0.0,cos(cirp)); */ /*line(0.5*sin(cirp),0.0,0.5*cos(cirp),0.5*sin(cirq),0.0,0.5*cos(cirq));*/ /*line(-0.5,0.0,0.0,0.0,0.0,0.5);*/ - for (pp=0;pp<=20;pp=pp+2) - { - cirp= (pp*(pi/21.0))-(0.5*pi); - cirq= ((pp+1)*(pi/21.0))-(0.5*pi); - line(0.5*sin(cirp),0.0,0.5*cos(cirp),0.5*sin(cirq),0.0,0.5*cos(cirq)); - } - + for (pp = 0; pp <= 20; pp = pp + 2) { + cirp = (pp * (pi / 21.0)) - (0.5 * pi); + cirq = ((pp + 1) * (pi / 21.0)) - (0.5 * pi); + line (0.5 * sin (cirp), 0.0, 0.5 * cos (cirp), 0.5 * sin (cirq), 0.0, 0.5 * cos (cirq)); + } %} END diff --git a/mcstas-comps/contrib/multi_pipe.comp b/mcstas-comps/contrib/multi_pipe.comp index d74c0c5c4..5cb531659 100644 --- a/mcstas-comps/contrib/multi_pipe.comp +++ b/mcstas-comps/contrib/multi_pipe.comp @@ -56,307 +56,300 @@ SHARE DECLARE %{ -t_Table pTable; -int user_file; -int ynum; -int xnum; -double diam; -double w_pipe; -double h_pipe; -int h_number; + t_Table pTable; + int user_file; + int ynum; + int xnum; + double diam; + double w_pipe; + double h_pipe; + int h_number; %} INITIALIZE %{ -char file_name[1024]; -char *pos; -char *fu; -int check; + char file_name[1024]; + char* pos; + char* fu; + int check; -if (xwidth > 0) { xmax = xwidth/2; xmin = -xmax; } - if (yheight > 0) { ymax = yheight/2; ymin = -ymax; } + if (xwidth > 0) { + xmax = xwidth / 2; + xmin = -xmax; + } + if (yheight > 0) { + ymax = yheight / 2; + ymin = -ymax; + } - if (xmin == 0 && xmax == 0 && ymin == 0 && ymax == 0 && radius == 0 && gap==0) - { fprintf(stderr,"multi_pipe: %s: Error: give geometry\n", NAME_CURRENT_COMP); exit(-1); } - user_file=0; + if (xmin == 0 && xmax == 0 && ymin == 0 && ymax == 0 && radius == 0 && gap == 0) { + fprintf (stderr, "multi_pipe: %s: Error: give geometry\n", NAME_CURRENT_COMP); + exit (-1); + } + user_file = 0; if (filename != NULL) { - fu=(char*)malloc(sizeof(char)*(strlen(filename)+1)); - strcpy(fu,filename); + fu = (char*)malloc (sizeof (char) * (strlen (filename) + 1)); + strcpy (fu, filename); - user_file=1; + user_file = 1; - Table_Read(&pTable, fu, 1); /* read 1st block data from file into pTable */ - if (pTable.rows < 2) Table_Free(&pTable); - Table_Info(pTable); - free(fu); + Table_Read (&pTable, fu, 1); /* read 1st block data from file into pTable */ + if (pTable.rows < 2) + Table_Free (&pTable); + Table_Info (pTable); + free (fu); } else { /* no user file is set */ /* calculate the number of holes */ - diam=2*radius; - w_pipe=xmax-xmin; - h_pipe=ymax-ymin; - xnum = (int) (w_pipe/(diam+gap)); - ynum = (int) (h_pipe/(diam+gap)); - h_number= xnum*ynum; - fprintf(stderr,"multi_pipe-hole number: %d\n", h_number); - user_file=2; + diam = 2 * radius; + w_pipe = xmax - xmin; + h_pipe = ymax - ymin; + xnum = (int)(w_pipe / (diam + gap)); + ynum = (int)(h_pipe / (diam + gap)); + h_number = xnum * ynum; + fprintf (stderr, "multi_pipe-hole number: %d\n", h_number); + user_file = 2; } %} TRACE %{ - int check1,check2; - double test_pipes; - double test_pipe2; - double xl,yl,dt0; - int i,ii; - int valuex,valuey; - int even_x,even_y; + int check1, check2; + double test_pipes; + double test_pipe2; + double xl, yl, dt0; + int i, ii; + int valuex, valuey; + int even_x, even_y; - PROP_Z0; - if (xxmax || yymax) { - /* neutrons outside of component */ - ABSORB; - } else { - if (user_file==1) { - /* use file data */ - if (pTable.data != NULL) - { - double uradius; - - check1=0; - check2=0; + PROP_Z0; + if (x < xmin || x > xmax || y < ymin || y > ymax) { + /* neutrons outside of component */ + ABSORB; + } else { + if (user_file == 1) { + /* use file data */ + if (pTable.data != NULL) { + double uradius; - for (i=0;i (uradius*uradius)) { - check2=1; - ABSORB; - } + check1 = 0; + check2 = 0; - } - break; - } - } - } - } else if (user_file==2) { - /* automatic generated holes */ - /* inside component - proof whether the neutrons come into a hole */ - valuex=0; - even_x = (xnum % 2); - /* check if xnum is odd or even */ - if (even_x==0) { - valuex=1; - } else { - valuex=2; - } - valuey=0; - even_y = (ynum % 2); - /* check if ynum is odd or even */ - if (even_y==0) { - /* even */ - valuey=1; - } else { - valuey=2; - } - test_pipes=0; - check1=0; - for(i=-(xnum/2);i<(xnum/2+1);i++) - { - /* calculate local coordiantes */ - if (valuex==1) { - if (i==xnum/2) { - /* outside */ - } else { - xl=i*(diam+gap)+radius+gap/2.0; - } - } else { - xl=i*(diam+gap); - } - /* fprintf(stderr,"xl: %f\n", xl); */ - for (ii=-(ynum/2);ii<(ynum/2+1);ii++) - { - if (valuey==1) { - if (ii==ynum/2) { - /* ouside */ - } else { - yl=ii*(diam+gap)+radius+gap/2; - test_pipes=((x-xl)*(x-xl))+((y-yl)*(y-yl)); - if (test_pipes < (radius*radius)) { - check1=1; - if (thickness==0) { - /* nothing to do */ - } else { - /* check if neutron absorb inside the component */ - dt0=thickness/vz; - PROP_DT(dt0); - check2=0; - test_pipe2=((x-xl)*(x-xl))+((y-yl)*(y-yl)); - if (test_pipe2 > (radius*radius)) { - check2=1; - ABSORB; - } - } - break; - } - } - } else { - yl=ii*(diam+gap); - test_pipes=((x-xl)*(x-xl))+((y-yl)*(y-yl)); - if (test_pipes < (radius*radius)) { - check1=1; - if (thickness==0) { - /* nothing to do */ - } else { - /* check if neutron absorb inside the component */ - dt0=thickness/vz; - PROP_DT(dt0); - check2=0; - test_pipe2=((x-xl)*(x-xl))+((y-yl)*(y-yl)); - if (test_pipe2 > (radius*radius)) { - check2=1; - ABSORB; - } - } - break; - } - } - } - } + for (i = 0; i < pTable.rows; i++) { + xl = Table_Index (pTable, i, 0); /* 1st column */ + yl = Table_Index (pTable, i, 1); /* 2nd column */ + uradius = Table_Index (pTable, i, 2); /* 3rd column */ + test_pipes = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipes < (uradius * uradius)) { + check1 = 1; + if (thickness == 0) { + /* nothing to do */ + } else { + /* check if neutron absorb inside the component */ + dt0 = thickness / vz; + PROP_DT (dt0); + check2 = 0; + test_pipe2 = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipe2 > (uradius * uradius)) { + check2 = 1; + ABSORB; + } + } + break; + } + } } - if (check1==1) { - SCATTER; + } else if (user_file == 2) { + /* automatic generated holes */ + /* inside component - proof whether the neutrons come into a hole */ + valuex = 0; + even_x = (xnum % 2); + /* check if xnum is odd or even */ + if (even_x == 0) { + valuex = 1; + } else { + valuex = 2; + } + valuey = 0; + even_y = (ynum % 2); + /* check if ynum is odd or even */ + if (even_y == 0) { + /* even */ + valuey = 1; } else { - ABSORB; + valuey = 2; + } + test_pipes = 0; + check1 = 0; + for (i = -(xnum / 2); i < (xnum / 2 + 1); i++) { + /* calculate local coordiantes */ + if (valuex == 1) { + if (i == xnum / 2) { + /* outside */ + } else { + xl = i * (diam + gap) + radius + gap / 2.0; + } + } else { + xl = i * (diam + gap); + } + /* fprintf(stderr,"xl: %f\n", xl); */ + for (ii = -(ynum / 2); ii < (ynum / 2 + 1); ii++) { + if (valuey == 1) { + if (ii == ynum / 2) { + /* ouside */ + } else { + yl = ii * (diam + gap) + radius + gap / 2; + test_pipes = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipes < (radius * radius)) { + check1 = 1; + if (thickness == 0) { + /* nothing to do */ + } else { + /* check if neutron absorb inside the component */ + dt0 = thickness / vz; + PROP_DT (dt0); + check2 = 0; + test_pipe2 = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipe2 > (radius * radius)) { + check2 = 1; + ABSORB; + } + } + break; + } + } + } else { + yl = ii * (diam + gap); + test_pipes = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipes < (radius * radius)) { + check1 = 1; + if (thickness == 0) { + /* nothing to do */ + } else { + /* check if neutron absorb inside the component */ + dt0 = thickness / vz; + PROP_DT (dt0); + check2 = 0; + test_pipe2 = ((x - xl) * (x - xl)) + ((y - yl) * (y - yl)); + if (test_pipe2 > (radius * radius)) { + check2 = 1; + ABSORB; + } + } + break; + } + } + } } - } + } + if (check1 == 1) { + SCATTER; + } else { + ABSORB; + } + } %} FINALLY %{ - Table_Free(&pTable); + Table_Free (&pTable); %} MCDISPLAY %{ - int even_x,even_y; - int valuex,valuey; - double xl,yl; - int i,ii; + int even_x, even_y; + int valuex, valuey; + double xl, yl; + int i, ii; t_Table plot_table; double uradius; - char *fu2; + char* fu2; - - multiline(5, - xmin, ymin, 0.0, - xmax, ymin, 0.0, - xmax, ymax, 0.0, - xmin, ymax, 0.0, - xmin, ymin, 0.0); + multiline (5, xmin, ymin, 0.0, xmax, ymin, 0.0, xmax, ymax, 0.0, xmin, ymax, 0.0, xmin, ymin, 0.0); if (thickness > 0) { - multiline(5, - xmin, ymin, (double)thickness, - xmax, ymin, (double)thickness, - xmax, ymax, (double)thickness, - xmin, ymax, (double)thickness, - xmin, ymin, (double)thickness); - line(xmin, ymin, 0, xmin, ymin, (double)thickness); - line(xmax, ymin, 0, xmax, ymin, (double)thickness); - line(xmax, xmax, 0, xmax, ymax, (double)thickness); - line(xmin, xmax, 0, xmin, ymax, (double)thickness); + multiline (5, xmin, ymin, (double)thickness, xmax, ymin, (double)thickness, xmax, ymax, (double)thickness, xmin, ymax, (double)thickness, xmin, ymin, + (double)thickness); + line (xmin, ymin, 0, xmin, ymin, (double)thickness); + line (xmax, ymin, 0, xmax, ymin, (double)thickness); + line (xmax, xmax, 0, xmax, ymax, (double)thickness); + line (xmin, xmax, 0, xmin, ymax, (double)thickness); } - if (user_file==1) { - /* open user file */ - if (filename != NULL) { - fu2=(char*)malloc(sizeof(char)*(strlen(filename)+1)); - strcpy(fu2,filename); - Table_Read(&plot_table, fu2, 1); /* read 1st block data from file into pTable */ - if (plot_table.rows < 2) Table_Free(&plot_table); - Table_Info(plot_table); - free(fu2); - for (i=0;i 0 ) { - circle("xy", xl, yl, (double)thickness, uradius); - } - } - } - Table_Free(&plot_table); - - } else if (user_file==2) { - valuex=0; - even_x = (xnum % 2); - /* check if xnum is odd or even */ - if (even_x==0) { - valuex=1; - } else { - valuex=2; + if (user_file == 1) { + /* open user file */ + if (filename != NULL) { + fu2 = (char*)malloc (sizeof (char) * (strlen (filename) + 1)); + strcpy (fu2, filename); + Table_Read (&plot_table, fu2, 1); /* read 1st block data from file into pTable */ + if (plot_table.rows < 2) + Table_Free (&plot_table); + Table_Info (plot_table); + free (fu2); + for (i = 0; i < plot_table.rows; i++) { + xl = Table_Index (plot_table, i, 0); /* 1st column */ + yl = Table_Index (plot_table, i, 1); /* 2nd column */ + uradius = Table_Index (plot_table, i, 2); /* 3rd column */ + circle ("xy", xl, yl, 0, uradius); + if (thickness > 0) { + circle ("xy", xl, yl, (double)thickness, uradius); + } } - valuey=0; - even_y = (ynum % 2); - /* check if ynum is odd or even */ - if (even_y==0) { - /* even */ - valuey=1; + } + Table_Free (&plot_table); + + } else if (user_file == 2) { + valuex = 0; + even_x = (xnum % 2); + /* check if xnum is odd or even */ + if (even_x == 0) { + valuex = 1; + } else { + valuex = 2; + } + valuey = 0; + even_y = (ynum % 2); + /* check if ynum is odd or even */ + if (even_y == 0) { + /* even */ + valuey = 1; + } else { + valuey = 2; + } + for (i = -(xnum / 2); i < (xnum / 2 + 1); i++) { + /* calculate local coordiantes */ + if (valuex == 1) { + if (i == xnum / 2) { + /* outside */ + } else { + xl = i * (2 * radius + gap) + radius + gap / 2.0; + } } else { - valuey=2; + xl = i * (2 * radius + gap); } - for(i=-(xnum/2);i<(xnum/2+1);i++) - { - /* calculate local coordiantes */ - if (valuex==1) { - if (i==xnum/2) - { - /* outside */ - } else { - xl=i*(2*radius+gap)+radius+gap/2.0; - } + for (ii = -(ynum / 2); ii < (ynum / 2 + 1); ii++) { + if (valuey == 1) { + if (ii == ynum / 2) { + /* ouside */ } else { - xl=i*(2*radius+gap); + yl = ii * (2 * radius + gap) + radius + gap / 2; + circle ("xy", xl, yl, 0, radius); + if (thickness > 0) { + circle ("xy", xl, yl, (double)thickness, radius); + } } - for (ii=-(ynum/2);ii<(ynum/2+1);ii++) - { - if (valuey==1) { - if (ii==ynum/2) { - /* ouside */ - } else { - yl=ii*(2*radius+gap)+radius+gap/2; - circle("xy", xl, yl, 0, radius); - if (thickness > 0 ) { - circle("xy", xl, yl, (double)thickness, radius); - } - } - } else { - yl=ii*(2*radius+gap); - circle("xy", xl, yl, 0, radius); - if (thickness > 0 ) { - circle("xy", xl, yl, (double)thickness, radius); - } - } + } else { + yl = ii * (2 * radius + gap); + circle ("xy", xl, yl, 0, radius); + if (thickness > 0) { + circle ("xy", xl, yl, (double)thickness, radius); } + } } - } + } + } %} END