void Ref::Call(CallHelper& call) const
{
this->ToStack();
if (!lua_isfunction(this->_state, -1))
{
lua_pop(this->_state, 1);
throw std::runtime_error("Luasel::Ref: Calling a value that is not a function");
}
call.ClearRets();
auto const& args = call.GetArgList();
if (!lua_checkstack(this->_state, (int)args.size()))
{
lua_pop(this->_state, 1);
throw std::runtime_error("Luasel::Ref: Insufficient Lua stack size for arguments");
}
auto it = args.rbegin();
auto itEnd = args.rend();
for (; it != itEnd; ++it)
it->ToStack();
if (lua_pcall(this->_state, static_cast<int>(args.size()), LUA_MULTRET, 0))
{
std::string e = "Luasel::Ref: Error in function call: ";
e += lua_tostring(this->_state, -1);
lua_pop(this->_state, 1);
throw std::runtime_error(e);
}
while (lua_gettop(this->_state))
{
Ref ret(this->_state);
ret.FromStack();
call.PushRet(ret);
}
}
void Rendezvous(long *nsrc0, double *wgt0)
{
#ifdef OLD_HIST
#ifdef MPI
long n, ntot, *ntsk, *buf, ptr, i, i0, sz1, sz2, nhist, pth, id;
double totwgt, *src1, *src2;
/* Check mode */
if ((long)RDB[DATA_OPTI_MPI_REPRODUCIBILITY] == NO)
return;
Die(FUNCTION_NAME, "Tää ei toimi uuden historiarakenteen kanssa");
/* Check number of mpi tasks */
if (mpitasks == 1)
return;
/* Start timers */
StartTimer(TIMER_MPI_OVERHEAD);
StartTimer(TIMER_MPI_OVERHEAD_TOTAL);
/* Allocate memory for task-wise sizes */
ntsk = (long *)Mem(MEM_ALLOC, mpitasks, sizeof(long));
buf = (long *)Mem(MEM_ALLOC, mpitasks, sizeof(long));
/* Put task-wise value */
buf[mpiid] = *nsrc0;
/* Reduce data */
MPI_Barrier(MPI_COMM_WORLD);
if (MPI_Reduce(buf, ntsk, mpitasks, MPI_LONG, MPI_SUM, 0, MPI_COMM_WORLD)
!= MPI_SUCCESS)
Die(FUNCTION_NAME, "MPI Error");
/* Broadcast data */
MPI_Barrier(MPI_COMM_WORLD);
if (MPI_Bcast(ntsk, mpitasks, MPI_LONG, 0, MPI_COMM_WORLD) != MPI_SUCCESS)
Die(FUNCTION_NAME, "MPI Error");
/* Calculate total size */
ntot = 0;
for (n = 0; n < mpitasks; n++)
ntot = ntot + ntsk[n];
/* Free buffer */
Mem(MEM_FREE, buf);
/* Get size of particle and history data blocks */
sz1 = PARTICLE_BLOCK_SIZE - LIST_DATA_SIZE;
sz2 = HIST_BLOCK_SIZE - LIST_DATA_SIZE;
/* Get size of history array */
if ((nhist = (long)RDB[DATA_HIST_LIST_SIZE]) < 0)
nhist = 0;
/* Allocate memory for histories */
src1 = Mem(MEM_ALLOC, (sz1 + nhist*sz2)*ntot, sizeof(double));
/* Calculate starting point */
i0 = 0;
for (i = 0; i < mpiid; i++)
i0 = i0 + ntsk[i]*(sz1 + nhist*sz2);
/* Reset OpenMP id */
id = 0;
/* Loop over distribution and read data into block */
while (1 != 2)
{
/* Pointer to source distribution */
ptr = (long)RDB[DATA_PART_PTR_SOURCE];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Pointer to first after dummy */
if ((ptr = NextItem(ptr)) < VALID_PTR)
break;
/* Remove particle from source */
RemoveItem(ptr);
/* Copy particle data */
memcpy(&src1[i0], &RDB[ptr + LIST_DATA_SIZE], sz1*sizeof(double));
/* Update pointer */
i0 = i0 + sz1;
/* Pointer to history data */
pth = (long)RDB[ptr + PARTICLE_PTR_HIST];
/* Loop over histories */
for (i = 0; i < nhist; i++)
{
/* Check pointer */
CheckPointer(FUNCTION_NAME, "(pth1)", DATA_ARRAY, pth);
/* Copy history data */
memcpy(&src1[i0], &RDB[pth + LIST_DATA_SIZE], sz2*sizeof(double));
/* Update pointer */
i0 = i0 + sz2;
/* Next */
pth = NextItem(pth);
}
/* Put particle in stack */
ToStack(ptr, id++);
/* Check OpenMP id */
if (id > (long)RDB[DATA_OMP_MAX_THREADS] - 1)
id = 0;
}
/* Allocate memory for temporary data */
if (mpiid == 0)
src2 = Mem(MEM_ALLOC, (sz1 + nhist*sz2)*ntot, sizeof(double));
else
src2 = NULL;
/* Reduce data */
MPI_Barrier(MPI_COMM_WORLD);
MPITransfer(src1, src2, (sz1 + nhist*sz2)*ntot, 0, MPI_METH_RED);
/* Move data back to original */
if (mpiid == 0)
memcpy(src1, src2, (sz1 + nhist*sz2)*ntot*sizeof(double));
/* Free temporary array */
if (mpiid == 0)
Mem(MEM_FREE, src2);
/* Broadcast data */
MPI_Barrier(MPI_COMM_WORLD);
MPITransfer(src1, NULL, (sz1 + nhist*sz2)*ntot, 0, MPI_METH_BC);
/* Reset pointer and OpenMP id */
i0 = 0;
id = 0;
/* Read data back to source */
for (n = 0; n < ntot; n++)
{
/* Get new particle from stack */
ptr = FromStack(PARTICLE_TYPE_NEUTRON, id++);
/* Check OpenMP id */
if (id > (long)RDB[DATA_OMP_MAX_THREADS] - 1)
id = 0;
/* Get pointer to history data (done here to avoid overwrite) */
pth = (long)RDB[ptr + PARTICLE_PTR_HIST];
/* Copy particle data */
memcpy(&WDB[ptr + LIST_DATA_SIZE], &src1[i0], sz1*sizeof(double));
/* Put pointer to history data */
WDB[ptr + PARTICLE_PTR_HIST] = (double)pth;
/* Update pointer */
i0 = i0 + sz1;
/* Loop over histories */
for (i = 0; i < nhist; i++)
{
/* Check pointer */
CheckPointer(FUNCTION_NAME, "(pth2)", DATA_ARRAY, pth);
/* Copy history data */
memcpy(&WDB[pth + LIST_DATA_SIZE], &src1[i0], sz2*sizeof(double));
/* Update pointer */
i0 = i0 + sz2;
/* Next */
pth = NextItem(pth);
}
/* Put particle back to source */
AddItem(DATA_PART_PTR_SOURCE, ptr);
}
/* Free memory */
Mem(MEM_FREE, src1);
Mem(MEM_FREE, ntsk);
/* Calculate number of particles and total weight */
totwgt = 0.0;
n = 0;
/* Pointer to first after dummy */
ptr = (long)RDB[DATA_PART_PTR_SOURCE];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
ptr = NextItem(ptr);
/* Loop over remaining */
while (ptr > VALID_PTR)
{
/* Add to counter and weight */
n++;
totwgt = totwgt + RDB[ptr + PARTICLE_WGT];
/* Next */
ptr = NextItem(ptr);
}
/* Check */
if (n != ntot)
Die(FUNCTION_NAME, "Error in count");
/* Put values */
*nsrc0 = ntot;
*wgt0 = totwgt;
MPI_Barrier(MPI_COMM_WORLD);
/* Stop timers */
StopTimer(TIMER_MPI_OVERHEAD);
StopTimer(TIMER_MPI_OVERHEAD_TOTAL);
#endif
#endif
}
long Collision(long mat, long part, double x, double y, double z, double *u,
double *v, double *w, double *E, double *wgt, double t, long id)
{
long type, rea, nuc, ptr, mt, scatt, icapt;
double totxs, absxs, E0, u0, v0, w0, mu, wgt0, wgt1, wgt2, dE;
/* Check input parameters */
CheckPointer(FUNCTION_NAME, "(mat)", DATA_ARRAY, mat);
CheckPointer(FUNCTION_NAME, "(part)", DATA_ARRAY, part);
CheckValue(FUNCTION_NAME, "x", "", x, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "y", "", y, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "z", "", z, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "cos", "", *u**u+*v**v+*w**w - 1.0, -1E-5, 1E-5);
CheckValue(FUNCTION_NAME, "E", "", *E, ZERO, INFTY);
CheckValue(FUNCTION_NAME, "t", "", t, ZERO, INFTY);
CheckValue(FUNCTION_NAME, "wgt", "", *wgt, ZERO, INFTY);
/* Get particle type */
type = (long)RDB[part + PARTICLE_TYPE];
/* Get pointer to total xs */
if (type == PARTICLE_TYPE_NEUTRON)
ptr = (long)RDB[mat + MATERIAL_PTR_TOTXS];
else
ptr = (long)RDB[mat + MATERIAL_PTR_TOTPHOTXS];
/* Get implicit capture flag */
icapt = (long)RDB[DATA_OPT_IMPL_CAPT];
/* Get initial weight and reset others */
wgt0 = *wgt;
wgt1 = -1.0;
wgt2 = -1.0;
/* Remember values before collision */
E0 = *E;
u0 = *u;
v0 = *v;
w0 = *w;
/* Reset change in change in particle energy */
dE = E0;
/* Weight reduction by implicit capture */
if ((icapt == YES) && (type == PARTICLE_TYPE_NEUTRON))
{
/* Get total xs */
totxs = TotXS(mat, type, *E, id);
/* Get material total absorption xs (may be zero for He) */
if ((ptr = (long)RDB[mat + MATERIAL_PTR_ABSXS]) > VALID_PTR)
absxs = MacroXS(ptr, *E, id);
else
absxs = 0.0;
/* Score capture reaction */
ScoreCapture(mat, -1, wgt0*absxs/totxs, id);
/* Calculate weight reduction */
wgt1 = wgt0*(1.0 - absxs/totxs);
}
else
wgt1 = wgt0;
/* Sample reaction */
if ((rea = SampleReaction(mat, type, *E, wgt1, id)) < VALID_PTR)
{
/* Sample rejected, set final weight */
*wgt = wgt1;
/* Score efficiency */
ptr = (long)RDB[RES_REA_SAMPLING_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, 1.0, ptr, id, 4 - type);
/* Return virtual */
return TRACK_END_VIRT;
}
else
{
/* Score efficiency */
ptr = (long)RDB[RES_REA_SAMPLING_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, 1.0, ptr, id, 2 - type);
}
/* Update collision index */
WDB[part + PARTICLE_COL_IDX] = RDB[part + PARTICLE_COL_IDX] + 1.0;
/* Pointer to nuclide */
nuc = (long)RDB[rea + REACTION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Produce photons */
PhotonProd(nuc, x, y, z, *u, *v, *w, *E, *wgt, t, id);
/* Get reaction mt */
mt = (long)RDB[rea + REACTION_MT];
/* Reset scattering flag */
scatt = NO;
/* Check particle type */
if (type == PARTICLE_TYPE_NEUTRON)
{
/***********************************************************************/
/***** Neutron reactions ***********************************************/
/* Check reaction type */
if (mt == 2)
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Elastic scattering */
ElasticScattering(mat, rea, E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
/* Weight is preserved */
wgt2 = wgt1;
}
else if ((mt == 1002) || (mt == 1004))
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Scattering by S(a,b) laws */
SabScattering(rea, E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
/* Weight is preserved */
wgt2 = wgt1;
}
else if ((mt == 2002) || (mt == 2004))
{
/* S(a,b) scattering with on-the-fly interpolation */
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Scattering by S(a,b) laws */
OTFSabScattering(rea, E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
/* Weight is preserved */
wgt2 = wgt1;
}
else if (RDB[rea + REACTION_TY] == 0.0)
{
/* Capture */
if (icapt == YES)
{
/* Not possible in implicit mode */
Die(FUNCTION_NAME, "Capture reaction in implicit mode");
}
else if ((long)RDB[DATA_NPHYS_SAMPLE_CAPT] == NO)
{
/* Not sampled, return scattering */
return TRACK_END_SCAT;
}
else
{
/* Score capture reaction */
ScoreCapture(mat, rea, wgt1, id);
/* Put particle back in stack */
ToStack(part, id);
/* Exit subroutine */
return TRACK_END_CAPT;
}
}
else if (fabs(RDB[rea + REACTION_TY]) > 100.0)
{
/* Complex reaction */
ComplexRea(rea, part, E, x, y, z, u, v, w, wgt1, &wgt2, t, &dE, id);
/* Check weight */
if (wgt2 > 0.0)
{
/* Set scattering */
scatt = YES;
}
else
{
/* Score capture reaction */
ScoreCapture(mat, rea, wgt1, id);
/* Put particle back in stack */
ToStack(part, id);
/* Exit subroutine */
return TRACK_END_CAPT;
}
}
else if (((mt > 17) && (mt < 22)) || (mt == 38))
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_FISS] == NO)
{
/* Tätä muutettiin 18.7.2013 / 2.1.15 sillai että */
/* readacefile.c:ssä fission TY laitetaan nollaksi, */
/* eli koko listaa ei pitäisi luoda. */
Die(FUNCTION_NAME, "Shouldn't be here");
/* Check if capture is sampled */
if ((long)RDB[DATA_NPHYS_SAMPLE_CAPT] == NO)
return TRACK_END_SCAT;
else
{
/* Put particle back in stack */
ToStack(part, id);
/* Exit subroutine */
return TRACK_END_CAPT;
}
}
/* Sample fission */
Fission(mat, rea, part, E, t, x, y, z, u, v, w, wgt1, &wgt2, id);
/* Put particle back in stack */
ToStack(part, id);
/* Exit subroutine */
return TRACK_END_FISS;
}
else if ((mt > 50) && (mt < 91))
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Inelastic level scattering */
LevelScattering(rea, E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
/* Weight is preserved */
wgt2 = wgt1;
}
else if (RDB[rea + REACTION_WGT_F] > 1.0)
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Multiplying scattering reaction */
Nxn(rea, part, E, x, y, z, u, v, w, wgt1, &wgt2, t, &dE, id);
/* Set scattering flag */
scatt = YES;
}
else if (mt < 100)
{
/* Check sampling */
if ((long)RDB[DATA_NPHYS_SAMPLE_SCATT] == NO)
return TRACK_END_SCAT;
/* Continuum single neutron reactions */
InelasticScattering(rea, E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
/* Weight is preserved */
wgt2 = wgt1;
}
else
{
/* Unknown reaction mode */
Die(FUNCTION_NAME, "Unknown reaction mode %ld sampled", mt);
}
/***********************************************************************/
}
else
{
/***** Photon reactions ************************************************/
if (mt == 504)
{
/* Incoherent (Compton) scattering */
ComptonScattering(mat, rea, part, E, x, y, z, u, v, w, *wgt, t, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
}
else if (mt == 502)
{
/* Coherent (Rayleigh) scattering */
RayleighScattering(rea, *E, u, v, w, id);
/* Set scattering flag and calculate change in energy */
scatt = YES;
dE = dE - *E;
}
else if (mt == 522)
{
/* Score capture rate */
ptr = (long)RDB[RES_PHOTOELE_CAPT_RATE];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, *wgt, ptr, id, 0);
/* Photoelectric effect */
Photoelectric(mat, rea, part, *E, x, y, z, *u, *v, *w, *wgt, t, id);
/* Incident photon is killed */
return TRACK_END_CAPT;
}
else if (mt == 516)
{
/* Score capture rate */
ptr = (long)RDB[RES_PAIRPROD_CAPT_RATE];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, *wgt, ptr, id, 0);
/* Pair production */
PairProduction(mat, rea, part, *E, x, y, z, *u, *v, *w, *wgt, t, id);
/* Incident photon is killed */
return TRACK_END_CAPT;
}
else
Die(FUNCTION_NAME, "Invalid reaction mode %ld sampled", mt);
/* Set weight */
wgt2 = wgt1;
/***********************************************************************/
}
/* Check final weight */
if (wgt2 < 0.0)
Die(FUNCTION_NAME, "Error in weight");
/* Apply weight window */
if (WeightWindow(-1, part, x, y, z, *u, *v, *w, *E, &wgt2, t, NO, id)
== TRACK_END_WCUT)
{
/* Exit subroutine */
return TRACK_END_WCUT;
}
/* Russian roulette */
if (wgt2 < RDB[DATA_OPT_ROULETTE_W0])
{
if (RandF(id) < RDB[DATA_OPT_ROULETTE_P0])
wgt2 = wgt2/RDB[DATA_OPT_ROULETTE_P0];
else
{
/* Put particle back in stack */
ToStack(part, id);
/* Exit subroutine */
return TRACK_END_WCUT;
}
}
/* Set final weight */
*wgt = wgt2;
/* Check energy, weight and cosines */
CheckValue(FUNCTION_NAME, "E", "", *E, ZERO, INFTY);
CheckValue(FUNCTION_NAME, "wgt", "", *wgt, ZERO, INFTY);
CheckValue(FUNCTION_NAME, "r", "", *u**u + *v**v + *w**w - 1.0, -1E-5, 1E-5);
/* Check with boundaries */
if (type == PARTICLE_TYPE_NEUTRON)
{
/* Adjust neutron energy */
if (*E < 1.0000001*RDB[DATA_NEUTRON_EMIN])
*E = 1.000001*RDB[DATA_NEUTRON_EMIN];
else if (*E > 0.999999*RDB[DATA_NEUTRON_EMAX])
*E = 0.999999*RDB[DATA_NEUTRON_EMAX];
/* Check scattering flag */
if (scatt == YES)
{
/* Calculate scattering cosine */
mu = *u*u0 + *v*v0 + *w*w0;
/* Score scattering */
ScoreScattering(mat, rea, mu, E0, *E, wgt1, wgt2, id);
/* Score recoil detector */
RecoilDet(mat, dE, x, y, z, u0, v0, w0, E0, t, wgt1, id);
/* Score mesh */
ScoreMesh(part, mat, 0.0, dE, x, y, z, E0, t, wgt1, 1.0, id);
}
/* Set time of thermalization */
if ((RDB[part + PARTICLE_TT] == 0.0) && (*E < 0.625E-6))
WDB[part + PARTICLE_TT] = t;
}
else
{
/* Do energy cut-off for photons or adjust upper boundary */
if (*E < RDB[DATA_PHOTON_EMIN])
{
/* Put particle back in stack */
ToStack(part, id);
/* Score cut-off */
ptr = (long)RDB[RES_TOT_PHOTON_CUTRATE];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, *wgt, ptr, id, 0);
/* Exit subroutine */
return TRACK_END_ECUT;
}
else if (*E > 0.999999*RDB[DATA_PHOTON_EMAX])
*E = 0.999999*RDB[DATA_PHOTON_EMAX];
}
/* Check that reaction was scattering */
if (scatt == NO)
Die(FUNCTION_NAME, "not a scattering reaction");
/* Exit subroutine */
return TRACK_END_SCAT;
/***************************************************************************/
}