From b2d92fe8af4ac1564f4cb8b117744597a06fd05d Mon Sep 17 00:00:00 2001 From: Peter Willendrup Date: Tue, 17 Feb 2026 19:21:47 +0100 Subject: [PATCH] Apply formatter to samples --- mcstas-comps/samples/Incoherent.comp | 422 +- mcstas-comps/samples/Isotropic_Sqw.comp | 4578 +++++++++-------- mcstas-comps/samples/Magnon_bcc.comp | 806 ++- mcstas-comps/samples/NCrystal_sample.comp | 290 +- mcstas-comps/samples/Phonon_simple.comp | 635 ++- mcstas-comps/samples/Powder1.comp | 181 +- mcstas-comps/samples/PowderN.comp | 1570 +++--- mcstas-comps/samples/SANS_spheres2.comp | 382 +- mcstas-comps/samples/Sans_spheres.comp | 170 +- mcstas-comps/samples/SasView_model.comp | 196 +- mcstas-comps/samples/Single_crystal.comp | 2070 ++++---- .../samples/Single_magnetic_crystal.comp | 1112 ++-- mcstas-comps/samples/TOFRes_sample.comp | 269 +- mcstas-comps/samples/Tunneling_sample.comp | 327 +- 14 files changed, 6462 insertions(+), 6546 deletions(-) diff --git a/mcstas-comps/samples/Incoherent.comp b/mcstas-comps/samples/Incoherent.comp index c87c3f8215..0397c42930 100644 --- a/mcstas-comps/samples/Incoherent.comp +++ b/mcstas-comps/samples/Incoherent.comp @@ -125,20 +125,19 @@ sigma_abs=5.08, sigma_inc=5.08, Vc=13.827, concentric=0, order=0) SHARE %{ -%include "read_table-lib" -%include "interoff-lib" -struct StructVarsInc -{ -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; - int shape; /* 0 cylinder, 1 box, 2 sphere, 3 OFF file */ - double aw,ah; /* rectangular angular dimensions */ - double xw,yh; /* rectangular metrical dimensions */ - double tx,ty,tz; /* target coords */ - }; + %include "read_table-lib" + %include "interoff-lib" + struct StructVarsInc { + 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; + int shape; /* 0 cylinder, 1 box, 2 sphere, 3 OFF file */ + double aw, ah; /* rectangular angular dimensions */ + double xw, yh; /* rectangular metrical dimensions */ + double tx, ty, tz; /* target coords */ + }; %} DECLARE @@ -149,103 +148,115 @@ DECLARE INITIALIZE %{ - VarsInc.shape=-1; /* -1:no shape, 0:cyl, 1:box, 2:sphere, 3:any-shape */ - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { + VarsInc.shape = -1; /* -1:no shape, 0:cyl, 1:box, 2:sphere, 3:any-shape */ + 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 - if (off_init(geometry, xwidth, yheight, zdepth, 0, &offdata)) { - VarsInc.shape=3; thickness=0; concentric=0; + if (off_init (geometry, xwidth, yheight, zdepth, 0, &offdata)) { + VarsInc.shape = 3; + thickness = 0; + concentric = 0; } #endif - } - else if (xwidth && yheight && zdepth) VarsInc.shape=1; /* box */ - else if (radius > 0 && yheight) VarsInc.shape=0; /* cylinder */ - else if (radius > 0 && !yheight) VarsInc.shape=2; /* sphere */ + } else if (xwidth && yheight && zdepth) + VarsInc.shape = 1; /* box */ + else if (radius > 0 && yheight) + VarsInc.shape = 0; /* cylinder */ + else if (radius > 0 && !yheight) + VarsInc.shape = 2; /* sphere */ if (VarsInc.shape < 0) - exit(fprintf(stderr,"Incoherent: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "Incoherent: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); if (thickness) { - if (radius && (radius < thickness || ( yheight && (yheight < 2*thickness)))) { - fprintf(stderr,"Incoherent: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" - "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", NAME_CURRENT_COMP); - thickness=0; - } - else if (!radius && (xwidth < 2*thickness || yheight < 2*thickness || zdepth < 2*thickness)) { - fprintf(stderr,"Incoherent: %s: hollow sample thickness is larger than its volume (box).\n" - "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", NAME_CURRENT_COMP); - thickness=0; + if (radius && (radius < thickness || (yheight && (yheight < 2 * thickness)))) { + fprintf (stderr, + "Incoherent: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" + "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", + NAME_CURRENT_COMP); + thickness = 0; + } else if (!radius && (xwidth < 2 * thickness || yheight < 2 * thickness || zdepth < 2 * thickness)) { + fprintf (stderr, + "Incoherent: %s: hollow sample thickness is larger than its volume (box).\n" + "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", + NAME_CURRENT_COMP); + thickness = 0; } } - if (concentric && thickness<=0) { - printf("Incoherent: %s:Can not use concentric mode\n" - "WARNING on non hollow shape. Ignoring.\n", - NAME_CURRENT_COMP); - concentric=0; + if (concentric && thickness <= 0) { + printf ("Incoherent: %s:Can not use concentric mode\n" + "WARNING on non hollow shape. Ignoring.\n", + NAME_CURRENT_COMP); + concentric = 0; } - VarsInc.sigma_a= sigma_abs; - VarsInc.sigma_i= sigma_inc; - VarsInc.rho = (pack/Vc); - VarsInc.my_s = (VarsInc.rho * 100 * VarsInc.sigma_i); + VarsInc.sigma_a = sigma_abs; + VarsInc.sigma_i = sigma_inc; + VarsInc.rho = (pack / Vc); + VarsInc.my_s = (VarsInc.rho * 100 * VarsInc.sigma_i); VarsInc.my_a_v = (VarsInc.rho * 100 * VarsInc.sigma_a); /* now compute target coords if a component index is supplied */ - VarsInc.tx= VarsInc.ty=VarsInc.tz=0; - if (!target_index && !target_x && !target_y && !target_z) target_index=1; - if (target_index) - { + VarsInc.tx = VarsInc.ty = VarsInc.tz = 0; + if (!target_index && !target_x && !target_y && !target_z) + target_index = 1; + 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, &VarsInc.tx, &VarsInc.ty, &VarsInc.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, &VarsInc.tx, &VarsInc.ty, &VarsInc.tz); + } else { + VarsInc.tx = target_x; + VarsInc.ty = target_y; + VarsInc.tz = target_z; } - else - { VarsInc.tx = target_x; VarsInc.ty = target_y; VarsInc.tz = target_z; } if (!(VarsInc.tx || VarsInc.ty || VarsInc.tz)) { - MPI_MASTER( - printf("Incoherent: %s: The target is not defined. Using direct beam (Z-axis).\n", - NAME_CURRENT_COMP); - ); - VarsInc.tz=1; + MPI_MASTER (printf ("Incoherent: %s: The target is not defined. Using direct beam (Z-axis).\n", NAME_CURRENT_COMP);); + VarsInc.tz = 1; } /* different ways of setting rectangular area */ - VarsInc.aw = VarsInc.ah = 0; - if (focus_xw) { VarsInc.xw = focus_xw; } - if (focus_yh) { VarsInc.yh = focus_yh; } - if (focus_aw) { VarsInc.aw = DEG2RAD*focus_aw; } - if (focus_ah) { VarsInc.ah = DEG2RAD*focus_ah; } - - MPI_MASTER( - printf("Incoherent: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn]\n", - NAME_CURRENT_COMP, Vc, VarsInc.sigma_a, VarsInc.sigma_i); - ); + VarsInc.aw = VarsInc.ah = 0; + if (focus_xw) { + VarsInc.xw = focus_xw; + } + if (focus_yh) { + VarsInc.yh = focus_yh; + } + if (focus_aw) { + VarsInc.aw = DEG2RAD * focus_aw; + } + if (focus_ah) { + VarsInc.ah = DEG2RAD * focus_ah; + } + MPI_MASTER (printf ("Incoherent: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn]\n", NAME_CURRENT_COMP, Vc, VarsInc.sigma_a, VarsInc.sigma_i);); %} TRACE %{ - double t0, t3; /* Entry/exit time for outer surface */ - double t1, t2; /* Entry/exit time for inner surface */ - double dt0, dt1, dt2, dt; /* Flight times through sample */ - double v=0; /* Neutron velocity */ - double d_path; /* Flight path length for non-scattered neutron */ - double l_i, l_o=0; /* Flight path lenght in/out for scattered neutron */ - double my_a=0,my_t=0; /* Velocity-dependent attenuation factor and total Xsec */ - double solid_angle=0; /* Solid angle of target as seen from scattering point */ - double aim_x=0, aim_y=0, aim_z=1; /* Position of target relative to scattering point */ - double v_i, v_f, E_i, E_f; /* initial and final energies and velocities */ - double dE; /* Energy transfer */ - int intersect=0; - int flag_concentric=0; - int flag=0; + double t0, t3; /* Entry/exit time for outer surface */ + double t1, t2; /* Entry/exit time for inner surface */ + double dt0, dt1, dt2, dt; /* Flight times through sample */ + double v = 0; /* Neutron velocity */ + double d_path; /* Flight path length for non-scattered neutron */ + double l_i, l_o = 0; /* Flight path lenght in/out for scattered neutron */ + double my_a = 0, my_t = 0; /* Velocity-dependent attenuation factor and total Xsec */ + double solid_angle = 0; /* Solid angle of target as seen from scattering point */ + double aim_x = 0, aim_y = 0, aim_z = 1; /* Position of target relative to scattering point */ + double v_i, v_f, E_i, E_f; /* initial and final energies and velocities */ + double dE; /* Energy transfer */ + int intersect = 0; + int flag_concentric = 0; + int flag = 0; double mc_trans, p_trans, mc_scatt, p_scatt, ws; - double p_mult=1; + double p_mult = 1; #ifdef OPENACC #ifdef USE_OFF @@ -254,63 +265,66 @@ TRACE #else #define thread_offdata offdata #endif - + do { /* Main interaction loop. Ends with intersect=0 */ /* Intersection neutron trajectory / sample (sample surface) */ if (VarsInc.shape == 0) - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); else if (VarsInc.shape == 1) - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else if (VarsInc.shape == 2) - intersect = sphere_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius); + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); #ifdef USE_OFF else if (VarsInc.shape == 3) - intersect = off_intersect(&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); #endif - + if (intersect) { int flag_ishollow = 0; - if (thickness>0) { - if (VarsInc.shape==0 && cylinder_intersect(&t1,&t2, x,y,z,vx,vy,vz, radius-thickness,yheight-2*thickness)) - flag_ishollow=1; - else if (VarsInc.shape==2 && sphere_intersect (&t1,&t2, x,y,z,vx,vy,vz, radius-thickness)) - flag_ishollow=1; - else if (VarsInc.shape==1 && box_intersect(&t1,&t2, x,y,z,vx,vy,vz, xwidth-2*thickness, yheight-2*thickness, zdepth-2*thickness)) + if (thickness > 0) { + if (VarsInc.shape == 0 && cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness, yheight - 2 * thickness)) + flag_ishollow = 1; + else if (VarsInc.shape == 2 && sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness)) + flag_ishollow = 1; + else if (VarsInc.shape == 1 && box_intersect (&t1, &t2, x, y, z, vx, vy, vz, xwidth - 2 * thickness, yheight - 2 * thickness, zdepth - 2 * thickness)) flag_ishollow = 1; } - if (!flag_ishollow) t1 = t2 = t3; /* no empty space inside */ + if (!flag_ishollow) + t1 = t2 = t3; /* no empty space inside */ - dt0 = t1-t0; /* Time in sample, ingoing */ - dt1 = t2-t1; /* Time in hole */ - dt2 = t3-t2; /* Time in sample, outgoing */ + dt0 = t1 - t0; /* Time in sample, ingoing */ + dt1 = t2 - t1; /* Time in hole */ + dt2 = t3 - t2; /* Time in sample, outgoing */ - if (t0 > 0) { /* we are before the sample */ - PROP_DT(t0); /* propagates neutron to the entry of the sample */ + if (t0 > 0) { /* we are before the sample */ + PROP_DT (t0); /* propagates neutron to the entry of the sample */ } else if (t1 > 0 && t1 > t0) { /* we are inside first part of the sample */ /* no propagation, stay inside */ } else if (t2 > 0 && t2 > t1) { /* we are in the hole */ - PROP_DT(t2); /* propagate to inner surface of 2nd part of sample */ + PROP_DT (t2); /* propagate to inner surface of 2nd part of sample */ } else if (t3 > 0 && t3 > t2) { /* we are in the 2nd part of sample */ /* no propagation, stay inside */ } - dt0=t1-(t0 > 0 ? t0 : 0); /* Time in first part of hollow/cylinder/box */ - dt1=t2-(t1 > 0 ? t1 : 0); /* Time in hole */ - dt2=t3-(t2 > 0 ? t2 : 0); /* Time in 2nd part of hollow cylinder */ + dt0 = t1 - (t0 > 0 ? t0 : 0); /* Time in first part of hollow/cylinder/box */ + dt1 = t2 - (t1 > 0 ? t1 : 0); /* Time in hole */ + dt2 = t3 - (t2 > 0 ? t2 : 0); /* Time in 2nd part of hollow cylinder */ - if (dt0 < 0) dt0 = 0; - if (dt1 < 0) dt1 = 0; - if (dt2 < 0) dt2 = 0; + if (dt0 < 0) + dt0 = 0; + if (dt1 < 0) + dt1 = 0; + if (dt2 < 0) + dt2 = 0; /* initialize concentric mode */ - if (concentric && !flag_concentric && t0 >= 0 - && VarsInc.shape==0 && thickness>0) { - flag_concentric=1; + if (concentric && !flag_concentric && t0 >= 0 && VarsInc.shape == 0 && thickness > 0) { + flag_concentric = 1; } if (flag_concentric == 1) { - dt1=dt2=0; /* force exit when reaching hole/2nd part */ + dt1 = dt2 = 0; /* force exit when reaching hole/2nd part */ } if (!dt0 && !dt2) { @@ -319,108 +333,112 @@ TRACE } p_mult = 1; - if (!v) v = sqrt(vx*vx + vy*vy + vz*vz); - if (v) my_a = VarsInc.my_a_v*(2200/v); + if (!v) + v = sqrt (vx * vx + vy * vy + vz * vz); + if (v) + my_a = VarsInc.my_a_v * (2200 / v); else { - printf("Incoherent: %s: ERROR: Null velocity\n",NAME_CURRENT_COMP); + printf ("Incoherent: %s: ERROR: Null velocity\n", NAME_CURRENT_COMP); ABSORB; /* should never occur */ } - my_t = my_a + VarsInc.my_s; /* total scattering Xsect (tmp var) */ + my_t = my_a + VarsInc.my_s; /* total scattering Xsect (tmp var) */ if (my_t <= 0) { - printf("Incoherent: %s: ERROR: Null total cross section %g. Removing event.\n", - NAME_CURRENT_COMP, my_t); + printf ("Incoherent: %s: ERROR: Null total cross section %g. Removing event.\n", NAME_CURRENT_COMP, my_t); ABSORB; /* should never occur */ } - d_path = v * (dt0 + dt2); /* Length of full path through sample */ - + d_path = v * (dt0 + dt2); /* Length of full path through sample */ + /* Proba of scattering vs absorption (integrating along the whole trajectory) */ - ws = VarsInc.my_s/my_t; /* (inc+coh)/(inc+coh+abs) */ + ws = VarsInc.my_s / my_t; /* (inc+coh)/(inc+coh+abs) */ /* Proba of transmission along length d_path */ - p_trans = exp(-my_t*d_path); + p_trans = exp (-my_t * d_path); p_scatt = 1 - p_trans; /* portion of beam which scatters */ - flag = 0; /* flag used for propagation to exit point before ending */ + flag = 0; /* flag used for propagation to exit point before ending */ /* are we next to the exit ? probably no scattering (avoid rounding errors) */ - if (VarsInc.my_s*d_path <= 4e-7) { - flag = 1; /* No interaction before the exit */ + if (VarsInc.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) { + 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) */ - if (!SCATTERED) mc_trans = 1-p_interact; - else mc_trans = 1-p_interact/(4*SCATTERED+1); /* reduce effect on multi scatt */ + if (!SCATTERED) + mc_trans = 1 - p_interact; + else + mc_trans = 1 - p_interact / (4 * SCATTERED + 1); /* reduce effect on multi scatt */ } else { mc_trans = p_trans; /* 1 - p_scatt */ } mc_scatt = 1 - mc_trans; /* portion of beam to scatter (or force to) */ - if (mc_scatt <= 0 || mc_scatt>1) flag=1; + if (mc_scatt <= 0 || mc_scatt > 1) + flag = 1; /* 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 */ - if (!mc_scatt) ABSORB; + 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 */ + if (!mc_scatt) + ABSORB; /* 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 */ + p_mult *= fabs (p_scatt / mc_scatt); /* lower than 1 */ } else { flag = 1; /* Transmission : no interaction neutron/sample */ - if (!mc_trans) ABSORB; - p_mult *= fabs(p_trans/mc_trans); /* attenuate beam by portion which is scattered (and left along) */ + if (!mc_trans) + ABSORB; + p_mult *= fabs (p_trans / mc_trans); /* attenuate beam by portion which is scattered (and left along) */ } if (flag) { /* propagate to exit of sample and finish */ intersect = 0; p *= p_mult; /* apply absorption correction */ - PROP_DT(dt0+dt2); + PROP_DT (dt0 + dt2); break; /* exit main multi scatt while loop */ } - 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 (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 - dt = -log(1 - rand0max((1 - exp(-my_t*d_path)))) / my_t; /* length */ - l_i = dt;/* Penetration in sample: scattering+abs */ - dt /= v; /* Time from present position to scattering point */ + dt = -log (1 - rand0max ((1 - exp (-my_t * d_path)))) / my_t; /* length */ + l_i = dt; /* Penetration in sample: scattering+abs */ + dt /= v; /* Time from present position to scattering point */ /* If t0 is in hole, propagate to next part of the hollow cylinder */ - if (dt1 > 0 && dt0 > 0 && dt > dt0) dt += dt1; - PROP_DT(dt); /* Point of scattering */ - + if (dt1 > 0 && dt0 > 0 && dt > dt0) + dt += dt1; + PROP_DT (dt); /* Point of scattering */ if ((VarsInc.tx || VarsInc.ty || VarsInc.tz)) { - aim_x = VarsInc.tx-x; /* Vector pointing at target (anal./det.) */ - aim_y = VarsInc.ty-y; - aim_z = VarsInc.tz-z; + aim_x = VarsInc.tx - x; /* Vector pointing at target (anal./det.) */ + aim_y = VarsInc.ty - y; + aim_z = VarsInc.tz - z; } - if(VarsInc.aw && VarsInc.ah) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, VarsInc.aw, VarsInc.ah, ROT_A_CURRENT_COMP); - } else if(VarsInc.xw && VarsInc.yh) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, VarsInc.xw, VarsInc.yh, ROT_A_CURRENT_COMP); + if (VarsInc.aw && VarsInc.ah) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, VarsInc.aw, VarsInc.ah, ROT_A_CURRENT_COMP); + } else if (VarsInc.xw && VarsInc.yh) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, VarsInc.xw, VarsInc.yh, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); } - NORM(vx, vy, vz); - - v_i = v; /* Store initial velocity in case of quasielastic */ - E_i = VS2E*v_i*v_i; - if (deltaE==0) { - if (rand01()= order) { - intersect=0; /* reached required number of SCATTERing */ - break; /* finish multiple scattering loop */ + intersect = 0; /* reached required number of SCATTERing */ + break; /* finish multiple scattering loop */ } } /* end if intersect */ } while (intersect); /* end do (intersect) (multiple scattering loop) */ - // Add attenuation of exit flight path for non-multiple scattering - if (order && SCATTERED){ + if (order && SCATTERED) { if (VarsInc.shape == 0) - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); else if (VarsInc.shape == 1) - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else if (VarsInc.shape == 2) - intersect = sphere_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius); + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); #ifdef USE_OFF else if (VarsInc.shape == 3) - intersect = off_intersect(&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); #endif - d_path = v * t3; /* Length of full path through sample */ - + d_path = v * t3; /* Length of full path through sample */ - p_trans = exp(-my_t*d_path); + p_trans = exp (-my_t * d_path); p *= p_trans; - PROP_DT(t3); - + PROP_DT (t3); } - %} MCDISPLAY %{ - if (geometry && strlen(geometry) && strcmp(geometry, "NULL") && strcmp(geometry, "0")) { /* OFF file */ - off_display(offdata); - } - else - if (radius > 0 && yheight) { /* cylinder along y*/ - cylinder(0,0,0,radius,yheight,thickness, 0, 1, 0); - } - else if (xwidth && yheight) { /* box/rectangle */ - box(0,0,0,xwidth,yheight,zdepth,thickness, 0, 1, 0); - } - else if (radius > 0 && !yheight) { /* sphere */ - sphere(0,0,0,radius); - } + if (geometry && strlen (geometry) && strcmp (geometry, "NULL") && strcmp (geometry, "0")) { /* OFF file */ + off_display (offdata); + } else if (radius > 0 && yheight) { /* cylinder along y*/ + cylinder (0, 0, 0, radius, yheight, thickness, 0, 1, 0); + } else if (xwidth && yheight) { /* box/rectangle */ + box (0, 0, 0, xwidth, yheight, zdepth, thickness, 0, 1, 0); + } else if (radius > 0 && !yheight) { /* sphere */ + sphere (0, 0, 0, radius); + } %} diff --git a/mcstas-comps/samples/Isotropic_Sqw.comp b/mcstas-comps/samples/Isotropic_Sqw.comp index b07f60bffc..b42343f97b 100644 --- a/mcstas-comps/samples/Isotropic_Sqw.comp +++ b/mcstas-comps/samples/Isotropic_Sqw.comp @@ -299,1711 +299,1709 @@ struct Sqw_sample_struct *Sqw, char *file, struct Sqw_Data_struct *Sqw_Data) SHARE %{ -#ifndef ISOTROPIC_SQW -#define ISOTROPIC_SQW $Revision$ - -/* {j d F2 DW Dd inv2d q F} + { Sq if j == -1}*/ -#ifndef Crystallographica -#define Crystallographica { 4,5,7,0,0,0,0, 0,0 } -#define Fullprof { 4,0,8,0,0,5,0, 0,0 } -#define Undefined { 0,0,0,0,0,0,0, 0,0 } -#define Lazy {17,6,0,0,0,0,0,13,0 } -#endif -/* special case for [q,Sq] table */ -#define qSq {-1,0,0,0,0,0,1, 0,0 } - -%include "read_table-lib" -%include "interoff-lib" - -/* For the density of states S(w) */ -struct Sqw_W_struct -{ - double omega; /* omega value for the data block */ - double cumul_proba; /* cumulated intensity (between 0 and 1) */ -}; - -/* For the S(q|w) probabilities */ -struct Sqw_Q_struct -{ - double Q; /* omega value for the data block */ - double cumul_proba; /* normalized cumulated probability */ -}; - -struct Sqw_Data_struct /* contains normalized Sqw data for probabilities, coh and inc */ -{ - struct Sqw_W_struct *SW; /* P(w) ~ density of states */ - struct Sqw_Q_struct **SQW; /* P(Q|w)= probability of each Q with w */ - - long *SW_lookup; - long **QW_lookup; - t_Table Sqw; /* S(q,w) rebin from file in range -w_max:w_max and 0:q_max, with exp(-hw/kT) weight */ - t_Table iqSq; /* sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dq dw up to 2*Ki_max */ - long q_bins; - long w_bins; /* length of q and w vectors/axes from file */ - double q_max, q_step; /* min=0 */ - double w_max, w_step; /* min=-w_max */ - long lookup_length; - char filename[80]; - double intensity; - double Ei_max; /* max neutron incoming energy for Sigma=iqSq table */ - long iqSq_length; - char type; - double q_min_file; -}; - -struct Sqw_sample_struct { /* global parameters gathered as a structure */ - char compname[256]; - - struct Sqw_Data_struct Data_inc; - struct Sqw_Data_struct Data_coh; - - double s_abs, s_coh, s_inc; /* material constants */ - double my_s; - double my_a_v; - double mat_rho; - double mat_weight; - double mat_density; - double Temperature; /* temperature from the data file */ - int shape; /* 0:cylinder, 1:box, 2:sphere 3:any shape*/ - - double sqw_threshold; /* options to tune S(q,w) */ - double sqw_classical; - double sqw_norm; - - double barns; /* for powders */ - double Dd, DWfactor; - - double T2E; /* constants */ - char Q_correction[256]; - double sqSE2K; - - int maxloop; /* flags to monitor caught warnings */ - int minevents; - long neutron_removed; - long neutron_enter; - long neutron_pmult; - long neutron_exit; - char verbose_output; - int column_order[9]; /* column signification */ - long lookup_length; - - double dq, dw; /* q/w transfer */ - char type; /* interaction type: c(coherent), i(incoherent), - V(isotropic incoherent), t(transmitted) */ - /* store information from the last event */ - double ki_x,ki_y,ki_z,kf_x,kf_y,kf_z; - double ti, tf; - double vi, vf; - double ki, kf; - double theta; - - double mean_scatt; /* stat to show at the end */ - double mean_abs; - double psum_scatt; - double single_coh; - double single_inc; - double multi; - - double rw, rq; -}; - -#include -#include - -/* sets a Data S(q,w) to 'NULL' */ -void Sqw_Data_init(struct Sqw_Data_struct *Sqw_Data) -{ - Sqw_Data->q_bins =0; - Sqw_Data->w_bins =0; - Sqw_Data->q_max =0; - Sqw_Data->q_step =1; - Sqw_Data->w_max =0; - Sqw_Data->w_step =1; - Sqw_Data->Ei_max = 0; - Sqw_Data->lookup_length=100; /* length of lookup tables */ - Sqw_Data->intensity =0; - strcpy(Sqw_Data->filename, ""); - Sqw_Data->SW =NULL; - Sqw_Data->SQW =NULL; - Sqw_Data->SW_lookup =NULL; - Sqw_Data->QW_lookup =NULL; - Sqw_Data->iqSq_length =100; - Sqw_Data->type = ' '; - Sqw_Data->q_min_file = 0; -} - -off_struct offdata; - -/* gaussian distribution to appply around Bragg peaks in a powder */ -double Sqw_powder_gauss(double x, double mean, double rms) { - return (exp(-(x-mean)*(x-mean)/(2*rms*rms))/(sqrt(2*PI)*rms)); -} - -/* Sqw_quantum_correction -* -* Return the 'quantum correction factor Q so that: -* -* S(q, w) = Q(w) S*(q,w) -* S(q,-w) = exp(-hw/kT) S(q,w) -* S(q, w) = exp( hw/kT) S(q,-w) -* -* with S*=classical limit and Q(w) defined below. For omega > 0, S(q,w) > S(q,-w) -* -* input: -* w: energy [meV] -* T: temperature [K] -* type: 'Schofield' or 'Boltzmann' Q = exp(hw/kT/2) -* 'harmonic' or 'Bader' Q = hw/kT./(1-exp(-hw/kT)) -* 'standard' or 'Frommhold' Q = 2./(1+exp(-hw/kT)) [recommended] -* -* References: -* B. Hehr, http://www.lib.ncsu.edu/resolver/1840.16/7422 PhD manuscript (2010). -* S. A. Egorov, K. F. Everitt and J. L. Skinner. J. Phys. Chem., 103, 9494 (1999). -* P. Schofield. Phys. Rev. Lett., 4, 239 (1960). -* J. S. Bader and B. J. Berne. J. Chem. Phys., 100, 8359 (1994). -* T. D. Hone and G. A. Voth. J. Chem. Phys., 121, 6412 (2004). -* L. Frommhold. Collision-induced absorption in gases, 1 st ed., Cambridge -* Monographs on Atomic, Molecular, and Chemical Physics, Vol. 2, -* Cambridge Univ. Press: London (1993). - - */ -double Sqw_quantum_correction(double hw, double T, char *type) { - double Q = 1; - double kT = T/11.605; /* [K] -> [meV = 1000*KB/e] */ - if (!hw || !T) return 1; - if (type == NULL || !strcmp(type, "standard") - || !strcmp(type, "Frommhold") || !strcmp(type, "default")) - Q = 2/(1+exp(-hw/kT)); - if (!strcmp(type, "Schofield") || !strcmp(type, "Boltzmann")) - Q = exp(hw/kT/2); - if (!strcmp(type, "harmonic") || !strcmp(type, "Bader")) - Q = hw/kT/(1-exp(-hw/kT)); - - return Q; -} + #ifndef ISOTROPIC_SQW + #define ISOTROPIC_SQW $Revision$ + + /* {j d F2 DW Dd inv2d q F} + { Sq if j == -1}*/ + #ifndef Crystallographica + #define Crystallographica { 4,5,7,0,0,0,0, 0,0 } + #define Fullprof { 4,0,8,0,0,5,0, 0,0 } + #define Undefined { 0,0,0,0,0,0,0, 0,0 } + #define Lazy {17,6,0,0,0,0,0,13,0 } + #endif + /* special case for [q,Sq] table */ + #define qSq {-1,0,0,0,0,0,1, 0,0 } -/***************************************************************************** -* Sqw_read_PowderN: Read PowderN data files -* Returns t_Table array or NULL in case of error -* Used in : Sqw_readfile (1) -*****************************************************************************/ -t_Table *Sqw_read_PowderN(struct Sqw_sample_struct *Sqw, t_Table sqwTable) -{ - struct line_data + %include "read_table-lib" + %include "interoff-lib" + + /* For the density of states S(w) */ + struct Sqw_W_struct { + double omega; /* omega value for the data block */ + double cumul_proba; /* cumulated intensity (between 0 and 1) */ + }; + + /* For the S(q|w) probabilities */ + struct Sqw_Q_struct { + double Q; /* omega value for the data block */ + double cumul_proba; /* normalized cumulated probability */ + }; + + struct Sqw_Data_struct /* contains normalized Sqw data for probabilities, coh and inc */ { - double F2; /* Value of structure factor */ - double q; /* Q vector */ - int j; /* Multiplicity */ - double DWfactor; /* Debye-Waller factor */ - double w; /* Intrinsic line width */ + struct Sqw_W_struct* SW; /* P(w) ~ density of states */ + struct Sqw_Q_struct** SQW; /* P(Q|w)= probability of each Q with w */ + + long* SW_lookup; + long** QW_lookup; + t_Table Sqw; /* S(q,w) rebin from file in range -w_max:w_max and 0:q_max, with exp(-hw/kT) weight */ + t_Table iqSq; /* sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dq dw up to 2*Ki_max */ + long q_bins; + long w_bins; /* length of q and w vectors/axes from file */ + double q_max, q_step; /* min=0 */ + double w_max, w_step; /* min=-w_max */ + long lookup_length; + char filename[80]; + double intensity; + double Ei_max; /* max neutron incoming energy for Sigma=iqSq table */ + long iqSq_length; + char type; + double q_min_file; }; - struct line_data *list = NULL; - double q_count=0, j_count=0, F2_count=0; - int mult_count =0; - double q_step =FLT_MAX; - long size =0; - int i, index; - double q_min=0, q_max=0; - char flag=0; - int list_count=0; - double q_step_cur; - char flag_qSq = 0; - - t_Table *retTable; - - flag_qSq = (Sqw->column_order[8]>0 && Sqw->column_order[6]>0); - - MPI_MASTER( - if (Sqw->column_order[0] == 4 && Sqw->barns !=0) - printf("Isotropic_sqw: %s: Powder file probably of type Crystallographica/Fullprof (lau)\n" - "WARNING: but F2 unit is set to powder_barns=1 (barns). Intensity might be 100 times too high.\n", - Sqw->compname); - if (Sqw->column_order[0] == 17 && Sqw->barns == 0) - printf("Isotropic_sqw: %s: Powder file probably of type Lazy Pulver (laz)\n" - "WARNING: but F2 unit is set to powder_barns=0 (fm^2). Intensity might be 100 times too low.\n", - Sqw->compname); - ); - size = sqwTable.rows; - MPI_MASTER( - if (Sqw->verbose_output > 0) { - printf("Isotropic_sqw: Converting %ld %s from %s into S(q,w) data\n", - size, flag_qSq ? "S(q)" : "powder lines", sqwTable.filename); + + struct Sqw_sample_struct { /* global parameters gathered as a structure */ + char compname[256]; + + struct Sqw_Data_struct Data_inc; + struct Sqw_Data_struct Data_coh; + + double s_abs, s_coh, s_inc; /* material constants */ + double my_s; + double my_a_v; + double mat_rho; + double mat_weight; + double mat_density; + double Temperature; /* temperature from the data file */ + int shape; /* 0:cylinder, 1:box, 2:sphere 3:any shape*/ + + double sqw_threshold; /* options to tune S(q,w) */ + double sqw_classical; + double sqw_norm; + + double barns; /* for powders */ + double Dd, DWfactor; + + double T2E; /* constants */ + char Q_correction[256]; + double sqSE2K; + + int maxloop; /* flags to monitor caught warnings */ + int minevents; + long neutron_removed; + long neutron_enter; + long neutron_pmult; + long neutron_exit; + char verbose_output; + int column_order[9]; /* column signification */ + long lookup_length; + + double dq, dw; /* q/w transfer */ + char type; /* interaction type: c(coherent), i(incoherent), + V(isotropic incoherent), t(transmitted) */ + /* store information from the last event */ + double ki_x, ki_y, ki_z, kf_x, kf_y, kf_z; + double ti, tf; + double vi, vf; + double ki, kf; + double theta; + + double mean_scatt; /* stat to show at the end */ + double mean_abs; + double psum_scatt; + double single_coh; + double single_inc; + double multi; + + double rw, rq; + }; + + #include + #include + + /* sets a Data S(q,w) to 'NULL' */ + void + Sqw_Data_init (struct Sqw_Data_struct* Sqw_Data) { + Sqw_Data->q_bins = 0; + Sqw_Data->w_bins = 0; + Sqw_Data->q_max = 0; + Sqw_Data->q_step = 1; + Sqw_Data->w_max = 0; + Sqw_Data->w_step = 1; + Sqw_Data->Ei_max = 0; + Sqw_Data->lookup_length = 100; /* length of lookup tables */ + Sqw_Data->intensity = 0; + strcpy (Sqw_Data->filename, ""); + Sqw_Data->SW = NULL; + Sqw_Data->SQW = NULL; + Sqw_Data->SW_lookup = NULL; + Sqw_Data->QW_lookup = NULL; + Sqw_Data->iqSq_length = 100; + Sqw_Data->type = ' '; + Sqw_Data->q_min_file = 0; + } + + off_struct offdata; + + /* gaussian distribution to appply around Bragg peaks in a powder */ + double + Sqw_powder_gauss (double x, double mean, double rms) { + return (exp (-(x - mean) * (x - mean) / (2 * rms * rms)) / (sqrt (2 * PI) * rms)); + } + + /* Sqw_quantum_correction + * + * Return the 'quantum correction factor Q so that: + * + * S(q, w) = Q(w) S*(q,w) + * S(q,-w) = exp(-hw/kT) S(q,w) + * S(q, w) = exp( hw/kT) S(q,-w) + * + * with S*=classical limit and Q(w) defined below. For omega > 0, S(q,w) > S(q,-w) + * + * input: + * w: energy [meV] + * T: temperature [K] + * type: 'Schofield' or 'Boltzmann' Q = exp(hw/kT/2) + * 'harmonic' or 'Bader' Q = hw/kT./(1-exp(-hw/kT)) + * 'standard' or 'Frommhold' Q = 2./(1+exp(-hw/kT)) [recommended] + * + * References: + * B. Hehr, http://www.lib.ncsu.edu/resolver/1840.16/7422 PhD manuscript (2010). + * S. A. Egorov, K. F. Everitt and J. L. Skinner. J. Phys. Chem., 103, 9494 (1999). + * P. Schofield. Phys. Rev. Lett., 4, 239 (1960). + * J. S. Bader and B. J. Berne. J. Chem. Phys., 100, 8359 (1994). + * T. D. Hone and G. A. Voth. J. Chem. Phys., 121, 6412 (2004). + * L. Frommhold. Collision-induced absorption in gases, 1 st ed., Cambridge + * Monographs on Atomic, Molecular, and Chemical Physics, Vol. 2, + * Cambridge Univ. Press: London (1993). + + */ + double + Sqw_quantum_correction (double hw, double T, char* type) { + double Q = 1; + double kT = T / 11.605; /* [K] -> [meV = 1000*KB/e] */ + if (!hw || !T) + return 1; + if (type == NULL || !strcmp (type, "standard") || !strcmp (type, "Frommhold") || !strcmp (type, "default")) + Q = 2 / (1 + exp (-hw / kT)); + if (!strcmp (type, "Schofield") || !strcmp (type, "Boltzmann")) + Q = exp (hw / kT / 2); + if (!strcmp (type, "harmonic") || !strcmp (type, "Bader")) + Q = hw / kT / (1 - exp (-hw / kT)); + + return Q; } - ); - /* allocate line_data array */ - list = (struct line_data*)malloc(size*sizeof(struct line_data)); - for (i=0; icolumn_order[8] > 0 && Sqw->column_order[6] > 0); + + MPI_MASTER (if (Sqw->column_order[0] == 4 && Sqw->barns != 0) + printf ("Isotropic_sqw: %s: Powder file probably of type Crystallographica/Fullprof (lau)\n" + "WARNING: but F2 unit is set to powder_barns=1 (barns). Intensity might be 100 times too high.\n", + Sqw->compname); + if (Sqw->column_order[0] == 17 && Sqw->barns == 0) + printf ("Isotropic_sqw: %s: Powder file probably of type Lazy Pulver (laz)\n" + "WARNING: but F2 unit is set to powder_barns=0 (fm^2). Intensity might be 100 times too low.\n", + Sqw->compname);); + size = sqwTable.rows; + MPI_MASTER (if (Sqw->verbose_output > 0) { + printf ("Isotropic_sqw: Converting %ld %s from %s into S(q,w) data\n", size, flag_qSq ? "S(q)" : "powder lines", sqwTable.filename); + }); + /* allocate line_data array */ + list = (struct line_data*)malloc (size * sizeof (struct line_data)); + + for (i = 0; i < size; i++) { + double j = 0, d = 0, w = 0, DWfactor = 0, F2 = 0, Sq = -1, q = 0; int index; - if (Sqw->Dd >= 0) w = Sqw->Dd; - if (Sqw->DWfactor > 0) DWfactor = Sqw->DWfactor; + if (Sqw->Dd >= 0) + w = Sqw->Dd; + if (Sqw->DWfactor > 0) + DWfactor = Sqw->DWfactor; /* get data from table using columns {j d F2 DW Dd inv2d q} + { Sq }*/ /* column indexes start at 1, thus need to substract 1 */ - if (Sqw->column_order[0]>0) - j = Table_Index(sqwTable, i, Sqw->column_order[0]-1); - if (Sqw->column_order[1]>0) - d = Table_Index(sqwTable, i, Sqw->column_order[1]-1); - if (Sqw->column_order[2]>0) - F2 = Table_Index(sqwTable, i, Sqw->column_order[2]-1); - if (Sqw->column_order[3]>0) - DWfactor = Table_Index(sqwTable, i, Sqw->column_order[3]-1); - if (Sqw->column_order[4]>0) - w = Table_Index(sqwTable, i, Sqw->column_order[4]-1); - if (Sqw->column_order[5]>0 && !(Sqw->column_order[1]>0)) { - d = Table_Index(sqwTable, i, Sqw->column_order[5]-1); if (d) d = 1/d/2; } - if (Sqw->column_order[6]>0) - q = Table_Index(sqwTable, i, Sqw->column_order[6]-1); - if (Sqw->column_order[7]>0 && !F2) - {F2= Table_Index(sqwTable, i, Sqw->column_order[7]-1); F2 *= F2;} - - if (Sqw->column_order[8]>0) - Sq= Table_Index(sqwTable, i, Sqw->column_order[8]-1); - - if (q > 0 && Sq >= 0) F2 = Sq; - if (d > 0 && q <= 0) q = 2*PI/d; + if (Sqw->column_order[0] > 0) + j = Table_Index (sqwTable, i, Sqw->column_order[0] - 1); + if (Sqw->column_order[1] > 0) + d = Table_Index (sqwTable, i, Sqw->column_order[1] - 1); + if (Sqw->column_order[2] > 0) + F2 = Table_Index (sqwTable, i, Sqw->column_order[2] - 1); + if (Sqw->column_order[3] > 0) + DWfactor = Table_Index (sqwTable, i, Sqw->column_order[3] - 1); + if (Sqw->column_order[4] > 0) + w = Table_Index (sqwTable, i, Sqw->column_order[4] - 1); + if (Sqw->column_order[5] > 0 && !(Sqw->column_order[1] > 0)) { + d = Table_Index (sqwTable, i, Sqw->column_order[5] - 1); + if (d) + d = 1 / d / 2; + } + if (Sqw->column_order[6] > 0) + q = Table_Index (sqwTable, i, Sqw->column_order[6] - 1); + if (Sqw->column_order[7] > 0 && !F2) { + F2 = Table_Index (sqwTable, i, Sqw->column_order[7] - 1); + F2 *= F2; + } + + if (Sqw->column_order[8] > 0) + Sq = Table_Index (sqwTable, i, Sqw->column_order[8] - 1); + + if (q > 0 && Sq >= 0) + F2 = Sq; + if (d > 0 && q <= 0) + q = 2 * PI / d; /* assign and check values */ j = (j > 0 ? j : 0); - if (flag_qSq) j=1; + if (flag_qSq) + j = 1; DWfactor = (DWfactor > 0 ? DWfactor : 1); - w = (w>0 ? w : 0); + w = (w > 0 ? w : 0); F2 = (F2 >= 0 ? F2 : 0); - d = (q > 0 ? 2*PI/d : 0); + d = (q > 0 ? 2 * PI / d : 0); if (j == 0 || d == 0 || q == 0) { - MPI_MASTER( - printf("Isotropic_sqw: %s: Warning: line %i has invalid definition\n" - " (mult=0 or q=0 or d=0)\n", Sqw->compname, i); - ); + MPI_MASTER (printf ("Isotropic_sqw: %s: Warning: line %i has invalid definition\n" + " (mult=0 or q=0 or d=0)\n", + Sqw->compname, i);); continue; } list[list_count].j = j; list[list_count].q = q; list[list_count].DWfactor = DWfactor; list[list_count].w = w; - list[list_count].F2= F2; /* or S(q) if flag_qSq */ + list[list_count].F2 = F2; /* or S(q) if flag_qSq */ - if (q_max < d) q_max = q; - if (q_min > d) q_min = q; + if (q_max < d) + q_max = q; + if (q_min > d) + q_min = q; if (list_count > 1) { - q_step_cur = fabs(list[list_count].q - list[list_count-1].q); + q_step_cur = fabs (list[list_count].q - list[list_count - 1].q); if (q_step_cur > 1e-5 && (!q_step || q_step_cur < q_step)) - q_step = q_step_cur; + q_step = q_step_cur; } /* adjust multiplicity if j-column + multiple d-spacing lines */ /* if d = previous d, increase line duplication index */ - if (!q_count) q_count = q; - if (!j_count) j_count = j; - if (!F2_count) F2_count= F2; - if (fabs(q_count-q) < 0.0001*fabs(q) - && fabs(F2_count-F2) < 0.0001*fabs(F2) && j_count == j) { - mult_count++; flag=0; } - else flag=1; - if (i == size-1) flag=1; + if (!q_count) + q_count = q; + if (!j_count) + j_count = j; + if (!F2_count) + F2_count = F2; + if (fabs (q_count - q) < 0.0001 * fabs (q) && fabs (F2_count - F2) < 0.0001 * fabs (F2) && j_count == j) { + mult_count++; + flag = 0; + } else + flag = 1; + if (i == size - 1) + flag = 1; /* else if d != previous d : just passed equivalent lines */ if (flag) { - if (i == size-1) list_count++; - /* if duplication index == previous multiplicity */ - /* set back multiplicity of previous lines to 1 */ - if (Sqw->verbose_output > 2 && (mult_count == list[list_count-1].j - || (mult_count == list[list_count].j && i == size-1))) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Setting multiplicity to 1 for lines [%i:%i]\n" - " (d-spacing %g is duplicated %i times)\n", - Sqw->compname, list_count-mult_count, list_count-1, list[list_count-1].q, mult_count); - ); - for (index=list_count-mult_count; indexverbose_output > 2 && (mult_count == list[list_count - 1].j || (mult_count == list[list_count].j && i == size - 1))) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Setting multiplicity to 1 for lines [%i:%i]\n" + " (d-spacing %g is duplicated %i times)\n", + Sqw->compname, list_count - mult_count, list_count - 1, list[list_count - 1].q, mult_count);); + for (index = list_count - mult_count; index < list_count; list[index++].j = 1) + ; + mult_count = 1; q_count = q; j_count = j; - F2_count= F2; + F2_count = F2; } - if (i == size-1) list_count--; - flag=0; + if (i == size - 1) + list_count--; + flag = 0; } list_count++; } /* end for */ - /* now builds new Table_Array to continue with Sqw_readfile */ - if (q_max == q_min || !q_step) return(NULL); - if (!flag_qSq) - size = 3*q_max/q_step; /* set a default of 3 q values per line */ - else size = list_count; - /* update the value of q_step */ - q_step = q_max/size; - MPI_MASTER( - if (Sqw->verbose_output > 0) - printf("Isotropic_sqw: q range [%g:%g], creating %li elements vector\n", - q_min, q_max, size); - ); - - retTable = (t_Table*)calloc(4, sizeof(t_Table)); - if (!retTable) printf("Isotropic_Sqw: ERROR: Cannot allocate PowderN->Sqw table.\n"); - else { - char *header; - if (!Table_Init(&retTable[0], size, 1)) - { printf("Isotropic_Sqw: ERROR Cannot allocate q-axis [%li] from Powder lines.\n", size); return(NULL); } - if (!Table_Init(&retTable[1], 1, 1)) - { printf("Isotropic_Sqw: ERROR Cannot allocate w-axis from Powder lines.\n"); return(NULL); } - if (!Table_Init(&retTable[2], size, 1)) - { printf("Isotropic_Sqw: ERROR Cannot allocate Sqw [%li] from Powder lines.\n", size); return(NULL); } - Table_Init(&retTable[3], 0,0); - - header = malloc(64); if (header) - { retTable[0].header = header; strcpy(retTable[0].header, "q"); } - header = malloc(64); if (header) - { retTable[1].header = header; strcpy(retTable[1].header, "w"); } - header = malloc(64); if (header) - { retTable[2].header = header; strcpy(retTable[2].header, "Sqw"); } - for (i=0; i < 4; i++) { - retTable[i].array_length = 3; - retTable[i].block_number = i+1; - } + /* now builds new Table_Array to continue with Sqw_readfile */ + if (q_max == q_min || !q_step) + return (NULL); if (!flag_qSq) - for (i=0; i 0 && !flag_qSq) { - peak_qmin = list[i].q*(1 - list[i].w*3); - peak_qmax = list[i].q*(1 + list[i].w*3); - } else { /* Dirac peak, no width */ - peak_qmin = peak_qmax = list[i].q; + size = 3 * q_max / q_step; /* set a default of 3 q values per line */ + else + size = list_count; + /* update the value of q_step */ + q_step = q_max / size; + MPI_MASTER (if (Sqw->verbose_output > 0) printf ("Isotropic_sqw: q range [%g:%g], creating %li elements vector\n", q_min, q_max, size);); + + retTable = (t_Table*)calloc (4, sizeof (t_Table)); + if (!retTable) + printf ("Isotropic_Sqw: ERROR: Cannot allocate PowderN->Sqw table.\n"); + else { + char* header; + if (!Table_Init (&retTable[0], size, 1)) { + printf ("Isotropic_Sqw: ERROR Cannot allocate q-axis [%li] from Powder lines.\n", size); + return (NULL); } - /* S(q) intensity is here */ - factor = list[i].j*(list[i].DWfactor ? list[i].DWfactor : 1) - *Sqw->mat_rho*PI/2 - /(Sqw->type == 'c' ? Sqw->s_coh : Sqw->s_inc)*list[i].F2/list[i].q/list[i].q; - if (Sqw->barns) factor *= 100; - for (q=peak_qmin; q <= peak_qmax; q += q_step) { - index = (long)floor(size*q/q_max); - if (index < 0) index=0; - else if (index >= size) index = size-1; - if (flag_qSq) { - retTable[2].data[index] += list[i].F2; - retTable[0].data[index] = list[i].q; - } else { - if (list[i].w <=0 || list[i].w*q < q_step) /* step function */ - retTable[2].data[index] += factor/q_step; - else /* gaussian */ - retTable[2].data[index] += factor - * Sqw_powder_gauss(q, list[i].q, list[i].w*list[i].q); - } + if (!Table_Init (&retTable[1], 1, 1)) { + printf ("Isotropic_Sqw: ERROR Cannot allocate w-axis from Powder lines.\n"); + return (NULL); } - } /* end for i */ - Table_Stat(&retTable[0]); Table_Stat(&retTable[1]); Table_Stat(&retTable[2]); - Sqw->sqw_norm = 0; /* F2 are normalized already */ - } + if (!Table_Init (&retTable[2], size, 1)) { + printf ("Isotropic_Sqw: ERROR Cannot allocate Sqw [%li] from Powder lines.\n", size); + return (NULL); + } + Table_Init (&retTable[3], 0, 0); - return(retTable); -} /* Sqw_read_PowderN */ + header = malloc (64); + if (header) { + retTable[0].header = header; + strcpy (retTable[0].header, "q"); + } + header = malloc (64); + if (header) { + retTable[1].header = header; + strcpy (retTable[1].header, "w"); + } + header = malloc (64); + if (header) { + retTable[2].header = header; + strcpy (retTable[2].header, "Sqw"); + } + for (i = 0; i < 4; i++) { + retTable[i].array_length = 3; + retTable[i].block_number = i + 1; + } + if (!flag_qSq) + for (i = 0; i < size; i++) + retTable[0].data[i] = i * q_max / size; + for (i = 0; i < list_count; i++) { /* loop on each Bragg peak */ + double peak_qmin, peak_qmax, factor, q; + if (list[i].w > 0 && !flag_qSq) { + peak_qmin = list[i].q * (1 - list[i].w * 3); + peak_qmax = list[i].q * (1 + list[i].w * 3); + } else { /* Dirac peak, no width */ + peak_qmin = peak_qmax = list[i].q; + } + /* S(q) intensity is here */ + factor = list[i].j * (list[i].DWfactor ? list[i].DWfactor : 1) * Sqw->mat_rho * PI / 2 / (Sqw->type == 'c' ? Sqw->s_coh : Sqw->s_inc) * list[i].F2 + / list[i].q / list[i].q; + if (Sqw->barns) + factor *= 100; + for (q = peak_qmin; q <= peak_qmax; q += q_step) { + index = (long)floor (size * q / q_max); + if (index < 0) + index = 0; + else if (index >= size) + index = size - 1; + if (flag_qSq) { + retTable[2].data[index] += list[i].F2; + retTable[0].data[index] = list[i].q; + } else { + if (list[i].w <= 0 || list[i].w * q < q_step) /* step function */ + retTable[2].data[index] += factor / q_step; + else /* gaussian */ + retTable[2].data[index] += factor * Sqw_powder_gauss (q, list[i].q, list[i].w * list[i].q); + } + } + } /* end for i */ + Table_Stat (&retTable[0]); + Table_Stat (&retTable[1]); + Table_Stat (&retTable[2]); + Sqw->sqw_norm = 0; /* F2 are normalized already */ + } -/***************************************************************************** -* Sqw_search_SW: For a given random number 'randnum', search for the bin -* containing the corresponding Sqw->SW -* Choose an energy in the projected S(w) distribution -* Used in : TRACE (1) -*****************************************************************************/ -#pragma acc routine seq -int Sqw_search_SW(struct Sqw_Data_struct Sqw, double randnum) -{ - int index_w=0; - - if (randnum <0) randnum=0; - if (randnum >1) randnum=1; - - if (Sqw.w_bins == 1) return(0); - /* benefit from fast lookup table if exists */ - if (Sqw.SW_lookup) { - index_w = Sqw.SW_lookup[(long)floor(randnum*Sqw.lookup_length)]-1; - if (index_w<0) index_w=0; - } + return (retTable); + } /* Sqw_read_PowderN */ + + /***************************************************************************** + * Sqw_search_SW: For a given random number 'randnum', search for the bin + * containing the corresponding Sqw->SW + * Choose an energy in the projected S(w) distribution + * Used in : TRACE (1) + *****************************************************************************/ + #pragma acc routine seq + int + Sqw_search_SW (struct Sqw_Data_struct Sqw, double randnum) { + int index_w = 0; + + if (randnum < 0) + randnum = 0; + if (randnum > 1) + randnum = 1; + + if (Sqw.w_bins == 1) + return (0); + /* benefit from fast lookup table if exists */ + if (Sqw.SW_lookup) { + index_w = Sqw.SW_lookup[(long)floor (randnum * Sqw.lookup_length)] - 1; + if (index_w < 0) + index_w = 0; + } - while (index_w < Sqw.w_bins && (&(Sqw.SW[index_w]) != NULL) && (randnum > Sqw.SW[index_w].cumul_proba)) + while (index_w < Sqw.w_bins && (&(Sqw.SW[index_w]) != NULL) && (randnum > Sqw.SW[index_w].cumul_proba)) index_w++; - if (index_w >= Sqw.w_bins) index_w = Sqw.w_bins-1; - - if (&(Sqw.SW[index_w]) == NULL) - { - printf("Isotropic_Sqw: Warning: No corresponding value in the SW. randnum too big.\n"); - printf(" index_w=%i ; randnum=%f ; Sqw.SW[index_w-1].cumul_proba=%f (Sqw_search_SW)\n", - index_w, randnum, Sqw.SW[index_w-1].cumul_proba); - return index_w-1; - } - else + if (index_w >= Sqw.w_bins) + index_w = Sqw.w_bins - 1; + + if (&(Sqw.SW[index_w]) == NULL) { + printf ("Isotropic_Sqw: Warning: No corresponding value in the SW. randnum too big.\n"); + printf (" index_w=%i ; randnum=%f ; Sqw.SW[index_w-1].cumul_proba=%f (Sqw_search_SW)\n", index_w, randnum, Sqw.SW[index_w - 1].cumul_proba); + return index_w - 1; + } else return (index_w); -} - -/***************************************************************************** -* Sqw_search_Q_proba_per_w: For a given random number randnum, search for -* the bin containing the corresponding Sqw.SW in the Q probablility grid -* Choose a momentum in the S(q|w) distribution -* index is given by Sqw_search_SW -* Used in : TRACE (1) -*****************************************************************************/ -#pragma acc routine seq -int Sqw_search_Q_proba_per_w(struct Sqw_Data_struct Sqw, double randnum, int index_w) -{ - int index_q=0; - - if (randnum <0) randnum=0; - if (randnum >1) randnum=1; - - /* benefit from fast lookup table if exists */ - if (Sqw.QW_lookup && Sqw.QW_lookup[index_w]) { - index_q = Sqw.QW_lookup[index_w][(long)floor(randnum*Sqw.lookup_length)]-1; - if (index_q<0) index_q=0; } - while (index_q < Sqw.q_bins && (&(Sqw.SQW[index_w][index_q]) != NULL) - && (randnum > Sqw.SQW[index_w][index_q].cumul_proba)) { - index_q++; - } - if (index_q >= Sqw.q_bins) index_q = Sqw.q_bins-1; - - if (&(Sqw.SQW[index_w][index_q]) == NULL) - return -1; - else - return (index_q); -} - -/***************************************************************************** -* compute the effective total cross section \int q S(q,w) dw dq -* for incoming neutron energy 0 < Ei < 2*w_max, and -* integration range w=-w_max:Ei and q=Q0:Q1 with -* Q0 = SE2Q*(sqrt(Ei)-sqrt(Ei-w))=|Ki-Kf| -* Q1 = SE2Q*(sqrt(Ei)+sqrt(Ei-w))=|Ki+Kf| -* The data to use is Sqw_Data->Sqw, and the limits are Sqw_Data->w_max Sqw_Data->q_max -* Returns the integral value -* Used in: Sqw_readfile (1) -*****************************************************************************/ -#pragma acc routine seq -double Sqw_integrate_iqSq(struct Sqw_Data_struct *Sqw_Data, double Ei) -{ - long index_w; - double iqSq = 0; - /* w=Ei-Ef q=ki-kf w>0 neutron looses energy, Stokes, Ef = Ei-w > 0, Kf =|Ki-q| > 0 */ - for (index_w=0; index_w < Sqw_Data->w_bins; index_w++) { - long index_q; - double w = -Sqw_Data->w_max + index_w * Sqw_Data->w_step; /* in the Sqw table */ - if (w <= Ei) { /* integration range w=-w_max:Ei, Ef = Ei-w > 0 */ - double sq=0, Q0=0, Q1=0; - sq = sqrt(Ei-w); /* always real as test was true before */ - Q0 = SE2V*V2K*(sqrt(Ei)-sq); - Q1 = SE2V*V2K*(sqrt(Ei)+sq); - - for (index_q=0; index_q < Sqw_Data->q_bins; index_q++) { - double q=(double)index_q * Sqw_Data->q_step; - /* add 'pixel' = q S(q,w) */ - if (Q0 <= q && q <= Q1) iqSq += q*Table_Index(Sqw_Data->Sqw, index_q, index_w); - } + /***************************************************************************** + * Sqw_search_Q_proba_per_w: For a given random number randnum, search for + * the bin containing the corresponding Sqw.SW in the Q probablility grid + * Choose a momentum in the S(q|w) distribution + * index is given by Sqw_search_SW + * Used in : TRACE (1) + *****************************************************************************/ + #pragma acc routine seq + int + Sqw_search_Q_proba_per_w (struct Sqw_Data_struct Sqw, double randnum, int index_w) { + int index_q = 0; + + if (randnum < 0) + randnum = 0; + if (randnum > 1) + randnum = 1; + + /* benefit from fast lookup table if exists */ + if (Sqw.QW_lookup && Sqw.QW_lookup[index_w]) { + index_q = Sqw.QW_lookup[index_w][(long)floor (randnum * Sqw.lookup_length)] - 1; + if (index_q < 0) + index_q = 0; } - } - /* multiply by 'pixel' size = dq dw */ - return(iqSq * Sqw_Data->q_step * Sqw_Data->w_step); -} /* Sqw_integrate_iqSq */ - -/***************************************************************************** -* Sqw_diagnosis: Computes Sqw_classical, moments and physical quantities -* make consistency checks, and output some data files -* Return: output files and information displayed -* Used in: Sqw_init (2) only by MASTER node with MPI -*****************************************************************************/ -void Sqw_diagnosis(struct Sqw_sample_struct *Sqw, struct Sqw_Data_struct *Sqw_Data) -{ - - t_Table Sqw_cl; /* the Sqw symmetric/classical version (T-> Inf) */ - t_Table Gqw; /* the generalized density of states as of Carpenter and Price, J Non Cryst Sol 92 (1987) 153 */ - t_Table Sqw_moments[7]; /* M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) G(w) */ - t_Table w_c, w_l; - long index_q, index_w; - char c[CHAR_BUF_LENGTH]; /* temporary variable */ - long q_min_index = 0; - - char do_coh=0, do_inc=0; - double q_min =0; - double u2 =0, S0=1; - long u2_count=0; - - if (!Sqw_Data || !Sqw_Data->intensity) return; /* nothing to do with empty S(q,w) */ - - if (Sqw_Data->type=='c') do_coh = 1; - if (Sqw_Data->type=='i') do_inc = 1; - - q_min = Sqw_Data->q_min_file; - if (q_min <= 0) q_min = Sqw_Data->q_step; - - /* test if there is only one S(q,w) available */ - if (!((Sqw->Data_inc).intensity) || !((Sqw->Data_coh).intensity)) - do_coh = do_inc = 1; /* do both if only one file given */ - - if (Sqw->Temperature > 0) { - if (!Table_Init(&Sqw_cl, Sqw_Data->q_bins, Sqw_Data->w_bins)) { - printf("Isotropic_Sqw: %s: Cannot allocate S_cl(q,w) Table (%lix%i).\n" - "WARNING Skipping S(q,w) diagnosis.\n", - Sqw->compname, Sqw_Data->q_bins, 1); - return; + while (index_q < Sqw.q_bins && (&(Sqw.SQW[index_w][index_q]) != NULL) && (randnum > Sqw.SQW[index_w][index_q].cumul_proba)) { + index_q++; } - sprintf(Sqw_cl.filename, - "S(q,w)_cl from %s (dynamic structure factor, classical)", - Sqw_Data->filename); - Sqw_cl.block_number = 1; - Sqw_cl.min_x = 0; - Sqw_cl.max_x = Sqw_Data->q_max; - Sqw_cl.step_x = Sqw_Data->q_step; - } + if (index_q >= Sqw.q_bins) + index_q = Sqw.q_bins - 1; - /* initialize moments and 1D stuff */ - for (index_q=0; index_q < 6; index_q++) { - if (!Table_Init(&Sqw_moments[index_q], Sqw_Data->q_bins, 1)) { - printf("Isotropic_Sqw: %s: Cannot allocate S(q,w) moment %ld Table (%lix%i).\n" - "WARNING Skipping S(q,w) diagnosis.\n", - Sqw->compname, index_q, Sqw_Data->q_bins, 1); - Table_Free(&Sqw_cl); - return; - } - Sqw_moments[index_q].block_number = 1; - Sqw_moments[index_q].min_x = 0; - Sqw_moments[index_q].max_x = Sqw_Data->q_max; - Sqw_moments[index_q].step_x = Sqw_Data->q_step; + if (&(Sqw.SQW[index_w][index_q]) == NULL) + return -1; + else + return (index_q); } - index_q=6; - Table_Init(&Sqw_moments[index_q], Sqw_Data->w_bins, 1); - Sqw_moments[index_q].block_number = 1; - Sqw_moments[index_q].min_x = -Sqw_Data->w_max; - Sqw_moments[index_q].max_x = Sqw_Data->w_max; - Sqw_moments[index_q].step_x = Sqw_Data->w_step; - - /* set Table titles */ - sprintf(Sqw_moments[0].filename, - "S(q)=M0(q) from %s [int S(q,w) dw]", - Sqw_Data->filename); - sprintf(Sqw_moments[1].filename, - "M1(q) 1-st moment from %s [int w S(q,w) dw] = HBAR^2*q^2/2/m (f-sum rule, recoil, Lovesey T1 Eq 3.63 p72, Egelstaff p196)", - Sqw_Data->filename); - sprintf(Sqw_moments[2].filename, - "M3(q) 3-rd moment from %s [int w^3 S(q,w) dw] = M1(q)*w_l^2(q)", - Sqw_Data->filename); - sprintf(Sqw_moments[3].filename, - "w_c(q) = sqrt(M1(q)/M0(q)*2kT) collective excitation from %s (Lovesey T1 Eq 5.38 p180, p211 Eq 5.204). Gaussian half-width of the S(q,w) classical", - Sqw_Data->filename); - sprintf(Sqw_moments[4].filename, - "w_l(q) = sqrt(M3(q)/M1(q)) harmonic frequency from %s (Lovesey T1 5.39 p 180)", - Sqw_Data->filename); - sprintf(Sqw_moments[5].filename, - "S_cl(q)=M0_cl(q) from %s [int S_cl(q,w) dw]", - Sqw_Data->filename); - sprintf(Sqw_moments[6].filename, - "G(w) generalized effective density of states from %s (Carpenter J Non Cryst Sol 92 (1987) 153)", - Sqw_Data->filename); - - for (index_q=0; index_q < Sqw_Data->q_bins; index_q++) { - double q = index_q*Sqw_Data->q_step; /* q value in Sqw_full ; q_min = 0 */ - double sq = 0; /* S(q) = w0 = 0-th moment */ - double w1 = 0; /* first moment \int w Sqw dw */ - double w3 = 0; /* third moment \int w^3 Sqw dw */ - double sq_cl = 0; /* S(q) = M0 = 0-th moment classical */ - double w_c = 0; - double w_l = 0; - - for (index_w=0; index_w < Sqw_Data->w_bins; index_w++) { - - double w = -Sqw_Data->w_max + index_w*Sqw_Data->w_step; /* w value in Sqw_full */ - double sqw_cl =0; - double sqw_full =0; - - sqw_full = Table_Index(Sqw_Data->Sqw, index_q, index_w); - - /* Sqw moments */ - if (w && Sqw_Data->w_bins) { - double tmp; - tmp = sqw_full*Sqw_Data->w_step; - tmp *= w; w1 += tmp; - tmp *= w*w; w3 += tmp; - } - /* compute classical Sqw and S(q)_cl */ - if (Sqw->Temperature > 0) { - double n; - sqw_cl = sqw_full * Sqw_quantum_correction(-w,Sqw->Temperature,Sqw->Q_correction); - if (!Table_SetElement(&Sqw_cl, index_q, index_w, sqw_cl)) - printf("Isotropic_Sqw: %s: " - "Error when setting Sqw_cl[%li q=%g,%li w=%g]=%g from file %s\n", - Sqw->compname, index_q, q, index_w, w, sqw_cl, Sqw_Data->filename); - sq_cl += sqw_cl; + /***************************************************************************** + * compute the effective total cross section \int q S(q,w) dw dq + * for incoming neutron energy 0 < Ei < 2*w_max, and + * integration range w=-w_max:Ei and q=Q0:Q1 with + * Q0 = SE2Q*(sqrt(Ei)-sqrt(Ei-w))=|Ki-Kf| + * Q1 = SE2Q*(sqrt(Ei)+sqrt(Ei-w))=|Ki+Kf| + * The data to use is Sqw_Data->Sqw, and the limits are Sqw_Data->w_max Sqw_Data->q_max + * Returns the integral value + * Used in: Sqw_readfile (1) + *****************************************************************************/ + #pragma acc routine seq + double + Sqw_integrate_iqSq (struct Sqw_Data_struct* Sqw_Data, double Ei) { + long index_w; + double iqSq = 0; + /* w=Ei-Ef q=ki-kf w>0 neutron looses energy, Stokes, Ef = Ei-w > 0, Kf =|Ki-q| > 0 */ + for (index_w = 0; index_w < Sqw_Data->w_bins; index_w++) { + long index_q; + double w = -Sqw_Data->w_max + index_w * Sqw_Data->w_step; /* in the Sqw table */ + if (w <= Ei) { /* integration range w=-w_max:Ei, Ef = Ei-w > 0 */ + double sq = 0, Q0 = 0, Q1 = 0; + sq = sqrt (Ei - w); /* always real as test was true before */ + Q0 = SE2V * V2K * (sqrt (Ei) - sq); + Q1 = SE2V * V2K * (sqrt (Ei) + sq); + + for (index_q = 0; index_q < Sqw_Data->q_bins; index_q++) { + double q = (double)index_q * Sqw_Data->q_step; + /* add 'pixel' = q S(q,w) */ + if (Q0 <= q && q <= Q1) + iqSq += q * Table_Index (Sqw_Data->Sqw, index_q, index_w); + } } - sq += sqw_full; - } /* for index_w */ - - sq *= Sqw_Data->w_step; /* S(q) = \int S(q,w) dw = structure factor */ - sq_cl *= Sqw_Data->w_step; - /* find minimal reliable q value (not interpolated) */ - if (q >= q_min && !q_min_index && sq) { - q_min_index = index_q; - q_min = q; - if (0.9 < sq) - S0 = sq; /* minimum reliable S(q) */ - else S0 = 1; - } - /* compute = <3 * ln(S(q)) / q^2> */ - if (q_min_index && q && S0 && sq) { - u2 += 3 * log(sq/S0) /q/q; - u2_count++; } + /* multiply by 'pixel' size = dq dw */ + return (iqSq * Sqw_Data->q_step * Sqw_Data->w_step); + } /* Sqw_integrate_iqSq */ + + /***************************************************************************** + * Sqw_diagnosis: Computes Sqw_classical, moments and physical quantities + * make consistency checks, and output some data files + * Return: output files and information displayed + * Used in: Sqw_init (2) only by MASTER node with MPI + *****************************************************************************/ + void + Sqw_diagnosis (struct Sqw_sample_struct* Sqw, struct Sqw_Data_struct* Sqw_Data) { + + t_Table Sqw_cl; /* the Sqw symmetric/classical version (T-> Inf) */ + t_Table Gqw; /* the generalized density of states as of Carpenter and Price, J Non Cryst Sol 92 (1987) 153 */ + t_Table Sqw_moments[7]; /* M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) G(w) */ + t_Table w_c, w_l; + long index_q, index_w; + char c[CHAR_BUF_LENGTH]; /* temporary variable */ + long q_min_index = 0; + + char do_coh = 0, do_inc = 0; + double q_min = 0; + double u2 = 0, S0 = 1; + long u2_count = 0; + + if (!Sqw_Data || !Sqw_Data->intensity) + return; /* nothing to do with empty S(q,w) */ + + if (Sqw_Data->type == 'c') + do_coh = 1; + if (Sqw_Data->type == 'i') + do_inc = 1; + + q_min = Sqw_Data->q_min_file; + if (q_min <= 0) + q_min = Sqw_Data->q_step; + + /* test if there is only one S(q,w) available */ + if (!((Sqw->Data_inc).intensity) || !((Sqw->Data_coh).intensity)) + do_coh = do_inc = 1; /* do both if only one file given */ - /* store moment values (q) as M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) */ - Table_SetElement(&Sqw_moments[0], index_q, 0, sq); - Table_SetElement(&Sqw_moments[1], index_q, 0, w1); - Table_SetElement(&Sqw_moments[2], index_q, 0, w3); - if (w1 > 0 && sq && Sqw->Temperature > 0) { - double w_c = sqrt(w1/sq*2*Sqw->Temperature*Sqw->T2E); /* HBAR^2 q^2 kT /m/ S(q) */ - Table_SetElement(&Sqw_moments[3], index_q, 0, w_c); /* collective dispersion */ + if (Sqw->Temperature > 0) { + if (!Table_Init (&Sqw_cl, Sqw_Data->q_bins, Sqw_Data->w_bins)) { + printf ("Isotropic_Sqw: %s: Cannot allocate S_cl(q,w) Table (%lix%i).\n" + "WARNING Skipping S(q,w) diagnosis.\n", + Sqw->compname, Sqw_Data->q_bins, 1); + return; + } + sprintf (Sqw_cl.filename, "S(q,w)_cl from %s (dynamic structure factor, classical)", Sqw_Data->filename); + Sqw_cl.block_number = 1; + Sqw_cl.min_x = 0; + Sqw_cl.max_x = Sqw_Data->q_max; + Sqw_cl.step_x = Sqw_Data->q_step; } - if (w1 && w3*w1 > 0) { - double w_l = sqrt(w3/w1); - Table_SetElement(&Sqw_moments[4], index_q, 0, w_l); /* harmonic dispersion */ + + /* initialize moments and 1D stuff */ + for (index_q = 0; index_q < 6; index_q++) { + if (!Table_Init (&Sqw_moments[index_q], Sqw_Data->q_bins, 1)) { + printf ("Isotropic_Sqw: %s: Cannot allocate S(q,w) moment %ld Table (%lix%i).\n" + "WARNING Skipping S(q,w) diagnosis.\n", + Sqw->compname, index_q, Sqw_Data->q_bins, 1); + Table_Free (&Sqw_cl); + return; + } + Sqw_moments[index_q].block_number = 1; + Sqw_moments[index_q].min_x = 0; + Sqw_moments[index_q].max_x = Sqw_Data->q_max; + Sqw_moments[index_q].step_x = Sqw_Data->q_step; } - if (Sqw->Temperature > 0) - Table_SetElement(&Sqw_moments[5], index_q, 0, sq_cl); + index_q = 6; + Table_Init (&Sqw_moments[index_q], Sqw_Data->w_bins, 1); + Sqw_moments[index_q].block_number = 1; + Sqw_moments[index_q].min_x = -Sqw_Data->w_max; + Sqw_moments[index_q].max_x = Sqw_Data->w_max; + Sqw_moments[index_q].step_x = Sqw_Data->w_step; + + /* set Table titles */ + sprintf (Sqw_moments[0].filename, "S(q)=M0(q) from %s [int S(q,w) dw]", Sqw_Data->filename); + sprintf (Sqw_moments[1].filename, "M1(q) 1-st moment from %s [int w S(q,w) dw] = HBAR^2*q^2/2/m (f-sum rule, recoil, Lovesey T1 Eq 3.63 p72, Egelstaff p196)", + Sqw_Data->filename); + sprintf (Sqw_moments[2].filename, "M3(q) 3-rd moment from %s [int w^3 S(q,w) dw] = M1(q)*w_l^2(q)", Sqw_Data->filename); + sprintf (Sqw_moments[3].filename, + "w_c(q) = sqrt(M1(q)/M0(q)*2kT) collective excitation from %s (Lovesey T1 Eq 5.38 p180, p211 Eq 5.204). Gaussian half-width of the S(q,w) classical", + Sqw_Data->filename); + sprintf (Sqw_moments[4].filename, "w_l(q) = sqrt(M3(q)/M1(q)) harmonic frequency from %s (Lovesey T1 5.39 p 180)", Sqw_Data->filename); + sprintf (Sqw_moments[5].filename, "S_cl(q)=M0_cl(q) from %s [int S_cl(q,w) dw]", Sqw_Data->filename); + sprintf (Sqw_moments[6].filename, "G(w) generalized effective density of states from %s (Carpenter J Non Cryst Sol 92 (1987) 153)", Sqw_Data->filename); + + for (index_q = 0; index_q < Sqw_Data->q_bins; index_q++) { + double q = index_q * Sqw_Data->q_step; /* q value in Sqw_full ; q_min = 0 */ + double sq = 0; /* S(q) = w0 = 0-th moment */ + double w1 = 0; /* first moment \int w Sqw dw */ + double w3 = 0; /* third moment \int w^3 Sqw dw */ + double sq_cl = 0; /* S(q) = M0 = 0-th moment classical */ + double w_c = 0; + double w_l = 0; + + for (index_w = 0; index_w < Sqw_Data->w_bins; index_w++) { + + double w = -Sqw_Data->w_max + index_w * Sqw_Data->w_step; /* w value in Sqw_full */ + double sqw_cl = 0; + double sqw_full = 0; + + sqw_full = Table_Index (Sqw_Data->Sqw, index_q, index_w); + + /* Sqw moments */ + if (w && Sqw_Data->w_bins) { + double tmp; + tmp = sqw_full * Sqw_Data->w_step; + tmp *= w; + w1 += tmp; + tmp *= w * w; + w3 += tmp; + } - } /* for index_q */ + /* compute classical Sqw and S(q)_cl */ + if (Sqw->Temperature > 0) { + double n; + sqw_cl = sqw_full * Sqw_quantum_correction (-w, Sqw->Temperature, Sqw->Q_correction); + if (!Table_SetElement (&Sqw_cl, index_q, index_w, sqw_cl)) + printf ("Isotropic_Sqw: %s: " + "Error when setting Sqw_cl[%li q=%g,%li w=%g]=%g from file %s\n", + Sqw->compname, index_q, q, index_w, w, sqw_cl, Sqw_Data->filename); + sq_cl += sqw_cl; + } + sq += sqw_full; + } /* for index_w */ + + sq *= Sqw_Data->w_step; /* S(q) = \int S(q,w) dw = structure factor */ + sq_cl *= Sqw_Data->w_step; + /* find minimal reliable q value (not interpolated) */ + if (q >= q_min && !q_min_index && sq) { + q_min_index = index_q; + q_min = q; + if (0.9 < sq) + S0 = sq; /* minimum reliable S(q) */ + else + S0 = 1; + } + /* compute = <3 * ln(S(q)) / q^2> */ + if (q_min_index && q && S0 && sq) { + u2 += 3 * log (sq / S0) / q / q; + u2_count++; + } + /* store moment values (q) as M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) */ + Table_SetElement (&Sqw_moments[0], index_q, 0, sq); + Table_SetElement (&Sqw_moments[1], index_q, 0, w1); + Table_SetElement (&Sqw_moments[2], index_q, 0, w3); + if (w1 > 0 && sq && Sqw->Temperature > 0) { + double w_c = sqrt (w1 / sq * 2 * Sqw->Temperature * Sqw->T2E); /* HBAR^2 q^2 kT /m/ S(q) */ + Table_SetElement (&Sqw_moments[3], index_q, 0, w_c); /* collective dispersion */ + } + if (w1 && w3 * w1 > 0) { + double w_l = sqrt (w3 / w1); + Table_SetElement (&Sqw_moments[4], index_q, 0, w_l); /* harmonic dispersion */ + } + if (Sqw->Temperature > 0) + Table_SetElement (&Sqw_moments[5], index_q, 0, sq_cl); + } /* for index_q */ - /* display some usefull information, only once in MPI mode (MASTER) */ - if (Sqw->Temperature > 0) { - double Da = 1.660538921e-27; /* [kg] unified atomic mass unit = Dalton = 1 g/mol */ - #ifndef KB - double KB = 1.3806503e-23; /* [J/K] */ - /* HBAR = 1.05457168e-34 */ - #endif - double CELE = 1.602176487e-19; /* [C] Elementary charge CODATA 2006 'e' */ - double meV2Hz = CELE/HBAR/1000/2/PI; /* 1 meV = 241.80e9 GHz */ - double gqw_sum = 0; + /* display some usefull information, only once in MPI mode (MASTER) */ + if (Sqw->Temperature > 0) { + double Da = 1.660538921e-27; /* [kg] unified atomic mass unit = Dalton = 1 g/mol */ + #ifndef KB + double KB = 1.3806503e-23; /* [J/K] */ + /* HBAR = 1.05457168e-34 */ + #endif + double CELE = 1.602176487e-19; /* [C] Elementary charge CODATA 2006 'e' */ + double meV2Hz = CELE / HBAR / 1000 / 2 / PI; /* 1 meV = 241.80e9 GHz */ + double gqw_sum = 0; + + /* classical Sqw */ + sprintf (c, "%s_%s_cl.sqw", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_cl, c, "Momentum [Angs-1]", "'S(q,w)*exp(hw/2kT) classical limit' Energy [meV]", 0, Sqw_Data->q_max, -Sqw_Data->w_max, Sqw_Data->w_max); + Table_Free (&Sqw_cl); + + if (u2_count) + u2 /= u2_count; + + MPI_MASTER ( + if (do_coh || do_inc) printf ("Isotropic_Sqw: %s: " + "Physical constants from the S(q,w) %s for T=%g [K]. Values are estimates.\n", + Sqw->compname, Sqw_Data->filename, Sqw->Temperature); + if (do_coh) { + if (Sqw->mat_weight) { + double LAMBDA = HBAR * 2 * PI / sqrt (2 * PI * Sqw->mat_weight * Da * KB * Sqw->Temperature) * 1e10; /* in [Angs] */ + double z = Sqw->mat_rho * LAMBDA * LAMBDA * LAMBDA; /* fugacity , rho=N/V in [Angs-3]*/ + double mu = KB * Sqw->Temperature * log (z); /* perfect gas chemical potential */ + printf ("# De Broglie wavelength LAMBDA=%g [Angs]\n", LAMBDA); + printf ("# Fugacity z=%g (from Egelstaff p32 Eq 2.31)\n", z); + printf ("# Chemical potential mu=%g [eV] (eq. perfect gas)\n", mu / CELE); + } - /* classical Sqw */ - sprintf(c, "%s_%s_cl.sqw", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_cl, c, "Momentum [Angs-1]", "'S(q,w)*exp(hw/2kT) classical limit' Energy [meV]", - 0,Sqw_Data->q_max,-Sqw_Data->w_max,Sqw_Data->w_max); - Table_Free(&Sqw_cl); + /* compute isothermal sound velocity and compressibility */ + /* get the S(q_min) value and the corresponding w_c */ + + if (q_min_index > 0 && q_min && q_min < 0.6) { + double w_c = Table_Index (Sqw_moments[3], q_min_index, 0); /* meV */ + /* HBAR = [J*s] */ + double c_T = 2 * PI * w_c * meV2Hz / q_min / 1e10; /* meV*Angs -> m/s */ + double ChiT = S0 / (KB * Sqw->Temperature * Sqw->mat_rho * 1e30); + printf ("# Isothermal compressibility Chi_T=%g [Pa-1] (Egelstaff p201 Eq 10.21) at q=%g [Angs-1]\n", ChiT, q_min); + printf ("# Isothermal sound velocity c_T=%g [m/s] (Lovesey T1 p210 Eq 5.197) at q=%g [Angs-1]\n", c_T, q_min); + + /* Computation if C11 is rather tricky as it is obtained from w_l, which is usually quite noisy + * This means that the obtained values are not reliable from C = rho c_l^2 (Egelstaff Eq 14.10b p284) + * C44 = rho c_c^2 ~ C11/3 + */ + double w_l = Table_Index (Sqw_moments[4], q_min_index, 0); /* meV */ + double c_l = 2 * PI * w_l * meV2Hz / q_min / 1e10; /* meV*Angs -> m/s */ + double C11 = (Sqw->mat_weight * Da) * (Sqw->mat_rho * 1e30) * c_l * c_l; + printf ("# Elastic modulus C11=%g [GPa] (Egelstaff Eq 14.10b p284) [rough estimate] at q=%g [Angs-1]\n", C11 / 1e9, q_min); + } + } if (do_inc) { + /* display the mean square displacement from S(q) = exp(-q^2/3) + = <3 * ln(S(q)) / q^2> + */ + if (u2_count && u2) { + printf ("# Mean square displacement =%g [Angs^2] (<3 * ln(S(q)) / q^2>)\n", u2); + } - if (u2_count) u2 /= u2_count; + /* compute the mean diffusion coefficient D=w_c/q^2 */ + /* FWHM of gaussian is Gamma*RMS2FWHM, only in diffusive regime (Q < 0.2 Angs-1) */ + if (q_min_index > 0 && q_min && q_min < 0.6) { + double w_c = Table_Index (Sqw_moments[3], q_min_index, 0); + double D = 2 * PI * w_c * meV2Hz / q_min / q_min / 1e14 * RMS2FWHM / 2; /* meV*Angs^2 -> mm^2/s */ + printf ("# Diffusion coefficient D=%g [mm^2/s] (Egelstaff p220)\n", D); + if (u2_count && u2 && D) + printf ("# Jump relaxation time tau=%g [ns] (Egelstaff Eq 11.8 p220)\n", u2 * 1e-2 / 6 / D); + } + }); /* MPI_MASTER */ - MPI_MASTER( - if (do_coh || do_inc) - printf("Isotropic_Sqw: %s: " - "Physical constants from the S(q,w) %s for T=%g [K]. Values are estimates.\n", - Sqw->compname, Sqw_Data->filename, Sqw->Temperature); - if (do_coh) { - if (Sqw->mat_weight) { - double LAMBDA = HBAR*2*PI/sqrt(2*PI*Sqw->mat_weight*Da*KB*Sqw->Temperature)*1e10; /* in [Angs] */ - double z = Sqw->mat_rho * LAMBDA*LAMBDA*LAMBDA; /* fugacity , rho=N/V in [Angs-3]*/ - double mu = KB*Sqw->Temperature*log(z); /* perfect gas chemical potential */ - printf("# De Broglie wavelength LAMBDA=%g [Angs]\n", LAMBDA); - printf("# Fugacity z=%g (from Egelstaff p32 Eq 2.31)\n", z); - printf("# Chemical potential mu=%g [eV] (eq. perfect gas)\n", mu/CELE); + /* density of states (generalized) */ + if (!Table_Init (&Gqw, Sqw_Data->q_bins, Sqw_Data->w_bins)) { + printf ("Isotropic_Sqw: %s: Cannot allocate G(q,w) Table (%lix%i).\n" + "WARNING Skipping S(q,w) diagnosis.\n", + Sqw->compname, Sqw_Data->q_bins, 1); + return; } - - /* compute isothermal sound velocity and compressibility */ - /* get the S(q_min) value and the corresponding w_c */ - - if (q_min_index > 0 && q_min && q_min < 0.6) { - double w_c = Table_Index(Sqw_moments[3], q_min_index, 0); /* meV */ - /* HBAR = [J*s] */ - double c_T = 2*PI*w_c*meV2Hz/q_min/1e10; /* meV*Angs -> m/s */ - double ChiT= S0/(KB*Sqw->Temperature*Sqw->mat_rho*1e30); - printf("# Isothermal compressibility Chi_T=%g [Pa-1] (Egelstaff p201 Eq 10.21) at q=%g [Angs-1]\n", - ChiT, q_min); - printf("# Isothermal sound velocity c_T=%g [m/s] (Lovesey T1 p210 Eq 5.197) at q=%g [Angs-1]\n", - c_T, q_min); - - /* Computation if C11 is rather tricky as it is obtained from w_l, which is usually quite noisy - * This means that the obtained values are not reliable from C = rho c_l^2 (Egelstaff Eq 14.10b p284) - * C44 = rho c_c^2 ~ C11/3 - */ - double w_l = Table_Index(Sqw_moments[4], q_min_index, 0); /* meV */ - double c_l = 2*PI*w_l*meV2Hz/q_min/1e10; /* meV*Angs -> m/s */ - double C11 = (Sqw->mat_weight*Da)*(Sqw->mat_rho*1e30)*c_l*c_l; - printf("# Elastic modulus C11=%g [GPa] (Egelstaff Eq 14.10b p284) [rough estimate] at q=%g [Angs-1]\n", - C11/1e9, q_min); + sprintf (Gqw.filename, "G(q,w) from %s (generalized density of states, Carpenter J Non Cryst Sol 92 (1987) 153)", Sqw_Data->filename); + Gqw.block_number = 1; + Gqw.min_x = 0; + Gqw.max_x = Sqw_Data->q_max; + Gqw.step_x = Sqw_Data->q_step; + + for (index_w = 0; index_w < Sqw_Data->w_bins; index_w++) { + double w = -Sqw_Data->w_max + index_w * Sqw_Data->w_step; /* w value in Sqw_full */ + double gw = 0; + for (index_q = 0; index_q < Sqw_Data->q_bins; index_q++) { + double q = index_q * Sqw_Data->q_step; /* q value in Sqw_full ; q_min = 0 */ + double sqw_full = Table_Index (Sqw_Data->Sqw, index_q, index_w); + double n = 1 / (exp (w / (Sqw->Temperature * Sqw->T2E)) - 1); /* Bose factor */ + double DW = q && u2 ? exp (2 * u2 * q * q / 6) : 1; /* Debye-Weller factor */ + double gqw = q && n + 1 ? sqw_full * DW * 2 * (Sqw->mat_weight * Da) * w / (n + 1) / q / q : 0; + if (!Table_SetElement (&Gqw, index_q, index_w, gqw)) + printf ("Isotropic_Sqw: %s: " + "Error when setting Gqw[%li q=%g,%li w=%g]=%g from file %s\n", + Sqw->compname, index_q, q, index_w, w, gqw, Sqw_Data->filename); + gw += gqw; + gqw_sum += gqw; + } + Table_SetElement (&Sqw_moments[6], index_w, 0, gw); } - } - if (do_inc) { - /* display the mean square displacement from S(q) = exp(-q^2/3) - = <3 * ln(S(q)) / q^2> - */ - if (u2_count && u2) { - printf("# Mean square displacement =%g [Angs^2] (<3 * ln(S(q)) / q^2>)\n", u2); + + /* normalize the density of states */ + for (index_w = 0; index_w < Sqw_Data->w_bins; index_w++) { + double gw = Table_Index (Sqw_moments[6], index_w, 0); + Table_SetElement (&Sqw_moments[6], index_w, 0, gw / gqw_sum); + for (index_q = 0; index_q < Sqw_Data->q_bins; index_q++) { + double gqw = Table_Index (Gqw, index_q, index_w); + Table_SetElement (&Gqw, index_q, index_w, gqw / gqw_sum); + } } - /* compute the mean diffusion coefficient D=w_c/q^2 */ - /* FWHM of gaussian is Gamma*RMS2FWHM, only in diffusive regime (Q < 0.2 Angs-1) */ - if (q_min_index > 0 && q_min && q_min < 0.6) { - double w_c = Table_Index(Sqw_moments[3], q_min_index, 0); - double D = 2*PI*w_c*meV2Hz/q_min/q_min/1e14*RMS2FWHM/2; /* meV*Angs^2 -> mm^2/s */ - printf("# Diffusion coefficient D=%g [mm^2/s] (Egelstaff p220)\n", D); - if (u2_count && u2 && D) - printf("# Jump relaxation time tau=%g [ns] (Egelstaff Eq 11.8 p220)\n", u2*1e-2/6/D); + /* write Gqw and free memory */ + if (Sqw_Data->w_bins > 1) { + sprintf (c, "%s_%s.gqw", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Gqw, c, "Momentum [Angs-1]", "'Generalized density of states' Energy [meV]", 0, Sqw_Data->q_max, -Sqw_Data->w_max, Sqw_Data->w_max); + Table_Free (&Gqw); } - } - ); /* MPI_MASTER */ + } /* if T>0 */ - /* density of states (generalized) */ - if (!Table_Init(&Gqw, Sqw_Data->q_bins, Sqw_Data->w_bins)) { - printf("Isotropic_Sqw: %s: Cannot allocate G(q,w) Table (%lix%i).\n" - "WARNING Skipping S(q,w) diagnosis.\n", - Sqw->compname, Sqw_Data->q_bins, 1); - return; - } - sprintf(Gqw.filename, - "G(q,w) from %s (generalized density of states, Carpenter J Non Cryst Sol 92 (1987) 153)", - Sqw_Data->filename); - Gqw.block_number = 1; - Gqw.min_x = 0; - Gqw.max_x = Sqw_Data->q_max; - Gqw.step_x = Sqw_Data->q_step; - - for (index_w=0; index_w < Sqw_Data->w_bins; index_w++) { - double w = -Sqw_Data->w_max + index_w*Sqw_Data->w_step; /* w value in Sqw_full */ - double gw = 0; - for (index_q=0; index_q < Sqw_Data->q_bins; index_q++) { - double q = index_q*Sqw_Data->q_step; /* q value in Sqw_full ; q_min = 0 */ - double sqw_full = Table_Index(Sqw_Data->Sqw, index_q, index_w); - double n = 1/(exp(w/(Sqw->Temperature*Sqw->T2E))-1); /* Bose factor */ - double DW = q && u2 ? exp(2*u2*q*q/6) : 1; /* Debye-Weller factor */ - double gqw = q && n+1 ? sqw_full*DW*2*(Sqw->mat_weight*Da)*w/(n+1)/q/q : 0; - if (!Table_SetElement(&Gqw, index_q, index_w, gqw)) - printf("Isotropic_Sqw: %s: " - "Error when setting Gqw[%li q=%g,%li w=%g]=%g from file %s\n", - Sqw->compname, index_q, q, index_w, w, gqw, Sqw_Data->filename); - gw += gqw; - gqw_sum += gqw; + /* write all tables to disk M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) */ + if (Sqw_Data->w_bins > 1) { + sprintf (c, "%s_%s.m1", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[1], c, "Momentum [Angs-1]", "int w S(q,w) dw (recoil) q^2/2m [meV]", 0, Sqw_Data->q_max, 0, 0); + sprintf (c, "%s_%s.w_l", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[4], c, "Momentum [Angs-1]", "w_l(q) harmonic frequency [meV]", 0, Sqw_Data->q_max, 0, 0); + sprintf (c, "%s_%s.sqw", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_Data->Sqw, c, "Momentum [Angs-1]", "'S(q,w) dynamical structure factor [meV-1]' Energy [meV]", 0, Sqw_Data->q_max, -Sqw_Data->w_max, + Sqw_Data->w_max); + + if (Sqw->Temperature > 0) { + sprintf (c, "%s_%s.w_c", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[3], c, "Momentum [Angs-1]", "w_c(q) collective excitation [meV]", 0, Sqw_Data->q_max, 0, 0); + sprintf (c, "%s_%s_cl.sq", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[5], c, "Momentum [Angs-1]", "int S_cl(q,w) dw", 0, Sqw_Data->q_max, 0, 0); + sprintf (c, "%s_%s.gw", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[6], c, "Energy [meV]", "'Generalized effective density of states' Energy [meV]", -Sqw_Data->w_max, Sqw_Data->w_max, 0, 0); } - Table_SetElement(&Sqw_moments[6], index_w, 0, gw); } - - /* normalize the density of states */ - for (index_w=0; index_w < Sqw_Data->w_bins; index_w++) { - double gw = Table_Index(Sqw_moments[6], index_w, 0); - Table_SetElement(&Sqw_moments[6], index_w, 0, gw / gqw_sum); - for (index_q=0; index_q < Sqw_Data->q_bins; index_q++) { - double gqw = Table_Index(Gqw, index_q, index_w); - Table_SetElement(&Gqw, index_q, index_w, gqw / gqw_sum); + sprintf (c, "%s_%s.sq", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_moments[0], c, "Momentum [Angs-1]", "S(q) = int S(q,w) dw", 0, Sqw_Data->q_max, 0, 0); + sprintf (c, "%s_%s.sigma", Sqw->compname, Sqw_Data->type == 'c' ? "coh" : "inc"); + Table_Write (Sqw_Data->iqSq, c, "Energy [meV]", "sigma kf/ki int q S(q,w) dw scattering cross section [barns]", 0, 0, 0, 0); + + /* free Tables */ + for (index_q = 0; index_q < 7; Table_Free (&Sqw_moments[index_q++])) + ; + + } /* Sqw_diagnosis */ + + /***************************************************************************** + * Sqw_readfile: Read Sqw data files + * Returns Sqw_Data_struct or NULL in case of error + * Used in : Sqw_init (2) + *****************************************************************************/ + struct Sqw_Data_struct* + Sqw_readfile (struct Sqw_sample_struct* Sqw, char* file, struct Sqw_Data_struct* Sqw_Data) { + + t_Table* Table_Array = NULL; + long nblocks = 0; + char flag = 0; + + t_Table Sqw_full, iqSq; /* the Sqw (non symmetric) and total scattering X section */ + + double sum = 0; + double mat_at_nb = 1; + double iq2Sq = 0; + long* SW_lookup = NULL; + long** QW_lookup = NULL; + char** parsing = NULL; + + long index_q, index_w; + double q_min_file, q_max_file, q_step_file; + long q_bins_file; + double w_min_file, w_max_file, w_step_file; + long w_bins_file; + double q_max, q_step; + long q_bins; + double w_max, w_step; + long w_bins; + + double alpha = 0; + + double M1 = 0; + double M1_cl = 0; + double T = 0; + double T_file = 0; + long T_count = 0; + long M1_count = 0; + long M1_cl_count = 0; + + /* setup default */ + Sqw_Data_init (Sqw_Data); + + if (!file || !strlen (file) || !strcmp (file, "NULL") || !strcmp (file, "0")) + return (Sqw_Data); + /* read the Sqw file */ + Table_Array = Table_Read_Array (file, &nblocks); + strncpy (Sqw_Data->filename, file, 80); + if (!Table_Array) + return (NULL); + + /* (1) parsing of header ================================================== */ + parsing = Table_ParseHeader (Table_Array[0].header, "Vc", "V_0", "sigma_abs", "sigma_a ", "sigma_inc", "sigma_i ", "column_j", /* 6 */ + "column_d", "column_F2", "column_DW", "column_Dd", "column_inv2d", "column_1/2d", "column_sintheta_lambda", "column_q", /* 14 */ + "sigma_coh", "sigma_c ", "Temperature", "column_Sq", "column_F ", /* 19 */ + "V_rho", "density", "weight", "nb_atoms", "multiplicity", "classical", NULL); + if (parsing) { + int i; + if (parsing[0] && !Sqw->mat_rho) + Sqw->mat_rho = 1 / atof (parsing[0]); + if (parsing[1] && !Sqw->mat_rho) + Sqw->mat_rho = 1 / atof (parsing[1]); + if (parsing[2] && !Sqw->s_abs) + Sqw->s_abs = atof (parsing[2]); + if (parsing[3] && !Sqw->s_abs) + Sqw->s_abs = atof (parsing[3]); + if (parsing[4] && !Sqw->s_inc) + Sqw->s_inc = atof (parsing[4]); + if (parsing[5] && !Sqw->s_inc) + Sqw->s_inc = atof (parsing[5]); + if (parsing[6]) + Sqw->column_order[0] = atoi (parsing[6]); + if (parsing[7]) + Sqw->column_order[1] = atoi (parsing[7]); + if (parsing[8]) + Sqw->column_order[2] = atoi (parsing[8]); + if (parsing[9]) + Sqw->column_order[3] = atoi (parsing[9]); + if (parsing[10]) + Sqw->column_order[4] = atoi (parsing[10]); + if (parsing[11]) + Sqw->column_order[5] = atoi (parsing[11]); + if (parsing[12]) + Sqw->column_order[5] = atoi (parsing[12]); + if (parsing[13]) + Sqw->column_order[5] = atoi (parsing[13]); + if (parsing[14]) + Sqw->column_order[6] = atoi (parsing[14]); + if (parsing[15] && !Sqw->s_coh) + Sqw->s_coh = atof (parsing[15]); + if (parsing[16] && !Sqw->s_coh) + Sqw->s_coh = atof (parsing[16]); + if (parsing[17] && !Sqw->Temperature) + Sqw->Temperature = atof (parsing[17]); /* from user or file */ + if (parsing[17]) + T_file = atof (parsing[17]); /* from file */ + if (parsing[18]) + Sqw->column_order[8] = atoi (parsing[18]); + if (parsing[19]) + Sqw->column_order[7] = atoi (parsing[19]); + if (parsing[20] && !Sqw->mat_rho) + Sqw->mat_rho = atof (parsing[20]); + if (parsing[21] && !Sqw->mat_density) + Sqw->mat_density = atof (parsing[21]); + if (parsing[22] && !Sqw->mat_weight) + Sqw->mat_weight = atof (parsing[22]); + if (parsing[23]) + mat_at_nb = atof (parsing[23]); + if (parsing[24]) + mat_at_nb = atof (parsing[24]); + if (parsing[25]) { /* classical is found in the header */ + char* endptr; + double value = strtod (parsing[25], &endptr); + if (*endptr == *parsing[25]) { + if (Sqw->sqw_classical < 0) + Sqw->sqw_classical = 1; + } else + Sqw->sqw_classical = value; } + for (i = 0; i <= 25; i++) + if (parsing[i]) + free (parsing[i]); + free (parsing); } - /* write Gqw and free memory */ - if (Sqw_Data->w_bins > 1) { - sprintf(c, "%s_%s.gqw", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Gqw, c, "Momentum [Angs-1]", "'Generalized density of states' Energy [meV]", - 0,Sqw_Data->q_max,-Sqw_Data->w_max,Sqw_Data->w_max); - Table_Free(&Gqw); + /* compute the scattering unit density from material weight and density */ + /* the weight of the scattering element is the chemical formula molecular weight + * times the nb of chemical formulae in the scattering element (nb_atoms) */ + if (!Sqw->mat_rho && Sqw->mat_density > 0 && Sqw->mat_weight > 0 && mat_at_nb > 0) { + /* molar volume [cm^3/mol] = weight [g/mol] / density [g/cm^3] */ + /* atom density per Angs^3 = [mol/cm^3] * N_Avogadro *(1e-8)^3 */ + Sqw->mat_rho = Sqw->mat_density / (Sqw->mat_weight * mat_at_nb) / 1e24 * NA; + MPI_MASTER (if (Sqw->verbose_output > 0) + printf ("Isotropic_Sqw: %s: Computing scattering unit density V_rho=%g [AA^-3] from density=%g [g/cm^3] weight=%g [g/mol].\n", + Sqw->compname, Sqw->mat_rho, Sqw->mat_density, Sqw->mat_weight);); } - } /* if T>0 */ - - /* write all tables to disk M0=S(q) M1=E_r M3 w_c w_l M0_cl=S_cl(q) */ - if (Sqw_Data->w_bins > 1) { - sprintf(c, "%s_%s.m1", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[1], c, "Momentum [Angs-1]", "int w S(q,w) dw (recoil) q^2/2m [meV]", - 0,Sqw_Data->q_max,0,0); - sprintf(c, "%s_%s.w_l", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[4], c, "Momentum [Angs-1]", "w_l(q) harmonic frequency [meV]", - 0,Sqw_Data->q_max,0,0); - sprintf(c, "%s_%s.sqw", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_Data->Sqw, c, "Momentum [Angs-1]", "'S(q,w) dynamical structure factor [meV-1]' Energy [meV]", - 0,Sqw_Data->q_max,-Sqw_Data->w_max,Sqw_Data->w_max); - - if (Sqw->Temperature > 0) { - sprintf(c, "%s_%s.w_c", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[3], c, "Momentum [Angs-1]", "w_c(q) collective excitation [meV]", 0,Sqw_Data->q_max,0,0); - sprintf(c, "%s_%s_cl.sq", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[5], c, "Momentum [Angs-1]", "int S_cl(q,w) dw", - 0,Sqw_Data->q_max,0,0); - sprintf(c, "%s_%s.gw", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[6], c, "Energy [meV]", "'Generalized effective density of states' Energy [meV]", - -Sqw_Data->w_max,Sqw_Data->w_max,0,0); + /* the scattering unit cross sections are the chemical formula ones + * times the nb of chemical formulae in the scattering element */ + if (mat_at_nb > 0) { + Sqw->s_abs *= mat_at_nb; + Sqw->s_inc *= mat_at_nb; + Sqw->s_coh *= mat_at_nb; } - } - sprintf(c, "%s_%s.sq", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_moments[0], c, "Momentum [Angs-1]","S(q) = int S(q,w) dw", 0,Sqw_Data->q_max,0,0); - sprintf(c, "%s_%s.sigma", Sqw->compname, Sqw_Data->type=='c' ? "coh" : "inc"); - Table_Write(Sqw_Data->iqSq, c, "Energy [meV]", "sigma kf/ki int q S(q,w) dw scattering cross section [barns]", 0,0,0,0); - - /* free Tables */ - for (index_q=0; index_q < 7; Table_Free(&Sqw_moments[index_q++])); - -} /* Sqw_diagnosis */ -/***************************************************************************** -* Sqw_readfile: Read Sqw data files -* Returns Sqw_Data_struct or NULL in case of error -* Used in : Sqw_init (2) -*****************************************************************************/ -struct Sqw_Data_struct *Sqw_readfile( - struct Sqw_sample_struct *Sqw, char *file, struct Sqw_Data_struct *Sqw_Data) -{ - - t_Table *Table_Array= NULL; - long nblocks = 0; - char flag = 0; - - t_Table Sqw_full, iqSq; /* the Sqw (non symmetric) and total scattering X section */ - - double sum=0; - double mat_at_nb=1; - double iq2Sq=0; - long *SW_lookup=NULL; - long **QW_lookup=NULL; - char **parsing =NULL; - - long index_q, index_w; - double q_min_file, q_max_file, q_step_file; - long q_bins_file; - double w_min_file, w_max_file, w_step_file; - long w_bins_file; - double q_max, q_step; - long q_bins; - double w_max, w_step; - long w_bins; - - double alpha=0; - - double M1 = 0; - double M1_cl = 0; - double T = 0; - double T_file = 0; - long T_count = 0; - long M1_count = 0; - long M1_cl_count = 0; - - /* setup default */ - Sqw_Data_init(Sqw_Data); - - if (!file || !strlen(file) || !strcmp(file, "NULL") || !strcmp(file, "0")) return(Sqw_Data); - /* read the Sqw file */ - Table_Array = Table_Read_Array(file, &nblocks); - strncpy(Sqw_Data->filename, file, 80); - if (!Table_Array) return(NULL); - - /* (1) parsing of header ================================================== */ - parsing = Table_ParseHeader(Table_Array[0].header, - "Vc","V_0", - "sigma_abs","sigma_a ", - "sigma_inc","sigma_i ", - "column_j", /* 6 */ - "column_d", - "column_F2", - "column_DW", - "column_Dd", - "column_inv2d", "column_1/2d", "column_sintheta_lambda", - "column_q", /* 14 */ - "sigma_coh","sigma_c ", - "Temperature", - "column_Sq", - "column_F ", /* 19 */ - "V_rho", - "density", - "weight", - "nb_atoms","multiplicity", - "classical", - NULL); - if (parsing) { - int i; - if (parsing[0] && !Sqw->mat_rho) Sqw->mat_rho =1/atof(parsing[0]); - if (parsing[1] && !Sqw->mat_rho) Sqw->mat_rho =1/atof(parsing[1]); - if (parsing[2] && !Sqw->s_abs) Sqw->s_abs = atof(parsing[2]); - if (parsing[3] && !Sqw->s_abs) Sqw->s_abs = atof(parsing[3]); - if (parsing[4] && !Sqw->s_inc) Sqw->s_inc = atof(parsing[4]); - if (parsing[5] && !Sqw->s_inc) Sqw->s_inc = atof(parsing[5]); - if (parsing[6]) Sqw->column_order[0]=atoi(parsing[6]); - if (parsing[7]) Sqw->column_order[1]=atoi(parsing[7]); - if (parsing[8]) Sqw->column_order[2]=atoi(parsing[8]); - if (parsing[9]) Sqw->column_order[3]=atoi(parsing[9]); - if (parsing[10]) Sqw->column_order[4]=atoi(parsing[10]); - if (parsing[11]) Sqw->column_order[5]=atoi(parsing[11]); - if (parsing[12]) Sqw->column_order[5]=atoi(parsing[12]); - if (parsing[13]) Sqw->column_order[5]=atoi(parsing[13]); - if (parsing[14]) Sqw->column_order[6]=atoi(parsing[14]); - if (parsing[15] && !Sqw->s_coh) Sqw->s_coh=atof(parsing[15]); - if (parsing[16] && !Sqw->s_coh) Sqw->s_coh=atof(parsing[16]); - if (parsing[17] && !Sqw->Temperature) Sqw->Temperature=atof(parsing[17]); /* from user or file */ - if (parsing[17] ) T_file=atof(parsing[17]); /* from file */ - if (parsing[18]) Sqw->column_order[8]=atoi(parsing[18]); - if (parsing[19]) Sqw->column_order[7]=atoi(parsing[19]); - if (parsing[20] && !Sqw->mat_rho) Sqw->mat_rho =atof(parsing[20]); - if (parsing[21] && !Sqw->mat_density) Sqw->mat_density=atof(parsing[21]); - if (parsing[22] && !Sqw->mat_weight) Sqw->mat_weight =atof(parsing[22]); - if (parsing[23] ) mat_at_nb =atof(parsing[23]); - if (parsing[24] ) mat_at_nb =atof(parsing[24]); - if (parsing[25] ) { /* classical is found in the header */ - char *endptr; - double value = strtod(parsing[25], &endptr); - if (*endptr == *parsing[25]) { - if (Sqw->sqw_classical < 0) Sqw->sqw_classical = 1; - } else Sqw->sqw_classical = value; + if (nblocks) { + if (nblocks == 1) { + /* import Powder file */ + t_Table* newTable = NULL; + newTable = Sqw_read_PowderN (Sqw, Table_Array[0]); + if (!newTable) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: ERROR importing powder line file %s.\n" + " Check format definition.\n", + Sqw->compname, file);); + exit (-1); + } else + flag = 0; + Table_Free_Array (Table_Array); + Table_Array = newTable; + } else if (nblocks != 3) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: ERROR " + "File %s contains %li block%s instead of 3.\n", + Sqw->compname, file, nblocks, (nblocks == 1 ? "" : "s"));); + } else { + flag = 0; + Sqw->barns = 0; /* Sqw files do not use powder_barns */ + } } - for (i=0; i<=25; i++) if (parsing[i]) free(parsing[i]); - free(parsing); - } - - /* compute the scattering unit density from material weight and density */ - /* the weight of the scattering element is the chemical formula molecular weight - * times the nb of chemical formulae in the scattering element (nb_atoms) */ - if (!Sqw->mat_rho && Sqw->mat_density > 0 && Sqw->mat_weight > 0 && mat_at_nb > 0) { - /* molar volume [cm^3/mol] = weight [g/mol] / density [g/cm^3] */ - /* atom density per Angs^3 = [mol/cm^3] * N_Avogadro *(1e-8)^3 */ - Sqw->mat_rho = Sqw->mat_density/(Sqw->mat_weight*mat_at_nb)/1e24*NA; - MPI_MASTER( - if (Sqw->verbose_output > 0) - printf("Isotropic_Sqw: %s: Computing scattering unit density V_rho=%g [AA^-3] from density=%g [g/cm^3] weight=%g [g/mol].\n", - Sqw->compname, Sqw->mat_rho, Sqw->mat_density, Sqw->mat_weight); - ); - } - - /* the scattering unit cross sections are the chemical formula ones - * times the nb of chemical formulae in the scattering element */ - if (mat_at_nb > 0) { - Sqw->s_abs *= mat_at_nb; Sqw->s_inc *= mat_at_nb; Sqw->s_coh *= mat_at_nb; - } - - if (nblocks) { - if (nblocks == 1) { - /* import Powder file */ - t_Table *newTable = NULL; - newTable = Sqw_read_PowderN(Sqw, Table_Array[0]); - if (!newTable) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: ERROR importing powder line file %s.\n" - " Check format definition.\n", - Sqw->compname, file); - ); - exit(-1); - } else flag=0; - Table_Free_Array(Table_Array); - Table_Array = newTable; - } else if (nblocks != 3) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: ERROR " - "File %s contains %li block%s instead of 3.\n", - Sqw->compname, file, nblocks, (nblocks == 1 ? "" : "s")); - ); - } else { flag=0; Sqw->barns=0; /* Sqw files do not use powder_barns */ } - } - /* print some info about Sqw files */ - if (flag) Sqw->verbose_output = 2; + /* print some info about Sqw files */ + if (flag) + Sqw->verbose_output = 2; - if (flag) { - MPI_MASTER( - if (nblocks) printf("ERROR Wrong file format.\n" - " Disabling contribution.\n" - " File must contain 3 blocks for [q,w,sqw] or Powder file (1 block, laz,lau).\n"); - ); - return(Sqw_Data); - } - - sprintf(Table_Array[0].filename, "%s#q", file); - sprintf(Table_Array[1].filename, "%s#w", file); - sprintf(Table_Array[2].filename, "%s#sqw", file); + if (flag) { + MPI_MASTER (if (nblocks) printf ("ERROR Wrong file format.\n" + " Disabling contribution.\n" + " File must contain 3 blocks for [q,w,sqw] or Powder file (1 block, laz,lau).\n");); + return (Sqw_Data); + } - MPI_MASTER( - if (nblocks && Sqw->verbose_output > 2) { - printf("Isotropic_Sqw: %s file read, analysing...\n", file); - Table_Info_Array(Table_Array); - } - ); + sprintf (Table_Array[0].filename, "%s#q", file); + sprintf (Table_Array[1].filename, "%s#w", file); + sprintf (Table_Array[2].filename, "%s#sqw", file); - /* (2) compute range for full +/- w and allocate S(q,w) =================== */ + MPI_MASTER (if (nblocks && Sqw->verbose_output > 2) { + printf ("Isotropic_Sqw: %s file read, analysing...\n", file); + Table_Info_Array (Table_Array); + }); - /* get the q,w extend of the table from the file */ - q_bins_file = Table_Array[0].rows*Table_Array[0].columns; - w_bins_file = Table_Array[1].rows*Table_Array[1].columns; + /* (2) compute range for full +/- w and allocate S(q,w) =================== */ - /* is there enough qw data in file to proceed ? */ - if (q_bins_file <= 1 || w_bins_file <= 0) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Data file %s has incomplete q or omega information (%lix%li).\n" - "ERROR Exiting.\n", - Sqw->compname, file, q_bins_file, w_bins_file); - ); - return(Sqw_Data); - } - - q_min_file = Table_Array[0].min_x; q_max_file = Table_Array[0].max_x; - q_step_file = Table_Array[0].step_x ? Table_Array[0].step_x : (q_max_file - q_min_file)/(Table_Array[0].rows*Table_Array[0].columns); - w_min_file = Table_Array[1].min_x; w_max_file = Table_Array[1].max_x; - w_step_file = Table_Array[1].step_x; - - /* create a regular extended q,w and Sqw tables applying the exp(-hw/kT) factor */ - q_max = q_max_file; - q_bins = (q_step_file ? q_max/q_step_file : q_bins_file)+1; - q_step = q_bins-1 > 0 ? q_max/(q_bins-1) : 1; - w_max = fabs(w_max_file); - if (fabs(w_min_file) > fabs(w_max_file)) w_max = fabs(w_min_file); - /* w_min =-w_max */ - w_bins = (w_step_file ? (long)(2*w_max/w_step_file) : 0)+1; /* twice the initial w range */ - w_step = w_bins-1 > 0 ? 2*w_max/(w_bins-1) : 1; /* that is +/- w_max */ - - /* create the Sqw table in full range */ - if (!Table_Init(&Sqw_full, q_bins, w_bins)) { - printf("Isotropic_Sqw: %s: Cannot allocate Sqw_full Table (%lix%li).\n" - "ERROR Exiting.\n", - Sqw->compname, q_bins, w_bins); - return(NULL); - } - sprintf(Sqw_full.filename, "S(q,w) from %s (dynamic structure factor)", file); - Sqw_full.block_number = 1; - - Sqw_Data->q_bins = q_bins; Sqw_Data->q_max = q_max; Sqw_Data->q_step= q_step; - Sqw_Data->w_bins = w_bins; Sqw_Data->w_max = w_max; Sqw_Data->w_step= w_step; - Sqw_Data->q_min_file = q_min_file; - - /* build an energy symmetric Sqw data set with detailed balance there-in, so - * that we can both compute effective scattering Xsection, probability distributions - * that is S(q) and \int q S(q). - * We scan the new Sqw table elements with regular qw binning and search for their - * equivalent element in the Sqw file data set. This is slower than doing the opposite. - * We could be scanning all file elements, and fill the new table, but in the - * process some empty spaces may appear when the initial file binning is not regular - * in qw, leading to gaps in the new table. - */ - - /* (3) we build q and w lookup table for conversion file -> sqw_full ====== */ - MPI_MASTER( - if (Sqw->verbose_output > 2) - printf("Isotropic_Sqw: %s: Creating Sqw_full... (%s, %s)\n", - Sqw->compname, file, Sqw->type=='c' ? "coh" : "inc"); - ); - - double *w_file2full = malloc(w_bins*sizeof(double)); /* lookup table for fast file -> Sqw_full allocation */ - if (!w_file2full) { - fprintf(stderr,"Isotropic_Sqw: Catastrophic Error allocating lookup table w_file2full!\nEXIT\n"); - exit(-1); - } + /* get the q,w extend of the table from the file */ + q_bins_file = Table_Array[0].rows * Table_Array[0].columns; + w_bins_file = Table_Array[1].rows * Table_Array[1].columns; - for (index_w=0; index_w < w_bins; w_file2full[index_w++]=0); + /* is there enough qw data in file to proceed ? */ + if (q_bins_file <= 1 || w_bins_file <= 0) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Data file %s has incomplete q or omega information (%lix%li).\n" + "ERROR Exiting.\n", + Sqw->compname, file, q_bins_file, w_bins_file);); + return (Sqw_Data); + } - for (index_w=0; index_w < w_bins; index_w++) { + q_min_file = Table_Array[0].min_x; + q_max_file = Table_Array[0].max_x; + q_step_file = Table_Array[0].step_x ? Table_Array[0].step_x : (q_max_file - q_min_file) / (Table_Array[0].rows * Table_Array[0].columns); + w_min_file = Table_Array[1].min_x; + w_max_file = Table_Array[1].max_x; + w_step_file = Table_Array[1].step_x; + + /* create a regular extended q,w and Sqw tables applying the exp(-hw/kT) factor */ + q_max = q_max_file; + q_bins = (q_step_file ? q_max / q_step_file : q_bins_file) + 1; + q_step = q_bins - 1 > 0 ? q_max / (q_bins - 1) : 1; + w_max = fabs (w_max_file); + if (fabs (w_min_file) > fabs (w_max_file)) + w_max = fabs (w_min_file); + /* w_min =-w_max */ + w_bins = (w_step_file ? (long)(2 * w_max / w_step_file) : 0) + 1; /* twice the initial w range */ + w_step = w_bins - 1 > 0 ? 2 * w_max / (w_bins - 1) : 1; /* that is +/- w_max */ + + /* create the Sqw table in full range */ + if (!Table_Init (&Sqw_full, q_bins, w_bins)) { + printf ("Isotropic_Sqw: %s: Cannot allocate Sqw_full Table (%lix%li).\n" + "ERROR Exiting.\n", + Sqw->compname, q_bins, w_bins); + return (NULL); + } + sprintf (Sqw_full.filename, "S(q,w) from %s (dynamic structure factor)", file); + Sqw_full.block_number = 1; + + Sqw_Data->q_bins = q_bins; + Sqw_Data->q_max = q_max; + Sqw_Data->q_step = q_step; + Sqw_Data->w_bins = w_bins; + Sqw_Data->w_max = w_max; + Sqw_Data->w_step = w_step; + Sqw_Data->q_min_file = q_min_file; + + /* build an energy symmetric Sqw data set with detailed balance there-in, so + * that we can both compute effective scattering Xsection, probability distributions + * that is S(q) and \int q S(q). + * We scan the new Sqw table elements with regular qw binning and search for their + * equivalent element in the Sqw file data set. This is slower than doing the opposite. + * We could be scanning all file elements, and fill the new table, but in the + * process some empty spaces may appear when the initial file binning is not regular + * in qw, leading to gaps in the new table. + */ + + /* (3) we build q and w lookup table for conversion file -> sqw_full ====== */ + MPI_MASTER (if (Sqw->verbose_output > 2) + printf ("Isotropic_Sqw: %s: Creating Sqw_full... (%s, %s)\n", Sqw->compname, file, Sqw->type == 'c' ? "coh" : "inc");); + + double* w_file2full = malloc (w_bins * sizeof (double)); /* lookup table for fast file -> Sqw_full allocation */ + if (!w_file2full) { + fprintf (stderr, "Isotropic_Sqw: Catastrophic Error allocating lookup table w_file2full!\nEXIT\n"); + exit (-1); + } - double w = -w_max + index_w*w_step; /* w value in Sqw_full */ - double index_w_file=0; /* w index in Sqw file */ - char found=0; - for (index_w_file=0; index_w_file < w_bins_file; index_w_file++) { - double w0=Table_Index(Table_Array[1], (long)index_w_file, 0); - double w1=Table_Index(Table_Array[1], (long)index_w_file+1,0); - /* test if we are in Stokes */ - if (w0 > w1) { - double tmp=w0; w0=w1; w1=tmp; - } - if (w0 <= w && w < w1) { - /* w ~ w_file exists in file, usually on w > 0 side Stokes, neutron looses energy */ - index_w_file += w1-w0 ? (w-w0)/(w1-w0) : 0; /* may correspond with a position in-betwwen two w elements */ - found=1; - break; + for (index_w = 0; index_w < w_bins; w_file2full[index_w++] = 0) + ; + + for (index_w = 0; index_w < w_bins; index_w++) { + + double w = -w_max + index_w * w_step; /* w value in Sqw_full */ + double index_w_file = 0; /* w index in Sqw file */ + char found = 0; + for (index_w_file = 0; index_w_file < w_bins_file; index_w_file++) { + double w0 = Table_Index (Table_Array[1], (long)index_w_file, 0); + double w1 = Table_Index (Table_Array[1], (long)index_w_file + 1, 0); + /* test if we are in Stokes */ + if (w0 > w1) { + double tmp = w0; + w0 = w1; + w1 = tmp; + } + if (w0 <= w && w < w1) { + /* w ~ w_file exists in file, usually on w > 0 side Stokes, neutron looses energy */ + index_w_file += w1 - w0 ? (w - w0) / (w1 - w0) : 0; /* may correspond with a position in-betwwen two w elements */ + found = 1; + break; + } } - } - /* test if we are in anti-Stokes */ - if (!found) - for (index_w_file=0; index_w_file < w_bins_file; index_w_file++) { - double w0=Table_Index(Table_Array[1], (long)index_w_file, 0); - double w1=Table_Index(Table_Array[1], (long)index_w_file+1,0); /* test if we are in anti-Stokes */ - if (w0 > w1) { - double tmp=w0; w0=w1; w1=tmp; - } - if (w0 <= -w && -w < w1) { /* w value is mirrored from the opposite side in file */ - index_w_file += w1-w0 ? (-w-w0)/(w1-w0) : 0; - index_w_file = -index_w_file; /* in this case, index value is set to negative */ - break; - } + if (!found) + for (index_w_file = 0; index_w_file < w_bins_file; index_w_file++) { + double w0 = Table_Index (Table_Array[1], (long)index_w_file, 0); + double w1 = Table_Index (Table_Array[1], (long)index_w_file + 1, 0); + /* test if we are in anti-Stokes */ + if (w0 > w1) { + double tmp = w0; + w0 = w1; + w1 = tmp; + } + if (w0 <= -w && -w < w1) { /* w value is mirrored from the opposite side in file */ + index_w_file += w1 - w0 ? (-w - w0) / (w1 - w0) : 0; + index_w_file = -index_w_file; /* in this case, index value is set to negative */ + break; + } + } + w_file2full[index_w] = index_w_file; } - w_file2full[index_w] = index_w_file; - } - double *q_file2full=malloc(q_bins*sizeof(double)); - if (!q_file2full) { - fprintf(stderr,"Isotropic_Sqw: Catastrophic Error allocating lookup table q_file2full!\nEXIT\n"); - exit(-1); - } - for (index_q=0; index_q < q_bins; q_file2full[index_q++]=0); + double* q_file2full = malloc (q_bins * sizeof (double)); + if (!q_file2full) { + fprintf (stderr, "Isotropic_Sqw: Catastrophic Error allocating lookup table q_file2full!\nEXIT\n"); + exit (-1); + } + for (index_q = 0; index_q < q_bins; q_file2full[index_q++] = 0) + ; - for (index_q=0; index_q < q_bins; index_q++) { + for (index_q = 0; index_q < q_bins; index_q++) { - double q = index_q*q_step; /* q value in Sqw_full ; q_min = 0 */ - double index_q_file= 0; /* q index in Sqw file */ + double q = index_q * q_step; /* q value in Sqw_full ; q_min = 0 */ + double index_q_file = 0; /* q index in Sqw file */ - /* search for q value in the initial file data set */ - if (q <= q_min_file) index_q_file=0; - else if (q >= q_max_file) index_q_file=q_bins_file-1; - else - for (index_q_file=0; index_q_file < q_bins_file; index_q_file++) { - double q0=Table_Index(Table_Array[0], (long)index_q_file, 0); - double q1=Table_Index(Table_Array[0], (long)index_q_file+1,0); - if (q0 <= q && q <= q1) { - index_q_file += q1-q0 ? (q-q0)/(q1-q0) : 0; /* may correspond with a position in-betwwen two q elements */ - break; - } + /* search for q value in the initial file data set */ + if (q <= q_min_file) + index_q_file = 0; + else if (q >= q_max_file) + index_q_file = q_bins_file - 1; + else + for (index_q_file = 0; index_q_file < q_bins_file; index_q_file++) { + double q0 = Table_Index (Table_Array[0], (long)index_q_file, 0); + double q1 = Table_Index (Table_Array[0], (long)index_q_file + 1, 0); + if (q0 <= q && q <= q1) { + index_q_file += q1 - q0 ? (q - q0) / (q1 - q0) : 0; /* may correspond with a position in-betwwen two q elements */ + break; + } + } + q_file2full[index_q] = index_q_file; } - q_file2full[index_q] = index_q_file; - } - /* (4) now we build Sqw on full Q,W ranges, using the Q,W table lookup above -> Sqw_full */ - for (index_q=0; index_q < q_bins; index_q++) { - - double q = index_q*q_step; /* q value in Sqw_full ; q_min = 0 */ - double index_q_file= 0; /* q index in Sqw file */ - - /* get q value in the initial file data set */ - index_q_file = q_file2full[index_q]; - - /* now scan energy elements in Sqw full, and search these in file data */ - for (index_w=0; index_w < w_bins; index_w++) { - double w = -w_max + index_w*w_step; /* w value in Sqw_full */ - double index_w_file=0; /* w index in Sqw file */ - double sqw_file =0; /* Sqw(index_q, index_w) value interpolated from file */ - - /* search for w value in the file data set, negative when mirrored */ - index_w_file = w_file2full[index_w]; - /* get Sqw_file element, with bi-linear interpolation from file */ - /* when the initial file does not contain the energy, the opposite element (-w) is used */ - sqw_file = Table_Value2d(Table_Array[2], index_q_file, fabs(index_w_file)); - /* apply the minimum threshold to remove noisy background in S(q,w) */ - if (sqw_file < Sqw->sqw_threshold) sqw_file = 0; - else if (index_w_file < 0) sqw_file = -sqw_file; /* negative == mirrored from other side */ - - if (!Table_SetElement(&Sqw_full, index_q, index_w, sqw_file)) - printf("Isotropic_Sqw: %s: " - "Error when setting Sqw[%li q=%g,%li w=%g]=%g from file %s\n", - Sqw->compname, index_q, q, index_w, w, fabs(sqw_file), file); - } /* for index_w */ - } /* for index_q */ - - /* free memory and store limits for new full Sqw table */ - Table_Free_Array(Table_Array); - - /* if only one S(q,w) side is given, it is symmetrised by mirroring, then M1=0 */ - - /* (5) test if the Sqw_full is classical or not by computing the 1st moment (=0 for classical) */ - /* also compute temperature (quantum case) from file if not set */ - for (index_q=0; index_q < q_bins; index_q++) { - - double q = index_q*q_step; /* q value in Sqw_full ; q_min = 0 */ - - for (index_w=0; index_w < w_bins; index_w++) { - double w = -w_max + index_w*w_step; /* w value in Sqw_full */ - double sqw_full = Table_Index(Sqw_full, index_q, index_w); - long index_mw = w_bins-1-index_w; /* opposite w index in S(q,w) */ - double sqw_opp = Table_Index(Sqw_full, index_q, index_mw); - double T_defined= T_file ? T_file : Sqw->Temperature; /* T better from file, else from user */ - - /* the analysis must be done only on values which exist on both sides */ - /* as integrals must be symmetric, and Bose factor requires both sides as well */ - if (sqw_full > 0 && sqw_opp > 0) { - /* compute temperature from Bose factor */ - if (sqw_opp != sqw_full) { - T += fabs(w/log(sqw_opp/sqw_full)/Sqw->T2E); - T_count++; - } - /* we first assume Sqw is quantum. M1_cl should be 0, M1 should be recoil */ - M1 += w*sqw_full*w_step; - M1_count++; - /* we assume it is quantum (non symmetric) and check that its symmetrized version has M1_cl=0 */ - if (T_defined > 0) { - sqw_opp = sqw_full * Sqw_quantum_correction(-w, T_defined,Sqw->Q_correction); /* Sqw_cl */ - M1_cl += w*sqw_opp*w_step; - M1_cl_count++; - } else if (Sqw->mat_weight) { - /* T=0 ? would compute the M1_cl = M1 - recoil energy, assuming we have a quantum S(q,w) in file */ - /* the M1(quantum) = (MNEUTRON/m)*2.0725*q^2 recoil energy */ - double Da = 1.660538921e-27; /* atomic mass unit */ - double Er = (MNEUTRON/Sqw->mat_weight/Da)*2.0725*q*q; /* recoil for one scattering unit in the cell [meV] Schober JDN16 p239 */ - M1_cl += M1 - Er; - M1_cl_count++; - } - } /* both side from file */ - } /*index_w */ - } /*index_q */ - - if (T_count) T /= T_count; /* mean temperature from Bose ratio */ - if (M1_count) M1 /= M1_count; - if (M1_cl_count) M1_cl /= M1_cl_count; /* mean energy value along q range */ - - /* determine if we use a classical or quantum S(q,w) */ - if (Sqw->sqw_classical < 0) { - if (fabs(M1) < 2*w_step) { - Sqw->sqw_classical = 1; /* the initial Sqw from file seems to be centered, thus classical */ - } else if (fabs(M1_cl) < fabs(M1)) { - /* M1 for classical is closer to 0 than for quantum one */ - Sqw->sqw_classical = 0; /* initial data from file seems to be quantum (non classical) */ - } else { /* M1_cl > M1 > 2*w_step */ + /* (4) now we build Sqw on full Q,W ranges, using the Q,W table lookup above -> Sqw_full */ + for (index_q = 0; index_q < q_bins; index_q++) { + + double q = index_q * q_step; /* q value in Sqw_full ; q_min = 0 */ + double index_q_file = 0; /* q index in Sqw file */ + + /* get q value in the initial file data set */ + index_q_file = q_file2full[index_q]; + + /* now scan energy elements in Sqw full, and search these in file data */ + for (index_w = 0; index_w < w_bins; index_w++) { + double w = -w_max + index_w * w_step; /* w value in Sqw_full */ + double index_w_file = 0; /* w index in Sqw file */ + double sqw_file = 0; /* Sqw(index_q, index_w) value interpolated from file */ + + /* search for w value in the file data set, negative when mirrored */ + index_w_file = w_file2full[index_w]; + /* get Sqw_file element, with bi-linear interpolation from file */ + /* when the initial file does not contain the energy, the opposite element (-w) is used */ + sqw_file = Table_Value2d (Table_Array[2], index_q_file, fabs (index_w_file)); + /* apply the minimum threshold to remove noisy background in S(q,w) */ + if (sqw_file < Sqw->sqw_threshold) + sqw_file = 0; + else if (index_w_file < 0) + sqw_file = -sqw_file; /* negative == mirrored from other side */ + + if (!Table_SetElement (&Sqw_full, index_q, index_w, sqw_file)) + printf ("Isotropic_Sqw: %s: " + "Error when setting Sqw[%li q=%g,%li w=%g]=%g from file %s\n", + Sqw->compname, index_q, q, index_w, w, fabs (sqw_file), file); + } /* for index_w */ + } /* for index_q */ + + /* free memory and store limits for new full Sqw table */ + Table_Free_Array (Table_Array); + + /* if only one S(q,w) side is given, it is symmetrised by mirroring, then M1=0 */ + + /* (5) test if the Sqw_full is classical or not by computing the 1st moment (=0 for classical) */ + /* also compute temperature (quantum case) from file if not set */ + for (index_q = 0; index_q < q_bins; index_q++) { + + double q = index_q * q_step; /* q value in Sqw_full ; q_min = 0 */ + + for (index_w = 0; index_w < w_bins; index_w++) { + double w = -w_max + index_w * w_step; /* w value in Sqw_full */ + double sqw_full = Table_Index (Sqw_full, index_q, index_w); + long index_mw = w_bins - 1 - index_w; /* opposite w index in S(q,w) */ + double sqw_opp = Table_Index (Sqw_full, index_q, index_mw); + double T_defined = T_file ? T_file : Sqw->Temperature; /* T better from file, else from user */ + + /* the analysis must be done only on values which exist on both sides */ + /* as integrals must be symmetric, and Bose factor requires both sides as well */ + if (sqw_full > 0 && sqw_opp > 0) { + /* compute temperature from Bose factor */ + if (sqw_opp != sqw_full) { + T += fabs (w / log (sqw_opp / sqw_full) / Sqw->T2E); + T_count++; + } + /* we first assume Sqw is quantum. M1_cl should be 0, M1 should be recoil */ + M1 += w * sqw_full * w_step; + M1_count++; + /* we assume it is quantum (non symmetric) and check that its symmetrized version has M1_cl=0 */ + if (T_defined > 0) { + sqw_opp = sqw_full * Sqw_quantum_correction (-w, T_defined, Sqw->Q_correction); /* Sqw_cl */ + M1_cl += w * sqw_opp * w_step; + M1_cl_count++; + } else if (Sqw->mat_weight) { + /* T=0 ? would compute the M1_cl = M1 - recoil energy, assuming we have a quantum S(q,w) in file */ + /* the M1(quantum) = (MNEUTRON/m)*2.0725*q^2 recoil energy */ + double Da = 1.660538921e-27; /* atomic mass unit */ + double Er = (MNEUTRON / Sqw->mat_weight / Da) * 2.0725 * q * q; /* recoil for one scattering unit in the cell [meV] Schober JDN16 p239 */ + M1_cl += M1 - Er; + M1_cl_count++; + } + } /* both side from file */ + } /*index_w */ + } /*index_q */ + + if (T_count) + T /= T_count; /* mean temperature from Bose ratio */ + if (M1_count) + M1 /= M1_count; + if (M1_cl_count) + M1_cl /= M1_cl_count; /* mean energy value along q range */ + + /* determine if we use a classical or quantum S(q,w) */ + if (Sqw->sqw_classical < 0) { + if (fabs (M1) < 2 * w_step) { + Sqw->sqw_classical = 1; /* the initial Sqw from file seems to be centered, thus classical */ + } else if (fabs (M1_cl) < fabs (M1)) { + /* M1 for classical is closer to 0 than for quantum one */ + Sqw->sqw_classical = 0; /* initial data from file seems to be quantum (non classical) */ + } else { /* M1_cl > M1 > 2*w_step */ + MPI_MASTER (printf ("Isotropic_Sqw: %s: I do not know if S(q,w) data is classical or quantum.\n" + "WARNING First moment M1=%g M1_cl=%g for file %s. Defaulting to classical case.\n", + Sqw->compname, M1, M1_cl, file);); + } + } + if (Sqw->sqw_classical < 0) + Sqw->sqw_classical = 1; /* default when quantum/classical choice is not set */ + + /* (5b) set temperature. Temperatures defined are: + * T_file: temperature read from the .sqw file + * T: temperature computed from the quantum Sqw using detailed balance + * Sqw->Temperature: temperature defined by user, or read from file when not set + */ + + /* display some warnings about the computed temperature */ + if (T > 3000) + T = 0; /* unrealistic */ + if (!T_file && T) { MPI_MASTER( - printf("Isotropic_Sqw: %s: I do not know if S(q,w) data is classical or quantum.\n" - "WARNING First moment M1=%g M1_cl=%g for file %s. Defaulting to classical case.\n", - Sqw->compname, M1, M1_cl, file); + if (Sqw->verbose_output > 0) { + printf ("Isotropic_Sqw: %s: Temperature computed from S(q,w) data from %s is T=%g [K].\n", Sqw->compname, file, T); ); + } } - } - if (Sqw->sqw_classical < 0) Sqw->sqw_classical=1; /* default when quantum/classical choice is not set */ - /* (5b) set temperature. Temperatures defined are: - * T_file: temperature read from the .sqw file - * T: temperature computed from the quantum Sqw using detailed balance - * Sqw->Temperature: temperature defined by user, or read from file when not set - */ + if (Sqw->Temperature == 0) { + Sqw->Temperature = T_file ? T_file : T; /* 0: not set: we use file value, else computed */ + } else if (Sqw->Temperature == -1) { + Sqw->Temperature = 0; /* -1: no detailed balance. Display message at end of INIT */ + } else if (Sqw->Temperature == -2) { + Sqw->Temperature = T ? T : T_file; /* -2: use guessed value when available */ + } /* else let value as it is (e.g. >0) */ - - /* display some warnings about the computed temperature */ - if (T > 3000) T=0; /* unrealistic */ - if (!T_file && T) { - MPI_MASTER( - if (Sqw->verbose_output > 0) { - printf( "Isotropic_Sqw: %s: Temperature computed from S(q,w) data from %s is T=%g [K].\n", - Sqw->compname, file, T); - ); + if (Sqw->verbose_output > 0 && Sqw->Temperature) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Temperature set to T=%g [K]\n", Sqw->compname, Sqw->Temperature);); } - } - if (Sqw->Temperature == 0) { - Sqw->Temperature = T_file ? T_file : T; /* 0: not set: we use file value, else computed */ - } else if (Sqw->Temperature ==-1) { - Sqw->Temperature = 0; /* -1: no detailed balance. Display message at end of INIT */ - } else if (Sqw->Temperature ==-2) { - Sqw->Temperature = T ? T : T_file; /* -2: use guessed value when available */ - } /* else let value as it is (e.g. >0) */ - - if (Sqw->verbose_output > 0 && Sqw->Temperature) { - MPI_MASTER( - printf( "Isotropic_Sqw: %s: Temperature set to T=%g [K]\n", Sqw->compname, Sqw->Temperature); - ); - } - - MPI_MASTER( - if (Sqw->verbose_output > 0 && w_bins > 1) - printf("Isotropic_Sqw: %s: S(q,w) data from %s (%s) assumed to be %s.\n", - Sqw->compname, file, Sqw->type=='c' ? "coh" : "inc", - Sqw->sqw_classical ? "classical (symmetrised in energy)" : "non-classical (includes Bose factor, non symmetric in energy)"); - ); - - /* (6) apply detailed balance on Sqw_full for classical or quantum S(q,w) */ - /* compute the \int q^2 S(q) for normalisation */ - - MPI_MASTER( - if (Sqw->sqw_classical && Sqw->verbose_output > 0 && Sqw->Temperature > 0) - printf("Isotropic_Sqw: %s: Applying exp(hw/2kT) factor with T=%g [K] on %s file (classical/symmetric) using '%s' quantum correction\n", - Sqw->compname, Sqw->Temperature, file, Sqw->Q_correction); - ); - for (index_q=0; index_q < q_bins; index_q++) { - double sq = 0; - double q = index_q*q_step; /* q value in Sqw_full ; q_min = 0 */ - for (index_w=0; index_w < w_bins; index_w++) { - double w = -w_max + index_w*w_step; /* w value in Sqw_full */ - double balance = 1; /* detailed balance factor, default is 1 */ - double sqw_full = Table_Index(Sqw_full, index_q, index_w); - - /* do we use a symmetric S(q,w) from real G(r,t) from e.g. MD ? */ - - if (Sqw->sqw_classical && Sqw->Temperature > 0) /* data is symmetric, we apply Bose factor */ - /* un-symmetrize Sqw(file) * exp(hw/kT/2) on both sides */ - balance = Sqw_quantum_correction(w, Sqw->Temperature, Sqw->Q_correction); - else if (!Sqw->sqw_classical) { /* data is quantum (contains Bose) */ - if (sqw_full < 0) { /* quantum but mirrored/symmetric value (was missing in file) */ - if (T) - /* prefer to use T computed from file for mirroring */ - balance *= exp(w/(T*Sqw->T2E)); /* apply Bose where missing */ - else if (Sqw->Temperature) - balance *= exp(w/(Sqw->Temperature*Sqw->T2E)); /* apply Bose where missing */ - } - /* test if T computed from file matches requested T, else apply correction */ - if (T && Sqw->Temperature > 0 && Sqw->Temperature != T) { - balance *= exp(-w/(T*Sqw->T2E)/2); /* make it a classical data set: remove computed/read T from quantum data file */ - balance *= exp( w/(Sqw->Temperature*Sqw->T2E)/2); /* then apply Bose to requested temperature */ + MPI_MASTER (if (Sqw->verbose_output > 0 && w_bins > 1) + printf ("Isotropic_Sqw: %s: S(q,w) data from %s (%s) assumed to be %s.\n", Sqw->compname, file, Sqw->type == 'c' ? "coh" : "inc", + Sqw->sqw_classical ? "classical (symmetrised in energy)" : "non-classical (includes Bose factor, non symmetric in energy)");); + + /* (6) apply detailed balance on Sqw_full for classical or quantum S(q,w) */ + /* compute the \int q^2 S(q) for normalisation */ + + MPI_MASTER (if (Sqw->sqw_classical && Sqw->verbose_output > 0 && Sqw->Temperature > 0) + printf ("Isotropic_Sqw: %s: Applying exp(hw/2kT) factor with T=%g [K] on %s file (classical/symmetric) using '%s' quantum correction\n", + Sqw->compname, Sqw->Temperature, file, Sqw->Q_correction);); + for (index_q = 0; index_q < q_bins; index_q++) { + double sq = 0; + double q = index_q * q_step; /* q value in Sqw_full ; q_min = 0 */ + for (index_w = 0; index_w < w_bins; index_w++) { + double w = -w_max + index_w * w_step; /* w value in Sqw_full */ + double balance = 1; /* detailed balance factor, default is 1 */ + double sqw_full = Table_Index (Sqw_full, index_q, index_w); + + /* do we use a symmetric S(q,w) from real G(r,t) from e.g. MD ? */ + + if (Sqw->sqw_classical && Sqw->Temperature > 0) /* data is symmetric, we apply Bose factor */ + /* un-symmetrize Sqw(file) * exp(hw/kT/2) on both sides */ + balance = Sqw_quantum_correction (w, Sqw->Temperature, Sqw->Q_correction); + else if (!Sqw->sqw_classical) { /* data is quantum (contains Bose) */ + if (sqw_full < 0) { /* quantum but mirrored/symmetric value (was missing in file) */ + if (T) + /* prefer to use T computed from file for mirroring */ + balance *= exp (w / (T * Sqw->T2E)); /* apply Bose where missing */ + else if (Sqw->Temperature) + balance *= exp (w / (Sqw->Temperature * Sqw->T2E)); /* apply Bose where missing */ + } + /* test if T computed from file matches requested T, else apply correction */ + if (T && Sqw->Temperature > 0 && Sqw->Temperature != T) { + balance *= exp (-w / (T * Sqw->T2E) / 2); /* make it a classical data set: remove computed/read T from quantum data file */ + balance *= exp (w / (Sqw->Temperature * Sqw->T2E) / 2); /* then apply Bose to requested temperature */ + } } - } - - /* update Sqw value */ - sqw_full = fabs(sqw_full)*balance; - Table_SetElement(&Sqw_full, index_q, index_w, sqw_full); - /* sum up the S(q) (0-th moment) = w0 */ - sq += sqw_full; - } /* index_w */ - sq *= w_step; /* S(q) = \int S(q,w) dw = structure factor */ - iq2Sq += q*q*sq*q_step; /* iq2Sq = \int q^2 S(q) dq = used for g-sum rule (normalisation) */ - sum += sq*q_step; /* |S| = \int S(q,w) dq dw = total integral value in file */ - } /* index_q */ - - if (!sum) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: No valid data in the selected (Q,w) range: sum(S)=0\n" - "ERROR Available Sqw data is\n", - Sqw->compname); - printf(" q=[%g:%g] w=[%g:%g]\n", - q_min_file, q_max_file, - w_min_file, w_max_file); - ); - Table_Free(&Sqw_full); - return(NULL); - } - /* norm S(q ,w) = sum(S)*q_range/q_bins on total q,w range from file */ - sum *= (q_max_file - q_min_file)/q_bins_file; - - /* (7) renormalization of S(q,w) ========================================== */ + /* update Sqw value */ + sqw_full = fabs (sqw_full) * balance; + Table_SetElement (&Sqw_full, index_q, index_w, sqw_full); + /* sum up the S(q) (0-th moment) = w0 */ + sq += sqw_full; + } /* index_w */ + sq *= w_step; /* S(q) = \int S(q,w) dw = structure factor */ + iq2Sq += q * q * sq * q_step; /* iq2Sq = \int q^2 S(q) dq = used for g-sum rule (normalisation) */ + sum += sq * q_step; /* |S| = \int S(q,w) dq dw = total integral value in file */ + } /* index_q */ + + if (!sum) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: No valid data in the selected (Q,w) range: sum(S)=0\n" + "ERROR Available Sqw data is\n", + Sqw->compname); + printf (" q=[%g:%g] w=[%g:%g]\n", q_min_file, q_max_file, w_min_file, w_max_file);); + Table_Free (&Sqw_full); + return (NULL); + } - if ( Sqw->sqw_norm >0) alpha=Sqw->sqw_norm; - else if (!Sqw->sqw_norm) alpha=1; + /* norm S(q ,w) = sum(S)*q_range/q_bins on total q,w range from file */ + sum *= (q_max_file - q_min_file) / q_bins_file; - if (!alpha && iq2Sq) { /* compute theoretical |S| norm */ - /* Eq (2.44) from H.E. Fischer et al, Rep. Prog. Phys., 69 (2006) 233 */ - alpha = - (q_max*q_max*q_max/3 - (Sqw->type == 'c' ? 2*PI*PI*Sqw->mat_rho : 0)) - /iq2Sq; - } + /* (7) renormalization of S(q,w) ========================================== */ - if (alpha < 0) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: normalisation factor is negative. rho=%g [Angs^-3] may be too high.\n" - "WARNING Disabling renormalization i.e. keeping initial S(q,w).\n", - Sqw->compname, Sqw->mat_rho); - ); - alpha=0; - } + if (Sqw->sqw_norm > 0) + alpha = Sqw->sqw_norm; + else if (!Sqw->sqw_norm) + alpha = 1; - /* apply normalization on S(q,w) */ - if (alpha && alpha != 1) { - sum *= alpha; - for (index_q=0; index_q < q_bins ; index_q++) { - for (index_w=0; index_w < w_bins; index_w++) - Table_SetElement(&Sqw_full, index_q, index_w, - Table_Index(Sqw_full, index_q, index_w) * alpha); + if (!alpha && iq2Sq) { /* compute theoretical |S| norm */ + /* Eq (2.44) from H.E. Fischer et al, Rep. Prog. Phys., 69 (2006) 233 */ + alpha = (q_max * q_max * q_max / 3 - (Sqw->type == 'c' ? 2 * PI * PI * Sqw->mat_rho : 0)) / iq2Sq; } - } - Sqw_Data->intensity = sum; - - Table_Stat(&Sqw_full); - Sqw_full.min_x = 0; - Sqw_full.max_x = q_max; - Sqw_full.step_x = q_step; - - MPI_MASTER( - if (Sqw->verbose_output > 0) { - printf("Isotropic_Sqw: %s: Generated %s %scoherent Sqw\n" - " q=[%g:%g Angs-1] w=[%g:%g meV] |S|=%g size=[%lix%li] sigma=%g [barns]\n", - Sqw->compname, file, (Sqw->type == 'i' ? "in" : ""), - q_min_file, q_max_file, - w_min_file, w_max_file, Sqw_Data->intensity, - q_bins, Sqw_Data->w_bins, - (Sqw->type == 'i' ? Sqw->s_inc : Sqw->s_coh)); - if (w_max < 1e-2) - printf(" Mainly elastic scattering.\n"); - if (Sqw->sqw_norm >0 && Sqw->sqw_norm != 1) - printf(" normalization factor S(q,w)*%g (user)\n", alpha); - else if (Sqw->sqw_norm<0) - printf(" normalization factor S(q,w)*%g (auto) \\int q^2 S(q) dq=%g\n", alpha, iq2Sq); - } - ); + if (alpha < 0) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: normalisation factor is negative. rho=%g [Angs^-3] may be too high.\n" + "WARNING Disabling renormalization i.e. keeping initial S(q,w).\n", + Sqw->compname, Sqw->mat_rho);); + alpha = 0; + } - /* (8) Compute total cross section ======================================== */ + /* apply normalization on S(q,w) */ + if (alpha && alpha != 1) { + sum *= alpha; + for (index_q = 0; index_q < q_bins; index_q++) { + for (index_w = 0; index_w < w_bins; index_w++) + Table_SetElement (&Sqw_full, index_q, index_w, Table_Index (Sqw_full, index_q, index_w) * alpha); + } + } - /* now compute the effective total cross section (Sqw_integrate_iqSq) - sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dw dq - * for each incoming neutron energy 0 < Ei < 2*w_max, and - * integration range w=-Ei:w_max and q=Q0:Q1 with - * Q0 = SE2Q*(sqrt(E)-sqrt(E+w)) - * Q1 = SE2Q*(sqrt(E)+sqrt(E+w)) - */ + Sqw_Data->intensity = sum; + + Table_Stat (&Sqw_full); + Sqw_full.min_x = 0; + Sqw_full.max_x = q_max; + Sqw_full.step_x = q_step; + + MPI_MASTER (if (Sqw->verbose_output > 0) { + printf ("Isotropic_Sqw: %s: Generated %s %scoherent Sqw\n" + " q=[%g:%g Angs-1] w=[%g:%g meV] |S|=%g size=[%lix%li] sigma=%g [barns]\n", + Sqw->compname, file, (Sqw->type == 'i' ? "in" : ""), q_min_file, q_max_file, w_min_file, w_max_file, Sqw_Data->intensity, q_bins, Sqw_Data->w_bins, + (Sqw->type == 'i' ? Sqw->s_inc : Sqw->s_coh)); + if (w_max < 1e-2) + printf (" Mainly elastic scattering.\n"); + if (Sqw->sqw_norm > 0 && Sqw->sqw_norm != 1) + printf (" normalization factor S(q,w)*%g (user)\n", alpha); + else if (Sqw->sqw_norm < 0) + printf (" normalization factor S(q,w)*%g (auto) \\int q^2 S(q) dq=%g\n", alpha, iq2Sq); + }); + + /* (8) Compute total cross section ======================================== */ + + /* now compute the effective total cross section (Sqw_integrate_iqSq) + sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dw dq + * for each incoming neutron energy 0 < Ei < 2*w_max, and + * integration range w=-Ei:w_max and q=Q0:Q1 with + * Q0 = SE2Q*(sqrt(E)-sqrt(E+w)) + * Q1 = SE2Q*(sqrt(E)+sqrt(E+w)) + */ + + Sqw_Data->lookup_length = Sqw->lookup_length; + Sqw_Data->iqSq_length = Sqw->lookup_length; + /* this length should be greater when w_max=0 for e.g. elastic only */ + if (w_bins <= 1) + Sqw_Data->iqSq_length = q_bins; + + if (!Table_Init (&iqSq, Sqw_Data->iqSq_length, 1)) { + /* from 0 to 2*Ki_max */ + printf ("Isotropic_Sqw: %s: Cannot allocate [int q S(q,w) dq dw] array (%li bytes).\n" + "ERROR Exiting.\n", + Sqw->compname, Sqw->lookup_length * sizeof (double)); + Table_Free (&Sqw_full); + return (NULL); + } - Sqw_Data->lookup_length = Sqw->lookup_length; - Sqw_Data->iqSq_length = Sqw->lookup_length; - /* this length should be greater when w_max=0 for e.g. elastic only */ - if (w_bins <= 1) Sqw_Data->iqSq_length = q_bins; - - if (!Table_Init(&iqSq, Sqw_Data->iqSq_length, 1)) { - /* from 0 to 2*Ki_max */ - printf("Isotropic_Sqw: %s: Cannot allocate [int q S(q,w) dq dw] array (%li bytes).\n" - "ERROR Exiting.\n", - Sqw->compname, Sqw->lookup_length*sizeof(double)); - Table_Free(&Sqw_full); - return(NULL); - } + /* compute the maximum incoming energy that can be handled */ + Sqw_Data->Ei_max = 2 * w_max; - /* compute the maximum incoming energy that can be handled */ - Sqw_Data->Ei_max = 2*w_max; - - /* Checked in different ways in Powder and "proper inelastic" case */ - if (w_step==1) { - /* Powder */ - double Ei_max_q = (q_max*K2V)*(q_max*K2V)*VS2E/2; - if (Ei_max_q > Sqw_Data->Ei_max) Sqw_Data->Ei_max = Ei_max_q; - } else { - /* Proper inelastic */ - /* check if the q-range will limit the integration */ - if ((q_max*K2V)*(q_max*K2V)*VS2E/2 > Sqw_Data->Ei_max) { - /* then scan Ei until we pass q_max */ - for (index_w=0; index_w < Sqw_Data->iqSq_length; index_w++) { - double Ei = index_w*2*w_max/Sqw_Data->iqSq_length; - if ( (Ei > w_max && sqrt(Ei)+sqrt(Ei-w_max) >= q_max/(SE2V*V2K)) - || sqrt(Ei)+sqrt(Ei+w_max) >= q_max/(SE2V*V2K)) - if (Ei < Sqw_Data->Ei_max) { - Sqw_Data->Ei_max = Ei; - break; - } + /* Checked in different ways in Powder and "proper inelastic" case */ + if (w_step == 1) { + /* Powder */ + double Ei_max_q = (q_max * K2V) * (q_max * K2V) * VS2E / 2; + if (Ei_max_q > Sqw_Data->Ei_max) + Sqw_Data->Ei_max = Ei_max_q; + } else { + /* Proper inelastic */ + /* check if the q-range will limit the integration */ + if ((q_max * K2V) * (q_max * K2V) * VS2E / 2 > Sqw_Data->Ei_max) { + /* then scan Ei until we pass q_max */ + for (index_w = 0; index_w < Sqw_Data->iqSq_length; index_w++) { + double Ei = index_w * 2 * w_max / Sqw_Data->iqSq_length; + if ((Ei > w_max && sqrt (Ei) + sqrt (Ei - w_max) >= q_max / (SE2V * V2K)) || sqrt (Ei) + sqrt (Ei + w_max) >= q_max / (SE2V * V2K)) + if (Ei < Sqw_Data->Ei_max) { + Sqw_Data->Ei_max = Ei; + break; + } + } } } - } - MPI_MASTER( - if (Sqw->verbose_output >= 2) - printf("Isotropic_Sqw: %s: Creating Sigma(Ei=0:%g [meV]) with %li entries...(%s %s)\n", - Sqw->compname, Sqw_Data->Ei_max, Sqw_Data->iqSq_length, file, Sqw->type=='c' ? "coh" : "inc"); - ); - Sqw_Data->Sqw = Sqw_full; /* store the S(q,w) Table (matrix) for Sqw_integrate_iqSq */ - - /* this loop takes time: use MPI when available */ - - for (index_w=0; index_w < Sqw_Data->iqSq_length; index_w++) { - - /* Ei = energy of incoming neutron, typically 0:w_max or 0:2*q_max */ - double Ei; /* neutron energy value in Sqw_full, up to 2*w_max */ - double Ki, Vi; - double Sigma=0; - Ei = index_w*Sqw_Data->Ei_max/Sqw_Data->iqSq_length; - Vi = sqrt(Ei/VS2E); - Ki = V2K*Vi; - /* sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dq dw */ - /* Eq (6) from E. Farhi et al. J. Comp. Phys. 228 (2009) 5251 */ - Sigma = Ki <= 0 ? 0 : (Sqw->type=='c' ? Sqw->s_coh : Sqw->s_inc) - /2/Ki/Ki * Sqw_integrate_iqSq(Sqw_Data, Ei); - Table_SetElement(&iqSq, index_w, 0, Sigma ); - } + MPI_MASTER (if (Sqw->verbose_output >= 2) printf ("Isotropic_Sqw: %s: Creating Sigma(Ei=0:%g [meV]) with %li entries...(%s %s)\n", Sqw->compname, + Sqw_Data->Ei_max, Sqw_Data->iqSq_length, file, Sqw->type == 'c' ? "coh" : "inc");); + Sqw_Data->Sqw = Sqw_full; /* store the S(q,w) Table (matrix) for Sqw_integrate_iqSq */ + + /* this loop takes time: use MPI when available */ + + for (index_w = 0; index_w < Sqw_Data->iqSq_length; index_w++) { + + /* Ei = energy of incoming neutron, typically 0:w_max or 0:2*q_max */ + double Ei; /* neutron energy value in Sqw_full, up to 2*w_max */ + double Ki, Vi; + double Sigma = 0; + Ei = index_w * Sqw_Data->Ei_max / Sqw_Data->iqSq_length; + Vi = sqrt (Ei / VS2E); + Ki = V2K * Vi; + /* sigma(Ei) = sigma/2/Ki^2 * \int q S(q,w) dq dw */ + /* Eq (6) from E. Farhi et al. J. Comp. Phys. 228 (2009) 5251 */ + Sigma = Ki <= 0 ? 0 : (Sqw->type == 'c' ? Sqw->s_coh : Sqw->s_inc) / 2 / Ki / Ki * Sqw_integrate_iqSq (Sqw_Data, Ei); + Table_SetElement (&iqSq, index_w, 0, Sigma); + } - sprintf(iqSq.filename, "[sigma/2Ki^2 int q S(q,w) dq dw] from %s", file); - iqSq.min_x = 0; - iqSq.max_x = Sqw_Data->Ei_max; - iqSq.step_x = Sqw_Data->Ei_max/Sqw_Data->iqSq_length; - iqSq.block_number = 1; + sprintf (iqSq.filename, "[sigma/2Ki^2 int q S(q,w) dq dw] from %s", file); + iqSq.min_x = 0; + iqSq.max_x = Sqw_Data->Ei_max; + iqSq.step_x = Sqw_Data->Ei_max / Sqw_Data->iqSq_length; + iqSq.block_number = 1; - Sqw_Data->iqSq = iqSq; /* store the sigma(Ei) = \int q S(q,w) dq dw Table (vector) */ + Sqw_Data->iqSq = iqSq; /* store the sigma(Ei) = \int q S(q,w) dq dw Table (vector) */ - /* (9) Compute P(w) probability =========================================== */ + /* (9) Compute P(w) probability =========================================== */ - /* set up 'density of states' */ - /* uses: Sqw_full and w axes */ - Sqw_Data->SW = - (struct Sqw_W_struct*)calloc(w_bins, sizeof(struct Sqw_W_struct)); + /* set up 'density of states' */ + /* uses: Sqw_full and w axes */ + Sqw_Data->SW = (struct Sqw_W_struct*)calloc (w_bins, sizeof (struct Sqw_W_struct)); - if (!Sqw_Data->SW) { - printf("Isotropic_Sqw: %s: Cannot allocate SW (%li bytes).\n" - "ERROR Exiting.\n", - Sqw->compname, w_bins*sizeof(struct Sqw_W_struct)); - Table_Free(&Sqw_full); - Table_Free(&iqSq); - return(NULL); - } - sum = 0; - for (index_w=0; index_w < w_bins ; index_w++) { - double local_val = 0; - double w = -w_max + index_w * w_step; - for (index_q=0; index_q < q_bins ; index_q++) { /* integrate on all q values */ - local_val += Table_Index(Sqw_full, index_q, index_w)*q_step*index_q*q_step; /* q*S(q,w) */ + if (!Sqw_Data->SW) { + printf ("Isotropic_Sqw: %s: Cannot allocate SW (%li bytes).\n" + "ERROR Exiting.\n", + Sqw->compname, w_bins * sizeof (struct Sqw_W_struct)); + Table_Free (&Sqw_full); + Table_Free (&iqSq); + return (NULL); + } + sum = 0; + for (index_w = 0; index_w < w_bins; index_w++) { + double local_val = 0; + double w = -w_max + index_w * w_step; + for (index_q = 0; index_q < q_bins; index_q++) { /* integrate on all q values */ + local_val += Table_Index (Sqw_full, index_q, index_w) * q_step * index_q * q_step; /* q*S(q,w) */ + } + Sqw_Data->SW[index_w].omega = w; + sum += local_val; /* S(w)=\int S(q,w) dq */ + /* compute cumulated probability */ + Sqw_Data->SW[index_w].cumul_proba = local_val; + if (index_w) + Sqw_Data->SW[index_w].cumul_proba += Sqw_Data->SW[index_w - 1].cumul_proba; + else + Sqw_Data->SW[index_w].cumul_proba = 0; } - Sqw_Data->SW[index_w].omega = w; - sum += local_val; /* S(w)=\int S(q,w) dq */ - /* compute cumulated probability */ - Sqw_Data->SW[index_w].cumul_proba = local_val; - if (index_w) Sqw_Data->SW[index_w].cumul_proba += Sqw_Data->SW[index_w-1].cumul_proba; - else Sqw_Data->SW[index_w].cumul_proba = 0; - } - if (!sum) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Total S(q,w) intensity is NULL.\n" - "ERROR Exiting.\n", Sqw->compname); - ); - Table_Free(&Sqw_full); - Table_Free(&iqSq); - return(NULL); - } + if (!sum) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Total S(q,w) intensity is NULL.\n" + "ERROR Exiting.\n", + Sqw->compname);); + Table_Free (&Sqw_full); + Table_Free (&iqSq); + return (NULL); + } - /* normalize Pw distribution to 0:1 range */ - for (index_w=0; index_w < w_bins ; index_w++) { - Sqw_Data->SW[index_w].cumul_proba /= Sqw_Data->SW[w_bins-1].cumul_proba; - } + /* normalize Pw distribution to 0:1 range */ + for (index_w = 0; index_w < w_bins; index_w++) { + Sqw_Data->SW[index_w].cumul_proba /= Sqw_Data->SW[w_bins - 1].cumul_proba; + } - if (Sqw->verbose_output > 2) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Generated normalized SW[%li] in range [0:%g]\n", - Sqw->compname, w_bins, Sqw_Data->SW[w_bins-1].cumul_proba); - ); - } + if (Sqw->verbose_output > 2) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Generated normalized SW[%li] in range [0:%g]\n", Sqw->compname, w_bins, Sqw_Data->SW[w_bins - 1].cumul_proba);); + } - /* (10) Compute P(Q|w) probability ======================================== */ + /* (10) Compute P(Q|w) probability ======================================== */ - /* set up Q probability table per w bin */ - /* uses: Sqw_full */ - Sqw_Data->SQW = - (struct Sqw_Q_struct**)calloc(w_bins, sizeof(struct Sqw_Q_struct*)); + /* set up Q probability table per w bin */ + /* uses: Sqw_full */ + Sqw_Data->SQW = (struct Sqw_Q_struct**)calloc (w_bins, sizeof (struct Sqw_Q_struct*)); - if (!Sqw_Data->SQW) { - printf("Isotropic_Sqw: %s: Cannot allocate P(Q|w) array (%li bytes).\n" - "ERROR Exiting.\n", - Sqw->compname, w_bins*sizeof(struct Sqw_Q_struct*)); - Table_Free(&Sqw_full); - Table_Free(&iqSq); - return(NULL); - } - for (index_w=0; index_w < w_bins ; index_w++) { - Sqw_Data->SQW[index_w]= - (struct Sqw_Q_struct*)calloc(q_bins, sizeof(struct Sqw_Q_struct)); - - if (!Sqw_Data->SQW[index_w]) { - printf("Isotropic_Sqw: %s: Cannot allocate P(Q|w)[%li] (%li bytes).\n" - "ERROR Exiting.\n", - Sqw->compname, index_w, q_bins*sizeof(struct Sqw_Q_struct)); - Table_Free(&Sqw_full); - Table_Free(&iqSq); - return(NULL); + if (!Sqw_Data->SQW) { + printf ("Isotropic_Sqw: %s: Cannot allocate P(Q|w) array (%li bytes).\n" + "ERROR Exiting.\n", + Sqw->compname, w_bins * sizeof (struct Sqw_Q_struct*)); + Table_Free (&Sqw_full); + Table_Free (&iqSq); + return (NULL); } - /* set P(Q|W) and compute total intensity */ - for (index_q=0; index_q < q_bins ; index_q++) { - double q = index_q * q_step; - Sqw_Data->SQW[index_w][index_q].Q = q; - - /* compute cumulated probability and take into account Jacobian with additional 'q' factor */ - Sqw_Data->SQW[index_w][index_q].cumul_proba = q*Table_Index(Sqw_full, index_q, index_w); /* q*S(q,w) */ - if (index_q) Sqw_Data->SQW[index_w][index_q].cumul_proba += Sqw_Data->SQW[index_w][index_q-1].cumul_proba; - else Sqw_Data->SQW[index_w][index_q].cumul_proba = 0; + for (index_w = 0; index_w < w_bins; index_w++) { + Sqw_Data->SQW[index_w] = (struct Sqw_Q_struct*)calloc (q_bins, sizeof (struct Sqw_Q_struct)); + + if (!Sqw_Data->SQW[index_w]) { + printf ("Isotropic_Sqw: %s: Cannot allocate P(Q|w)[%li] (%li bytes).\n" + "ERROR Exiting.\n", + Sqw->compname, index_w, q_bins * sizeof (struct Sqw_Q_struct)); + Table_Free (&Sqw_full); + Table_Free (&iqSq); + return (NULL); + } + /* set P(Q|W) and compute total intensity */ + for (index_q = 0; index_q < q_bins; index_q++) { + double q = index_q * q_step; + Sqw_Data->SQW[index_w][index_q].Q = q; + + /* compute cumulated probability and take into account Jacobian with additional 'q' factor */ + Sqw_Data->SQW[index_w][index_q].cumul_proba = q * Table_Index (Sqw_full, index_q, index_w); /* q*S(q,w) */ + if (index_q) + Sqw_Data->SQW[index_w][index_q].cumul_proba += Sqw_Data->SQW[index_w][index_q - 1].cumul_proba; + else + Sqw_Data->SQW[index_w][index_q].cumul_proba = 0; + } + /* normalize P(q|w) distribution to 0:1 range */ + for (index_q = 0; index_q < q_bins; Sqw_Data->SQW[index_w][index_q++].cumul_proba /= Sqw_Data->SQW[index_w][q_bins - 1].cumul_proba) + ; + } + if (Sqw->verbose_output > 2) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Generated P(Q|w)\n", Sqw->compname);); } - /* normalize P(q|w) distribution to 0:1 range */ - for (index_q=0; index_q < q_bins ; - Sqw_Data->SQW[index_w][index_q++].cumul_proba /= Sqw_Data->SQW[index_w][q_bins-1].cumul_proba - ); - - } - if (Sqw->verbose_output > 2) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Generated P(Q|w)\n", - Sqw->compname); - ); - } - /* (11) generate quick lookup tables for SW and SQW ======================= */ + /* (11) generate quick lookup tables for SW and SQW ======================= */ - SW_lookup = (long*)calloc(Sqw->lookup_length, sizeof(long)); + SW_lookup = (long*)calloc (Sqw->lookup_length, sizeof (long)); - if (!SW_lookup) { - printf("Isotropic_Sqw: %s: Cannot allocate SW_lookup (%li bytes).\n" - "Warning Will be slower.\n", - Sqw->compname, Sqw->lookup_length*sizeof(long)); - } else { - int i; - for (i=0; i < Sqw->lookup_length; i++) { - double w = (double)i/(double)Sqw->lookup_length; /* a random number tabulated value */ - SW_lookup[i] = Sqw_search_SW(*Sqw_Data, w); + if (!SW_lookup) { + printf ("Isotropic_Sqw: %s: Cannot allocate SW_lookup (%li bytes).\n" + "Warning Will be slower.\n", + Sqw->compname, Sqw->lookup_length * sizeof (long)); + } else { + int i; + for (i = 0; i < Sqw->lookup_length; i++) { + double w = (double)i / (double)Sqw->lookup_length; /* a random number tabulated value */ + SW_lookup[i] = Sqw_search_SW (*Sqw_Data, w); + } + Sqw_Data->SW_lookup = SW_lookup; } - Sqw_Data->SW_lookup = SW_lookup; - } - QW_lookup = (long**)calloc(w_bins, sizeof(long*)); - - if (!QW_lookup) { - printf("Isotropic_Sqw: %s: Cannot allocate QW_lookup (%li bytes).\n" - "Warning Will be slower.\n", - Sqw->compname, w_bins*sizeof(long*)); - } else { - for (index_w=0; index_w < w_bins ; index_w++) { - QW_lookup[index_w] = - (long*)calloc(Sqw->lookup_length, sizeof(long)); - if (!QW_lookup[index_w]) { - printf("Isotropic_Sqw: %s: Cannot allocate QW_lookup[%li] (%li bytes).\n" - "Warning Will be slower.\n", - Sqw->compname, index_w, Sqw->lookup_length*sizeof(long)); - free(QW_lookup); Sqw_Data->QW_lookup = QW_lookup = NULL; break; - } else { - int i; - for (i=0; i < Sqw->lookup_length; i++) { - double w = (double)i/(double)Sqw->lookup_length; /* a random number tabulated value */ - QW_lookup[index_w][i] = Sqw_search_Q_proba_per_w(*Sqw_Data, w, index_w); + QW_lookup = (long**)calloc (w_bins, sizeof (long*)); + + if (!QW_lookup) { + printf ("Isotropic_Sqw: %s: Cannot allocate QW_lookup (%li bytes).\n" + "Warning Will be slower.\n", + Sqw->compname, w_bins * sizeof (long*)); + } else { + for (index_w = 0; index_w < w_bins; index_w++) { + QW_lookup[index_w] = (long*)calloc (Sqw->lookup_length, sizeof (long)); + if (!QW_lookup[index_w]) { + printf ("Isotropic_Sqw: %s: Cannot allocate QW_lookup[%li] (%li bytes).\n" + "Warning Will be slower.\n", + Sqw->compname, index_w, Sqw->lookup_length * sizeof (long)); + free (QW_lookup); + Sqw_Data->QW_lookup = QW_lookup = NULL; + break; + } else { + int i; + for (i = 0; i < Sqw->lookup_length; i++) { + double w = (double)i / (double)Sqw->lookup_length; /* a random number tabulated value */ + QW_lookup[index_w][i] = Sqw_search_Q_proba_per_w (*Sqw_Data, w, index_w); + } } } + Sqw_Data->QW_lookup = QW_lookup; + } + if ((Sqw_Data->QW_lookup || Sqw_Data->SW_lookup) && Sqw->verbose_output > 2) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: Generated lookup tables with %li entries\n", Sqw->compname, Sqw->lookup_length);); + } + free (w_file2full); + free (q_file2full); + return (Sqw_Data); + } /* end Sqw_readfile */ + + /***************************************************************************** + * Sqw_init_read: Read coherent/incoherent Sqw data files + * Returns Sqw total intensity, or 0 (error) + * Used in : INITIALIZE (1) + *****************************************************************************/ + double + Sqw_init (struct Sqw_sample_struct* Sqw, char* file_coh, char* file_inc) { + double ret = 0; + + /* read files */ + struct Sqw_Data_struct *d_inc, *d_coh; + Sqw->type = 'i'; + d_inc = Sqw_readfile (Sqw, file_inc, &(Sqw->Data_inc)); + Sqw->type = 'c'; + d_coh = Sqw_readfile (Sqw, file_coh, &(Sqw->Data_coh)); + + if (d_inc && !d_inc->intensity && Sqw->s_inc > 0) { + MPI_MASTER (if (Sqw->verbose_output > 0) + printf ("Isotropic_Sqw: %s: Using Isotropic elastic incoherent scattering (sigma=%g [barns])\n", Sqw->compname, Sqw->s_inc);); + ret = 1; } - Sqw_Data->QW_lookup = QW_lookup; - } - if ((Sqw_Data->QW_lookup || Sqw_Data->SW_lookup) && Sqw->verbose_output > 2) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Generated lookup tables with %li entries\n", - Sqw->compname, Sqw->lookup_length); - ); - } - free(w_file2full); - free(q_file2full); - return(Sqw_Data); -} /* end Sqw_readfile */ - -/***************************************************************************** -* Sqw_init_read: Read coherent/incoherent Sqw data files -* Returns Sqw total intensity, or 0 (error) -* Used in : INITIALIZE (1) -*****************************************************************************/ -double Sqw_init(struct Sqw_sample_struct *Sqw, char *file_coh, char *file_inc) -{ - double ret=0; - - /* read files */ - struct Sqw_Data_struct *d_inc, *d_coh; - Sqw->type = 'i'; - d_inc = Sqw_readfile(Sqw, file_inc, &(Sqw->Data_inc)); - Sqw->type = 'c'; - d_coh = Sqw_readfile(Sqw, file_coh, &(Sqw->Data_coh)); - - if (d_inc && !d_inc->intensity && Sqw->s_inc>0) { - MPI_MASTER( - if (Sqw->verbose_output > 0) - printf("Isotropic_Sqw: %s: Using Isotropic elastic incoherent scattering (sigma=%g [barns])\n", Sqw->compname, Sqw->s_inc); - ); - ret=1; - } - if (!d_inc || !d_coh) return(0); - - d_coh->type = 'c'; - Sqw->Data_inc.type = 'i'; - MPI_MASTER( - if (d_coh && !d_coh->intensity && Sqw->s_coh) - printf("Isotropic_Sqw: %s: Coherent scattering Sqw intensity is null.\n" - "Warning Disabling coherent scattering.\n", Sqw->compname); - ); - if (d_inc && d_coh && d_inc->intensity && d_coh->intensity) { - char msg[80]; - strcpy(msg, ""); - /* check dimensions/limits for Q, Energy in coh and inc Tables */ - if (d_inc->q_bins != d_coh->q_bins) - strcpy(msg, "Q axis size"); - if (d_inc->w_bins != d_coh->w_bins) - strcpy(msg, "Energy axis size"); - if (d_inc->q_max != d_coh->q_max) - strcpy(msg, "Q axis limits"); - if (d_inc->w_max != d_coh->w_max) - strcpy(msg, "Energy axis limits"); - MPI_MASTER( - if (strlen(msg)) { - printf("Isotropic_Sqw: %s: Sqw data from files %s and %s do not match\n" - "WARNING wrong %s\n", - Sqw->compname, file_coh, file_inc, msg); + if (!d_inc || !d_coh) + return (0); + + d_coh->type = 'c'; + Sqw->Data_inc.type = 'i'; + MPI_MASTER (if (d_coh && !d_coh->intensity && Sqw->s_coh) printf ("Isotropic_Sqw: %s: Coherent scattering Sqw intensity is null.\n" + "Warning Disabling coherent scattering.\n", + Sqw->compname);); + if (d_inc && d_coh && d_inc->intensity && d_coh->intensity) { + char msg[80]; + strcpy (msg, ""); + /* check dimensions/limits for Q, Energy in coh and inc Tables */ + if (d_inc->q_bins != d_coh->q_bins) + strcpy (msg, "Q axis size"); + if (d_inc->w_bins != d_coh->w_bins) + strcpy (msg, "Energy axis size"); + if (d_inc->q_max != d_coh->q_max) + strcpy (msg, "Q axis limits"); + if (d_inc->w_max != d_coh->w_max) + strcpy (msg, "Energy axis limits"); + MPI_MASTER (if (strlen (msg)) { + printf ("Isotropic_Sqw: %s: Sqw data from files %s and %s do not match\n" + "WARNING wrong %s\n", + Sqw->compname, file_coh, file_inc, msg); + }); } - ); - } - if (!ret) ret=d_inc->intensity+d_coh->intensity; - return(ret); -} /* Sqw_init */ + if (!ret) + ret = d_inc->intensity + d_coh->intensity; + return (ret); + } /* Sqw_init */ -#endif /* definied ISOTROPIC_SQW */ + #endif /* definied ISOTROPIC_SQW */ %} @@ -2013,7 +2011,7 @@ double Sqw_init(struct Sqw_sample_struct *Sqw, char *file_coh, char *file_inc) DECLARE %{ struct Sqw_sample_struct VarSqw; - int *columns; + int* columns; off_struct offdata; %} @@ -2026,170 +2024,164 @@ INITIALIZE /* check for parameters */ columns = (int*)powder_format; - VarSqw.verbose_output= verbose; + VarSqw.verbose_output = verbose; VarSqw.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 (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 - if (off_init(geometry, xwidth, yheight, zdepth, 0, &offdata)) { - VarSqw.shape=3; thickness=0; concentric=0; + if (off_init (geometry, xwidth, yheight, zdepth, 0, &offdata)) { + VarSqw.shape = 3; + thickness = 0; + concentric = 0; } #endif - } - else - if (xwidth && yheight && zdepth) VarSqw.shape=1; /* box */ - else if (radius > 0 && yheight) VarSqw.shape=0; /* cylinder */ - else if (radius > 0 && !yheight) VarSqw.shape=2; /* sphere */ + } else if (xwidth && yheight && zdepth) + VarSqw.shape = 1; /* box */ + else if (radius > 0 && yheight) + VarSqw.shape = 0; /* cylinder */ + else if (radius > 0 && !yheight) + VarSqw.shape = 2; /* sphere */ if (VarSqw.shape < 0) - exit(fprintf(stderr,"Isotropic_Sqw: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); - - + exit (fprintf (stderr, + "Isotropic_Sqw: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); if (thickness) { - if (radius && (radius < fabs(thickness) )) { - MPI_MASTER( - fprintf(stderr,"Isotropic_Sqw: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" - "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", NAME_CURRENT_COMP); - ); - thickness=0; - } - else if (!radius && (xwidth < 2*fabs(thickness) || yheight < 2*fabs(thickness) || zdepth < 2*fabs(thickness))) { - MPI_MASTER( - fprintf(stderr,"Isotropic_Sqw: %s: hollow sample thickness is larger than its volume (box).\n" - "WARNING Please check parameter values.\n", NAME_CURRENT_COMP); - ); + if (radius && (radius < fabs (thickness))) { + MPI_MASTER (fprintf (stderr, + "Isotropic_Sqw: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" + "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", + NAME_CURRENT_COMP);); + thickness = 0; + } else if (!radius && (xwidth < 2 * fabs (thickness) || yheight < 2 * fabs (thickness) || zdepth < 2 * fabs (thickness))) { + MPI_MASTER (fprintf (stderr, + "Isotropic_Sqw: %s: hollow sample thickness is larger than its volume (box).\n" + "WARNING Please check parameter values.\n", + NAME_CURRENT_COMP);); } } - MPI_MASTER( - if (VarSqw.verbose_output) { + MPI_MASTER (if (VarSqw.verbose_output) { switch (VarSqw.shape) { - case 0: printf("Isotropic_Sqw: %s: is a %scylinder: radius=%f thickness=%f height=%f [J Comp Phys 228 (2009) 5251]\n", - NAME_CURRENT_COMP, (thickness ? "hollow " : ""), - radius,fabs(thickness),yheight); - break; - case 1: printf("Isotropic_Sqw: %s: is a %sbox: width=%f height=%f depth=%f \n", - NAME_CURRENT_COMP, (thickness ? "hollow " : ""), xwidth,yheight,zdepth); - break; - case 2: printf("Isotropic_Sqw: %s: is a %ssphere: radius=%f thickness=%f\n", - NAME_CURRENT_COMP, (thickness ? "hollow " : ""), - radius,fabs(thickness)); - break; - case 3: printf("Isotropic_Sqw: %s: is a volume defined from file %s\n", - NAME_CURRENT_COMP, geometry); + case 0: + printf ("Isotropic_Sqw: %s: is a %scylinder: radius=%f thickness=%f height=%f [J Comp Phys 228 (2009) 5251]\n", NAME_CURRENT_COMP, + (thickness ? "hollow " : ""), radius, fabs (thickness), yheight); + break; + case 1: + printf ("Isotropic_Sqw: %s: is a %sbox: width=%f height=%f depth=%f \n", NAME_CURRENT_COMP, (thickness ? "hollow " : ""), xwidth, yheight, zdepth); + break; + case 2: + printf ("Isotropic_Sqw: %s: is a %ssphere: radius=%f thickness=%f\n", NAME_CURRENT_COMP, (thickness ? "hollow " : ""), radius, fabs (thickness)); + break; + case 3: + printf ("Isotropic_Sqw: %s: is a volume defined from file %s\n", NAME_CURRENT_COMP, geometry); } - } - ); + }); if (concentric && !thickness) { - MPI_MASTER( - printf("Isotropic_Sqw: %s:Can not use concentric mode\n" - "WARNING on non hollow shape. Ignoring.\n", - NAME_CURRENT_COMP); - ); - concentric=0; + MPI_MASTER (printf ("Isotropic_Sqw: %s:Can not use concentric mode\n" + "WARNING on non hollow shape. Ignoring.\n", + NAME_CURRENT_COMP);); + concentric = 0; } - strncpy(VarSqw.compname, NAME_CURRENT_COMP, 256); - VarSqw.T2E =(1/11.605); /* Kelvin to meV = 1000*KB/e */ - VarSqw.sqSE2K = (V2K*SE2V)*(V2K*SE2V); + strncpy (VarSqw.compname, NAME_CURRENT_COMP, 256); + VarSqw.T2E = (1 / 11.605); /* Kelvin to meV = 1000*KB/e */ + VarSqw.sqSE2K = (V2K * SE2V) * (V2K * SE2V); VarSqw.sqw_threshold = (threshold > 0 ? threshold : 0); - VarSqw.s_abs = sigma_abs; - VarSqw.s_coh = sigma_coh; - VarSqw.s_inc = sigma_inc; /* s_scatt member initialized in Sqw_init */ - VarSqw.maxloop = 100; /* atempts to close triangle */ - VarSqw.minevents = 100; /* minimal # of events required to get dynamical range */ + VarSqw.s_abs = sigma_abs; + VarSqw.s_coh = sigma_coh; + VarSqw.s_inc = sigma_inc; /* s_scatt member initialized in Sqw_init */ + VarSqw.maxloop = 100; /* atempts to close triangle */ + VarSqw.minevents = 100; /* minimal # of events required to get dynamical range */ VarSqw.neutron_removed = 0; - VarSqw.neutron_enter = 0; - VarSqw.neutron_pmult = 0; - VarSqw.neutron_exit = 0; - VarSqw.mat_rho = rho; - VarSqw.sqw_norm = norm; - VarSqw.mean_scatt= 0; - VarSqw.mean_abs = 0; - VarSqw.psum_scatt= 0; - VarSqw.single_coh= 0; - VarSqw.single_inc= 0; - VarSqw.multi = 0; - VarSqw.barns = powder_barns; + VarSqw.neutron_enter = 0; + VarSqw.neutron_pmult = 0; + VarSqw.neutron_exit = 0; + VarSqw.mat_rho = rho; + VarSqw.sqw_norm = norm; + VarSqw.mean_scatt = 0; + VarSqw.mean_abs = 0; + VarSqw.psum_scatt = 0; + VarSqw.single_coh = 0; + VarSqw.single_inc = 0; + VarSqw.multi = 0; + VarSqw.barns = powder_barns; VarSqw.sqw_classical = classical; - VarSqw.lookup_length=100; - VarSqw.mat_weight = weight; - VarSqw.mat_density = density; - if (quantum_correction && strlen(quantum_correction)) - strncpy(VarSqw.Q_correction, quantum_correction, 256); + VarSqw.lookup_length = 100; + VarSqw.mat_weight = weight; + VarSqw.mat_density = density; + if (quantum_correction && strlen (quantum_correction)) + strncpy (VarSqw.Q_correction, quantum_correction, 256); else - strncpy(VarSqw.Q_correction, "default", 256); + strncpy (VarSqw.Q_correction, "default", 256); /* PowderN compatibility members */ - VarSqw.Dd = powder_Dd; - VarSqw.DWfactor = powder_DW; - VarSqw.Temperature= T; - for (i=0; i< 9; i++) VarSqw.column_order[i] = columns[i]; + VarSqw.Dd = powder_Dd; + VarSqw.DWfactor = powder_DW; + VarSqw.Temperature = T; + for (i = 0; i < 9; i++) + VarSqw.column_order[i] = columns[i]; VarSqw.column_order[8] = (VarSqw.column_order[0] >= 0 ? 0 : 2); /* optional ways to define rho */ if (!VarSqw.mat_rho && powder_Vc > 0) - VarSqw.mat_rho = 1/powder_Vc; + VarSqw.mat_rho = 1 / powder_Vc; /* import the data files ================================================== */ - if (!Sqw_init(&VarSqw, Sqw_coh, Sqw_inc)) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: ERROR importing data files (Sqw_init coh=%s inc=%s).\n",NAME_CURRENT_COMP, Sqw_coh, Sqw_inc); - ); + if (!Sqw_init (&VarSqw, Sqw_coh, Sqw_inc)) { + MPI_MASTER (printf ("Isotropic_Sqw: %s: ERROR importing data files (Sqw_init coh=%s inc=%s).\n", NAME_CURRENT_COMP, Sqw_coh, Sqw_inc);); } - if ( VarSqw.s_coh < 0) VarSqw.s_coh=0; - if ( VarSqw.s_inc < 0) VarSqw.s_inc=0; - if ( VarSqw.s_abs < 0) VarSqw.s_abs=0; + if (VarSqw.s_coh < 0) + VarSqw.s_coh = 0; + if (VarSqw.s_inc < 0) + VarSqw.s_inc = 0; + if (VarSqw.s_abs < 0) + VarSqw.s_abs = 0; if ((VarSqw.s_coh > 0 || VarSqw.s_inc > 0) && VarSqw.mat_rho <= 0) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: WARNING: Null density (V_rho). Unactivating component.\n",NAME_CURRENT_COMP); - ); - VarSqw.s_coh=VarSqw.s_inc=0; + MPI_MASTER (printf ("Isotropic_Sqw: %s: WARNING: Null density (V_rho). Unactivating component.\n", NAME_CURRENT_COMP);); + VarSqw.s_coh = VarSqw.s_inc = 0; } /* 100: convert from barns to fm^2 */ - VarSqw.my_a_v =(VarSqw.mat_rho*100*VarSqw.s_abs*2200); - VarSqw.my_s =(VarSqw.mat_rho*100*(VarSqw.s_coh>0 ? VarSqw.s_coh : 0 - +VarSqw.s_inc>0 ? VarSqw.s_inc : 0)); - MPI_MASTER( - if ((VarSqw.s_coh > 0 || VarSqw.s_inc > 0) && !VarSqw.Temperature - && (VarSqw.Data_coh.intensity || VarSqw.Data_inc.intensity) - && VarSqw.verbose_output) - printf("Isotropic_Sqw: %s: Sample temperature not defined (T=0).\n" - "Warning Disabling detailed balance.\n", NAME_CURRENT_COMP); - if (VarSqw.s_coh<=0 && VarSqw.s_inc<=0) { - printf("Isotropic_Sqw: %s: Scattering cross section is zero\n" - "ERROR (sigma_coh, sigma_inc).\n",NAME_CURRENT_COMP); - } - ); - if (d_phi) d_phi = fabs(d_phi)*DEG2RAD; - - if (d_phi > PI) d_phi = 0; /* V_scatt on 4*PI */ + VarSqw.my_a_v = (VarSqw.mat_rho * 100 * VarSqw.s_abs * 2200); + VarSqw.my_s = (VarSqw.mat_rho * 100 * (VarSqw.s_coh > 0 ? VarSqw.s_coh : 0 + VarSqw.s_inc > 0 ? VarSqw.s_inc : 0)); + MPI_MASTER (if ((VarSqw.s_coh > 0 || VarSqw.s_inc > 0) && !VarSqw.Temperature && (VarSqw.Data_coh.intensity || VarSqw.Data_inc.intensity) + && VarSqw.verbose_output) printf ("Isotropic_Sqw: %s: Sample temperature not defined (T=0).\n" + "Warning Disabling detailed balance.\n", + NAME_CURRENT_COMP); + if (VarSqw.s_coh <= 0 && VarSqw.s_inc <= 0) { + printf ("Isotropic_Sqw: %s: Scattering cross section is zero\n" + "ERROR (sigma_coh, sigma_inc).\n", + NAME_CURRENT_COMP); + }); + if (d_phi) + d_phi = fabs (d_phi) * DEG2RAD; + + if (d_phi > PI) + d_phi = 0; /* V_scatt on 4*PI */ if (d_phi && order != 1) { - MPI_MASTER( - printf("Isotropic_Sqw: %s: Focusing can only apply for single\n" - " scattering. Setting to order=1.\n", - NAME_CURRENT_COMP); - ); + MPI_MASTER (printf ("Isotropic_Sqw: %s: Focusing can only apply for single\n" + " scattering. Setting to order=1.\n", + NAME_CURRENT_COMP);); order = 1; } /* request statistics */ if (VarSqw.verbose_output > 1) { - Sqw_diagnosis(&VarSqw, &VarSqw.Data_coh); - Sqw_diagnosis(&VarSqw, &VarSqw.Data_inc); + Sqw_diagnosis (&VarSqw, &VarSqw.Data_coh); + Sqw_diagnosis (&VarSqw, &VarSqw.Data_inc); } - for (i=0; i < 2; i++) { + for (i = 0; i < 2; i++) { struct Sqw_Data_struct Data_sqw; - Data_sqw = (i == 0 ? VarSqw.Data_coh : VarSqw.Data_inc); - Table_Free(&(Data_sqw.Sqw)); + Data_sqw = (i == 0 ? VarSqw.Data_coh : VarSqw.Data_inc); + Table_Free (&(Data_sqw.Sqw)); } -/* end INITIALIZE */ + /* end INITIALIZE */ %} /*****************************************************************************/ @@ -2197,602 +2189,641 @@ INITIALIZE TRACE %{ -int intersect=0; /* flag to continue/stop */ -double t0, t1, t2, t3; /* times for intersections */ -double dt0, dt1, dt2, dt; /* time intervals */ -double k=0, Ei=0; -double v=0, vf=0; -double d_path; /* total path length for straight trajectory */ -double my_a; /* absorption cross-section scaled to velocity (2200) */ -double ws, p_scatt; /* probability for scattering/absorption and for */ - /* interaction along d_path */ -double tmp_rand; /* temporary var */ -double ratio_w=0, ratio_q=0; /* variables for bilinear interpolation */ -double q11, q21, q22, q12; -double omega=0; /* energy transfer */ -double q=0; /* wavevector transfer */ -long index_w; /* energy index for table look-up SW */ -long index_q; /* Q index for table look-up P(Q|w) */ -double theta=0, costheta=0; /* for the choice of kf direction */ -double u1x,u1y,u1z; -double u2x,u2y,u2z; -double u0x,u0y,u0z; -int index_counter; -int flag=0; -int flag_concentric=0; -int flag_ishollow=0; -double solid_angle=0; -double my_t=0; -double p_mult=1; -double mc_trans, p_trans, mc_scatt; -double coh=0, inc=0; -struct Sqw_Data_struct Data_sqw; -double d_phi_thread = d_phi; - -char type; - -double ki_x,ki_y,ki_z,ti,vi,ki; -double kf_x,kf_y,kf_z,tf,kf; - -/* Store Initial neutron state */ - -ki_x = V2K*vx; -ki_y = V2K*vy; -ki_z = V2K*vz; -ti = t; -vi = 0; -ki = 0; -type = '\0'; - -#ifdef OPENACC -#ifdef USE_OFF -off_struct thread_offdata = offdata; -#endif -#else -#define thread_offdata offdata -#endif - -do { /* Main interaction loop. Ends with intersect=0 */ - - /* Intersection neutron trajectory / sample (sample surface) */ - if (VarSqw.s_coh > 0 || VarSqw.s_inc > 0) { - if (thickness >= 0) { - if (VarSqw.shape==0) - intersect=cylinder_intersect(&t0,&t3, x,y,z,vx,vy,vz, radius,yheight); - else if (VarSqw.shape==1) - intersect=box_intersect (&t0,&t3, x,y,z,vx,vy,vz, xwidth,yheight,zdepth); - else if (VarSqw.shape==2) - intersect=sphere_intersect (&t0,&t3, x,y,z,vx,vy,vz, radius); - #ifdef USE_OFF - else if (VarSqw.shape == 3) - intersect=off_intersect(&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); - #endif - } else { - if (VarSqw.shape==0) - intersect=cylinder_intersect(&t0,&t3, x,y,z,vx,vy,vz, radius-thickness, - yheight-2*thickness > 0 ? yheight-2*thickness : yheight); - else if (VarSqw.shape==1) - intersect=box_intersect (&t0,&t3, x,y,z,vx,vy,vz, - xwidth-2*thickness > 0 ? xwidth-2*thickness : xwidth, - yheight-2*thickness > 0 ? yheight-2*thickness : yheight, - zdepth-2*thickness > 0 ? zdepth-2*thickness : zdepth); - else if (VarSqw.shape==2) - intersect=sphere_intersect (&t0,&t3, x,y,z,vx,vy,vz, radius-thickness); - #ifdef USE_OFF - else if (VarSqw.shape == 3) - intersect=off_intersect(&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); - #endif - } - } else intersect=0; - - /* Computing the intermediate times */ - if (intersect) { - flag_ishollow = 0; - if (thickness > 0) { - if (VarSqw.shape==0 && cylinder_intersect(&t1,&t2, x,y,z,vx,vy,vz, radius-thickness, - yheight-2*thickness > 0 ? yheight-2*thickness : yheight)) - flag_ishollow=1; - else if (VarSqw.shape==2 && sphere_intersect (&t1,&t2, x,y,z,vx,vy,vz, radius-thickness)) - flag_ishollow=1; - else if (VarSqw.shape==1 && box_intersect(&t1,&t2, x,y,z,vx,vy,vz, - xwidth-2*thickness > 0 ? xwidth-2*thickness : xwidth, - yheight-2*thickness > 0 ? yheight-2*thickness : yheight, - zdepth-2*thickness > 0 ? zdepth-2*thickness : zdepth)) - flag_ishollow=1; - } else if (thickness<0) { - if (VarSqw.shape==0 && cylinder_intersect(&t1,&t2, x,y,z,vx,vy,vz, radius,yheight)) - flag_ishollow=1; - else if (VarSqw.shape==2 && sphere_intersect (&t1,&t2, x,y,z,vx,vy,vz, radius)) - flag_ishollow=1; - else if (VarSqw.shape==1 && box_intersect(&t1,&t2, x,y,z,vx,vy,vz, xwidth, yheight, zdepth)) - flag_ishollow=1; - } - if (!flag_ishollow) t1 = t2 = t3; /* no empty space inside */ - } else break; /* neutron does not hit sample: transmitted */ - - if (intersect) { /* the neutron hits the sample */ - - if (t0 > 0) { /* we are before the sample */ - PROP_DT(t0); /* propagates neutron to the entry of the sample */ - } else if (t1 > 0 && t1 > t0) { /* we are inside first part of the sample */ - /* no propagation, stay inside */ - } else if (t2 > 0 && t2 > t1) { /* we are in the hole */ - PROP_DT(t2); /* propagate to inner surface of 2nd part of sample */ - } else if (t3 > 0 && t3 > t2) { /* we are in the 2nd part of sample */ - /* no propagation, stay inside */ - } + int intersect = 0; /* flag to continue/stop */ + double t0, t1, t2, t3; /* times for intersections */ + double dt0, dt1, dt2, dt; /* time intervals */ + double k = 0, Ei = 0; + double v = 0, vf = 0; + double d_path; /* total path length for straight trajectory */ + double my_a; /* absorption cross-section scaled to velocity (2200) */ + double ws, p_scatt; /* probability for scattering/absorption and for */ + /* interaction along d_path */ + double tmp_rand; /* temporary var */ + double ratio_w = 0, ratio_q = 0; /* variables for bilinear interpolation */ + double q11, q21, q22, q12; + double omega = 0; /* energy transfer */ + double q = 0; /* wavevector transfer */ + long index_w; /* energy index for table look-up SW */ + long index_q; /* Q index for table look-up P(Q|w) */ + double theta = 0, costheta = 0; /* for the choice of kf direction */ + double u1x, u1y, u1z; + double u2x, u2y, u2z; + double u0x, u0y, u0z; + int index_counter; + int flag = 0; + int flag_concentric = 0; + int flag_ishollow = 0; + double solid_angle = 0; + double my_t = 0; + double p_mult = 1; + double mc_trans, p_trans, mc_scatt; + double coh = 0, inc = 0; + struct Sqw_Data_struct Data_sqw; + double d_phi_thread = d_phi; + + char type; + + double ki_x, ki_y, ki_z, ti, vi, ki; + double kf_x, kf_y, kf_z, tf, kf; + + /* Store Initial neutron state */ + + ki_x = V2K * vx; + ki_y = V2K * vy; + ki_z = V2K * vz; + ti = t; + vi = 0; + ki = 0; + type = '\0'; + + #ifdef OPENACC + #ifdef USE_OFF + off_struct thread_offdata = offdata; + #endif + #else + #define thread_offdata offdata + #endif + + do { /* Main interaction loop. Ends with intersect=0 */ + + /* Intersection neutron trajectory / sample (sample surface) */ + if (VarSqw.s_coh > 0 || VarSqw.s_inc > 0) { + if (thickness >= 0) { + if (VarSqw.shape == 0) + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + else if (VarSqw.shape == 1) + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + else if (VarSqw.shape == 2) + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); + #ifdef USE_OFF + else if (VarSqw.shape == 3) + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + #endif + } else { + if (VarSqw.shape == 0) + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius - thickness, yheight - 2 * thickness > 0 ? yheight - 2 * thickness : yheight); + else if (VarSqw.shape == 1) + intersect + = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth - 2 * thickness > 0 ? xwidth - 2 * thickness : xwidth, + yheight - 2 * thickness > 0 ? yheight - 2 * thickness : yheight, zdepth - 2 * thickness > 0 ? zdepth - 2 * thickness : zdepth); + else if (VarSqw.shape == 2) + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius - thickness); + #ifdef USE_OFF + else if (VarSqw.shape == 3) + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + #endif + } + } else + intersect = 0; - dt0=t1-(t0 > 0 ? t0 : 0); /* Time in first part of hollow/cylinder/box */ - dt1=t2-(t1 > 0 ? t1 : 0); /* Time in hole */ - dt2=t3-(t2 > 0 ? t2 : 0); /* Time in 2nd part of hollow cylinder */ + /* Computing the intermediate times */ + if (intersect) { + flag_ishollow = 0; + if (thickness > 0) { + if (VarSqw.shape == 0 + && cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness, yheight - 2 * thickness > 0 ? yheight - 2 * thickness : yheight)) + flag_ishollow = 1; + else if (VarSqw.shape == 2 && sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness)) + flag_ishollow = 1; + else if (VarSqw.shape == 1 + && box_intersect (&t1, &t2, x, y, z, vx, vy, vz, xwidth - 2 * thickness > 0 ? xwidth - 2 * thickness : xwidth, + yheight - 2 * thickness > 0 ? yheight - 2 * thickness : yheight, zdepth - 2 * thickness > 0 ? zdepth - 2 * thickness : zdepth)) + flag_ishollow = 1; + } else if (thickness < 0) { + if (VarSqw.shape == 0 && cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius, yheight)) + flag_ishollow = 1; + else if (VarSqw.shape == 2 && sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius)) + flag_ishollow = 1; + else if (VarSqw.shape == 1 && box_intersect (&t1, &t2, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) + flag_ishollow = 1; + } + if (!flag_ishollow) + t1 = t2 = t3; /* no empty space inside */ + } else + break; /* neutron does not hit sample: transmitted */ + + if (intersect) { /* the neutron hits the sample */ + + if (t0 > 0) { /* we are before the sample */ + PROP_DT (t0); /* propagates neutron to the entry of the sample */ + } else if (t1 > 0 && t1 > t0) { /* we are inside first part of the sample */ + /* no propagation, stay inside */ + } else if (t2 > 0 && t2 > t1) { /* we are in the hole */ + PROP_DT (t2); /* propagate to inner surface of 2nd part of sample */ + } else if (t3 > 0 && t3 > t2) { /* we are in the 2nd part of sample */ + /* no propagation, stay inside */ + } - if (dt0 < 0) dt0 = 0; - if (dt1 < 0) dt1 = 0; - if (dt2 < 0) dt2 = 0; + dt0 = t1 - (t0 > 0 ? t0 : 0); /* Time in first part of hollow/cylinder/box */ + dt1 = t2 - (t1 > 0 ? t1 : 0); /* Time in hole */ + dt2 = t3 - (t2 > 0 ? t2 : 0); /* Time in 2nd part of hollow cylinder */ - /* initialize concentric mode */ - if (concentric && !flag_concentric && t0 >= 0 - && VarSqw.shape==0 && thickness) { - flag_concentric=1; - } + if (dt0 < 0) + dt0 = 0; + if (dt1 < 0) + dt1 = 0; + if (dt2 < 0) + dt2 = 0; - if (flag_concentric == 1) { - dt1=dt2=0; /* force exit when reaching hole/2nd part */ - } + /* initialize concentric mode */ + if (concentric && !flag_concentric && t0 >= 0 && VarSqw.shape == 0 && thickness) { + flag_concentric = 1; + } - if (!dt0 && !dt2) { - intersect = 0; /* the sample was passed entirely */ - break; - } + if (flag_concentric == 1) { + dt1 = dt2 = 0; /* force exit when reaching hole/2nd part */ + } - VarSqw.neutron_enter++; - p_mult = 1; - if (!v) { - v = vx*vx+vy*vy+vz*vz; - v = sqrt(v); - } - k = V2K*v; - Ei = VS2E*v*v; + if (!dt0 && !dt2) { + intersect = 0; /* the sample was passed entirely */ + break; + } - if (!vi) vi = v; - if (!ki) ki = k; + VarSqw.neutron_enter++; + p_mult = 1; + if (!v) { + v = vx * vx + vy * vy + vz * vz; + v = sqrt (v); + } + k = V2K * v; + Ei = VS2E * v * v; - if (v <= 0) { - printf("Isotropic_Sqw: %s: ERROR: Null velocity !\n",NAME_CURRENT_COMP); - VarSqw.neutron_removed++; - ABSORB; /* should never occur */ - } + if (!vi) + vi = v; + if (!ki) + ki = k; - /* check for scattering event */ - my_a = VarSqw.my_a_v / v; /* absorption 'mu' */ - /* compute total scattering X section */ - /* \int q S(q) dq /2 /ki^2 sigma OR bare Xsection*/ - /* contains the 4*PI*kf/ki factor */ - coh = VarSqw.s_coh; - inc = VarSqw.s_inc; - if (k && VarSqw.s_coh>0 && VarSqw.Data_coh.intensity) { - double Ei = VS2E*v*v; - double index_Ei = Ei / (VarSqw.Data_coh.Ei_max/VarSqw.Data_coh.iqSq_length); - coh = Table_Value2d(VarSqw.Data_coh.iqSq, index_Ei, 0); - } - if (k && VarSqw.s_inc>0 && VarSqw.Data_inc.intensity) { - double Ei = VS2E*v*v; - double index_Ei = Ei / (VarSqw.Data_inc.Ei_max/VarSqw.Data_inc.iqSq_length); - inc = Table_Value2d(VarSqw.Data_inc.iqSq, index_Ei, 0); - } - if (coh<0) coh=0; - if (inc<0) inc=0; - VarSqw.my_s =(VarSqw.mat_rho*100*(coh + inc)); - - my_t = my_a + VarSqw.my_s; /* total scattering Xsect */ - if (my_t <= 0) { - if (VarSqw.neutron_removed 1 && VarSqw.neutron_removed 0 && VarSqw.Data_coh.intensity) { + double Ei = VS2E * v * v; + double index_Ei = Ei / (VarSqw.Data_coh.Ei_max / VarSqw.Data_coh.iqSq_length); + coh = Table_Value2d (VarSqw.Data_coh.iqSq, index_Ei, 0); + } + if (k && VarSqw.s_inc > 0 && VarSqw.Data_inc.intensity) { + double Ei = VS2E * v * v; + double index_Ei = Ei / (VarSqw.Data_inc.Ei_max / VarSqw.Data_inc.iqSq_length); + inc = Table_Value2d (VarSqw.Data_inc.iqSq, index_Ei, 0); + } + if (coh < 0) + coh = 0; + if (inc < 0) + inc = 0; + VarSqw.my_s = (VarSqw.mat_rho * 100 * (coh + inc)); + + my_t = my_a + VarSqw.my_s; /* total scattering Xsect */ + if (my_t <= 0) { + if (VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: ERROR: Null total cross section %g. Removing event.\n", NAME_CURRENT_COMP, my_t); + VarSqw.neutron_removed++; + ABSORB; /* should never occur */ + } else if (VarSqw.my_s <= 0) { + if (VarSqw.verbose_output > 1 && VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: Warning: Null scattering cross section %g. Ignoring.\n", NAME_CURRENT_COMP, VarSqw.my_s); + VarSqw.my_s = 0; + } - flag = 0; /* flag used for propagation to exit point before ending */ + /* Proba of scattering vs absorption (integrating along the whole trajectory) */ + ws = VarSqw.my_s / my_t; /* (inc+coh)/(inc+coh+abs) */ + d_path = v * (dt0 + dt2); /* total path lenght in sample */ + /* Proba of transmission/interaction along length d_path */ + p_trans = exp (-my_t * d_path); + p_scatt = 1 - p_trans; /* portion of beam which scatters */ - /* are we next to the exit ? probably no scattering (avoid rounding errors) */ - if (VarSqw.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) */ - if (!SCATTERED) mc_trans = 1-p_interact; - else mc_trans = 1-p_interact/(4*SCATTERED+1); /* reduce effect on multi scatt */ - } else { - mc_trans = p_trans; /* 1 - p_scatt */ - } - mc_scatt = 1 - mc_trans; /* portion of beam to scatter (or force to) */ - if (mc_scatt <= 0 || mc_scatt>1) flag=1; - /* 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 */ - if (!mc_scatt) ABSORB; - p_mult *= fabs(p_scatt/mc_scatt); /* lower than 1 */ - } else { - flag = 1; /* Transmission : no interaction neutron/sample */ - if (!type) type = 't'; - if (!mc_trans) ABSORB; - p_mult *= fabs(p_trans/mc_trans); /* attenuate beam by portion which is scattered (and left along) */ - } + flag = 0; /* flag used for propagation to exit point before ending */ - if (flag) { /* propagate to exit of sample and finish */ - intersect = 0; - p *= p_mult; /* apply absorption correction */ - PROP_DT(dt0+dt2); - break; /* exit main multi scatt while loop */ - } - } /* end if intersect the neutron hits the sample */ - else break; - - if (intersect) { /* scattering event */ - double kf=0, kf1, kf2; - /* mean scattering probability and absorption fraction */ - VarSqw.mean_scatt += (1-exp(-VarSqw.my_s*d_path))*p; - VarSqw.mean_abs += (1-ws)*p; - VarSqw.psum_scatt += p; - - /* Decaying exponential distribution of the path length before scattering */ - /* Select a point at which to scatter the neutron, taking - secondary extinction into account. */ - 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 */ + /* are we next to the exit ? probably no scattering (avoid rounding errors) */ + if (VarSqw.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) */ + if (!SCATTERED) + mc_trans = 1 - p_interact; + else + mc_trans = 1 - p_interact / (4 * SCATTERED + 1); /* reduce effect on multi scatt */ + } else { + mc_trans = p_trans; /* 1 - p_scatt */ + } + mc_scatt = 1 - mc_trans; /* portion of beam to scatter (or force to) */ + if (mc_scatt <= 0 || mc_scatt > 1) + flag = 1; + /* 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 */ + if (!mc_scatt) + ABSORB; + p_mult *= fabs (p_scatt / mc_scatt); /* lower than 1 */ + } else { + flag = 1; /* Transmission : no interaction neutron/sample */ + if (!type) + type = 't'; + if (!mc_trans) + ABSORB; + p_mult *= fabs (p_trans / mc_trans); /* attenuate beam by portion which is scattered (and left along) */ + } + + if (flag) { /* propagate to exit of sample and finish */ + intersect = 0; + p *= p_mult; /* apply absorption correction */ + PROP_DT (dt0 + dt2); + break; /* exit main multi scatt while loop */ + } + } /* end if intersect the neutron hits the sample */ else - dt = -log(1 - rand0max((1 - exp(-my_t*d_path)))) / my_t; /* length */ - dt /= v; /* Time from present position to scattering point */ - - /* If t0 is in hole, propagate to next part of the hollow cylinder */ - if (dt1 > 0 && dt0 > 0 && dt > dt0) dt += dt1; - - /* Neutron propagation to the scattering point */ - PROP_DT(dt); - - /* choice between coherent/incoherent scattering */ - tmp_rand = rand01(); - /* local description at the scattering point (scat probability for atom) */ - tmp_rand *= (coh+inc); - - flag=0; - if (VarSqw.s_inc>0 && tmp_rand < inc) { - /* CASE 1: incoherent case */ - if (!VarSqw.Data_inc.intensity) { - /* CASE 1a: no incoherent Sqw from file, use isotropic V-like */ - if (d_phi_thread && order == 1) { - randvec_target_rect_angular(&u1x, &u1y, &u1z, &solid_angle, - vx, vy, vz, 2*PI, d_phi_thread, ROT_A_CURRENT_COMP); - p_mult *= solid_angle/4/PI; /* weighted by focused range to total range */ - } else - randvec_target_circle(&u1x, &u1y, &u1z, NULL, vx, vy, vz, 0); + break; - vx = u1x; vy = u1y; vz = u1z; - vf = v; kf = k; - if (!type) type = 'v'; - SCATTER; - } else { - /* CASE 1b: incoherent Sqw from file */ - if (VarSqw.Data_inc.intensity) { - Data_sqw = VarSqw.Data_inc; - if (!type) type = 'i'; + if (intersect) { /* scattering event */ + double kf = 0, kf1, kf2; + /* mean scattering probability and absorption fraction */ + VarSqw.mean_scatt += (1 - exp (-VarSqw.my_s * d_path)) * p; + VarSqw.mean_abs += (1 - ws) * p; + VarSqw.psum_scatt += p; + + /* Decaying exponential distribution of the path length before scattering */ + /* Select a point at which to scatter the neutron, taking + secondary extinction into account. */ + 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 + dt = -log (1 - rand0max ((1 - exp (-my_t * d_path)))) / my_t; /* length */ + dt /= v; /* Time from present position to scattering point */ + + /* If t0 is in hole, propagate to next part of the hollow cylinder */ + if (dt1 > 0 && dt0 > 0 && dt > dt0) + dt += dt1; + + /* Neutron propagation to the scattering point */ + PROP_DT (dt); + + /* choice between coherent/incoherent scattering */ + tmp_rand = rand01 (); + /* local description at the scattering point (scat probability for atom) */ + tmp_rand *= (coh + inc); + + flag = 0; + if (VarSqw.s_inc > 0 && tmp_rand < inc) { + /* CASE 1: incoherent case */ + if (!VarSqw.Data_inc.intensity) { + /* CASE 1a: no incoherent Sqw from file, use isotropic V-like */ + if (d_phi_thread && order == 1) { + randvec_target_rect_angular (&u1x, &u1y, &u1z, &solid_angle, vx, vy, vz, 2 * PI, d_phi_thread, ROT_A_CURRENT_COMP); + p_mult *= solid_angle / 4 / PI; /* weighted by focused range to total range */ + } else + randvec_target_circle (&u1x, &u1y, &u1z, NULL, vx, vy, vz, 0); + + vx = u1x; + vy = u1y; + vz = u1z; + vf = v; + kf = k; + if (!type) + type = 'v'; + SCATTER; + } else { + /* CASE 1b: incoherent Sqw from file */ + if (VarSqw.Data_inc.intensity) { + Data_sqw = VarSqw.Data_inc; + if (!type) + type = 'i'; + flag = 1; + } + } + } else if (VarSqw.s_coh > 0 && tmp_rand > VarSqw.s_inc) { + if (VarSqw.Data_coh.intensity) { + /* CASE2: coherent case */ + Data_sqw = VarSqw.Data_coh; + if (!type) + type = 'c'; flag = 1; } } - } else if (VarSqw.s_coh>0 && tmp_rand > VarSqw.s_inc) { - if (VarSqw.Data_coh.intensity) { - /* CASE2: coherent case */ - Data_sqw = VarSqw.Data_coh; - if (!type) type = 'c'; - flag = 1; - } - } - if (flag) { /* true when S(q,w) table exists (Data_sqw) */ - - double alpha=0, alpha0; - /* give us a limited number of tries for scattering: choose W then Q */ - for (index_counter=VarSqw.maxloop; index_counter > 0 ; index_counter--) { - - /* MC choice: energy transfer w=Ei-Ef in the S(w) = SW */ - omega = 0; - tmp_rand = rand01(); - /* energy index for rand > cumul SW */ - index_w = Sqw_search_SW(Data_sqw, tmp_rand); - VarSqw.rw = (double)index_w; - if (index_w >= 0 && &(Data_sqw.SW[index_w]) != NULL) { - if (Data_sqw.w_bins > 1) { - double w1, w2; - if (index_w > 0) { /* interpolate linearly energy */ - ratio_w = (tmp_rand - Data_sqw.SW[index_w-1].cumul_proba) - /(Data_sqw.SW[index_w].cumul_proba - Data_sqw.SW[index_w-1].cumul_proba); - /* ratio_w=0 omega[index_w-1], ratio=1 omega[index] */ - w1 = Data_sqw.SW[index_w-1].omega; w2 = Data_sqw.SW[index_w].omega; - } else { /* index_w = 0 interpolate to 0 energy */ - /* ratio_w=0 omega=0, ratio=1 omega[index] */ - w1 = Data_sqw.SW[index_w].omega; w2= Data_sqw.SW[index_w+1].omega; - if (!w2 && index_w+1 < Data_sqw.w_bins) - w2= Data_sqw.SW[index_w+1].omega; - if (Data_sqw.w_bins && Data_sqw.SW[index_w].cumul_proba) { - ratio_w = tmp_rand/Data_sqw.SW[index_w].cumul_proba; - } else ratio_w=0; + if (flag) { /* true when S(q,w) table exists (Data_sqw) */ + + double alpha = 0, alpha0; + /* give us a limited number of tries for scattering: choose W then Q */ + for (index_counter = VarSqw.maxloop; index_counter > 0; index_counter--) { + + /* MC choice: energy transfer w=Ei-Ef in the S(w) = SW */ + omega = 0; + tmp_rand = rand01 (); + /* energy index for rand > cumul SW */ + index_w = Sqw_search_SW (Data_sqw, tmp_rand); + VarSqw.rw = (double)index_w; + if (index_w >= 0 && &(Data_sqw.SW[index_w]) != NULL) { + if (Data_sqw.w_bins > 1) { + double w1, w2; + if (index_w > 0) { /* interpolate linearly energy */ + ratio_w = (tmp_rand - Data_sqw.SW[index_w - 1].cumul_proba) / (Data_sqw.SW[index_w].cumul_proba - Data_sqw.SW[index_w - 1].cumul_proba); + /* ratio_w=0 omega[index_w-1], ratio=1 omega[index] */ + w1 = Data_sqw.SW[index_w - 1].omega; + w2 = Data_sqw.SW[index_w].omega; + } else { /* index_w = 0 interpolate to 0 energy */ + /* ratio_w=0 omega=0, ratio=1 omega[index] */ + w1 = Data_sqw.SW[index_w].omega; + w2 = Data_sqw.SW[index_w + 1].omega; + if (!w2 && index_w + 1 < Data_sqw.w_bins) + w2 = Data_sqw.SW[index_w + 1].omega; + if (Data_sqw.w_bins && Data_sqw.SW[index_w].cumul_proba) { + ratio_w = tmp_rand / Data_sqw.SW[index_w].cumul_proba; + } else + ratio_w = 0; + } + if (ratio_w < 0) + ratio_w = 0; + else if (ratio_w > 1) + ratio_w = 1; + omega = (1 - ratio_w) * w1 + ratio_w * w2; + } else { + ratio_w = 0; + omega = Data_sqw.SW[index_w].omega; } - if (ratio_w<0) ratio_w=0; else if (ratio_w>1) ratio_w=1; - omega = (1-ratio_w)*w1 + ratio_w*w2; } else { - ratio_w = 0; - omega = Data_sqw.SW[index_w].omega; + if (VarSqw.verbose_output >= 3 && VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: Warning: No suitable w transfer for index_w=%li.\n", NAME_CURRENT_COMP, index_w); + continue; /* no W value: try again with an other energy transfer */ } - } else { - if (VarSqw.verbose_output >= 3 && VarSqw.neutron_removed cumul SQ|W */ - index_q = Sqw_search_Q_proba_per_w(Data_sqw, tmp_rand, index_w); - VarSqw.rq = (double)index_q; - - if (index_q >= 0 && &(Data_sqw.SQW[index_w]) != NULL) { - if (Data_sqw.q_bins > 1 && index_q > 0) { - if (index_w > 0 && Data_sqw.w_bins > 1) { - /* bilinear interpolation on - side: index_w > 0, index_q > 0 */ - ratio_q = (tmp_rand - Data_sqw.SQW[index_w][index_q-1].cumul_proba) - /(Data_sqw.SQW[index_w][index_q].cumul_proba - - Data_sqw.SQW[index_w][index_q-1].cumul_proba); - q22 = Data_sqw.SQW[index_w] [index_q].Q; - q11 = Data_sqw.SQW[index_w-1][index_q-1].Q; - q21 = Data_sqw.SQW[index_w] [index_q-1].Q; - q12 = Data_sqw.SQW[index_w-1][index_q].Q; - if (ratio_q<0) ratio_q=0; else if (ratio_q>1) ratio_q=1; - q = (1-ratio_w)*(1-ratio_q)*q11+ratio_w*(1-ratio_q)*q21 - + ratio_w*ratio_q*q22 +(1-ratio_w)*ratio_q*q12; - } else { /* bilinear interpolation on + side: index_w=0, index_q > 0 */ - ratio_q = (tmp_rand - Data_sqw.SQW[index_w][index_q-1].cumul_proba) - /(Data_sqw.SQW[index_w][index_q].cumul_proba - - Data_sqw.SQW[index_w][index_q-1].cumul_proba); - q11 = Data_sqw.SQW[index_w] [index_q-1].Q; - q12 = Data_sqw.SQW[index_w] [index_q].Q; - if (ratio_q<0) ratio_q=0; else if (ratio_q>1) ratio_q=1; - if (index_w < Data_sqw.w_bins-1 && Data_sqw.w_bins > 1) { - q22 = Data_sqw.SQW[index_w+1][index_q].Q; - q21 = Data_sqw.SQW[index_w+1][index_q-1].Q; - q = (1-ratio_w)*(1-ratio_q)*q11+ratio_w*(1-ratio_q)*q21 - + ratio_w*ratio_q*q22 +(1-ratio_w)*ratio_q*q12; - } else { - q = (1-ratio_q)*q11 + ratio_q*q12; + /* MC choice: momentum transfer Q in P(Q|w) */ + tmp_rand = rand01 (); + + /* momentum index for rand > cumul SQ|W */ + index_q = Sqw_search_Q_proba_per_w (Data_sqw, tmp_rand, index_w); + VarSqw.rq = (double)index_q; + + if (index_q >= 0 && &(Data_sqw.SQW[index_w]) != NULL) { + if (Data_sqw.q_bins > 1 && index_q > 0) { + if (index_w > 0 && Data_sqw.w_bins > 1) { + /* bilinear interpolation on - side: index_w > 0, index_q > 0 */ + ratio_q = (tmp_rand - Data_sqw.SQW[index_w][index_q - 1].cumul_proba) + / (Data_sqw.SQW[index_w][index_q].cumul_proba - Data_sqw.SQW[index_w][index_q - 1].cumul_proba); + q22 = Data_sqw.SQW[index_w][index_q].Q; + q11 = Data_sqw.SQW[index_w - 1][index_q - 1].Q; + q21 = Data_sqw.SQW[index_w][index_q - 1].Q; + q12 = Data_sqw.SQW[index_w - 1][index_q].Q; + if (ratio_q < 0) + ratio_q = 0; + else if (ratio_q > 1) + ratio_q = 1; + q = (1 - ratio_w) * (1 - ratio_q) * q11 + ratio_w * (1 - ratio_q) * q21 + ratio_w * ratio_q * q22 + (1 - ratio_w) * ratio_q * q12; + } else { /* bilinear interpolation on + side: index_w=0, index_q > 0 */ + ratio_q = (tmp_rand - Data_sqw.SQW[index_w][index_q - 1].cumul_proba) + / (Data_sqw.SQW[index_w][index_q].cumul_proba - Data_sqw.SQW[index_w][index_q - 1].cumul_proba); + q11 = Data_sqw.SQW[index_w][index_q - 1].Q; + q12 = Data_sqw.SQW[index_w][index_q].Q; + if (ratio_q < 0) + ratio_q = 0; + else if (ratio_q > 1) + ratio_q = 1; + if (index_w < Data_sqw.w_bins - 1 && Data_sqw.w_bins > 1) { + q22 = Data_sqw.SQW[index_w + 1][index_q].Q; + q21 = Data_sqw.SQW[index_w + 1][index_q - 1].Q; + q = (1 - ratio_w) * (1 - ratio_q) * q11 + ratio_w * (1 - ratio_q) * q21 + ratio_w * ratio_q * q22 + (1 - ratio_w) * ratio_q * q12; + } else { + q = (1 - ratio_q) * q11 + ratio_q * q12; + } } + } else { + q = Data_sqw.SQW[index_w][index_q].Q; } } else { - q = Data_sqw.SQW[index_w][index_q].Q; + if (VarSqw.verbose_output >= 3 && VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: Warning: No suitable q transfer for w=%g.\n", NAME_CURRENT_COMP, omega); + VarSqw.neutron_removed++; + continue; /* no Q value for this w choice */ } - } else { - if (VarSqw.verbose_output >= 3 && VarSqw.neutron_removed= 3 && VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: Warning: imaginary root for w=%g q=%g Ei=%g (triangle can not close)\n", NAME_CURRENT_COMP, omega, q, Ei); + VarSqw.neutron_removed++; + continue; /* all roots are imaginary */ + } + + /* kf1 and kf2 are opposite */ + kf = fabs (kf1); + vf = K2V * kf; + + /* Search of the direction of kf such that : q = ki - kf */ + /* cos theta = (ki2+kf2-q2)/(2ki kf) */ + + costheta = (k * k + kf * kf - q * q) / (2 * kf * k); /* this is cos(theta) */ + + if (-1 < costheta && costheta < 1) { + break; /* satisfies q momentum conservation */ + } + /* else continue; */ + + /* exit for loop on success */ + } /* end for index_counter */ + + if (!index_counter) { /* for loop ended: failure for scattering */ + intersect = 0; /* Could not scatter: finish multiple scattering loop */ + if (VarSqw.verbose_output >= 2 && VarSqw.neutron_removed < VarSqw.maxloop) + printf ("Isotropic_Sqw: %s: Warning: No scattering [q,w] conditions\n" + " last try (%i): type=%c w=%g q=%g cos(theta)=%g k=%g\n", + NAME_CURRENT_COMP, VarSqw.maxloop, (type ? type : '-'), omega, q, costheta, k); VarSqw.neutron_removed++; - continue; /* no Q value for this w choice */ + if (order && SCATTERED != order) + ABSORB; + break; /* finish multiple scattering loop */ } - /* Search for length of final wave vector kf */ - /* kf is such that : hbar*w = hbar*hbar/2/m*(k*k - kf*kf) */ - /* acceptable values for kf are kf1 and kf2 */ - if (!solve_2nd_order(&kf1, &kf2, 1, 0, -k*k + VarSqw.sqSE2K*omega)) { - if (VarSqw.verbose_output >= 3 && VarSqw.neutron_removed 1) + d_phi_thread = 0; + /* Otherwise, determine alpha to rotate from scattering plane + into d_phi_thread focusing area*/ + else + alpha = 2 * asin (cone_focus); + if (d_phi_thread) + p_mult *= alpha / PI; } + if (d_phi_thread) { + /* Focusing */ + alpha = fabs (alpha); + /* Trick to get scattering for pos/neg theta's */ + alpha0 = 2 * rand01 () * alpha; + if (alpha0 > alpha) { + alpha0 = PI + (alpha0 - 1.5 * alpha); + } else { + alpha0 = alpha0 - 0.5 * alpha; + } + } else + alpha0 = PI * randpm1 (); - /* kf1 and kf2 are opposite */ - kf = fabs(kf1); - vf = K2V*kf; + /* now find a nearly vertical rotation axis (u1) : + * Either + * (v along Z) x (X axis) -> nearly Y axis + * Or + * (v along X) x (Z axis) -> nearly Y axis + */ + if (fabs (scalar_prod (1, 0, 0, vx / v, vy / v, vz / v)) < fabs (scalar_prod (0, 0, 1, vx / v, vy / v, vz / v))) { + u1x = 1; + u1y = u1z = 0; + } else { + u1x = u1y = 0; + u1z = 1; + } + vec_prod (u2x, u2y, u2z, vx, vy, vz, u1x, u1y, u1z); - /* Search of the direction of kf such that : q = ki - kf */ - /* cos theta = (ki2+kf2-q2)/(2ki kf) */ + /* handle case where v and aim are parallel */ + if (!u2x && !u2y && !u2z) { + u2x = u2z = 0; + u2y = 1; + } - costheta= (k*k+kf*kf-q*q)/(2*kf*k); /* this is cos(theta) */ + /* u1 = rotate 'v' by theta around u2: DS scattering angle, nearly in horz plane */ + rotate (u1x, u1y, u1z, vx, vy, vz, theta, u2x, u2y, u2z); - if (-1 < costheta && costheta < 1) { - break; /* satisfies q momentum conservation */ - } -/* else continue; */ + /* u0 = rotate u1 by alpha0 around 'v' (Debye-Scherrer cone) */ + rotate (u0x, u0y, u0z, u1x, u1y, u1z, alpha0, vx, vy, vz); + NORM (u0x, u0y, u0z); + vx = u0x * vf; + vy = u0y * vf; + vz = u0z * vf; - /* exit for loop on success */ - } /* end for index_counter */ + SCATTER; - if (!index_counter) { /* for loop ended: failure for scattering */ - intersect=0; /* Could not scatter: finish multiple scattering loop */ - if (VarSqw.verbose_output >= 2 && VarSqw.neutron_removed 1) d_phi_thread = 0; - /* Otherwise, determine alpha to rotate from scattering plane - into d_phi_thread focusing area*/ - else alpha = 2*asin(cone_focus); - if (d_phi_thread) p_mult *= alpha/PI; - } - if (d_phi_thread) { - /* Focusing */ - alpha = fabs(alpha); - /* Trick to get scattering for pos/neg theta's */ - alpha0= 2*rand01()*alpha; - if (alpha0 > alpha) { - alpha0=PI+(alpha0-1.5*alpha); - } else { - alpha0=alpha0-0.5*alpha; - } - } - else - alpha0 = PI*randpm1(); - - /* now find a nearly vertical rotation axis (u1) : - * Either - * (v along Z) x (X axis) -> nearly Y axis - * Or - * (v along X) x (Z axis) -> nearly Y axis - */ - if (fabs(scalar_prod(1,0,0,vx/v,vy/v,vz/v)) < fabs(scalar_prod(0,0,1,vx/v,vy/v,vz/v))) { - u1x = 1; u1y = u1z = 0; - } else { - u1x = u1y = 0; u1z = 1; - } - vec_prod(u2x,u2y,u2z, vx,vy,vz, u1x,u1y,u1z); - - /* handle case where v and aim are parallel */ - if (!u2x && !u2y && !u2z) { u2x=u2z=0; u2y=1; } - - /* u1 = rotate 'v' by theta around u2: DS scattering angle, nearly in horz plane */ - rotate(u1x,u1y,u1z, vx,vy,vz, theta, u2x,u2y,u2z); - - /* u0 = rotate u1 by alpha0 around 'v' (Debye-Scherrer cone) */ - rotate(u0x,u0y,u0z, u1x,u1y,u1z, alpha0, vx, vy, vz); - NORM(u0x,u0y,u0z); - vx = u0x*vf; - vy = u0y*vf; - vz = u0z*vf; - - SCATTER; - - v = vf; k = kf; /* for next iteration */ - - } /* end if (flag) */ - - VarSqw.neutron_exit++; - p *= p_mult; - if (p_mult > 1) VarSqw.neutron_pmult++; - - /* test for a given multiple order */ - if (order && SCATTERED >= order) { - intersect=0; /* reached required number of SCATTERing */ - break; /* finish multiple scattering loop */ - } + } /* end if (flag) */ - } /* end if (intersect) scattering event */ + VarSqw.neutron_exit++; + p *= p_mult; + if (p_mult > 1) + VarSqw.neutron_pmult++; -} while (intersect); /* end do (intersect) (multiple scattering loop) */ + /* test for a given multiple order */ + if (order && SCATTERED >= order) { + intersect = 0; /* reached required number of SCATTERing */ + break; /* finish multiple scattering loop */ + } -/* Store Final neutron state */ -kf_x = V2K*vx; -kf_y = V2K*vy; -kf_z = V2K*vz; -tf = t; -vf = v; -kf = k; -VarSqw.theta= theta; + } /* end if (intersect) scattering event */ -if (SCATTERED) { + } while (intersect); /* end do (intersect) (multiple scattering loop) */ + /* Store Final neutron state */ + kf_x = V2K * vx; + kf_y = V2K * vy; + kf_z = V2K * vz; + tf = t; + vf = v; + kf = k; + VarSqw.theta = theta; + if (SCATTERED) { - if (SCATTERED == 1) { - if (type == 'c') VarSqw.single_coh += p; - else VarSqw.single_inc += p; - VarSqw.dq = sqrt((kf_x-ki_x)*(kf_x-ki_x) - +(kf_y-ki_y)*(kf_y-ki_y) - +(kf_z-ki_z)*(kf_z-ki_z)); - VarSqw.dw = VS2E*(vf*vf - vi*vi); - } else VarSqw.multi += p; + if (SCATTERED == 1) { + if (type == 'c') + VarSqw.single_coh += p; + else + VarSqw.single_inc += p; + VarSqw.dq = sqrt ((kf_x - ki_x) * (kf_x - ki_x) + (kf_y - ki_y) * (kf_y - ki_y) + (kf_z - ki_z) * (kf_z - ki_z)); + VarSqw.dw = VS2E * (vf * vf - vi * vi); + } else + VarSqw.multi += p; -} else VarSqw.dq=VarSqw.dw=0; + } else + VarSqw.dq = VarSqw.dw = 0; -/* end TRACE */ + /* end TRACE */ %} FINALLY %{ - int k; + int k; if (VarSqw.s_coh > 0 || VarSqw.s_inc > 0) - for (k=0; k < 2; k++) { - struct Sqw_Data_struct Data_sqw; - - Data_sqw = (k == 0 ? VarSqw.Data_coh : VarSqw.Data_inc); - /* Data_sqw->Sqw has already been freed at end of INIT */ - Table_Free(&(Data_sqw.iqSq)); - - if (Data_sqw.SW) free(Data_sqw.SW); - if (Data_sqw.SQW) free(Data_sqw.SQW); - if (Data_sqw.SW_lookup) free(Data_sqw.SW_lookup); - if (Data_sqw.QW_lookup) free(Data_sqw.QW_lookup); - } /* end for */ + for (k = 0; k < 2; k++) { + struct Sqw_Data_struct Data_sqw; + + Data_sqw = (k == 0 ? VarSqw.Data_coh : VarSqw.Data_inc); + /* Data_sqw->Sqw has already been freed at end of INIT */ + Table_Free (&(Data_sqw.iqSq)); + + if (Data_sqw.SW) + free (Data_sqw.SW); + if (Data_sqw.SQW) + free (Data_sqw.SQW); + if (Data_sqw.SW_lookup) + free (Data_sqw.SW_lookup); + if (Data_sqw.QW_lookup) + free (Data_sqw.QW_lookup); + } /* end for */ -#ifdef USE_MPI + #ifdef USE_MPI if (mpi_node_count > 1) { double tmp; - tmp = (double)VarSqw.neutron_removed; mc_MPI_Sum(&tmp, 1); VarSqw.neutron_removed=(long)tmp; - tmp = (double)VarSqw.neutron_exit; mc_MPI_Sum(&tmp, 1); VarSqw.neutron_exit=(long)tmp; - tmp = (double)VarSqw.neutron_pmult; mc_MPI_Sum(&tmp, 1); VarSqw.neutron_pmult=(long)tmp; - mc_MPI_Sum(&VarSqw.mean_scatt, 1); - mc_MPI_Sum(&VarSqw.psum_scatt, 1); - mc_MPI_Sum(&VarSqw.mean_abs, 1); - mc_MPI_Sum(&VarSqw.single_coh, 1); - mc_MPI_Sum(&VarSqw.single_inc, 1); - mc_MPI_Sum(&VarSqw.multi, 1); - } -#endif - MPI_MASTER( - if (VarSqw.neutron_removed) - printf("Isotropic_Sqw: %s: %li neutron events (out of %li) that should have\n" - " scattered were transmitted because scattering conditions\n" - "WARNING could not be satisfied after %i tries.\n", - NAME_CURRENT_COMP, VarSqw.neutron_removed, - VarSqw.neutron_exit+VarSqw.neutron_removed, VarSqw.maxloop); - if (VarSqw.neutron_pmult) - printf("Isotropic_Sqw: %s: %li neutron events (out of %li) reached\n" - "WARNING unrealistic weight. The S(q,w) norm might be too high.\n", - NAME_CURRENT_COMP, VarSqw.neutron_pmult, VarSqw.neutron_exit); - - if (VarSqw.verbose_output >= 1 && VarSqw.psum_scatt > 0) { - printf("Isotropic_Sqw: %s: Scattering fraction=%g of incoming intensity\n" - " Absorption fraction =%g\n", - NAME_CURRENT_COMP, - VarSqw.mean_scatt/VarSqw.psum_scatt, VarSqw.mean_abs/VarSqw.psum_scatt); - printf(" Single scattering intensity =%g (coh=%g inc=%g)\n" - " Multiple scattering intensity =%g\n", - VarSqw.single_coh+VarSqw.single_inc, VarSqw.single_coh, VarSqw.single_inc, VarSqw.multi); - ); + tmp = (double)VarSqw.neutron_removed; + mc_MPI_Sum (&tmp, 1); + VarSqw.neutron_removed = (long)tmp; + tmp = (double)VarSqw.neutron_exit; + mc_MPI_Sum (&tmp, 1); + VarSqw.neutron_exit = (long)tmp; + tmp = (double)VarSqw.neutron_pmult; + mc_MPI_Sum (&tmp, 1); + VarSqw.neutron_pmult = (long)tmp; + mc_MPI_Sum (&VarSqw.mean_scatt, 1); + mc_MPI_Sum (&VarSqw.psum_scatt, 1); + mc_MPI_Sum (&VarSqw.mean_abs, 1); + mc_MPI_Sum (&VarSqw.single_coh, 1); + mc_MPI_Sum (&VarSqw.single_inc, 1); + mc_MPI_Sum (&VarSqw.multi, 1); } + #endif + MPI_MASTER( + if (VarSqw.neutron_removed) + printf("Isotropic_Sqw: %s: %li neutron events (out of %li) that should have\n" + " scattered were transmitted because scattering conditions\n" + "WARNING could not be satisfied after %i tries.\n", + NAME_CURRENT_COMP, VarSqw.neutron_removed, + VarSqw.neutron_exit+VarSqw.neutron_removed, VarSqw.maxloop); + if (VarSqw.neutron_pmult) + printf("Isotropic_Sqw: %s: %li neutron events (out of %li) reached\n" + "WARNING unrealistic weight. The S(q,w) norm might be too high.\n", + NAME_CURRENT_COMP, VarSqw.neutron_pmult, VarSqw.neutron_exit); + + if (VarSqw.verbose_output >= 1 && VarSqw.psum_scatt > 0) { + printf ("Isotropic_Sqw: %s: Scattering fraction=%g of incoming intensity\n" + " Absorption fraction =%g\n", + NAME_CURRENT_COMP, VarSqw.mean_scatt / VarSqw.psum_scatt, VarSqw.mean_abs / VarSqw.psum_scatt); + printf (" Single scattering intensity =%g (coh=%g inc=%g)\n" + " Multiple scattering intensity =%g\n", + VarSqw.single_coh + VarSqw.single_inc, VarSqw.single_coh, VarSqw.single_inc, VarSqw.multi); + ); + } -/* end FINALLY */ + /* end FINALLY */ %} /*****************************************************************************/ /*****************************************************************************/ @@ -2801,84 +2832,65 @@ MCDISPLAY %{ if (VarSqw.s_coh > 0 || VarSqw.s_inc > 0) { - if(VarSqw.shape==1) - { - 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 (VarSqw.shape == 1) { + 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 (thickness) { - xmin = -0.5*xwidth+thickness; + xmin = -0.5 * xwidth + thickness; xmax = -xmin; - ymin = -0.5*yheight+thickness; + ymin = -0.5 * yheight + thickness; ymax = -ymin; - zmin = -0.5*zdepth+thickness; + zmin = -0.5 * zdepth + thickness; zmax = -zmin; - 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); + 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(VarSqw.shape==0) - { - 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 (VarSqw.shape == 0) { + 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); if (thickness) { - double radius_i=radius-thickness; - circle("xz", 0, yheight/2.0, 0, radius_i); - circle("xz", 0, -yheight/2.0, 0, radius_i); - line(-radius_i, -yheight/2.0, 0, -radius_i, +yheight/2.0, 0); - line(+radius_i, -yheight/2.0, 0, +radius_i, +yheight/2.0, 0); - line(0, -yheight/2.0, -radius_i, 0, +yheight/2.0, -radius_i); - line(0, -yheight/2.0, +radius_i, 0, +yheight/2.0, +radius_i); + double radius_i = radius - thickness; + circle ("xz", 0, yheight / 2.0, 0, radius_i); + circle ("xz", 0, -yheight / 2.0, 0, radius_i); + line (-radius_i, -yheight / 2.0, 0, -radius_i, +yheight / 2.0, 0); + line (+radius_i, -yheight / 2.0, 0, +radius_i, +yheight / 2.0, 0); + line (0, -yheight / 2.0, -radius_i, 0, +yheight / 2.0, -radius_i); + line (0, -yheight / 2.0, +radius_i, 0, +yheight / 2.0, +radius_i); } - } else if(VarSqw.shape==2) { + } else if (VarSqw.shape == 2) { if (thickness) { - double radius_i=radius-thickness; - circle("xy",0,0,0,radius_i); - circle("xz",0,0,0,radius_i); - circle("yz",0,0,0,radius_i); + double radius_i = radius - thickness; + circle ("xy", 0, 0, 0, radius_i); + circle ("xz", 0, 0, 0, radius_i); + circle ("yz", 0, 0, 0, radius_i); } - circle("xy",0,0,0,radius); - circle("xz",0,0,0,radius); - circle("yz",0,0,0,radius); - } else if (VarSqw.shape == 3) { /* OFF file */ - off_display(offdata); + circle ("xy", 0, 0, 0, radius); + circle ("xz", 0, 0, 0, radius); + circle ("yz", 0, 0, 0, radius); + } else if (VarSqw.shape == 3) { /* OFF file */ + off_display (offdata); } } -/* end MCDISPLAY */ + /* end MCDISPLAY */ %} /*****************************************************************************/ diff --git a/mcstas-comps/samples/Magnon_bcc.comp b/mcstas-comps/samples/Magnon_bcc.comp index 8e876d3732..b4fa7cc9aa 100644 --- a/mcstas-comps/samples/Magnon_bcc.comp +++ b/mcstas-comps/samples/Magnon_bcc.comp @@ -84,314 +84,271 @@ target_x=0, target_y=0, target_z=0, int target_index=0,F2=1,focus_r=0,focus_xw=0 /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -#ifndef PHONON_SIMPLE -#define PHONON_SIMPLE $Revision$ -#define T2E (1/11.605) /* Kelvin to meV */ + #ifndef PHONON_SIMPLE + #define PHONON_SIMPLE $Revision$ + #define T2E (1/11.605) /* Kelvin to meV */ -#pragma acc routine -double nbose(double omega, double T) /* Other name ?? */ + #pragma acc routine + double + nbose (double omega, double T) /* Other name ?? */ { double nb; - nb= (omega>0) ? 1+1/(exp(omega/(T*T2E))-1) : 1/(exp(-omega/(T*T2E))-1); + nb = (omega > 0) ? 1 + 1 / (exp (omega / (T * T2E)) - 1) : 1 / (exp (-omega / (T * T2E)) - 1); return nb; } -#undef T2E -/* Routine types inspired from similar ones in Numerical Recipies */ -#define UNUSED (-1.11e30) -#define MAXRIDD 60 - -void fatalerror_cpu(char *s) - { - fprintf(stderr,"%s \n",s); - exit(1); - } - -#pragma acc routine - void fatalerror(char *s, _class_particle *_particle) - { - #ifndef OPENACC - fatalerror_cpu(s); - #else - _particle->_absorbed=1; - #endif - } - - #pragma acc routine - double omega_q(double* parms) - { - /* dispersion in units of meV */ - double vi, vf, vv_x, vv_y, vv_z, vi_x, vi_y, vi_z; - double q, qx, qy, qz, FM, J1, J2, J10, J1q, J20, J2q, D, Verbose, res_magnon, res_neutron; - double ah, a, s, tmp, coherence_flag, coherence_fac, Omega_magnon; - double u_sq_v_sq, uv,cos_factor; - - - vf=parms[0]; - vi=parms[1]; - vv_x=parms[2]; - vv_y=parms[3]; - vv_z=parms[4]; - vi_x=parms[5]; - vi_y=parms[6]; - vi_z=parms[7]; - a =parms[8]; - J1 =parms[9]; - J2 = parms[10]; - s = parms[11]; - D = parms[12]; - Verbose = parms[13]; - coherence_flag = parms[14]; - FM = parms[15]; - ah=a/2.0; - - qx=V2K*(vi_x-vf*vv_x); - qy=V2K*(vi_y-vf*vv_y); - qz=V2K*(vi_z-vf*vv_z); - - /* q=sqrt(qx*qx+qy*qy+qz*qz); */ - J10=8*J1; - J1q=2*J1*(cos(ah*(qx+qy+qz))+cos(ah*(qx+qy-qz))+cos(ah*(qx-qy+qz))+cos(ah*(qx-qy-qz))); - J20=6*J2; - J2q=2*J2*(cos(a*qx)+cos(a*qy)+cos(a*qz)); - if (FM==1) - { - Omega_magnon = s*((J10+J20)-(J1q+J2q))+D*(2*s+1); - } - else - { - tmp = (s*J10-s*J20+s*J2q+D*(2*s-1))*(s*J10-s*J20+s*J2q+D*(2*s-1))-s*s*J1q*J1q; - Omega_magnon = sqrt(tmp); - } - res_magnon = Omega_magnon; - res_neutron = fabs(VS2E*(vi*vi-vf*vf)); - if ((Verbose==2) && fabs(res_magnon-res_neutron)< 1e-3 && (vi>vf) ) - { - // printf("ah = %g, ah*(qx+qy+qz) = %g, cos = %g \n",ah,ah*(qx+qy+qz),cos(ah*(qx+qy+qz))); - printf("omega_q called with parameters vf= %g, vi=%g (%g %g %g) vv=(%g, %g, %g) q=(%g %g %g)\n", vf,vi,vi_x,vi_y,vi_z,vv_x,vv_y,vv_z,qx,qy,qz); - printf("omega_q gives: J10 = %g , J1q = %g, J20 = %g, J2q = %g, D = %g, tmp = %g \n",J10,J1q,J20,J2q,D,tmp); - printf("in omega_q: q=(%g %g %g) omega_magnon=%g, omega_neutron=%g\n",qx,qy,qz,res_magnon,res_neutron); - // printf("omega_q returning %g - %g\n",res_magnon,res_neutron); - } - if (coherence_flag) - { - if (FM==1) - return (1); // no coherence factor for a FM - else - { // This is a tricky equation, which may need a second check (KL 240718) - u_sq_v_sq = 2*s*(2*s*J10-2*s*(J20-J2q))/Omega_magnon; - uv = -2*s*s*J1q/Omega_magnon; - cos_factor= 1; // TODO: this is probably always so (despite otherwise written in Marshall and Lowsey) - coherence_fac=u_sq_v_sq + 2*cos_factor*uv; - return (coherence_fac); - } - } - else - return (res_magnon - res_neutron); -} - -double zridd(double (*func)(double*), double x1, double x2, double *parms, double xacc, _class_particle *_particle) - { - int j; - double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; - - // printf("zridd called with brackets %g %g acceptance %g \n",x1,x2,xacc); - // printf("and %i parameters %g %g %g %g %g \n",Nparms,parms[0],parms[1],parms[2],parms[3], parms[4]); - parms[0]=x1; - fl=(*func)(parms); - parms[0]=x2; - fh=(*func)(parms); - -/* printf("Function values: %g %g \n",fl,fh); */ - if (fl*fh >= 0) - { - if (fl==0) return x1; - if (fh==0) return x2; - return UNUSED; + #undef T2E + /* Routine types inspired from similar ones in Numerical Recipies */ + #define UNUSED (-1.11e30) + #define MAXRIDD 60 + + void + fatalerror_cpu (char* s) { + fprintf (stderr, "%s \n", s); + exit (1); + } + + #pragma acc routine + void + fatalerror (char* s, _class_particle* _particle) { + #ifndef OPENACC + fatalerror_cpu (s); + #else + _particle->_absorbed = 1; + #endif + } + + #pragma acc routine + double + omega_q (double* parms) { + /* dispersion in units of meV */ + double vi, vf, vv_x, vv_y, vv_z, vi_x, vi_y, vi_z; + double q, qx, qy, qz, FM, J1, J2, J10, J1q, J20, J2q, D, Verbose, res_magnon, res_neutron; + double ah, a, s, tmp, coherence_flag, coherence_fac, Omega_magnon; + double u_sq_v_sq, uv, cos_factor; + + vf = parms[0]; + vi = parms[1]; + vv_x = parms[2]; + vv_y = parms[3]; + vv_z = parms[4]; + vi_x = parms[5]; + vi_y = parms[6]; + vi_z = parms[7]; + a = parms[8]; + J1 = parms[9]; + J2 = parms[10]; + s = parms[11]; + D = parms[12]; + Verbose = parms[13]; + coherence_flag = parms[14]; + FM = parms[15]; + ah = a / 2.0; + + qx = V2K * (vi_x - vf * vv_x); + qy = V2K * (vi_y - vf * vv_y); + qz = V2K * (vi_z - vf * vv_z); + + /* q=sqrt(qx*qx+qy*qy+qz*qz); */ + J10 = 8 * J1; + J1q = 2 * J1 * (cos (ah * (qx + qy + qz)) + cos (ah * (qx + qy - qz)) + cos (ah * (qx - qy + qz)) + cos (ah * (qx - qy - qz))); + J20 = 6 * J2; + J2q = 2 * J2 * (cos (a * qx) + cos (a * qy) + cos (a * qz)); + if (FM == 1) { + Omega_magnon = s * ((J10 + J20) - (J1q + J2q)) + D * (2 * s + 1); + } else { + tmp = (s * J10 - s * J20 + s * J2q + D * (2 * s - 1)) * (s * J10 - s * J20 + s * J2q + D * (2 * s - 1)) - s * s * J1q * J1q; + Omega_magnon = sqrt (tmp); + } + res_magnon = Omega_magnon; + res_neutron = fabs (VS2E * (vi * vi - vf * vf)); + if ((Verbose == 2) && fabs (res_magnon - res_neutron) < 1e-3 && (vi > vf)) { + // printf("ah = %g, ah*(qx+qy+qz) = %g, cos = %g \n",ah,ah*(qx+qy+qz),cos(ah*(qx+qy+qz))); + printf ("omega_q called with parameters vf= %g, vi=%g (%g %g %g) vv=(%g, %g, %g) q=(%g %g %g)\n", vf, vi, vi_x, vi_y, vi_z, vv_x, vv_y, vv_z, qx, qy, qz); + printf ("omega_q gives: J10 = %g , J1q = %g, J20 = %g, J2q = %g, D = %g, tmp = %g \n", J10, J1q, J20, J2q, D, tmp); + printf ("in omega_q: q=(%g %g %g) omega_magnon=%g, omega_neutron=%g\n", qx, qy, qz, res_magnon, res_neutron); + // printf("omega_q returning %g - %g\n",res_magnon,res_neutron); + } + if (coherence_flag) { + if (FM == 1) + return (1); // no coherence factor for a FM + else { // This is a tricky equation, which may need a second check (KL 240718) + u_sq_v_sq = 2 * s * (2 * s * J10 - 2 * s * (J20 - J2q)) / Omega_magnon; + uv = -2 * s * s * J1q / Omega_magnon; + cos_factor = 1; // TODO: this is probably always so (despite otherwise written in Marshall and Lowsey) + coherence_fac = u_sq_v_sq + 2 * cos_factor * uv; + return (coherence_fac); } - else - { - xl=x1; - xh=x2; - ans=UNUSED; - for (j=1; j= fh ? 1.0 : -1.0)*fm/s); - if (fabs(xnew-ans) <= xacc) - return ans; - ans=xnew; - parms[0]=ans; - fnew=(*func)(parms); - if (fnew == 0.0) return ans; - if (fabs(fm)*SIGN(fnew) != fm) - { - xl=xm; - fl=fm; - xh=ans; - fh=fnew; - } - else - if (fabs(fl)*SIGN(fnew) != fl) - { - xh=ans; - fh=fnew; - } - else - if(fabs(fh)*SIGN(fnew) != fh) - { - xl=ans; - fl=fnew; - } - else - fatalerror("never get here in zridd",_particle); - if (fabs(xh-xl) <= xacc) - return ans; - } - fatalerror("zridd exceeded maximum iterations",_particle); + } else + return (res_magnon - res_neutron); + } + + double + zridd (double (*func) (double*), double x1, double x2, double* parms, double xacc, _class_particle* _particle) { + int j; + double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; + + // printf("zridd called with brackets %g %g acceptance %g \n",x1,x2,xacc); + // printf("and %i parameters %g %g %g %g %g \n",Nparms,parms[0],parms[1],parms[2],parms[3], parms[4]); + parms[0] = x1; + fl = (*func) (parms); + parms[0] = x2; + fh = (*func) (parms); + + /* printf("Function values: %g %g \n",fl,fh); */ + if (fl * fh >= 0) { + if (fl == 0) + return x1; + if (fh == 0) + return x2; + return UNUSED; + } else { + xl = x1; + xh = x2; + ans = UNUSED; + for (j = 1; j < MAXRIDD; j++) { + xm = 0.5 * (xl + xh); + parms[0] = xm; + fm = (*func) (parms); + s = sqrt (fm * fm - fl * fh); + if (s == 0.0) + return ans; + xnew = xm + (xm - xl) * ((fl >= fh ? 1.0 : -1.0) * fm / s); + if (fabs (xnew - ans) <= xacc) + return ans; + ans = xnew; + parms[0] = ans; + fnew = (*func) (parms); + if (fnew == 0.0) + return ans; + if (fabs (fm) * SIGN (fnew) != fm) { + xl = xm; + fl = fm; + xh = ans; + fh = fnew; + } else if (fabs (fl) * SIGN (fnew) != fl) { + xh = ans; + fh = fnew; + } else if (fabs (fh) * SIGN (fnew) != fh) { + xl = ans; + fl = fnew; + } else + fatalerror ("never get here in zridd", _particle); + if (fabs (xh - xl) <= xacc) + return ans; } - return 0.0; /* Never get here */ + fatalerror ("zridd exceeded maximum iterations", _particle); } + return 0.0; /* Never get here */ + } -#pragma acc routine - double zridd_gpu(double x1, double x2, double *parms, double xacc, _class_particle *_particle) - { - int j; - double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; - - parms[0]=x1; - fl=omega_q(parms); - parms[0]=x2; - fh=omega_q(parms); - if (fl*fh >= 0) - { - if (fl==0) return x1; - if (fh==0) return x2; - return UNUSED; - } - else - { - xl=x1; - xh=x2; - ans=UNUSED; - for (j=1; j= fh ? 1.0 : -1.0)*fm/s); - if (fabs(xnew-ans) <= xacc) - return ans; - ans=xnew; - parms[0]=ans; - fnew=omega_q(parms); - if (fnew == 0.0) return ans; - if (fabs(fm)*SIGN(fnew) != fm) - { - xl=xm; - fl=fm; - xh=ans; - fh=fnew; - } - else - if (fabs(fl)*SIGN(fnew) != fl) - { - xh=ans; - fh=fnew; - } - else - if(fabs(fh)*SIGN(fnew) != fh) - { - xl=ans; - fl=fnew; - } - else - fatalerror("never get here in zridd", _particle); - if (fabs(xh-xl) <= xacc) - return ans; - } - fatalerror("zridd exceeded maximum iterations", _particle); - } - return 0.0; /* Never get here */ - } - -#define ROOTACC 1e-8 - int findroots(double brack_low, double brack_mid, double brack_high, double *list, int* index, double (*f)(double*), double *parms, _class_particle *_particle) - { - double root, range_low=brack_mid-brack_low, range_high=brack_high-brack_mid; - int i, steps=100; - - for (i=0; i= 0) { + if (fl == 0) + return x1; + if (fh == 0) + return x2; + return UNUSED; + } else { + xl = x1; + xh = x2; + ans = UNUSED; + for (j = 1; j < MAXRIDD; j++) { + xm = 0.5 * (xl + xh); + parms[0] = xm; + fm = omega_q (parms); + s = sqrt (fm * fm - fl * fh); + if (s == 0.0) + return ans; + xnew = xm + (xm - xl) * ((fl >= fh ? 1.0 : -1.0) * fm / s); + if (fabs (xnew - ans) <= xacc) + return ans; + ans = xnew; + parms[0] = ans; + fnew = omega_q (parms); + if (fnew == 0.0) + return ans; + if (fabs (fm) * SIGN (fnew) != fm) { + xl = xm; + fl = fm; + xh = ans; + fh = fnew; + } else if (fabs (fl) * SIGN (fnew) != fl) { + xh = ans; + fh = fnew; + } else if (fabs (fh) * SIGN (fnew) != fh) { + xl = ans; + fl = fnew; + } else + fatalerror ("never get here in zridd", _particle); + if (fabs (xh - xl) <= xacc) + return ans; } - } - - for (i=0; i0 && index<7) { - v_f=vf_list[index]; - int recast=0; + if (nf > 0 && index < 7) { + v_f = vf_list[index]; + int recast = 0; /* Recast if v_f is 0 */ - while (recast < 7 && v_f < 10*FLT_EPSILON) { - index=(int)floor(rand01()*nf); - v_f=vf_list[index]; - recast++; + while (recast < 7 && v_f < 10 * FLT_EPSILON) { + index = (int)floor (rand01 () * nf); + v_f = vf_list[index]; + recast++; } - parms[0]=v_f; - parms[14]=1; // return coherence factor - coherence_factor = omega_q(parms); - parms[0]=v_f-DV; - parms[14]=0; // return dispersion - f1=omega_q(parms); - parms[0]=v_f+DV; - f2=omega_q(parms); - J_factor = fabs(f2-f1)/(2*DV*K2V); + parms[0] = v_f; + parms[14] = 1; // return coherence factor + coherence_factor = omega_q (parms); + parms[0] = v_f - DV; + parms[14] = 0; // return dispersion + f1 = omega_q (parms); + parms[0] = v_f + DV; + f2 = omega_q (parms); + J_factor = fabs (f2 - f1) / (2 * DV * K2V); /* printf("f1,f2: %g %g , J factor %g \n",f1,f2,J_factor); */ - omega=VS2E*(v_i*v_i-v_f*v_f); + omega = VS2E * (v_i * v_i - v_f * v_f); /* printf("nf, omega: %i %g v_i index, v_f: %g %i %g \n", nf,omega,v_i,index,v_f); */ vx *= v_f; vy *= v_f; vz *= v_f; /* printf("vi= %g (vi_x,vi_y,vi_z)= (%g %g %g); vf= %g (vx,vy,vz)=(%g %g %g) \n", v_i,vx_i,vy_i,vz_i,v_f,vx,vy,vz); */ - kappa_x=V2K*(vx_i-vx); - kappa_y=V2K*(vy_i-vy); - kappa_z=V2K*(vz_i-vz); - kappa2=kappa_z*kappa_z+kappa_y*kappa_y+kappa_x*kappa_x; - kappa2_norm_z=kappa_z*kappa_z/kappa2; - - //printf("State before cyl interscect: \n xyz %g %g %g \n vxyz %g %g %g and vf %g\n nf %i recast: %i \n",x,y,z,vx,vy,vz,v_f,nf,recast); - if(cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, yheight)) { - dt = t1; - l_o = v_f*dt; - - my_a_i = V_my_a_v/v_i; - my_a_f = V_my_a_v/v_f; - bose_factor=nbose(omega,T); - p1 = exp(-(V_my_s*(l_i+l_o)+my_a_i*l_i+my_a_f*l_o)); /* Absorption factor */ - p2 = nf*solid_angle*l_full*V_rho/(4*PI); /* Focusing factors; assume random choice of n_f possibilities */ - p3 = gamma_n*gamma_n*r0*r0*(v_f/v_i)*F2*DW*s*s*(1+kappa2_norm_z)*bose_factor; - /* Cross section factor approx */ - p4 = 2*VS2E*v_f/J_factor; /* Jacobian of delta functions in cross section */ - p5 = coherence_factor; /* Cross section factor 2 */ - p *= p1*p2*p3*p4*p5; - SCATTER; - - if (verbose==1){ printf("p factors : %g %g %g %g %g Omega: %g \n", p1, p2, p3, p4, p5, omega); - printf("J_factor %g l_full %g, v_f/v_i %g, DW %g, kappa2 %g, bose_factor%g, fabs(omega) %g, coherence %g \n", - J_factor, l_full, v_f/v_i, DW, kappa2, bose_factor, fabs(omega), coherence_factor); - } - } else { /* ??? did not hit cylinder */ - ABSORB; // Simply absorb if we can not hit, no fatal errors. (Typically indication of v_f==0) - //fatalerror("FATAL ERROR: Did not hit cylinder from inside.\n", _particle); + kappa_x = V2K * (vx_i - vx); + kappa_y = V2K * (vy_i - vy); + kappa_z = V2K * (vz_i - vz); + kappa2 = kappa_z * kappa_z + kappa_y * kappa_y + kappa_x * kappa_x; + kappa2_norm_z = kappa_z * kappa_z / kappa2; + + // printf("State before cyl interscect: \n xyz %g %g %g \n vxyz %g %g %g and vf %g\n nf %i recast: %i \n",x,y,z,vx,vy,vz,v_f,nf,recast); + if (cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius, yheight)) { + dt = t1; + l_o = v_f * dt; + + my_a_i = V_my_a_v / v_i; + my_a_f = V_my_a_v / v_f; + bose_factor = nbose (omega, T); + p1 = exp (-(V_my_s * (l_i + l_o) + my_a_i * l_i + my_a_f * l_o)); /* Absorption factor */ + p2 = nf * solid_angle * l_full * V_rho / (4 * PI); /* Focusing factors; assume random choice of n_f possibilities */ + p3 = gamma_n * gamma_n * r0 * r0 * (v_f / v_i) * F2 * DW * s * s * (1 + kappa2_norm_z) * bose_factor; + /* Cross section factor approx */ + p4 = 2 * VS2E * v_f / J_factor; /* Jacobian of delta functions in cross section */ + p5 = coherence_factor; /* Cross section factor 2 */ + p *= p1 * p2 * p3 * p4 * p5; + SCATTER; + + if (verbose == 1) { + printf ("p factors : %g %g %g %g %g Omega: %g \n", p1, p2, p3, p4, p5, omega); + printf ("J_factor %g l_full %g, v_f/v_i %g, DW %g, kappa2 %g, bose_factor%g, fabs(omega) %g, coherence %g \n", J_factor, l_full, v_f / v_i, DW, kappa2, + bose_factor, fabs (omega), coherence_factor); + } + } else { /* ??? did not hit cylinder */ + ABSORB; // Simply absorb if we can not hit, no fatal errors. (Typically indication of v_f==0) + // fatalerror("FATAL ERROR: Did not hit cylinder from inside.\n", _particle); } } else { @@ -574,13 +528,13 @@ TRACE MCDISPLAY %{ - magnify("xyz"); - 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); + magnify ("xyz"); + 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); %} END diff --git a/mcstas-comps/samples/NCrystal_sample.comp b/mcstas-comps/samples/NCrystal_sample.comp index 34a0d57fed..514b619f2a 100644 --- a/mcstas-comps/samples/NCrystal_sample.comp +++ b/mcstas-comps/samples/NCrystal_sample.comp @@ -70,21 +70,21 @@ NOACC /* Notice: you must remove this line if using the legacy McStas 2.x branch SHARE %{ /* common includes, defines, functions, etc. shared by all instances of this component */ -#ifndef WIN32 -#include "NCrystal/ncrystal.h" -#else -#include "NCrystal\\ncrystal.h" -#endif -#include "stdio.h" -#include "stdlib.h" -#ifndef NCMCERR2 + #ifndef WIN32 + #include "NCrystal/ncrystal.h" + #else + #include "NCrystal\\ncrystal.h" + #endif + #include "stdio.h" + #include "stdlib.h" + #ifndef NCMCERR2 /* consistent/convenient error reporting */ -# define NCMCERR2(compname,msg) do { fprintf(stderr, "\nNCrystal: %s: ERROR: %s\n\n", compname, msg); exit(1); } while (0) -#endif + # define NCMCERR2(compname,msg) do { fprintf(stderr, "\nNCrystal: %s: ERROR: %s\n\n", compname, msg); exit(1); } while (0) + #endif static int ncsample_reported_version = 0; - //Keep all instance-specific parameters on a few structs: + // Keep all instance-specific parameters on a few structs: typedef struct { double density_factor; double inv_density_factor; @@ -94,26 +94,24 @@ SHARE int absmode; } ncrystalsample_t; - typedef enum {NC_BOX, NC_SPHERE, NC_CYLINDER} ncrystal_shapetype; + typedef enum { NC_BOX, NC_SPHERE, NC_CYLINDER } ncrystal_shapetype; typedef struct { ncrystal_shapetype shape; - double dx, dy, dz, rradius;//naming rradius instead of radius to avoid mcstas macro issues (due to clash with component parameter name). + double dx, dy, dz, rradius; // naming rradius instead of radius to avoid mcstas macro issues (due to clash with component parameter name). } ncrystalsamplegeom_t; /* Factor out geometry related code in the following functions (+MCDISPLAY section below): */ - void ncrystalsample_initgeom(ncrystalsamplegeom_t* geom, const char * name_comp, double xxwidth, double yyheight, double zzdepth, double rradius) - { - int isbox = ( xxwidth>0 && yyheight>0 && zzdepth>0 ); - int iscyl = ( yyheight>0 && rradius>0 ); - int issphere = ( !iscyl && rradius>0 ); - int nshapes = (isbox?1:0)+(iscyl?1:0)+(issphere?1:0); - if (nshapes==0) - NCMCERR2(name_comp,"must specify more parameters to define shape"); - if ( nshapes > 1 - || ( iscyl && ( xxwidth>0 || zzdepth>0 ) ) - || ( issphere && ( xxwidth>0 || yyheight > 0 || zzdepth>0 ) ) ) - NCMCERR2(name_comp,"conflicting shape parameters specified (pick either parameters for box, cylinder or sphere, not more than one)"); + void + ncrystalsample_initgeom (ncrystalsamplegeom_t* geom, const char* name_comp, double xxwidth, double yyheight, double zzdepth, double rradius) { + int isbox = (xxwidth > 0 && yyheight > 0 && zzdepth > 0); + int iscyl = (yyheight > 0 && rradius > 0); + int issphere = (!iscyl && rradius > 0); + int nshapes = (isbox ? 1 : 0) + (iscyl ? 1 : 0) + (issphere ? 1 : 0); + if (nshapes == 0) + NCMCERR2 (name_comp, "must specify more parameters to define shape"); + if (nshapes > 1 || (iscyl && (xxwidth > 0 || zzdepth > 0)) || (issphere && (xxwidth > 0 || yyheight > 0 || zzdepth > 0))) + NCMCERR2 (name_comp, "conflicting shape parameters specified (pick either parameters for box, cylinder or sphere, not more than one)"); if (isbox) { geom->shape = NC_BOX; @@ -129,7 +127,7 @@ SHARE geom->rradius = rradius; } else { if (!issphere) - NCMCERR2(name_comp,"logic error in shape selection"); + NCMCERR2 (name_comp, "logic error in shape selection"); geom->shape = NC_SPHERE; geom->dx = 0.0; geom->dy = 0.0; @@ -138,24 +136,22 @@ SHARE } } - int ncrystalsample_surfintersect(ncrystalsamplegeom_t* geom, double *t0, double *t1, - double x, double y, double z, double vx, double vy, double vz) - { + int + ncrystalsample_surfintersect (ncrystalsamplegeom_t* geom, double* t0, double* t1, double x, double y, double z, double vx, double vy, double vz) { switch (geom->shape) { case NC_CYLINDER: - return cylinder_intersect(t0,t1,x,y,z,vx,vy,vz,geom->rradius, geom->dy); + return cylinder_intersect (t0, t1, x, y, z, vx, vy, vz, geom->rradius, geom->dy); case NC_BOX: - return box_intersect(t0, t1, x, y, z, vx, vy, vz,geom->dx, geom->dy, geom->dz); + return box_intersect (t0, t1, x, y, z, vx, vy, vz, geom->dx, geom->dy, geom->dz); case NC_SPHERE: - return sphere_intersect(t0,t1,x,y,z,vx,vy,vz,geom->rradius); + return sphere_intersect (t0, t1, x, y, z, vx, vy, vz, geom->rradius); }; } -#ifndef NCMCERR + #ifndef NCMCERR /* more convenient form (only works in TRACE section, not in SHARE functions) */ -# define NCMCERR(msg) NCMCERR2(NAME_CURRENT_COMP,msg) -#endif - + # define NCMCERR(msg) NCMCERR2(NAME_CURRENT_COMP,msg) + #endif %} DECLARE @@ -164,89 +160,86 @@ DECLARE ncrystalsamplegeom_t geoparams; double ncrystal_convfact_vsq2ekin; double ncrystal_convfact_ekin2vsq; - %} INITIALIZE %{ - //Print NCrystal version + sanity check setup. - if ( NCRYSTAL_VERSION != ncrystal_version() ) { - NCMCERR("Inconsistency detected between included ncrystal.h and linked NCrystal library!"); + // Print NCrystal version + sanity check setup. + if (NCRYSTAL_VERSION != ncrystal_version ()) { + NCMCERR ("Inconsistency detected between included ncrystal.h and linked NCrystal library!"); } - if (ncsample_reported_version != ncrystal_version()) { + if (ncsample_reported_version != ncrystal_version ()) { if (ncsample_reported_version) { - NCMCERR("Inconsistent NCrystal library versions detected - this should normally not be possible!"); + NCMCERR ("Inconsistent NCrystal library versions detected - this should normally not be possible!"); } - ncsample_reported_version = ncrystal_version(); - MPI_MASTER( - printf( "NCrystal: McStas sample component(s) are using version %s of the NCrystal library.\n",ncrystal_version_str()); - ); + ncsample_reported_version = ncrystal_version (); + MPI_MASTER (printf ("NCrystal: McStas sample component(s) are using version %s of the NCrystal library.\n", ncrystal_version_str ());); } - //The following conversion factors might look slightly odd. They reflect the - //fact that the various conversion factors used in McStas and NCrystal are not - //completely consistent among each other (TODO: Follow up on this with McStas - //developers!). Also McStas's V2K*K2V is not exactly 1. All in all, this can - //give issues when a McStas user is trying to set up a narrow beam very - //precisely in an instrument file, attempting to carefully hit a certain - //narrow Bragg reflection in this NCrystal component. We can not completely - //work around all issues here, but for now, we assume that the user is - //carefully setting up things by specifying the wavelength to some source - //component. That wavelength is then converted to the McStas state pars + // The following conversion factors might look slightly odd. They reflect the + // fact that the various conversion factors used in McStas and NCrystal are not + // completely consistent among each other (TODO: Follow up on this with McStas + // developers!). Also McStas's V2K*K2V is not exactly 1. All in all, this can + // give issues when a McStas user is trying to set up a narrow beam very + // precisely in an instrument file, attempting to carefully hit a certain + // narrow Bragg reflection in this NCrystal component. We can not completely + // work around all issues here, but for now, we assume that the user is + // carefully setting up things by specifying the wavelength to some source + // component. That wavelength is then converted to the McStas state pars //(vx,vy,vz) via K2V. We thus here first use 1/K2V (and *not* V2K) to convert - //back to a wavelength, and then we use NCrystal's conversion constants to - //convert the resulting wavelength to kinetic energy needed for NCrystal's - //interfaces. + // back to a wavelength, and then we use NCrystal's conversion constants to + // convert the resulting wavelength to kinetic energy needed for NCrystal's + // interfaces. // 0.0253302959105844428609698658024319097260896937 is 1/(4*pi^2) - ncrystal_convfact_vsq2ekin = ncrystal_wl2ekin(1.0) * 0.0253302959105844428609698658024319097260896937 / ( K2V*K2V ); + ncrystal_convfact_vsq2ekin = ncrystal_wl2ekin (1.0) * 0.0253302959105844428609698658024319097260896937 / (K2V * K2V); ncrystal_convfact_ekin2vsq = 1.0 / ncrystal_convfact_vsq2ekin; - //for our sanity, zero-initialise all instance-specific data: - memset(¶ms,0,sizeof(params)); - memset(&geoparams,0,sizeof(geoparams)); + // for our sanity, zero-initialise all instance-specific data: + memset (¶ms, 0, sizeof (params)); + memset (&geoparams, 0, sizeof (geoparams)); - ncrystalsample_initgeom(&geoparams, NAME_CURRENT_COMP, xwidth, yheight, zdepth, radius); + ncrystalsample_initgeom (&geoparams, NAME_CURRENT_COMP, xwidth, yheight, zdepth, radius); - if (!(absorptionmode==0||absorptionmode==1||absorptionmode==2)) - NCMCERR("Invalid value of absorptionmode"); + if (!(absorptionmode == 0 || absorptionmode == 1 || absorptionmode == 2)) + NCMCERR ("Invalid value of absorptionmode"); params.absmode = absorptionmode; -#ifndef rand01 + #ifndef rand01 /* Tell NCrystal to use the rand01 function provided by McStas: */ - ncrystal_setrandgen(rand01); -#else + ncrystal_setrandgen (rand01); + #else /* rand01 is actually a macro not an actual C-function (most likely defined as */ /* _rand01(_particle->randstate) for OPENACC purposes), which we can not */ /* register with NCrystal. As a workaround we tell NCrystal to use its own RNG */ /* algorithm, with merely the seed provided by McStas: */ - ncrystal_setbuiltinrandgen_withseed( mcseed ); -#endif + ncrystal_setbuiltinrandgen_withseed (mcseed); + #endif /* access material info to get number density (natoms/volume): */ - ncrystal_info_t info = ncrystal_create_info(cfg); - double numberdensity = ncrystal_info_getnumberdensity(info); - ncrystal_unref(&info); - - //numberdensity is the atomic number density in units of Aa^-3=1e30m^3, and - //given that we have cross-sections in barn (1e-28m^2) and want to generate - //distances in meters with -log(R)/(numberdensity*xsect), we get the unit - //conversion factor of 0.01: - params.density_factor = - 0.01 / numberdensity; + ncrystal_info_t info = ncrystal_create_info (cfg); + double numberdensity = ncrystal_info_getnumberdensity (info); + ncrystal_unref (&info); + + // numberdensity is the atomic number density in units of Aa^-3=1e30m^3, and + // given that we have cross-sections in barn (1e-28m^2) and want to generate + // distances in meters with -log(R)/(numberdensity*xsect), we get the unit + // conversion factor of 0.01: + params.density_factor = -0.01 / numberdensity; params.inv_density_factor = -100.0 * numberdensity; - //Setup scattering: - params.scat = ncrystal_create_scatter(cfg); - params.proc_scat = ncrystal_cast_scat2proc(params.scat); - params.proc_scat_isoriented = ! ncrystal_isnonoriented(params.proc_scat);; + // Setup scattering: + params.scat = ncrystal_create_scatter (cfg); + params.proc_scat = ncrystal_cast_scat2proc (params.scat); + params.proc_scat_isoriented = !ncrystal_isnonoriented (params.proc_scat); + ; - //Setup absorption: + // Setup absorption: if (params.absmode) { - params.proc_abs = ncrystal_cast_abs2proc(ncrystal_create_absorption(cfg)); - if (!ncrystal_isnonoriented(params.proc_abs)) - NCMCERR("Encountered oriented NCAbsorption process which is not currently supported by this component."); + params.proc_abs = ncrystal_cast_abs2proc (ncrystal_create_absorption (cfg)); + if (!ncrystal_isnonoriented (params.proc_abs)) + NCMCERR ("Encountered oriented NCAbsorption process which is not currently supported by this component."); } - %} TRACE @@ -256,103 +249,103 @@ TRACE do { /* neutron is outside our surface at this point. First check if it intersects it... */ - double t0,t1; - if (!ncrystalsample_surfintersect(&geoparams,&t0,&t1,x,y,z,vx,vy,vz)) - break;//no intersections with our sample geometry, so nothing more to do. + double t0, t1; + if (!ncrystalsample_surfintersect (&geoparams, &t0, &t1, x, y, z, vx, vy, vz)) + break; // no intersections with our sample geometry, so nothing more to do. /* Propagate the neutron to our surface (t0<=0 means we started inside!) */ - if (t0>0) - PROP_DT(t0); /* let the neutron fly in a straight line for t0 */ + if (t0 > 0) + PROP_DT (t0); /* let the neutron fly in a straight line for t0 */ double dir[3], dirout[3]; - double v2 = vx*vx+vy*vy+vz*vz; - double absv = sqrt(v2); - double inv_absv = 1.0/absv; - dir[0] = vx*inv_absv; - dir[1] = vy*inv_absv; - dir[2] = vz*inv_absv; + double v2 = vx * vx + vy * vy + vz * vz; + double absv = sqrt (v2); + double inv_absv = 1.0 / absv; + dir[0] = vx * inv_absv; + dir[1] = vy * inv_absv; + dir[2] = vz * inv_absv; double ekin = ncrystal_convfact_vsq2ekin * v2; double xsect_scat = 0.0; double xsect_abs = 0.0; - ncrystal_crosssection(params.proc_scat,ekin,(const double(*)[3])&dir,&xsect_scat); + ncrystal_crosssection (params.proc_scat, ekin, (const double (*)[3]) & dir, &xsect_scat); if (params.absmode) - ncrystal_crosssection_nonoriented(params.proc_abs, ekin,&xsect_abs); + ncrystal_crosssection_nonoriented (params.proc_abs, ekin, &xsect_abs); - while(1) - { + while (1) { /* Make the calculations and pick the final state before exiting the sample */ double xsect_step = xsect_scat; - if (params.absmode==2) xsect_step += xsect_abs; - double distance = xsect_step ? log( rand01() ) * params.density_factor / xsect_step : DBL_MAX; /* in m */ + if (params.absmode == 2) + xsect_step += xsect_abs; + double distance = xsect_step ? log (rand01 ()) * params.density_factor / xsect_step : DBL_MAX; /* in m */ double timestep = distance * inv_absv; /* Test when the neutron would reach the outer surface in absence of interactions: */ - if (!ncrystalsample_surfintersect(&geoparams,&t0,&t1,x,y,z,vx,vy,vz)) - NCMCERR("Can not propagate to surface from inside volume!"); + if (!ncrystalsample_surfintersect (&geoparams, &t0, &t1, x, y, z, vx, vy, vz)) + NCMCERR ("Can not propagate to surface from inside volume!"); - if(timestep>t1) { + if (timestep > t1) { /* neutron reaches surface, move forward to surface and apply intensity reduction if absmode=1 */ - if (params.absmode==1) - p *= exp( absv * t1 * xsect_abs * params.inv_density_factor ); - PROP_DT(t1); - break;//end stepping inside volume + if (params.absmode == 1) + p *= exp (absv * t1 * xsect_abs * params.inv_density_factor); + PROP_DT (t1); + break; // end stepping inside volume } /*move neutron forward*/ - PROP_DT(timestep); + PROP_DT (timestep); /* perform reaction */ - if (params.absmode==2 && xsect_abs > rand01()*xsect_step ) { + if (params.absmode == 2 && xsect_abs > rand01 () * xsect_step) { /* reaction was full-blooded absorption */ - ABSORB;/* kill track (uses goto to jump out of current loop context)*/ - } else if (params.absmode==1) { + ABSORB; /* kill track (uses goto to jump out of current loop context)*/ + } else if (params.absmode == 1) { /* reaction was scatter and we model absorption by intensity-reduction */ - p *= exp( distance * xsect_abs * params.inv_density_factor ); + p *= exp (distance * xsect_abs * params.inv_density_factor); } else { /* reaction was scatter and we do not perform any intensity-reduction */ } /* scattering */ double ekin_final; - ncrystal_samplescatter( params.scat, ekin, (const double(*)[3])&dir, &ekin_final, &dirout ); + ncrystal_samplescatter (params.scat, ekin, (const double (*)[3]) & dir, &ekin_final, &dirout); double delta_ekin = ekin_final - ekin; if (delta_ekin) { ekin = ekin_final; - if (ekin<=0) { - //not expected to happen much, but an interaction could in principle bring the neutron to rest. + if (ekin <= 0) { + // not expected to happen much, but an interaction could in principle bring the neutron to rest. ABSORB; } v2 = ncrystal_convfact_ekin2vsq * ekin; - absv = sqrt(v2); - inv_absv = 1.0/absv; + absv = sqrt (v2); + inv_absv = 1.0 / absv; } - vx=dirout[0]*absv; - vy=dirout[1]*absv; - vz=dirout[2]*absv; - dir[0]=dirout[0]; - dir[1]=dirout[1]; - dir[2]=dirout[2]; + vx = dirout[0] * absv; + vy = dirout[1] * absv; + vz = dirout[2] * absv; + dir[0] = dirout[0]; + dir[1] = dirout[1]; + dir[2] = dirout[2]; - SCATTER;/* update mcstas scatter counter and potentially enable trajectory visualisation */ + SCATTER; /* update mcstas scatter counter and potentially enable trajectory visualisation */ if (multscat) { - //Must update x-sects if energy changed or processes are oriented: - if (delta_ekin&¶ms.absmode) - ncrystal_crosssection_nonoriented(params.proc_abs, ekin,&xsect_abs); - if (delta_ekin||params.proc_scat_isoriented) - ncrystal_crosssection(params.proc_scat,ekin,(const double(*)[3])&dir,&xsect_scat); + // Must update x-sects if energy changed or processes are oriented: + if (delta_ekin && params.absmode) + ncrystal_crosssection_nonoriented (params.proc_abs, ekin, &xsect_abs); + if (delta_ekin || params.proc_scat_isoriented) + ncrystal_crosssection (params.proc_scat, ekin, (const double (*)[3]) & dir, &xsect_scat); } else { - //Multiple scattering disabled, so we just need to propagate the neutron - //out of the sample and (if absmode==1) apply one more intensity - //reduction factor. We handle this by putting cross-sections to 0 here, - //which will result in an infinife step length of the next step. + // Multiple scattering disabled, so we just need to propagate the neutron + // out of the sample and (if absmode==1) apply one more intensity + // reduction factor. We handle this by putting cross-sections to 0 here, + // which will result in an infinife step length of the next step. xsect_scat = 0.0; - if (params.absmode!=1) + if (params.absmode != 1) xsect_abs = 0.0; } - }/*exited at a surface*/ + } /*exited at a surface*/ /* Exited the surface. We let the while condition below always be false for * * now, since we only support convex bodies, so there is no need to check if * @@ -362,26 +355,23 @@ TRACE FINALLY %{ - ncrystal_unref(¶ms.scat); - ncrystal_invalidate(¶ms.proc_scat);//a cast of params.scat, so just invalidate handle don't unref + ncrystal_unref (¶ms.scat); + ncrystal_invalidate (¶ms.proc_scat); // a cast of params.scat, so just invalidate handle don't unref if (params.absmode) - ncrystal_unref(¶ms.proc_abs); + ncrystal_unref (¶ms.proc_abs); %} MCDISPLAY %{ switch (geoparams.shape) { case NC_CYLINDER: - mcdis_cylinder( 0., 0., 0., - geoparams.rradius, - geoparams.dy, - 0 , 0.0 , 1.0 , 0.0); + mcdis_cylinder (0., 0., 0., geoparams.rradius, geoparams.dy, 0, 0.0, 1.0, 0.0); break; case NC_BOX: - mcdis_box(0., 0., 0., geoparams.dx, geoparams.dy, geoparams.dz,0, 0, 1, 0); + mcdis_box (0., 0., 0., geoparams.dx, geoparams.dy, geoparams.dz, 0, 0, 1, 0); break; case NC_SPHERE: - mcdis_sphere(0.0,0.0,0.0,geoparams.rradius); + mcdis_sphere (0.0, 0.0, 0.0, geoparams.rradius); break; }; %} diff --git a/mcstas-comps/samples/Phonon_simple.comp b/mcstas-comps/samples/Phonon_simple.comp index d11400a7a7..bf45c8c98f 100644 --- a/mcstas-comps/samples/Phonon_simple.comp +++ b/mcstas-comps/samples/Phonon_simple.comp @@ -75,291 +75,262 @@ SETTING PARAMETERS (radius,yheight,sigma_abs,sigma_inc,a,b,M,c,DW,T, /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -#ifndef PHONON_SIMPLE -#define PHONON_SIMPLE $Revision$ -#define T2E (1/11.605) /* Kelvin to meV */ + #ifndef PHONON_SIMPLE + #define PHONON_SIMPLE $Revision$ + #define T2E (1/11.605) /* Kelvin to meV */ - struct phonon_params { - double a_; // d spacing of the cubic lattice - double c_; // Speed of sound in the material + struct phonon_params { + double a_; // d spacing of the cubic lattice + double c_; // Speed of sound in the material double gap_; // optional spin gap - double ah; // Half of a + double ah; // Half of a int e_steps_high_; int e_steps_low_; - }; + }; struct neutron_params { - // Statically allocate vectors that are always 3 - double vf; // Final velocity size - double vi; // Initial velocity size + // Statically allocate vectors that are always 3 + double vf; // Final velocity size + double vi; // Initial velocity size double vv_x; // vv is the unit vector of the final velocity vector double vv_y; double vv_z; double vi_x; // vi is the initial velocity vector double vi_y; double vi_z; - }; + }; -#pragma acc routine -double nbose(double omega, double T) /* Other name ?? */ + #pragma acc routine + double + nbose (double omega, double T) /* Other name ?? */ { double nb; - nb= (omega>0) ? 1+1/(exp(omega/(T*T2E))-1) : 1/(exp(-omega/(T*T2E))-1); + nb = (omega > 0) ? 1 + 1 / (exp (omega / (T * T2E)) - 1) : 1 / (exp (-omega / (T * T2E)) - 1); return nb; } -#undef T2E -/* Routine types from Numerical Recipies book */ -#define UNUSED (-1.11e30) -#define MAXRIDD 60 - -void fatalerror_cpu(char *s) - { - fprintf(stderr,"%s \n",s); - exit(1); - } - -#pragma acc routine -void fatalerror(char *s) - { - #ifndef OPENACC - fatalerror_cpu(s); - #endif + #undef T2E + /* Routine types from Numerical Recipies book */ + #define UNUSED (-1.11e30) + #define MAXRIDD 60 + + void + fatalerror_cpu (char* s) { + fprintf (stderr, "%s \n", s); + exit (1); } #pragma acc routine - double omega_q(struct neutron_params *neutron, struct phonon_params *phonon) - { - /* dispersion in units of meV */ - double vi, vf, vv_x, vv_y, vv_z, vi_x, vi_y, vi_z; - double q, qx, qy, qz, Jq, res_phonon, res_neutron; - double ah, a, c; - double gap; - - vf=neutron->vf; - vi=neutron->vi; - vv_x=neutron->vv_x; - vv_y=neutron->vv_y; - vv_z=neutron->vv_z; - vi_x=neutron->vi_x; - vi_y=neutron->vi_y; - vi_z=neutron->vi_z; - a =phonon->a_; - c =phonon->c_; - gap =phonon->gap_; - ah =phonon->ah; - - qx=V2K*(vi_x-vf*vv_x); - qy=V2K*(vi_y-vf*vv_y); - qz=V2K*(vi_z-vf*vv_z); - q=sqrt(qx*qx+qy*qy+qz*qz); - Jq=2*(cos(ah*(qx+qy))+cos(ah*(qx-qy))+cos(ah*(qx+qz))+cos(ah*(qx-qz)) - +cos(ah*(qy+qz))+cos(ah*(qy-qz)) ); - if (gap>0) { - res_phonon=sqrt(gap*gap+(12-Jq)*(c*c)/(a*a)); - } else { - res_phonon=c/a*sqrt(12-Jq); - } - res_neutron = fabs(VS2E*(vi*vi-vf*vf)); + void + fatalerror (char* s) { + #ifndef OPENACC + fatalerror_cpu (s); + #endif + } - return (res_phonon - res_neutron); + #pragma acc routine + double + omega_q (struct neutron_params* neutron, struct phonon_params* phonon) { + /* dispersion in units of meV */ + double vi, vf, vv_x, vv_y, vv_z, vi_x, vi_y, vi_z; + double q, qx, qy, qz, Jq, res_phonon, res_neutron; + double ah, a, c; + double gap; + + vf = neutron->vf; + vi = neutron->vi; + vv_x = neutron->vv_x; + vv_y = neutron->vv_y; + vv_z = neutron->vv_z; + vi_x = neutron->vi_x; + vi_y = neutron->vi_y; + vi_z = neutron->vi_z; + a = phonon->a_; + c = phonon->c_; + gap = phonon->gap_; + ah = phonon->ah; + + qx = V2K * (vi_x - vf * vv_x); + qy = V2K * (vi_y - vf * vv_y); + qz = V2K * (vi_z - vf * vv_z); + q = sqrt (qx * qx + qy * qy + qz * qz); + Jq = 2 * (cos (ah * (qx + qy)) + cos (ah * (qx - qy)) + cos (ah * (qx + qz)) + cos (ah * (qx - qz)) + cos (ah * (qy + qz)) + cos (ah * (qy - qz))); + if (gap > 0) { + res_phonon = sqrt (gap * gap + (12 - Jq) * (c * c) / (a * a)); + } else { + res_phonon = c / a * sqrt (12 - Jq); } + res_neutron = fabs (VS2E * (vi * vi - vf * vf)); + return (res_phonon - res_neutron); + } -double zridd(double (*func)(struct neutron_params*, struct phonon_params*), - double x1, double x2, struct neutron_params *neutron, - struct phonon_params *phonon, double xacc) - { - int j; - double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; - - neutron->vf=x1; - fl=func(neutron, phonon); - neutron->vf=x2; - fh=func(neutron, phonon); - if (fl*fh >= 0) - { - if (fl==0) return x1; - if (fh==0) return x2; - return UNUSED; - } - else - { - xl=x1; - xh=x2; - ans=UNUSED; - for (j=1; jvf=xm; - fm=func(neutron,phonon); - s=sqrt(fm*fm-fl*fh); - if (s == 0.0) - return ans; - xnew=xm+(xm-xl)*((fl >= fh ? 1.0 : -1.0)*fm/s); - if (fabs(xnew-ans) <= xacc) - return ans; - ans=xnew; - neutron->vf=ans; - fnew=func(neutron,phonon); - if (fnew == 0.0) return ans; - if (fabs(fm)*SIGN(fnew) != fm) - { - xl=xm; - fl=fm; - xh=ans; - fh=fnew; - } - else - if (fabs(fl)*SIGN(fnew) != fl) - { - xh=ans; - fh=fnew; - } - else - if(fabs(fh)*SIGN(fnew) != fh) - { - xl=ans; - fl=fnew; - } - else - fatalerror("never get here in zridd"); - if (fabs(xh-xl) <= xacc) - return ans; - } - fatalerror("zridd exceeded maximum iterations"); + double + zridd (double (*func) (struct neutron_params*, struct phonon_params*), double x1, double x2, struct neutron_params* neutron, struct phonon_params* phonon, + double xacc) { + int j; + double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; + + neutron->vf = x1; + fl = func (neutron, phonon); + neutron->vf = x2; + fh = func (neutron, phonon); + if (fl * fh >= 0) { + if (fl == 0) + return x1; + if (fh == 0) + return x2; + return UNUSED; + } else { + xl = x1; + xh = x2; + ans = UNUSED; + for (j = 1; j < MAXRIDD; j++) { + xm = 0.5 * (xl + xh); + neutron->vf = xm; + fm = func (neutron, phonon); + s = sqrt (fm * fm - fl * fh); + if (s == 0.0) + return ans; + xnew = xm + (xm - xl) * ((fl >= fh ? 1.0 : -1.0) * fm / s); + if (fabs (xnew - ans) <= xacc) + return ans; + ans = xnew; + neutron->vf = ans; + fnew = func (neutron, phonon); + if (fnew == 0.0) + return ans; + if (fabs (fm) * SIGN (fnew) != fm) { + xl = xm; + fl = fm; + xh = ans; + fh = fnew; + } else if (fabs (fl) * SIGN (fnew) != fl) { + xh = ans; + fh = fnew; + } else if (fabs (fh) * SIGN (fnew) != fh) { + xl = ans; + fl = fnew; + } else + fatalerror ("never get here in zridd"); + if (fabs (xh - xl) <= xacc) + return ans; } - return 0.0; /* Never get here */ + fatalerror ("zridd exceeded maximum iterations"); } + return 0.0; /* Never get here */ + } -#pragma acc routine -double zridd_gpu(double x1, double x2, struct neutron_params *neutron, struct phonon_params* phonon, double xacc) - { - int j; - double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; - - neutron->vf=x1; - fl=omega_q(neutron, phonon); - neutron->vf=x2; - fh=omega_q(neutron, phonon); - if (fl*fh >= 0) - { - if (fl==0) return x1; - if (fh==0) return x2; - return UNUSED; - } - else - { - xl=x1; - xh=x2; - ans=UNUSED; - for (j=1; jvf=xm; - fm=omega_q(neutron, phonon); - s=sqrt(fm*fm-fl*fh); - if (s == 0.0) - return ans; - xnew=xm+(xm-xl)*((fl >= fh ? 1.0 : -1.0)*fm/s); - if (fabs(xnew-ans) <= xacc) - return ans; - ans=xnew; - neutron->vf=ans; - fnew=omega_q(neutron, phonon); - if (fnew == 0.0) return ans; - if (fabs(fm)*SIGN(fnew) != fm) - { - xl=xm; - fl=fm; - xh=ans; - fh=fnew; - } - else - if (fabs(fl)*SIGN(fnew) != fl) - { - xh=ans; - fh=fnew; - } - else - if(fabs(fh)*SIGN(fnew) != fh) - { - xl=ans; - fl=fnew; - } - else - fatalerror("never get here in zridd"); - if (fabs(xh-xl) <= xacc) - return ans; - } - fatalerror("zridd exceeded maximum iterations"); + #pragma acc routine + double + zridd_gpu (double x1, double x2, struct neutron_params* neutron, struct phonon_params* phonon, double xacc) { + int j; + double ans, fh, fl, fm, fnew, s, xh, xl, xm, xnew; + + neutron->vf = x1; + fl = omega_q (neutron, phonon); + neutron->vf = x2; + fh = omega_q (neutron, phonon); + if (fl * fh >= 0) { + if (fl == 0) + return x1; + if (fh == 0) + return x2; + return UNUSED; + } else { + xl = x1; + xh = x2; + ans = UNUSED; + for (j = 1; j < MAXRIDD; j++) { + xm = 0.5 * (xl + xh); + neutron->vf = xm; + fm = omega_q (neutron, phonon); + s = sqrt (fm * fm - fl * fh); + if (s == 0.0) + return ans; + xnew = xm + (xm - xl) * ((fl >= fh ? 1.0 : -1.0) * fm / s); + if (fabs (xnew - ans) <= xacc) + return ans; + ans = xnew; + neutron->vf = ans; + fnew = omega_q (neutron, phonon); + if (fnew == 0.0) + return ans; + if (fabs (fm) * SIGN (fnew) != fm) { + xl = xm; + fl = fm; + xh = ans; + fh = fnew; + } else if (fabs (fl) * SIGN (fnew) != fl) { + xh = ans; + fh = fnew; + } else if (fabs (fh) * SIGN (fnew) != fh) { + xl = ans; + fl = fnew; + } else + fatalerror ("never get here in zridd"); + if (fabs (xh - xl) <= xacc) + return ans; } - return 0.0; /* Never get here */ + fatalerror ("zridd exceeded maximum iterations"); } + return 0.0; /* Never get here */ + } - -#define ROOTACC 1e-8 + #define ROOTACC 1e-8 - void findroots(double brack_low, double brack_mid, double brack_high, - double *list, int* index, double (*f)(struct neutron_params*, struct phonon_params*), - struct neutron_params *neutron, struct phonon_params *phonon) { + void + findroots (double brack_low, double brack_mid, double brack_high, double* list, int* index, double (*f) (struct neutron_params*, struct phonon_params*), + struct neutron_params* neutron, struct phonon_params* phonon) { double root; // Energy gain and energy loss spaces are not equally big. We check uniformly // So we use two different ranges double range_low = brack_mid - brack_low; double range_high = brack_high - brack_mid; // First in energy loss for the neutron - for (int i=0; ie_steps_low_; i++){ - root = zridd(f, brack_low+range_low*i/ phonon->e_steps_low_, - brack_low+range_low*(i+1)/ phonon->e_steps_low_, - neutron, phonon, ROOTACC); + for (int i = 0; i < phonon->e_steps_low_; i++) { + root = zridd (f, brack_low + range_low * i / phonon->e_steps_low_, brack_low + range_low * (i + 1) / phonon->e_steps_low_, neutron, phonon, ROOTACC); if (root != UNUSED) { - list[(*index)++]=root; + list[(*index)++] = root; } } // Then in energy gain for the neutron - for (int i=0; ie_steps_high_; i++){ - root = zridd(f, brack_mid+range_high*i/ phonon->e_steps_high_, - brack_mid+range_high*(i+1)/ phonon->e_steps_high_, - neutron, phonon, ROOTACC); - if (root != UNUSED){ - list[(*index)++]=root; + for (int i = 0; i < phonon->e_steps_high_; i++) { + root = zridd (f, brack_mid + range_high * i / phonon->e_steps_high_, brack_mid + range_high * (i + 1) / phonon->e_steps_high_, neutron, phonon, ROOTACC); + if (root != UNUSED) { + list[(*index)++] = root; } } } - -#pragma acc routine - void findroots_gpu(double brack_low, double brack_mid, double brack_high, - double *list, int* index, struct neutron_params *neutron, struct phonon_params *phonon) { + + #pragma acc routine + void + findroots_gpu (double brack_low, double brack_mid, double brack_high, double* list, int* index, struct neutron_params* neutron, struct phonon_params* phonon) { double root; // Energy gain and energy loss spaces are not equally big. We check uniformly // So we use two different ranges double range_low = brack_mid - brack_low; double range_high = brack_high - brack_mid; // First in energy loss for the neutron - for (int i=0; ie_steps_low_; i++){ - root = zridd_gpu(brack_low+range_low*i/ phonon->e_steps_low_, - brack_low+range_low*(i+1)/ phonon->e_steps_low_, - neutron, phonon, ROOTACC); + for (int i = 0; i < phonon->e_steps_low_; i++) { + root = zridd_gpu (brack_low + range_low * i / phonon->e_steps_low_, brack_low + range_low * (i + 1) / phonon->e_steps_low_, neutron, phonon, ROOTACC); if (root != UNUSED) { - list[(*index)++]=root; + list[(*index)++] = root; } } // Then in energy gain for the neutron - for (int i=0; ie_steps_high_; i++){ - root = zridd_gpu(brack_mid+range_high*i/ phonon->e_steps_high_, - brack_mid+range_high*(i+1)/ phonon->e_steps_high_, - neutron, phonon, ROOTACC); - if (root != UNUSED){ - list[(*index)++]=root; + for (int i = 0; i < phonon->e_steps_high_; i++) { + root = zridd_gpu (brack_mid + range_high * i / phonon->e_steps_high_, brack_mid + range_high * (i + 1) / phonon->e_steps_high_, neutron, phonon, ROOTACC); + if (root != UNUSED) { + list[(*index)++] = root; } } } -#undef UNUSED -#undef MAXRIDD -#endif + #undef UNUSED + #undef MAXRIDD + #endif %} DECLARE @@ -369,107 +340,103 @@ DECLARE double V_my_a_v; double DV; struct phonon_params phonon; - %} INITIALIZE %{ - - V_rho = 4/(a*a*a); + + V_rho = 4 / (a * a * a); V_my_s = (V_rho * 100 * sigma_inc); V_my_a_v = (V_rho * 100 * sigma_abs * 2200); - DV = 0.001; /* Velocity change used for numerical derivative */ - + DV = 0.001; /* Velocity change used for numerical derivative */ + // Set constant parameters for parms object phonon.a_ = a; phonon.c_ = c; phonon.gap_ = gap; - phonon.ah = a/2.0; + phonon.ah = a / 2.0; phonon.e_steps_high_ = e_steps_high; phonon.e_steps_low_ = e_steps_low; /* now compute target coords if a component index is supplied */ - if (!target_index && !target_x && !target_y && !target_z) target_index=1; - if (target_index){ + if (!target_index && !target_x && !target_y && !target_z) + target_index = 1; + 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, &target_x, &target_y, &target_z); + 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, &target_x, &target_y, &target_z); } if (!(target_x || target_y || target_z)) { - printf("Phonon_simple: %s: The target is not defined. Using direct beam (Z-axis).\n", - NAME_CURRENT_COMP); - target_z=1; + printf ("Phonon_simple: %s: The target is not defined. Using direct beam (Z-axis).\n", NAME_CURRENT_COMP); + target_z = 1; } %} TRACE %{ double* vf_list; #ifdef OPENACC - vf_list = (double *)malloc( (e_steps_low + e_steps_high)* sizeof(double)); // List of allowed final velocities. Has length of scan_steps + vf_list = (double*)malloc ((e_steps_low + e_steps_high) * sizeof (double)); // List of allowed final velocities. Has length of scan_steps #else - vf_list = (double *)calloc( e_steps_low + e_steps_high, sizeof(double)); // List of allowed final velocities. Has length of scan_steps + vf_list = (double*)calloc (e_steps_low + e_steps_high, sizeof (double)); // List of allowed final velocities. Has length of scan_steps #endif if (!vf_list) { - printf("Memory allocation failed, fatal error!\n"); - exit(-1); + printf ("Memory allocation failed, fatal error!\n"); + exit (-1); } #ifdef OPENACC - for (int ii=0; ii 1) - ABSORB; /* No bragg scattering possible*/ - theta = asin(arg); /* Bragg scattering law */ - -/* Choose point on Debye-Scherrer cone */ - if (dphi_in) - { /* relate height of detector to the height on DS cone */ - arg = sin(dphi_in*DEG2RAD/2)/sin(2*theta); - if (arg < -1 || arg > 1) dphi_in = 0; - else dphi_in = 2*asin(arg); - } - if (dphi_in) { - dphi_in = fabs(dphi_in); - d_phi0= 2*rand01()*dphi_in; - if (d_phi0 > dphi_in) arg = 1; else arg = 0; - if (arg) { - d_phi0=PI+(d_phi0-1.5*dphi_in); - } else { - d_phi0=d_phi0-0.5*dphi_in; - } - p *= dphi_in/PI; - } + arg = q_v / (2.0 * v); + if (arg > 1) + ABSORB; /* No bragg scattering possible*/ + theta = asin (arg); /* Bragg scattering law */ + + /* Choose point on Debye-Scherrer cone */ + if (dphi_in) { /* relate height of detector to the height on DS cone */ + arg = sin (dphi_in * DEG2RAD / 2) / sin (2 * theta); + if (arg < -1 || arg > 1) + dphi_in = 0; + else + dphi_in = 2 * asin (arg); + } + if (dphi_in) { + dphi_in = fabs (dphi_in); + d_phi0 = 2 * rand01 () * dphi_in; + if (d_phi0 > dphi_in) + arg = 1; else - d_phi0 = PI*randpm1(); + arg = 0; + if (arg) { + d_phi0 = PI + (d_phi0 - 1.5 * dphi_in); + } else { + d_phi0 = d_phi0 - 0.5 * dphi_in; + } + p *= dphi_in / PI; + } else + d_phi0 = PI * randpm1 (); /* now find a nearly vertical rotation axis: - * (v along Z) x (X axis) -> nearly Y axis - */ - vec_prod(tmp_vx,tmp_vy,tmp_vz, vx,vy,vz, 1,0,0); + * (v along Z) x (X axis) -> nearly Y axis + */ + vec_prod (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, 1, 0, 0); /* handle case where v and aim are parallel */ - if (!tmp_vx && !tmp_vy && !tmp_vz) { tmp_vx=tmp_vz=0; tmp_vy=1; } + if (!tmp_vx && !tmp_vy && !tmp_vz) { + tmp_vx = tmp_vz = 0; + tmp_vy = 1; + } /* v_out = rotate 'v' by 2*theta around tmp_v: Bragg angle */ - rotate(vout_x,vout_y,vout_z, vx,vy,vz, 2*theta, tmp_vx,tmp_vy,tmp_vz); + rotate (vout_x, vout_y, vout_z, vx, vy, vz, 2 * theta, tmp_vx, tmp_vy, tmp_vz); /* tmp_v = rotate v_out by d_phi0 around 'v' (Debye-Scherrer cone) */ - rotate(tmp_vx,tmp_vy,tmp_vz, vout_x,vout_y,vout_z, d_phi0, vx, vy, vz); + rotate (tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z, d_phi0, vx, vy, vz); vx = tmp_vx; vy = tmp_vy; vz = tmp_vz; - arg=0; - if (isrect && !box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) arg=1; - else if(!isrect && !cylinder_intersect(&t0, &t1, x, y, z, - vx, vy, vz, radius, yheight)) arg=1; + arg = 0; + if (isrect && !box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) + arg = 1; + else if (!isrect && !cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius, yheight)) + arg = 1; if (arg) { /* Strange error: did not hit cylinder */ - fprintf(stderr, "PowderN: FATAL ERROR: Did not hit sample from inside.\n"); + fprintf (stderr, "PowderN: FATAL ERROR: Did not hit sample from inside.\n"); ABSORB; } - l_1 = v*t1; /* go to exit */ + l_1 = v * t1; /* go to exit */ - my_s = my_s_v2/(v*v); - p *= l_full*my_s*exp(-(my_a_v/v+my_s)*(l+l_1)); + my_s = my_s_v2 / (v * v); + p *= l_full * my_s * exp (-(my_a_v / v + my_s) * (l + l_1)); SCATTER; } %} MCDISPLAY %{ - + if (!isrect) { - 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); + 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 { - 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/samples/PowderN.comp b/mcstas-comps/samples/PowderN.comp index 3087a7443b..87219328eb 100644 --- a/mcstas-comps/samples/PowderN.comp +++ b/mcstas-comps/samples/PowderN.comp @@ -213,454 +213,467 @@ SETTING PARAMETERS (string reflections="NULL", string geometry="NULL", 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 POWDERN_DECL -#define POWDERN_DECL - -struct line_data -{ -double F2; /* Value of structure factor */ -double q; /* Qvector */ -int j; /* Multiplicity */ -double DWfactor; /* Debye-Waller factor */ -double w; /* Intrinsic line width */ -double Epsilon; /* Strain=delta_d_d/d shift in ppm */ -}; - -struct line_info_struct -{ - struct line_data *list; /* Reflection array */ - int count; /* Number of reflections */ - double Dd; - double DWfactor; - double V_0; - double rho; - double at_weight; - double at_nb; - double sigma_a; - double sigma_i; - char compname[256]; - double flag_barns; - int shape; /* 0 cylinder, 1 box, 2 sphere, 3 OFF file */ - int column_order[9]; /* column signification */ - int flag_warning; - double dq; /* wavevector transfer [Angs-1] */ - double Epsilon; /* global strain in ppm */ - double XsectionFactor; - double my_s_v2_sum; - double my_a_v; - double my_inc; - double lfree; // store mean free path for the last event; - double *w_v,*q_v, *my_s_v2; - double radius_i,xwidth_i,yheight_i,zdepth_i; - double v; /* last velocity (cached) */ - double Nq; - int nb_reuses, nb_refl, nb_refl_count; - double v_min, v_max; - double xs_Nq[CHAR_BUF_LENGTH]; - double xs_sum[CHAR_BUF_LENGTH]; - double neutron_passed; - long xs_compute, xs_reuse, xs_calls; -}; + /* used for reading data table from file */ + %include "read_table-lib" + %include "interoff-lib" + /* Declare structures and functions only once in each instrument. */ + #ifndef POWDERN_DECL + #define POWDERN_DECL + + struct line_data { + double F2; /* Value of structure factor */ + double q; /* Qvector */ + int j; /* Multiplicity */ + double DWfactor; /* Debye-Waller factor */ + double w; /* Intrinsic line width */ + double Epsilon; /* Strain=delta_d_d/d shift in ppm */ + }; + + struct line_info_struct { + struct line_data* list; /* Reflection array */ + int count; /* Number of reflections */ + double Dd; + double DWfactor; + double V_0; + double rho; + double at_weight; + double at_nb; + double sigma_a; + double sigma_i; + char compname[256]; + double flag_barns; + int shape; /* 0 cylinder, 1 box, 2 sphere, 3 OFF file */ + int column_order[9]; /* column signification */ + int flag_warning; + double dq; /* wavevector transfer [Angs-1] */ + double Epsilon; /* global strain in ppm */ + double XsectionFactor; + double my_s_v2_sum; + double my_a_v; + double my_inc; + double lfree; // store mean free path for the last event; + double *w_v, *q_v, *my_s_v2; + double radius_i, xwidth_i, yheight_i, zdepth_i; + double v; /* last velocity (cached) */ + double Nq; + int nb_reuses, nb_refl, nb_refl_count; + double v_min, v_max; + double xs_Nq[CHAR_BUF_LENGTH]; + double xs_sum[CHAR_BUF_LENGTH]; + double neutron_passed; + long xs_compute, xs_reuse, xs_calls; + }; // PN_list_compare ***************************************************************** -int PN_list_compare(const void *a, const void *b) -{ - const struct line_data *pa = a; - const struct line_data *pb = b; + int + PN_list_compare (const void* a, const void* b) { + const struct line_data* pa = a; + const struct line_data* pb = b; /* Sort by q */ - if (pa->q < pb->q) return -1; - if (pa->q > pb->q) return 1; + if (pa->q < pb->q) + return -1; + if (pa->q > pb->q) + return 1; /* In case of tie, sort by F2 also */ - if (pa->F2 < pb->F2) return -1; - if (pa->F2 > pb->F2) return 1; + if (pa->F2 < pb->F2) + return -1; + if (pa->F2 > pb->F2) + return 1; /* In case of tie, sort by j also */ - if (pa->j < pb->j) return -1; - if (pa->j > pb->j) return 1; + if (pa->j < pb->j) + return -1; + if (pa->j > pb->j) + return 1; return 0; } /* PN_list_compare */ - -#ifndef CIF2HKL -#define CIF2HKL + + #ifndef CIF2HKL + #define CIF2HKL // hkl_filename = cif2hkl(file, options) // used to convert CIF/CFL/INS file into F2(hkl) // the CIF2HKL env var can point to a cif2hkl executable // else the McCode binary is attempted, then the system. - char *cif2hkl(char *infile, char *options) { + char* + cif2hkl (char* infile, char* options) { char cmd[1024]; - int ret = 0; - int found = 0; - char *OUTFILE; - char *inpath; - + int ret = 0; + int found = 0; + char* OUTFILE; + char* inpath; + // get filename extension - char *ext = strrchr(infile, '.'); - if(!ext || ext == infile) return infile; - else ext++; - + char* ext = strrchr (infile, '.'); + if (!ext || ext == infile) + return infile; + else + ext++; + // return input when no extension or not a CIF/FullProf/ShelX file - if ( strcasecmp(ext, "cif") - && strcasecmp(ext, "pcr") - && strcasecmp(ext, "cfl") - && strcasecmp(ext, "shx") - && strcasecmp(ext, "ins") - && strcasecmp(ext, "res")) return infile; - - OUTFILE = malloc(1024); + if (strcasecmp (ext, "cif") && strcasecmp (ext, "pcr") && strcasecmp (ext, "cfl") && strcasecmp (ext, "shx") && strcasecmp (ext, "ins") + && strcasecmp (ext, "res")) + return infile; + + OUTFILE = malloc (1024); if (!OUTFILE) { - free(OUTFILE); + free (OUTFILE); return infile; } - inpath = malloc(1024); + inpath = malloc (1024); if (!inpath) { - free(OUTFILE); - free(inpath); + free (OUTFILE); + free (inpath); return infile; } // get input file path from read-table:Open_File - FILE *f_infile = Open_File(infile, "r", inpath); + FILE* f_infile = Open_File (infile, "r", inpath); if (!f_infile) { - free(OUTFILE); - free(inpath); - free(f_infile); + free (OUTFILE); + free (inpath); + free (f_infile); return infile; } - fclose(f_infile); - - strncpy(OUTFILE, tmpnam(NULL), 1024); // create an output temporary file name - + fclose (f_infile); + + strncpy (OUTFILE, tmpnam (NULL), 1024); // create an output temporary file name + // try in order the CIF2HKL env var, then the system cif2hkl, then the McCode one - if (!found && getenv("CIF2HKL")) { - snprintf(cmd, 1024, "%s -o %s %s %s", - getenv("CIF2HKL"), - OUTFILE, options, inpath); - ret = system(cmd); - if (ret != -1 && ret != 127) found = 1; + if (!found && getenv ("CIF2HKL")) { + snprintf (cmd, 1024, "%s -o %s %s %s", getenv ("CIF2HKL"), OUTFILE, options, inpath); + ret = system (cmd); + if (ret != -1 && ret != 127) + found = 1; } - if (!found) { + if (!found) { // try with cif2hkl command from the system PATH - snprintf(cmd, 1024, "%s -o %s %s %s", - "cif2hkl", OUTFILE, options, infile); - ret = system(cmd); - if (ret != -1 && ret != 127) found = 1; + snprintf (cmd, 1024, "%s -o %s %s %s", "cif2hkl", OUTFILE, options, infile); + ret = system (cmd); + if (ret != -1 && ret != 127) + found = 1; } if (!found) { // As a last resort, attempt with cif2hkl from $MCSTAS/bin - snprintf(cmd, 1024, "%s%c%s%c%s -o %s %s %s", - getenv(FLAVOR_UPPER) ? getenv(FLAVOR_UPPER) : MCSTAS, - MC_PATHSEP_C, "bin", MC_PATHSEP_C, "cif2hkl", - OUTFILE, options, inpath); - ret = system(cmd); + snprintf (cmd, 1024, "%s%c%s%c%s -o %s %s %s", getenv (FLAVOR_UPPER) ? getenv (FLAVOR_UPPER) : MCSTAS, MC_PATHSEP_C, "bin", MC_PATHSEP_C, "cif2hkl", + OUTFILE, options, inpath); + ret = system (cmd); } // ret = -1: child process could not be created - // ret = 127: shell could not be executed in the child process + // ret = 127: shell could not be executed in the child process if (ret == -1 || ret == 127) { - free(OUTFILE); - return(NULL); + free (OUTFILE); + return (NULL); } - + // test if the result file has been created - FILE *file = fopen(OUTFILE,"r"); + FILE* file = fopen (OUTFILE, "r"); if (!file) { - free(OUTFILE); - return(NULL); + free (OUTFILE); + return (NULL); } - MPI_MASTER( - printf("%s: INFO: Converting %s into F2(HKL) list %s\n", - __FILE__, inpath, OUTFILE); - printf ("%s\n",cmd); - ); - fflush(NULL); - fclose(file); - return(OUTFILE); + MPI_MASTER (printf ("%s: INFO: Converting %s into F2(HKL) list %s\n", __FILE__, inpath, OUTFILE); printf ("%s\n", cmd);); + fflush (NULL); + fclose (file); + return (OUTFILE); } // cif2hkl -#endif + #endif - int read_line_data(char *SC_file, struct line_info_struct *info) - { - struct line_data *list = NULL; - int size = 0; + int + read_line_data (char* SC_file, struct line_info_struct* info) { + struct line_data* list = NULL; + int size = 0; t_Table sTable; /* sample data table structure from SC_file */ - int i=0; - int mult_count =0; - char flag=0; - double q_count=0, j_count=0, F2_count=0; - char **parsing; - int list_count=0; - char *filename=NULL; - - if (!SC_file || !strlen(SC_file) || !strcmp(SC_file, "NULL")) { - MPI_MASTER( - printf("PowderN: %s: Using incoherent elastic scattering only.\n", - info->compname); - ); + int i = 0; + int mult_count = 0; + char flag = 0; + double q_count = 0, j_count = 0, F2_count = 0; + char** parsing; + int list_count = 0; + char* filename = NULL; + + if (!SC_file || !strlen (SC_file) || !strcmp (SC_file, "NULL")) { + MPI_MASTER (printf ("PowderN: %s: Using incoherent elastic scattering only.\n", info->compname);); info->count = 0; - return(0); + return (0); } - filename = cif2hkl(SC_file, "--mode NUC"); - if (filename != SC_file) info->flag_barns=1; // cif2hkl returns barns - long retval = Table_Read(&sTable, filename, 1); /* read 1st block data from SC_file into sTable*/ - if (retval<0) { - fprintf(stderr,"PowderN: Could not open file %s - exiting!\n",SC_file); - exit(-1); + filename = cif2hkl (SC_file, "--mode NUC"); + if (filename != SC_file) + info->flag_barns = 1; // cif2hkl returns barns + long retval = Table_Read (&sTable, filename, 1); /* read 1st block data from SC_file into sTable*/ + if (retval < 0) { + fprintf (stderr, "PowderN: Could not open file %s - exiting!\n", SC_file); + exit (-1); } /* parsing of header */ - parsing = Table_ParseHeader(sTable.header, - "Vc","V_0", - "sigma_abs","sigma_a ", - "sigma_inc","sigma_i ", - "column_j", - "column_d", - "column_F2", - "column_DW", - "column_Dd", - "column_inv2d", "column_1/2d", "column_sintheta/lambda", - "column_q", /* 14 */ - "DW", "Debye_Waller", - "delta_d_d/d", - "column_F ", - "V_rho", - "density", - "weight", - "nb_atoms","multiplicity", /* 23 */ - "column_ppm","column_strain", - NULL); + parsing = Table_ParseHeader (sTable.header, "Vc", "V_0", "sigma_abs", "sigma_a ", "sigma_inc", "sigma_i ", "column_j", "column_d", "column_F2", "column_DW", + "column_Dd", "column_inv2d", "column_1/2d", "column_sintheta/lambda", "column_q", /* 14 */ + "DW", "Debye_Waller", "delta_d_d/d", "column_F ", "V_rho", "density", "weight", "nb_atoms", "multiplicity", /* 23 */ + "column_ppm", "column_strain", NULL); if (parsing) { - if (parsing[0] && !info->V_0) info->V_0 =atof(parsing[0]); - if (parsing[1] && !info->V_0) info->V_0 =atof(parsing[1]); - if (parsing[2] && !info->sigma_a) info->sigma_a=atof(parsing[2]); - if (parsing[3] && !info->sigma_a) info->sigma_a=atof(parsing[3]); - if (parsing[4] && !info->sigma_i) info->sigma_i=atof(parsing[4]); - if (parsing[5] && !info->sigma_i) info->sigma_i=atof(parsing[5]); - if (parsing[6]) info->column_order[0]=atoi(parsing[6]); - if (parsing[7]) info->column_order[1]=atoi(parsing[7]); - if (parsing[8]) info->column_order[2]=atoi(parsing[8]); - if (parsing[9]) info->column_order[3]=atoi(parsing[9]); - if (parsing[10]) info->column_order[4]=atoi(parsing[10]); - if (parsing[11]) info->column_order[5]=atoi(parsing[11]); - if (parsing[12]) info->column_order[5]=atoi(parsing[12]); - if (parsing[13]) info->column_order[5]=atoi(parsing[13]); - if (parsing[14]) info->column_order[6]=atoi(parsing[14]); - if (parsing[15] && info->DWfactor<=0) info->DWfactor=atof(parsing[15]); - if (parsing[16] && info->DWfactor<=0) info->DWfactor=atof(parsing[16]); - if (parsing[17] && info->Dd <0) info->Dd =atof(parsing[17]); - if (parsing[18]) info->column_order[7]=atoi(parsing[18]); - if (parsing[19] && !info->V_0) info->V_0 =1/atof(parsing[19]); - if (parsing[20] && !info->rho) info->rho =atof(parsing[20]); - if (parsing[21] && !info->at_weight) info->at_weight =atof(parsing[21]); - if (parsing[22] && info->at_nb <= 1) info->at_nb =atof(parsing[22]); - if (parsing[23] && info->at_nb <= 1) info->at_nb =atof(parsing[23]); - if (parsing[24]) info->column_order[8]=atoi(parsing[24]); - if (parsing[25]) info->column_order[8]=atoi(parsing[25]); - for (i=0; i<=25; i++) if (parsing[i]) free(parsing[i]); - free(parsing); + if (parsing[0] && !info->V_0) + info->V_0 = atof (parsing[0]); + if (parsing[1] && !info->V_0) + info->V_0 = atof (parsing[1]); + if (parsing[2] && !info->sigma_a) + info->sigma_a = atof (parsing[2]); + if (parsing[3] && !info->sigma_a) + info->sigma_a = atof (parsing[3]); + if (parsing[4] && !info->sigma_i) + info->sigma_i = atof (parsing[4]); + if (parsing[5] && !info->sigma_i) + info->sigma_i = atof (parsing[5]); + if (parsing[6]) + info->column_order[0] = atoi (parsing[6]); + if (parsing[7]) + info->column_order[1] = atoi (parsing[7]); + if (parsing[8]) + info->column_order[2] = atoi (parsing[8]); + if (parsing[9]) + info->column_order[3] = atoi (parsing[9]); + if (parsing[10]) + info->column_order[4] = atoi (parsing[10]); + if (parsing[11]) + info->column_order[5] = atoi (parsing[11]); + if (parsing[12]) + info->column_order[5] = atoi (parsing[12]); + if (parsing[13]) + info->column_order[5] = atoi (parsing[13]); + if (parsing[14]) + info->column_order[6] = atoi (parsing[14]); + if (parsing[15] && info->DWfactor <= 0) + info->DWfactor = atof (parsing[15]); + if (parsing[16] && info->DWfactor <= 0) + info->DWfactor = atof (parsing[16]); + if (parsing[17] && info->Dd < 0) + info->Dd = atof (parsing[17]); + if (parsing[18]) + info->column_order[7] = atoi (parsing[18]); + if (parsing[19] && !info->V_0) + info->V_0 = 1 / atof (parsing[19]); + if (parsing[20] && !info->rho) + info->rho = atof (parsing[20]); + if (parsing[21] && !info->at_weight) + info->at_weight = atof (parsing[21]); + if (parsing[22] && info->at_nb <= 1) + info->at_nb = atof (parsing[22]); + if (parsing[23] && info->at_nb <= 1) + info->at_nb = atof (parsing[23]); + if (parsing[24]) + info->column_order[8] = atoi (parsing[24]); + if (parsing[25]) + info->column_order[8] = atoi (parsing[25]); + for (i = 0; i <= 25; i++) + if (parsing[i]) + free (parsing[i]); + free (parsing); } if (!sTable.rows) - exit(fprintf(stderr, "PowderN: %s: Error: The number of rows in %s " - "should be at least %d\n", info->compname, SC_file, 1)); + exit (fprintf (stderr, + "PowderN: %s: Error: The number of rows in %s " + "should be at least %d\n", + info->compname, SC_file, 1)); else size = sTable.rows; - MPI_MASTER( - Table_Info(sTable); - printf("PowderN: %s: Reading %d rows from %s\n", - info->compname, size, SC_file); - ); + MPI_MASTER (Table_Info (sTable); printf ("PowderN: %s: Reading %d rows from %s\n", info->compname, size, SC_file);); if (filename == SC_file) { // only when not from cif2hkl - if (info->column_order[0] == 4 && info->flag_barns !=0) - MPI_MASTER( - printf("PowderN: %s: Powder file probably of type Crystallographica/Fullprof (lau)\n" - "WARNING: but F2 unit is set to barns=1 (barns). Intensity might be 100 times too high.\n", - info->compname); - ); + if (info->column_order[0] == 4 && info->flag_barns != 0) + MPI_MASTER (printf ("PowderN: %s: Powder file probably of type Crystallographica/Fullprof (lau)\n" + "WARNING: but F2 unit is set to barns=1 (barns). Intensity might be 100 times too high.\n", + info->compname);); if (info->column_order[0] == 17 && info->flag_barns == 0) - MPI_MASTER( - printf("PowderN: %s: Powder file probably of type Lazy Pulver (laz)\n" - "WARNING: but F2 unit is set to barns=0 (fm^2). Intensity might be 100 times too low.\n", - info->compname); - ); + MPI_MASTER (printf ("PowderN: %s: Powder file probably of type Lazy Pulver (laz)\n" + "WARNING: but F2 unit is set to barns=0 (fm^2). Intensity might be 100 times too low.\n", + info->compname);); } /* allocate line_data array */ - list = (struct line_data*)malloc(size*sizeof(struct line_data)); + list = (struct line_data*)malloc (size * sizeof (struct line_data)); - for (i=0; iDd >= 0) w = info->Dd; - if (info->DWfactor > 0) DWfactor = info->DWfactor; - if (info->Epsilon) Epsilon = info->Epsilon*1e-6; + if (info->Dd >= 0) + w = info->Dd; + if (info->DWfactor > 0) + DWfactor = info->DWfactor; + if (info->Epsilon) + Epsilon = info->Epsilon * 1e-6; /* get data from table using columns {j d F2 DW Dd inv2d q F} */ /* column indexes start at 1, thus need to substract 1 */ - if (info->column_order[0] >0) - j = Table_Index(sTable, i, info->column_order[0]-1); - if (info->column_order[1] >0) - d = Table_Index(sTable, i, info->column_order[1]-1); - if (info->column_order[2] >0) - F2 = Table_Index(sTable, i, info->column_order[2]-1); - if (info->column_order[3] >0) - DWfactor = Table_Index(sTable, i, info->column_order[3]-1); - if (info->column_order[4] >0) - w = Table_Index(sTable, i, info->column_order[4]-1); - if (info->column_order[5] >0 && !(info->column_order[1] >0)) // Only use if d not read already - { d = Table_Index(sTable, i, info->column_order[5]-1); - d = (d > 0? 1/d/2 : 0); } - if (info->column_order[6] >0 && !(info->column_order[1] >0)) // Only use if d not read already - { q = Table_Index(sTable, i, info->column_order[6]-1); - d = (q > 0 ? 2*PI/q : 0); } - if (info->column_order[7] >0 && !F2) - { F2 = Table_Index(sTable, i, info->column_order[7]-1); F2 *= F2; } - if (info->column_order[8] >0 && !Epsilon) - { Epsilon = Table_Index(sTable, i, info->column_order[8]-1)*1e-6; } + if (info->column_order[0] > 0) + j = Table_Index (sTable, i, info->column_order[0] - 1); + if (info->column_order[1] > 0) + d = Table_Index (sTable, i, info->column_order[1] - 1); + if (info->column_order[2] > 0) + F2 = Table_Index (sTable, i, info->column_order[2] - 1); + if (info->column_order[3] > 0) + DWfactor = Table_Index (sTable, i, info->column_order[3] - 1); + if (info->column_order[4] > 0) + w = Table_Index (sTable, i, info->column_order[4] - 1); + if (info->column_order[5] > 0 && !(info->column_order[1] > 0)) // Only use if d not read already + { + d = Table_Index (sTable, i, info->column_order[5] - 1); + d = (d > 0 ? 1 / d / 2 : 0); + } + if (info->column_order[6] > 0 && !(info->column_order[1] > 0)) // Only use if d not read already + { + q = Table_Index (sTable, i, info->column_order[6] - 1); + d = (q > 0 ? 2 * PI / q : 0); + } + if (info->column_order[7] > 0 && !F2) { + F2 = Table_Index (sTable, i, info->column_order[7] - 1); + F2 *= F2; + } + if (info->column_order[8] > 0 && !Epsilon) { + Epsilon = Table_Index (sTable, i, info->column_order[8] - 1) * 1e-6; + } /* assign and check values */ - j = (j > 0 ? j : 0); - q = (d > 0 ? 2*PI/d : 0); /* this is q */ - if (Epsilon && fabs(Epsilon) < 1e6) { - q -= Epsilon*q; /* dq/q = -delta_d_d/d = -Epsilon */ + j = (j > 0 ? j : 0); + q = (d > 0 ? 2 * PI / d : 0); /* this is q */ + if (Epsilon && fabs (Epsilon) < 1e6) { + q -= Epsilon * q; /* dq/q = -delta_d_d/d = -Epsilon */ } DWfactor = (DWfactor > 0 ? DWfactor : 1); - w = (w>0 ? w : 0); /* this is q and d relative spreading */ - F2 = (F2 >= 0 ? F2 : 0); + w = (w > 0 ? w : 0); /* this is q and d relative spreading */ + F2 = (F2 >= 0 ? F2 : 0); if (j == 0 || q == 0) { - MPI_MASTER( - printf("PowderN: %s: line %i has invalid definition\n" - " (mult=0 or q=0 or d=0)\n", info->compname, i); - ); + MPI_MASTER (printf ("PowderN: %s: line %i has invalid definition\n" + " (mult=0 or q=0 or d=0)\n", + info->compname, i);); continue; } list[list_count].j = j; list[list_count].q = q; list[list_count].DWfactor = DWfactor; list[list_count].w = w; - list[list_count].F2= F2; + list[list_count].F2 = F2; list[list_count].Epsilon = Epsilon; /* adjust multiplicity if j-column + multiple d-spacing lines */ /* if d = previous d, increase line duplication index */ - if (!q_count) q_count = q; - if (!j_count) j_count = j; - if (!F2_count) F2_count = F2; - if (fabs(q_count-q) < 0.0001*fabs(q) - && fabs(F2_count-F2) < 0.0001*fabs(F2) && j_count == j) { - mult_count++; flag=0; } - else flag=1; - if (i == size-1) flag=1; + if (!q_count) + q_count = q; + if (!j_count) + j_count = j; + if (!F2_count) + F2_count = F2; + if (fabs (q_count - q) < 0.0001 * fabs (q) && fabs (F2_count - F2) < 0.0001 * fabs (F2) && j_count == j) { + mult_count++; + flag = 0; + } else + flag = 1; + if (i == size - 1) + flag = 1; /* else if d != previous d : just passed equivalent lines */ if (flag) { - if (i == size-1) list_count++; - /* if duplication index == previous multiplicity */ - /* set back multiplicity of previous lines to 1 */ - if ((mult_count && list_count>0) - && (mult_count == list[list_count-1].j - || ((list_count < size) && (i == size - 1) - && (mult_count == list[list_count].j))) ) { - MPI_MASTER( - printf("PowderN: %s: Set multiplicity to 1 for lines [%i:%i]\n" - " (d-spacing %g is duplicated %i times)\n", - info->compname, list_count-mult_count, list_count-1, list[list_count-1].q, mult_count); - ); - for (index=list_count-mult_count; index 0) + && (mult_count == list[list_count - 1].j || ((list_count < size) && (i == size - 1) && (mult_count == list[list_count].j)))) { + MPI_MASTER (printf ("PowderN: %s: Set multiplicity to 1 for lines [%i:%i]\n" + " (d-spacing %g is duplicated %i times)\n", + info->compname, list_count - mult_count, list_count - 1, list[list_count - 1].q, mult_count);); + for (index = list_count - mult_count; index < list_count; list[index++].j = 1) + ; mult_count = 1; - q_count = q; - j_count = j; - F2_count = F2; + q_count = q; + j_count = j; + F2_count = F2; } - if (i == size-1) list_count--; - flag=0; + if (i == size - 1) + list_count--; + flag = 0; } list_count++; } /* end for */ - Table_Free(&sTable); + Table_Free (&sTable); /* sort the list with increasing q */ - qsort(list, list_count, sizeof(struct line_data), PN_list_compare); + qsort (list, list_count, sizeof (struct line_data), PN_list_compare); + + MPI_MASTER (printf ("PowderN: %s: Read %i reflections from file '%s'\n", info->compname, list_count, SC_file);); - MPI_MASTER( - printf("PowderN: %s: Read %i reflections from file '%s'\n", - info->compname, list_count, SC_file); - ); - // remove temporary F2(hkl) file when giving CFL/CIF/ShelX file if (filename != SC_file) - unlink(filename); + unlink (filename); - info->list = list; + info->list = list; info->count = list_count; - return(list_count); + return (list_count); } /* read_line_data */ + /* computes the number of possible reflections (return value), and the total xsection 'sum' */ + /* this routine looks for a pre-computed value in the Nq and sum cache tables */ + /* when found, the earch starts from the corresponding lower element in the table */ + #pragma acc routine seq + int + calc_xsect (double v, double* qv, double* my_sv2, int count, double* sum, struct line_info_struct* line_info) { + int Nq = 0, line = 0, line0 = 0; + *sum = 0; -/* computes the number of possible reflections (return value), and the total xsection 'sum' */ -/* this routine looks for a pre-computed value in the Nq and sum cache tables */ -/* when found, the earch starts from the corresponding lower element in the table */ -#pragma acc routine seq -int calc_xsect(double v, double *qv, double *my_sv2, int count, double *sum, - struct line_info_struct *line_info) { - int Nq = 0, line=0, line0=0; - *sum=0; - - /* check if a line_info element has been recorded already - not on OpenACC */ - #ifndef OPENACC - if (v >= line_info->v_min && v <= line_info->v_max && line_info->neutron_passed >= CHAR_BUF_LENGTH) { - line = (int)floor(v - line_info->v_min)*CHAR_BUF_LENGTH/(line_info->v_max - line_info->v_min); - Nq = line_info->xs_Nq[line]; - *sum = line_info->xs_sum[line]; - if (!Nq && *sum == 0) { - /* not yet set: we compute the sum up to the corresponding speed in the table cache */ - double line_v = line_info->v_min + line*(line_info->v_max - line_info->v_min)/CHAR_BUF_LENGTH; - for(line0=0; line0xs_Nq[line] = Nq; - line_info->xs_sum[line]= *sum; - line_info->xs_compute++; - } else line_info->xs_reuse++; - line0 = Nq; - } - - line_info->xs_calls++; - #endif + /* check if a line_info element has been recorded already - not on OpenACC */ + #ifndef OPENACC + if (v >= line_info->v_min && v <= line_info->v_max && line_info->neutron_passed >= CHAR_BUF_LENGTH) { + line = (int)floor (v - line_info->v_min) * CHAR_BUF_LENGTH / (line_info->v_max - line_info->v_min); + Nq = line_info->xs_Nq[line]; + *sum = line_info->xs_sum[line]; + if (!Nq && *sum == 0) { + /* not yet set: we compute the sum up to the corresponding speed in the table cache */ + double line_v = line_info->v_min + line * (line_info->v_max - line_info->v_min) / CHAR_BUF_LENGTH; + for (line0 = 0; line0 < count; line0++) { + if (qv[line0] <= 2 * line_v) { /* q < 2*kf: restrict structural range */ + *sum += my_sv2[line0]; + if (Nq < line0 + 1) + Nq = line0 + 1; /* determine maximum line index which can scatter */ + } else + break; + } + line_info->xs_Nq[line] = Nq; + line_info->xs_sum[line] = *sum; + line_info->xs_compute++; + } else + line_info->xs_reuse++; + line0 = Nq; + } - for(line=line0; linexs_calls++; + #endif - return(Nq); -} /* calc_xsect */ + for (line = line0; line < count; line++) { + if (qv[line] <= 2 * v) { /* q < 2*kf: restrict structural range */ + *sum += my_sv2[line]; + if (Nq < line + 1) + Nq = line + 1; /* determine maximum line index which can scatter */ + } else + break; + } -#endif /* !POWDERN_DECL */ + return (Nq); + } /* calc_xsect */ + #endif /* !POWDERN_DECL */ %} DECLARE %{ struct line_info_struct line_info; - double *columns; + double* columns; off_struct offdata; double tgt_x; double tgt_y; @@ -672,96 +685,100 @@ INITIALIZE /* We ought to clean up the columns variable as format is now a proper vector/array */ columns = format; - int i=0; - struct line_data *L; - line_info.Dd = delta_d_d; + int i = 0; + struct line_data* L; + line_info.Dd = delta_d_d; line_info.DWfactor = DW; - line_info.V_0 = Vc; - line_info.rho = density; - line_info.at_weight= weight; - line_info.at_nb = nb_atoms; - line_info.sigma_a = sigma_abs; - line_info.sigma_i = sigma_inc; - line_info.flag_barns=barns; - line_info.shape = 0; - line_info.flag_warning=0; - line_info.Epsilon = Strain; - line_info.radius_i =line_info.xwidth_i=line_info.yheight_i=line_info.zdepth_i=0; - line_info.v = 0; + line_info.V_0 = Vc; + line_info.rho = density; + line_info.at_weight = weight; + line_info.at_nb = nb_atoms; + line_info.sigma_a = sigma_abs; + line_info.sigma_i = sigma_inc; + line_info.flag_barns = barns; + line_info.shape = 0; + line_info.flag_warning = 0; + line_info.Epsilon = Strain; + line_info.radius_i = line_info.xwidth_i = line_info.yheight_i = line_info.zdepth_i = 0; + line_info.v = 0; line_info.Nq = 0; - line_info.v_min = FLT_MAX; line_info.v_max = 0; - line_info.neutron_passed=0; + line_info.v_min = FLT_MAX; + line_info.v_max = 0; + line_info.neutron_passed = 0; line_info.nb_reuses = line_info.nb_refl = line_info.nb_refl_count = 0; - line_info.xs_compute= line_info.xs_reuse= line_info.xs_calls =0; - for (i=0; i< 9; i++) { + line_info.xs_compute = line_info.xs_reuse = line_info.xs_calls = 0; + for (i = 0; i < 9; i++) { line_info.column_order[i] = (int)columns[i]; } - strncpy(line_info.compname, NAME_CURRENT_COMP, 256); + strncpy (line_info.compname, NAME_CURRENT_COMP, 256); - line_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")) { + line_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")) { #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 - if (off_init(geometry, xwidth, yheight, zdepth, 0, &offdata)) { - line_info.shape=3; thickness=0; concentric=0; + if (off_init (geometry, xwidth, yheight, zdepth, 0, &offdata)) { + line_info.shape = 3; + thickness = 0; + concentric = 0; } #endif - } - else - if (xwidth && yheight && zdepth) line_info.shape=1; /* box */ - else if (radius > 0 && yheight) line_info.shape=0; /* cylinder */ - else if (radius > 0 && !yheight) line_info.shape=2; /* sphere */ + } else if (xwidth && yheight && zdepth) + line_info.shape = 1; /* box */ + else if (radius > 0 && yheight) + line_info.shape = 0; /* cylinder */ + else if (radius > 0 && !yheight) + line_info.shape = 2; /* sphere */ if (line_info.shape < 0) - exit(fprintf(stderr,"PowderN: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "PowderN: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); if (thickness) { - if (radius && (radius < fabs(thickness))) { - MPI_MASTER( - printf("PowderN: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" - "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", NAME_CURRENT_COMP); - ); - thickness=0; - } - else if (!radius && (xwidth < 2*fabs(thickness) || yheight < 2*fabs(thickness) || zdepth < 2*fabs(thickness))) { - MPI_MASTER( - printf("PowderN: %s: hollow sample thickness is larger than its volume (box).\n" - "WARNING Please check parameter values.\n", NAME_CURRENT_COMP); - ); + if (radius && (radius < fabs (thickness))) { + MPI_MASTER (printf ("PowderN: %s: hollow sample thickness is larger than its volume (sphere/cylinder).\n" + "WARNING Please check parameter values. Using bulk sample (thickness=0).\n", + NAME_CURRENT_COMP);); + thickness = 0; + } else if (!radius && (xwidth < 2 * fabs (thickness) || yheight < 2 * fabs (thickness) || zdepth < 2 * fabs (thickness))) { + MPI_MASTER (printf ("PowderN: %s: hollow sample thickness is larger than its volume (box).\n" + "WARNING Please check parameter values.\n", + NAME_CURRENT_COMP);); } } - if (concentric && thickness==0) { - MPI_MASTER( - printf("PowderN: %s:Can not use concentric mode\n" - "WARNING on non hollow shape. Ignoring.\n", - NAME_CURRENT_COMP); - ); - concentric=0; + if (concentric && thickness == 0) { + MPI_MASTER (printf ("PowderN: %s:Can not use concentric mode\n" + "WARNING on non hollow shape. Ignoring.\n", + NAME_CURRENT_COMP);); + concentric = 0; } - if (thickness>0) { - if (radius>thickness) { - line_info.radius_i=radius-thickness; + if (thickness > 0) { + if (radius > thickness) { + line_info.radius_i = radius - thickness; } else { - if (xwidth>2*thickness) line_info.xwidth_i =xwidth -2*thickness; - if (yheight>2*thickness) line_info.yheight_i=yheight-2*thickness; - if (zdepth>2*thickness) line_info.zdepth_i =zdepth -2*thickness; + if (xwidth > 2 * thickness) + line_info.xwidth_i = xwidth - 2 * thickness; + if (yheight > 2 * thickness) + line_info.yheight_i = yheight - 2 * thickness; + if (zdepth > 2 * thickness) + line_info.zdepth_i = zdepth - 2 * thickness; } - } else if (thickness<0) { - thickness = fabs(thickness); + } else if (thickness < 0) { + thickness = fabs (thickness); if (radius) { - line_info.radius_i=radius; - radius=line_info.radius_i+thickness; + line_info.radius_i = radius; + radius = line_info.radius_i + thickness; } else { - line_info.xwidth_i =xwidth; - line_info.yheight_i=yheight; - line_info.zdepth_i =zdepth; - xwidth =xwidth +2*thickness; - yheight =yheight+2*thickness; - zdepth =zdepth +2*thickness; + line_info.xwidth_i = xwidth; + line_info.yheight_i = yheight; + line_info.zdepth_i = zdepth; + xwidth = xwidth + 2 * thickness; + yheight = yheight + 2 * thickness; + zdepth = zdepth + 2 * thickness; } } @@ -769,72 +786,69 @@ INITIALIZE line_info.yheight_i = yheight; } - if (!p_interact){ - fprintf(stderr,"WARNING(%s): p_interact=0, adjusting to 0.01, to avoid algorithm instability\n",NAME_CURRENT_COMP); - p_interact=1e-2; + if (!p_interact) { + fprintf (stderr, "WARNING(%s): p_interact=0, adjusting to 0.01, to avoid algorithm instability\n", NAME_CURRENT_COMP); + p_interact = 1e-2; } - if (!p_inc){ - fprintf(stderr,"WARNING(%s): p_inc=0, adjusting to 0.01, to avoid algorithm instability\n",NAME_CURRENT_COMP); - p_inc =1e-2; + if (!p_inc) { + fprintf (stderr, "WARNING(%s): p_inc=0, adjusting to 0.01, to avoid algorithm instability\n", NAME_CURRENT_COMP); + p_inc = 1e-2; } - if (!p_transmit){ - fprintf(stderr,"WARNING(%s): p_transmit=0, adjusting to 0.01, to avoid algorithm instability\n",NAME_CURRENT_COMP); - p_transmit=1e-2; + if (!p_transmit) { + fprintf (stderr, "WARNING(%s): p_transmit=0, adjusting to 0.01, to avoid algorithm instability\n", NAME_CURRENT_COMP); + p_transmit = 1e-2; } - double p_sum=p_interact+p_inc+p_transmit; + double p_sum = p_interact + p_inc + p_transmit; p_interact = p_interact / p_sum; - p_inc = p_inc / p_sum; + p_inc = p_inc / p_sum; p_transmit = p_transmit / p_sum; if (concentric) { - MPI_MASTER( - printf("PowderN: %s: Concentric mode - remember to include the 'opposite' copy of this component !\n" - "WARNING The equivalent, 'opposite' comp should have concentric=0\n", NAME_CURRENT_COMP); - ); + MPI_MASTER (printf ("PowderN: %s: Concentric mode - remember to include the 'opposite' copy of this component !\n" + "WARNING The equivalent, 'opposite' comp should have concentric=0\n", + NAME_CURRENT_COMP);); if (p_transmit < 0.1) { - MPI_MASTER( - printf("PowderN: %s: Concentric mode and p_transmit<0.1 !\n" - "WARNING Consider increasing p_transmit as few particles will reach the inner hollow.\n", NAME_CURRENT_COMP); - ); + MPI_MASTER (printf ("PowderN: %s: Concentric mode and p_transmit<0.1 !\n" + "WARNING Consider increasing p_transmit as few particles will reach the inner hollow.\n", + NAME_CURRENT_COMP);); } } - if (reflections && strlen(reflections) && strcmp(reflections, "NULL") && strcmp(reflections, "0")) { - i = read_line_data(reflections, &line_info); + if (reflections && strlen (reflections) && strcmp (reflections, "NULL") && strcmp (reflections, "0")) { + i = read_line_data (reflections, &line_info); if (i == 0) - exit(fprintf(stderr,"PowderN: %s: reflection file %s is not valid.\n" - "ERROR Please check file format (laz or lau).\n", NAME_CURRENT_COMP, reflections)); + exit (fprintf (stderr, + "PowderN: %s: reflection file %s is not valid.\n" + "ERROR Please check file format (laz or lau).\n", + NAME_CURRENT_COMP, reflections)); } /* compute the scattering unit density from material weight and density */ /* the weight of the scattering element is the chemical formula molecular weight * times the nb of chemical formulae in the scattering element (nb_atoms) */ - if (!line_info.V_0 && line_info.at_nb > 0 - && line_info.at_weight > 0 && line_info.rho > 0) { + if (!line_info.V_0 && line_info.at_nb > 0 && line_info.at_weight > 0 && line_info.rho > 0) { /* molar volume [cm^3/mol] = weight [g/mol] / density [g/cm^3] */ /* atom density per Angs^3 = [mol/cm^3] * N_Avogadro *(1e-8)^3 */ - line_info.V_0 = line_info.at_nb - /(line_info.rho/line_info.at_weight/1e24*6.02214199e23); + line_info.V_0 = line_info.at_nb / (line_info.rho / line_info.at_weight / 1e24 * 6.02214199e23); } /* the scattering unit cross sections are the chemical formula onces * times the nb of chemical formulae in the scattering element */ if (line_info.at_nb > 0) { - line_info.sigma_a *= line_info.at_nb; line_info.sigma_i *= line_info.at_nb; + line_info.sigma_a *= line_info.at_nb; + line_info.sigma_i *= line_info.at_nb; } - if (line_info.sigma_a<0) line_info.sigma_a=0; - if (line_info.sigma_i<0) line_info.sigma_i=0; + if (line_info.sigma_a < 0) + line_info.sigma_a = 0; + if (line_info.sigma_i < 0) + line_info.sigma_i = 0; if (line_info.V_0 <= 0) - MPI_MASTER( - printf("PowderN: %s: density/unit cell volume is NULL (Vc). Unactivating component.\n", NAME_CURRENT_COMP); - ); + MPI_MASTER (printf ("PowderN: %s: density/unit cell volume is NULL (Vc). Unactivating component.\n", NAME_CURRENT_COMP);); if (line_info.V_0 > 0 && p_inc && !line_info.sigma_i) { - MPI_MASTER( - printf("PowderN: %s: WARNING: You have requested statistics for incoherent scattering but not defined sigma_inc!\n", NAME_CURRENT_COMP); - ); + MPI_MASTER (printf ("PowderN: %s: WARNING: You have requested statistics for incoherent scattering but not defined sigma_inc!\n", NAME_CURRENT_COMP);); } if (line_info.flag_barns) { /* Factor 100 to convert from barns to fm^2 */ @@ -846,61 +860,56 @@ INITIALIZE if (line_info.V_0 > 0 && i) { L = line_info.list; - line_info.q_v = malloc(line_info.count*sizeof(double)); - line_info.w_v = malloc(line_info.count*sizeof(double)); - line_info.my_s_v2 = malloc(line_info.count*sizeof(double)); + line_info.q_v = malloc (line_info.count * sizeof (double)); + line_info.w_v = malloc (line_info.count * sizeof (double)); + line_info.my_s_v2 = malloc (line_info.count * sizeof (double)); if (!line_info.q_v || !line_info.w_v || !line_info.my_s_v2) - exit(fprintf(stderr,"PowderN: %s: ERROR allocating memory (init)\n", NAME_CURRENT_COMP)); - for(i=0; i 0) { /* Is not yet divided by v */ - line_info.my_a_v = pack*line_info.sigma_a/line_info.V_0*2200*100; // Factor 100 to convert from barns to fm^2 - line_info.my_inc = pack*line_info.sigma_i/line_info.V_0*100; // Factor 100 to convert from barns to fm^2 - MPI_MASTER( - printf("PowderN: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", - NAME_CURRENT_COMP, line_info.V_0, line_info.sigma_a, line_info.sigma_i, reflections && strlen(reflections) ? reflections : "NULL"); - ); + line_info.my_a_v = pack * line_info.sigma_a / line_info.V_0 * 2200 * 100; // Factor 100 to convert from barns to fm^2 + line_info.my_inc = pack * line_info.sigma_i / line_info.V_0 * 100; // Factor 100 to convert from barns to fm^2 + MPI_MASTER (printf ("PowderN: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", NAME_CURRENT_COMP, line_info.V_0, line_info.sigma_a, + line_info.sigma_i, reflections && strlen (reflections) ? reflections : "NULL");); } - + /* update JS, 1/7/2017 Get target coordinates relative to the local reference frame. */ - 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, &tgt_x, &tgt_y, &tgt_z); - NORM(tgt_x, tgt_y, tgt_z); - printf("PowderN: Target direction = (%g %g %g)\n",tgt_x, tgt_y, tgt_z); - } else { - tgt_x=0.0; - tgt_y=0.0; - tgt_z=1.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, &tgt_x, &tgt_y, &tgt_z); + NORM (tgt_x, tgt_y, tgt_z); + printf ("PowderN: Target direction = (%g %g %g)\n", tgt_x, tgt_y, tgt_z); + } else { + tgt_x = 0.0; + tgt_y = 0.0; + tgt_z = 1.0; + } %} TRACE %{ - double t0, t1, t2, t3, v, v1,l_full, l, l_1, dt, alpha0, alpha, theta, my_s, my_s_n, sg; + double t0, t1, t2, t3, v, v1, l_full, l, l_1, dt, alpha0, alpha, theta, my_s, my_s_n, sg; double solid_angle; double neutrontype = 0; double ntype = 0; - double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z, nx, ny, nz, pmul=1; - int line; - char intersect=0; - char intersecti=0; - - // Variables calculated within thread for thread purpose only + double arg, tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z, nx, ny, nz, pmul = 1; + int line; + char intersect = 0; + char intersecti = 0; + + // Variables calculated within thread for thread purpose only char type = '\0'; int itype = 0; double d_phi_thread = d_phi; @@ -908,14 +917,14 @@ TRACE int nb_reuses = line_info.nb_reuses; int nb_refl = line_info.nb_refl; int nb_refl_count = line_info.nb_refl_count; - double vcache = line_info.v; + double vcache = line_info.v; double Nq = line_info.Nq; double v_min = line_info.v_min; double v_max = line_info.v_max; double lfree = line_info.lfree; - long xs_compute = line_info.xs_compute; - long xs_reuse = line_info.xs_reuse; - long xs_calls = line_info.xs_calls; + long xs_compute = line_info.xs_compute; + long xs_reuse = line_info.xs_reuse; + long xs_calls = line_info.xs_calls; double dq = line_info.dq; #ifdef OPENACC @@ -925,151 +934,161 @@ TRACE #else #define thread_offdata offdata #endif - + if (line_info.V_0 > 0 && (line_info.count || line_info.my_inc)) { if (line_info.shape == 1) { - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - intersecti = box_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersecti = box_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); } else if (line_info.shape == 0) { - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); - intersecti = cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersecti = cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); } else if (line_info.shape == 2) { - intersect = sphere_intersect (&t0, &t3, x,y,z, vx,vy,vz, radius); - intersecti = sphere_intersect (&t1, &t2, x,y,z, vx,vy,vz, line_info.radius_i); + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); + intersecti = sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i); } #ifdef USE_OFF else if (line_info.shape == 3) { - intersect = off_intersect (&t0, &t3, NULL, NULL, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); intersecti = 0; } #endif - } + } - if(intersect && t3 >0) { + if (intersect && t3 > 0) { if (concentric) { /* Set up for concentric case */ /* 'Remove' the backside of this comp */ if (!intersecti) { - t1 = (t3 + t0) /2; + t1 = (t3 + t0) / 2; } t2 = t1; t3 = t1; - dt = -1.0*rand01(); /* In case of scattering we will scatter on 'forward' part of sample */ + dt = -1.0 * rand01 (); /* In case of scattering we will scatter on 'forward' part of sample */ } else { if (!intersecti) { - t1 = (t3 + t0) /2; + t1 = (t3 + t0) / 2; t2 = t1; } - dt = randpm1(); /* Possibility to scatter at all points in line of sight */ + dt = randpm1 (); /* Possibility to scatter at all points in line of sight */ } /* Neutron enters at t=t0. */ - if(t0 < 0) t0=0; /* already in sample */ - if(t1 < 0) t1=0; /* already in inner hollow */ - if(t2 < 0) t2=0; /* already past inner hollow */ - v = sqrt(vx*vx + vy*vy + vz*vz); + if (t0 < 0) + t0 = 0; /* already in sample */ + if (t1 < 0) + t1 = 0; /* already in inner hollow */ + if (t2 < 0) + t2 = 0; /* already past inner hollow */ + v = sqrt (vx * vx + vy * vy + vz * vz); l_full = v * (t3 - t2 + t1 - t0); if (line_info.neutron_passed < CHAR_BUF_LENGTH) { - if (v < v_min) v_min = v; - if (v > v_max) v_max = v; + if (v < v_min) + v_min = v; + if (v > v_max) + v_max = v; line_info.neutron_passed++; } /* Calculate total scattering cross section at relevant velocity - but not on GPU*/ #ifndef OPENACC - if ( fabs(v - vcache) < 1e-6) { - nb_reuses++; + if (fabs (v - vcache) < 1e-6) { + nb_reuses++; } else { - #endif - Nq = calc_xsect(v, line_info.q_v, line_info.my_s_v2, line_info.count, &line_info.my_s_v2_sum, &line_info); + #endif + Nq = calc_xsect (v, line_info.q_v, line_info.my_s_v2, line_info.count, &line_info.my_s_v2_sum, &line_info); vcache = v; nb_refl += Nq; nb_refl_count++; - #ifndef OPENACC + #ifndef OPENACC } #endif if (t3 < 0) { - t3=0; /* Already past sample?! */ + t3 = 0; /* Already past sample?! */ if (line_info.flag_warning < 10) - printf("PowderN: %s: Warning: Neutron has already passed us? (Skipped).\n" - " In concentric geometry, this may be caused by a missing concentric=0 option in 2nd enclosing instance.\n", NAME_CURRENT_COMP); + printf ("PowderN: %s: Warning: Neutron has already passed us? (Skipped).\n" + " In concentric geometry, this may be caused by a missing concentric=0 option in 2nd enclosing instance.\n", + NAME_CURRENT_COMP); line_info.flag_warning++; } else { - if (dt<0) { /* Calculate scattering point position */ - dt = fabs(dt)*(t1 - t0); /* 'Forward' part */ + if (dt < 0) { /* Calculate scattering point position */ + dt = fabs (dt) * (t1 - t0); /* 'Forward' part */ } else { - dt = dt * (t3 - t2) + (t2-t0) ; /* Possibly also 'backside' part */ + dt = dt * (t3 - t2) + (t2 - t0); /* Possibly also 'backside' part */ } - if (order){ - my_s = line_info.my_s_v2_sum/(v*v)+line_info.my_inc; + if (order) { + my_s = line_info.my_s_v2_sum / (v * v) + line_info.my_inc; } else { my_s = line_info.my_inc; } /* Total attenuation from scattering */ - lfree=0; - ntype = rand01(); + lfree = 0; + ntype = rand01 (); /* How to handle this one? Transmit (1) / Incoherent (2) / Coherent (3) ? */ if (ntype < p_transmit) { neutrontype = 1; l = l_full; /* Passing through, full length */ - PROP_DT(t3); + PROP_DT (t3); } else if (ntype >= p_transmit && ntype < (p_transmit + p_inc)) { neutrontype = 2; - l = v*dt; /* Penetration in sample */ - PROP_DT(dt+t0); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ + PROP_DT (dt + t0); /* Point of scattering */ SCATTER; } else if (ntype >= p_transmit + p_inc) { neutrontype = 3; - l = v*dt; /* Penetration in sample */ - PROP_DT(dt+t0); /* Point of scattering */ + l = v * dt; /* Penetration in sample */ + PROP_DT (dt + t0); /* Point of scattering */ SCATTER; } else { - exit(fprintf(stderr,"PowderN %s: DEAD - this shouldn't happen!\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, "PowderN %s: DEAD - this shouldn't happen!\n", NAME_CURRENT_COMP)); } if (neutrontype == 3) { /* Make coherent scattering event */ if (line_info.count > 0) { /* choose line */ - if (Nq > 1) line=floor(Nq*rand01()); /* Select between Nq powder lines */ - else line = 0; - if (line_info.w_v[line]) - arg = line_info.q_v[line]*(1+line_info.w_v[line]*randnorm())/(2.0*v); - else - arg = line_info.q_v[line]/(2.0*v); - my_s_n = line_info.my_s_v2[line]/(v*v); - if(fabs(arg) > 1) - ABSORB; /* No bragg scattering possible*/ - if (tth_sign == 0) { - sg = randpm1(); - if (sg > 0) sg = 1; else sg=-1; - } - else { - sg = tth_sign/fabs(tth_sign); - } - theta = asin(arg); /* Bragg scattering law */ - /* Choose point on Debye-Scherrer cone */ - if (d_phi_thread) - { /* relate height of detector to the height on DS cone */ - arg = sin(d_phi_thread*DEG2RAD/2)/sin(2*theta); - /* If full Debye-Scherrer cone is within d_phi, don't focus */ - if (arg < -1 || arg > 1) d_phi_thread = 0; - /* Otherwise, determine alpha to rotate from scattering plane - into d_phi focusing area*/ - else alpha = 2*asin(arg); - } - if (d_phi_thread) { - /* Focusing */ - alpha = fabs(alpha); - alpha0 = 0.5*randpm1()*alpha; - if(focus_flip){ - alpha0+=M_PI_2; - } - } - else - alpha0 = PI*randpm1(); + if (Nq > 1) + line = floor (Nq * rand01 ()); /* Select between Nq powder lines */ + else + line = 0; + if (line_info.w_v[line]) + arg = line_info.q_v[line] * (1 + line_info.w_v[line] * randnorm ()) / (2.0 * v); + else + arg = line_info.q_v[line] / (2.0 * v); + my_s_n = line_info.my_s_v2[line] / (v * v); + if (fabs (arg) > 1) + ABSORB; /* No bragg scattering possible*/ + if (tth_sign == 0) { + sg = randpm1 (); + if (sg > 0) + sg = 1; + else + sg = -1; + } else { + sg = tth_sign / fabs (tth_sign); + } + theta = asin (arg); /* Bragg scattering law */ + /* Choose point on Debye-Scherrer cone */ + if (d_phi_thread) { /* relate height of detector to the height on DS cone */ + arg = sin (d_phi_thread * DEG2RAD / 2) / sin (2 * theta); + /* If full Debye-Scherrer cone is within d_phi, don't focus */ + if (arg < -1 || arg > 1) + d_phi_thread = 0; + /* Otherwise, determine alpha to rotate from scattering plane + into d_phi focusing area*/ + else + alpha = 2 * asin (arg); + } + if (d_phi_thread) { + /* Focusing */ + alpha = fabs (alpha); + alpha0 = 0.5 * randpm1 () * alpha; + if (focus_flip) { + alpha0 += M_PI_2; + } + } else + alpha0 = PI * randpm1 (); /* now find a nearly vertical rotation axis: * Either @@ -1077,141 +1096,142 @@ TRACE * Or * (v along X) x (Z axis) -> nearly Y axis */ - - /* update JS, 1/7/2017 - If a target is defined, try to define vertical axis as a normal to the plane - defined by the incident neutron velocity and target position. - Check that v is not ~ parallel to the target direction. - */ - double vnorm=0.0; - if (target_index) { - vec_prod(tmp_vx, tmp_vy, tmp_vz, vx,vy,vz, tgt_x, tgt_y, tgt_z); - vnorm = sqrt(tmp_vx*tmp_vx+tmp_vy*tmp_vy+tmp_vz*tmp_vz)/v; - } - // no target or direction is nearly parallel to v: - if (vnorm<0.01) { - if (fabs(vx/v) < fabs(vz/v)) { - nx = 1; ny = 0; nz = 0; - } else { - nx = 0; ny = 0; nz = 1; - } - vec_prod(tmp_vx,tmp_vy,tmp_vz, vx,vy,vz, nx,ny,nz); - } - - /* v_out = rotate 'v' by 2*theta around tmp_v: Bragg angle */ - rotate(vout_x,vout_y,vout_z, vx,vy,vz, 2*sg*theta, tmp_vx,tmp_vy,tmp_vz); - - /* tmp_v = rotate v_out by alpha0 around 'v' (Debye-Scherrer cone) */ - rotate(tmp_vx,tmp_vy,tmp_vz, vout_x,vout_y,vout_z, alpha0, vx, vy, vz); - vx = tmp_vx; - vy = tmp_vy; - vz = tmp_vz; - - /* Since now scattered and new direction given, calculate path to exit */ - if (line_info.shape == 1) { - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - intersecti = box_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); - } else if (line_info.shape == 0) { - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); - intersecti = cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); - } else if (line_info.shape == 2) { - intersect = sphere_intersect (&t0, &t3, x,y,z, vx,vy,vz, radius); - intersecti = sphere_intersect (&t1, &t2, x,y,z, vx,vy,vz, line_info.radius_i); - } - #ifdef USE_OFF - else if (line_info.shape == 3) { - intersect = off_intersect (&t0, &t3, NULL, NULL, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); - intersecti = 0; - } - #endif - - if (!intersect) { - /* Strange error: did not hit cylinder */ - if (line_info.flag_warning < 10) - printf("PowderN: %s: WARNING: Did not hit sample from inside (coh). ABSORB.\n", NAME_CURRENT_COMP); - line_info.flag_warning++; - ABSORB; - } - - if (!intersecti) { - t1 = (t3 + t0) /2; - t2 = t1; - } - - if (concentric && intersecti) { - /* In case of concentricity, 'remove' backward wall of sample */ - t2 = t1; - t3 = t1; - } - - if(t0 < 0) t0=0; /* already in sample */ - if(t1 < 0) t1=0; /* already in inner hollow */ - if(t2 < 0) t2=0; /* already past inner hollow */ - - - l_1 = v*(t3 - t2 + t1 - t0); /* Length to exit */ - - pmul *= Nq*l_full*my_s_n *exp(-(line_info.my_a_v/v+my_s)*(l+l_1)) - /(1-(p_inc+p_transmit)); - - /* Correction in case of d_phi focusing - BUT only when d_phi != 0 */ - if (d_phi_thread) { - pmul *= alpha/PI; - if (tth_sign) pmul *=0.5; - } - - - type = 'c'; - itype = 1; - dq = line_info.q_v[line]*V2K; - lfree=1/(line_info.my_a_v/v+my_s); + + /* update JS, 1/7/2017 + If a target is defined, try to define vertical axis as a normal to the plane + defined by the incident neutron velocity and target position. + Check that v is not ~ parallel to the target direction. + */ + double vnorm = 0.0; + if (target_index) { + vec_prod (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, tgt_x, tgt_y, tgt_z); + vnorm = sqrt (tmp_vx * tmp_vx + tmp_vy * tmp_vy + tmp_vz * tmp_vz) / v; + } + // no target or direction is nearly parallel to v: + if (vnorm < 0.01) { + if (fabs (vx / v) < fabs (vz / v)) { + nx = 1; + ny = 0; + nz = 0; + } else { + nx = 0; + ny = 0; + nz = 1; + } + vec_prod (tmp_vx, tmp_vy, tmp_vz, vx, vy, vz, nx, ny, nz); + } + + /* v_out = rotate 'v' by 2*theta around tmp_v: Bragg angle */ + rotate (vout_x, vout_y, vout_z, vx, vy, vz, 2 * sg * theta, tmp_vx, tmp_vy, tmp_vz); + + /* tmp_v = rotate v_out by alpha0 around 'v' (Debye-Scherrer cone) */ + rotate (tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z, alpha0, vx, vy, vz); + vx = tmp_vx; + vy = tmp_vy; + vz = tmp_vz; + + /* Since now scattered and new direction given, calculate path to exit */ + if (line_info.shape == 1) { + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersecti = box_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); + } else if (line_info.shape == 0) { + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersecti = cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); + } else if (line_info.shape == 2) { + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); + intersecti = sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i); + } + #ifdef USE_OFF + else if (line_info.shape == 3) { + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); + intersecti = 0; + } + #endif + + if (!intersect) { + /* Strange error: did not hit cylinder */ + if (line_info.flag_warning < 10) + printf ("PowderN: %s: WARNING: Did not hit sample from inside (coh). ABSORB.\n", NAME_CURRENT_COMP); + line_info.flag_warning++; + ABSORB; + } + + if (!intersecti) { + t1 = (t3 + t0) / 2; + t2 = t1; + } + + if (concentric && intersecti) { + /* In case of concentricity, 'remove' backward wall of sample */ + t2 = t1; + t3 = t1; + } + + if (t0 < 0) + t0 = 0; /* already in sample */ + if (t1 < 0) + t1 = 0; /* already in inner hollow */ + if (t2 < 0) + t2 = 0; /* already past inner hollow */ + + l_1 = v * (t3 - t2 + t1 - t0); /* Length to exit */ + + pmul *= Nq * l_full * my_s_n * exp (-(line_info.my_a_v / v + my_s) * (l + l_1)) / (1 - (p_inc + p_transmit)); + + /* Correction in case of d_phi focusing - BUT only when d_phi != 0 */ + if (d_phi_thread) { + pmul *= alpha / PI; + if (tth_sign) + pmul *= 0.5; + } + + type = 'c'; + itype = 1; + dq = line_info.q_v[line] * V2K; + lfree = 1 / (line_info.my_a_v / v + my_s); } /* else transmit <-- No powder lines in file */ - } /* Coherent scattering event */ - else if (neutrontype == 2) { /* Make incoherent scattering event */ - if (d_omega && d_phi_thread) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - tgt_x, tgt_y, tgt_z, d_omega*DEG2RAD, d_phi_thread*DEG2RAD, ROT_A_CURRENT_COMP); - } else if (d_phi_thread) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - tgt_x, tgt_y, tgt_z, - 2*PI, d_phi_thread*DEG2RAD, ROT_A_CURRENT_COMP); + } /* Coherent scattering event */ + else if (neutrontype == 2) { /* Make incoherent scattering event */ + if (d_omega && d_phi_thread) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, tgt_x, tgt_y, tgt_z, d_omega * DEG2RAD, d_phi_thread * DEG2RAD, ROT_A_CURRENT_COMP); + } else if (d_phi_thread) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, tgt_x, tgt_y, tgt_z, 2 * PI, d_phi_thread * DEG2RAD, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, - &solid_angle, 0, 0, 1, 0); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, 0, 0, 1, 0); } - v1 = sqrt(vx*vx+vy*vy+vz*vz); - vx *= v/v1; - vy *= v/v1; - vz *= v/v1; + v1 = sqrt (vx * vx + vy * vy + vz * vz); + vx *= v / v1; + vy *= v / v1; + vz *= v / v1; /* Since now scattered and new direction given, calculate path to exit */ if (line_info.shape == 1) { - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); - intersecti = box_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersecti = box_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.xwidth_i, line_info.yheight_i, line_info.zdepth_i); } else if (line_info.shape == 0) { - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); - intersecti = cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersecti = cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i, line_info.yheight_i); } else if (line_info.shape == 2) { - intersect = sphere_intersect (&t0, &t3, x,y,z, vx,vy,vz, radius); - intersecti = sphere_intersect (&t1, &t2, x,y,z, vx,vy,vz, line_info.radius_i); + intersect = sphere_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius); + intersecti = sphere_intersect (&t1, &t2, x, y, z, vx, vy, vz, line_info.radius_i); } - #ifdef USE_OFF - else if (line_info.shape == 3) { - intersect = off_intersect (&t0, &t3, NULL, NULL, x,y,z, vx,vy,vz, 0, 0, 0, thread_offdata); + #ifdef USE_OFF + else if (line_info.shape == 3) { + intersect = off_intersect (&t0, &t3, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); intersecti = 0; } - #endif + #endif if (!intersect) { /* Strange error: did not hit cylinder */ if (line_info.flag_warning < 10) - printf("PowderN: %s: WARNING: Did not hit sample from inside (inc). ABSORB.\n", NAME_CURRENT_COMP); + printf ("PowderN: %s: WARNING: Did not hit sample from inside (inc). ABSORB.\n", NAME_CURRENT_COMP); line_info.flag_warning++; ABSORB; } if (!intersecti) { - t1 = (t3 + t0) /2; + t1 = (t3 + t0) / 2; t2 = t1; } @@ -1221,74 +1241,71 @@ TRACE t3 = t1; } - if(t0 < 0) t0=0; /* already in sample */ - if(t1 < 0) t1=0; /* already in inner hollow */ - if(t2 < 0) t2=0; /* already past inner hollow */ + if (t0 < 0) + t0 = 0; /* already in sample */ + if (t1 < 0) + t1 = 0; /* already in inner hollow */ + if (t2 < 0) + t2 = 0; /* already past inner hollow */ + l_1 = v * (t3 - t2 + t1 - t0); /* Length to exit */ - l_1 = v*(t3 - t2 + t1 - t0); /* Length to exit */ - - pmul *= l_full*line_info.my_inc*exp(-(line_info.my_a_v/v+my_s)*(l+l_1))/(p_inc); - pmul *= solid_angle/(4*PI); - lfree=1/(line_info.my_a_v/v+my_s); + pmul *= l_full * line_info.my_inc * exp (-(line_info.my_a_v / v + my_s) * (l + l_1)) / (p_inc); + pmul *= solid_angle / (4 * PI); + lfree = 1 / (line_info.my_a_v / v + my_s); type = 'i'; - itype = 2; + itype = 2; - } /* Incoherent scattering event */ + } /* Incoherent scattering event */ else if (neutrontype == 1) { /* Make transmitted (absorption-corrected) event */ /* No coordinate changes here, simply change neutron weight */ - pmul *= exp(-(line_info.my_a_v/v+my_s)*(l))/(p_transmit); - lfree=1/(line_info.my_a_v/v+my_s); + pmul *= exp (-(line_info.my_a_v / v + my_s) * (l)) / (p_transmit); + lfree = 1 / (line_info.my_a_v / v + my_s); type = 't'; - itype = 3; + itype = 3; } p *= pmul; } /* Neutron leaving since it has passed already */ } /* else transmit non interacting neutrons */ - + // Inject these back to global struct in non-OpenACC case #ifndef OPENACC - line_info.nb_reuses=nb_reuses; - line_info.nb_refl=nb_refl; - line_info.nb_refl_count=nb_refl_count; - line_info.v=vcache; - line_info.Nq=Nq; - line_info.v_min=v_min; - line_info.v_max=v_max; - line_info.lfree=lfree; - line_info.xs_compute=xs_compute; - line_info.xs_reuse=xs_reuse; - line_info.xs_calls=xs_calls; - line_info.dq=dq; + line_info.nb_reuses = nb_reuses; + line_info.nb_refl = nb_refl; + line_info.nb_refl_count = nb_refl_count; + line_info.v = vcache; + line_info.Nq = Nq; + line_info.v_min = v_min; + line_info.v_max = v_max; + line_info.lfree = lfree; + line_info.xs_compute = xs_compute; + line_info.xs_reuse = xs_reuse; + line_info.xs_calls = xs_calls; + line_info.dq = dq; #endif - %} FINALLY %{ - free(line_info.list); - free(line_info.q_v); - free(line_info.w_v); - free(line_info.my_s_v2); - MPI_MASTER( - if (line_info.flag_warning) - printf("PowderN: %s: Error messages were repeated %i times with absorbed neutrons.\n", - NAME_CURRENT_COMP, line_info.flag_warning); - - /* in case this instance is used in a SPLIT, we can recommend the - optimal iteration value */ - if (line_info.nb_refl_count) { - double split_iterations = (double)line_info.nb_reuses/line_info.nb_refl_count + 1; - double split_optimal = (double)line_info.nb_refl/line_info.nb_refl_count; - if (split_optimal > split_iterations + 5) - printf("PowderN: %s: Info: you may highly improve the computation efficiency by using\n" - " SPLIT %i COMPONENT %s=PowderN(...)\n" - " in the instrument description %s.\n", - NAME_CURRENT_COMP, (int)split_optimal, NAME_CURRENT_COMP, instrument_source); - } - ); - + free (line_info.list); + free (line_info.q_v); + free (line_info.w_v); + free (line_info.my_s_v2); + MPI_MASTER (if (line_info.flag_warning) + printf ("PowderN: %s: Error messages were repeated %i times with absorbed neutrons.\n", NAME_CURRENT_COMP, line_info.flag_warning); + + /* in case this instance is used in a SPLIT, we can recommend the + optimal iteration value */ + if (line_info.nb_refl_count) { + double split_iterations = (double)line_info.nb_reuses / line_info.nb_refl_count + 1; + double split_optimal = (double)line_info.nb_refl / line_info.nb_refl_count; + if (split_optimal > split_iterations + 5) + printf ("PowderN: %s: Info: you may highly improve the computation efficiency by using\n" + " SPLIT %i COMPONENT %s=PowderN(...)\n" + " in the instrument description %s.\n", + NAME_CURRENT_COMP, (int)split_optimal, NAME_CURRENT_COMP, instrument_source); + }); %} MCDISPLAY @@ -1296,75 +1313,60 @@ MCDISPLAY if (line_info.V_0) { if (line_info.shape == 0) { /* cyl */ - 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); + 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); if (thickness) { - double radius_i=radius-thickness; - circle("xz", 0, yheight/2.0, 0, radius_i); - circle("xz", 0, -yheight/2.0, 0, radius_i); - line(-radius_i, -yheight/2.0, 0, -radius_i, +yheight/2.0, 0); - line(+radius_i, -yheight/2.0, 0, +radius_i, +yheight/2.0, 0); - line(0, -yheight/2.0, -radius_i, 0, +yheight/2.0, -radius_i); - line(0, -yheight/2.0, +radius_i, 0, +yheight/2.0, +radius_i); + double radius_i = radius - thickness; + circle ("xz", 0, yheight / 2.0, 0, radius_i); + circle ("xz", 0, -yheight / 2.0, 0, radius_i); + line (-radius_i, -yheight / 2.0, 0, -radius_i, +yheight / 2.0, 0); + line (+radius_i, -yheight / 2.0, 0, +radius_i, +yheight / 2.0, 0); + line (0, -yheight / 2.0, -radius_i, 0, +yheight / 2.0, -radius_i); + line (0, -yheight / 2.0, +radius_i, 0, +yheight / 2.0, +radius_i); } - } else if (line_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 (line_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); if (line_info.zdepth_i) { - xmin = -0.5*line_info.xwidth_i; - xmax = 0.5*line_info.xwidth_i; - ymin = -0.5*line_info.yheight_i; - ymax = 0.5*line_info.yheight_i; - zmin = -0.5*line_info.zdepth_i; - zmax = 0.5*line_info.zdepth_i; - 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); + xmin = -0.5 * line_info.xwidth_i; + xmax = 0.5 * line_info.xwidth_i; + ymin = -0.5 * line_info.yheight_i; + ymax = 0.5 * line_info.yheight_i; + zmin = -0.5 * line_info.zdepth_i; + zmax = 0.5 * line_info.zdepth_i; + 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 (line_info.shape == 2) { /* sphere */ + } + if (line_info.shape == 2) { /* sphere */ if (line_info.radius_i) { - circle("xy",0,0,0,line_info.radius_i); - circle("xz",0,0,0,line_info.radius_i); - circle("yz",0,0,0,line_info.radius_i); + circle ("xy", 0, 0, 0, line_info.radius_i); + circle ("xz", 0, 0, 0, line_info.radius_i); + circle ("yz", 0, 0, 0, line_info.radius_i); } - circle("xy",0,0,0,radius); - circle("xz",0,0,0,radius); - circle("yz",0,0,0,radius); - } else if (line_info.shape == 3) { /* OFF file */ - off_display(offdata); + circle ("xy", 0, 0, 0, radius); + circle ("xz", 0, 0, 0, radius); + circle ("yz", 0, 0, 0, radius); + } else if (line_info.shape == 3) { /* OFF file */ + off_display (offdata); } } %} diff --git a/mcstas-comps/samples/SANS_spheres2.comp b/mcstas-comps/samples/SANS_spheres2.comp index 3e79bf8e81..8dead0a0df 100644 --- a/mcstas-comps/samples/SANS_spheres2.comp +++ b/mcstas-comps/samples/SANS_spheres2.comp @@ -59,43 +59,60 @@ SETTING PARAMETERS (xwidth=0.01, yheight=0.01, zthick=0.001, dsdw_inc=0.02, sc_a SHARE %{ -#pragma acc routine seq -double Min(double A, double B) { -if (AB) return A; else return B; -}; - -#pragma acc routine seq -int IMin(int A, int B) { -if (AB) return A; else return B; -}; - -#pragma acc routine seq - double dSigdW(double Q, double R, double phi, double drho) { - - double out; - double G; - double qR; - - qR = Q*R; - G = (drho*drho*phi*4e-24*PI*R*R*R/3.0); /* 4 is from sphere volume, 1e-24 is AA^3->cm^3 */ - - /* Note that for very small q, we should rather do a Taylor expansion here. - - See H. Frielinghaus mail to PW, WGB from Dec. 18th 2019 */ - out = 3.0*(sin(qR)-qR*cos(qR))/(qR*qR*qR); - out *= G * out; - - return out; -} + #pragma acc routine seq + double + Min (double A, double B) { + if (A < B) + return A; + else + return B; + }; + + #pragma acc routine seq + double + Max (double A, double B) { + if (A > B) + return A; + else + return B; + }; + + #pragma acc routine seq + int + IMin (int A, int B) { + if (A < B) + return A; + else + return B; + }; + + #pragma acc routine seq + int + IMax (int A, int B) { + if (A > B) + return A; + else + return B; + }; + + #pragma acc routine seq + double + dSigdW (double Q, double R, double phi, double drho) { + + double out; + double G; + double qR; + + qR = Q * R; + G = (drho * drho * phi * 4e-24 * PI * R * R * R / 3.0); /* 4 is from sphere volume, 1e-24 is AA^3->cm^3 */ + + /* Note that for very small q, we should rather do a Taylor expansion here. + - See H. Frielinghaus mail to PW, WGB from Dec. 18th 2019 */ + out = 3.0 * (sin (qR) - qR * cos (qR)) / (qR * qR * qR); + out *= G * out; + + return out; + } %} @@ -103,262 +120,255 @@ DECLARE %{ DArray1d Idsdw; double Qminl; - double Qmaxl; - double l10; /* logarithms of Qmind, Qmaxd and constant ln(10) */ + double Qmaxl; + double l10; /* logarithms of Qmind, Qmaxd and constant ln(10) */ double p0; %} INITIALIZE %{ - if (!xwidth || !yheight || !zthick) - { - exit(fprintf(stderr,"%s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + if (!xwidth || !yheight || !zthick) { + exit (fprintf (stderr, "%s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); } - int iii,kkk; + int iii, kkk; - Qminl = log10(Qmind); - Qmaxl = log10(Qmaxd); - l10 = log(10.00); + Qminl = log10 (Qmind); + Qmaxl = log10 (Qmaxd); + l10 = log (10.00); - double q,Isq; - double qmin,qmax,step; - int istp; + double q, Isq; + double qmin, qmax, step; + int istp; - istp = floor((Qmaxl-Qminl)*300.0+0.5); + istp = floor ((Qmaxl - Qminl) * 300.0 + 0.5); - Idsdw = create_darr1d(31); + Idsdw = create_darr1d (31); /* By integration, calculate the coherent scattering cross-section for the relevant wavelength range */ - for (iii=1;iii<=30;iii++) { /* wavelength in AA, up to 30 */ + for (iii = 1; iii <= 30; iii++) { /* wavelength in AA, up to 30 */ Idsdw[iii] = 0.0; - Isq = 0.0; + Isq = 0.0; qmin = 0.0; - step = (log10(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(q,R,phi,drho)*q*(qmax-qmin); + step = (log10 (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 (q, R, phi, drho) * q * (qmax - qmin); qmin = qmax; }; - Idsdw[iii]= Isq; + Idsdw[iii] = Isq; }; - %} TRACE %{ - double v,k0,lambda; - int Ilam,Ilam2; - double qmax,qmaxl,Ymax,Xmax,thmax; + double v, k0, lambda; + int Ilam, Ilam2; + double qmax, qmaxl, Ymax, Xmax, thmax; /* Wavelength-dependent cross-section variables for cross-section terms */ double Scoh, Sinc1, Sinc2, Stot; - - double rcut,fcut; + + double rcut, fcut; double Q, Xsc, theta; - int iscatt; + int iscatt; - char intersect; + char intersect; double t0, t1, dt, phiROT; double axis_x, axis_y, axis_z; double tmp_vx, tmp_vy, tmp_vz, vout_x, vout_y, vout_z; /* Initial neutron weight saved for later */ - p0=p; + p0 = p; /* Number of scatterings in sample - limit at 10 below */ iscatt = 0; - 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; - Ilam = IMax(floor(lambda),1); - Ilam2 = IMin(Ilam+1,30); + Ilam = IMax (floor (lambda), 1); + Ilam2 = IMin (Ilam + 1, 30); /* Coherent "SANS" scattering - in 3 intervals, asymptotic values at the low and high WL end */ - if (lambda<=1.0) Scoh = 200.0*PI*Idsdw[1] / (k0*k0); + if (lambda <= 1.0) + Scoh = 200.0 * PI * Idsdw[1] / (k0 * k0); else { - if (lambda>=30.0) Scoh = 200.0*PI*Idsdw[30] / (k0*k0); - else Scoh = 200.0*PI*((Ilam2-lambda)*Idsdw[Ilam]+(lambda-Ilam)*Idsdw[Ilam2]) / (k0*k0); + if (lambda >= 30.0) + Scoh = 200.0 * PI * Idsdw[30] / (k0 * k0); + else + Scoh = 200.0 * PI * ((Ilam2 - lambda) * Idsdw[Ilam] + (lambda - Ilam) * Idsdw[Ilam2]) / (k0 * k0); }; /* Scattering triangle consideration, limit to lowes of either Qmind or double initial k0 value */ - qmax = Min(Qmaxd,2.0*k0); - qmaxl = log10(qmax); - - Ymax = 0.25*qmax*qmax/(k0*k0); + qmax = Min (Qmaxd, 2.0 * k0); + qmaxl = log10 (qmax); + + Ymax = 0.25 * qmax * qmax / (k0 * k0); /* Maximal relative scale between q and k0 */ - if (Ymax>=0.9999) Ymax=1.0; /* if rounding errors occurr, this will help to avoid problems */ - Xmax = 1.0 - 2.0*Ymax; + if (Ymax >= 0.9999) + Ymax = 1.0; /* if rounding errors occurr, this will help to avoid problems */ + Xmax = 1.0 - 2.0 * Ymax; /* Maximal scattering angle for SANS signal */ - thmax = acos(Xmax); - + thmax = acos (Xmax); + /* Inchoherent "forward" scattering */ - Sinc1 = 100.0*PI*( qmax*qmax/(k0*k0)) * fabs(dsdw_inc); + Sinc1 = 100.0 * PI * (qmax * qmax / (k0 * k0)) * fabs (dsdw_inc); /* non-directional incoherent scattering */ - Sinc2 = 100.0*PI*(4.0-qmax*qmax/(k0*k0)) * fabs(dsdw_inc); + Sinc2 = 100.0 * PI * (4.0 - qmax * qmax / (k0 * k0)) * fabs (dsdw_inc); /* - that result in the total scattering cross-section */ - Stot = Sinc1 + Sinc2 + Scoh; - + Stot = Sinc1 + Sinc2 + Scoh; + /* Check for intersections with sample */ - 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); /* Are we hitting and does cross-section have finite value? */ - if (intersect && Stot>0.0) { + if (intersect && Stot > 0.0) { /* Kill neutron if it already entered sample volume */ - if(t0<0.0) ABSORB; + if (t0 < 0.0) + ABSORB; /* Using total XS, check if we should scatter coherently here or transmit. Partition statistics accordingly. */ - rcut = exp(-Stot*(t1-t0)*v); + rcut = exp (-Stot * (t1 - t0) * v); /* Sample scattering position logarithmically */ - if (1.0-rcut > sc_aim) { - dt = -1.0/(v*Stot)*log(rand01()); + if (1.0 - rcut > sc_aim) { + dt = -1.0 / (v * Stot) * log (rand01 ()); } else { - if (rand01()<=sc_aim) { - dt = -1.0/(v*Stot)*log(1.0-(1.0-rcut)*rand01()); - p *= (1.0-rcut)/sc_aim; - } - else { - /* Transmit this guy */ - dt = -1.0/(v*Stot)*log(rcut*rand01()); - dt = 1e33; /* run out of sample ... */ - p *= rcut/(1.0-sc_aim); + if (rand01 () <= sc_aim) { + dt = -1.0 / (v * Stot) * log (1.0 - (1.0 - rcut) * rand01 ()); + p *= (1.0 - rcut) / sc_aim; + } else { + /* Transmit this guy */ + dt = -1.0 / (v * Stot) * log (rcut * rand01 ()); + dt = 1e33; /* run out of sample ... */ + p *= rcut / (1.0 - sc_aim); }; }; - + /* Based on time-logic, define if we should treat the neutron or not */ - if (t0+dt<=t1) { - PROP_DT(t0+dt); + if (t0 + dt <= t1) { + PROP_DT (t0 + dt); SCATTER; iscatt = 1; /* Partition statistics according to "SANS" vs. incoherent scattering */ - fcut = Max(Ymax,sans_aim); + fcut = Max (Ymax, sans_aim); /* Scatter SANS or not */ - if (rand01()<=fcut) { - /* Pick a random Q in the SANS regime - logarithmic sampling */ - Q = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); - double dsdw; - dsdw=dSigdW(Q,R,phi,drho); - p *= 200.0*PI*Q*Q/(k0*k0)*(qmaxl-Qminl)*l10*(dsdw+fabs(dsdw_inc))/(Stot*fcut); - Xsc = 1.0 - 0.5*(Q*Q/(k0*k0)); - /* Scattering angle */ - theta = 2.0 * asin(0.5*Q/k0); + if (rand01 () <= fcut) { + /* Pick a random Q in the SANS regime - logarithmic sampling */ + Q = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + double dsdw; + dsdw = dSigdW (Q, R, phi, drho); + p *= 200.0 * PI * Q * Q / (k0 * k0) * (qmaxl - Qminl) * l10 * (dsdw + fabs (dsdw_inc)) / (Stot * fcut); + Xsc = 1.0 - 0.5 * (Q * Q / (k0 * k0)); + /* Scattering angle */ + theta = 2.0 * asin (0.5 * Q / k0); } else { - /* Random Q for the incoherent case */ - Xsc = -1.0 + (Xmax+1.0)*rand01(); - p *= (1.0-Ymax)/(1.0-fcut); - /* Scattering angle */ - theta = acos(Xsc); + /* Random Q for the incoherent case */ + Xsc = -1.0 + (Xmax + 1.0) * rand01 (); + p *= (1.0 - Ymax) / (1.0 - fcut); + /* Scattering angle */ + theta = acos (Xsc); } /* Azimuthal-symmetrical angle */ - phiROT = 2.0*PI*rand01(); + phiROT = 2.0 * PI * rand01 (); /* vector product between \vec{v} and vertical */ - vec_prod(axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); + vec_prod (axis_x, axis_y, axis_z, vx, vy, vz, 0, 1, 0); /* apply the two rotations from above */ - 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, phiROT, vx, vy, vz); + 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, phiROT, vx, vy, vz); vx = vout_x; vy = vout_y; vz = vout_z; /* Check if we should do multiple scattering (still) */ - while (iscatt<10 && singlesp==0) { + while (iscatt < 10 && singlesp == 0) { - /* re-intersect component geometry */ - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); - if (!intersect) ABSORB; + /* re-intersect component geometry */ + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zthick); + if (!intersect) + ABSORB; - /* Logarithmic sampling in time according to Xsect */ - dt = -1.0/(v*Stot)*log(rand01()); + /* Logarithmic sampling in time according to Xsect */ + dt = -1.0 / (v * Stot) * log (rand01 ()); - /* Still inside the sample? */ - if (dt<=t1) { + /* Still inside the sample? */ + if (dt <= t1) { - /* Propagate and scatter */ - PROP_DT(dt); + /* Propagate and scatter */ + PROP_DT (dt); SCATTER; iscatt++; - /* Apply the same weighting and logic scheme as for single-scattering above */ - fcut = Max(Ymax,sans_aim); - - if (rand01()<=fcut) { - Q = pow(10.0,Qminl+(qmaxl-Qminl)*rand01()); - double dsdw; - dsdw=dSigdW(Q,R,phi,drho); - p *= 200.0*PI*Q*Q/(k0*k0)*(qmaxl-Qminl)*l10*(dsdw+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); - }; - - phiROT = 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, phiROT, vx, vy, vz); + /* Apply the same weighting and logic scheme as for single-scattering above */ + fcut = Max (Ymax, sans_aim); + + if (rand01 () <= fcut) { + Q = pow (10.0, Qminl + (qmaxl - Qminl) * rand01 ()); + double dsdw; + dsdw = dSigdW (Q, R, phi, drho); + p *= 200.0 * PI * Q * Q / (k0 * k0) * (qmaxl - Qminl) * l10 * (dsdw + 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); + }; + + phiROT = 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, phiROT, vx, vy, vz); vx = vout_x; vy = vout_y; vz = vout_z; - } - else break; /* Not in the sample any longer */ + } else + break; /* Not in the sample any longer */ }; /* Final propagation to last "edge" of the sample box */ - 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); /* Time dt was long enough that we already passed the sample */ + PROP_DT (t1); /* Time dt was long enough that we already passed the sample */ }; }; - %} 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/samples/Sans_spheres.comp b/mcstas-comps/samples/Sans_spheres.comp index 08146cdbcf..58aa212310 100644 --- a/mcstas-comps/samples/Sans_spheres.comp +++ b/mcstas-comps/samples/Sans_spheres.comp @@ -69,96 +69,96 @@ focus_xw=0, focus_yh=0, focus_aw=0, focus_ah=0, focus_r=0) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ DECLARE %{ -double my_s_pre; -double my_a_v; -double shape; + double my_s_pre; + double my_a_v; + double shape; %} INITIALIZE %{ -shape=-1; /* -1:no shape, 0:cyl, 1:box, 2:sphere */ -if (xwidth && yheight && zdepth) shape=1; /* box */ - else if (radius > 0 && yheight) shape=0; /* cylinder */ - else if (radius > 0 && !yheight) shape=2; /* sphere */ + shape = -1; /* -1:no shape, 0:cyl, 1:box, 2:sphere */ + if (xwidth && yheight && zdepth) + shape = 1; /* box */ + else if (radius > 0 && yheight) + shape = 0; /* cylinder */ + else if (radius > 0 && !yheight) + shape = 2; /* sphere */ if (shape < 0) - exit(fprintf(stderr,"Sans_spheres: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values.\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "Sans_spheres: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values.\n", + NAME_CURRENT_COMP)); /* now compute target coords if a component index is supplied */ - if (!target_index && !target_x && !target_y && !target_z) target_index=1; - if (target_index) - { + if (!target_index && !target_x && !target_y && !target_z) + target_index = 1; + 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, &target_x, &target_y, &target_z); + 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, &target_x, &target_y, &target_z); } if (!(target_x || target_y || target_z)) { - printf("Sans_spheres: %s: The target is not defined. Using direct beam (Z-axis).\n", - NAME_CURRENT_COMP); - target_z=1; + printf ("Sans_spheres: %s: The target is not defined. Using direct beam (Z-axis).\n", NAME_CURRENT_COMP); + target_z = 1; } - my_a_v = sigma_abs*2200; /* Is not yet divided by v.*/ - - my_s_pre = Phi * 4*PI*R*R*R/3 * Delta_rho*Delta_rho; + my_a_v = sigma_abs * 2200; /* Is not yet divided by v.*/ + my_s_pre = Phi * 4 * PI * R * R * R / 3 * Delta_rho * Delta_rho; %} TRACE %{ double t0, t1, v, l_full, l, l_1, dt, my_s; - double aim_x=0, aim_y=0, aim_z=1; - double f, solid_angle, vx_i, vy_i, vz_i, qx, qy, qz,q; - char intersect=0; + double aim_x = 0, aim_y = 0, aim_z = 1; + double f, solid_angle, vx_i, vy_i, vz_i, qx, qy, qz, q; + char intersect = 0; /* Intersection neutron trajectory / sample (sample surface) */ if (shape == 0) - intersect = cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius, yheight); else if (shape == 1) - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else if (shape == 2) - intersect = sphere_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius); - if(intersect) - { - if(t0 < 0) + intersect = sphere_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius); + 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 */ + 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; + vx_i = vx; + vy_i = vy; + vz_i = vz; if ((target_x || target_y || target_z)) { - aim_x = target_x-x; /* Vector pointing at target (anal./det.) */ - aim_y = target_y-y; - aim_z = target_z-z; + aim_x = target_x - x; /* Vector pointing at target (anal./det.) */ + aim_y = target_y - y; + aim_z = target_z - z; } - if(focus_aw && focus_ah) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, focus_aw, focus_ah, ROT_A_CURRENT_COMP); - } else if(focus_xw && focus_yh) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, focus_xw, focus_yh, ROT_A_CURRENT_COMP); + if (focus_aw && focus_ah) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_aw, focus_ah, ROT_A_CURRENT_COMP); + } else if (focus_xw && focus_yh) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_xw, focus_yh, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); } - NORM(vx, vy, vz); + 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); + f = 3 * (sin (q * R) - q * R * cos (q * R)) / (q * R * q * R * q * R); - double pmul=l_full*solid_angle/(4*PI)*my_s_pre*f*f*exp(-(my_a_v/v)*l_full); + double pmul = l_full * solid_angle / (4 * PI) * my_s_pre * f * f * exp (-(my_a_v / v) * l_full); p = p * pmul; SCATTER; } @@ -166,41 +166,31 @@ TRACE MCDISPLAY %{ - - if (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 (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 (shape == 2) { /* sphere */ - circle("xy", 0, 0.0, 0, radius); - circle("xz", 0, 0.0, 0, radius); - circle("yz", 0, 0.0, 0, radius); + + if (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 (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 (shape == 2) { /* sphere */ + circle ("xy", 0, 0.0, 0, radius); + circle ("xz", 0, 0.0, 0, radius); + circle ("yz", 0, 0.0, 0, radius); } %} END diff --git a/mcstas-comps/samples/SasView_model.comp b/mcstas-comps/samples/SasView_model.comp index c75396fd31..0791c692d8 100644 --- a/mcstas-comps/samples/SasView_model.comp +++ b/mcstas-comps/samples/SasView_model.comp @@ -2193,119 +2193,119 @@ DECLARE INITIALIZE %{ - -int chosen=model_index; -#ifndef SASmodel_index - exit(fprintf(stderr, "SasView_model: %s: Your instrument was compiled without the define -DSASmodel_index \n" - "ERROR Please recompile your instrument with -DSASmodel_index=%i to enable model_index=%i.\n", NAME_CURRENT_COMP, chosen, chosen)); -#else - if (!(SASmodel_index==model_index)) { - exit(fprintf(stderr, "SasView_model: %s: Your instrument was compiled with -DSASmodel_index=%i \n" - "ERROR Please recompile your instrument with -DSASmodel_index=%i to enable model_index=%i\n", NAME_CURRENT_COMP, SASmodel_index, chosen, chosen)); -// int SASmodel_index=model_index; -} -#endif - -shape=-1; /* -1:no shape, 0:cyl, 1:box, 2:sphere */ -if (xwidth && yheight && zdepth) - shape=1; + int chosen = model_index; + #ifndef SASmodel_index + exit (fprintf (stderr, + "SasView_model: %s: Your instrument was compiled without the define -DSASmodel_index \n" + "ERROR Please recompile your instrument with -DSASmodel_index=%i to enable model_index=%i.\n", + NAME_CURRENT_COMP, chosen, chosen)); + #else + if (!(SASmodel_index == model_index)) { + exit (fprintf (stderr, + "SasView_model: %s: Your instrument was compiled with -DSASmodel_index=%i \n" + "ERROR Please recompile your instrument with -DSASmodel_index=%i to enable model_index=%i\n", + NAME_CURRENT_COMP, SASmodel_index, chosen, chosen)); + + // int SASmodel_index=model_index; + } + #endif + + shape = -1; /* -1:no shape, 0:cyl, 1:box, 2:sphere */ + if (xwidth && yheight && zdepth) + shape = 1; else if (radius > 0 && yheight) - shape=0; + shape = 0; else if (radius > 0 && !yheight) - shape=2; + shape = 2; if (shape < 0) - exit(fprintf(stderr, "SasView_model: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values.\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "SasView_model: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values.\n", + NAME_CURRENT_COMP)); /* now compute target coords if a component index is supplied */ - if (!target_index && !target_x && !target_y && !target_z) target_index=1; - if (target_index) - { + if (!target_index && !target_x && !target_y && !target_z) + target_index = 1; + 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, &target_x, &target_y, &target_z); + 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, &target_x, &target_y, &target_z); } if (!(target_x || target_y || target_z)) { - printf("SasView_model: %s: The target is not defined. Using direct beam (Z-axis).\n", - NAME_CURRENT_COMP); - target_z=1; + printf ("SasView_model: %s: The target is not defined. Using direct beam (Z-axis).\n", NAME_CURRENT_COMP); + target_z = 1; } - my_a_v = model_abs*2200*100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ + my_a_v = model_abs * 2200 * 100; /* Is not yet divided by v. 100: Convert barns -> fm^2 */ int j; - for(j=0;j<15;j++){ - modelpars[j]=model_pars[j]; + for (j = 0; j < 15; j++) { + modelpars[j] = model_pars[j]; } - - %} TRACE %{ double t0, t1, v, l_full, l, l_1, dt, d_phi, theta, my_s; - double aim_x=0, aim_y=0, aim_z=1, axis_x, axis_y, axis_z; + double aim_x = 0, aim_y = 0, aim_z = 1, 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, q, qx, qy, qz; - char intersect=0; + char intersect = 0; /* Intersection neutron trajectory / sample (sample surface) */ if (shape == 0) - intersect = cylinder_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius, yheight); else if (shape == 1) - intersect = box_intersect(&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t0, &t1, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else if (shape == 2) - intersect = sphere_intersect(&t0, &t1, x, y, z, vx, vy, vz, radius); - if(intersect) - { - if(t0 < 0) + intersect = sphere_intersect (&t0, &t1, x, y, z, vx, vy, vz, radius); + if (intersect) { + if (t0 < 0) ABSORB; /* Neutron enters at t=t0. */ - v = sqrt(vx*vx + vy*vy + vz*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 */ + 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; + vx_i = vx; + vy_i = vy; + vz_i = vz; if ((target_x || target_y || target_z)) { - aim_x = target_x-x; /* Vector pointing at target (anal./det.) */ - aim_y = target_y-y; - aim_z = target_z-z; + aim_x = target_x - x; /* Vector pointing at target (anal./det.) */ + aim_y = target_y - y; + aim_z = target_z - z; } - if(focus_aw && focus_ah) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, focus_aw, focus_ah, ROT_A_CURRENT_COMP); - } else if(focus_xw && focus_yh) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, focus_xw, focus_yh, ROT_A_CURRENT_COMP); + if (focus_aw && focus_ah) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_aw, focus_ah, ROT_A_CURRENT_COMP); + } else if (focus_xw && focus_yh) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_xw, focus_yh, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); } - NORM(vx, vy, vz); + 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); float Iq_out; - Iq_out = getIq(q, qx, qy, modelpars); + Iq_out = getIq (q, qx, qy, modelpars); float vol; - vol=getFormVol(modelpars); + vol = getFormVol (modelpars); // Scale by 1.0E2 [SasView: 1/cm -> McStas: 1/m] - Iq_out = model_scale*Iq_out / vol * 1.0E2; + Iq_out = model_scale * Iq_out / vol * 1.0E2; - l_1 = v*t1; - p *= l_full*solid_angle/(4*PI)*Iq_out*exp(-my_a_v*(l+l_1)/v); + l_1 = v * t1; + p *= l_full * solid_angle / (4 * PI) * Iq_out * exp (-my_a_v * (l + l_1) / v); SCATTER; } @@ -2314,40 +2314,30 @@ TRACE MCDISPLAY %{ - if (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 (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 (shape == 2) { /* sphere */ - circle("xy", 0, 0.0, 0, radius); - circle("xz", 0, 0.0, 0, radius); - circle("yz", 0, 0.0, 0, radius); + if (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 (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 (shape == 2) { /* sphere */ + circle ("xy", 0, 0.0, 0, radius); + circle ("xz", 0, 0.0, 0, radius); + circle ("yz", 0, 0.0, 0, radius); } %} END diff --git a/mcstas-comps/samples/Single_crystal.comp b/mcstas-comps/samples/Single_crystal.comp index ecb9e553b4..964c331c17 100644 --- a/mcstas-comps/samples/Single_crystal.comp +++ b/mcstas-comps/samples/Single_crystal.comp @@ -297,395 +297,406 @@ deltak=1e-6) /* Neutron parameters: (x,y,z,vx,vy,vz,t,sx,sy,sz,p) */ SHARE %{ -/* used for reading data table from file */ -%include "read_table-lib" -%include "interoff-lib" -#ifndef OPENACC - %include "opencl-lib" -#endif -/* Declare structures and functions only once in each instrument. */ -#ifndef SINGLE_CRYSTAL_DECL -#define SINGLE_CRYSTAL_DECL - -#ifndef Mosaic_AB_Undefined -#define Mosaic_AB_Undefined {0,0, 0,0,0, 0,0,0} -#endif - -#ifndef MCSX_REFL_SLIST_SIZE -#define MCSX_REFL_SLIST_SIZE 128 -#endif - -struct hkl_data -{ - int h,k,l; /* Indices for this reflection */ - double F2; /* Value of structure factor */ - double tau_x, tau_y, tau_z; /* Coordinates in reciprocal space */ - double tau; /* Length of (tau_x, tau_y, tau_z) */ - double u1x, u1y, u1z; /* First axis of local coordinate system */ - double u2x, u2y, u2z; /* Second axis of local coordinate system */ - double u3x, u3y, u3z; /* Third axis of local coordinate system */ - double sig123; /* The product sig1*sig2*sig3 = volume of spot */ - double m1, m2, m3; /* Diagonal matrix representation of Gauss */ - double cutoff; /* Cutoff value for Gaussian tails */ - }; + /* used for reading data table from file */ + %include "read_table-lib" + %include "interoff-lib" + #ifndef OPENACC + %include "opencl-lib" + #endif + /* Declare structures and functions only once in each instrument. */ + #ifndef SINGLE_CRYSTAL_DECL + #define SINGLE_CRYSTAL_DECL - struct tau_data - { - int index; /* Index into reflection table */ - double refl; - double xsect; - /* The following vectors are in local koordinates. */ - double rho_x, rho_y, rho_z; /* The vector ki - tau */ - double rho; /* Length of rho vector */ - double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ - double b1x, b1y, b1z; /* Spanning vectors of Ewald sphere tangent */ - double b2x, b2y, b2z; - double l11, l12, l22; /* Cholesky decomposition L of 2D Gauss */ - double y0x, y0y; /* 2D Gauss center in tangent plane */ - }; + #ifndef Mosaic_AB_Undefined + #define Mosaic_AB_Undefined {0,0, 0,0,0, 0,0,0} + #endif - struct hkl_info_struct - { - 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 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 */ - int flag_barns; /* 1: F2 in barns, 0: in fm^2 */ - char type; /* type of last event: t=transmit,c=coherent or i=incoherent */ - int h,k,l; /* last coherent scattering momentum transfer indices */ - int tau_count; /* Number of reflections within cutoff */ - double coh_refl, coh_xsect; /* cross section computed with last tau_list */ - double kix, kiy, kiz; /* last incoming neutron ki */ - int nb_reuses, nb_refl, nb_refl_count; - int max_tau_count; - }; -#pragma acc routine - int SX_list_compare (void const *a, void const *b) - { - struct hkl_data const *pa = a; - struct hkl_data const *pb = b; + #ifndef MCSX_REFL_SLIST_SIZE + #define MCSX_REFL_SLIST_SIZE 128 + #endif + + struct hkl_data { + int h, k, l; /* Indices for this reflection */ + double F2; /* Value of structure factor */ + double tau_x, tau_y, tau_z; /* Coordinates in reciprocal space */ + double tau; /* Length of (tau_x, tau_y, tau_z) */ + double u1x, u1y, u1z; /* First axis of local coordinate system */ + double u2x, u2y, u2z; /* Second axis of local coordinate system */ + double u3x, u3y, u3z; /* Third axis of local coordinate system */ + double sig123; /* The product sig1*sig2*sig3 = volume of spot */ + double m1, m2, m3; /* Diagonal matrix representation of Gauss */ + double cutoff; /* Cutoff value for Gaussian tails */ + }; + + struct tau_data { + int index; /* Index into reflection table */ + double refl; + double xsect; + /* The following vectors are in local koordinates. */ + double rho_x, rho_y, rho_z; /* The vector ki - tau */ + double rho; /* Length of rho vector */ + double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ + double b1x, b1y, b1z; /* Spanning vectors of Ewald sphere tangent */ + double b2x, b2y, b2z; + double l11, l12, l22; /* Cholesky decomposition L of 2D Gauss */ + double y0x, y0y; /* 2D Gauss center in tangent plane */ + }; + + struct hkl_info_struct { + 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 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 */ + int flag_barns; /* 1: F2 in barns, 0: in fm^2 */ + char type; /* type of last event: t=transmit,c=coherent or i=incoherent */ + int h, k, l; /* last coherent scattering momentum transfer indices */ + int tau_count; /* Number of reflections within cutoff */ + double coh_refl, coh_xsect; /* cross section computed with last tau_list */ + double kix, kiy, kiz; /* last incoming neutron ki */ + int nb_reuses, nb_refl, nb_refl_count; + int max_tau_count; + }; + #pragma acc routine + int + SX_list_compare (void const* a, void const* b) { + struct hkl_data const* pa = a; + struct hkl_data const* pb = b; /* Sort by tau */ - if (pa->tau < pb->tau) return -1; - if (pa->tau > pb->tau) return 1; + if (pa->tau < pb->tau) + return -1; + if (pa->tau > pb->tau) + return 1; /* Sort by tau_x */ - if (pa->tau_x < pb->tau_x) return -1; - if (pa->tau_x > pb->tau_x) return 1; + if (pa->tau_x < pb->tau_x) + return -1; + if (pa->tau_x > pb->tau_x) + return 1; /* Sort by tau_y */ - if (pa->tau_y < pb->tau_y) return -1; - if (pa->tau_y > pb->tau_y) return 1; + if (pa->tau_y < pb->tau_y) + return -1; + if (pa->tau_y > pb->tau_y) + return 1; /* Sort by tau_z */ - if (pa->tau_z < pb->tau_z) return -1; - if (pa->tau_z > pb->tau_z) return 1; + if (pa->tau_z < pb->tau_z) + return -1; + if (pa->tau_z > pb->tau_z) + return 1; /* In case of tie, sort by F2 also */ - if (pa->F2 < pb->F2) return -1; - if (pa->F2 > pb->F2) return 1; - + if (pa->F2 < pb->F2) + return -1; + if (pa->F2 > pb->F2) + return 1; return 0; } /* SX_list_compare */ - -#ifndef CIF2HKL -#define CIF2HKL + + #ifndef CIF2HKL + #define CIF2HKL // hkl_filename = cif2hkl(file, options) // used to convert CIF/CFL/INS file into F2(hkl) // the CIF2HKL env var can point to a cif2hkl executable // else the McCode binary is attempted, then the system. - char *cif2hkl(char *infile, char *options) { + char* + cif2hkl (char* infile, char* options) { char cmd[1024]; - int ret = 0; - int found = 0; - char *OUTFILE; - char *inpath; - + int ret = 0; + int found = 0; + char* OUTFILE; + char* inpath; + // get filename extension - const char *ext = strrchr(infile, '.'); - if(!ext || ext == infile) return infile; - else ext++; - + const char* ext = strrchr (infile, '.'); + if (!ext || ext == infile) + return infile; + else + ext++; + // return input when no extension or not a CIF/FullProf/ShelX file - if ( strcasecmp(ext, "cif") - && strcasecmp(ext, "pcr") - && strcasecmp(ext, "cfl") - && strcasecmp(ext, "shx") - && strcasecmp(ext, "ins") - && strcasecmp(ext, "res")) return infile; - - OUTFILE = malloc(1024); + if (strcasecmp (ext, "cif") && strcasecmp (ext, "pcr") && strcasecmp (ext, "cfl") && strcasecmp (ext, "shx") && strcasecmp (ext, "ins") + && strcasecmp (ext, "res")) + return infile; + + OUTFILE = malloc (1024); if (!OUTFILE) { - free(OUTFILE); + free (OUTFILE); return infile; } - inpath = malloc(1024); + inpath = malloc (1024); if (!inpath) { - free(OUTFILE); - free(inpath); + free (OUTFILE); + free (inpath); return infile; } // get input file path from read-table:Open_File - FILE *f_infile = Open_File(infile, "r", inpath); + FILE* f_infile = Open_File (infile, "r", inpath); if (!f_infile) { - free(OUTFILE); - free(inpath); - free(f_infile); + free (OUTFILE); + free (inpath); + free (f_infile); return infile; } - fclose(f_infile); + fclose (f_infile); + + strncpy (OUTFILE, tmpnam (NULL), 1024); // create an output temporary file name - strncpy(OUTFILE, tmpnam(NULL), 1024); // create an output temporary file name - // try in order the CIF2HKL env var, then the system cif2hkl, then the McCode one - if (!found && getenv("CIF2HKL")) { - snprintf(cmd, 1024, "%s -o %s %s %s", - getenv("CIF2HKL"), - OUTFILE, options, inpath); - ret = system(cmd); - if (ret != -1 && ret != 127) found = 1; + if (!found && getenv ("CIF2HKL")) { + snprintf (cmd, 1024, "%s -o %s %s %s", getenv ("CIF2HKL"), OUTFILE, options, inpath); + ret = system (cmd); + if (ret != -1 && ret != 127) + found = 1; } if (!found) { // try with cif2hkl command from the system PATH - snprintf(cmd, 1024, "%s -o %s %s %s", - "cif2hkl", OUTFILE, options, inpath); - ret = system(cmd); - if (ret != -1 && ret != 127) found = 1; + snprintf (cmd, 1024, "%s -o %s %s %s", "cif2hkl", OUTFILE, options, inpath); + ret = system (cmd); + if (ret != -1 && ret != 127) + found = 1; } if (!found) { // As a last resort, attempt with cif2hkl from $MCSTAS/bin - snprintf(cmd, 1024, "%s%c%s%c%s -o %s %s %s", - getenv(FLAVOR_UPPER) ? getenv(FLAVOR_UPPER) : MCSTAS, - MC_PATHSEP_C, "bin", MC_PATHSEP_C, "cif2hkl", - OUTFILE, options, inpath); - ret = system(cmd); + snprintf (cmd, 1024, "%s%c%s%c%s -o %s %s %s", getenv (FLAVOR_UPPER) ? getenv (FLAVOR_UPPER) : MCSTAS, MC_PATHSEP_C, "bin", MC_PATHSEP_C, "cif2hkl", + OUTFILE, options, inpath); + ret = system (cmd); } // ret = -1: child process could not be created - // ret = 127: shell could not be executed in the child process + // ret = 127: shell could not be executed in the child process if (ret == -1 || ret == 127) { - free(OUTFILE); - return(NULL); + free (OUTFILE); + return (NULL); } - + // test if the result file has been created - FILE *file = fopen(OUTFILE,"r"); + FILE* file = fopen (OUTFILE, "r"); if (!file) { - free(OUTFILE); - return(NULL); + free (OUTFILE); + return (NULL); } - MPI_MASTER( - printf("%s: INFO: Converting %s into F2(HKL) list %s\n", - __FILE__, infile, OUTFILE); - printf ("%s\n",cmd); - ); - fflush(NULL); - fclose(file); - return(OUTFILE); + MPI_MASTER (printf ("%s: INFO: Converting %s into F2(HKL) list %s\n", __FILE__, infile, OUTFILE); printf ("%s\n", cmd);); + fflush (NULL); + fclose (file); + return (OUTFILE); } // cif2hkl -#endif + #endif /* ------------------------------------------------------------------------ */ int - read_hkl_data(char *SC_file, struct hkl_info_struct *info, struct hkl_data **hkl_list, - double SC_mosaic, double SC_mosaic_a, double SC_mosaic_b, double SC_mosaic_c, double *SC_mosaic_AB) - { - struct hkl_data *list = NULL; + read_hkl_data (char* SC_file, struct hkl_info_struct* info, struct hkl_data** hkl_list, double SC_mosaic, double SC_mosaic_a, double SC_mosaic_b, + double SC_mosaic_c, double* SC_mosaic_AB) { + 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 *filename=NULL; + char** parsing; + char flag = 0; + double nb_atoms = 1; + char* filename = NULL; - 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) { - filename = cif2hkl(SC_file, "--xtal --mode NUC"); - if (filename != SC_file) info->flag_barns=1; // cif2hkl returns barns - Table_Read(&sTable, filename, 1); /* read 1st block data from SC_file into sTable*/ + filename = cif2hkl (SC_file, "--xtal --mode NUC"); + if (filename != SC_file) + info->flag_barns = 1; // cif2hkl returns barns + Table_Read (&sTable, filename, 1); /* read 1st block data from SC_file into sTable*/ if (sTable.columns < 4) { - fprintf(stderr, "Single_crystal: Error: The number of columns in %s should be at least %d for [h,k,l,F2]\n", SC_file, 4); - return(0); + fprintf (stderr, "Single_crystal: Error: The number of columns in %s should be at least %d for [h,k,l,F2]\n", SC_file, 4); + return (0); } if (!sTable.rows) { - fprintf(stderr, "Single_crystal: Error: The number of rows in %s should be at least %d\n", SC_file, 1); - return(0); - } else size = sTable.rows; + fprintf (stderr, "Single_crystal: Error: The number of rows in %s should be at least %d\n", SC_file, 1); + return (0); + } else + size = sTable.rows; /* parsing of header */ - parsing = Table_ParseHeader(sTable.header, - "sigma_abs","sigma_a ", - "sigma_inc","sigma_i ", - "column_h", - "column_k", - "column_l", - "column_F ", - "column_F2", - "Delta_d/d", - "lattice_a ", - "lattice_b ", - "lattice_c ", - "lattice_aa", - "lattice_bb", - "lattice_cc", - "nb_atoms","multiplicity", - NULL); + parsing + = Table_ParseHeader (sTable.header, "sigma_abs", "sigma_a ", "sigma_inc", "sigma_i ", "column_h", "column_k", "column_l", "column_F ", "column_F2", + "Delta_d/d", "lattice_a ", "lattice_b ", "lattice_c ", "lattice_aa", "lattice_bb", "lattice_cc", "nb_atoms", "multiplicity", NULL); if (parsing) { - if (parsing[0] && !info->sigma_a) info->sigma_a=atof(parsing[0]); - if (parsing[1] && !info->sigma_a) info->sigma_a=atof(parsing[1]); - if (parsing[2] && !info->sigma_i) info->sigma_i=atof(parsing[2]); - if (parsing[3] && !info->sigma_i) info->sigma_i=atof(parsing[3]); - if (parsing[4]) info->column_order[0]=atoi(parsing[4]); - if (parsing[5]) info->column_order[1]=atoi(parsing[5]); - if (parsing[6]) info->column_order[2]=atoi(parsing[6]); - if (parsing[7]) info->column_order[3]=atoi(parsing[7]); - if (parsing[8]) info->column_order[4]=atoi(parsing[8]); - if (parsing[9] && info->m_delta_d_d <0) info->m_delta_d_d=atof(parsing[9]); - if (parsing[10] && !info->m_a) info->m_a =atof(parsing[10]); - if (parsing[11] && !info->m_b) info->m_b =atof(parsing[11]); - if (parsing[12] && !info->m_c) info->m_c =atof(parsing[12]); - if (parsing[13] && !info->m_aa) info->m_aa=atof(parsing[13]); - if (parsing[14] && !info->m_bb) info->m_bb=atof(parsing[14]); - if (parsing[15] && !info->m_cc) info->m_cc=atof(parsing[15]); - if (parsing[16]) nb_atoms=atof(parsing[16]); - if (parsing[17]) nb_atoms=atof(parsing[17]); - for (i=0; i<=17; i++) if (parsing[i]) free(parsing[i]); - free(parsing); + if (parsing[0] && !info->sigma_a) + info->sigma_a = atof (parsing[0]); + if (parsing[1] && !info->sigma_a) + info->sigma_a = atof (parsing[1]); + if (parsing[2] && !info->sigma_i) + info->sigma_i = atof (parsing[2]); + if (parsing[3] && !info->sigma_i) + info->sigma_i = atof (parsing[3]); + if (parsing[4]) + info->column_order[0] = atoi (parsing[4]); + if (parsing[5]) + info->column_order[1] = atoi (parsing[5]); + if (parsing[6]) + info->column_order[2] = atoi (parsing[6]); + if (parsing[7]) + info->column_order[3] = atoi (parsing[7]); + if (parsing[8]) + info->column_order[4] = atoi (parsing[8]); + if (parsing[9] && info->m_delta_d_d < 0) + info->m_delta_d_d = atof (parsing[9]); + if (parsing[10] && !info->m_a) + info->m_a = atof (parsing[10]); + if (parsing[11] && !info->m_b) + info->m_b = atof (parsing[11]); + if (parsing[12] && !info->m_c) + info->m_c = atof (parsing[12]); + if (parsing[13] && !info->m_aa) + info->m_aa = atof (parsing[13]); + if (parsing[14] && !info->m_bb) + info->m_bb = atof (parsing[14]); + if (parsing[15] && !info->m_cc) + info->m_cc = atof (parsing[15]); + if (parsing[16]) + nb_atoms = atof (parsing[16]); + if (parsing[17]) + nb_atoms = atof (parsing[17]); + for (i = 0; i <= 17; i++) + if (parsing[i]) + free (parsing[i]); + free (parsing); } } - if (nb_atoms > 1) { info->sigma_a *= nb_atoms; info->sigma_i *= nb_atoms; } + 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; info->m_aa=0;} /* means we specify by hand the vectors */ - if (info->m_bx || info->m_by || info->m_bz) {info->m_b=0; info->m_bb=0;} - if (info->m_cx || info->m_cy || info->m_cz) {info->m_c=0; info->m_cc=0;}; + if (info->m_ax || info->m_ay || info->m_az) { + info->m_a = 0; + info->m_aa = 0; + } /* means we specify by hand the vectors */ + if (info->m_bx || info->m_by || info->m_bz) { + info->m_b = 0; + info->m_bb = 0; + } + if (info->m_cx || info->m_cy || info->m_cz) { + info->m_c = 0; + info->m_cc = 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: Error: Wrong a lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Wrong a lattice vector definition\n"); + return (0); } if (!info->m_bx && !info->m_by && !info->m_bz && !info->m_b) { - fprintf(stderr, - "Single_crystal: Error: Wrong b lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Wrong b lattice vector definition\n"); + return (0); } if (!info->m_cx && !info->m_cy && !info->m_cz && !info->m_c) { - fprintf(stderr, - "Single_crystal: Error: Wrong c lattice vector definition\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Wrong c lattice vector definition\n"); + return (0); } if (info->m_aa && info->m_bb && info->m_cc && info->recip) { - fprintf(stderr, - "Single_crystal: Error: Selecting reciprocal cell and angles is unmeaningful\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Selecting reciprocal cell and angles is unmeaningful\n"); + return (0); } /* when lengths a,b,c + angles are given (instead of vectors a,b,c) */ - if (info->m_aa && info->m_bb && info->m_cc) - { - MPI_MASTER( - printf("Mode: lengths and angles\n"); - ); - double as,bs,cs; - if (info->m_a) as = info->m_a; - else as = sqrt(info->m_ax*info->m_ax+info->m_ay*info->m_ay+info->m_az*info->m_az); - if (info->m_b) bs = info->m_b; - else bs = sqrt(info->m_bx*info->m_bx+info->m_by*info->m_by+info->m_bz*info->m_bz); - if (info->m_c) cs = info->m_c; - else cs = sqrt(info->m_cx*info->m_cx+info->m_cy*info->m_cy+info->m_cz*info->m_cz); - - info->m_bz = as; info->m_by = 0; info->m_bx = 0; - info->m_az = bs*cos(info->m_cc*DEG2RAD); - info->m_ay = bs*sin(info->m_cc*DEG2RAD); + if (info->m_aa && info->m_bb && info->m_cc) { + MPI_MASTER (printf ("Mode: lengths and angles\n");); + double as, bs, cs; + if (info->m_a) + as = info->m_a; + else + as = sqrt (info->m_ax * info->m_ax + info->m_ay * info->m_ay + info->m_az * info->m_az); + if (info->m_b) + bs = info->m_b; + else + bs = sqrt (info->m_bx * info->m_bx + info->m_by * info->m_by + info->m_bz * info->m_bz); + if (info->m_c) + cs = info->m_c; + else + cs = sqrt (info->m_cx * info->m_cx + info->m_cy * info->m_cy + info->m_cz * info->m_cz); + + info->m_bz = as; + info->m_by = 0; + info->m_bx = 0; + info->m_az = bs * cos (info->m_cc * DEG2RAD); + info->m_ay = bs * sin (info->m_cc * DEG2RAD); info->m_ax = 0; - info->m_cz = cs*cos(info->m_bb*DEG2RAD); - info->m_cy = cs*(cos(info->m_aa*DEG2RAD)-cos(info->m_cc*DEG2RAD)*cos(info->m_bb*DEG2RAD)) - /sin(info->m_cc*DEG2RAD); - info->m_cx = sqrt(cs*cs - info->m_cz*info->m_cz - info->m_cy*info->m_cy); - - MPI_MASTER( - printf("Single_crystal: %s structure a=%g b=%g c=%g aa=%g bb=%g cc=%g ", - (flag ? "INC" : SC_file), as, bs, cs, info->m_aa, info->m_bb, info->m_cc); - ); + 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); + + MPI_MASTER ( + printf ("Single_crystal: %s structure a=%g b=%g c=%g aa=%g bb=%g cc=%g ", (flag ? "INC" : SC_file), as, bs, cs, info->m_aa, info->m_bb, info->m_cc);); } else { if (!info->recip) { - MPI_MASTER( - printf("Mode: Direct mode lattice\n"); - printf("Single_crystal: %s structure a=[%g,%g,%g] b=[%g,%g,%g] c=[%g,%g,%g] ", - (flag ? "INC" : SC_file), info->m_ax ,info->m_ay ,info->m_az, - info->m_bx ,info->m_by ,info->m_bz, - info->m_cx ,info->m_cy ,info->m_cz); - ); + MPI_MASTER (printf ("Mode: Direct mode lattice\n"); + printf ("Single_crystal: %s structure a=[%g,%g,%g] b=[%g,%g,%g] c=[%g,%g,%g] ", (flag ? "INC" : SC_file), info->m_ax, info->m_ay, info->m_az, + info->m_bx, info->m_by, info->m_bz, info->m_cx, info->m_cy, info->m_cz);); } else { - MPI_MASTER( - printf("Mode: Reciprocal mode lattice\n"); - printf("Single_crystal: %s structure a*=[%g,%g,%g] b*=[%g,%g,%g] c*=[%g,%g,%g] ", - (flag ? "INC" : SC_file), info->m_ax ,info->m_ay ,info->m_az, - info->m_bx ,info->m_by ,info->m_bz, - info->m_cx ,info->m_cy ,info->m_cz); - ); + MPI_MASTER (printf ("Mode: Reciprocal mode lattice\n"); + printf ("Single_crystal: %s structure a*=[%g,%g,%g] b*=[%g,%g,%g] c*=[%g,%g,%g] ", (flag ? "INC" : SC_file), info->m_ax, info->m_ay, + info->m_az, info->m_bx, info->m_by, info->m_bz, info->m_cx, info->m_cy, info->m_cz);); } } /* Compute reciprocal or direct lattice vectors. */ if (!info->recip) { - vec_prod(tmp_x, tmp_y, tmp_z, - info->m_bx, info->m_by, info->m_bz, - info->m_cx, info->m_cy, info->m_cz); - info->V0 = fabs(scalar_prod(info->m_ax, info->m_ay, info->m_az, tmp_x, tmp_y, tmp_z)); - MPI_MASTER( - printf("V0=%g\n", info->V0); - ); - - info->asx = 2*PI/info->V0*tmp_x; - info->asy = 2*PI/info->V0*tmp_y; - info->asz = 2*PI/info->V0*tmp_z; - vec_prod(tmp_x, tmp_y, tmp_z, info->m_cx, info->m_cy, info->m_cz, info->m_ax, info->m_ay, info->m_az); - info->bsx = 2*PI/info->V0*tmp_x; - info->bsy = 2*PI/info->V0*tmp_y; - info->bsz = 2*PI/info->V0*tmp_z; - vec_prod(tmp_x, tmp_y, tmp_z, info->m_ax, info->m_ay, info->m_az, info->m_bx, info->m_by, info->m_bz); - info->csx = 2*PI/info->V0*tmp_x; - info->csy = 2*PI/info->V0*tmp_y; - info->csz = 2*PI/info->V0*tmp_z; + 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)); + MPI_MASTER (printf ("V0=%g\n", info->V0);); + + info->asx = 2 * PI / info->V0 * tmp_x; + info->asy = 2 * PI / info->V0 * tmp_y; + info->asz = 2 * PI / info->V0 * tmp_z; + vec_prod (tmp_x, tmp_y, tmp_z, info->m_cx, info->m_cy, info->m_cz, info->m_ax, info->m_ay, info->m_az); + info->bsx = 2 * PI / info->V0 * tmp_x; + info->bsy = 2 * PI / info->V0 * tmp_y; + info->bsz = 2 * PI / info->V0 * tmp_z; + vec_prod (tmp_x, tmp_y, tmp_z, info->m_ax, info->m_ay, info->m_az, info->m_bx, info->m_by, info->m_bz); + info->csx = 2 * PI / info->V0 * tmp_x; + info->csy = 2 * PI / info->V0 * tmp_y; + info->csz = 2 * PI / info->V0 * tmp_z; } else { info->asx = info->m_ax; info->asy = info->m_ay; @@ -697,63 +708,60 @@ struct hkl_data 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)); - MPI_MASTER( - 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)); + MPI_MASTER (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]) { - fprintf(stderr, - "Single_crystal: Error: Wrong h,k,l column definition\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Wrong h,k,l column definition\n"); + return (0); } if (!info->column_order[3] && !info->column_order[4]) { - fprintf(stderr, - "Single_crystal: Error: Wrong F,F2 column definition\n"); - return(0); + fprintf (stderr, "Single_crystal: Error: Wrong F,F2 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)); if (!list) { - fprintf(stderr, - "Single_crystal: Error allocating reflection list\n"); - return(0); + fprintf (stderr, "Single_crystal: Error allocating reflection list\n"); + return (0); } - 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); - if (info->column_order[3]) - { F2= Table_Index(sTable, i, info->column_order[3]-1); F2 *= F2; } - else if (info->column_order[4]) - F2= Table_Index(sTable, i, info->column_order[4]-1); + h = Table_Index (sTable, i, info->column_order[0] - 1); + k = Table_Index (sTable, i, info->column_order[1] - 1); + l = Table_Index (sTable, i, info->column_order[2] - 1); + if (info->column_order[3]) { + F2 = Table_Index (sTable, i, info->column_order[3] - 1); + F2 *= F2; + } else if (info->column_order[4]) + F2 = Table_Index (sTable, i, info->column_order[4] - 1); list[i].h = h; list[i].k = k; @@ -761,49 +769,47 @@ struct hkl_data list[i].F2 = F2; /* Precompute some values */ - list[i].tau_x = h*info->asx + k*info->bsx + l*info->csx; - list[i].tau_y = h*info->asy + k*info->bsy + l*info->csy; - list[i].tau_z = h*info->asz + k*info->bsz + l*info->csz; - list[i].tau = sqrt(list[i].tau_x*list[i].tau_x + - list[i].tau_y*list[i].tau_y + - list[i].tau_z*list[i].tau_z); - list[i].u1x = list[i].tau_x/list[i].tau; - list[i].u1y = list[i].tau_y/list[i].tau; - list[i].u1z = list[i].tau_z/list[i].tau; - sig1 = FWHM2RMS*info->m_delta_d_d*list[i].tau; + list[i].tau_x = h * info->asx + k * info->bsx + l * info->csx; + list[i].tau_y = h * info->asy + k * info->bsy + l * info->csy; + list[i].tau_z = h * info->asz + k * info->bsz + l * info->csz; + list[i].tau = sqrt (list[i].tau_x * list[i].tau_x + list[i].tau_y * list[i].tau_y + list[i].tau_z * list[i].tau_z); + list[i].u1x = list[i].tau_x / list[i].tau; + list[i].u1y = list[i].tau_y / list[i].tau; + list[i].u1z = list[i].tau_z / list[i].tau; + sig1 = FWHM2RMS * info->m_delta_d_d * list[i].tau; /* Find two arbitrary axes perpendicular to tau and each other. */ - normal_vec(&b1[0], &b1[1], &b1[2], - list[i].u1x, list[i].u1y, list[i].u1z); - vec_prod(b2[0], b2[1], b2[2], - list[i].u1x, list[i].u1y, list[i].u1z, - b1[0], b1[1], b1[2]); + normal_vec (&b1[0], &b1[1], &b1[2], list[i].u1x, list[i].u1y, list[i].u1z); + vec_prod (b2[0], b2[1], b2[2], list[i].u1x, list[i].u1y, list[i].u1z, b1[0], b1[1], b1[2]); /* Find the two mosaic axes perpendicular to tau. */ - if(SC_mosaic > 0) { + if (SC_mosaic > 0) { /* Use isotropic mosaic. */ list[i].u2x = b1[0]; list[i].u2y = b1[1]; list[i].u2z = b1[2]; - sig2 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic; + sig2 = FWHM2RMS * list[i].tau * MIN2RAD * SC_mosaic; list[i].u3x = b2[0]; list[i].u3y = b2[1]; list[i].u3z = b2[2]; - sig3 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic; - } else if(SC_mosaic_a > 0 && SC_mosaic_b > 0 && SC_mosaic_c > 0) { + sig3 = FWHM2RMS * list[i].tau * MIN2RAD * SC_mosaic; + } else if (SC_mosaic_a > 0 && SC_mosaic_b > 0 && SC_mosaic_c > 0) { /* Use anisotropic mosaic. */ - fprintf(stderr,"Single_crystal: Warning: you are using an experimental feature:\n" - " anistropic mosaicity. Please examine your data carefully.\n"); + fprintf (stderr, "Single_crystal: Warning: you are using an experimental feature:\n" + " anistropic mosaicity. Please examine your data carefully.\n"); /* compute the jacobian of (tau_v,tau_n) from rotations around the unit cell vectors. */ - struct hkl_data *l =&(list[i]); - double xia_x,xia_y,xia_z,xib_x,xib_y,xib_z,xic_x,xic_y,xic_z; + struct hkl_data* l = &(list[i]); + double xia_x, xia_y, xia_z, xib_x, xib_y, xib_z, xic_x, xic_y, xic_z; /*input parameters are in arc minutes*/ - double sig_fi_a=SC_mosaic_a*MIN2RAD; - double sig_fi_b=SC_mosaic_b*MIN2RAD; - double sig_fi_c=SC_mosaic_c*MIN2RAD; - if(info->m_a==0) info->m_a=sqrt(scalar_prod( info->m_ax,info->m_ay,info->m_az,info->m_ax,info->m_ay,info->m_az)); - if(info->m_b==0) info->m_b=sqrt(scalar_prod( info->m_bx,info->m_by,info->m_bz,info->m_bx,info->m_by,info->m_bz)); - if(info->m_c==0) info->m_c=sqrt(scalar_prod( info->m_cx,info->m_cy,info->m_cz,info->m_cx,info->m_cy,info->m_cz)); + double sig_fi_a = SC_mosaic_a * MIN2RAD; + double sig_fi_b = SC_mosaic_b * MIN2RAD; + double sig_fi_c = SC_mosaic_c * MIN2RAD; + if (info->m_a == 0) + info->m_a = sqrt (scalar_prod (info->m_ax, info->m_ay, info->m_az, info->m_ax, info->m_ay, info->m_az)); + if (info->m_b == 0) + info->m_b = sqrt (scalar_prod (info->m_bx, info->m_by, info->m_bz, info->m_bx, info->m_by, info->m_bz)); + if (info->m_c == 0) + info->m_c = sqrt (scalar_prod (info->m_cx, info->m_cy, info->m_cz, info->m_cx, info->m_cy, info->m_cz)); l->u2x = b1[0]; l->u2y = b1[1]; @@ -812,131 +818,138 @@ struct hkl_data l->u3y = b2[1]; l->u3z = b2[2]; - xia_x=l->tau_x-(M_2_PI*h/info->m_a)*info->asx; - xia_y=l->tau_y-(M_2_PI*h/info->m_a)*info->asy; - xia_z=l->tau_z-(M_2_PI*h/info->m_a)*info->asz; - xib_x=l->tau_x-(M_2_PI*h/info->m_b)*info->bsx; - xib_y=l->tau_y-(M_2_PI*h/info->m_b)*info->bsy; - xib_z=l->tau_z-(M_2_PI*h/info->m_b)*info->bsz; - xic_x=l->tau_x-(M_2_PI*h/info->m_c)*info->csx; - xic_y=l->tau_y-(M_2_PI*h/info->m_c)*info->csy; - xic_z=l->tau_z-(M_2_PI*h/info->m_c)*info->csz; - - double xia=sqrt(xia_x*xia_x + xia_y*xia_y + xia_z*xia_z); - double xib=sqrt(xib_x*xib_x + xib_y*xib_y + xib_z*xib_z); - double xic=sqrt(xic_x*xic_x + xic_y*xic_y + xic_z*xic_z); - - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z); - double J_n_fia= xia/info->m_a/l->tau*scalar_prod(info->asx,info->asy,info->asz,tmp_x,tmp_y,tmp_z); - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z); - double J_n_fib= xib/info->m_b/l->tau*scalar_prod(info->bsx,info->bsy,info->bsz,tmp_x,tmp_y,tmp_z); - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u2x,l->u2y,l->u2z); - double J_n_fic= xic/info->m_c/l->tau*scalar_prod(info->csx,info->csy,info->csz,tmp_x,tmp_y,tmp_z); - - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z); - double J_v_fia= xia/info->m_a/l->tau*scalar_prod(info->asx,info->asy,info->asz,tmp_x,tmp_y,tmp_z); - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z); - double J_v_fib= xib/info->m_b/l->tau*scalar_prod(info->bsx,info->bsy,info->bsz,tmp_x,tmp_y,tmp_z); - vec_prod(tmp_x,tmp_y,tmp_z,l->tau_x,l->tau_y,l->tau_z, l->u3x,l->u3y,l->u3z); - double J_v_fic= xic/info->m_c/l->tau*scalar_prod(info->csx,info->csy,info->csz,tmp_x,tmp_y,tmp_z); + xia_x = l->tau_x - (M_2_PI * h / info->m_a) * info->asx; + xia_y = l->tau_y - (M_2_PI * h / info->m_a) * info->asy; + xia_z = l->tau_z - (M_2_PI * h / info->m_a) * info->asz; + xib_x = l->tau_x - (M_2_PI * h / info->m_b) * info->bsx; + xib_y = l->tau_y - (M_2_PI * h / info->m_b) * info->bsy; + xib_z = l->tau_z - (M_2_PI * h / info->m_b) * info->bsz; + xic_x = l->tau_x - (M_2_PI * h / info->m_c) * info->csx; + xic_y = l->tau_y - (M_2_PI * h / info->m_c) * info->csy; + xic_z = l->tau_z - (M_2_PI * h / info->m_c) * info->csz; + + double xia = sqrt (xia_x * xia_x + xia_y * xia_y + xia_z * xia_z); + double xib = sqrt (xib_x * xib_x + xib_y * xib_y + xib_z * xib_z); + double xic = sqrt (xic_x * xic_x + xic_y * xic_y + xic_z * xic_z); + + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u2x, l->u2y, l->u2z); + double J_n_fia = xia / info->m_a / l->tau * scalar_prod (info->asx, info->asy, info->asz, tmp_x, tmp_y, tmp_z); + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u2x, l->u2y, l->u2z); + double J_n_fib = xib / info->m_b / l->tau * scalar_prod (info->bsx, info->bsy, info->bsz, tmp_x, tmp_y, tmp_z); + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u2x, l->u2y, l->u2z); + double J_n_fic = xic / info->m_c / l->tau * scalar_prod (info->csx, info->csy, info->csz, tmp_x, tmp_y, tmp_z); + + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u3x, l->u3y, l->u3z); + double J_v_fia = xia / info->m_a / l->tau * scalar_prod (info->asx, info->asy, info->asz, tmp_x, tmp_y, tmp_z); + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u3x, l->u3y, l->u3z); + double J_v_fib = xib / info->m_b / l->tau * scalar_prod (info->bsx, info->bsy, info->bsz, tmp_x, tmp_y, tmp_z); + vec_prod (tmp_x, tmp_y, tmp_z, l->tau_x, l->tau_y, l->tau_z, l->u3x, l->u3y, l->u3z); + double J_v_fic = xic / info->m_c / l->tau * scalar_prod (info->csx, info->csy, info->csz, tmp_x, tmp_y, tmp_z); /*with the jacobian we can compute the sigmas in terms of the orthogonal vectors u2 and u3*/ - sig2=sig_fi_a*fabs(J_v_fia) + sig_fi_b*fabs(J_v_fib) + sig_fi_c*fabs(J_v_fic); - sig3=sig_fi_a*fabs(J_n_fia) + sig_fi_b*fabs(J_n_fib) + sig_fi_c*fabs(J_n_fic); - } else if (SC_mosaic_AB[0]!=0 && SC_mosaic_AB[1]!=0){ - if ( (SC_mosaic_AB[2]==0 && SC_mosaic_AB[3]==0 && SC_mosaic_AB[4]==0) || (SC_mosaic_AB[5]==0 && SC_mosaic_AB[6]==0 && SC_mosaic_AB[7]==0) ){ - fprintf(stderr,"Single_crystal: Error: in-plane mosaics are specified but one (or both)\n" - " in-plane reciprocal vector is the zero vector\n"); - return(0); + sig2 = sig_fi_a * fabs (J_v_fia) + sig_fi_b * fabs (J_v_fib) + sig_fi_c * fabs (J_v_fic); + sig3 = sig_fi_a * fabs (J_n_fia) + sig_fi_b * fabs (J_n_fib) + sig_fi_c * fabs (J_n_fic); + } else if (SC_mosaic_AB[0] != 0 && SC_mosaic_AB[1] != 0) { + if ((SC_mosaic_AB[2] == 0 && SC_mosaic_AB[3] == 0 && SC_mosaic_AB[4] == 0) || (SC_mosaic_AB[5] == 0 && SC_mosaic_AB[6] == 0 && SC_mosaic_AB[7] == 0)) { + fprintf (stderr, "Single_crystal: Error: in-plane mosaics are specified but one (or both)\n" + " in-plane reciprocal vector is the zero vector\n"); + return (0); } - fprintf(stderr,"Single_crystal: Warning: you are using an experimental feature: \n" - " \"in-plane\" anistropic mosaicity. Please examine your data carefully.\n"); + fprintf (stderr, "Single_crystal: Warning: you are using an experimental feature: \n" + " \"in-plane\" anistropic mosaicity. Please examine your data carefully.\n"); /*for given reflection in list - compute linear comb of tau_a and tau_b*/ /*check for not in plane - f.i. check if (tau_a X tau_b).tau_i)==0*/ - struct hkl_data *l =&(list[i]); - double det,c1,c2,sig_tau_c; - double em_x,em_y,em_z, tmp_x,tmp_y,tmp_z; - double tau_a[3],tau_b[3]; + struct hkl_data* l = &(list[i]); + double det, c1, c2, sig_tau_c; + double em_x, em_y, em_z, tmp_x, tmp_y, tmp_z; + double tau_a[3], tau_b[3]; /*convert Miller indices to taus*/ - if(info->m_a==0) info->m_a=sqrt(scalar_prod( info->m_ax,info->m_ay,info->m_az,info->m_ax,info->m_ay,info->m_az)); - if(info->m_b==0) info->m_b=sqrt(scalar_prod( info->m_bx,info->m_by,info->m_bz,info->m_bx,info->m_by,info->m_bz)); - if(info->m_c==0) info->m_c=sqrt(scalar_prod( info->m_cx,info->m_cy,info->m_cz,info->m_cx,info->m_cy,info->m_cz)); - tau_a[0]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asx + (SC_mosaic_AB[3]/info->m_b)*info->bsx + (SC_mosaic_AB[4]/info->m_c)*info->csx ); - tau_a[1]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asy + (SC_mosaic_AB[3]/info->m_b)*info->bsy + (SC_mosaic_AB[4]/info->m_c)*info->csy ); - tau_a[2]=M_2_PI*( (SC_mosaic_AB[2]/info->m_a)*info->asz + (SC_mosaic_AB[3]/info->m_b)*info->bsz + (SC_mosaic_AB[4]/info->m_c)*info->csz ); - tau_b[0]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asx + (SC_mosaic_AB[6]/info->m_b)*info->bsx + (SC_mosaic_AB[7]/info->m_c)*info->csx ); - tau_b[1]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asy + (SC_mosaic_AB[6]/info->m_b)*info->bsy + (SC_mosaic_AB[7]/info->m_c)*info->csy ); - tau_b[2]=M_2_PI*( (SC_mosaic_AB[5]/info->m_a)*info->asz + (SC_mosaic_AB[6]/info->m_b)*info->bsz + (SC_mosaic_AB[7]/info->m_c)*info->csz ); + if (info->m_a == 0) + info->m_a = sqrt (scalar_prod (info->m_ax, info->m_ay, info->m_az, info->m_ax, info->m_ay, info->m_az)); + if (info->m_b == 0) + info->m_b = sqrt (scalar_prod (info->m_bx, info->m_by, info->m_bz, info->m_bx, info->m_by, info->m_bz)); + if (info->m_c == 0) + info->m_c = sqrt (scalar_prod (info->m_cx, info->m_cy, info->m_cz, info->m_cx, info->m_cy, info->m_cz)); + tau_a[0] = M_2_PI * ((SC_mosaic_AB[2] / info->m_a) * info->asx + (SC_mosaic_AB[3] / info->m_b) * info->bsx + (SC_mosaic_AB[4] / info->m_c) * info->csx); + tau_a[1] = M_2_PI * ((SC_mosaic_AB[2] / info->m_a) * info->asy + (SC_mosaic_AB[3] / info->m_b) * info->bsy + (SC_mosaic_AB[4] / info->m_c) * info->csy); + tau_a[2] = M_2_PI * ((SC_mosaic_AB[2] / info->m_a) * info->asz + (SC_mosaic_AB[3] / info->m_b) * info->bsz + (SC_mosaic_AB[4] / info->m_c) * info->csz); + tau_b[0] = M_2_PI * ((SC_mosaic_AB[5] / info->m_a) * info->asx + (SC_mosaic_AB[6] / info->m_b) * info->bsx + (SC_mosaic_AB[7] / info->m_c) * info->csx); + tau_b[1] = M_2_PI * ((SC_mosaic_AB[5] / info->m_a) * info->asy + (SC_mosaic_AB[6] / info->m_b) * info->bsy + (SC_mosaic_AB[7] / info->m_c) * info->csy); + tau_b[2] = M_2_PI * ((SC_mosaic_AB[5] / info->m_a) * info->asz + (SC_mosaic_AB[6] / info->m_b) * info->bsz + (SC_mosaic_AB[7] / info->m_c) * info->csz); /*check determinants to see how we should compute the linear combination of a and b (to match c)*/ - c1=c2=0; - if ((det=tau_a[0]*tau_b[1]-tau_a[1]*tau_b[0])!=0){ - c1= (l->tau_x*tau_b[1] - l->tau_y*tau_b[0])/det; - c2= (tau_a[0]*l->tau_y - tau_a[1]*l->tau_x)/det; - }else if ((det=tau_a[1]*tau_b[2]-tau_a[2]*tau_b[1])!=0){ - c1= (l->tau_y*tau_b[2] - l->tau_z*tau_b[1])/det; - c2= (tau_a[1]*l->tau_z - tau_a[2]*l->tau_y)/det; - }else if ((det=tau_a[0]*tau_b[2]-tau_a[2]*tau_b[0])!=0){ - c1= (l->tau_x*tau_b[2] - l->tau_z*tau_b[0])/det; - c2= (tau_a[0]*l->tau_z - tau_a[2]*l->tau_x)/det; + c1 = c2 = 0; + if ((det = tau_a[0] * tau_b[1] - tau_a[1] * tau_b[0]) != 0) { + c1 = (l->tau_x * tau_b[1] - l->tau_y * tau_b[0]) / det; + c2 = (tau_a[0] * l->tau_y - tau_a[1] * l->tau_x) / det; + } else if ((det = tau_a[1] * tau_b[2] - tau_a[2] * tau_b[1]) != 0) { + c1 = (l->tau_y * tau_b[2] - l->tau_z * tau_b[1]) / det; + c2 = (tau_a[1] * l->tau_z - tau_a[2] * l->tau_y) / det; + } else if ((det = tau_a[0] * tau_b[2] - tau_a[2] * tau_b[0]) != 0) { + c1 = (l->tau_x * tau_b[2] - l->tau_z * tau_b[0]) / det; + c2 = (tau_a[0] * l->tau_z - tau_a[2] * l->tau_x) / det; } - if ((c1==0) && (c2==0)){ - fprintf(stderr,"Single_crystal: Warning: reflection tau[%i]=(%g %g %g) " - "has no component in defined mosaic plane\n", - i, l->tau_x,l->tau_y,l->tau_z); + if ((c1 == 0) && (c2 == 0)) { + fprintf (stderr, + "Single_crystal: Warning: reflection tau[%i]=(%g %g %g) " + "has no component in defined mosaic plane\n", + i, l->tau_x, l->tau_y, l->tau_z); } /*compute linear combination => sig_tau_i = | c1*sig_tau_a + c2*sig_tau_b | - also add in the minute to radian scaling factor*/; - sig_tau_c = MIN2RAD*sqrt(c1*SC_mosaic_AB[0]*c1*SC_mosaic_AB[0] + c2*SC_mosaic_AB[1]*c2*SC_mosaic_AB[1]); - l->u2x = b1[0]; l->u2y = b1[1]; l->u2z = b1[2]; - l->u3x = b2[0]; l->u3y = b2[1]; l->u3z = b2[2]; + sig_tau_c = MIN2RAD * sqrt (c1 * SC_mosaic_AB[0] * c1 * SC_mosaic_AB[0] + c2 * SC_mosaic_AB[1] * c2 * SC_mosaic_AB[1]); + l->u2x = b1[0]; + l->u2y = b1[1]; + l->u2z = b1[2]; + l->u3x = b2[0]; + l->u3y = b2[1]; + l->u3z = b2[2]; /*so now let's compute the rotation around planenormal tau_a X tau_b*/ /*g_bar (unit normal of rotation plane) = tau_a X tau_b / norm(tau_a X tau_b)*/ - vec_prod(tmp_x,tmp_y,tmp_z, tau_a[0],tau_a[1],tau_a[2],tau_b[0],tau_b[1],tau_b[2]); - vec_prod(em_x,em_y,em_z, l->tau_x, l->tau_y, l->tau_z, tmp_x,tmp_y,tmp_z); - NORM(em_x,em_y,em_z); - sig2 = l->tau*sig_tau_c*fabs(scalar_prod(em_x,em_y,em_z, l->u2x,l->u2y,l->u2z)); - sig3 = l->tau*sig_tau_c*fabs(scalar_prod(em_x,em_y,em_z, l->u3x,l->u3y,l->u3z)); + vec_prod (tmp_x, tmp_y, tmp_z, tau_a[0], tau_a[1], tau_a[2], tau_b[0], tau_b[1], tau_b[2]); + vec_prod (em_x, em_y, em_z, l->tau_x, l->tau_y, l->tau_z, tmp_x, tmp_y, tmp_z); + NORM (em_x, em_y, em_z); + sig2 = l->tau * sig_tau_c * fabs (scalar_prod (em_x, em_y, em_z, l->u2x, l->u2y, l->u2z)); + sig3 = l->tau * sig_tau_c * fabs (scalar_prod (em_x, em_y, em_z, l->u3x, l->u3y, l->u3z)); /*protect against collapsing gaussians. These seem to be sensible values.*/ - if (sig2<1e-5) sig2=1e-5; - if (sig3<1e-5) sig3=1e-5; - } - else { - fprintf(stderr, - "Single_crystal: Error: EITHER mosaic OR (mosaic_a, mosaic_b, mosaic_c)\n" - " must be given and be >0.\n"); - return(0); + if (sig2 < 1e-5) + sig2 = 1e-5; + if (sig3 < 1e-5) + sig3 = 1e-5; + } else { + fprintf (stderr, "Single_crystal: Error: EITHER mosaic OR (mosaic_a, mosaic_b, mosaic_c)\n" + " must be given and be >0.\n"); + return (0); } - list[i].sig123 = sig1*sig2*sig3; - list[i].m1 = 1/(2*sig1*sig1); - list[i].m2 = 1/(2*sig2*sig2); - list[i].m3 = 1/(2*sig3*sig3); + list[i].sig123 = sig1 * sig2 * sig3; + list[i].m1 = 1 / (2 * sig1 * sig1); + list[i].m2 = 1 / (2 * sig2 * sig2); + list[i].m3 = 1 / (2 * sig3 * sig3); /* Set Gauss cutoff to 5 times the maximal sigma. */ - if(sig1 > sig2) - if(sig1 > sig3) - list[i].cutoff = 5*sig1; + if (sig1 > sig2) + if (sig1 > sig3) + list[i].cutoff = 5 * sig1; else - list[i].cutoff = 5*sig3; + list[i].cutoff = 5 * sig3; + else if (sig2 > sig3) + list[i].cutoff = 5 * sig2; else - if(sig2 > sig3) - list[i].cutoff = 5*sig2; - else - list[i].cutoff = 5*sig3; + list[i].cutoff = 5 * sig3; } - Table_Free(&sTable); + Table_Free (&sTable); /* sort the list with increasing tau */ - qsort(list, i, sizeof(struct hkl_data), SX_list_compare); + qsort (list, i, sizeof (struct hkl_data), SX_list_compare); *hkl_list = list; info->count = i; - + // remove temporary F2(hkl) file when giving CFL/CIF/ShelX file if (filename != SC_file) - unlink(filename); - - return(info->count); + unlink (filename); + + return (info->count); } /* read_hkl_data */ /* ------------------------------------------------------------------------ */ @@ -948,218 +961,220 @@ struct hkl_data this function returns: tau_count (return), coh_refl, coh_xsect, T (updated elements in the array up to [j]) */ -#pragma acc routine -int hkl_search(struct hkl_data *L, void *TT, int count, double V0, - double kix, double kiy, double kiz, double tau_max, - double *coh_refl, double *coh_xsect) - { + #pragma acc routine + int + hkl_search (struct hkl_data* L, void* TT, int count, double V0, double kix, double kiy, double kiz, double tau_max, double* coh_refl, double* coh_xsect) { double rho, rho_x, rho_y, rho_z; double diff; - int i,j; - double ox,oy,oz; - double b1x,b1y,b1z, b2x,b2y,b2z, kx, ky, kz, nx, ny, nz; - double n11, n22, n12, det_N, inv_n11, inv_n22, inv_n12, l11, l22, l12, det_L; + int i, j; + double ox, oy, oz; + double b1x, b1y, b1z, b2x, b2y, b2z, kx, ky, kz, nx, ny, nz; + double n11, n22, n12, det_N, inv_n11, inv_n22, inv_n12, l11, l22, l12, det_L; double Bt_D_O_x, Bt_D_O_y, y0x, y0y, alpha; - double ki = sqrt(kix*kix+kiy*kiy+kiz*kiz); - int jglobal=-1; - double coherent_refl,coherent_xsect; + double ki = sqrt (kix * kix + kiy * kiy + kiz * kiz); + int jglobal = -1; + double coherent_refl, coherent_xsect; - struct tau_data *T=(struct tau_data *)TT; + struct tau_data* T = (struct tau_data*)TT; - //coherent_refl = *coh_refl; - //coherent_xsect = *coh_xsect; + // coherent_refl = *coh_refl; + // coherent_xsect = *coh_xsect; coherent_refl = 0; coherent_xsect = 0; /* Common factor in coherent cross-section */ - double xsect_factor = pow(2*PI, 5.0/2.0)/(V0*ki*ki); - j=0; - for(i = 0; i < count; i++) - { - /* Assuming reflections are sorted, stop search when max tau exceeded. */ - if(L[i].tau > tau_max) - break; - /* Check if this reciprocal lattice point is close enough to the - Ewald sphere to make scattering possible. */ - rho_x = kix - L[i].tau_x; - rho_y = kiy - L[i].tau_y; - rho_z = kiz - L[i].tau_z; - rho = sqrt(rho_x*rho_x + rho_y*rho_y + rho_z*rho_z); - diff = fabs(rho - ki); - - /* Check if scattering is possible (cutoff of Gaussian tails). */ - if(diff <= L[i].cutoff) - { - /* Store reflection. */ - T[j].index = i; - /* Get ki vector in local coordinates. */ - kx = kix*L[i].u1x + kiy*L[i].u1y + kiz*L[i].u1z; - ky = kix*L[i].u2x + kiy*L[i].u2y + kiz*L[i].u2z; - kz = kix*L[i].u3x + kiy*L[i].u3y + kiz*L[i].u3z; - T[j].rho_x = kx - L[i].tau; - T[j].rho_y = ky; - T[j].rho_z = kz; - T[j].rho = rho; - /* Compute the tangent plane of the Ewald sphere. */ - nx = T[j].rho_x/T[j].rho; - ny = T[j].rho_y/T[j].rho; - nz = T[j].rho_z/T[j].rho; - ox = (ki - T[j].rho)*nx; - oy = (ki - T[j].rho)*ny; - oz = (ki - T[j].rho)*nz; - T[j].ox = ox; - T[j].oy = oy; - T[j].oz = oz; - /* Compute unit vectors b1 and b2 that span the tangent plane. */ - normal_vec(&b1x, &b1y, &b1z, nx, ny, nz); - vec_prod(b2x, b2y, b2z, nx, ny, nz, b1x, b1y, b1z); - T[j].b1x = b1x; - T[j].b1y = b1y; - T[j].b1z = b1z; - T[j].b2x = b2x; - T[j].b2y = b2y; - T[j].b2z = b2z; - /* Compute the 2D projection of the 3D Gauss of the reflection. */ - /* The symmetric 2x2 matrix N describing the 2D gauss. */ - n11 = L[i].m1*b1x*b1x + L[i].m2*b1y*b1y + L[i].m3*b1z*b1z; - n12 = L[i].m1*b1x*b2x + L[i].m2*b1y*b2y + L[i].m3*b1z*b2z; - n22 = L[i].m1*b2x*b2x + L[i].m2*b2y*b2y + L[i].m3*b2z*b2z; - /* The (symmetric) inverse matrix of N. */ - det_N = n11*n22 - n12*n12; - inv_n11 = n22/det_N; - inv_n12 = -n12/det_N; - inv_n22 = n11/det_N; - /* The Cholesky decomposition of 1/2*inv_n (lower triangular L). */ - l11 = sqrt(inv_n11/2); - l12 = inv_n12/(2*l11); - l22 = sqrt(inv_n22/2 - l12*l12); - T[j].l11 = l11; - T[j].l12 = l12; - T[j].l22 = l22; - det_L = l11*l22; - /* The product B^T D o. */ - Bt_D_O_x = b1x*L[i].m1*ox + b1y*L[i].m2*oy + b1z*L[i].m3*oz; - Bt_D_O_y = b2x*L[i].m1*ox + b2y*L[i].m2*oy + b2z*L[i].m3*oz; - /* Center of 2D Gauss in plane coordinates. */ - y0x = -(Bt_D_O_x*inv_n11 + Bt_D_O_y*inv_n12); - y0y = -(Bt_D_O_x*inv_n12 + Bt_D_O_y*inv_n22); - T[j].y0x = y0x; - T[j].y0y = y0y; - /* Factor alpha for the distance of the 2D Gauss from the origin. */ - alpha = L[i].m1*ox*ox + L[i].m2*oy*oy + L[i].m3*oz*oz - - (y0x*y0x*n11 + y0y*y0y*n22 + 2*y0x*y0y*n12); - T[j].refl = xsect_factor*det_L*exp(-alpha)/L[i].sig123; /* intensity of that Bragg */ - *coh_refl += T[j].refl; /* total scatterable intensity*/ - T[j].xsect = T[j].refl*L[i].F2; - *coh_xsect += T[j].xsect; - j++; - } - /*protect against tau shortlist buffer overrrun*/ - if (j==MCSX_REFL_SLIST_SIZE){ - break; - } - } /* end for */ - return (j); // this is 'tau_count', i.e. number of reachable reflections - } /* end hkl_search */ - -#pragma acc routine - int hkl_select(struct tau_data *T, int tau_count, double coh_refl, double *sum,_class_particle *_particle) { - int j; - double r = rand0max(coh_refl); - *sum = 0; - for(j = 0; j < tau_count; j++) - { - *sum += T[j].refl; - if(*sum > r) break; + double xsect_factor = pow (2 * PI, 5.0 / 2.0) / (V0 * ki * ki); + j = 0; + for (i = 0; i < count; i++) { + /* Assuming reflections are sorted, stop search when max tau exceeded. */ + if (L[i].tau > tau_max) + break; + /* Check if this reciprocal lattice point is close enough to the + Ewald sphere to make scattering possible. */ + rho_x = kix - L[i].tau_x; + rho_y = kiy - L[i].tau_y; + rho_z = kiz - L[i].tau_z; + rho = sqrt (rho_x * rho_x + rho_y * rho_y + rho_z * rho_z); + diff = fabs (rho - ki); + + /* Check if scattering is possible (cutoff of Gaussian tails). */ + if (diff <= L[i].cutoff) { + /* Store reflection. */ + T[j].index = i; + /* Get ki vector in local coordinates. */ + kx = kix * L[i].u1x + kiy * L[i].u1y + kiz * L[i].u1z; + ky = kix * L[i].u2x + kiy * L[i].u2y + kiz * L[i].u2z; + kz = kix * L[i].u3x + kiy * L[i].u3y + kiz * L[i].u3z; + T[j].rho_x = kx - L[i].tau; + T[j].rho_y = ky; + T[j].rho_z = kz; + T[j].rho = rho; + /* Compute the tangent plane of the Ewald sphere. */ + nx = T[j].rho_x / T[j].rho; + ny = T[j].rho_y / T[j].rho; + nz = T[j].rho_z / T[j].rho; + ox = (ki - T[j].rho) * nx; + oy = (ki - T[j].rho) * ny; + oz = (ki - T[j].rho) * nz; + T[j].ox = ox; + T[j].oy = oy; + T[j].oz = oz; + /* Compute unit vectors b1 and b2 that span the tangent plane. */ + normal_vec (&b1x, &b1y, &b1z, nx, ny, nz); + vec_prod (b2x, b2y, b2z, nx, ny, nz, b1x, b1y, b1z); + T[j].b1x = b1x; + T[j].b1y = b1y; + T[j].b1z = b1z; + T[j].b2x = b2x; + T[j].b2y = b2y; + T[j].b2z = b2z; + /* Compute the 2D projection of the 3D Gauss of the reflection. */ + /* The symmetric 2x2 matrix N describing the 2D gauss. */ + n11 = L[i].m1 * b1x * b1x + L[i].m2 * b1y * b1y + L[i].m3 * b1z * b1z; + n12 = L[i].m1 * b1x * b2x + L[i].m2 * b1y * b2y + L[i].m3 * b1z * b2z; + n22 = L[i].m1 * b2x * b2x + L[i].m2 * b2y * b2y + L[i].m3 * b2z * b2z; + /* The (symmetric) inverse matrix of N. */ + det_N = n11 * n22 - n12 * n12; + inv_n11 = n22 / det_N; + inv_n12 = -n12 / det_N; + inv_n22 = n11 / det_N; + /* The Cholesky decomposition of 1/2*inv_n (lower triangular L). */ + l11 = sqrt (inv_n11 / 2); + l12 = inv_n12 / (2 * l11); + l22 = sqrt (inv_n22 / 2 - l12 * l12); + T[j].l11 = l11; + T[j].l12 = l12; + T[j].l22 = l22; + det_L = l11 * l22; + /* The product B^T D o. */ + Bt_D_O_x = b1x * L[i].m1 * ox + b1y * L[i].m2 * oy + b1z * L[i].m3 * oz; + Bt_D_O_y = b2x * L[i].m1 * ox + b2y * L[i].m2 * oy + b2z * L[i].m3 * oz; + /* Center of 2D Gauss in plane coordinates. */ + y0x = -(Bt_D_O_x * inv_n11 + Bt_D_O_y * inv_n12); + y0y = -(Bt_D_O_x * inv_n12 + Bt_D_O_y * inv_n22); + T[j].y0x = y0x; + T[j].y0y = y0y; + /* Factor alpha for the distance of the 2D Gauss from the origin. */ + alpha = L[i].m1 * ox * ox + L[i].m2 * oy * oy + L[i].m3 * oz * oz - (y0x * y0x * n11 + y0y * y0y * n22 + 2 * y0x * y0y * n12); + T[j].refl = xsect_factor * det_L * exp (-alpha) / L[i].sig123; /* intensity of that Bragg */ + *coh_refl += T[j].refl; /* total scatterable intensity*/ + T[j].xsect = T[j].refl * L[i].F2; + *coh_xsect += T[j].xsect; + j++; } - return j; - } + /*protect against tau shortlist buffer overrrun*/ + if (j == MCSX_REFL_SLIST_SIZE) { + break; + } + } /* end for */ + return (j); // this is 'tau_count', i.e. number of reachable reflections + } /* end hkl_search */ - /* Functions for "reorientation", powder and PG modes */ - /* Powder, forward */ -#pragma acc routine - void randrotate(double *nx, double *ny, double *nz, double a, double b, double c) { - double x1, y1, z1, x2, y2, z2; - rotate(x1, y1, z1, *nx,*ny,*nz, a, 1, 0, 0); /* <1> = rot(,a) */ - rotate(x2, y2, z2, x1, y1, z1, b, 0, 1, 0); /* <2> = rot(<1>,b) */ - rotate(*nx,*ny,*nz, x2, y2, z2, c, 0, 0, 1); /* = rot(<2>,c) */ - } - /* Powder, back */ -#pragma acc routine -void randderotate(double *nx, double *ny, double *nz, double a, double b, double c) { - double x1, y1, z1, x2, y2, z2; - rotate(x1, y1, z1, *nx,*ny,*nz, -c, 0,0,1); - rotate(x2, y2, z2, x1, y1, z1, -b, 0,1,0); - rotate(*nx,*ny,*nz, x2, y2, z2, -a, 1,0,0); - } - /* PG, forward */ -#pragma acc routine -void PGrotate(double *nx, double *ny, double *nz, double a, double csx, double csy, double csz) { - /* Currently assumes c-axis along 'x', ought to be generalized... */ - double nvx, nvy, nvz; - rotate(nvx,nvy,nvz, *nx, *ny, *nz, a, csx, csy, csz); - *nx = nvx; *ny = nvy; *nz = nvz; - } - /* PG, back */ -#pragma acc routine -void PGderotate(double *nx, double *ny, double *nz, double a, double csx, double csy, double csz) { - /* Currently assumes c-axis along 'x', ought to be generalized... */ - double nvx, nvy, nvz; - rotate(nvx,nvy,nvz, *nx, *ny, *nz, -a, csx, csy, csz); - *nx = nvx; *ny = nvy; *nz = nvz; + #pragma acc routine + int + hkl_select (struct tau_data* T, int tau_count, double coh_refl, double* sum, _class_particle* _particle) { + int j; + double r = rand0max (coh_refl); + *sum = 0; + for (j = 0; j < tau_count; j++) { + *sum += T[j].refl; + if (*sum > r) + break; } + return j; + } + /* Functions for "reorientation", powder and PG modes */ + /* Powder, forward */ + #pragma acc routine + void + randrotate (double* nx, double* ny, double* nz, double a, double b, double c) { + double x1, y1, z1, x2, y2, z2; + rotate (x1, y1, z1, *nx, *ny, *nz, a, 1, 0, 0); /* <1> = rot(,a) */ + rotate (x2, y2, z2, x1, y1, z1, b, 0, 1, 0); /* <2> = rot(<1>,b) */ + rotate (*nx, *ny, *nz, x2, y2, z2, c, 0, 0, 1); /* = rot(<2>,c) */ + } + /* Powder, back */ + #pragma acc routine + void + randderotate (double* nx, double* ny, double* nz, double a, double b, double c) { + double x1, y1, z1, x2, y2, z2; + rotate (x1, y1, z1, *nx, *ny, *nz, -c, 0, 0, 1); + rotate (x2, y2, z2, x1, y1, z1, -b, 0, 1, 0); + rotate (*nx, *ny, *nz, x2, y2, z2, -a, 1, 0, 0); + } + /* PG, forward */ + #pragma acc routine + void + PGrotate (double* nx, double* ny, double* nz, double a, double csx, double csy, double csz) { + /* Currently assumes c-axis along 'x', ought to be generalized... */ + double nvx, nvy, nvz; + rotate (nvx, nvy, nvz, *nx, *ny, *nz, a, csx, csy, csz); + *nx = nvx; + *ny = nvy; + *nz = nvz; + } + /* PG, back */ + #pragma acc routine + void + PGderotate (double* nx, double* ny, double* nz, double a, double csx, double csy, double csz) { + /* Currently assumes c-axis along 'x', ought to be generalized... */ + double nvx, nvy, nvz; + rotate (nvx, nvy, nvz, *nx, *ny, *nz, -a, csx, csy, csz); + *nx = nvx; + *ny = nvy; + *nz = nvz; + } + #pragma acc routine + /* rotate vector counterclockwise */ + void + vec_rotate_2d (double* x, double* y, double angle) { + double c, s; + double newx, newy; -#pragma acc routine - /* rotate vector counterclockwise */ - void vec_rotate_2d(double* x, double* y, double angle) { - double c, s; - double newx, newy; - - c = cos(angle); - s = sin(angle); + c = cos (angle); + s = sin (angle); - newx = *x*c - *y*s; - newy = *x*s + *y*c; + newx = *x * c - *y * s; + newy = *x * s + *y * c; - *x = newx; - *y = newy; - } + *x = newx; + *y = newy; + } #ifdef USE_OPENCL struct opencl_context oclContext_SX; - cl_mem d_T=NULL, d_tau_count=NULL, d_coh_refl=NULL, d_coh_xsect=NULL; //OpenCL device buffers - cl_mem d_L=NULL; + cl_mem d_T = NULL, d_tau_count = NULL, d_coh_refl = NULL, d_coh_xsect = NULL; // OpenCL device buffers + cl_mem d_L = NULL; #endif - -#endif /* !SINGLE_CRYSTAL_DECL */ + #endif /* !SINGLE_CRYSTAL_DECL */ %} DECLARE %{ struct hkl_info_struct hkl_info; - off_struct offdata; - struct hkl_data *hkl_list; -#ifndef OPENACC + off_struct offdata; + struct hkl_data* hkl_list; + #ifndef OPENACC struct tau_data tau_list[MCSX_REFL_SLIST_SIZE]; -#endif + #endif %} INITIALIZE %{ double as, bs, cs; - int i=0; + int i = 0; /* 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; @@ -1174,142 +1189,139 @@ 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,F,F2 */ - hkl_info.column_order[0]=1; - hkl_info.column_order[1]=2; - hkl_info.column_order[2]=3; - hkl_info.column_order[3]=0; - hkl_info.column_order[4]=7; + hkl_info.column_order[0] = 1; + hkl_info.column_order[1] = 2; + hkl_info.column_order[2] = 3; + hkl_info.column_order[3] = 0; + hkl_info.column_order[4] = 7; hkl_info.kix = hkl_info.kiy = hkl_info.kiz = 0; hkl_info.nb_reuses = hkl_info.nb_refl = hkl_info.nb_refl_count = 0; hkl_info.tau_count = 0; - hkl_info.flag_barns= barns; + hkl_info.flag_barns = barns; /* ought to be cleaned up as mosaic_AB now is a proper vector/array and not a define */ double* mosaic_ABin = mosaic_AB; /* Read in structure factors, and do some pre-calculations. */ - if (!read_hkl_data(reflections, &hkl_info, &hkl_list, mosaic, mosaic_a, mosaic_b, mosaic_c, mosaic_ABin)) { - printf("Single_crystal: %s: Error: Aborting.\n", NAME_CURRENT_COMP); - exit(-1); + if (!read_hkl_data (reflections, &hkl_info, &hkl_list, mosaic, mosaic_a, mosaic_b, mosaic_c, mosaic_ABin)) { + printf ("Single_crystal: %s: Error: Aborting.\n", NAME_CURRENT_COMP); + 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) { - MPI_MASTER( - printf("Single_crystal: %s: Read %d reflections from file '%s'\n", - NAME_CURRENT_COMP, hkl_info.count, reflections); - ); + MPI_MASTER (printf ("Single_crystal: %s: Read %d reflections from file '%s'\n", NAME_CURRENT_COMP, hkl_info.count, reflections);); } else { - MPI_MASTER( - printf("Single_crystal: %s: Using incoherent elastic scattering only sigma=%g.\n", - NAME_CURRENT_COMP, hkl_info.sigma_i); - ); + MPI_MASTER (printf ("Single_crystal: %s: Using incoherent elastic scattering only sigma=%g.\n", NAME_CURRENT_COMP, hkl_info.sigma_i);); } /*this should not be in hkl_info*/ - 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")) { + 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")) { #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 - if (off_init(geometry, xwidth, yheight, zdepth, 0, &offdata)) { - hkl_info.shape=3; + if (off_init (geometry, xwidth, yheight, zdepth, 0, &offdata)) { + hkl_info.shape = 3; } #endif - } - 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: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); - - MPI_MASTER( - printf("Single_crystal: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", - NAME_CURRENT_COMP, hkl_info.V0, hkl_info.sigma_a, hkl_info.sigma_i, - reflections && strlen(reflections) ? reflections : "NULL"); - ); - if (powder && PG) - exit(fprintf(stderr,"Single_crystal: %s: powder and PG modes can not be used together!\n" - "ERROR Please use EITHER powder or PG mode.\n", NAME_CURRENT_COMP)); + exit (fprintf (stderr, + "Single_crystal: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); - if (powder && !(order==1)) { - fprintf(stderr,"Single_crystal: %s: powder mode means implicit choice of no multiple scattering!\n" - "WARNING setting order=1\n", NAME_CURRENT_COMP); - order=1; + MPI_MASTER (printf ("Single_crystal: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", NAME_CURRENT_COMP, hkl_info.V0, + hkl_info.sigma_a, hkl_info.sigma_i, reflections&& strlen (reflections) ? reflections : "NULL");); + if (powder && PG) + exit (fprintf (stderr, + "Single_crystal: %s: powder and PG modes can not be used together!\n" + "ERROR Please use EITHER powder or PG mode.\n", + NAME_CURRENT_COMP)); + + if (powder && !(order == 1)) { + fprintf (stderr, + "Single_crystal: %s: powder mode means implicit choice of no multiple scattering!\n" + "WARNING setting order=1\n", + NAME_CURRENT_COMP); + order = 1; } - if (PG && !(order==1)) { - fprintf(stderr,"Single_crystal: %s: PG mode means implicit choice of no multiple scattering!\n" - "WARNING setting order=1\n", NAME_CURRENT_COMP); - order=1; + if (PG && !(order == 1)) { + fprintf (stderr, + "Single_crystal: %s: PG mode means implicit choice of no multiple scattering!\n" + "WARNING setting order=1\n", + NAME_CURRENT_COMP); + order = 1; } - - if (order==0 && extra_order) { - fprintf(stderr, "Single_crystal: %s: extra_order used while order=0, then this option has no effect\n", NAME_CURRENT_COMP); + + if (order == 0 && extra_order) { + fprintf (stderr, "Single_crystal: %s: extra_order used while order=0, then this option has no effect\n", NAME_CURRENT_COMP); } - MPI_MASTER( - printf("Direct space lattice orientation:\n"); - printf(" a = [%g %g %g]\n", hkl_info.m_ax, hkl_info.m_ay, hkl_info.m_az); - printf(" b = [%g %g %g]\n", hkl_info.m_bx, hkl_info.m_by, hkl_info.m_bz); - printf(" c = [%g %g %g]\n", hkl_info.m_cx, hkl_info.m_cy, hkl_info.m_cz); - printf("Reciprocal space lattice orientation:\n"); - printf(" a* = [%g %g %g]\n", hkl_info.asx, hkl_info.asy, hkl_info.asz); - printf(" b* = [%g %g %g]\n", hkl_info.bsx, hkl_info.bsy, hkl_info.bsz); - printf(" c* = [%g %g %g]\n", hkl_info.csx, hkl_info.csy, hkl_info.csz); - ); + MPI_MASTER (printf ("Direct space lattice orientation:\n"); printf (" a = [%g %g %g]\n", hkl_info.m_ax, hkl_info.m_ay, hkl_info.m_az); + printf (" b = [%g %g %g]\n", hkl_info.m_bx, hkl_info.m_by, hkl_info.m_bz); + printf (" c = [%g %g %g]\n", hkl_info.m_cx, hkl_info.m_cy, hkl_info.m_cz); printf ("Reciprocal space lattice orientation:\n"); + printf (" a* = [%g %g %g]\n", hkl_info.asx, hkl_info.asy, hkl_info.asz); printf (" b* = [%g %g %g]\n", hkl_info.bsx, hkl_info.bsy, hkl_info.bsz); + printf (" c* = [%g %g %g]\n", hkl_info.csx, hkl_info.csy, hkl_info.csz);); %} TRACE %{ - double t1, t2=0; /* Entry and exit times in sample */ - struct hkl_data *L; /* Structure factor list */ - int i; /* Index into structure factor list */ -#ifndef OPENACC - struct tau_data *T; /* List of reflections close to Ewald sphere */ -#else + double t1, t2 = 0; /* Entry and exit times in sample */ + struct hkl_data* L; /* Structure factor list */ + int i; /* Index into structure factor list */ + #ifndef OPENACC + struct tau_data* T; /* List of reflections close to Ewald sphere */ + #else struct tau_data T[MCSX_REFL_SLIST_SIZE]; -#endif - int tau_count; /* Number of reflections close to Ewald sphere*/ - int j; /* Index into reflection list */ - int event_counter; /* scattering event counter */ - double kix, kiy, kiz, ki; /* Initial wave vector [1/AA] */ - double kfx, kfy, kfz; /* Final wave vector */ - double v; /* Neutron velocity */ - double rho_x, rho_y, rho_z; /* the vector ki - tau */ + #endif + int tau_count; /* Number of reflections close to Ewald sphere*/ + int j; /* Index into reflection list */ + int event_counter; /* scattering event counter */ + double kix, kiy, kiz, ki; /* Initial wave vector [1/AA] */ + double kfx, kfy, kfz; /* Final wave vector */ + double v; /* Neutron velocity */ + double rho_x, rho_y, rho_z; /* the vector ki - tau */ double rho; - double diff; /* Deviation from Bragg condition */ - double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ - double b1x, b1y, b1z; /* First vector spanning tangent plane */ - double b2x, b2y, b2z; /* Second vector spanning tangent plane */ - double n11, n12, n22; /* 2D Gauss description matrix N */ - double det_N; /* Determinant of N */ + double diff; /* Deviation from Bragg condition */ + double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ + double b1x, b1y, b1z; /* First vector spanning tangent plane */ + double b2x, b2y, b2z; /* Second vector spanning tangent plane */ + double n11, n12, n22; /* 2D Gauss description matrix N */ + double det_N; /* Determinant of N */ double inv_n11, inv_n12, inv_n22; /* Inverse of N */ - double l11, l12, l22; /* Cholesky decomposition L of 1/2*inv(N) */ - double det_L; /* Determinant of L */ - double Bt_D_O_x, Bt_D_O_y; /* Temporaries */ - double y0x, y0y; /* Center of 2D Gauss in plane coordinates */ - double alpha; /* Offset of 2D Gauss center from 3D center */ - double V0; /* Volume of unit cell */ - double l_full; /* Neutron path length for transmission */ - double l; /* Path length to scattering event */ - double abs_xsect, abs_xlen; /* Absorption cross section and length */ - double inc_xsect, inc_xlen; /* Incoherent scattering cross section and length */ - double coh_xlen; /* Coherent cross section and length */ - double tot_xsect, tot_xlen; /* Total cross section and length */ - double z1, z2, y1, y2; /* Temporaries to choose kf from 2D Gauss */ - double adjust, sum; /* Temporaries */ + double l11, l12, l22; /* Cholesky decomposition L of 1/2*inv(N) */ + double det_L; /* Determinant of L */ + double Bt_D_O_x, Bt_D_O_y; /* Temporaries */ + double y0x, y0y; /* Center of 2D Gauss in plane coordinates */ + double alpha; /* Offset of 2D Gauss center from 3D center */ + double V0; /* Volume of unit cell */ + double l_full; /* Neutron path length for transmission */ + double l; /* Path length to scattering event */ + double abs_xsect, abs_xlen; /* Absorption cross section and length */ + double inc_xsect, inc_xlen; /* Incoherent scattering cross section and length */ + double coh_xlen; /* Coherent cross section and length */ + double tot_xsect, tot_xlen; /* Total cross section and length */ + double z1, z2, y1, y2; /* Temporaries to choose kf from 2D Gauss */ + double adjust, sum; /* Temporaries */ double p_trans; /* Transmission probability */ double mc_trans, mc_interact; /* Transmission, interaction MC choices */ - int intersect=0; - double theta, phi; /* rotation angles for curved lattice option */ + int intersect = 0; + double theta, phi; /* rotation angles for curved lattice option */ double curv_xangle; double curv_yangle; @@ -1318,8 +1330,8 @@ TRACE double _vy; double _vz; - char type; /* type of last event: t=transmit,c=coherent or i=incoherent */ - int itype; /* type of last event: t=1,c=2 or i=3 */ + char type; /* type of last event: t=transmit,c=coherent or i=incoherent */ + int itype; /* type of last event: t=1,c=2 or i=3 */ #ifdef OPENACC #ifdef USE_OFF @@ -1328,99 +1340,98 @@ TRACE #else #define thread_offdata offdata #endif - + /* Intersection neutron trajectory / sample (sample surface) */ 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); #ifdef USE_OFF else if (hkl_info.shape == 3) - intersect = off_intersect(&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); + intersect = off_intersect (&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); #endif - if (t2 < 0) intersect=0; /* we passed sample volume already */ - - 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; + if (t2 < 0) + intersect = 0; /* we passed sample volume already */ + + 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; /* Scalar cross sections for inc/abs are given in barns, so 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; L = hkl_list; - + type = '\0'; itype = 0; - -#ifndef OPENACC - T = tau_list; + + #ifndef OPENACC + T = tau_list; hkl_info.type = type; -#endif - do { /* Loop over multiple scattering events */ + #endif + do { /* Loop over multiple scattering events */ /* Angles for powder randomization */ double Alpha, Beta, Gamma; - double lab_vx, lab_vy, lab_vz; - - lab_vx = vx; - lab_vy = vy; - lab_vz = vz; + double lab_vx, lab_vy, lab_vz; + + lab_vx = vx; + lab_vy = vy; + lab_vz = vz; 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); #ifdef USE_OFF else if (hkl_info.shape == 3) - intersect = off_intersect(&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata ); + intersect = off_intersect (&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, thread_offdata); #endif - if(!intersect || t2*v < -1e-9 || t1*v > 1e-9) - { + if (!intersect || t2 * v < -1e-9 || t1 * v > 1e-9) { /* neutron is leaving the sample */ if (hkl_info.flag_warning < 10) -#ifndef OPENACC - fprintf(stderr, - "Single_crystal: %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); + #ifndef OPENACC + fprintf (stderr, + "Single_crystal: %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++; -#endif + #endif break; } - l_full = t2*v; - - if ( (order && !(extra_order) && event_counter >= order) - || (order && extra_order && event_counter >= order + extra_order)) { + l_full = t2 * v; + + if ((order && !(extra_order) && event_counter >= order) || (order && extra_order && event_counter >= order + extra_order)) { // Exit due to truncated order, weight with relevant cross-sections to distance l_full - p*=exp(-abs_xlen*l_full); - intersect=0; + p *= exp (-abs_xlen * l_full); + intersect = 0; break; } - + /* (1). Compute incoming wave vector ki */ if (powder) { /* orientation of crystallite is random */ - Alpha = randpm1()*PI*powder; - Beta = randpm1()*PI/2; - Gamma = randpm1()*PI; - randrotate(&vx, &vy, &vz, Alpha, Beta, Gamma); + Alpha = randpm1 () * PI * powder; + Beta = randpm1 () * PI / 2; + Gamma = randpm1 () * PI; + randrotate (&vx, &vy, &vz, Alpha, Beta, Gamma); } if (PG) { /* orientation of crystallite is random along axis */ - Alpha = randpm1()*PI*PG; - PGrotate(&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); + Alpha = randpm1 () * PI * PG; + PGrotate (&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); } /* ------------------------------------------------------------------------- */ @@ -1428,170 +1439,161 @@ TRACE /* WARNING: cannot be used together with the PG c-rotation! */ curv_xangle = 0; curv_yangle = 0; - + _vx = vx; _vy = vy; _vz = vz; - if(RY) { /* rotate v around x axis based on y pos, for vertical focus */ - curv_yangle = atan2(y, RY); - vec_rotate_2d(&vy,&vz, curv_yangle); - vec_rotate_2d(&sy,&sz, curv_yangle); + if (RY) { /* rotate v around x axis based on y pos, for vertical focus */ + curv_yangle = atan2 (y, RY); + vec_rotate_2d (&vy, &vz, curv_yangle); + vec_rotate_2d (&sy, &sz, curv_yangle); - /*changing y,z actually curves the crystal, not only the planes*/ - /*comment out if only curvature of the lattice planes is needed*/ - vec_rotate_2d(&y,&z, curv_yangle); + /*changing y,z actually curves the crystal, not only the planes*/ + /*comment out if only curvature of the lattice planes is needed*/ + vec_rotate_2d (&y, &z, curv_yangle); } - if(RX) { /* rotate v around y axis based on x pos, for horizontal focus */ - curv_xangle = atan2(x, RX); - vec_rotate_2d(&vx,&vz, curv_xangle); - vec_rotate_2d(&sx,&sz, curv_xangle); - - /*changing x,z actually curves the crystal, not only the planes*/ - /*comment out if only curvature of the lattice planes is needed*/ - vec_rotate_2d(&x,&z, curv_xangle); + if (RX) { /* rotate v around y axis based on x pos, for horizontal focus */ + curv_xangle = atan2 (x, RX); + vec_rotate_2d (&vx, &vz, curv_xangle); + vec_rotate_2d (&sx, &sz, curv_xangle); + + /*changing x,z actually curves the crystal, not only the planes*/ + /*comment out if only curvature of the lattice planes is needed*/ + vec_rotate_2d (&x, &z, curv_xangle); } - kix = V2K*vx; - kiy = V2K*vy; - kiz = V2K*vz; + kix = V2K * vx; + kiy = V2K * vy; + kiz = V2K * vz; vx = _vx; vy = _vy; vz = _vz; /* ------------------------------------------------------------------------- */ - - /* (2). Intersection of Ewald sphere with reciprocal lattice points */ - - double coh_xsect = 0, coh_refl = 0; - - // Condition to skip calculation of coherent cross section when, needed for extra_order feature - if (order==0 || extra_order==0 || event_counter < order) { -#ifndef OPENACC - /* in case we use 'SPLIT' then consecutive neutrons can be identical when entering here - and we may skip the hkl_search call. One tau_list is reserved for data for the initial - ray results so that it potentially can be reused later. */ - T = tau_list; - if (order==1 && fabs(kix - hkl_info.kix) < deltak - && fabs(kiy - hkl_info.kiy) < deltak - && fabs(kiz - hkl_info.kiz) < deltak) { - hkl_info.nb_reuses++; - - /* Restore in case of matching event (e.g. SPLIT) */ - coh_refl = hkl_info.coh_refl; - coh_xsect = hkl_info.coh_xsect; - tau_count = hkl_info.tau_count; - } else { -#endif - /* Max possible tau for this ki with 5*sigma delta-d/d cutoff. */ - double tau_max = 2*ki/(1 - 5*hkl_info.m_delta_d_d); - - /* call hkl_search */ - #ifdef USE_OPENCL - if (oclContext_SX.Kernel != NULL){ // the Kernel could be initialised - tau_count = hkl_search_opencl(L, T, hkl_info.count, hkl_info.V0, - kix, kiy, kiz, tau_max, - &coh_refl, &coh_xsect, oclContext_SX, - d_L, d_T, d_tau_count, d_coh_refl, d_coh_xsect); - if (tau_count != 0) - MPI_MASTER( - printf("\nGPU tau_count:%i\n",tau_count); - ); - } - else - #endif - tau_count = hkl_search(L, T, hkl_info.count, hkl_info.V0, - kix, kiy, kiz, tau_max, - &coh_refl, &coh_xsect); + double coh_xsect = 0, coh_refl = 0; - /* store ki so that we can check for further SPLIT iterations */ -#ifndef OPENACC - if (tau_count>hkl_info.max_tau_count){ - hkl_info.max_tau_count=tau_count; - } - if (event_counter == 0 ) { /* only for incoming neutron */ - hkl_info.kix = kix; - hkl_info.kiy = kiy; - hkl_info.kiz = kiz; - - /* Store for potential re-use (e.g. SPLIT) */ - hkl_info.coh_refl = coh_refl; - hkl_info.coh_xsect = coh_xsect; - hkl_info.tau_count = tau_count; - hkl_info.nb_refl += tau_count; - hkl_info.nb_refl_count++; + // Condition to skip calculation of coherent cross section when, needed for extra_order feature + if (order == 0 || extra_order == 0 || event_counter < order) { + #ifndef OPENACC + /* in case we use 'SPLIT' then consecutive neutrons can be identical when entering here + and we may skip the hkl_search call. One tau_list is reserved for data for the initial + ray results so that it potentially can be reused later. */ + T = tau_list; + if (order == 1 && fabs (kix - hkl_info.kix) < deltak && fabs (kiy - hkl_info.kiy) < deltak && fabs (kiz - hkl_info.kiz) < deltak) { + hkl_info.nb_reuses++; + + /* Restore in case of matching event (e.g. SPLIT) */ + coh_refl = hkl_info.coh_refl; + coh_xsect = hkl_info.coh_xsect; + tau_count = hkl_info.tau_count; + } else { + #endif + /* Max possible tau for this ki with 5*sigma delta-d/d cutoff. */ + double tau_max = 2 * ki / (1 - 5 * hkl_info.m_delta_d_d); + + /* call hkl_search */ + #ifdef USE_OPENCL + if (oclContext_SX.Kernel != NULL) { // the Kernel could be initialised + tau_count = hkl_search_opencl (L, T, hkl_info.count, hkl_info.V0, kix, kiy, kiz, tau_max, &coh_refl, &coh_xsect, oclContext_SX, d_L, d_T, d_tau_count, + d_coh_refl, d_coh_xsect); + if (tau_count != 0) + MPI_MASTER (printf ("\nGPU tau_count:%i\n", tau_count);); + } else + #endif + + tau_count = hkl_search (L, T, hkl_info.count, hkl_info.V0, kix, kiy, kiz, tau_max, &coh_refl, &coh_xsect); + + /* store ki so that we can check for further SPLIT iterations */ + #ifndef OPENACC + if (tau_count > hkl_info.max_tau_count) { + hkl_info.max_tau_count = tau_count; + } + if (event_counter == 0) { /* only for incoming neutron */ + hkl_info.kix = kix; + hkl_info.kiy = kiy; + hkl_info.kiz = kiz; + + /* Store for potential re-use (e.g. SPLIT) */ + hkl_info.coh_refl = coh_refl; + hkl_info.coh_xsect = coh_xsect; + hkl_info.tau_count = tau_count; + hkl_info.nb_refl += tau_count; + hkl_info.nb_refl_count++; + } } - } -#endif + #endif } else { - // When extra_order used, disable coherent scattering after order reached, but continue - // Set coherent cross section to zero to ignore coherent part - coh_refl = 0; - coh_xsect = 0; - tau_count = 0; - } - - + // When extra_order used, disable coherent scattering after order reached, but continue + // Set coherent cross section to zero to ignore coherent part + coh_refl = 0; + coh_xsect = 0; + tau_count = 0; + } + /* (3). Probabilities of the different possible interactions. */ /* Cross-sections are in barns = 10**-28 m**2, and unit cell volumes are in AA**3 = 10**-30 m**2. Hence a factor of 100 is used to convert scattering lengths to m**-1 */ - coh_xlen = coh_xsect/V0; + coh_xlen = coh_xsect / V0; if (hkl_info.flag_barns) { coh_xlen *= 100; } /* else assume fm^2 */ tot_xlen = abs_xlen + inc_xlen + coh_xlen; - if(tot_xlen <= 0){ - ABSORB; // Should we really absorb here? If "nothing" can happen we perhaps ought to "pass" instead? + if (tot_xlen <= 0) { + ABSORB; // Should we really absorb here? If "nothing" can happen we perhaps ought to "pass" instead? } - + /* (5). Transmission */ - p_trans = exp(-tot_xlen*l_full); - if(!event_counter && p_transmit >= 0 && p_transmit <= 1) { + p_trans = exp (-tot_xlen * l_full); + if (!event_counter && p_transmit >= 0 && p_transmit <= 1) { mc_trans = p_transmit; /* first event */ } else { mc_trans = p_trans; } mc_interact = 1 - mc_trans; - if(mc_trans > 0 && (mc_trans >= 1 || rand01() < mc_trans)) /* Transmit */ + if (mc_trans > 0 && (mc_trans >= 1 || rand01 () < mc_trans)) /* Transmit */ { - p *= p_trans/mc_trans; - intersect=0; + p *= p_trans / mc_trans; + intersect = 0; if (powder) { /* orientation of crystallite is longer random */ - randderotate(&vx, &vy, &vz, Alpha, Beta, Gamma); + randderotate (&vx, &vy, &vz, Alpha, Beta, Gamma); } if (PG) { /* orientation of crystallite is longer random */ - PGderotate(&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); + PGderotate (&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); } type = 't'; - if (!itype) itype = 1; + if (!itype) + itype = 1; #ifndef OPENACC - hkl_info.type = type; + hkl_info.type = type; #endif - break; + break; /* This break means that we are leaving the while-loop, exiting the crystal by "tunneling". */ } /* Scattering "proper", i.e. coh or incoh */ - if(mc_interact <= 0) /* Protect against rounding errors */ - { intersect=0; - if (powder) { /* orientation of crystallite is no longer random */ - randderotate(&vx, &vy, &vz, Alpha, Beta, Gamma); - } - if (PG) { /* orientation of crystallite is no longer random, rotation around */ - PGderotate(&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); - } - break; + if (mc_interact <= 0) /* Protect against rounding errors */ + { + intersect = 0; + if (powder) { /* orientation of crystallite is no longer random */ + randderotate (&vx, &vy, &vz, Alpha, Beta, Gamma); } + if (PG) { /* orientation of crystallite is no longer random, rotation around */ + PGderotate (&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); + } + break; + } /* First-pass considerations: */ - if (!event_counter) p *= fabs(1 - p_trans)/mc_interact; + if (!event_counter) + p *= fabs (1 - p_trans) / mc_interact; /* Select a point at which to scatter the neutron, taking secondary extinction into account. */ /* dP(l) = exp(-tot_xlen*l)dl @@ -1599,21 +1601,21 @@ TRACE = (1 - exp(-tot_xlen*l0))/tot_xlen l = -log(1 - tot_xlen*rand0max(P(l= tau_count) - { -#ifndef OPENACC + j = hkl_select (T, tau_count, coh_refl, &sum, _particle); + if (j >= tau_count) { + #ifndef OPENACC if (hkl_info.flag_warning < 10) - fprintf(stderr, "Single_crystal: Error: Illegal tau search " - "(sum=%g, j=%i, tau_count=%i).\n", sum, j , tau_count); + fprintf (stderr, + "Single_crystal: Error: Illegal tau search " + "(sum=%g, j=%i, tau_count=%i).\n", + sum, j, tau_count); hkl_info.flag_warning++; -#endif + #endif j = tau_count - 1; } i = T[j].index; /* (8). Pick scattered wavevector kf from 2D Gauss distribution. */ - z1 = randnorm(); - z2 = randnorm(); - y1 = T[j].l11*z1 + T[j].y0x; - y2 = T[j].l12*z1 + T[j].l22*z2 + T[j].y0y; - kfx = T[j].rho_x + T[j].ox + T[j].b1x*y1 + T[j].b2x*y2; - kfy = T[j].rho_y + T[j].oy + T[j].b1y*y1 + T[j].b2y*y2; - kfz = T[j].rho_z + T[j].oz + T[j].b1z*y1 + T[j].b2z*y2; + z1 = randnorm (); + z2 = randnorm (); + y1 = T[j].l11 * z1 + T[j].y0x; + y2 = T[j].l12 * z1 + T[j].l22 * z2 + T[j].y0y; + kfx = T[j].rho_x + T[j].ox + T[j].b1x * y1 + T[j].b2x * y2; + kfy = T[j].rho_y + T[j].oy + T[j].b1y * y1 + T[j].b2y * y2; + kfz = T[j].rho_z + T[j].oz + T[j].b1z * y1 + T[j].b2z * y2; /* Normalize kf to length of ki, to account for planer approximation of the Ewald sphere. */ - adjust = ki/sqrt(kfx*kfx + kfy*kfy + kfz*kfz); + adjust = ki / sqrt (kfx * kfx + kfy * kfy + kfz * kfz); kfx *= adjust; kfy *= adjust; kfz *= adjust; /* Adjust neutron weight (see manual for explanation). */ - double pmul = T[j].xsect*coh_refl/(coh_xsect*T[j].refl); - if (!isnan(pmul)) p *= pmul; - vx = K2V*(L[i].u1x*kfx + L[i].u2x*kfy + L[i].u3x*kfz); - vy = K2V*(L[i].u1y*kfx + L[i].u2y*kfy + L[i].u3y*kfz); - vz = K2V*(L[i].u1z*kfx + L[i].u2z*kfy + L[i].u3z*kfz); - + double pmul = T[j].xsect * coh_refl / (coh_xsect * T[j].refl); + if (!isnan (pmul)) + p *= pmul; + vx = K2V * (L[i].u1x * kfx + L[i].u2x * kfy + L[i].u3x * kfz); + vy = K2V * (L[i].u1y * kfx + L[i].u2y * kfy + L[i].u3y * kfz); + vz = K2V * (L[i].u1z * kfx + L[i].u2z * kfy + L[i].u3z * kfz); + type = 'c'; - if (!itype) itype = 3; -#ifndef OPENACC + if (!itype) + itype = 3; + #ifndef OPENACC hkl_info.type = type; - hkl_info.h = L[i].h; - hkl_info.k = L[i].k; - hkl_info.l = L[i].l; -#endif - + hkl_info.h = L[i].h; + hkl_info.k = L[i].k; + hkl_info.l = L[i].l; + #endif } /* ------------------------------------------------------------------------- */ /* lattice curvature option: rotate back neutron velocity */ - if(RX) { - vec_rotate_2d(&vx,&vz, -curv_xangle); - vec_rotate_2d(&sx,&sz, -curv_xangle); + if (RX) { + vec_rotate_2d (&vx, &vz, -curv_xangle); + vec_rotate_2d (&sx, &sz, -curv_xangle); - /*changing x,z actually curves the crystal, not only the planes*/ - /*comment out if only curvature of the lattice planes is needed*/ - vec_rotate_2d(&x,&z, -curv_xangle); + /*changing x,z actually curves the crystal, not only the planes*/ + /*comment out if only curvature of the lattice planes is needed*/ + vec_rotate_2d (&x, &z, -curv_xangle); } - if(RY) { - vec_rotate_2d(&vy,&vz, -curv_yangle); - vec_rotate_2d(&sy,&sz, -curv_yangle); + if (RY) { + vec_rotate_2d (&vy, &vz, -curv_yangle); + vec_rotate_2d (&sy, &sz, -curv_yangle); - /*changing y,z actually curves the crystal, not only the planes*/ - /*comment out if only curvature of the lattice planes is needed*/ - vec_rotate_2d(&y,&z, -curv_yangle); + /*changing y,z actually curves the crystal, not only the planes*/ + /*comment out if only curvature of the lattice planes is needed*/ + vec_rotate_2d (&y, &z, -curv_yangle); } /* ------------------------------------------------------------------------- */ SCATTER; if (powder) { /* orientation of crystallite is no longer random */ - randderotate(&vx, &vy, &vz, Alpha, Beta, Gamma); + randderotate (&vx, &vy, &vz, Alpha, Beta, Gamma); } if (PG) { /* orientation of crystallite is longer random */ - PGderotate(&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); + PGderotate (&vx, &vy, &vz, Alpha, hkl_info.csx, hkl_info.csy, hkl_info.csz); } /* Repeat loop for next scattering event. */ } while (intersect); /* end do (intersect) (multiple scattering loop) */ @@ -1720,91 +1724,87 @@ TRACE FINALLY %{ -#ifdef USE_MPI - if(mpi_node_rank == mpi_node_root) { -#endif - - if (hkl_info.flag_warning) - fprintf(stderr, "Single_crystal: %s: Error message was repeated %i times with absorbed neutrons.\n", - NAME_CURRENT_COMP, hkl_info.flag_warning); - - /* in case this instance is used in a SPLIT, we can recommend the - optimal iteration value */ - if (hkl_info.max_tau_count>=MCSX_REFL_SLIST_SIZE){ - fprintf(stderr,"Warning (%s): The reflection short list buffer was exhausted at least once. Please consider redefining MCSX_REFL_SLIST_SIZE > %d\n",NAME_CURRENT_COMP,MCSX_REFL_SLIST_SIZE); - } + #ifdef USE_MPI + if (mpi_node_rank == mpi_node_root) { + #endif - if (hkl_info.nb_refl_count) { - double split_iterations = (double)hkl_info.nb_reuses/hkl_info.nb_refl_count + 1; - double split_optimal = (double)hkl_info.nb_refl/hkl_info.nb_refl_count; - if (split_optimal > split_iterations + 5) - printf("Single_crystal: %s: Info: you may highly improve the computation efficiency by using\n" - " SPLIT %i COMPONENT %s=Single_crystal(order=1, ...)\n" - " in the instrument description %s.\n", - NAME_CURRENT_COMP, (int)split_optimal, NAME_CURRENT_COMP, instrument_source); - } - #ifdef USE_OPENCL - if (oclContext_SX.Kernel) { - int iDevice=0; - // clear OpenCL memory - - if (oclContext_SX.GPUContext) clReleaseContext(oclContext_SX.GPUContext); - if (oclContext_SX.Kernel) clReleaseKernel(oclContext_SX.Kernel); - if (oclContext_SX.CommandQueue[iDevice]) clReleaseCommandQueue(oclContext_SX.CommandQueue[iDevice]); - - if (d_L) clReleaseMemObject(d_L); - if (d_T) clReleaseMemObject(d_T); - if (d_tau_count) clReleaseMemObject(d_tau_count); - if (d_coh_refl) clReleaseMemObject(d_coh_refl); - if (d_coh_xsect) clReleaseMemObject(d_coh_xsect); + if (hkl_info.flag_warning) + fprintf (stderr, "Single_crystal: %s: Error message was repeated %i times with absorbed neutrons.\n", NAME_CURRENT_COMP, hkl_info.flag_warning); - } - #endif + /* in case this instance is used in a SPLIT, we can recommend the + optimal iteration value */ + if (hkl_info.max_tau_count >= MCSX_REFL_SLIST_SIZE) { + fprintf (stderr, "Warning (%s): The reflection short list buffer was exhausted at least once. Please consider redefining MCSX_REFL_SLIST_SIZE > %d\n", + NAME_CURRENT_COMP, MCSX_REFL_SLIST_SIZE); + } -#ifdef USE_MPI + if (hkl_info.nb_refl_count) { + double split_iterations = (double)hkl_info.nb_reuses / hkl_info.nb_refl_count + 1; + double split_optimal = (double)hkl_info.nb_refl / hkl_info.nb_refl_count; + if (split_optimal > split_iterations + 5) + printf ("Single_crystal: %s: Info: you may highly improve the computation efficiency by using\n" + " SPLIT %i COMPONENT %s=Single_crystal(order=1, ...)\n" + " in the instrument description %s.\n", + NAME_CURRENT_COMP, (int)split_optimal, NAME_CURRENT_COMP, instrument_source); + } + #ifdef USE_OPENCL + if (oclContext_SX.Kernel) { + int iDevice = 0; + // clear OpenCL memory + + if (oclContext_SX.GPUContext) + clReleaseContext (oclContext_SX.GPUContext); + if (oclContext_SX.Kernel) + clReleaseKernel (oclContext_SX.Kernel); + if (oclContext_SX.CommandQueue[iDevice]) + clReleaseCommandQueue (oclContext_SX.CommandQueue[iDevice]); + + if (d_L) + clReleaseMemObject (d_L); + if (d_T) + clReleaseMemObject (d_T); + if (d_tau_count) + clReleaseMemObject (d_tau_count); + if (d_coh_refl) + clReleaseMemObject (d_coh_refl); + if (d_coh_xsect) + clReleaseMemObject (d_coh_xsect); + } + #endif + + #ifdef USE_MPI } -#endif + #endif %} MCDISPLAY %{ - 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); + 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/samples/Single_magnetic_crystal.comp b/mcstas-comps/samples/Single_magnetic_crystal.comp index 3e6a849ec0..a9131eb003 100644 --- a/mcstas-comps/samples/Single_magnetic_crystal.comp +++ b/mcstas-comps/samples/Single_magnetic_crystal.comp @@ -112,128 +112,122 @@ SHARE %include "read_table-lib" %include "interoff-lib" %include "mccode-complex-lib" -// %include "columnfile" -/* Declare structures and functions only once in each instrument. */ -#ifndef SINGLE_MAGNETIC_CRYSTAL_DECL -#define SINGLE_MAGNETIC_CRYSTAL_DECL - - struct hkl_data - { - int h,k,l; /* Indices for this reflection */ - double F2; /* Value of structure factor */ - cdouble f[4]; /* Structure factors (scattering amplitudes for different spin flips spin up->up, down->down, up->down, down-up */ - double tau_x, tau_y, tau_z; /* Coordinates in reciprocal space */ - double tau; /* Length of (tau_x, tau_y, tau_z) */ - double u1x, u1y, u1z; /* First axis of local coordinate system */ - double u2x, u2y, u2z; /* Second axis of local coordinate system */ - double u3x, u3y, u3z; /* Third axis of local coordinate system */ - double sig1, sig2, sig3; /* RMSs of Gauss axis */ - double sig123; /* The product sig1*sig2*sig3 */ - double m1, m2, m3; /* Diagonal matrix representation of Gauss */ - double cutoff; /* Cutoff value for Gaussian tails */ - }; - - struct hkl_info_struct - { - struct hkl_data *list; /* Reflection array */ - int count; /* Number of reflections */ - struct tau_data *tau_list; /* Reflections close to Ewald Sphere */ - double m_delta_d_d; /* Delta-d/d FWHM */ - double m_ax,m_ay,m_az; /* First unit cell axis (direct space, AA) */ - double m_bx,m_by,m_bz; /* Second unit cell axis */ - double m_cx,m_cy,m_cz; /* Third unit cell axis */ - double asx,asy,asz; /* First reciprocal lattice axis (1/AA) */ - double bsx,bsy,bsz; /* Second reciprocal lattice axis */ - double csx,csy,csz; /* Third reciprocal lattice axis */ - double m_a, m_b, m_c; /* 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 */ - double tau_max; - double tau_min; - double refx,refy,refz; /*chosen polarisation reference direction*/ - }; - - struct tau_data - { - int index; /* Index into reflection table */ - double refl; - double xsect; - double sigma_1, sigma_2; - /* The following vectors are in local koordinates. */ - double kix, kiy, kiz; /* Initial wave vector */ - double rho_x, rho_y, rho_z; /* The vector ki - tau */ - double rho; /* Length of rho vector */ - double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ - double nx, ny, nz; /* Normal vector of Ewald sphere tangent */ - double b1x, b1y, b1z; /* Spanning vectors of Ewald sphere tangent */ - double b2x, b2y, b2z; - double l11, l12, l22; /* Cholesky decomposition L of 2D Gauss */ - double det_L; /* Determinant of L */ - double y0x, y0y; /* 2D Gauss center in tangent plane */ - }; + // %include "columnfile" + /* Declare structures and functions only once in each instrument. */ + #ifndef SINGLE_MAGNETIC_CRYSTAL_DECL + #define SINGLE_MAGNETIC_CRYSTAL_DECL + + struct hkl_data { + int h, k, l; /* Indices for this reflection */ + double F2; /* Value of structure factor */ + cdouble f[4]; /* Structure factors (scattering amplitudes for different spin flips spin up->up, down->down, up->down, down-up */ + double tau_x, tau_y, tau_z; /* Coordinates in reciprocal space */ + double tau; /* Length of (tau_x, tau_y, tau_z) */ + double u1x, u1y, u1z; /* First axis of local coordinate system */ + double u2x, u2y, u2z; /* Second axis of local coordinate system */ + double u3x, u3y, u3z; /* Third axis of local coordinate system */ + double sig1, sig2, sig3; /* RMSs of Gauss axis */ + double sig123; /* The product sig1*sig2*sig3 */ + double m1, m2, m3; /* Diagonal matrix representation of Gauss */ + double cutoff; /* Cutoff value for Gaussian tails */ + }; + + struct hkl_info_struct { + struct hkl_data* list; /* Reflection array */ + int count; /* Number of reflections */ + struct tau_data* tau_list; /* Reflections close to Ewald Sphere */ + double m_delta_d_d; /* Delta-d/d FWHM */ + double m_ax, m_ay, m_az; /* First unit cell axis (direct space, AA) */ + double m_bx, m_by, m_bz; /* Second unit cell axis */ + double m_cx, m_cy, m_cz; /* Third unit cell axis */ + double asx, asy, asz; /* First reciprocal lattice axis (1/AA) */ + double bsx, bsy, bsz; /* Second reciprocal lattice axis */ + double csx, csy, csz; /* Third reciprocal lattice axis */ + double m_a, m_b, m_c; /* 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 */ + double tau_max; + double tau_min; + double refx, refy, refz; /*chosen polarisation reference direction*/ + }; + + struct tau_data { + int index; /* Index into reflection table */ + double refl; + double xsect; + double sigma_1, sigma_2; + /* The following vectors are in local koordinates. */ + double kix, kiy, kiz; /* Initial wave vector */ + double rho_x, rho_y, rho_z; /* The vector ki - tau */ + double rho; /* Length of rho vector */ + double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ + double nx, ny, nz; /* Normal vector of Ewald sphere tangent */ + double b1x, b1y, b1z; /* Spanning vectors of Ewald sphere tangent */ + double b2x, b2y, b2z; + double l11, l12, l22; /* Cholesky decomposition L of 2D Gauss */ + double det_L; /* Determinant of L */ + double y0x, y0y; /* 2D Gauss center in tangent plane */ + }; int - read_hkl_data(char *atoms_file, struct hkl_info_struct *info, - double SC_mosaic, double SC_mosaic_h, double SC_mosaic_v, double SC_mosaic_n) - {/*{{{*/ - struct hkl_data *list = NULL; + read_hkl_data (char* atoms_file, struct hkl_info_struct* info, double SC_mosaic, double SC_mosaic_h, double SC_mosaic_v, double SC_mosaic_n) { /*{{{*/ + struct hkl_data* list = NULL; int size = 0; t_Table sTable; /* sample data table structure from atoms_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; t_Table atoms; - if (!atoms_file || !strlen(atoms_file) || !strcmp(atoms_file,"NULL") || !strcmp(atoms_file,"0" ) ) { + if (!atoms_file || !strlen (atoms_file) || !strcmp (atoms_file, "NULL") || !strcmp (atoms_file, "0")) { info->count = 0; - flag=1; + flag = 1; } if (!flag) { - int status; - if( (status=Table_Read(&atoms,atoms_file,0))==-1){ - fprintf(stderr,"Single_magnetic_crystal: Error reading atom list from file: %s\n",atoms_file);return(0); + int status; + if ((status = Table_Read (&atoms, atoms_file, 0)) == -1) { + fprintf (stderr, "Single_magnetic_crystal: Error reading atom list from file: %s\n", atoms_file); + return (0); } - - printf("index type x y z b\n"); - for (i=0;irecip) {/*{{{*/ - vec_prod(tmp_x, tmp_y, tmp_z, - info->m_bx, info->m_by, info->m_bz, - info->m_cx, info->m_cy, info->m_cz); - info->V0 = fabs(scalar_prod(info->m_ax, info->m_ay, info->m_az, tmp_x, tmp_y, tmp_z)); - printf("V0=%g\n", info->V0); - - info->asx = 2*PI/info->V0*tmp_x; - info->asy = 2*PI/info->V0*tmp_y; - info->asz = 2*PI/info->V0*tmp_z; - vec_prod(tmp_x, tmp_y, tmp_z, info->m_cx, info->m_cy, info->m_cz, info->m_ax, info->m_ay, info->m_az); - info->bsx = 2*PI/info->V0*tmp_x; - info->bsy = 2*PI/info->V0*tmp_y; - info->bsz = 2*PI/info->V0*tmp_z; - vec_prod(tmp_x, tmp_y, tmp_z, info->m_ax, info->m_ay, info->m_az, info->m_bx, info->m_by, info->m_bz); - info->csx = 2*PI/info->V0*tmp_x; - info->csy = 2*PI/info->V0*tmp_y; - info->csz = 2*PI/info->V0*tmp_z; + if (!info->recip) { /*{{{*/ + vec_prod (tmp_x, tmp_y, tmp_z, info->m_bx, info->m_by, info->m_bz, info->m_cx, info->m_cy, info->m_cz); + info->V0 = fabs (scalar_prod (info->m_ax, info->m_ay, info->m_az, tmp_x, tmp_y, tmp_z)); + printf ("V0=%g\n", info->V0); + + info->asx = 2 * PI / info->V0 * tmp_x; + info->asy = 2 * PI / info->V0 * tmp_y; + info->asz = 2 * PI / info->V0 * tmp_z; + vec_prod (tmp_x, tmp_y, tmp_z, info->m_cx, info->m_cy, info->m_cz, info->m_ax, info->m_ay, info->m_az); + info->bsx = 2 * PI / info->V0 * tmp_x; + info->bsy = 2 * PI / info->V0 * tmp_y; + info->bsz = 2 * PI / info->V0 * tmp_z; + vec_prod (tmp_x, tmp_y, tmp_z, info->m_ax, info->m_ay, info->m_az, info->m_bx, info->m_by, info->m_bz); + info->csx = 2 * PI / info->V0 * tmp_x; + info->csy = 2 * PI / info->V0 * tmp_y; + info->csz = 2 * PI / info->V0 * tmp_z; } else { info->asx = info->m_ax; info->asy = info->m_ay; @@ -245,238 +239,261 @@ 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); - - 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->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); + + 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; + } /*}}}*/ /*store lattice vector lengths for later reference*/ - info->m_a=sqrt(scalar_prod(info->m_ax,info->m_ay,info->m_az,info->m_ax,info->m_ay,info->m_az)); - info->m_b=sqrt(scalar_prod(info->m_bx,info->m_by,info->m_bz,info->m_bx,info->m_by,info->m_bz)); - info->m_c=sqrt(scalar_prod(info->m_cx,info->m_cy,info->m_cz,info->m_cx,info->m_cy,info->m_cz)); + info->m_a = sqrt (scalar_prod (info->m_ax, info->m_ay, info->m_az, info->m_ax, info->m_ay, info->m_az)); + info->m_b = sqrt (scalar_prod (info->m_bx, info->m_by, info->m_bz, info->m_bx, info->m_by, info->m_bz)); + info->m_c = sqrt (scalar_prod (info->m_cx, info->m_cy, info->m_cz, info->m_cx, info->m_cy, info->m_cz)); /*give the atom list - calculate the chemical structure factors of a series of hkls that are within the q-range*/ - double as,bs,cs; - as=sqrt(scalar_prod(info->asx,info->asy,info->asz,info->asx,info->asy,info->asz)); - bs=sqrt(scalar_prod(info->bsx,info->bsy,info->bsz,info->bsx,info->bsy,info->bsz)); - cs=sqrt(scalar_prod(info->csx,info->csy,info->csz,info->csx,info->csy,info->csz)); - - cdouble f=cplx(0,0); - if (info->tau_max==-1) - info->tau_max=4*as; - + double as, bs, cs; + as = sqrt (scalar_prod (info->asx, info->asy, info->asz, info->asx, info->asy, info->asz)); + bs = sqrt (scalar_prod (info->bsx, info->bsy, info->bsz, info->bsx, info->bsy, info->bsz)); + cs = sqrt (scalar_prod (info->csx, info->csy, info->csz, info->csx, info->csy, info->csz)); + + cdouble f = cplx (0, 0); + if (info->tau_max == -1) + info->tau_max = 4 * as; + double q; - int h,k,l,m; - + int h, k, l, m; + /* allocate hkl_data array initially make room for 2048 reflections. will be expanded (realloc'd) if needed.*/ - size=2048; - list = (struct hkl_data*)malloc(size*sizeof(struct hkl_data)); + size = 2048; + list = (struct hkl_data*)malloc (size * sizeof (struct hkl_data)); if (!list) { - fprintf(stderr, - "Single_magnetic_crystal: Error allocating reflection list\n"); - return(-1); + fprintf (stderr, "Single_magnetic_crystal: Error allocating reflection list\n"); + return (-1); } - printf("q=[%g %g]\n",info->tau_min,info->tau_max); - printf("as,bs,cs=(%g %g %g)\n",as,bs,cs); - i=0; - for (h=-floor(info->tau_max/as);htau_max/as);h++){ - for (k=-floor(info->tau_max/bs);ktau_max/bs);k++){ - for (l=-floor(info->tau_max/cs);ltau_max/cs);l++){ - if (h==0 && k==0 && l==0) continue; - double qx= (h*info->asx+k*info->bsx+l*info->csx); - double qy= (h*info->asy+k*info->bsy+l*info->csy); - double qz= (h*info->asz+k*info->bsz+l*info->csz); - q=sqrt(qx*qx+qy*qy+qz*qz); - if (qtau_min || q>info->tau_max) continue; - f=cplx(0,0); - cdouble f_tau=cplx(0,0); - cdouble* f_ = malloc(4*sizeof(cdouble)); + printf ("q=[%g %g]\n", info->tau_min, info->tau_max); + printf ("as,bs,cs=(%g %g %g)\n", as, bs, cs); + i = 0; + for (h = -floor (info->tau_max / as); h < ceil (info->tau_max / as); h++) { + for (k = -floor (info->tau_max / bs); k < ceil (info->tau_max / bs); k++) { + for (l = -floor (info->tau_max / cs); l < ceil (info->tau_max / cs); l++) { + if (h == 0 && k == 0 && l == 0) + continue; + double qx = (h * info->asx + k * info->bsx + l * info->csx); + double qy = (h * info->asy + k * info->bsy + l * info->csy); + double qz = (h * info->asz + k * info->bsz + l * info->csz); + q = sqrt (qx * qx + qy * qy + qz * qz); + if (q < info->tau_min || q > info->tau_max) + continue; + f = cplx (0, 0); + cdouble f_tau = cplx (0, 0); + cdouble* f_ = malloc (4 * sizeof (cdouble)); if (!f_) { - fprintf(stderr, - "Single_magnetic_crystal: Error allocating cdouble f_[4]\n"); - return(-1); + fprintf (stderr, "Single_magnetic_crystal: Error allocating cdouble f_[4]\n"); + return (-1); } - f_[0]=f_[1]=f_[2]=f_[3]=cplx(0,0); + f_[0] = f_[1] = f_[2] = f_[3] = cplx (0, 0); - for (m=0;m6){ + double b = Table_Index (atoms, m, 5) / 10; + f_tau = cexp (cplx (0, 2 * M_PI * (h * Table_Index (atoms, m, 2) + k * Table_Index (atoms, m, 3) + l * Table_Index (atoms, m, 4)))); + // printf("%g b=%g r=(%g %g %g) hkl=(%2d %2d %2d), + // exp(-i*2pi*(H.r)=(%g%+gj)\n",atoms.data[m][0],b,atoms.data[m][2],atoms.data[m][3],atoms.data[m][4],h,k,l,creal(f_tau),cimag(f_tau)); + if (atoms.columns > 6) { /*the atom has a magnetic moment*/ - double S_x,S_y,S_z,L_x,L_y,L_z; - double i_x=0,i_y=0,i_z=0; + double S_x, S_y, S_z, L_x, L_y, L_z; + double i_x = 0, i_y = 0, i_z = 0; /*G. Williams Definition of r0 / cm =-gamma*e^2/(m_e c^2)*/ - const double r0=-0.5391e-12; - double g,gs,gl; - double M,beta=0; - gs=Table_Index(atoms,m,6); - /*S_a,S_b,S_c in the file are given in crystal coordinates - so convert that to the crystal cartesian coordinate system*/ - S_x=Table_Index(atoms,m,7)*info->m_ax/info->m_a+Table_Index(atoms,m,8)*info->m_bx/info->m_b+ Table_Index(atoms,m,9)*info->m_cx/info->m_c; - S_y=Table_Index(atoms,m,7)*info->m_ay/info->m_a+Table_Index(atoms,m,8)*info->m_by/info->m_b+ Table_Index(atoms,m,9)*info->m_cy/info->m_c; - S_z=Table_Index(atoms,m,7)*info->m_az/info->m_a+Table_Index(atoms,m,8)*info->m_bz/info->m_b+ Table_Index(atoms,m,9)*info->m_cz/info->m_c; - gl=Table_Index(atoms,m,10); - /*L_a,L_b,L_c in the file are given in crystal coordinates - so convert that to the crystal cartesian coordinate system*/ - L_x=Table_Index(atoms,m,11)*info->m_ax/info->m_a+Table_Index(atoms,m,12)*info->m_bx/info->m_b+ Table_Index(atoms,m,13)*info->m_cx/info->m_c; - L_y=Table_Index(atoms,m,11)*info->m_ay/info->m_a+Table_Index(atoms,m,12)*info->m_by/info->m_b+ Table_Index(atoms,m,13)*info->m_cy/info->m_c; - L_z=Table_Index(atoms,m,11)*info->m_az/info->m_a+Table_Index(atoms,m,12)*info->m_bz/info->m_b+ Table_Index(atoms,m,13)*info->m_cz/info->m_c; - g=gs+gl; - - M=fabs(r0)*g/2*1e12;/*2nd factor to end up with x-sections in barns*/ - if ( (S_x!=0 || S_y!=0 || S_z!=0) ){ + const double r0 = -0.5391e-12; + double g, gs, gl; + double M, beta = 0; + gs = Table_Index (atoms, m, 6); + /*S_a,S_b,S_c in the file are given in crystal coordinates - so convert that to the crystal cartesian coordinate system*/ + S_x = Table_Index (atoms, m, 7) * info->m_ax / info->m_a + Table_Index (atoms, m, 8) * info->m_bx / info->m_b + + Table_Index (atoms, m, 9) * info->m_cx / info->m_c; + S_y = Table_Index (atoms, m, 7) * info->m_ay / info->m_a + Table_Index (atoms, m, 8) * info->m_by / info->m_b + + Table_Index (atoms, m, 9) * info->m_cy / info->m_c; + S_z = Table_Index (atoms, m, 7) * info->m_az / info->m_a + Table_Index (atoms, m, 8) * info->m_bz / info->m_b + + Table_Index (atoms, m, 9) * info->m_cz / info->m_c; + gl = Table_Index (atoms, m, 10); + /*L_a,L_b,L_c in the file are given in crystal coordinates - so convert that to the crystal cartesian coordinate system*/ + L_x = Table_Index (atoms, m, 11) * info->m_ax / info->m_a + Table_Index (atoms, m, 12) * info->m_bx / info->m_b + + Table_Index (atoms, m, 13) * info->m_cx / info->m_c; + L_y = Table_Index (atoms, m, 11) * info->m_ay / info->m_a + Table_Index (atoms, m, 12) * info->m_by / info->m_b + + Table_Index (atoms, m, 13) * info->m_cy / info->m_c; + L_z = Table_Index (atoms, m, 11) * info->m_az / info->m_a + Table_Index (atoms, m, 12) * info->m_bz / info->m_b + + Table_Index (atoms, m, 13) * info->m_cz / info->m_c; + g = gs + gl; + + M = fabs (r0) * g / 2 * 1e12; /*2nd factor to end up with x-sections in barns*/ + if ((S_x != 0 || S_y != 0 || S_z != 0)) { /*S_|_=q_norm x (S x _norm) */ - double S_orto_x,S_orto_y,S_orto_z; - vec_prod(S_orto_x,S_orto_y,S_orto_z,S_x,S_y,S_z,qx,qy,qz); - vec_prod(S_orto_x,S_orto_y,S_orto_z,qx,qy,qz,S_x,S_y,S_z); - S_orto_x/=(q*q);S_orto_y/=(q*q);S_orto_z/=(q*q); + double S_orto_x, S_orto_y, S_orto_z; + vec_prod (S_orto_x, S_orto_y, S_orto_z, S_x, S_y, S_z, qx, qy, qz); + vec_prod (S_orto_x, S_orto_y, S_orto_z, qx, qy, qz, S_x, S_y, S_z); + S_orto_x /= (q * q); + S_orto_y /= (q * q); + S_orto_z /= (q * q); /* Refer to coordinates where polarisation is along z*/ - double mm1sq=scalar_prod(info->refx,info->refy,info->refz,info->refx,info->refy,info->refz); + double mm1sq = scalar_prod (info->refx, info->refy, info->refz, info->refx, info->refy, info->refz); /*gram-schmidt orthogonalization*/ - double mm2x=1,mm2y=0,mm2z=0,mm2sq=1,mm3x=0,mm3y=0,mm3z=1,mm3sq=1; - if (info->refy==0){ - if (info->refx==0 ){mm2x=1;mm2y=0;mm2z=0; mm3x=0;mm3y=1;mm3z=0;} - else {mm2x=0;mm2y=1;mm2z=0; mm3x=0;mm3y=0;mm3z=1;} + double mm2x = 1, mm2y = 0, mm2z = 0, mm2sq = 1, mm3x = 0, mm3y = 0, mm3z = 1, mm3sq = 1; + if (info->refy == 0) { + if (info->refx == 0) { + mm2x = 1; + mm2y = 0; + mm2z = 0; + mm3x = 0; + mm3y = 1; + mm3z = 0; + } else { + mm2x = 0; + mm2y = 1; + mm2z = 0; + mm3x = 0; + mm3y = 0; + mm3z = 1; + } } - double tmpx,tmpy,tmpz; - tmpx= mm2x-scalar_prod(mm2x,mm2y,mm2z,info->refx,info->refy,info->refz)/mm1sq*info->refx; - tmpy= mm2y-scalar_prod(mm2x,mm2y,mm2z,info->refx,info->refy,info->refz)/mm1sq*info->refy; - tmpz= mm2z-scalar_prod(mm2x,mm2y,mm2z,info->refx,info->refy,info->refz)/mm1sq*info->refz; - mm2x=tmpx;mm2y=tmpy;mm2z=tmpz; - mm2sq=scalar_prod(mm2x,mm2y,mm2z,mm2x,mm2y,mm2z); - - tmpx= mm3x-scalar_prod(mm3x,mm3y,mm3z,info->refx,info->refy,info->refz)/mm1sq*info->refx; - tmpy= mm3y-scalar_prod(mm3x,mm3y,mm3z,info->refx,info->refy,info->refz)/mm1sq*info->refy; - tmpz= mm3z-scalar_prod(mm3x,mm3y,mm3z,info->refx,info->refy,info->refz)/mm1sq*info->refz; - mm3x=tmpx;mm3y=tmpy;mm3z=tmpz; - tmpx= mm3x-scalar_prod(mm3x,mm3y,mm3z,mm2x,mm2y,mm2z)/mm2sq*info->refx; - tmpy= mm3y-scalar_prod(mm3x,mm3y,mm3z,mm2x,mm2y,mm2z)/mm2sq*info->refy; - tmpz= mm3z-scalar_prod(mm3x,mm3y,mm3z,mm2x,mm2y,mm2z)/mm2sq*info->refz; - mm3x=tmpx;mm3y=tmpy;mm3z=tmpz; - - S_x=scalar_prod(S_orto_x,S_orto_y,S_orto_z,mm2x,mm2y,mm2z); - S_y=scalar_prod(S_orto_x,S_orto_y,S_orto_z,mm3x,mm3y,mm3z); - S_z=scalar_prod(S_orto_x,S_orto_y,S_orto_z,info->refx,info->refy,info->refz); + double tmpx, tmpy, tmpz; + tmpx = mm2x - scalar_prod (mm2x, mm2y, mm2z, info->refx, info->refy, info->refz) / mm1sq * info->refx; + tmpy = mm2y - scalar_prod (mm2x, mm2y, mm2z, info->refx, info->refy, info->refz) / mm1sq * info->refy; + tmpz = mm2z - scalar_prod (mm2x, mm2y, mm2z, info->refx, info->refy, info->refz) / mm1sq * info->refz; + mm2x = tmpx; + mm2y = tmpy; + mm2z = tmpz; + mm2sq = scalar_prod (mm2x, mm2y, mm2z, mm2x, mm2y, mm2z); + + tmpx = mm3x - scalar_prod (mm3x, mm3y, mm3z, info->refx, info->refy, info->refz) / mm1sq * info->refx; + tmpy = mm3y - scalar_prod (mm3x, mm3y, mm3z, info->refx, info->refy, info->refz) / mm1sq * info->refy; + tmpz = mm3z - scalar_prod (mm3x, mm3y, mm3z, info->refx, info->refy, info->refz) / mm1sq * info->refz; + mm3x = tmpx; + mm3y = tmpy; + mm3z = tmpz; + tmpx = mm3x - scalar_prod (mm3x, mm3y, mm3z, mm2x, mm2y, mm2z) / mm2sq * info->refx; + tmpy = mm3y - scalar_prod (mm3x, mm3y, mm3z, mm2x, mm2y, mm2z) / mm2sq * info->refy; + tmpz = mm3z - scalar_prod (mm3x, mm3y, mm3z, mm2x, mm2y, mm2z) / mm2sq * info->refz; + mm3x = tmpx; + mm3y = tmpy; + mm3z = tmpz; + + S_x = scalar_prod (S_orto_x, S_orto_y, S_orto_z, mm2x, mm2y, mm2z); + S_y = scalar_prod (S_orto_x, S_orto_y, S_orto_z, mm3x, mm3y, mm3z); + S_z = scalar_prod (S_orto_x, S_orto_y, S_orto_z, info->refx, info->refy, info->refz); } - f_[0]=cadd(f_[0],rmul( b -M*S_z + (beta/2)*i_z ,f_tau)); - f_[1]=cadd(f_[1],rmul( b +M*S_z - (beta/2)*i_z ,f_tau)); - f_[2]=cadd(f_[2],cmul( cadd(rmul(-M,cplx(S_x, S_y)) , rmul(beta/2,cplx(i_x, i_y))) ,f_tau)); - f_[3]=cadd(f_[3],cmul( cadd(rmul(-M,cplx(S_x,-S_y)) , rmul(beta/2,cplx(i_x, -i_y))) ,f_tau)); - }else{ + f_[0] = cadd (f_[0], rmul (b - M * S_z + (beta / 2) * i_z, f_tau)); + f_[1] = cadd (f_[1], rmul (b + M * S_z - (beta / 2) * i_z, f_tau)); + f_[2] = cadd (f_[2], cmul (cadd (rmul (-M, cplx (S_x, S_y)), rmul (beta / 2, cplx (i_x, i_y))), f_tau)); + f_[3] = cadd (f_[3], cmul (cadd (rmul (-M, cplx (S_x, -S_y)), rmul (beta / 2, cplx (i_x, -i_y))), f_tau)); + } else { /*scattering is non-magnetic*/ - f_[0]=cadd(f_[0],rmul(b,f_tau)); - f_[1]=cadd(f_[1],rmul(b,f_tau)); - //f_[2]=f_[2]; // +0; - //f_[3]=f_[3]; // +0; + f_[0] = cadd (f_[0], rmul (b, f_tau)); + f_[1] = cadd (f_[1], rmul (b, f_tau)); + // f_[2]=f_[2]; // +0; + // f_[3]=f_[3]; // +0; } } - if (cabs(f_[0])>FLT_EPSILON || cabs(f_[1])>FLT_EPSILON || cabs(f_[2])>FLT_EPSILON || cabs(f_[3])>FLT_EPSILON ){ - list[i].h=h; - list[i].k=k; - list[i].l=l; - for (m=0;m<4;m++){ - list[i].f[m]=f_[m]; - } - list[i].F2=cabs(f_tau)*cabs(f_tau); - if(++i==size){ - size=2*size; - list = (struct hkl_data*)realloc(list,size*sizeof(struct hkl_data)); + if (cabs (f_[0]) > FLT_EPSILON || cabs (f_[1]) > FLT_EPSILON || cabs (f_[2]) > FLT_EPSILON || cabs (f_[3]) > FLT_EPSILON) { + list[i].h = h; + list[i].k = k; + list[i].l = l; + for (m = 0; m < 4; m++) { + list[i].f[m] = f_[m]; + } + list[i].F2 = cabs (f_tau) * cabs (f_tau); + if (++i == size) { + size = 2 * size; + list = (struct hkl_data*)realloc (list, size * sizeof (struct hkl_data)); if (!list) { - fprintf(stderr, - "Single_crystal: Error re-allocating reflection list\n"); - return(-1); + fprintf (stderr, "Single_crystal: Error re-allocating reflection list\n"); + return (-1); } } - printf("(hkl)=(%2d %2d %2d) ",h,k,l); - printf(" |f++|^2=%g |f--|^2=%g |f+-|^2=%g |f-+|^2=%g",cabs(f_[0])*cabs(f_[0]),cabs(f_[1])*cabs(f_[1]),cabs(f_[2])*cabs(f_[2]),cabs(f_[3])*cabs(f_[3])); - printf(" f++=%g%+gj, f--=%g%+gj, f+-=%g%+gj, f-+=%g%+gj\n",creal(f_[0]),cimag(f_[0]),creal(f_[1]),cimag(f_[1]),creal(f_[2]),cimag(f_[2]),creal(f_[3]),cimag(f_[3]) ); + printf ("(hkl)=(%2d %2d %2d) ", h, k, l); + printf (" |f++|^2=%g |f--|^2=%g |f+-|^2=%g |f-+|^2=%g", cabs (f_[0]) * cabs (f_[0]), cabs (f_[1]) * cabs (f_[1]), cabs (f_[2]) * cabs (f_[2]), + cabs (f_[3]) * cabs (f_[3])); + printf (" f++=%g%+gj, f--=%g%+gj, f+-=%g%+gj, f-+=%g%+gj\n", creal (f_[0]), cimag (f_[0]), creal (f_[1]), cimag (f_[1]), creal (f_[2]), + cimag (f_[2]), creal (f_[3]), cimag (f_[3])); } } } } /*set size to actual number of reflections*/ - size=i; + size = i; } - if (flag) return(-1); + if (flag) + return (-1); /*re-loop over reflections and evaluate mosaicity coefficients etc.*/ - for (i=0; iasx + list[i].k*info->bsx + list[i].l*info->csx; - list[i].tau_y = list[i].h*info->asy + list[i].k*info->bsy + list[i].l*info->csy; - list[i].tau_z = list[i].h*info->asz + list[i].k*info->bsz + list[i].l*info->csz; - list[i].tau = sqrt(list[i].tau_x*list[i].tau_x + list[i].tau_y*list[i].tau_y +list[i].tau_z*list[i].tau_z); - list[i].u1x = list[i].tau_x/list[i].tau; - list[i].u1y = list[i].tau_y/list[i].tau; - list[i].u1z = list[i].tau_z/list[i].tau; - list[i].sig1 = FWHM2RMS*info->m_delta_d_d*list[i].tau; + list[i].tau_x = list[i].h * info->asx + list[i].k * info->bsx + list[i].l * info->csx; + list[i].tau_y = list[i].h * info->asy + list[i].k * info->bsy + list[i].l * info->csy; + list[i].tau_z = list[i].h * info->asz + list[i].k * info->bsz + list[i].l * info->csz; + list[i].tau = sqrt (list[i].tau_x * list[i].tau_x + list[i].tau_y * list[i].tau_y + list[i].tau_z * list[i].tau_z); + list[i].u1x = list[i].tau_x / list[i].tau; + list[i].u1y = list[i].tau_y / list[i].tau; + list[i].u1z = list[i].tau_z / list[i].tau; + list[i].sig1 = FWHM2RMS * info->m_delta_d_d * list[i].tau; /* Find two arbitrary axes perpendicular to tau and each other. */ - normal_vec(&b1[0], &b1[1], &b1[2], - list[i].u1x, list[i].u1y, list[i].u1z); - vec_prod(b2[0], b2[1], b2[2], - list[i].u1x, list[i].u1y, list[i].u1z, - b1[0], b1[1], b1[2]); + normal_vec (&b1[0], &b1[1], &b1[2], list[i].u1x, list[i].u1y, list[i].u1z); + vec_prod (b2[0], b2[1], b2[2], list[i].u1x, list[i].u1y, list[i].u1z, b1[0], b1[1], b1[2]); /* Find the two mosaic axes perpendicular to tau. */ - if(SC_mosaic > 0) { + if (SC_mosaic > 0) { /* Use isotropic mosaic. */ list[i].u2x = b1[0]; list[i].u2y = b1[1]; list[i].u2z = b1[2]; - list[i].sig2 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic; + list[i].sig2 = FWHM2RMS * list[i].tau * MIN2RAD * SC_mosaic; list[i].u3x = b2[0]; list[i].u3y = b2[1]; list[i].u3z = b2[2]; - list[i].sig3 = FWHM2RMS*list[i].tau*MIN2RAD*SC_mosaic; - } else { + list[i].sig3 = FWHM2RMS * list[i].tau * MIN2RAD * SC_mosaic; + } else { /* Use anisotropic mosaic. */ - /*This is not implemeted fully yet (see todo below)- therefore exit with a warning*/ - fprintf(stderr,"Single_magnetic_crystal: Anisotropic mosaic not implemented yet - aborting.\n"); - return(0); + /*This is not implemeted fully yet (see todo below)- therefore exit with a warning*/ + fprintf (stderr, "Single_magnetic_crystal: Anisotropic mosaic not implemented yet - aborting.\n"); + return (0); } - list[i].sig123 = list[i].sig1*list[i].sig2*list[i].sig3; - list[i].m1 = 1/(2*list[i].sig1*list[i].sig1); - list[i].m2 = 1/(2*list[i].sig2*list[i].sig2); - list[i].m3 = 1/(2*list[i].sig3*list[i].sig3); + list[i].sig123 = list[i].sig1 * list[i].sig2 * list[i].sig3; + list[i].m1 = 1 / (2 * list[i].sig1 * list[i].sig1); + list[i].m2 = 1 / (2 * list[i].sig2 * list[i].sig2); + list[i].m3 = 1 / (2 * list[i].sig3 * list[i].sig3); /* Set Gauss cutoff to 5 times the maximal sigma. */ - if(list[i].sig1 > list[i].sig2) - if(list[i].sig1 > list[i].sig3) - list[i].cutoff = 5*list[i].sig1; + if (list[i].sig1 > list[i].sig2) + if (list[i].sig1 > list[i].sig3) + list[i].cutoff = 5 * list[i].sig1; else - list[i].cutoff = 5*list[i].sig3; + list[i].cutoff = 5 * list[i].sig3; + else if (list[i].sig2 > list[i].sig3) + list[i].cutoff = 5 * list[i].sig2; else - if(list[i].sig2 > list[i].sig3) - list[i].cutoff = 5*list[i].sig2; - else - list[i].cutoff = 5*list[i].sig3; + list[i].cutoff = 5 * list[i].sig3; } info->list = list; info->count = i; - info->tau_list = malloc(i*sizeof(*info->tau_list)); - if(!info->tau_list) - { - fprintf(stderr, "Single_crystal: Error: Out of memory!\n"); - return(0); + info->tau_list = malloc (i * sizeof (*info->tau_list)); + if (!info->tau_list) { + fprintf (stderr, "Single_crystal: Error: Out of memory!\n"); + return (0); } - return(info->count = i); - }/*}}}*/ -#endif /* !SINGLE_MAGNETIC_CRYSTAL_DECL */ + return (info->count = i); + } /*}}}*/ + #endif /* !SINGLE_MAGNETIC_CRYSTAL_DECL */ %} DECLARE @@ -491,203 +508,203 @@ INITIALIZE /* transfer input parameters */ hkl_info.m_delta_d_d = delta_d_d; - hkl_info.m_ax = na*ax; - hkl_info.m_ay = na*ay; - hkl_info.m_az = na*az; - hkl_info.m_bx = nb*bx; - hkl_info.m_by = nb*by; - hkl_info.m_bz = nb*bz; - hkl_info.m_cx = nc*cx; - hkl_info.m_cy = nc*cy; - hkl_info.m_cz = nc*cz; + hkl_info.m_ax = na * ax; + hkl_info.m_ay = na * ay; + hkl_info.m_az = na * az; + hkl_info.m_bx = nb * bx; + hkl_info.m_by = nb * by; + hkl_info.m_bz = nb * bz; + hkl_info.m_cx = nc * cx; + hkl_info.m_cy = nc * cy; + hkl_info.m_cz = nc * cz; hkl_info.sigma_a = sigma_abs; hkl_info.sigma_i = sigma_inc; hkl_info.recip = recip_cell; - hkl_info.tau_min=q_min; - hkl_info.tau_max=q_max; - if (mx!=0 || my!=0 || mz!=0){ - hkl_info.refx=mx; - hkl_info.refy=my; - hkl_info.refz=mz; - NORM(hkl_info.refx,hkl_info.refy,hkl_info.refz); - }else{ - hkl_info.refx=hkl_info.refz=0;hkl_info.refy=1; + hkl_info.tau_min = q_min; + hkl_info.tau_max = q_max; + if (mx != 0 || my != 0 || mz != 0) { + hkl_info.refx = mx; + hkl_info.refy = my; + hkl_info.refz = mz; + NORM (hkl_info.refx, hkl_info.refy, hkl_info.refz); + } else { + hkl_info.refx = hkl_info.refz = 0; + hkl_info.refy = 1; } /* Read in structure factors, and do some pre-calculations. */ - if (!read_hkl_data(atom_sites, &hkl_info, mosaic, mosaic_h, mosaic_v, mosaic_n)) - exit(-1); + if (!read_hkl_data (atom_sites, &hkl_info, mosaic, mosaic_h, mosaic_v, mosaic_n)) + exit (-1); if (hkl_info.count) - printf("Single_crystal: %s: Read %d reflections from file '%s'\n", - NAME_CURRENT_COMP, hkl_info.count, atom_sites); - else printf("Single_crystal: %s: Using incoherent elastic scattering 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: %s: Read %d reflections from file '%s'\n", NAME_CURRENT_COMP, hkl_info.count, atom_sites); + else + printf ("Single_crystal: %s: Using incoherent elastic scattering 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 */ - - if (hkl_info.shape < 0) - exit(fprintf(stderr,"Single_magnetic_crystal: %s: sample has invalid dimensions.\n" - "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", NAME_CURRENT_COMP)); - - printf("Single_magnetic_crystal: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", - NAME_CURRENT_COMP, hkl_info.V0, hkl_info.sigma_a, hkl_info.sigma_i, atom_sites && strlen(atom_sites) ? atom_sites : "NULL"); - - printf("WARNING; Single_magnetic_crystal has not yet been experimentally validated. Please use caution when intepreting results.\n"); - + } 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_magnetic_crystal: %s: sample has invalid dimensions.\n" + "ERROR Please check parameter values (xwidth, yheight, zdepth, radius).\n", + NAME_CURRENT_COMP)); + + printf ("Single_magnetic_crystal: %s: Vc=%g [Angs] sigma_abs=%g [barn] sigma_inc=%g [barn] reflections=%s\n", NAME_CURRENT_COMP, hkl_info.V0, hkl_info.sigma_a, + hkl_info.sigma_i, atom_sites&& strlen (atom_sites) ? atom_sites : "NULL"); + + printf ("WARNING; Single_magnetic_crystal has not yet been experimentally validated. Please use caution when intepreting results.\n"); %} TRACE %{ - double t1, t2=0; /* Entry and exit times in sample */ - struct hkl_data *L; /* Structure factor list */ - int i; /* Index into structure factor list */ - struct tau_data *T; /* List of reflections close to Ewald sphere */ - int j; /* Index into reflection list */ - int event_counter; /* scattering event counter */ - double kix, kiy, kiz, ki; /* Initial wave vector [1/AA] */ - double kfx, kfy, kfz; /* Final wave vector */ - double v; /* Neutron velocity */ - double tau_max; /* Max tau allowing reflection at this ki */ - double rho_x, rho_y, rho_z; /* the vector ki - tau */ + double t1, t2 = 0; /* Entry and exit times in sample */ + struct hkl_data* L; /* Structure factor list */ + int i; /* Index into structure factor list */ + struct tau_data* T; /* List of reflections close to Ewald sphere */ + int j; /* Index into reflection list */ + int event_counter; /* scattering event counter */ + double kix, kiy, kiz, ki; /* Initial wave vector [1/AA] */ + double kfx, kfy, kfz; /* Final wave vector */ + double v; /* Neutron velocity */ + double tau_max; /* Max tau allowing reflection at this ki */ + double rho_x, rho_y, rho_z; /* the vector ki - tau */ double rho; - double diff; /* Deviation from Bragg condition */ - double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ - double b1x, b1y, b1z; /* First vector spanning tangent plane */ - double b2x, b2y, b2z; /* Second vector spanning tangent plane */ - double n11, n12, n22; /* 2D Gauss description matrix N */ - double det_N; /* Determinant of N */ + double diff; /* Deviation from Bragg condition */ + double ox, oy, oz; /* Origin of Ewald sphere tangent plane */ + double b1x, b1y, b1z; /* First vector spanning tangent plane */ + double b2x, b2y, b2z; /* Second vector spanning tangent plane */ + double n11, n12, n22; /* 2D Gauss description matrix N */ + double det_N; /* Determinant of N */ double inv_n11, inv_n12, inv_n22; /* Inverse of N */ - double l11, l12, l22; /* Cholesky decomposition L of 1/2*inv(N) */ - double det_L; /* Determinant of L */ - double Bt_D_O_x, Bt_D_O_y; /* Temporaries */ - double y0x, y0y; /* Center of 2D Gauss in plane coordinates */ - double alpha; /* Offset of 2D Gauss center from 3D center */ - int tau_count; /* Number of reflections within cutoff */ - double V0; /* Volume of unit cell */ - double l_full; /* Neutron path length for transmission */ - double l; /* Path length to scattering event */ - double abs_xsect, abs_xlen; /* sigma_abs cross section and length */ - double inc_xsect, inc_xlen; /* sigma_inc cross section and length */ - double coh_xsect, coh_xlen; /* Coherent cross section and length */ - double tot_xsect, tot_xlen; /* Total cross section and length */ - double z1, z2, y1, y2; /* Temporaries to choose kf from 2D Gauss */ - double adjust, coh_refl; /* Temporaries */ - double r, sum; /* Temporaries */ - double xsect_factor; /* Common factor in coherent cross-section */ - double p_trans; /* Transmission probability */ - double mc_trans, mc_interact; /* Transmission, interaction MC choices */ - int intersect=0; - + double l11, l12, l22; /* Cholesky decomposition L of 1/2*inv(N) */ + double det_L; /* Determinant of L */ + double Bt_D_O_x, Bt_D_O_y; /* Temporaries */ + double y0x, y0y; /* Center of 2D Gauss in plane coordinates */ + double alpha; /* Offset of 2D Gauss center from 3D center */ + int tau_count; /* Number of reflections within cutoff */ + double V0; /* Volume of unit cell */ + double l_full; /* Neutron path length for transmission */ + double l; /* Path length to scattering event */ + double abs_xsect, abs_xlen; /* sigma_abs cross section and length */ + double inc_xsect, inc_xlen; /* sigma_inc cross section and length */ + double coh_xsect, coh_xlen; /* Coherent cross section and length */ + double tot_xsect, tot_xlen; /* Total cross section and length */ + double z1, z2, y1, y2; /* Temporaries to choose kf from 2D Gauss */ + double adjust, coh_refl; /* Temporaries */ + double r, sum; /* Temporaries */ + double xsect_factor; /* Common factor in coherent cross-section */ + double p_trans; /* Transmission probability */ + double mc_trans, mc_interact; /* Transmission, interaction MC choices */ + int intersect = 0; + /* Intersection neutron trajectory / sample (sample surface) */ 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 (t2 < 0) intersect=0; /* we passed sample volume already */ - - 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; + intersect = off_intersect (&t1, &t2, NULL, NULL, x, y, z, vx, vy, vz, 0, 0, 0, offdata); + + if (t2 < 0) + intersect = 0; /* we passed sample volume already */ + + 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 = 1e2*abs_xsect/V0; - inc_xlen = 1e2*inc_xsect/V0; + V0 = hkl_info.V0; + abs_xlen = 1e2 * abs_xsect / V0; + inc_xlen = 1e2 * inc_xsect / V0; L = hkl_info.list; T = hkl_info.tau_list; - - 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: %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); + if (hkl_info.flag_warning < 100) + fprintf (stderr, + "Single_crystal: %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 */ - kix = V2K*vx; - kiy = V2K*vy; - kiz = V2K*vz; + kix = V2K * vx; + kiy = V2K * vy; + kiz = V2K * vz; /* (2). Intersection of Ewald sphere with reciprocal lattice points */ /* Max possible tau with 5*sigma delta-d/d cutoff. */ - tau_max = 2*ki/(1 - 5*hkl_info.m_delta_d_d); + tau_max = 2 * ki / (1 - 5 * hkl_info.m_delta_d_d); coh_xsect = 0; - coh_refl = 0; - xsect_factor = pow(2*PI, 5.0/2.0)/(V0*ki*ki); - for(i = j = 0; i < hkl_info.count; i++) - { + coh_refl = 0; + xsect_factor = pow (2 * PI, 5.0 / 2.0) / (V0 * ki * ki); + for (i = j = 0; i < hkl_info.count; i++) { /* Assuming reflections are sorted, stop search when max tau exceeded. */ - if(L[i].tau > tau_max) + if (L[i].tau > tau_max) break; /* Check if this reciprocal lattice point is close enough to the Ewald sphere to make scattering possible. */ rho_x = kix - L[i].tau_x; rho_y = kiy - L[i].tau_y; rho_z = kiz - L[i].tau_z; - rho = sqrt(rho_x*rho_x + rho_y*rho_y + rho_z*rho_z); - diff = fabs(rho - ki); + rho = sqrt (rho_x * rho_x + rho_y * rho_y + rho_z * rho_z); + diff = fabs (rho - ki); /* Check if scattering is possible (cutoff of Gaussian tails). */ - if(diff <= L[i].cutoff) - { + if (diff <= L[i].cutoff) { /* Store reflection. */ T[j].index = i; /* Get ki vector in local coordinates. */ - T[j].kix = kix*L[i].u1x + kiy*L[i].u1y + kiz*L[i].u1z; - T[j].kiy = kix*L[i].u2x + kiy*L[i].u2y + kiz*L[i].u2z; - T[j].kiz = kix*L[i].u3x + kiy*L[i].u3y + kiz*L[i].u3z; + T[j].kix = kix * L[i].u1x + kiy * L[i].u1y + kiz * L[i].u1z; + T[j].kiy = kix * L[i].u2x + kiy * L[i].u2y + kiz * L[i].u2z; + T[j].kiz = kix * L[i].u3x + kiy * L[i].u3y + kiz * L[i].u3z; T[j].rho_x = T[j].kix - L[i].tau; T[j].rho_y = T[j].kiy; T[j].rho_z = T[j].kiz; T[j].rho = rho; /* Compute the tangent plane of the Ewald sphere. */ - T[j].nx = T[j].rho_x/T[j].rho; - T[j].ny = T[j].rho_y/T[j].rho; - T[j].nz = T[j].rho_z/T[j].rho; - ox = (ki - T[j].rho)*T[j].nx; - oy = (ki - T[j].rho)*T[j].ny; - oz = (ki - T[j].rho)*T[j].nz; + T[j].nx = T[j].rho_x / T[j].rho; + T[j].ny = T[j].rho_y / T[j].rho; + T[j].nz = T[j].rho_z / T[j].rho; + ox = (ki - T[j].rho) * T[j].nx; + oy = (ki - T[j].rho) * T[j].ny; + oz = (ki - T[j].rho) * T[j].nz; T[j].ox = ox; T[j].oy = oy; T[j].oz = oz; /* Compute unit vectors b1 and b2 that span the tangent plane. */ - normal_vec(&b1x, &b1y, &b1z, T[j].nx, T[j].ny, T[j].nz); - vec_prod(b2x, b2y, b2z, T[j].nx, T[j].ny, T[j].nz, b1x, b1y, b1z); + normal_vec (&b1x, &b1y, &b1z, T[j].nx, T[j].ny, T[j].nz); + vec_prod (b2x, b2y, b2z, T[j].nx, T[j].ny, T[j].nz, b1x, b1y, b1z); T[j].b1x = b1x; T[j].b1y = b1y; T[j].b1z = b1z; @@ -696,45 +713,45 @@ TRACE T[j].b2z = b2z; /* Compute the 2D projection of the 3D Gauss of the reflection. */ /* The symmetric 2x2 matrix N describing the 2D gauss. */ - n11 = L[i].m1*b1x*b1x + L[i].m2*b1y*b1y + L[i].m3*b1z*b1z; - n12 = L[i].m1*b1x*b2x + L[i].m2*b1y*b2y + L[i].m3*b1z*b2z; - n22 = L[i].m1*b2x*b2x + L[i].m2*b2y*b2y + L[i].m3*b2z*b2z; + n11 = L[i].m1 * b1x * b1x + L[i].m2 * b1y * b1y + L[i].m3 * b1z * b1z; + n12 = L[i].m1 * b1x * b2x + L[i].m2 * b1y * b2y + L[i].m3 * b1z * b2z; + n22 = L[i].m1 * b2x * b2x + L[i].m2 * b2y * b2y + L[i].m3 * b2z * b2z; /* The (symmetric) inverse matrix of N. */ - det_N = n11*n22 - n12*n12; - inv_n11 = n22/det_N; - inv_n12 = -n12/det_N; - inv_n22 = n11/det_N; + det_N = n11 * n22 - n12 * n12; + inv_n11 = n22 / det_N; + inv_n12 = -n12 / det_N; + inv_n22 = n11 / det_N; /* The Cholesky decomposition of 1/2*inv_n (lower triangular L). */ - l11 = sqrt(inv_n11/2); - l12 = inv_n12/(2*l11); - l22 = sqrt(inv_n22/2 - l12*l12); + l11 = sqrt (inv_n11 / 2); + l12 = inv_n12 / (2 * l11); + l22 = sqrt (inv_n22 / 2 - l12 * l12); T[j].l11 = l11; T[j].l12 = l12; T[j].l22 = l22; - det_L = l11*l22; + det_L = l11 * l22; T[j].det_L = det_L; /* The product B^T D o. */ - Bt_D_O_x = b1x*L[i].m1*ox + b1y*L[i].m2*oy + b1z*L[i].m3*oz; - Bt_D_O_y = b2x*L[i].m1*ox + b2y*L[i].m2*oy + b2z*L[i].m3*oz; + Bt_D_O_x = b1x * L[i].m1 * ox + b1y * L[i].m2 * oy + b1z * L[i].m3 * oz; + Bt_D_O_y = b2x * L[i].m1 * ox + b2y * L[i].m2 * oy + b2z * L[i].m3 * oz; /* Center of 2D Gauss in plane coordinates. */ - y0x = -(Bt_D_O_x*inv_n11 + Bt_D_O_y*inv_n12); - y0y = -(Bt_D_O_x*inv_n12 + Bt_D_O_y*inv_n22); + y0x = -(Bt_D_O_x * inv_n11 + Bt_D_O_y * inv_n12); + y0y = -(Bt_D_O_x * inv_n12 + Bt_D_O_y * inv_n22); T[j].y0x = y0x; T[j].y0y = y0y; /* Factor alpha for the distance of the 2D Gauss from the origin. */ - alpha = L[i].m1*ox*ox + L[i].m2*oy*oy + L[i].m3*oz*oz - - (y0x*y0x*n11 + y0y*y0y*n22 + 2*y0x*y0y*n12); - T[j].refl = xsect_factor*det_L*exp(-alpha)/L[i].sig123; /* intensity of that Bragg */ - coh_refl += T[j].refl; /* total scatterable intensity */ - /*some logic here to figure out cross-sections for NSF and SF scattering*/ + alpha = L[i].m1 * ox * ox + L[i].m2 * oy * oy + L[i].m3 * oz * oz - (y0x * y0x * n11 + y0y * y0y * n22 + 2 * y0x * y0y * n12); + T[j].refl = xsect_factor * det_L * exp (-alpha) / L[i].sig123; /* intensity of that Bragg */ + coh_refl += T[j].refl; /* total scatterable intensity */ + /*some logic here to figure out cross-sections for NSF and SF scattering*/ cdouble F; - double F2,spin_up,spin_down; + double F2, spin_up, spin_down; /*fractions of spin-up and spin-down incoming neutrons*/ - spin_up=(1+scalar_prod(sx,sy,sz,mx,my,mz))/2; - spin_down=(1-scalar_prod(sx,sy,sz,mx,my,mz))/2; - F2=spin_up*(cabs(L[i].f[0])*cabs(L[i].f[0])+cabs(L[i].f[2])*cabs(L[i].f[2])) + spin_down*(cabs(L[i].f[1])*cabs(L[i].f[1])+cabs(L[i].f[3])*cabs(L[i].f[3])); - //F2=cabs(F)*cabs(F); - T[j].xsect = T[j].refl*F2; + spin_up = (1 + scalar_prod (sx, sy, sz, mx, my, mz)) / 2; + spin_down = (1 - scalar_prod (sx, sy, sz, mx, my, mz)) / 2; + F2 = spin_up * (cabs (L[i].f[0]) * cabs (L[i].f[0]) + cabs (L[i].f[2]) * cabs (L[i].f[2])) + + spin_down * (cabs (L[i].f[1]) * cabs (L[i].f[1]) + cabs (L[i].f[3]) * cabs (L[i].f[3])); + // F2=cabs(F)*cabs(F); + T[j].xsect = T[j].refl * F2; coh_xsect += T[j].xsect; j++; } @@ -746,28 +763,33 @@ TRACE /* Cross-sections are in barns = 10**-28 m**2, and unit cell volumes are in AA**3 = 10**-30 m**2. Hence a factor of 100 is used to convert scattering lengths to m**-1 */ - coh_xlen = 1e2*coh_xsect/V0; - tot_xlen = 1e2*tot_xsect/V0; + coh_xlen = 1e2 * coh_xsect / V0; + tot_xlen = 1e2 * tot_xsect / V0; /* (5). Transmission */ - p_trans = exp(-tot_xlen*l_full); - if(!event_counter && p_transmit >= 0 && p_transmit <= 1) { + p_trans = exp (-tot_xlen * l_full); + if (!event_counter && p_transmit >= 0 && p_transmit <= 1) { mc_trans = p_transmit; /* first event */ } else { mc_trans = p_trans; } mc_interact = 1 - mc_trans; - if(mc_trans > 0 && (mc_trans >= 1 || rand01() < mc_trans)) /* Transmit */ + if (mc_trans > 0 && (mc_trans >= 1 || rand01 () < mc_trans)) /* Transmit */ { - p *= p_trans/mc_trans; - intersect=0; break; + p *= p_trans / mc_trans; + intersect = 0; + break; } - if(tot_xlen <= 0) + if (tot_xlen <= 0) ABSORB; - if(mc_interact <= 0) /* Protect against rounding errors */ - { intersect=0; break; } - if (!event_counter) p *= fabs(1 - p_trans)/mc_interact; + if (mc_interact <= 0) /* Protect against rounding errors */ + { + intersect = 0; + break; + } + if (!event_counter) + p *= fabs (1 - p_trans) / mc_interact; /* Select a point at which to scatter the neutron, taking secondary extinction into account. */ /* dP(l) = exp(-tot_xlen*l)dl @@ -775,92 +797,98 @@ TRACE = (1 - exp(-tot_xlen*l0))/tot_xlen l = -log(1 - tot_xlen*rand0max(P(l r) break; + if (sum > r) + break; } - if(j >= tau_count) - { - fprintf(stderr, "Single_crystal: Error: Illegal tau search " - "(r = %g, sum = %g).\n", r, sum); + if (j >= tau_count) { + fprintf (stderr, + "Single_crystal: Error: Illegal tau search " + "(r = %g, sum = %g).\n", + r, sum); j = tau_count - 1; } i = T[j].index; /* (8). Pick scattered wavevector kf from 2D Gauss distribution. */ - z1 = randnorm(); - z2 = randnorm(); - y1 = T[j].l11*z1 + T[j].y0x; - y2 = T[j].l12*z1 + T[j].l22*z2 + T[j].y0y; - kfx = T[j].rho_x + T[j].ox + T[j].b1x*y1 + T[j].b2x*y2; - kfy = T[j].rho_y + T[j].oy + T[j].b1y*y1 + T[j].b2y*y2; - kfz = T[j].rho_z + T[j].oz + T[j].b1z*y1 + T[j].b2z*y2; + z1 = randnorm (); + z2 = randnorm (); + y1 = T[j].l11 * z1 + T[j].y0x; + y2 = T[j].l12 * z1 + T[j].l22 * z2 + T[j].y0y; + kfx = T[j].rho_x + T[j].ox + T[j].b1x * y1 + T[j].b2x * y2; + kfy = T[j].rho_y + T[j].oy + T[j].b1y * y1 + T[j].b2y * y2; + kfz = T[j].rho_z + T[j].oz + T[j].b1z * y1 + T[j].b2z * y2; /* Normalize kf to length of ki, to account for planer approximation of the Ewald sphere. */ - adjust = ki/sqrt(kfx*kfx + kfy*kfy + kfz*kfz); + adjust = ki / sqrt (kfx * kfx + kfy * kfy + kfz * kfz); kfx *= adjust; kfy *= adjust; kfz *= adjust; /* Adjust neutron weight (see manual for explanation). */ - p *= T[j].xsect*coh_refl/(coh_xsect*T[j].refl); + p *= T[j].xsect * coh_refl / (coh_xsect * T[j].refl); + + vx = K2V * (L[i].u1x * kfx + L[i].u2x * kfy + L[i].u3x * kfz); + vy = K2V * (L[i].u1y * kfx + L[i].u2y * kfy + L[i].u3y * kfz); + vz = K2V * (L[i].u1z * kfx + L[i].u2z * kfy + L[i].u3z * kfz); - vx = K2V*(L[i].u1x*kfx + L[i].u2x*kfy + L[i].u3x*kfz); - vy = K2V*(L[i].u1y*kfx + L[i].u2y*kfy + L[i].u3y*kfz); - vz = K2V*(L[i].u1z*kfx + L[i].u2z*kfy + L[i].u3z*kfz); - /*adjust neutron pol vector*/ - double spin_up,spin_down,P_i,P_f; + double spin_up, spin_down, P_i, P_f; /*fractions of spin-up an0d spin-down for incoming neutrons*/ - P_i=scalar_prod(sx,sy,sz,mx,my,mz); - spin_up=(1+P_i)/2; - spin_down=(1-P_i)/2; + P_i = scalar_prod (sx, sy, sz, mx, my, mz); + spin_up = (1 + P_i) / 2; + spin_down = (1 - P_i) / 2; /*from P-vec get fractions of up and down. New fractions of up and down will be weighted by up->up + down->up etc. Then we construct a new P-vector which obeys this*/ - double sigma_tot,polar; - sigma_tot=spin_up*(cabs(L[i].f[0])*cabs(L[i].f[0]) + cabs(L[i].f[2])*cabs(L[i].f[2])) + spin_down*(cabs(L[i].f[1])*cabs(L[i].f[1]) + cabs(L[i].f[3])*cabs(L[i].f[3])); - polar= ( spin_up*( cabs(L[i].f[0])*cabs(L[i].f[0])) + spin_down*(cabs(L[i].f[3])* cabs(L[i].f[3])) - spin_down*( cabs(L[i].f[1])*cabs(L[i].f[1])) - spin_up*( cabs(L[i].f[2])*cabs(L[i].f[2])) ) / sigma_tot; - if (polar<-1 || polar>1){ - fprintf(stderr,"Single_magnetic_crystal: inconsistent polarisation (%g %g %g %g)\n",spin_up,spin_down,sigma_tot,polar); + double sigma_tot, polar; + sigma_tot = spin_up * (cabs (L[i].f[0]) * cabs (L[i].f[0]) + cabs (L[i].f[2]) * cabs (L[i].f[2])) + + spin_down * (cabs (L[i].f[1]) * cabs (L[i].f[1]) + cabs (L[i].f[3]) * cabs (L[i].f[3])); + polar = (spin_up * (cabs (L[i].f[0]) * cabs (L[i].f[0])) + spin_down * (cabs (L[i].f[3]) * cabs (L[i].f[3])) + - spin_down * (cabs (L[i].f[1]) * cabs (L[i].f[1])) - spin_up * (cabs (L[i].f[2]) * cabs (L[i].f[2]))) + / sigma_tot; + if (polar < -1 || polar > 1) { + fprintf (stderr, "Single_magnetic_crystal: inconsistent polarisation (%g %g %g %g)\n", spin_up, spin_down, sigma_tot, polar); } - double ss=sqrt(scalar_prod(sx,sy,sz,sx,sy,sz)); - if (fabs(P_i)= 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 */ @@ -869,50 +897,38 @@ TRACE FINALLY %{ if (hkl_info.flag_warning) - fprintf(stderr, "Single_crystal: %s: Error message was repeated %i times with absorbed neutrons.\n", - NAME_CURRENT_COMP, hkl_info.flag_warning); + fprintf (stderr, "Single_crystal: %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/samples/TOFRes_sample.comp b/mcstas-comps/samples/TOFRes_sample.comp index efdf2530c3..9d1124fa7c 100644 --- a/mcstas-comps/samples/TOFRes_sample.comp +++ b/mcstas-comps/samples/TOFRes_sample.comp @@ -84,11 +84,11 @@ focus_aw=0, focus_ah=0, xwidth=0, zdepth=0, int target_index=0) SHARE %{ struct Res_sample_struct { - char isrect; /* true when7 sample is a box */ - double distance; /* when non zero, gives rect target distance */ - double aw,ah; /* rectangular angular dimensions */ - double xw,yh; /* rectangular metrical dimensions */ - double tx,ty,tz; /* target coords */ + char isrect; /* true when7 sample is a box */ + double distance; /* when non zero, gives rect target distance */ + double aw, ah; /* rectangular angular dimensions */ + double xw, yh; /* rectangular metrical dimensions */ + double tx, ty, tz; /* target coords */ }; %} @@ -125,34 +125,34 @@ DECLARE INITIALIZE %{ -if (!radius || !yheight) { - if (!xwidth || !yheight || !zdepth) { - exit(fprintf(stderr,"TOFRes_sample: %s: box-shaped sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + if (!radius || !yheight) { + if (!xwidth || !yheight || !zdepth) { + exit (fprintf (stderr, "TOFRes_sample: %s: box-shaped sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + } else { + res_struct.isrect = 1; + } } else { - res_struct.isrect=1; - } - } else { - res_struct.isrect=0; - if (!thickness || thickness >= radius) { - exit(fprintf(stderr,"TOFRes_sample: %s: Hollow of cylindrical sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + res_struct.isrect = 0; + if (!thickness || thickness >= radius) { + exit (fprintf (stderr, "TOFRes_sample: %s: Hollow of cylindrical sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + } } - } - + /* now compute target coords if a component index is supplied */ - if (target_index) - { + 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, &res_struct.tx, &res_struct.ty, &res_struct.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, &res_struct.tx, &res_struct.ty, &res_struct.tz); + } else { + res_struct.tx = target_x; + res_struct.ty = target_y; + res_struct.tz = target_z; } - else - { res_struct.tx = target_x; res_struct.ty = target_y; res_struct.tz = target_z; } - res_struct.distance=sqrt(res_struct.tx*res_struct.tx - +res_struct.ty*res_struct.ty+res_struct.tz*res_struct.tz); + res_struct.distance = sqrt (res_struct.tx * res_struct.tx + res_struct.ty * res_struct.ty + res_struct.tz * res_struct.tz); /* different ways of setting rectangular area */ - res_struct.aw = res_struct.ah = 0; + res_struct.aw = res_struct.ah = 0; if (focus_xw) { res_struct.xw = focus_xw; } @@ -160,106 +160,110 @@ if (!radius || !yheight) { res_struct.yh = focus_yh; } if (focus_aw) { - res_struct.aw = DEG2RAD*focus_aw; + res_struct.aw = DEG2RAD * focus_aw; } if (focus_ah) { - res_struct.ah = DEG2RAD*focus_ah; + res_struct.ah = DEG2RAD * focus_ah; } /* Initialize uservar strings */ - sprintf(res_pi_var,"res_pi_%i",_comp->_index); - sprintf(res_ki_x_var,"res_ki_x_%i",_comp->_index); - sprintf(res_ki_y_var,"res_ki_y_%i",_comp->_index); - sprintf(res_ki_z_var,"res_ki_z_%i",_comp->_index); - sprintf(res_kf_x_var,"res_kf_x_%i",_comp->_index); - sprintf(res_kf_y_var,"res_kf_y_%i",_comp->_index); - sprintf(res_kf_z_var,"res_kf_z_%i",_comp->_index); - sprintf(res_rx_var,"res_rx_%i",_comp->_index); - sprintf(res_ry_var,"res_ry_%i",_comp->_index); - sprintf(res_rz_var,"res_rz_%i",_comp->_index); - compindex=_comp->_index; - + sprintf (res_pi_var, "res_pi_%i", _comp->_index); + sprintf (res_ki_x_var, "res_ki_x_%i", _comp->_index); + sprintf (res_ki_y_var, "res_ki_y_%i", _comp->_index); + sprintf (res_ki_z_var, "res_ki_z_%i", _comp->_index); + sprintf (res_kf_x_var, "res_kf_x_%i", _comp->_index); + sprintf (res_kf_y_var, "res_kf_y_%i", _comp->_index); + sprintf (res_kf_z_var, "res_kf_z_%i", _comp->_index); + sprintf (res_rx_var, "res_rx_%i", _comp->_index); + sprintf (res_ry_var, "res_ry_%i", _comp->_index); + sprintf (res_rz_var, "res_rz_%i", _comp->_index); + compindex = _comp->_index; %} TRACE %{ - double t0, t3; /* Entry/exit time for outer cylinder */ - double t1, t2; /* Entry/exit time for inner cylinder */ - double v; /* Neutron velocity */ + double t0, t3; /* Entry/exit time for outer cylinder */ + double t1, t2; /* Entry/exit time for inner cylinder */ + double v; /* Neutron velocity */ double E; - double l_full; /* Flight path length for non-scattered neutron */ - double flight_time; /* Calculated time-of-flight from source to target (detector) */ - double dt0, dt1, dt2, dt; /* Flight times through sample */ - double solid_angle=0; /* Solid angle of target as seen from scattering point */ + double l_full; /* Flight path length for non-scattered neutron */ + double flight_time; /* Calculated time-of-flight from source to target (detector) */ + double dt0, dt1, dt2, dt; /* Flight times through sample */ + double solid_angle = 0; /* Solid angle of target as seen from scattering point */ double aim_x, aim_y, aim_z, aim_length; - /* Position of target relative to scattering point */ - double norm_factor; /* Normalization factor */ - int intersect=0; - double kix,kiy,kiz; - double kfx,kfy,kfz; + /* Position of target relative to scattering point */ + double norm_factor; /* Normalization factor */ + int intersect = 0; + double kix, kiy, kiz; + double kfx, kfy, kfz; - if(res_struct.isrect) - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + if (res_struct.isrect) + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); - if(intersect) - { - if(t0 < 0) ABSORB; - if(res_struct.isrect) { t1 = t2 = t3; norm_factor = 2*zdepth; } /* box sample */ + if (intersect) { + if (t0 < 0) + ABSORB; + if (res_struct.isrect) { + t1 = t2 = t3; + norm_factor = 2 * zdepth; + } /* box sample */ else { /* Cylindrical sample */ /* Neutron enters at t=t0. */ - /* If cylinder hollow does not exist or is NOT intersected */ - if(thickness==0 || !cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, radius-thickness, yheight)) { + /* If cylinder hollow does not exist or is NOT intersected */ + if (thickness == 0 || !cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness, yheight)) { t1 = t2 = t3; } else { - ABSORB; + ABSORB; } - norm_factor = 2*thickness; /* Maximum path length in the sample for zero vertical divergence */ + norm_factor = 2 * thickness; /* Maximum path length in the sample for zero vertical divergence */ } - dt0 = t1-t0; /* Time in sample, ingoing */ - dt1 = t2-t1; /* Time in hole */ - dt2 = t3-t2; /* Time in sample, outgoing */ - v = sqrt(vx*vx + vy*vy + vz*vz); + dt0 = t1 - t0; /* Time in sample, ingoing */ + dt1 = t2 - t1; /* Time in hole */ + dt2 = t3 - t2; /* Time in sample, outgoing */ + v = sqrt (vx * vx + vy * vy + vz * vz); l_full = v * (dt0 + dt2); /* Length of full path through sample */ - p *= l_full/norm_factor; /* Normalized scattering probability, proportional to path length in the sample */ - dt = rand01()*(dt0+dt2); /* Time of scattering (relative to t0) */ + p *= l_full / norm_factor; /* Normalized scattering probability, proportional to path length in the sample */ + dt = rand01 () * (dt0 + dt2); /* Time of scattering (relative to t0) */ if (dt > dt0) dt += dt1; - PROP_DT(dt+t0); /* Point of scattering */ + PROP_DT (dt + t0); /* Point of scattering */ /* Store initial neutron state. */ - if(p == 0) ABSORB; - kix=V2K*vx; kiy=V2K*vy; kiz=V2K*vz; - particle_setvar_void(_particle, res_pi_var, &p); - particle_setvar_void(_particle, res_ki_x_var, &(kix)); - particle_setvar_void(_particle, res_ki_y_var, &(kiy)); - particle_setvar_void(_particle, res_ki_z_var, &(kiz)); - particle_setvar_void(_particle, res_rx_var, &x); - particle_setvar_void(_particle, res_ry_var, &y); - particle_setvar_void(_particle, res_rz_var, &z); + if (p == 0) + ABSORB; + kix = V2K * vx; + kiy = V2K * vy; + kiz = V2K * vz; + particle_setvar_void (_particle, res_pi_var, &p); + particle_setvar_void (_particle, res_ki_x_var, &(kix)); + particle_setvar_void (_particle, res_ki_y_var, &(kiy)); + particle_setvar_void (_particle, res_ki_z_var, &(kiz)); + particle_setvar_void (_particle, res_rx_var, &x); + particle_setvar_void (_particle, res_ry_var, &y); + particle_setvar_void (_particle, res_rz_var, &z); - aim_x = res_struct.tx-x; /* Vector pointing at target (anal./det.) */ - aim_y = res_struct.ty-y; - aim_z = res_struct.tz-z; - aim_length = sqrt(aim_x*aim_x+aim_y*aim_y+aim_z*aim_z); - if(res_struct.aw && res_struct.ah) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, res_struct.aw, res_struct.ah, ROT_A_CURRENT_COMP); - } else if(res_struct.xw && res_struct.yh) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, res_struct.xw, res_struct.yh, ROT_A_CURRENT_COMP); + aim_x = res_struct.tx - x; /* Vector pointing at target (anal./det.) */ + aim_y = res_struct.ty - y; + aim_z = res_struct.tz - z; + aim_length = sqrt (aim_x * aim_x + aim_y * aim_y + aim_z * aim_z); + if (res_struct.aw && res_struct.ah) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, res_struct.aw, res_struct.ah, ROT_A_CURRENT_COMP); + } else if (res_struct.xw && res_struct.yh) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, res_struct.xw, res_struct.yh, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, focus_r); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); } - NORM(vx, vy, vz); - flight_time = -t + 1e-6*(time_bin + time_width * randpm1()); + NORM (vx, vy, vz); + flight_time = -t + 1e-6 * (time_bin + time_width * randpm1 ()); /* Correct for too large or negative flight_times, based on user-defined f */ - for (; flight_time<0; flight_time += 1/f); - for (; flight_time>1/f; flight_time -= 1/f); + for (; flight_time < 0; flight_time += 1 / f) + ; + for (; flight_time > 1 / f; flight_time -= 1 / f) + ; v = aim_length / flight_time; /* !! Remember later to correct for Jacobian in MC choice, t to V !! */ @@ -269,53 +273,44 @@ TRACE SCATTER; /* Store final neutron state. */ - kfx=V2K*vx; kfy=V2K*vy; kfz=V2K*vz; - particle_setvar_void(_particle, res_kf_x_var, &(kfx)); - particle_setvar_void(_particle, res_kf_y_var, &(kfy)); - particle_setvar_void(_particle, res_kf_z_var, &(kfz)); + kfx = V2K * vx; + kfy = V2K * vy; + kfz = V2K * vz; + particle_setvar_void (_particle, res_kf_x_var, &(kfx)); + particle_setvar_void (_particle, res_kf_y_var, &(kfy)); + particle_setvar_void (_particle, res_kf_z_var, &(kfz)); } %} MCDISPLAY %{ - - if(res_struct.isrect) - { /* Flat sample. */ - double xmin = -0.5*xwidth; - double xmax = 0.5*xwidth; - double ymin = -0.5*yheight; - double ymax = 0.5*yheight; - double len = zdepth/2; - multiline(5, xmin, ymin, -len, - xmax, ymin, -len, - xmax, ymax, -len, - xmin, ymax, -len, - xmin, ymin, -len); - multiline(5, xmin, ymin, len, - xmax, ymin, len, - xmax, ymax, len, - xmin, ymax, len, - xmin, ymin, len); - line(xmin, ymin, -len, xmin, ymin, len); - line(xmax, ymin, -len, xmax, ymin, len); - line(xmin, ymax, -len, xmin, ymax, len); - line(xmax, ymax, -len, xmax, ymax, len); - } - else - { - double radius_i = thickness ? radius-thickness : 0; - circle("xz", 0, yheight/2.0, 0, radius_i); - circle("xz", 0, yheight/2.0, 0, radius); - circle("xz", 0, -yheight/2.0, 0, radius_i); - circle("xz", 0, -yheight/2.0, 0, radius); - line(-radius_i, -yheight/2.0, 0, -radius_i, +yheight/2.0, 0); - line(+radius_i, -yheight/2.0, 0, +radius_i, +yheight/2.0, 0); - line(0, -yheight/2.0, -radius_i, 0, +yheight/2.0, -radius_i); - line(0, -yheight/2.0, +radius_i, 0, +yheight/2.0, +radius_i); - 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); + + if (res_struct.isrect) { /* Flat sample. */ + double xmin = -0.5 * xwidth; + double xmax = 0.5 * xwidth; + double ymin = -0.5 * yheight; + double ymax = 0.5 * yheight; + double len = zdepth / 2; + multiline (5, xmin, ymin, -len, xmax, ymin, -len, xmax, ymax, -len, xmin, ymax, -len, xmin, ymin, -len); + multiline (5, xmin, ymin, len, xmax, ymin, len, xmax, ymax, len, xmin, ymax, len, xmin, ymin, len); + line (xmin, ymin, -len, xmin, ymin, len); + line (xmax, ymin, -len, xmax, ymin, len); + line (xmin, ymax, -len, xmin, ymax, len); + line (xmax, ymax, -len, xmax, ymax, len); + } else { + double radius_i = thickness ? radius - thickness : 0; + circle ("xz", 0, yheight / 2.0, 0, radius_i); + circle ("xz", 0, yheight / 2.0, 0, radius); + circle ("xz", 0, -yheight / 2.0, 0, radius_i); + circle ("xz", 0, -yheight / 2.0, 0, radius); + line (-radius_i, -yheight / 2.0, 0, -radius_i, +yheight / 2.0, 0); + line (+radius_i, -yheight / 2.0, 0, +radius_i, +yheight / 2.0, 0); + line (0, -yheight / 2.0, -radius_i, 0, +yheight / 2.0, -radius_i); + line (0, -yheight / 2.0, +radius_i, 0, +yheight / 2.0, +radius_i); + 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); } %} diff --git a/mcstas-comps/samples/Tunneling_sample.comp b/mcstas-comps/samples/Tunneling_sample.comp index 951ca682db..c0e22d6d2b 100644 --- a/mcstas-comps/samples/Tunneling_sample.comp +++ b/mcstas-comps/samples/Tunneling_sample.comp @@ -86,18 +86,17 @@ focus_aw=0, focus_ah=0, xwidth=0, yheight=0.05, zdepth=0, sigma_abs=5.08, sigma_ SHARE %{ -struct StructVarsV -{ -double sigma_a; /* Absorption cross section per atom (barns) */ + struct StructVarsV { + 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 */ - double distance; /* when non zero, gives rect target distance */ - double aw,ah; /* rectangular angular dimensions */ - double xw,yh; /* rectangular metrical dimensions */ - double tx,ty,tz; /* target coords */ + char isrect; /* true when sample is a box */ + double distance; /* when non zero, gives rect target distance */ + double aw, ah; /* rectangular angular dimensions */ + double xw, yh; /* rectangular metrical dimensions */ + double tx, ty, tz; /* target coords */ }; %} @@ -111,198 +110,190 @@ DECLARE INITIALIZE %{ if (!xwidth || !yheight || !zdepth) /* Cannot define a rectangle */ - if (!radius || !yheight) /* Cannot define a cylinder either */ - exit(fprintf(stderr,"V_sample: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); - else /* It is a cylinder */ - VarsV.isrect=0; - else /* It is a rectangle */ - VarsV.isrect=1; + if (!radius || !yheight) /* Cannot define a cylinder either */ + exit (fprintf (stderr, "V_sample: %s: sample has no volume (zero dimensions)\n", NAME_CURRENT_COMP)); + else /* It is a cylinder */ + VarsV.isrect = 0; + else /* It is a rectangle */ + VarsV.isrect = 1; - VarsV.sigma_a=sigma_abs; - VarsV.sigma_i=sigma_inc; - VarsV.rho = (1/Vc); - VarsV.my_s=(VarsV.rho * 100 * VarsV.sigma_i); - VarsV.my_a_v=(VarsV.rho * 100 * VarsV.sigma_a); + VarsV.sigma_a = sigma_abs; + VarsV.sigma_i = sigma_inc; + VarsV.rho = (1 / Vc); + VarsV.my_s = (VarsV.rho * 100 * VarsV.sigma_i); + VarsV.my_a_v = (VarsV.rho * 100 * VarsV.sigma_a); /* now compute target coords if a component index is supplied */ - VarsV.tx= VarsV.ty=VarsV.tz=0; - if (target_index) - { + VarsV.tx = VarsV.ty = VarsV.tz = 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, &VarsV.tx, &VarsV.ty, &VarsV.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, &VarsV.tx, &VarsV.ty, &VarsV.tz); + } else { + VarsV.tx = target_x; + VarsV.ty = target_y; + VarsV.tz = target_z; } - else - { VarsV.tx = target_x; VarsV.ty = target_y; VarsV.tz = target_z; } if (!(VarsV.tx || VarsV.ty || VarsV.tz)) - printf("Tunneling_sample: %s: The target is not defined. Using direct beam (Z-axis).\n", - NAME_CURRENT_COMP); + printf ("Tunneling_sample: %s: The target is not defined. Using direct beam (Z-axis).\n", NAME_CURRENT_COMP); - VarsV.distance=sqrt(VarsV.tx*VarsV.tx+VarsV.ty*VarsV.ty+VarsV.tz*VarsV.tz); + VarsV.distance = sqrt (VarsV.tx * VarsV.tx + VarsV.ty * VarsV.ty + VarsV.tz * VarsV.tz); /* different ways of setting rectangular area */ - VarsV.aw = VarsV.ah = 0; + VarsV.aw = VarsV.ah = 0; if (focus_xw) { - VarsV.xw = focus_xw; + VarsV.xw = focus_xw; } if (focus_yh) { VarsV.yh = focus_yh; } if (focus_aw) { - VarsV.aw = DEG2RAD*focus_aw; + VarsV.aw = DEG2RAD * focus_aw; } if (focus_ah) { - VarsV.ah = DEG2RAD*focus_ah; + VarsV.ah = DEG2RAD * focus_ah; } /* Check that probabilities are positive and do not exceed unity */ - if (f_tun<0) - ftun=0; + if (f_tun < 0) + ftun = 0; else - ftun=f_tun; - if(f_QE<0) - fQE=0; + ftun = f_tun; + if (f_QE < 0) + fQE = 0; else - fQE=f_QE; - if ((ftun+fQE)>1) { - ftun=0; - printf("Tunneling_sample: Sum of inelastic probabilities > 1. Setting f_tun=0"); - if (fQE>1) { - fQE=0; - printf("Tunneling_sample: Probability fQE > 1. Setting fQE=0."); + fQE = f_QE; + if ((ftun + fQE) > 1) { + ftun = 0; + printf ("Tunneling_sample: Sum of inelastic probabilities > 1. Setting f_tun=0"); + if (fQE > 1) { + fQE = 0; + printf ("Tunneling_sample: Probability fQE > 1. Setting fQE=0."); } } %} 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=0; /* Velocity-dependent attenuation factor */ - double solid_angle=0; /* Solid angle of target as seen from scattering point */ - double aim_x=0, aim_y=0, aim_z=1; /* Position of target relative to scattering point */ - double v_i, v_f, E_i, E_f; /* initial and final energies and velocities */ - double dE; /* Energy transfer */ - double scatt_choice; /* Representing random choice of scattering type */ - int intersect=0; + 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 = 0; /* Velocity-dependent attenuation factor */ + double solid_angle = 0; /* Solid angle of target as seen from scattering point */ + double aim_x = 0, aim_y = 0, aim_z = 1; /* Position of target relative to scattering point */ + double v_i, v_f, E_i, E_f; /* initial and final energies and velocities */ + double dE; /* Energy transfer */ + double scatt_choice; /* Representing random choice of scattering type */ + int intersect = 0; if (VarsV.isrect) - intersect = box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); + intersect = box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth); else - intersect = cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); - if(intersect) - { - if(t0 < 0) ABSORB; /* we already passed the sample; this is illegal */ + intersect = cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight); + if (intersect) { + if (t0 < 0) + ABSORB; /* we already passed the sample; this is illegal */ /* Neutron enters at t=t0. */ - if(VarsV.isrect) + if (VarsV.isrect) + t1 = t2 = t3; + else if (!thickness || !cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness, yheight)) t1 = t2 = t3; - else - if(!thickness || !cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, radius-thickness, yheight)) - t1 = t2 = t3; - dt0 = t1-t0; /* Time in sample, ingoing */ - dt1 = t2-t1; /* Time in hole */ - dt2 = t3-t2; /* Time in sample, outgoing */ - v = sqrt(vx*vx + vy*vy + vz*vz); - l_full = v * (dt0 + dt2); /* Length of full path through sample */ - if (v) my_a = VarsV.my_a_v*(2200/v); + dt0 = t1 - t0; /* Time in sample, ingoing */ + dt1 = t2 - t1; /* Time in hole */ + dt2 = t3 - t2; /* Time in sample, outgoing */ + v = sqrt (vx * vx + vy * vy + vz * vz); + l_full = v * (dt0 + dt2); /* Length of full path through sample */ + if (v) + my_a = VarsV.my_a_v * (2200 / v); - if (p_interact >= 1 || rand01()= 1 || rand01 () < p_interact) /* Scattering */ { - dt = rand01()*(dt0+dt2); /* Time of scattering (relative to t0) */ - l_i = v*dt; /* Penetration in sample: scattering+abs */ + dt = rand01 () * (dt0 + dt2); /* Time of scattering (relative to t0) */ + l_i = v * dt; /* Penetration in sample: scattering+abs */ if (dt > dt0) - dt += dt1; /* jump to 2nd side of cylinder */ + dt += dt1; /* jump to 2nd side of cylinder */ - PROP_DT(dt+t0); /* Point of scattering */ + PROP_DT (dt + t0); /* Point of scattering */ if ((VarsV.tx || VarsV.ty || VarsV.tz)) { - aim_x = VarsV.tx-x; /* Vector pointing at target (anal./det.) */ - aim_y = VarsV.ty-y; - aim_z = VarsV.tz-z; + aim_x = VarsV.tx - x; /* Vector pointing at target (anal./det.) */ + aim_y = VarsV.ty - y; + aim_z = VarsV.tz - z; } - if(VarsV.aw && VarsV.ah) { - randvec_target_rect_angular(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, VarsV.aw, VarsV.ah, ROT_A_CURRENT_COMP); - } else if(VarsV.xw && VarsV.yh) { - randvec_target_rect(&vx, &vy, &vz, &solid_angle, - aim_x, aim_y, aim_z, VarsV.xw, VarsV.yh, ROT_A_CURRENT_COMP); + if (VarsV.aw && VarsV.ah) { + randvec_target_rect_angular (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, VarsV.aw, VarsV.ah, ROT_A_CURRENT_COMP); + } else if (VarsV.xw && VarsV.yh) { + randvec_target_rect (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, VarsV.xw, VarsV.yh, ROT_A_CURRENT_COMP); } else { - randvec_target_circle(&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); + randvec_target_circle (&vx, &vy, &vz, &solid_angle, aim_x, aim_y, aim_z, focus_r); } - NORM(vx, vy, vz); + NORM (vx, vy, vz); - scatt_choice = rand01(); /* chooses type of scattering */ + scatt_choice = rand01 (); /* chooses type of scattering */ v_i = v; /* Store initial velocity in case of inel. */ - E_i = VS2E*v_i*v_i; - if (scatt_choice<(fQE+ftun)) /* Inelastic choices */ - { - if (scatt_choice0) - dE = E_tun; - else - dE = -E_tun; - } - E_f = E_i + dE; - if (E_f <= 0) - ABSORB; - v_f = SE2V*sqrt(E_f); - v = v_f; - } + E_i = VS2E * v_i * v_i; + if (scatt_choice < (fQE + ftun)) /* Inelastic choices */ + { + if (scatt_choice < fQE) /* Quasielastic */ + { + dE = gamma * tan (PI / 2 * randpm1 ()); + } else { + if (randpm1 () > 0) + dE = E_tun; + else + dE = -E_tun; + } + E_f = E_i + dE; + if (E_f <= 0) + ABSORB; + v_f = SE2V * sqrt (E_f); + v = v_f; + } vx *= v; vy *= v; vz *= v; - if(!VarsV.isrect) { - if(!cylinder_intersect(&t0, &t3, x, y, z, vx, vy, vz, radius, yheight)) - { + if (!VarsV.isrect) { + if (!cylinder_intersect (&t0, &t3, x, y, z, vx, vy, vz, radius, yheight)) { /* ??? 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; /* outgoing point */ - if(thickness && cylinder_intersect(&t1, &t2, x, y, z, vx, vy, vz, radius-thickness, yheight) && - t2 > 0) - dt -= (t2-t1); /* Subtract hollow part */ - } - else - { - if(!box_intersect(&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) - { + if (thickness && cylinder_intersect (&t1, &t2, x, y, z, vx, vy, vz, radius - thickness, yheight) && t2 > 0) + dt -= (t2 - t1); /* Subtract hollow part */ + } else { + if (!box_intersect (&t0, &t3, x, y, z, vx, vy, vz, xwidth, yheight, zdepth)) { /* ??? did not hit box */ - printf("FATAL ERROR: Did not hit box from inside.\n"); - exit(1); + printf ("FATAL ERROR: Did not hit box from inside.\n"); + exit (1); } dt = t3; } - l_o = v*dt; /* trajectory after scattering point: absorption only */ + l_o = v * dt; /* trajectory after scattering point: absorption only */ - p *= v/v_i*l_full*VarsV.my_s*exp(-my_a*(l_i+v_i/v*l_o)-VarsV.my_s*l_i); + p *= v / v_i * l_full * VarsV.my_s * exp (-my_a * (l_i + v_i / v * l_o) - VarsV.my_s * l_i); /* We do not consider scattering from 2nd part (outgoing) */ - p /= 4*PI/solid_angle; + p /= 4 * PI / solid_angle; p /= p_interact; /* Polarisation part (1/3 NSF, 2/3 SF) */ - sx *= -1.0/3.0; - sy *= -1.0/3.0; - sz *= -1.0/3.0; + sx *= -1.0 / 3.0; + sy *= -1.0 / 3.0; + sz *= -1.0 / 3.0; SCATTER; - } - else /* Transmitting; always elastic */ + } else /* Transmitting; always elastic */ { - p *= exp(-(my_a+VarsV.my_s)*l_full); - p /= (1-p_interact); + p *= exp (-(my_a + VarsV.my_s) * l_full); + p /= (1 - p_interact); } } %} @@ -310,47 +301,35 @@ TRACE MCDISPLAY %{ - if (!VarsV.isrect) - { - 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); - if (thickness) - { - double radius_i=radius-thickness; - circle("xz", 0, yheight/2.0, 0, radius_i); - circle("xz", 0, -yheight/2.0, 0, radius_i); - line(-radius_i, -yheight/2.0, 0, -radius_i, +yheight/2.0, 0); - line(+radius_i, -yheight/2.0, 0, +radius_i, +yheight/2.0, 0); - line(0, -yheight/2.0, -radius_i, 0, +yheight/2.0, -radius_i); - line(0, -yheight/2.0, +radius_i, 0, +yheight/2.0, +radius_i); + if (!VarsV.isrect) { + 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); + if (thickness) { + double radius_i = radius - thickness; + circle ("xz", 0, yheight / 2.0, 0, radius_i); + circle ("xz", 0, -yheight / 2.0, 0, radius_i); + line (-radius_i, -yheight / 2.0, 0, -radius_i, +yheight / 2.0, 0); + line (+radius_i, -yheight / 2.0, 0, +radius_i, +yheight / 2.0, 0); + line (0, -yheight / 2.0, -radius_i, 0, +yheight / 2.0, -radius_i); + line (0, -yheight / 2.0, +radius_i, 0, +yheight / 2.0, +radius_i); } - } - 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*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 { + 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); } %}