bool wxMacPageMarginsDialog::TransferDataFromWindow()
{
wxPoint topLeft, bottomRight;
if (!CheckValue(m_LeftMargin, &topLeft.x, m_MinMarginTopLeft.x, wxT("left margin"))) return false;
if (!CheckValue(m_TopMargin, &topLeft.y, m_MinMarginTopLeft.y, wxT("top margin"))) return false;
if (!CheckValue(m_RightMargin, &bottomRight.x, m_MinMarginBottomRight.x, wxT("right margin"))) return false;
if (!CheckValue(m_BottomMargin, &bottomRight.y, m_MinMarginBottomRight.y, wxT("bottom margin"))) return false;
m_pageSetupDialogData->SetMarginTopLeft(topLeft);
m_pageSetupDialogData->SetMarginBottomRight(bottomRight);
return true;
}
void IsotropicDirection(double *u, double *v, double *w, long id)
{
double rand1, rand2, rand3, C1, C2;
/* Use the rejection method described in Lux & Koblinger, pp. 21-22. */
do
{
rand1 = 2.0*RandF(id) - 1.0;
rand2 = 2.0*RandF(id) - 1.0;
C1 = rand1*rand1 + rand2*rand2;
}
while (C1 > 1.0);
rand3 = 2.0*RandF(id) - 1.0;
C2 = sqrt(1 - rand3*rand3);
*u = C2*(rand1*rand1 - rand2*rand2)/C1;
*v = C2*2.0*rand1*rand2/C1;
*w = rand3;
/* Check value and exit. */
CheckValue(FUNCTION_NAME, "r", "", *u**u+*v**v+*w**w - 1.0, -1E-10, 1E-10);
}
bool CDlgOffsetTS::SaveData()
{
bool bOK = true;
if( !CheckValue() )
{
bOK = false;
CString csMsg = _T("");
csMsg.Format("Offset value is out of range.! %5.2f ~ %5.2f",
m.Setting.m_dOffsetHighLimit, m.Setting.m_dOffsetLowLimit);
AfxMessageBox( csMsg );
return bOK;
}
UpdateData();
// Test Site
m_Offset.TestSite.contact = m_dOffsetTSContact;
m_Offset.TestSite.pick = m_dOffsetTSPick;
m_Offset.TestSite.place = m_dOffsetTSPlace;
m.m_Offset = m_Offset;
f.SaveOffset();
return bOK;
}
/**
* Perform a Get and Set on a variable
*
* \param p_this: The object that hold the variable
* \param psz_name: the name of the variable
* \param i_action: the action to perform
* \param p_val: The action parameter
* \return vlc error codes
*/
int var_GetAndSet( vlc_object_t *p_this, const char *psz_name, int i_action,
vlc_value_t *p_val )
{
variable_t *p_var;
vlc_value_t oldval;
assert( p_this );
assert( p_val );
vlc_object_internals_t *p_priv = vlc_internals( p_this );
p_var = Lookup( p_this, psz_name );
if( p_var == NULL )
{
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_ENOVAR;
}
WaitUnused( p_this, p_var );
/* Duplicated data if needed */
//p_var->ops->pf_dup( &val );
/* Backup needed stuff */
oldval = p_var->val;
/* depending of the action requiered */
switch( i_action )
{
case VLC_VAR_BOOL_TOGGLE:
assert( ( p_var->i_type & VLC_VAR_BOOL ) == VLC_VAR_BOOL );
p_var->val.b_bool = !p_var->val.b_bool;
break;
case VLC_VAR_INTEGER_ADD:
assert( ( p_var->i_type & VLC_VAR_INTEGER ) == VLC_VAR_INTEGER );
p_var->val.i_int += p_val->i_int;
break;
case VLC_VAR_INTEGER_OR:
assert( ( p_var->i_type & VLC_VAR_INTEGER ) == VLC_VAR_INTEGER );
p_var->val.i_int |= p_val->i_int;
break;
case VLC_VAR_INTEGER_NAND:
assert( ( p_var->i_type & VLC_VAR_INTEGER ) == VLC_VAR_INTEGER );
p_var->val.i_int &= ~p_val->i_int;
break;
default:
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_EGENERIC;
}
/* Check boundaries */
CheckValue( p_var, &p_var->val );
*p_val = p_var->val;
/* Deal with callbacks.*/
TriggerCallback( p_this, p_var, psz_name, oldval );
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_SUCCESS;
}
bool STG::GetEncodedValue(const char ** attr, std::string & value, const std::string & attrName)
{
if (!CheckValue(attr, attrName))
return false;
Decode21str(value, attr[1]);
return true;
}
BOOL CCutFile::OnView()
{
// TODO: Add your control notification handler code here
UpdateData(TRUE);
if(!CheckValue())
{
MessageBox("Input value over");
return FALSE;
}
DWORD dwType;
ZeroMemory(&m_stRealBegin, sizeof(FRAME_POS));
ZeroMemory(&m_stRealEnd, sizeof(FRAME_POS));
if(m_nType == 0)
{
dwType = BY_FRAMENUM;
}
else
{
dwType = BY_FRAMETIME;
//conver to ms
m_nBegin *= 1000;
m_nEnd *= 1000;
}
//locate the I-Frame .
NAME(VN_PLAY_GetKeyFramePos)(m_lPort, m_nBegin, dwType, &m_stRealBegin);
if(!NAME(VN_PLAY_GetNextKeyFramePos)(m_lPort, m_nEnd, dwType, &m_stRealEnd))
{
m_stRealEnd.nFilePos = SetFilePointer(m_hPlayFile, 0, 0, FILE_END);
m_stRealEnd.nFrameNum = m_nEnd;
m_stRealEnd.nFrameTime = m_dwMaxTime*1000;
}
DWORD dwBegin = 0;
DWORD dwEnd = 0;
if(dwType == BY_FRAMENUM)
{
dwBegin = m_stRealBegin.nFrameNum;
dwEnd = m_stRealEnd.nFrameNum;
}
else if(dwType == BY_FRAMETIME)
{
dwBegin = m_stRealBegin.nFrameTime / 1000;
dwEnd = m_stRealEnd.nFrameTime / 1000;
}
else
{
MessageBox("Type is unknown");
return FALSE;
}
CString strReal;
strReal.Format("%d", dwBegin);
GetDlgItem(IDC_REAL_BEGIN)->SetWindowText(strReal);
strReal.Format("%d", dwEnd);
GetDlgItem(IDC_REAL_END)->SetWindowText(strReal);
return TRUE;
}
bool STG::GetIPValue(const char ** attr, uint32_t & value, const std::string & attrName)
{
if (!CheckValue(attr, attrName))
return false;
std::string ip(attr[1]);
value = inet_strington(attr[1]);
if (value == 0 && ip != "0.0.0.0")
return false;
return true;
}
int var_SetChecked( vlc_object_t *p_this, const char *psz_name,
int expected_type, vlc_value_t val )
{
int i_ret = VLC_SUCCESS;
variable_t *p_var;
vlc_value_t oldval;
assert( p_this );
vlc_object_internals_t *p_priv = vlc_internals( p_this );
vlc_mutex_lock( &p_priv->var_lock );
p_var = Lookup( p_this, psz_name );
if( p_var == NULL )
{
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_ENOVAR;
}
assert( expected_type == 0 ||
(p_var->i_type & VLC_VAR_CLASS) == expected_type );
#ifndef NDEBUG
/* Alert if the type is VLC_VAR_VOID */
if( ( p_var->i_type & VLC_VAR_TYPE ) == VLC_VAR_VOID )
msg_Warn( p_this, "Calling var_Set on the void variable '%s' (0x%04x)", psz_name, p_var->i_type );
#endif
WaitUnused( p_this, p_var );
/* Duplicate data if needed */
p_var->ops->pf_dup( &val );
/* Backup needed stuff */
oldval = p_var->val;
/* Check boundaries and list */
CheckValue( p_var, &val );
/* Set the variable */
p_var->val = val;
/* Deal with callbacks */
i_ret = TriggerCallback( p_this, p_var, psz_name, oldval );
/* Free data if needed */
p_var->ops->pf_free( &oldval );
vlc_mutex_unlock( &p_priv->var_lock );
return i_ret;
}
int func1(void* arg)
{
int retval=0;
ThreadData* pData = (ThreadData*) arg;
retval = SemWait(pData);
retval = CheckValue(pData,0);
if(retval == 0)
{
StopThread(pData);
}
return retval;
}
int var_SetChecked( vlc_object_t *p_this, const char *psz_name,
int expected_type, vlc_value_t val )
{
variable_t *p_var;
vlc_value_t oldval;
assert( p_this );
vlc_object_internals_t *p_priv = vlc_internals( p_this );
p_var = Lookup( p_this, psz_name );
if( p_var == NULL )
{
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_ENOVAR;
}
assert( expected_type == 0 ||
(p_var->i_type & VLC_VAR_CLASS) == expected_type );
assert ((p_var->i_type & VLC_VAR_CLASS) != VLC_VAR_VOID);
WaitUnused( p_this, p_var );
/* Duplicate data if needed */
p_var->ops->pf_dup( &val );
/* Backup needed stuff */
oldval = p_var->val;
/* Check boundaries and list */
CheckValue( p_var, &val );
/* Set the variable */
p_var->val = val;
/* Deal with callbacks */
TriggerCallback( p_this, p_var, psz_name, oldval );
/* Free data if needed */
p_var->ops->pf_free( &oldval );
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_SUCCESS;
}
/**
* Perform an action on a variable
*
* \param p_this The object that holds the variable
* \param psz_name The name of the variable
* \param i_action The action to perform. Must be one of \ref var_action
* \param p_val First action parameter
* \param p_val2 Second action parameter
*/
int var_Change( vlc_object_t *p_this, const char *psz_name,
int i_action, vlc_value_t *p_val, vlc_value_t *p_val2 )
{
int ret = VLC_SUCCESS;
variable_t *p_var;
vlc_value_t oldval;
vlc_value_t newval;
assert( p_this );
vlc_object_internals_t *p_priv = vlc_internals( p_this );
p_var = Lookup( p_this, psz_name );
if( p_var == NULL )
{
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_ENOVAR;
}
switch( i_action )
{
case VLC_VAR_GETMIN:
*p_val = p_var->min;
break;
case VLC_VAR_GETMAX:
*p_val = p_var->max;
break;
case VLC_VAR_SETMINMAX:
assert(p_var->ops->pf_free == FreeDummy);
p_var->min = *p_val;
p_var->max = *p_val2;
break;
case VLC_VAR_SETSTEP:
assert(p_var->ops->pf_free == FreeDummy);
p_var->step = *p_val;
CheckValue( p_var, &p_var->val );
break;
case VLC_VAR_GETSTEP:
switch (p_var->i_type & VLC_VAR_TYPE)
{
case VLC_VAR_INTEGER:
if (p_var->step.i_int == 0)
ret = VLC_EGENERIC;
break;
case VLC_VAR_FLOAT:
if (p_var->step.f_float == 0.f)
ret = VLC_EGENERIC;
break;
default:
ret = VLC_EGENERIC;
}
if (ret == VLC_SUCCESS)
*p_val = p_var->step;
break;
case VLC_VAR_ADDCHOICE:
{
int i = p_var->choices.i_count;
TAB_APPEND(p_var->choices.i_count,
p_var->choices.p_values, *p_val);
assert(i == p_var->choices_text.i_count);
TAB_APPEND(p_var->choices_text.i_count,
p_var->choices_text.p_values, *p_val);
p_var->ops->pf_dup( &p_var->choices.p_values[i] );
p_var->choices_text.p_values[i].psz_string =
( p_val2 && p_val2->psz_string ) ?
strdup( p_val2->psz_string ) : NULL;
TriggerListCallback(p_this, p_var, psz_name, VLC_VAR_ADDCHOICE, p_val);
break;
}
case VLC_VAR_DELCHOICE:
{
int i;
for( i = 0 ; i < p_var->choices.i_count ; i++ )
if( p_var->ops->pf_cmp( p_var->choices.p_values[i], *p_val ) == 0 )
break;
if( i == p_var->choices.i_count )
{
/* Not found */
vlc_mutex_unlock( &p_priv->var_lock );
return VLC_EGENERIC;
}
p_var->ops->pf_free( &p_var->choices.p_values[i] );
free( p_var->choices_text.p_values[i].psz_string );
TAB_ERASE(p_var->choices.i_count, p_var->choices.p_values, i);
TAB_ERASE(p_var->choices_text.i_count,
p_var->choices_text.p_values, i);
TriggerListCallback(p_this, p_var, psz_name, VLC_VAR_DELCHOICE, p_val);
break;
}
case VLC_VAR_CHOICESCOUNT:
p_val->i_int = p_var->choices.i_count;
break;
case VLC_VAR_CLEARCHOICES:
for( int i = 0 ; i < p_var->choices.i_count ; i++ )
p_var->ops->pf_free( &p_var->choices.p_values[i] );
for( int i = 0 ; i < p_var->choices_text.i_count ; i++ )
free( p_var->choices_text.p_values[i].psz_string );
if( p_var->choices.i_count ) free( p_var->choices.p_values );
if( p_var->choices_text.i_count ) free( p_var->choices_text.p_values );
p_var->choices.i_count = 0;
p_var->choices.p_values = NULL;
p_var->choices_text.i_count = 0;
p_var->choices_text.p_values = NULL;
TriggerListCallback(p_this, p_var, psz_name, VLC_VAR_CLEARCHOICES, NULL);
break;
case VLC_VAR_SETVALUE:
/* Duplicate data if needed */
newval = *p_val;
p_var->ops->pf_dup( &newval );
/* Backup needed stuff */
oldval = p_var->val;
/* Check boundaries and list */
CheckValue( p_var, &newval );
/* Set the variable */
p_var->val = newval;
/* Free data if needed */
p_var->ops->pf_free( &oldval );
break;
case VLC_VAR_GETCHOICES:
p_val->p_list = xmalloc( sizeof(vlc_list_t) );
p_val->p_list->p_values =
xmalloc( p_var->choices.i_count * sizeof(vlc_value_t) );
p_val->p_list->i_type = p_var->i_type;
p_val->p_list->i_count = p_var->choices.i_count;
if( p_val2 )
{
p_val2->p_list = xmalloc( sizeof(vlc_list_t) );
p_val2->p_list->p_values =
xmalloc( p_var->choices.i_count * sizeof(vlc_value_t) );
p_val2->p_list->i_type = VLC_VAR_STRING;
p_val2->p_list->i_count = p_var->choices.i_count;
}
for( int i = 0 ; i < p_var->choices.i_count ; i++ )
{
p_val->p_list->p_values[i] = p_var->choices.p_values[i];
p_var->ops->pf_dup( &p_val->p_list->p_values[i] );
if( p_val2 )
{
p_val2->p_list->p_values[i].psz_string =
p_var->choices_text.p_values[i].psz_string ?
strdup(p_var->choices_text.p_values[i].psz_string) : NULL;
}
}
break;
case VLC_VAR_SETTEXT:
free( p_var->psz_text );
if( p_val && p_val->psz_string )
p_var->psz_text = strdup( p_val->psz_string );
else
p_var->psz_text = NULL;
break;
case VLC_VAR_GETTEXT:
p_val->psz_string = p_var->psz_text ? strdup( p_var->psz_text )
: NULL;
break;
default:
break;
}
vlc_mutex_unlock( &p_priv->var_lock );
return ret;
}
double TTB(long mat, long part, double Te, double x, double y, double z, double u,
double v, double w, double wgt, double t, long pflag, long id) {
long ptd, ptr, nTe0, new1, brcdfptr, brpdfptr, Ncdf, Nk, idx, i;
double sumEk, lTe, Yk, rcdf, Ek, cdfmax, a, Ed;
const double *Ted, *lTed, *lYkd, *brcdf, *brpdf;
if ((Te < RDB[DATA_PHOTON_EMIN]) || (RDB[DATA_PHOTON_USE_TTB] == NO)) {
/* Electron/positron energy is deposited locally */
/* TODO: (!RDB[DATA_PHOTON_USE_TTB]) vois siirtää rutiineihin, joissa elektroneja
luodaan */
return Te;
}
CheckPointer(FUNCTION_NAME, "(mat)", DATA_ARRAY, mat);
CheckPointer(FUNCTION_NAME, "(part)", DATA_ARRAY, part);
ptd = (long)RDB[mat + MATERIAL_PTR_TTB];
CheckPointer(FUNCTION_NAME, "(ptd)", DATA_ARRAY, ptd);
nTe0 = (long)RDB[ptd + TTB_NE];
ptr = (long)RDB[ptd + TTB_E];
CheckPointer(FUNCTION_NAME, "(Te0)", DATA_ARRAY, ptr);
Ted = &RDB[ptr];
ptr = (long)RDB[ptd + TTB_LE];
CheckPointer(FUNCTION_NAME, "(lTe0)", DATA_ARRAY, ptr);
lTed = &RDB[ptr];
/* Select positron or electron data */
if (pflag && ((long)RDB[DATA_PHOTON_TTBPM] == YES)) {
/* Positron */
ptr = (long)RDB[ptd + TTB_LYP];
CheckPointer(FUNCTION_NAME, "(lYph0)", DATA_ARRAY, ptr);
lYkd = &RDB[ptr];
ptr = (long)RDB[ptd + TTB_BRPCDF];
CheckPointer(FUNCTION_NAME, "(brpcdf)", DATA_ARRAY, ptr);
brcdfptr = ptr;
ptr = (long)RDB[ptd + TTB_BRPPDF];
CheckPointer(FUNCTION_NAME, "(brppdf", DATA_ARRAY, ptr);
brpdfptr = ptr;
}
else {
/* Electron */
ptr = (long)RDB[ptd + TTB_LYE];
CheckPointer(FUNCTION_NAME, "(lYph0)", DATA_ARRAY, ptr);
lYkd = &RDB[ptr];
ptr = (long)RDB[ptd + TTB_BRECDF];
CheckPointer(FUNCTION_NAME, "(brecdf)", DATA_ARRAY, ptr);
brcdfptr = ptr;
ptr = (long)RDB[ptd + TTB_BREPDF];
CheckPointer(FUNCTION_NAME, "(brepdf)", DATA_ARRAY, ptr);
brpdfptr = ptr;
}
/* Find log energy NOTE: assuming log interpolated energy array */
lTe = log(Te);
idx = (long)((lTe - lTed[0])/(lTed[1] - lTed[0]));
/* Check index and energy TODO: Nämä vois laittaa checkeiksi */
if ((idx < 0) || (idx > nTe0))
Die(FUNCTION_NAME, "Electron/positron energy not found for index %ld", idx);
if ((Te < Ted[idx]) || (Te > Ted[idx+1]))
Die(FUNCTION_NAME, "Energy not found in the interval: Ted[%ld] = %.5E, Te = %.5E, Ted[%ld] = %.5E", idx, Ted[idx], Te, idx+1, Ted[idx+1]);
/* Interpolate photon yield */
Yk = exp(lYkd[idx] + (lYkd[idx+1] - lYkd[idx])*(lTe - lTed[idx])
/(lTed[idx+1] - lTed[idx]));
/* Sample number of photons */
Nk = (long)(Yk + RandF(id));
CheckValue(FUNCTION_NAME, "Nk", "", Nk, 0, INFTY);
if (Nk == 0) {
/* No bremsstrahlung photons created, deposit energy locally */
return Te;
}
/* Set bremsstrahlung energy cdf and pdf, the grid is selected using
* interpolation weights */
if ((idx == 0) || (lTed[idx] + RandF(id)*(lTed[idx+1] - lTed[idx]) <= lTe)) {
brcdf = &RDB[(long)RDB[brcdfptr + idx + 1]];
brpdf = &RDB[(long)RDB[brpdfptr + idx + 1]];
Ncdf = idx + 2; /* +2 due to the index change */
/* Interpolate the maximum cdf assuming the cdf is integrated from linearly
* interpolated pdf (pdf(x) = ax + b) */
a = (brpdf[idx+1] - brpdf[idx]) / (Ted[idx+1] - Ted[idx]);
cdfmax = brcdf[idx] + 0.5*(2.0*brpdf[idx] + a*(Te - Ted[idx]))*(Te - Ted[idx]);
}
else {
/* NOTE: The lower index is selected, meaning that the maximum photon energy
* will be below the electron energy */
brcdf = &RDB[(long)RDB[brcdfptr + idx]];
brpdf = &RDB[(long)RDB[brpdfptr + idx]];
Ncdf = idx + 1;
cdfmax = brcdf[idx];
}
/***** Sample photon energies **********************************************/
sumEk = 0;
for (i = 0; i < Nk; i++) {
/* Sample from */
rcdf = RandF(id)*cdfmax;
idx = SearchArray(brcdf, rcdf, Ncdf);
if (idx == -1)
Die(FUNCTION_NAME, "rcdf not found");
/* Solve the photon energy assuming linearly interpolated pdf */
a = (brpdf[idx+1] - brpdf[idx]) / (Ted[idx+1] - Ted[idx]);
Ek = Ted[idx] + (sqrt(brpdf[idx]*brpdf[idx] + 2.0*a*(rcdf - brcdf[idx]))
- brpdf[idx])/a;
/* Check Ek limits */
CheckValue(FUNCTION_NAME, "bremsstrahlung photon energy", "",
Ek, Ted[idx], Ted[idx+1]);
if (Ek < RDB[DATA_PHOTON_EMIN])
Die(FUNCTION_NAME, "Photon energy %.5E smaller than DATA_PHOTON_EMIN", Ek);
if (Ek > Te)
Die(FUNCTION_NAME, "Photon energy %.5E larger than electron/positron energy", Ek);
sumEk += Ek;
if ((sumEk > Te) && ((long)RDB[DATA_PHOTON_TTBEC] == YES)) {
/* Sum of photon energies is above the electron energy. Sampling is stopped */
/* Residual energy */
sumEk -= Ek;
Ek = Te - sumEk;
if (Ek < RDB[DATA_PHOTON_EMIN]) {
/* The last photon is not created */
Nk = i;
}
else {
/* Create a new photon having the residual energy */
sumEk = Te;
/* Correct the number of photons */
Nk = i+1;
new1 = DuplicateParticle(part, id);
WDB[new1 + PARTICLE_X] = x;
WDB[new1 + PARTICLE_Y] = y;
WDB[new1 + PARTICLE_Z] = z;
WDB[new1 + PARTICLE_WGT] = wgt; /*TODO: Onko oikein? */
WDB[new1 + PARTICLE_T] = t;
WDB[new1 + PARTICLE_E] = Ek;
WDB[new1 + PARTICLE_U] = u;
WDB[new1 + PARTICLE_V] = v;
WDB[new1 + PARTICLE_W] = w;
ToQue(new1, id);
}
break;
}
/* Create new photon */
new1 = DuplicateParticle(part, id);
WDB[new1 + PARTICLE_X] = x;
WDB[new1 + PARTICLE_Y] = y;
WDB[new1 + PARTICLE_Z] = z;
WDB[new1 + PARTICLE_WGT] = wgt; /*TODO: Onko oikein? */
WDB[new1 + PARTICLE_T] = t;
WDB[new1 + PARTICLE_E] = Ek;
/* NOTE: Photon direction is not sampled */
WDB[new1 + PARTICLE_U] = u;
WDB[new1 + PARTICLE_V] = v;
WDB[new1 + PARTICLE_W] = w;
ToQue(new1, id);
}
/***************************************************************************/
/* Locally deposited energy */
Ed = Te - sumEk;
/* Ed can be negative if RDB[DATA_PHOTON_TTBEC]==NO.
* TODO: Should energy deposition be used only when RDB[DATA_PHOTON_TTBEC]==YES?
* */
if (Ed < 0.0)
Ed = 0.0;
/* TODO: Statistics: Total number of bremsstrahlung photons created */
/* WDB[DATA_PHOTON_BREM_TOT] += Nk; */
return Ed;
}
void schurFactorization(long n, complex **A, complex **T, complex **U)
{
/* Schur factorization: A = U*T*U', T = upper triangular, U = unitary */
long i,j,iter,maxIter;
double tol, diff1,diff2;
complex T11, T12, T21, T22;
complex sigma1, sigma2, sigma;
complex z, z1, z2;
complex **P, **Q, **R;
/* Allocate auxiliary matrices */
P = (complex **)Mem(MEM_ALLOC,n, sizeof(complex *));
Q = (complex **)Mem(MEM_ALLOC,n, sizeof(complex *));
R = (complex **)Mem(MEM_ALLOC,n, sizeof(complex *));
for (i=0; i<n; i++){
P[i] = (complex *)Mem(MEM_ALLOC,n, sizeof(complex));
Q[i] = (complex *)Mem(MEM_ALLOC,n, sizeof(complex));
R[i] = (complex *)Mem(MEM_ALLOC,n, sizeof(complex));
}
/* ------------------------------------------------------------*/
/* Parameters for iteration */
maxIter = 500;
tol = 1E-30;
/* ------------------------------------------------------------*/
/* Init U = eye(n) (identity matrix) */
for (i=0; i<n; i++){
U[i][i].re = 1.0;
U[i][i].im = 0.0;
}
/* ------------------------------------------------------------*/
/* Reduce A to Hessenberg form */
hessFactorization(n,A,P,T);
/* ------------------------------------------------------------*/
/* Compute Schur factorization of Hessenberg matrix T */
for (j=n-1; j>0; j--){ /* Main loop */
for (iter=0; iter<maxIter; iter++){ /* Iteration loop */
sigma.re = T[j][j].re;
sigma.im = T[j][j].im;
/* -- Use Wilkinson shift -- */
/* submatrix considered in the shift */
T11 = T[j-1][j-1];
T12 = T[j-1][j];
T21 = T[j][j-1];
T22 = T[j][j];
/* Compute eigenvalues of submatrix */
z.re = 0.0;
z.im = 0.0;
z2.re = 0.0;
z2.im = 0.0;
/* z = T11*T11 + T22*T22 - 2*T11*T22 + 4*T12*T21 */
z1 = c_mul(T11,T11);
z = c_add(z ,z1);
z2 = c_add(z2,z1);
z1 = c_mul(T22,T22);
z = c_add(z ,z1);
z2 = c_add(z2,z1);
z1 = c_mul(T11,T22);
z1.re = -2.0 * z1.re;
z1.im = -2.0 * z1.im;
z = c_add(z,z1);
z1 = c_mul(T12,T21);
z1.re = 4.0 * z1.re;
z1.im = 4.0 * z1.im;
z = c_add(z,z1);
/* Square root*/
z = c_sqrt(z);
/* Eigenvalues */
sigma1 = c_add(z2,z);
sigma2 = c_sub(z2,z);
/* printf("sigma1 = %e %e\n", sigma1.re, sigma1.im); */
/* printf("sigma2 = %e %e\n", sigma2.re, sigma2.im); */
/* Select eigenvalue for shift*/
diff1 = c_norm( c_sub(T[j][j], sigma1) );
diff2 = c_norm( c_sub(T[j][j], sigma2) );
if (diff1 < diff2){
sigma.re = sigma1.re;
sigma.im = sigma1.im;
}else{
sigma.re = sigma2.re;
sigma.im = sigma2.im;
}
/* --- QR step with Wilkinson shift --- */
/* Shift: T(1:j,1:j) = T(1:j,1:j) - sigma * eye(j) */
for (i=0; i<j+1; i++){
CheckValue(FUNCTION_NAME, "T[i][i].re","", T[i][i].re, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "T[i][i].im","", T[i][i].im, -INFTY, INFTY);
T[i][i].re = T[i][i].re - sigma.re;
T[i][i].im = T[i][i].im - sigma.im;
}
/* Compute QR factorization of shifted Hessenberg matrix */
for (i=0; i<n; i++){
memset(Q[i], 0, n*sizeof(complex));
memset(R[i], 0, n*sizeof(complex));
}
QRfactorization(n,T,Q,R);
/* T = T_new = R * Q */
for (i=0; i<n; i++){
memset(T[i], 0, n*sizeof(complex));
}
matProduct(n, n, n, R, Q, T);
/* T(1:j,1:j) = T(1:j,1:j) + sigma * eye(j) */
for (i=0; i<j+1; i++){
T[i][i].re = T[i][i].re + sigma.re;
T[i][i].im = T[i][i].im + sigma.im;
}
/* R = U_new = U * Q */
for (i=0; i<n; i++){
memset(R[i], 0, n*sizeof(complex));
}
matProduct(n,n,n,U,Q,R);
/* U = R */
for (i=0; i<n; i++){
memcpy(U[i],R[i], n*sizeof(complex));
}
/* Check convergence */
if (c_norm( T[j][j-1] ) <= tol * (c_norm(T[j-1][j-1]) + c_norm(T[j][j]))){
T[j][j-1].re = 0.0;
T[j][j-1].im = 0.0;
break;
}
} /* end of iter loop */
} /* end of main loop */
/* -------------------------------------------------------------*/
/* U = P*U */
for (i=0; i<n; i++){
memset(U[i], 0, n*sizeof(complex));
}
matProduct(n,n,n,P,R,U);
/* -------------------------------------------------------------*/
/* Free auxiliary variables */
for (i=0; i<n; i++){
Mem(MEM_FREE,P[i]);
Mem(MEM_FREE,Q[i]);
Mem(MEM_FREE,R[i]);
}
Mem(MEM_FREE,P);
Mem(MEM_FREE,Q);
Mem(MEM_FREE,R);
/* Return */
return;
}
void ProcessUMSHGeometry()
{
long umsh, loc0, loc1, loc2, ptr, count, msh, np, cell0;
long mat0, mat, cell;
char *mname;
double xmin, xmax, ymin, ymax, zmin, zmax, lims[6], frac, last;
/* Check pointer */
if ((umsh = (long)RDB[DATA_PTR_UMSH0]) < VALID_PTR)
return;
fprintf(out, "Processing unstructured mesh based geometries:\n");
/* Loop over definitions */
while (umsh > VALID_PTR)
{
/***********************************************************************/
/***** Create search mesh **********************************************/
/* Pointer to interface structure */
loc0 = (long)RDB[umsh + UMSH_PTR_IFC];
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Loop over tet cells to link materials */
/* If cell has been divided, only do this to parents */
if((loc1 = (long)RDB[loc0 + IFC_PTR_TET_MSH_PRNTS]) < VALID_PTR)
loc1 = (long)RDB[loc0 + IFC_PTR_TET_MSH];
/* Reset previous material */
mat0 = -1;
while (loc1 > VALID_PTR)
{
/* Get geometry cell */
cell = (long)RDB[loc1 + IFC_TET_MSH_PTR_CELL];
CheckPointer(FUNCTION_NAME, "(cell)", DATA_ARRAY, cell);
if ((RDB[cell + CELL_PTR_MAT]) < 0)
{
/* Not yet linked */
/* Remove minus sign */
WDB[cell + CELL_PTR_MAT] = -RDB[cell + CELL_PTR_MAT];
/* Get material name */
mname = GetText(cell + CELL_PTR_MAT);
/* Check previous */
mat = -1;
if (mat0 > VALID_PTR)
if (!strcmp(mname, GetText(mat0 + MATERIAL_PTR_NAME)))
mat = mat0;
/* Find match */
if (mat < VALID_PTR)
{
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Compare name */
if (!strcmp(mname, GetText(mat + MATERIAL_PTR_NAME)))
break;
/* Next material */
mat = NextItem(mat);
}
}
/* Check match */
if (mat < VALID_PTR)
Error(loc0, "Material %s is not defined", mname);
/* Set pointer */
WDB[cell + CELL_PTR_MAT] = mat;
mat0 = mat;
/* Put interface to material, if this is an interface solid */
if(RDB[loc0 + IFC_PTR_OF_TFILE] > VALID_PTR)
{
WDB[mat + MATERIAL_PTR_IFC] = (double)loc0;
}
}
else
{
/* Already linked (OF_SOLID) */
mat = RDB[cell + CELL_PTR_MAT];
}
loc1 = NextItem(loc1);
}
/***** Copy cell content ***********************************************/
/* Pointer to interface structure */
loc0 = (long)RDB[umsh + UMSH_PTR_IFC];
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Loop over tet cells */
loc1 = (long)RDB[loc0 + IFC_PTR_TET_MSH];
while (loc1 > VALID_PTR)
{
/* Get pointer to parent */
if ((loc2 = (long)RDB[loc1 + IFC_TET_MSH_PTR_PARENT]) < VALID_PTR)
{
/* Pointer to next */
loc1 = NextItem(loc1);
/* Cycle loop */
continue;
}
/* Get cell pointers */
cell0 = (long)RDB[loc2 + IFC_TET_MSH_PTR_CELL];
CheckPointer(FUNCTION_NAME, "(cell0)", DATA_ARRAY, cell0);
/* Copy just cell pointer */
WDB[loc1 + IFC_TET_MSH_PTR_CELL] = (double)cell0;
/* Pointer to next */
loc1 = NextItem(loc1);
}
/* Loop over cells to calculate volume and centerpoint */
/* Pointer to tet mesh cells */
loc1 = (long)RDB[loc0 + IFC_PTR_TET_MSH];
CheckPointer(FUNCTION_NAME, "(loc1)", DATA_ARRAY, loc1);
/* Check if interface based umsh */
if((long)RDB[umsh + UMSH_PTR_FNAME] > 0)
{
/* Copy number of original cells */
if ((long)RDB[loc0 + IFC_NC_PRNTS] > 0)
WDB[umsh + UMSH_N_ORIG_CELLS] = RDB[loc0 + IFC_NC_PRNTS];
else
WDB[umsh + UMSH_N_ORIG_CELLS] = RDB[loc0 + IFC_NC];
/* Other things for these will be processed in processtetmesh.c */
umsh = NextItem(umsh);
continue;
}
/* Get limits */
xmin = RDB[loc0 + IFC_MESH_XMIN];
xmax = RDB[loc0 + IFC_MESH_XMAX];
ymin = RDB[loc0 + IFC_MESH_YMIN];
ymax = RDB[loc0 + IFC_MESH_YMAX];
zmin = RDB[loc0 + IFC_MESH_ZMIN];
zmax = RDB[loc0 + IFC_MESH_ZMAX];
/* Check boundaries */
if ((xmin >= xmax) || (ymin >= ymax) || (zmin >= zmax))
Error(umsh, "Structure is not 3D");
/* Adjust boundaries */
xmin = xmin - 1E-6;
xmax = xmax + 1E-6;
ymin = ymin - 1E-6;
ymax = ymax + 1E-6;
zmin = zmin - 1E-6;
zmax = zmax + 1E-6;
/* Put mesh variables */
lims[0] = xmin;
lims[1] = xmax;
lims[2] = ymin;
lims[3] = ymax;
lims[4] = zmin;
lims[5] = zmax;
/* Read mesh split criterion */
np = (long)RDB[loc0 + IFC_SEARCH_MESH_ADA_SPLIT];
CheckValue(FUNCTION_NAME, "np", "", np, 1, INFTY);
/* Get pointer to size vector */
ptr = (long)RDB[loc0 + IFC_SEARCH_MESH_ADA_PTR_SZ];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Create mesh structure */
msh = CreateMesh(MESH_TYPE_ADAPTIVE, MESH_CONTENT_PTR,
MESH_CONTENT_DATA_TET, np, 0, 0, lims, ptr);
/* Put pointer */
WDB[loc0 + IFC_PTR_SEARCH_MESH] = (double)msh;
/* Print progress */
fprintf(out, "\nCreating search mesh for universe %s:\n\n",
GetText(umsh + UMSH_PTR_NAME));
last = 0.0;
count = 0;
/* Loop over tet cells */
loc1 = (long)RDB[loc0 + IFC_PTR_TET_MSH];
while (loc1 > VALID_PTR)
{
/* Preallocate memory for counters */
if ((long)RDB[DATA_REAL_PRIVA_SIZE] -
(long)RDB[DATA_ALLOC_PRIVA_SIZE] < 100)
PreallocMem(100, PRIVA_ARRAY);
/* Calculate fraction and print progress */
frac = (double)(count++)/((double)ListSize(loc1));
if (frac - last > 0.10)
{
fprintf(out, " %3.0f%% complete\n", 100.0*frac);
last = frac;
}
/* Get limits */
xmin = RDB[loc1 + IFC_TET_MSH_XMIN];
xmax = RDB[loc1 + IFC_TET_MSH_XMAX];
ymin = RDB[loc1 + IFC_TET_MSH_YMIN];
ymax = RDB[loc1 + IFC_TET_MSH_YMAX];
zmin = RDB[loc1 + IFC_TET_MSH_ZMIN];
zmax = RDB[loc1 + IFC_TET_MSH_ZMAX];
/* Add to search mesh */
AddSearchMesh(msh, loc1, xmin, xmax, ymin, ymax, zmin, zmax);
/* Next */
loc1 = NextItem(loc1);
}
fprintf(out, " %3.0f%% complete\n\n", 100.0);
/***********************************************************************/
/***********************************************************************/
/* Next geometry */
umsh = NextItem(umsh);
}
fprintf(out, "OK.\n\n");
}
void ProcessICM()
{
long ptr, loc0, surf, lat, n, m, sz, ene, npmax, ng0, ng1, nseg, nsub;
long nmu0, nmu1, nmu2, nmua, nmus;
char tmpstr[MAX_STR];
/* Check option */
if((long)RDB[DATA_ICM_CALC] == NO)
return;
fprintf(out, "Processing data for interface current method...\n");
/***************************************************************************/
/***** Link energy group data **********************************************/
/* Check pointer to main grid */
if ((long)RDB[DATA_ICM_PTR_ENE0] < VALID_PTR)
Error(0, "Missing energy grid in ICM calculation");
/* Get name */
sprintf(tmpstr, "%s", GetText(DATA_ICM_PTR_ENE0));
/* Find grid */
ene = RDB[DATA_PTR_ENE0];
if ((ene = SeekListStr(ene, ENE_PTR_NAME, tmpstr)) > VALID_PTR)
{
/* Pointer to grid data */
ene = (long)RDB[ene + ENE_PTR_GRID];
CheckPointer(FUNCTION_NAME, "(ene)", DATA_ARRAY, ene);
/* Put pointer */
WDB[DATA_ICM_PTR_ENE0] = (double)ene;
/* Set grid size */
WDB[DATA_ICM_NG0] = RDB[ene + ENERGY_GRID_NE] - 1.0;
}
else
Error(0, "ICM energy grid %s is not defined", tmpstr);
/* Check pointer to reconstruction grid */
if ((long)RDB[DATA_ICM_PTR_ENE1] < VALID_PTR)
Error(0, "Missing energy grid in ICM calculation");
/* Get name */
sprintf(tmpstr, "%s", GetText(DATA_ICM_PTR_ENE1));
/* Find grid */
ene = RDB[DATA_PTR_ENE0];
if ((ene = SeekListStr(ene, ENE_PTR_NAME, tmpstr)) > VALID_PTR)
{
/* Pointer to grid data */
ene = (long)RDB[ene + ENE_PTR_GRID];
CheckPointer(FUNCTION_NAME, "(ene)", DATA_ARRAY, ene);
/* Put pointer */
WDB[DATA_ICM_PTR_ENE1] = (double)ene;
/* Set grid size */
WDB[DATA_ICM_NG1] = RDB[ene + ENERGY_GRID_NE] - 1.0;
}
else if (!strcmp(tmpstr, "-1"))
WDB[DATA_ICM_PTR_ENE1] = NULLPTR;
else
Error(0, "ICM energy grid %s is not defined", tmpstr);
/***************************************************************************/
/***** Link surfaces *******************************************************/
/* Loop over structures */
loc0 = (long)RDB[DATA_PTR_ICM0];
while (loc0 > VALID_PTR)
{
/* Find surface */
surf = RDB[DATA_PTR_S0];
if ((surf = SeekListStr(surf, SURFACE_PTR_NAME,
GetText(loc0 + ICM_PTR_SURF))) < VALID_PTR)
Error(loc0, "Surface %s is not defined",
GetText(loc0 + ICM_PTR_SURF));
/* Put pointer */
WDB[loc0 + ICM_PTR_SURF] = (double)surf;
/* Get pointer to surface parameters */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get number of faces */
switch ((long)RDB[surf + SURFACE_TYPE])
{
case SURF_SQC:
{
/* Set number of surfaces */
n = 4;
/* Set origin */
WDB[loc0 + ICM_X0] = RDB[ptr];
WDB[loc0 + ICM_Y0] = RDB[ptr + 1];
WDB[loc0 + ICM_Z0] = 0.0;
break;
}
default:
Error(loc0, "Surface %s is wrong type for ICM calculation",
GetText(surf + SURFACE_PTR_NAME));
}
/* Get number of sub-segments */
m = (long)RDB[DATA_ICM_NSUB];
CheckValue(FUNCTION_NAME, "m", "", m, 1, 50);
/* Store values */
if (((long)RDB[DATA_ICM_NSEG] > 0) &&
((long)RDB[DATA_ICM_NSEG] != n*m))
Error(loc0, "Mismatch in surface type");
else
WDB[DATA_ICM_NSEG] = (double)(n*m);
/* Next */
loc0 = NextItem(loc0);
}
/* Stop tracks at outer boundary */
WDB[DATA_STOP_AT_BOUNDARY] = (double)YES;
/***************************************************************************/
/***** Link lattices *******************************************************/
/* Reset maximum number of pins */
npmax = 0;
/* Loop over structures */
loc0 = (long)RDB[DATA_PTR_ICM0];
while (loc0 > VALID_PTR)
{
/* Check pointer */
if ((long)RDB[loc0 + ICM_PTR_LAT] < VALID_PTR)
{
/* Pointer to next */
loc0 = NextItem(loc0);
/* Cycle loop */
continue;
}
/* Find lattice */
lat = RDB[DATA_PTR_L0];
if ((lat = SeekListStr(lat, LAT_PTR_NAME,
GetText(loc0 + ICM_PTR_LAT))) < VALID_PTR)
Error(loc0, "Lattice %s is not defined",
GetText(loc0 + ICM_PTR_LAT));
/* Put pointer */
WDB[loc0 + ICM_PTR_LAT] = (double)lat;
/* Get number of pins */
if ((n = (long)RDB[lat + LAT_NTOT]) > 0)
WDB[loc0 + ICM_NP] = (double)n;
else
Die(FUNCTION_NAME, "Number of pins is zero");
/* Compare to maximum */
if (n > npmax)
npmax = n;
/* Next */
loc0 = NextItem(loc0);
}
/***************************************************************************/
/***** Check discretization ************************************************/
/* Get number of groups, segments and angular bins */
if ((ng0 = (long)RDB[DATA_ICM_NG0]) < 1)
Die(FUNCTION_NAME, "Invalid number of energy groups");
if ((ng1 = (long)RDB[DATA_ICM_NG1]) < 0)
Die(FUNCTION_NAME, "Invalid number of energy groups");
if ((nseg = (long)RDB[DATA_ICM_NSEG]) < 4)
Die(FUNCTION_NAME, "Invalid number of segments");
nsub = (long)RDB[DATA_ICM_NSUB];
CheckValue(FUNCTION_NAME, "nsub", "", nsub, 1, 50);
nmu0 = (long)RDB[DATA_ICM_NMU0];
CheckValue(FUNCTION_NAME, "nmu0", "", nmu0, 1, 50);
nmu1 = (long)RDB[DATA_ICM_NMU1];
CheckValue(FUNCTION_NAME, "nmu1", "", nmu1, 1, 50);
nmu2 = (long)RDB[DATA_ICM_NMU2];
CheckValue(FUNCTION_NAME, "nmu2", "", nmu2, 1, 50);
/* Put sub-segments if not defined */
if ((ptr = (long)RDB[DATA_ICM_PTR_SUB]) < VALID_PTR)
{
ptr = ReallocMem(DATA_ARRAY, nsub + 1);
WDB[DATA_ICM_PTR_SUB] = (double)ptr;
for (n = 0; n < nsub + 1; n++)
WDB[ptr++] = ((double)n)/((double)nsub);
WDB[DATA_ICM_NSUB] = (double)nsub;
}
else
{
/* Check order */
for (n = 1; n < nsub + 1; n++)
if (RDB[ptr + n] <= RDB[ptr + n - 1])
Error(0, "ICM sub-segmentation must be in ascending order");
}
/* Put angular bins if not defined */
if ((ptr = (long)RDB[DATA_ICM_PTR_MU0]) < VALID_PTR)
{
ptr = ReallocMem(DATA_ARRAY, nmu0 + 1);
WDB[DATA_ICM_PTR_MU0] = (double)ptr;
for (n = 0; n < nmu0 + 1; n++)
WDB[ptr++] = ((double)n)/((double)nmu0);
WDB[DATA_ICM_NMU0] = (double)nmu0;
}
else
{
/* Check order */
for (n = 1; n < nmu0 + 1; n++)
if (RDB[ptr + n] <= RDB[ptr + n - 1])
Error(0, "ICM angular binning must be in ascending order");
}
if ((ptr = (long)RDB[DATA_ICM_PTR_MU1]) < VALID_PTR)
{
ptr = ReallocMem(DATA_ARRAY, nmu1 + 1);
WDB[DATA_ICM_PTR_MU1] = (double)ptr;
for (n = 0; n < nmu1 + 1; n++)
WDB[ptr++] = 2.0*((double)n)/((double)nmu1) - 1.0;
WDB[DATA_ICM_NMU1] = (double)nmu1;
}
else
{
/* Check order */
for (n = 1; n < nmu1 + 1; n++)
if (RDB[ptr + n] <= RDB[ptr + n - 1])
Error(0, "ICM angular binning must be in ascending order");
}
if ((ptr = (long)RDB[DATA_ICM_PTR_MU2]) < VALID_PTR)
{
ptr = ReallocMem(DATA_ARRAY, nmu2 + 1);
WDB[DATA_ICM_PTR_MU2] = (double)ptr;
for (n = 0; n < nmu2 + 1; n++)
WDB[ptr++] = 2.0*((double)n)/((double)nmu2) - 1.0;
WDB[DATA_ICM_NMU2] = (double)nmu2;
}
else
{
/* Check order */
for (n = 1; n < nmu2 + 1; n++)
if (RDB[ptr + n] <= RDB[ptr + n - 1])
Error(0, "ICM angular binning must be in ascending order");
}
/***************************************************************************/
/***** Allocate memory for results *****************************************/
/* Asymmetric and symmetric bins */
nmua = nmu1;
nmus = nmu0*nmu2;
/* Calculate number of values */
sz = 2*nseg*nmua*nmus*ng0*nseg*nmua*nmus*ng0;
sz = sz + 2*nseg*nmua*nmus*ng0*ng1;
sz = sz + 9*nseg*nmua*nmus*ng0;
sz = sz + 2*nseg*nmua*nmus*ng0*npmax;
sz = sz + 2*nseg*nmua*nmus*ng0*ng1*npmax;
/* Multiply by number of structures */
loc0 = (long)RDB[DATA_PTR_ICM0];
sz = sz*ListSize(loc0);
/* Preallocate memory from buffer array */
PreallocMem(sz*BUF_BLOCK_SIZE, BUF_ARRAY);
/* Loop over structures and allocate memory for results */
loc0 = (long)RDB[DATA_PTR_ICM0];
while (loc0 > VALID_PTR)
{
ptr = NewStat("ICM_CURR0", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_CURR0] = (double)ptr;
ptr = NewStat("CC1", 8, nseg, nmua, nmus, ng0, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_CC1] = (double)ptr;
ptr = NewStat("CC2", 8, nseg, nmua, nmus, ng0, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_CC2] = (double)ptr;
if (ng1 > 0)
{
ptr = NewStat("AFLX1", 5, nseg, nmua, nmus, ng0, ng1);
WDB[loc0 + ICM_RES_AFLX1] = (double)ptr;
ptr = NewStat("AFLX2", 5, nseg, nmua, nmus, ng0, ng1);
WDB[loc0 + ICM_RES_AFLX2] = (double)ptr;
}
ptr = NewStat("ASRC1", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_ASRC1] = (double)ptr;
ptr = NewStat("ASRC2", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_ASRC2] = (double)ptr;
ptr = NewStat("AFISS1", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_AFISS1] = (double)ptr;
ptr = NewStat("AFISS2", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_AFISS2] = (double)ptr;
ptr = NewStat("AABS1", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_AABS1] = (double)ptr;
ptr = NewStat("AABS2", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_AABS2] = (double)ptr;
ptr = NewStat("LEAK1", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_LEAK1] = (double)ptr;
ptr = NewStat("LEAK2", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_LEAK2] = (double)ptr;
ptr = NewStat("APOW1", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_APOW1] = (double)ptr;
ptr = NewStat("APOW2", 4, nseg, nmua, nmus, ng0);
WDB[loc0 + ICM_RES_APOW2] = (double)ptr;
/* Get number of pins */
if ((m = (long)RDB[loc0 + ICM_NP]) > 0)
{
ptr = NewStat("PPOW1", 5, nseg, nmua, nmus, ng0, m);
WDB[loc0 + ICM_RES_PPOW1] = (double)ptr;
ptr = NewStat("PPOW2", 5, nseg, nmua, nmus, ng0, m);
WDB[loc0 + ICM_RES_PPOW2] = (double)ptr;
if (ng1 > 0)
{
ptr = NewStat("PFLX1", 6, nseg, nmua, nmus, ng0, ng1, m);
WDB[loc0 + ICM_RES_PFLX1] = (double)ptr;
ptr = NewStat("PFLX2", 6, nseg, nmua, nmus, ng0, ng1, m);
WDB[loc0 + ICM_RES_PFLX2] = (double)ptr;
}
}
/* Allocate memory for break counter */
ptr = AllocPrivateData(1, PRIVA_ARRAY);
WDB[loc0 + ICM_BREAK_PTR_COUNT] = (double)ptr;
/***********************************************************************/
/* Pointer to next */
loc0 = NextItem(loc0);
}
/***************************************************************************/
fprintf(out, "OK.\n\n");
/***************************************************************************/
}
void PrintCoeVals(FILE *fp, long loc0)
{
long dim, ptr, nv, n, N[4], i0, i1, i2, i3;
double val, err;
/* Check pointer */
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Get dimension */
if ((dim = (long)RDB[loc0 + SCORE_DIM]) > 4)
Die(FUNCTION_NAME, "Increase array size");
CheckValue(FUNCTION_NAME, "dim", "", dim, 1, 4);
/* Pointer to list of maximum values */
ptr = (long)RDB[loc0 + SCORE_PTR_NMAX];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Reset dimension vector */
for (n = 0; n < 4; n++)
N[n] = 1;
/* Loop over dimensions, get sizes and number of values */
nv = 1;
for (n = 0; n < dim; n++)
{
N[n] = (long)RDB[ptr++];
nv = nv*N[n];
}
/* Print variable name */
fprintf(fp, "%s %ld", GetText(loc0 + SCORE_PTR_NAME), nv);
/* Avoid compiler warning */
val = -1.0;
err = -1.0;
/* Loop over dimensions */
for (i0 = 0; i0 < N[0]; i0++)
for (i1 = 0; i1 < N[1]; i1++)
for (i2 = 0; i2 < N[2]; i2++)
for (i3 = 0; i3 < N[3]; i3++)
{
if (dim == 1)
{
val = Mean(loc0, i0);
err = RelErr(loc0, i0);
}
else if (dim == 2)
{
val = Mean(loc0, i0, i1);
err = RelErr(loc0, i0, i1);
}
else if (dim == 3)
{
val = Mean(loc0, i0, i1, i2);
err = RelErr(loc0, i0, i1, i2);
}
else if (dim == 4)
{
val = Mean(loc0, i0, i1, i2, i3);
err = RelErr(loc0, i0, i1, i2, i3);
}
/* Print */
if ((long)RDB[DATA_COEF_CALC_INCLUDE_ERRORS] == (double)NO)
fprintf(fp, " %12.5E", val);
else if ((long)RDB[DATA_COEF_CALC_INCLUDE_ERRORS] == (double)YES)
{
/* Check magnitude of errors */
if (err < 0.00010)
fprintf(fp, " %12.5E %7.1E", val, err);
else
fprintf(fp, " %12.5E %7.5f", val, err);
}
else
Die(FUNCTION_NAME, "Invalid mode");
}
/* Newline */
fprintf(fp, "\n");
}
double NearestBoundary(long id)
{
long lvl0, lvl, reg, cell, pbd, pbl, surf, type, n, np, ptr, loc0, ltype;
long surflist, ownrlist, nbrlist, facelist, sidelist, nf, side, k, j, pt;
long nbhr, uni, ifc, ncol, tbi, ang, i, cgns, loc1, nt;
double min, d, x, y, z, u, v, w, y2, z2, params[MAX_SURFACE_PARAMS];
double t, phi, phi2;
/* Reset minimum distance */
min = INFTY;
/* Pointer to first level */
lvl0 = (long)RDB[DATA_PTR_LVL0];
CheckPointer(FUNCTION_NAME, "(lvl0)", DATA_ARRAY, lvl0);
/* Loop over levels */
while (lvl0 > VALID_PTR)
{
/* Pointer to private data */
lvl = (long)RDB[lvl0 + LVL_PTR_PRIVATE_DATA];
CheckPointer(FUNCTION_NAME, "(lvl)", PRIVA_ARRAY, lvl);
/* Get coordinates */
x = GetPrivateData(lvl + LVL_PRIV_X, id);
y = GetPrivateData(lvl + LVL_PRIV_Y, id);
z = GetPrivateData(lvl + LVL_PRIV_Z, id);
/* Get direction cosines */
u = GetPrivateData(lvl + LVL_PRIV_U, id);
v = GetPrivateData(lvl + LVL_PRIV_V, id);
w = GetPrivateData(lvl + LVL_PRIV_W, id);
/* Check coordinates and direction cosines */
CheckValue(FUNCTION_NAME, "x", "", x, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "y", "", y, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "z", "", z, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "u", "", u, -1.0, 1.0);
CheckValue(FUNCTION_NAME, "v", "", v, -1.0, 1.0);
CheckValue(FUNCTION_NAME, "w", "", w, -1.0, 1.0);
/* Pointer to universe */
uni = (long)GetPrivateData(lvl + LVL_PRIV_PTR_UNIV, id);
CheckPointer(FUNCTION_NAME, "(uni)", DATA_ARRAY, uni);
/* Get time */
ptr = RDB[uni + UNIVERSE_PTR_PRIVA_T];
CheckPointer(FUNCTION_NAME, "(ptr)", PRIVA_ARRAY, ptr);
t = GetPrivateData(ptr, id);
/* Check for symmetry */
if ((ptr = (long)RDB[uni + UNIVERSE_PTR_SYM]) > VALID_PTR)
if ((d = SymmetryBoundary(ptr, x, y, z, u, v, w)) < min)
min = d;
/* Get level type */
ltype = (long)GetPrivateData(lvl + LVL_PRIV_TYPE, id);
/* Check type */
switch (ltype)
{
case UNIVERSE_TYPE_NEST:
{
/*****************************************************************/
/***** Nest ******************************************************/
/* Check for fuel performance interface */
if ((loc0 = (long)RDB[uni + UNIVERSE_PTR_IFC_FUEP]) > VALID_PTR)
{
/* First check nest boundaries */
/* Check nest region surfaces */
/* Pointer to nest region */
reg = (long)GetPrivateData(lvl + LVL_PRIV_PTR_NEST_REG, id);
CheckPointer(FUNCTION_NAME, "(reg)", DATA_ARRAY, reg);
/* First surface */
if ((surf = (long)RDB[reg + NEST_REG_PTR_SURF_IN]) > VALID_PTR)
{
/* Get type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Die on non-cylindrical */
if(type != SURF_CYL)
Die(FUNCTION_NAME,"Non-cylindrical surface");
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Copy surface parameters */
memcpy(¶ms,&RDB[ptr],np*sizeof(double));
y2 = 0.0;
z2 = z;
/* Cold to hot expansion of cylinder radius */
/* (params[2]) */
CoordExpans(loc0,¶ms[2],&y2,&z2,t,2);
/* Get distance */
d = SurfaceDistance(-1, params, type, np, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "1", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Second surface */
if ((surf = (long)RDB[reg + NEST_REG_PTR_SURF_OUT]) >
VALID_PTR)
{
/* Get type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Die on non-cylindrical */
if(type != SURF_CYL)
Die(FUNCTION_NAME,"Non-cylindrical surface");
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Copy surface parameters */
memcpy(¶ms,&RDB[ptr],np*sizeof(double));
y2 = 0.0;
z2 = z;
/* Cold to hot expansion of cylinder radius */
/* (params[2]) */
CoordExpans(loc0,¶ms[2],&y2,&z2,t,2);
/* Get distance */
d = SurfaceDistance(-1, params, type, np, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "2", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Check the interface input boundaries, */
/* Find time interval */
tbi = (long)RDB[loc0 + IFC_FUEP_PTR_T];
/* Get pointer to limits */
ptr = (long)RDB[loc0 + IFC_FUEP_LIM_PTR_T];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get number of time bins */
nt = (long)RDB[loc0 + IFC_FUEP_N_T];
/* Find bin*/
i = SearchArray(&RDB[ptr], t, nt + 1);
/* Check if found */
if (i < 0)
break;
/* Get direct pointer to time bin */
tbi = ListPtr(tbi, i);
/* Find axial zone */
loc1 = (long)RDB[tbi + IFC_FUEP_T_PTR_AX];
while (loc1 > VALID_PTR)
{
/* Compare coordinates */
if ((z >= RDB[loc1 + IFC_FUEP_AX_ZMIN]) &&
(z < RDB[loc1 + IFC_FUEP_AX_ZMAX]))
{
/* Break loop */
break;
}
/* Next */
loc1 = NextItem(loc1);
}
/* Break case if not found*/
if (loc1 < VALID_PTR)
break;
/* Only check axial boundaries in 3D calculation */
if ((long)RDB[DATA_GEOM_DIM] == 3)
{
/* Distance to lower boundary */
params[0] = RDB[loc1 + IFC_FUEP_AX_ZMIN];
d = SurfaceDistance(-1, params, SURF_PZ, 1, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "3", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
/* Distance to upper boundary */
params[0] = RDB[loc1 + IFC_FUEP_AX_ZMAX];
d = SurfaceDistance(-1, params, SURF_PZ, 1, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "4", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Get the correct angular segment */
ang = (long)RDB[loc1 + IFC_FUEP_AX_PTR_ANG];
/* Get polar angle */
phi = PolarAngle(x,y);
while (ang > VALID_PTR)
{
/* Rotate if needed */
if(phi > 2.0*PI+RDB[ang + IFC_FUEP_ANG_AMIN])
phi2 = phi - 2.0*PI;
else
phi2 = phi;
/* Compare coordinates */
if ((phi2 >= RDB[ang + IFC_FUEP_ANG_AMIN]) &&
(phi2 < RDB[ang + IFC_FUEP_ANG_AMAX]))
break;
/* Next */
ang = NextItem(ang);
}
/* Break case if not found */
if (ang < VALID_PTR)
break;
/* Calculate distance to angular zone boundaries */
/* Tää ei huomioi että rajoittava taso on vain puoliääretön */
/* (Tulee ylimääräisiä pysäytyksiä, jos kulmasegmenttejä */
/* on pariton määrä) */
params[0] = RDB[ang + IFC_FUEP_ANG_CMIN];
params[1] = 1.0;
params[2] = 0.0;
params[3] = 0.0;
d = SurfaceDistance(-1, params, SURF_PLANE, 4, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "5", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
params[0] = RDB[ang + IFC_FUEP_ANG_CMAX];
d = SurfaceDistance(-1, params, SURF_PLANE, 4, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "6", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
else
{
/* Pointer to nest region */
reg = (long)GetPrivateData(lvl + LVL_PRIV_PTR_NEST_REG, id);
CheckPointer(FUNCTION_NAME, "(reg)", DATA_ARRAY, reg);
/* First surface */
if ((surf = (long)RDB[reg + NEST_REG_PTR_SURF_IN]) > VALID_PTR)
{
/* Get type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get distance */
d = SurfaceDistance(-1, &RDB[ptr], type, np, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "10", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Second surface */
if ((surf = (long)RDB[reg + NEST_REG_PTR_SURF_OUT]) > VALID_PTR)
{
/* Get type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get distance */
d = SurfaceDistance(-1, &RDB[ptr], type, np, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "11", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
}
/* Break case */
break;
/*****************************************************************/
}
case UNIVERSE_TYPE_LATTICE:
{
/*****************************************************************/
/***** Lattice ***************************************************/
/* Check pointer to lattice */
if ((long)GetPrivateData(lvl + LVL_PRIV_PTR_LAT, id) < VALID_PTR)
Die(FUNCTION_NAME, "No lattice pointer");
/* Get surface type */
type = (long)GetPrivateData(lvl + LVL_PRIV_LAT_SURF_TYPE, id);
/* Get number of surface parameters */
np = (long)GetPrivateData(lvl + LVL_PRIV_LAT_SURF_NP, id);
/* Get parameters (noiden kerrointen pitää olla peräkkäin) */
for (n = 0; n < np; n++)
params[n] = GetPrivateData(lvl + LVL_PRIV_LAT_SURF_C0 + n, id);
/* Get distance */
d = SurfaceDistance(-1, params, type, np, x, y, z, u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "12", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
/* Check if type is vertical stack */
if (type == SURF_PZ)
{
/* Put parameter for second surface */
params[0] = GetPrivateData(lvl + LVL_PRIV_LAT_SURF_C1, id);
/* Get distance (ei tarkisteta, reunimmaiset pinnat voi */
/* olla +/- INFTY) */
d = SurfaceDistance(-1, params, type, np, x, y, z, u, v, w, id);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Break case */
break;
/*****************************************************************/
}
case UNIVERSE_TYPE_CELL:
{
/*****************************************************************/
/***** Cell ******************************************************/
/* Pointer to cell */
cell = (long)GetPrivateData(lvl + LVL_PRIV_PTR_CELL, id);
CheckPointer(FUNCTION_NAME, "(cell)", DATA_ARRAY, cell);
/* Pointer to surface list */
loc0 = (long)RDB[cell + CELL_PTR_SURF_LIST];
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Loop over list */
while ((surf = (long)RDB[loc0++]) > VALID_PTR)
{
/* Get type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Check infinite */
if (type != SURF_INF)
{
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get distance */
d = SurfaceDistance(surf, &RDB[ptr], type, np, x, y, z,
u, v, w, id);
if (d < 0.0)
printf("%s %ld: x = %1.14E; y = %1.14E; z = %1.14E; u = %1.14E; v = %1.14E; w = %1.14E;\n", GetText(surf + SURFACE_PTR_NAME),
type, x, y, z, u, v, w);
CheckValue(FUNCTION_NAME, "d", "14", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
min = d;
}
}
/* Break case */
break;
/*****************************************************************/
}
case UNIVERSE_TYPE_UMSH:
{
/*****************************************************************/
/***** Unstructured mesh based geometry **************************/
/* Pointer to cell */
if ((cell = (long)GetPrivateData(lvl + LVL_PRIV_PTR_CELL, id))
> VALID_PTR)
{
/* Get current tetra-cell (set in whereami.c) */
ptr = (long)RDB[cell + CELL_PTR_PREV_TET];
if ((cgns = (long)GetPrivateData(ptr, id)) < VALID_PTR)
Die(FUNCTION_NAME, "UMSH tet was not stored");
/* Reset pointer to neighbour */
nbhr = -1;
/* Get pointer to UMSH structure */
ptr = (long)RDB[uni + UNIVERSE_PTR_UMSH];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get pointer to UMSH interface */
ifc = (long)RDB[ptr + UMSH_PTR_IFC];
CheckPointer(FUNCTION_NAME, "(ifc)", DATA_ARRAY, ifc);
/* Get pointer to interface surface list */
surflist = (long)RDB[ifc + IFC_PTR_SURF_LIST];
CheckPointer(FUNCTION_NAME, "(surflist)", DATA_ARRAY, surflist);
/* Get pointer to interface owner list */
ownrlist = (long)RDB[ifc + IFC_PTR_OWNR_LIST];
CheckPointer(FUNCTION_NAME, "(ownrlist)", DATA_ARRAY, ownrlist);
/* Get pointer to interface neighbour list */
nbrlist = (long)RDB[ifc + IFC_PTR_NBR_LIST];
CheckPointer(FUNCTION_NAME, "(nbrlist)", DATA_ARRAY, nbrlist);
/* Get pointer to cell's face list */
facelist = (long)RDB[cgns + IFC_TET_MSH_PTR_FACES];
CheckPointer(FUNCTION_NAME, "(facelist)", DATA_ARRAY, facelist);
/* Get pointer to cell's side list */
sidelist = (long)RDB[cgns + IFC_TET_MSH_PTR_SIDES];
CheckPointer(FUNCTION_NAME, "(sidelist)", DATA_ARRAY, sidelist);
/* Loop over cell faces */
nf = (long)RDB[cgns + IFC_TET_MSH_NF];
CheckValue(FUNCTION_NAME, "nf", "", nf, 4, 4);
for (i = 0; i < nf; i++)
{
/* Get index of face */
n = (long)RDB[facelist + i];
/* Get side for face */
side = (long)RDB[sidelist + i];
/* Get pointer to face surface */
surf = ListPtr(surflist, n);
/* Get pointer to surface parameters */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get number of points on the face */
np = (long)RDB[surf + SURFACE_N_PARAMS];
CheckValue(FUNCTION_NAME, "np", "", np, 3, 3);
/* Copy points to params */
k = 0;
for (j = 0; j < np; j++)
{
/* Get pointer to beginning of point coordinates */
pt = (long)RDB[ptr + j];
/* Store coordinates to params */
params[k++] = RDB[pt + 0];
params[k++] = RDB[pt + 1];
params[k++] = RDB[pt + 2];
}
/* Get distance */
d = SurfaceDistance(surf, params, SURF_PLANE, 9,
x, y, z, u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "15", d, 0.0, INFTY);
/* Compare to minimum */
if (d < min)
{
min = d;
/* Get neighbour */
if (side == -1)
nbhr = (long)RDB[nbrlist + n];
else
nbhr = (long)RDB[ownrlist + n];
}
}
/* Get collision count */
ptr = (long)RDB[DATA_PTR_COLLISION_COUNT];
ncol = GetPrivateData(ptr, id);
/* Store value */
StoreValuePair(uni + UNIVERSE_PTR_NEXT_CELL, ncol, nbhr, id);
}
else
{
/* Point is in background universe, get distance to search */
/* mesh boundaries. */
/* Pointer to geometry */
loc0 = (long)GetPrivateData(lvl + LVL_PRIV_PTR_UMSH, id);
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Pointer to interaface structure */
loc0 = (long)RDB[loc0 + UMSH_PTR_IFC];
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Get minimum distance */
d = NearestUMSHSurf(loc0, x, y, z, u, v, w, id);
/* Compare to minimum */
if (d < min)
min = d;
}
/* Break case */
break;
/*****************************************************************/
}
case UNIVERSE_TYPE_STL:
{
/*****************************************************************/
/***** STL based geometry ****************************************/
/* Pointer to geometry */
loc0 = (long)GetPrivateData(lvl + LVL_PRIV_PTR_STL, id);
CheckPointer(FUNCTION_NAME, "(loc0)", DATA_ARRAY, loc0);
/* Get minimum distance */
d = NearestSTLSurf(loc0, x, y, z, u, v, w, id);
/* Compare to minimum */
if (d < min)
min = d;
/* Break case */
break;
/*****************************************************************/
}
case UNIVERSE_TYPE_PBED:
{
/*****************************************************************/
/***** Explicit stochastic geometry ******************************/
/* Check direct pointer to pebble */
if ((pbl = (long)GetPrivateData(lvl + LVL_PRIV_PTR_PEBBLE, id)) >
VALID_PTR)
{
/* Put surface parameters */
params[0] = RDB[pbl + PEBBLE_X0];
params[1] = RDB[pbl + PEBBLE_Y0];
params[2] = RDB[pbl + PEBBLE_Z0];
params[3] = RDB[pbl + PEBBLE_RAD];
if ((x - params[0])*(x - params[0]) +
(y - params[1])*(y - params[1]) +
(z - params[2])*(z - params[2]) > params[3]*params[3])
Die(FUNCTION_NAME, "not inside");
/* Get distance */
d = SurfaceDistance(-1, params, SURF_SPH, 4, x, y, z,
u, v, w, id);
CheckValue(FUNCTION_NAME, "d", "16", d, 0.0, 2.0*params[3]);
}
else
{
/* Pointer to PB geometry */
pbd = (long)GetPrivateData(lvl + LVL_PRIV_PTR_PBED, id);
CheckPointer(FUNCTION_NAME, "(pbd)", DATA_ARRAY, pbd);
/* Get minimum distance */
d = NearestPBSurf(pbd, x, y, z, u, v, w, id);
}
/* Compare to minimum */
if (d < min)
min = d;
/* Break case */
break;
/*****************************************************************/
}
default:
{
/* Invalid type */
Die(FUNCTION_NAME, "Invalid universe type");
}
}
/* Break loop if level is last */
if ((long)GetPrivateData(lvl + LVL_PRIV_LAST, id) == YES)
break;
/* Next level */
lvl0 = NextItem(lvl0);
}
/* Return shortest distance */
return min;
}
long MoveDT(long part, double majorant, double minxs, long *cell, double *xs0,
double *x, double *y, double *z, double *l0, double *u, double *v,
double *w, double E, long id)
{
long ptr, type, mat, mat0, bc;
double totxs, l, wgt;
/* Check particle pointer */
CheckPointer(FUNCTION_NAME, "(part)", DATA_ARRAY, part);
/* Check coordinates and direction cosines */
CheckValue(FUNCTION_NAME, "x", "", *x, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "y", "", *y, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "z", "", *z, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "u", "", *u, -1.0, 1.0);
CheckValue(FUNCTION_NAME, "v", "", *v, -1.0, 1.0);
CheckValue(FUNCTION_NAME, "w", "", *w, -1.0, 1.0);
/* Get particle type */
type = (long)RDB[part + PARTICLE_TYPE];
/* Add to DT fraction counter */
ptr = (long)RDB[RES_DT_TRACK_FRAC];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf1D(1.0, 1.0, ptr, id, 2 - type);
/* Check cross section and sample path length */
CheckValue(FUNCTION_NAME, "majorant", "", majorant, ZERO, INFTY);
l = -log(RandF(id))/majorant;
/* Move particle to collision site */
*x = *x + *u*l;
*y = *y + *v*l;
*z = *z + *w*l;
/* Set path length */
*l0 = l;
/* Reset previous material pointer and total xs */
mat0 = -1;
totxs = 0.0;
/* Find location */
*cell = WhereAmI(*x, *y, *z, *u, *v, *w, id);
CheckPointer(FUNCTION_NAME, "(cell)", DATA_ARRAY, *cell);
/* Check if point is outside the geometry */
if ((long)RDB[*cell + CELL_TYPE] == CELL_TYPE_OUTSIDE)
{
/* Check if track is stopped at outer boundary */
if ((long)RDB[DATA_STOP_AT_BOUNDARY] == NO)
{
/* Set weight to test that albedo boundary conditions were not */
/* applied */
wgt = 1.0;
/* Apply repeated boundary conditions */
bc = BoundaryConditions(cell, x, y, z, u, v, w, &wgt, id);
/* Check that condition was applied */
if (bc != YES)
Die(FUNCTION_NAME, "Repeated bc not apllied");
/* Check change in weight */
if (wgt != 1.0)
Die(FUNCTION_NAME, "Change in weight (albedo)");
/* Find location */
*cell = WhereAmI(*x, *y, *z, *u, *v, *w, id);
CheckPointer(FUNCTION_NAME, "(cell)", DATA_ARRAY, *cell);
}
else
{
/* Stop track at boundary */
StopAtBoundary(cell, x, y, z, l0, *u, *v, *w, id);
/* Set cross section */
*xs0 = -1.0;
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return surface crossing */
return TRACK_END_SURF;
}
}
/* Get material pointer */
mat = (long)RDB[*cell + CELL_PTR_MAT];
mat = MatPtr(mat, id);
/* Check pointer */
if (mat != mat0)
{
/* Get total cross section */
totxs = TotXS(mat, type, E, id);
/* Remember material */
mat0 = mat;
}
/* Check total xs */
CheckValue(FUNCTION_NAME, "totxs", "", totxs, 0.0, INFTY);
/* Compare to minimum value */
if (totxs > minxs)
{
/* Sample between real and virtual collision */
if (RandF(id) < totxs/majorant)
{
/* Set cross section */
*xs0 = totxs;
/* Add to success counter */
ptr = (long)RDB[RES_DT_TRACK_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY,ptr);
AddBuf1D(1.0, 1.0, ptr, id, 2 - type);
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return collision */
return TRACK_END_COLL;
}
else
{
/* Set cross section */
*xs0 = -1.0;
/* Add to failure counter */
ptr = (long)RDB[RES_DT_TRACK_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY,ptr);
AddBuf1D(1.0, 1.0, ptr, id, 4 - type);
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return virtual */
return TRACK_END_VIRT;
}
}
else
{
/* Sample scoring */
if (RandF(id) < minxs/majorant)
{
/* Set cross section */
*xs0 = minxs;
/* Sample between real and virtual collision */
if (RandF(id) < totxs/minxs)
{
/* Add to success counter */
ptr = (long)RDB[RES_DT_TRACK_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY,ptr);
AddBuf1D(1.0, 1.0, ptr, id, 2 - type);
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return collision */
return TRACK_END_COLL;
}
else
{
/* Add to failure counter */
ptr = (long)RDB[RES_DT_TRACK_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY,ptr);
AddBuf1D(1.0, 1.0, ptr, id, 4 - type);
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return virtual */
return TRACK_END_VIRT;
}
}
else
{
/* Set cross section */
*xs0 = -1.0;
/* Add to failure counter */
ptr = (long)RDB[RES_DT_TRACK_EFF];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY,ptr);
AddBuf1D(1.0, 1.0, ptr, id, 4 - type);
/* Check distance */
CheckValue(FUNCTION_NAME, "l0", "", *l0, ZERO, INFTY);
/* Return virtual */
return TRACK_END_VIRT;
}
}
}
void CalculateEntropies()
{
long nx, ny, nz, part, i, j, k, idx, ptr;
double xmin, xmax, ymin, ymax, zmin, zmax, x, y, z, wgt, totw, totp;
double *spt, *swg, entrp, entrw, sump, sumw;
/* Check if entropies are calculated */
if ((long)RDB[DATA_OPTI_ENTROPY_CALC] == NO)
return;
/* Get mesh size */
nx = (long)RDB[DATA_ENTROPY_NX];
ny = (long)RDB[DATA_ENTROPY_NY];
nz = (long)RDB[DATA_ENTROPY_NZ];
/* Check values */
CheckValue(FUNCTION_NAME, "nx", "", nx, 1, 500);
CheckValue(FUNCTION_NAME, "ny", "", ny, 1, 500);
CheckValue(FUNCTION_NAME, "nz", "", nz, 1, 500);
/* Get boundaries */
xmin = RDB[DATA_ENTROPY_XMIN];
xmax = RDB[DATA_ENTROPY_XMAX];
ymin = RDB[DATA_ENTROPY_YMIN];
ymax = RDB[DATA_ENTROPY_YMAX];
zmin = RDB[DATA_ENTROPY_ZMIN];
zmax = RDB[DATA_ENTROPY_ZMAX];
/* Check values */
CheckValue(FUNCTION_NAME, "xmin", "", xmin, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "xmax", "", xmax, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "ymin", "", ymin, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "ymax", "", ymax, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "zmin", "", zmin, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "zmax", "", zmax, -INFTY, INFTY);
/* Check order */
if (xmin > xmax)
Die(FUNCTION_NAME, "Error in boundaries");
if (ymin > ymax)
Die(FUNCTION_NAME, "Error in boundaries");
if (zmin > zmax)
Die(FUNCTION_NAME, "Error in boundaries");
/* Allocate memory for temporary arrays */
spt = (double *)Mem(MEM_ALLOC, nx*ny*nz, sizeof(double));
swg = (double *)Mem(MEM_ALLOC, nx*ny*nz, sizeof(double));
/* Reset data */
memset(spt, 0.0, nx*ny*nz*sizeof(double));
memset(swg, 0.0, nx*ny*nz*sizeof(double));
/* Reset totals */
totw = 0.0;
totp = 0.0;
/* Pointer to first item after dummy */
part = (long)RDB[DATA_PART_PTR_SOURCE];
part = NextItem(part);
/* Loop over source and collect points */
while(part > VALID_PTR)
{
/* Get coordinates and weight */
x = RDB[part + PARTICLE_X];
y = RDB[part + PARTICLE_Y];
z = RDB[part + PARTICLE_Z];
wgt = RDB[part + PARTICLE_WGT];
/* Get local normalised co-ordinates */
if (xmin != xmax)
x = (x - xmin)/(xmax - xmin);
else
x = 0.0;
if (ymin != ymax)
y = (y - ymin)/(ymax - ymin);
else
y = 0.0;
if (zmin != zmax)
z = (z - zmin)/(zmax - zmin);
else
z = 0.0;
/* Check */
if ((x >= 0.0) && (x < 1.0) && (y >= 0.0) && (y < 1.0) &&
(z >= 0.0) && (z < 1.0))
{
/* Calculate indexes */
i = (long)(x*nx);
j = (long)(y*ny);
k = (long)(z*nz);
/* Calculate index */
idx = i + nx*j + nx*ny*k;
/* Add points and weight */
spt[idx] = spt[idx] + 1.0;
swg[idx] = swg[idx] + wgt;
/* Add to totals */
totp = totp + 1.0;
totw = totw + wgt;
}
/* Next particle */
part = NextItem(part);
}
/* X-component of entropy */
entrp = 0.0;
entrw = 0.0;
for (i = 0; i < nx; i++)
{
/* Sum over values */
sump = 0.0;
sumw = 0.0;
for (j = 0; j < ny; j++)
for (k = 0; k < nz; k++)
{
/* Calculate index */
idx = i + nx*j + nx*ny*k;
/* Add to sums */
sump = sump + spt[idx]/totp;
sumw = sumw + swg[idx]/totw;
}
/* Add to entropies */
if ((sump > 0.0) && (sump < 1.0))
entrp = entrp - sump*log2(sump);
if ((sumw > 0.0) && (sumw < 1.0))
entrw = entrw - sumw*log2(sumw);
}
/* Divide by uniform source entropy */
if (nx > 1)
{
entrp = entrp/log2(nx);
entrw = entrw/log2(nx);
}
/* Add to statistics */
ptr = (long)RDB[DATA_ENTROPY_PTR_SPT_STAT];
AddStat(entrp, ptr, 1);
ptr = (long)RDB[DATA_ENTROPY_PTR_SWG_STAT];
AddStat(entrw, ptr, 1);
/* Y-component of entropy */
entrp = 0.0;
entrw = 0.0;
for (j = 0; j < ny; j++)
{
/* Sum over values */
sump = 0.0;
sumw = 0.0;
for (i = 0; i < nx; i++)
for (k = 0; k < nz; k++)
{
/* Calculate index */
idx = i + nx*j + nx*ny*k;
/* Add to sums */
sump = sump + spt[idx]/totp;
sumw = sumw + swg[idx]/totw;
}
/* Add to entropies */
if ((sump > 0.0) && (sump < 1.0))
entrp = entrp - sump*log2(sump);
if ((sumw > 0.0) && (sumw < 1.0))
entrw = entrw - sumw*log2(sumw);
}
/* Divide by uniform source entropy */
if (ny > 1)
{
entrp = entrp/log2(ny);
entrw = entrw/log2(ny);
}
/* Add to statistics */
ptr = (long)RDB[DATA_ENTROPY_PTR_SPT_STAT];
AddStat(entrp, ptr, 2);
ptr = (long)RDB[DATA_ENTROPY_PTR_SWG_STAT];
AddStat(entrw, ptr, 2);
/* Z-component of entropy */
entrp = 0.0;
entrw = 0.0;
for (k = 0; k < nz; k++)
{
/* Sum over values */
sump = 0.0;
sumw = 0.0;
for (i = 0; i < nx; i++)
for (j = 0; j < ny; j++)
{
/* Calculate index */
idx = i + nx*j + nx*ny*k;
/* Add to sums */
sump = sump + spt[idx]/totp;
sumw = sumw + swg[idx]/totw;
}
/* Add to entropies */
if ((sump > 0.0) && (sump < 1.0))
entrp = entrp - sump*log2(sump);
if ((sumw > 0.0) && (sumw < 1.0))
entrw = entrw - sumw*log2(sumw);
}
/* Divide by uniform source entropy */
if (nz > 1)
{
entrp = entrp/log2(nz);
entrw = entrw/log2(nz);
}
/* Add to statistics */
ptr = (long)RDB[DATA_ENTROPY_PTR_SPT_STAT];
AddStat(entrp, ptr, 3);
ptr = (long)RDB[DATA_ENTROPY_PTR_SWG_STAT];
AddStat(entrw, ptr, 3);
/* Total entropy */
entrp = 0.0;
entrw = 0.0;
/* Loop over values */
for (i = 0; i < nx; i++)
for (j = 0; j < ny; j++)
for (k = 0; k < nz; k++)
{
/* Calculate index */
idx = i + nx*j + nx*ny*k;
/* Get value */
sump = spt[idx]/totp;
sumw = swg[idx]/totw;
/* Add to entropies */
if ((sump > 0.0) && (sump < 1.0))
entrp = entrp - sump*log2(sump);
if ((sumw > 0.0) && (sumw < 1.0))
entrw = entrw - sumw*log2(sumw);
}
/* Divide by uniform source entropy */
if (nx*ny*nz > 1)
{
entrp = entrp/log2(nx*ny*nz);
entrw = entrw/log2(nx*ny*nz);
}
/* Add to statistics */
ptr = (long)RDB[DATA_ENTROPY_PTR_SPT_STAT];
AddStat(entrp, ptr, 0);
ptr = (long)RDB[DATA_ENTROPY_PTR_SWG_STAT];
AddStat(entrw, ptr, 0);
/* Free temporary arrays */
Mem(MEM_FREE, spt);
Mem(MEM_FREE, swg);
}
double TetraVol(long ifc, long cgns)
{
long surf, ptr, n, p0, p1, p2, p3, nf;
long surflist, facelist;
double vol, a1, a2, a3, b1, b2, b3;
double c1, c2, c3;
/* Check cell pointer */
CheckPointer(FUNCTION_NAME, "(cgns)", DATA_ARRAY, cgns);
/* Get pointer to interface surfaces */
surflist = (long)RDB[ifc + IFC_PTR_SURF_LIST];
CheckPointer(FUNCTION_NAME, "(surflist)", DATA_ARRAY, surflist);
/* Get pointer to cell's face list */
facelist = (long)RDB[cgns + IFC_TET_MSH_PTR_FACES];
CheckPointer(FUNCTION_NAME, "(facelist)", DATA_ARRAY, facelist);
/* Loop over cell faces */
nf = (long)RDB[cgns + IFC_TET_MSH_NF];
CheckValue(FUNCTION_NAME, "nf", "", nf, 4, 4);
/* Get index of face */
n = (long)RDB[facelist + 0];
/* Get pointer to face surface */
surf = ListPtr(surflist, n);
/* Get pointer to surface parameters */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get pointers to points */
p0 = (long)RDB[ptr + 0];
p1 = (long)RDB[ptr + 1];
p2 = (long)RDB[ptr + 2];
/* Get fourth point from second face */
/* Get index of face */
n = (long)RDB[facelist + 1];
/* Get pointer to face surface */
surf = ListPtr(surflist, n);
/* Get pointer to surface parameters */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get point candidate */
p3 = (long)RDB[ptr + 0];
/* Check if it is one of the first three */
if ((p3 == p0) || (p3 == p1) || (p3 == p2))
{
/* Try next point */
p3 = (long)RDB[ptr + 1];
if ((p3 == p0) || (p3 == p1) || (p3 == p2))
{
/* Try next point */
p3 = (long)RDB[ptr + 2];
if ((p3 == p0) || (p3 == p1) || (p3 == p2))
Die(FUNCTION_NAME, "Identical faces");
}
}
/* Calculate vector components */
a1 = RDB[p1+0] - RDB[p0+0];
a2 = RDB[p1+1] - RDB[p0+1];
a3 = RDB[p1+2] - RDB[p0+2];
b1 = RDB[p2+0] - RDB[p0+0];
b2 = RDB[p2+1] - RDB[p0+1];
b3 = RDB[p2+2] - RDB[p0+2];
c1 = RDB[p3+0] - RDB[p0+0];
c2 = RDB[p3+1] - RDB[p0+1];
c3 = RDB[p3+2] - RDB[p0+2];
/* Calculate vector triple product and volume */
vol = a1*(b2*c3 - b3*c2) - a2*(b1*c3 - b3*c1) + a3*(b1*c2 - b2*c1);
vol = fabs(vol)/6.0;
/* Check */
if (vol == 0.0)
Warn(FUNCTION_NAME, "Zero volume in cell %ld",
(long)RDB[cgns + IFC_TET_MSH_IDX]);
else if (vol > 1E+9)
Warn(FUNCTION_NAME, "Suspiciouslylarge volume %1.5E in cell %ld", vol,
(long)RDB[cgns + IFC_TET_MSH_IDX]);
/* Return volume */
return vol;
}
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;
/***************************************************************************/
}
void QRfactorization(long n, complex **A, complex **Q, complex **R)
{
/* QR factorization based on Householder transformations */
long i,j,k,m;
double nrm;
complex z,z1,z2;
complex *vj;
/* Init. Q = eye(n) (identity matrix) */
for (i=0; i<n; i++){
Q[i][i].re = 1.0;
Q[i][i].im = 0.0;
}
/* Init. R = A */
for(j=0; j<n; j++){
for (i=0; i<n; i++){
R[i][j].re = A[i][j].re;
R[i][j].im = A[i][j].im;
CheckValue(FUNCTION_NAME, "A[i][j].re","", A[i][j].re, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "A[i][j].im","", A[i][j].im, -INFTY, INFTY);
}
}
/* Allocate auxiliary variables*/
vj = (complex *)Mem(MEM_ALLOC, n, sizeof(complex));
/* printf("begin calc, n = %d\n", n); */
/* ------------------------------------------------------------*/
for (j=0; j<n; j++){ /* Main loop */
/* R(j:end, j) */
for (i=j; i<n; i++){
vj[i-j].re = R[i][j].re;
vj[i-j].im = R[i][j].im;
}
nrm = vectorNorm(n-j, vj);
/* v(1) = v(1) + sign(R(j,j)) * norm(v) */
vj[0].re = vj[0].re + R[j][j].re / c_norm(R[j][j]) * nrm;
vj[0].im = vj[0].im + R[j][j].im / c_norm(R[j][j]) * nrm;
/* Update norm */
nrm = vectorNorm(n-j, vj);
/* v = v./norm(v) */
for (i=0; i<n-j; i++){
vj[i].re = vj[i].re / nrm;
vj[i].im = vj[i].im / nrm;
}
/* Update */
/* R(j:end, :) = R(j:end,:) - 2 * vj * vj' * R(j:end,:), : */
/* Q(:,j:end) = Q(:,j:end) - 2 * Q(:,j:end) * vj * vj^T */
for (k=0; k<n; k++){
/* (v * v' * A)_ik = v_i SUM_m Conj(v_m) A_mk */
z.re = 0.0;
z.im = 0.0;
for (m=j; m<n; m++){
z1 = c_con(vj[m-j]);
z1 = c_mul(z1, R[m][k]);
z = c_add(z,z1);
}
for (i=j; i<n; i++){
z2 = c_mul(vj[i-j],z);
/* Update R(i,k) */
R[i][k].re = R[i][k].re - 2.0 * z2.re;
R[i][k].im = R[i][k].im - 2.0 * z2.im;
CheckValue(FUNCTION_NAME, "R[i][k].re","", R[i][k].re, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "R[i][k].im","", R[i][k].im, -INFTY, INFTY);
}
/* (A * v * v^')_ki = v_i * SUM_m Conj(v_m) A_km */
z.re = 0.0;
z.im = 0.0;
for (m=j; m<n; m++){
z1 = vj[m-j];
z1 = c_mul(z1, Q[k][m]);
z = c_add(z,z1);
}
for (i=j; i<n; i++){
z1 = c_con(vj[i-j]);
z2 = c_mul(z1,z);
/* Update Q(k,i)*/
Q[k][i].re = Q[k][i].re - 2.0 * z2.re;
Q[k][i].im = Q[k][i].im - 2.0 * z2.im;
CheckValue(FUNCTION_NAME, "Q[k][i].re","", Q[k][i].re, -INFTY, INFTY);
CheckValue(FUNCTION_NAME, "Q[k][i].im","", Q[k][i].im, -INFTY, INFTY);
}
}
} /* End of main loop (j) */
/* -------------------------------------------------------------*/
/* Free auxiliary variables */
Mem(MEM_FREE, vj);
return;
}
void ReadFissionYields()
{
double E, yield, sum;
long n, m, i, loc0, loc1, ZA, NWD, I, LE, NFP, ptr, ZAI, Z, A, yld, pta;
char line[256], *eof;
FILE *fp;
/***************************************************************************/
/***** Neutron-induced fission ********************************************/
if ((pta = (long)RDB[DATA_PTR_NFYDATA_FNAME_LIST]) > 0)
{
/* Print */
fprintf(out, "Reading neutron-induced fission yields...\n");
/* Loop over files */
while ((long)RDB[pta] > 0)
{
/*******************************************************************/
/***** Independent yields ******************************************/
/* Test format */
WDB[DATA_DUMMY] = RDB[pta];
TestDOSFile(GetText(DATA_DUMMY));
/* Open file for reading */
fp = OpenDataFile(pta, "NFY data");
/* Loop over endf file */
do
{
/* Loop until in comment section */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 1451) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
break;
/* Read ZA */
ZA = (long)rint(ENDFColF(1, line));
/* Check that value is reasonable, if not, this is not */
/* a fission yield file. */
if (ZA < 89000)
Error(0, "No fission yield data available in file \"%s\"",
GetText(pta));
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 89000, 120000);
/* Read isomeric state number */
ENDFNewLine(FUNCTION_NAME, line, fp);
I = ENDFColI(4, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 1);
/* Convert to ZAI (this is the parent, ZA and I are re-used */
/* in the next loop). */
ZAI = 10*ZA + I;
/* Skip line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Read header size */
ENDFNewLine(FUNCTION_NAME, line, fp);
NWD = ENDFColI(5, line);
/* Skip header */
fseek(fp, 81*(NWD + 1), SEEK_CUR);
/* Skip remaining comment block */
do
ENDFNewLine(FUNCTION_NAME, line, fp);
while (atoi(&line[71]) == 1451);
/* Loop until fission product yield data. */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 8454) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
Die(FUNCTION_NAME, "Error reading fission yield file \"%s\"",
GetText(pta));
/* Get number of incident energies */
LE = ENDFColI(3, line);
/* Check value */
CheckValue(FUNCTION_NAME, "LE", "", LE, 0, 4);
/* Loop over energies */
for (n = 0; n < LE; n++)
{
/***********************************************************/
/***** Store data ******************************************/
/* Allocate memory for data */
yld = ReallocMem(ACE_ARRAY, FISSION_YIELD_BLOCK_SIZE);
/* Set null pointer to next */
ACE[yld + FISSION_YIELD_PTR_NEXT] = NULLPTR;
/* Check if previous exists (ei voi käyttää VALID_PTR) */
if ((ptr = (long)RDB[DATA_PTR_ACE_NFY_DATA]) < 0)
{
/* First definition, set pointer */
WDB[DATA_PTR_ACE_NFY_DATA] = (double)yld;
}
else
{
/* Find last block (tohon ei VALID_PTR) */
while ((long)ACE[ptr + FISSION_YIELD_PTR_NEXT] > 0)
ptr = (long)ACE[ptr + FISSION_YIELD_PTR_NEXT];
/* Set pointer to new */
ACE[ptr + FISSION_YIELD_PTR_NEXT] = (double)yld;
}
/* Put parent ZAI */
ACE[yld + FISSION_YIELD_PARENT_ZAI] = (double)ZAI;
/* Get energy */
ENDFNewLine(FUNCTION_NAME, line, fp);
E = 1E-6*ENDFColF(1, line);
/* Check value */
CheckValue(FUNCTION_NAME, "E", "(independent)", E, 0.0, 20.0);
/* Put value */
ACE[yld + FISSION_YIELD_E] = E;
/* Get number of fission products */
NFP = ENDFColI(6, line);
/* Check value */
CheckValue(FUNCTION_NAME, "NFP", "", NFP, 700,
MAX_FP_NUCLIDES);
/* Additional check for upper limit */
if (NFP > MAX_FP_NUCLIDES)
Die(FUNCTION_NAME,
"Number of FP nuclides exceeds maximum");
/* Put value */
ACE[yld + FISSION_YIELD_NFP] = (double)NFP;
/* Allocate memory for data */
loc0 = ReallocMem(ACE_ARRAY, NFP + 1);
/* Set pointer */
ACE[yld + FISSION_YIELD_PTR_DISTR] = (double)loc0;
/* Read first line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Loop over data */
i = 1;
sum = 0.0;
for (m = 0; m < NFP; m++)
{
/* Read isotope ZA */
ZA = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 1001, 80000);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Separate Z and A (only needed for bug check) */
Z = (long)((double)ZA/1000.0);
A = ZA - 1000*Z;
/* Check values */
CheckValue(FUNCTION_NAME, "Z", "", Z, 1, 80);
CheckValue(FUNCTION_NAME, "A", "", A, 1, 210);
/* Read isomeric state */
I = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 2);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read yield */
yield = ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "yield", "",yield, 0.0, 1.0);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Skip uncertainty */
i++;
if ((i > 6) && (m < NFP - 1))
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Allocate memory */
loc1 = ReallocMem(ACE_ARRAY, FY_BLOCK_SIZE);
/* Put pointer */
ACE[loc0++] = (double)loc1;
/* Put values */
ACE[loc1 + FY_TGT_ZAI] = (double)(10*ZA + I);
ACE[loc1 + FY_INDEPENDENT_FRAC] = yield;
/* Add to sum */
sum = sum + yield;
}
/* Put null pointer */
ACE[loc0] = NULLPTR;
/* Check sum (may differ from 2 due to cut-off and ternary */
/* fission) */
CheckValue(FUNCTION_NAME, "sum", "", sum, 1.5, 2.5);
/* Set warning flag */
if ((sum < 1.9999) || (sum > 2.01))
WDB[DATA_WARN_NFY_SUM] = RDB[DATA_WARN_NFY_SUM] + 1.0;
}
}
while (1 != 2);
/* Close file */
fclose(fp);
/*******************************************************************/
/***** Cumulative yields *******************************************/
fp = OpenDataFile(pta, "NFY data");
/* Pointer to data (tässä oletetaan että noi independent yieldit on */
/* luettu ja cumulative yieldit on samassa järjestyksessä). */
yld = (long)RDB[DATA_PTR_ACE_NFY_DATA];
/* Loop over endf file */
do
{
/* Loop until in comment section */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 1451) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
break;
/* Read ZA */
ZA = (long)rint(ENDFColF(1, line));
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 89000, 120000);
/* Read isomeric state number */
ENDFNewLine(FUNCTION_NAME, line, fp);
I = ENDFColI(4, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 1);
/* Convert to ZAI (this is the parent, ZA and I are re-used */
/* in the next loop). */
ZAI = 10*ZA + I;
/* Skip line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Read header size */
ENDFNewLine(FUNCTION_NAME, line, fp);
NWD = ENDFColI(5, line);
/* Skip header */
fseek(fp, 81*(NWD + 1), SEEK_CUR);
/* Skip remaining comment block */
do
ENDFNewLine(FUNCTION_NAME, line, fp);
while (atoi(&line[71]) == 1451);
/* Loop until fission product yield data. */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 8459) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
Die(FUNCTION_NAME, "Error reading fission yield file \"%s\"",
GetText(pta));
/* Get number of incident energies */
LE = ENDFColI(3, line);
/* Check value */
CheckValue(FUNCTION_NAME, "LE", "", LE, 0, 4);
/* Loop over energies */
for (n = 0; n < LE; n++)
{
/***********************************************************/
/***** Store data ******************************************/
/* Compare ZAI */
if ((long)ACE[yld + FISSION_YIELD_PARENT_ZAI] != ZAI)
Die(FUNCTION_NAME, "Mismatch in parent ZAI");
/* Get energy */
ENDFNewLine(FUNCTION_NAME, line, fp);
E = 1E-6*ENDFColF(1, line);
/* Compare energy */
if (ACE[yld + FISSION_YIELD_E] != E)
Die(FUNCTION_NAME, "Mismatch in energy");
/* Get number of fission products */
NFP = ENDFColI(6, line);
/* compare value */
if ((long)ACE[yld + FISSION_YIELD_NFP] != NFP)
Die(FUNCTION_NAME, "Mismatch in NFP");
/* Set pointer to data */
loc0 = (long)ACE[yld + FISSION_YIELD_PTR_DISTR];
/* Read first line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Loop over data */
i = 1;
sum = 0.0;
for (m = 0; m < NFP; m++)
{
/* Read isotope ZA */
ZA = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 1001, 80000);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read isomeric state */
I = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 2);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read yield */
yield = ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "yield", "",yield, 0.0, 1.0);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Skip uncertainty */
i++;
if ((i > 6) && (m < NFP - 1))
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Get pointer */
loc1 = (long)ACE[loc0++];
/* Compare ZAI */
if ((long)ACE[loc1 + FY_TGT_ZAI] != 10*ZA + I)
Die(FUNCTION_NAME, "Mismatch in product ZAI");
/* Compare yield (ENDF/B-VI.8 and -VII datassa pieniä */
/* ylityksiä) */
if ((yield > 0.0) &&
(ACE[loc1 + FY_INDEPENDENT_FRAC]/yield- 1.0 > 1E-4))
Warn(FUNCTION_NAME,
"Independent yield exceeds cumulative (%ld %E %E)",
ZAI, yield, ACE[loc1 + FY_INDEPENDENT_FRAC]);
/* Put yield */
ACE[loc1 + FY_CUMULATIVE_FRAC] = yield;
}
/* Next yield */
yld = (long)ACE[yld + FISSION_YIELD_PTR_NEXT];
}
}
while (1 != 2);
/* Close file */
fclose(fp);
/*******************************************************************/
/* Next file */
pta++;
}
/***********************************************************************/
fprintf(out, "OK.\n\n");
}
/***************************************************************************/
/***** Sponteneous fission ************************************************/
if ((pta = (long)RDB[DATA_PTR_SFYDATA_FNAME_LIST]) > 0)
{
/* Print */
fprintf(out, "Reading spontaneous fission yields...\n");
/* Loop over files */
while ((long)RDB[pta] > 0)
{
/*******************************************************************/
/***** Independent yields ******************************************/
/* Open file for reading */
fp = OpenDataFile(pta, "NFY data");
/* Loop over endf file */
do
{
/* Loop until in comment section */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 1451) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
break;
/* Read ZA */
ZA = (long)rint(ENDFColF(1, line));
/* Check that value is reasonable, if not, this is not */
/* a fission yield file. */
if (ZA < 89000)
Error(0, "No fission yield data available in file \"%s\"",
GetText(pta));
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 89000, 120000);
/* Read isomeric state number */
ENDFNewLine(FUNCTION_NAME, line, fp);
I = ENDFColI(4, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 1);
/* Convert to ZAI (this is the parent, ZA and I are re-used */
/* in the next loop). */
ZAI = 10*ZA + I;
/* Skip line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Read header size */
ENDFNewLine(FUNCTION_NAME, line, fp);
NWD = ENDFColI(5, line);
/* Skip header */
fseek(fp, 81*(NWD + 1), SEEK_CUR);
/* Skip remaining comment block */
do
ENDFNewLine(FUNCTION_NAME, line, fp);
while (atoi(&line[71]) == 1451);
/* Loop until fission product yield data. */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 8454) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
Die(FUNCTION_NAME, "Error reading fission yield file \"%s\"",
GetText(pta));
/* Get number of incident energies */
LE = ENDFColI(3, line);
/* Check value */
CheckValue(FUNCTION_NAME, "LE", "", LE, 1, 1);
/* Loop over energies */
for (n = 0; n < LE; n++)
{
/***********************************************************/
/***** Store data ******************************************/
/* Allocate memory for data */
yld = ReallocMem(ACE_ARRAY, FISSION_YIELD_BLOCK_SIZE);
/* Set null pointer to next */
ACE[yld + FISSION_YIELD_PTR_NEXT] = NULLPTR;
/* Check if previous exists (ei voi käyttää VALID_PTR) */
if ((ptr = (long)RDB[DATA_PTR_ACE_SFY_DATA]) < 0)
{
/* First definition, set pointer */
WDB[DATA_PTR_ACE_SFY_DATA] = (double)yld;
}
else
{
/* Find last block (tohon ei VALID_PTR) */
while ((long)ACE[ptr + FISSION_YIELD_PTR_NEXT] > 0)
ptr = (long)ACE[ptr + FISSION_YIELD_PTR_NEXT];
/* Set pointer to new */
ACE[ptr + FISSION_YIELD_PTR_NEXT] = (double)yld;
}
/* Put parent ZAI */
ACE[yld + FISSION_YIELD_PARENT_ZAI] = (double)ZAI;
/* Get energy */
ENDFNewLine(FUNCTION_NAME, line, fp);
E = 1E-6*ENDFColF(1, line);
/* Check value */
CheckValue(FUNCTION_NAME, "E", "(independent)", E, 0.0, 20.0);
/* Put value */
ACE[yld + FISSION_YIELD_E] = E;
/* Get number of fission products */
NFP = ENDFColI(6, line);
/* Check value */
CheckValue(FUNCTION_NAME, "NFP", "", NFP, 700,
MAX_FP_NUCLIDES);
/* Additional check for upper limit */
if (NFP > MAX_FP_NUCLIDES)
Die(FUNCTION_NAME,
"Number of FP nuclides exceeds maximum");
/* Put value */
ACE[yld + FISSION_YIELD_NFP] = (double)NFP;
/* Allocate memory for data */
loc0 = ReallocMem(ACE_ARRAY, NFP + 1);
/* Set pointer */
ACE[yld + FISSION_YIELD_PTR_DISTR] = (double)loc0;
/* Read first line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Loop over data */
i = 1;
sum = 0.0;
for (m = 0; m < NFP; m++)
{
/* Read isotope ZA */
ZA = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 1001, 80000);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Separate Z and A (only needed for bug check) */
Z = (long)((double)ZA/1000.0);
A = ZA - 1000*Z;
/* Check values */
if ((Z < 1) || (Z > 80))
Die(FUNCTION_NAME, "Error in Z");
if ((A < 1) || (A > 210))
Die(FUNCTION_NAME, "Error in A");
/* Read isomeric state */
I = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 2);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read yield */
yield = ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "yield", "",yield, 0.0, 1.0);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Skip uncertainty */
i++;
if ((i > 6) && (m < NFP - 1))
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Allocate memory */
loc1 = ReallocMem(ACE_ARRAY, FY_BLOCK_SIZE);
/* Put pointer */
ACE[loc0++] = (double)loc1;
/* Put values */
ACE[loc1 + FY_TGT_ZAI] = (double)(10*ZA + I);
ACE[loc1 + FY_INDEPENDENT_FRAC] = yield;
/* Add to sum */
sum = sum + yield;
}
/* Put null pointer */
ACE[loc0] = NULLPTR;
/* Check sum (may differ from 2 due to cut-off and ternary */
/* fission) */
CheckValue(FUNCTION_NAME, "sum", "", sum, 1.5, 2.5);
/* Set warning flag */
if ((sum < 1.9999) || (sum > 2.01))
WDB[DATA_WARN_SFY_SUM] = RDB[DATA_WARN_SFY_SUM] + 1.0;
}
}
while (1 != 2);
/* Close file */
fclose(fp);
/*******************************************************************/
/***** Cumulative yields *******************************************/
fp = OpenDataFile(pta, "SFY data");
/* Pointer to data (tässä oletetaan että noi independent yieldit */
/* on luettu ja cumulative yieldit on samassa järjestyksessä). */
yld = (long)RDB[DATA_PTR_ACE_SFY_DATA];
/* Loop over endf file */
do
{
/* Loop until in comment section */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 1451) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
break;
/* Read ZA */
ZA = (long)rint(ENDFColF(1, line));
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 89000, 120000);
/* Read isomeric state number */
ENDFNewLine(FUNCTION_NAME, line, fp);
I = ENDFColI(4, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 1);
/* Convert to ZAI (this is the parent, ZA and I are re-used */
/* in the next loop). */
ZAI = 10*ZA + I;
/* Skip line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Read header size */
ENDFNewLine(FUNCTION_NAME, line, fp);
NWD = ENDFColI(5, line);
/* Skip header */
fseek(fp, 81*(NWD + 1), SEEK_CUR);
/* Skip remaining comment block */
do
ENDFNewLine(FUNCTION_NAME, line, fp);
while (atoi(&line[71]) == 1451);
/* Loop until fission product yield data. */
do
eof = fgets(line, 82, fp);
while ((atoi(&line[71]) != 8459) && (eof != NULL));
/* Check EOF */
if (eof == NULL)
Die(FUNCTION_NAME, "Error reading fission yield file \"%s\"",
GetText(pta));
/* Get number of incident energies */
LE = ENDFColI(3, line);
/* Check value */
CheckValue(FUNCTION_NAME, "LE", "", LE, 1, 1);
/* Loop over energies */
for (n = 0; n < LE; n++)
{
/***********************************************************/
/***** Store data ******************************************/
/* Compare ZAI */
if ((long)ACE[yld + FISSION_YIELD_PARENT_ZAI] != ZAI)
Die(FUNCTION_NAME, "Mismatch in parent ZAI");
/* Get energy */
ENDFNewLine(FUNCTION_NAME, line, fp);
E = 1E-6*ENDFColF(1, line);
/* Compare energy */
/*
if (ACE[yld + FISSION_YIELD_E] != E)
Die(FUNCTION_NAME, "Mismatch in energy");
*/
/* Get number of fission products */
NFP = ENDFColI(6, line);
/* compare value */
if ((long)ACE[yld + FISSION_YIELD_NFP] != NFP)
Die(FUNCTION_NAME, "Mismatch in NFP");
/* Set pointer to data */
loc0 = (long)ACE[yld + FISSION_YIELD_PTR_DISTR];
/* Read first line */
ENDFNewLine(FUNCTION_NAME, line, fp);
/* Loop over data */
i = 1;
sum = 0.0;
for (m = 0; m < NFP; m++)
{
/* Read isotope ZA */
ZA = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "ZA", "", ZA, 1001, 80000);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read isomeric state */
I = (long)ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "I", "", I, 0, 2);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Read yield */
yield = ENDFColF(i++, line);
/* Check value */
CheckValue(FUNCTION_NAME, "yield", "",yield, 0.0, 1.0);
if (i > 6)
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Skip uncertainty */
i++;
if ((i > 6) && (m < NFP - 1))
{
ENDFNewLine(FUNCTION_NAME, line, fp);
i = i - 6;
}
/* Get pointer */
loc1 = (long)ACE[loc0++];
/* Compare ZAI */
if ((long)ACE[loc1 + FY_TGT_ZAI] != 10*ZA + I)
Die(FUNCTION_NAME, "Mismatch in product ZAI");
/* Compare yield (ENDF/B-VI.8 and -VII datassa pieniä */
/* ylityksiä) */
if ((yield > 0.0) &&
(ACE[loc1 + FY_INDEPENDENT_FRAC]/yield- 1.0 > 2E-4))
Warn(FUNCTION_NAME,
"Independent yield exceeds cumulative (%ld %E %E)",
ZAI, yield, ACE[loc1 + FY_INDEPENDENT_FRAC]);
/* Put yield */
ACE[loc1 + FY_CUMULATIVE_FRAC] = yield;
}
/* Next yield */
yld = (long)ACE[yld + FISSION_YIELD_PTR_NEXT];
}
}
while (1 != 2);
/* Close file */
fclose(fp);
/*******************************************************************/
/* Next file */
pta++;
}
fprintf(out, "OK.\n\n");
}
/***************************************************************************/
}
double MacroXS(long rea0, double E, long id)
{
long i, ptr, rea, erg, ne, mat, nuc, ncol, mt;
double xs0, xs1, xs, adens, f, mult, Emin, Emax, Er, T;
/* Check Pointer */
CheckPointer(FUNCTION_NAME, "(rea0)", DATA_ARRAY, rea0);
/* Get mt */
mt = (long)RDB[rea0 + REACTION_MT];
CheckValue(FUNCTION_NAME, "mt", "", mt, -30, -1);
/* Get pointer to material */
mat = (long)RDB[rea0 + REACTION_PTR_MAT];
CheckPointer(FUNCTION_NAME, "(mat)", DATA_ARRAY, mat);
/* Get pointer to data */
if ((ptr = (long)RDB[rea0 + REACTION_PTR_XS]) > VALID_PTR)
{
/***********************************************************************/
/***** Interpolate pre-calculated data *********************************/
#ifdef DEBUG
/* Sanity check for TMS */
if (((long)RDB[mat + MATERIAL_TMS_MODE] == TMS_MODE_MG) ||
(((long)RDB[mat + MATERIAL_TMS_MODE] == TMS_MODE_CE) &&
(mt != MT_MACRO_TMP_MAJORANTXS)))
Die(FUNCTION_NAME, "Pre-calculated data in %s %ld",
GetText(mat + MATERIAL_PTR_NAME), mt);
#endif
/* Test existing data (ei voi käyttää TMS:n kanssa) */
if ((xs = TestValuePair(rea0 + REACTION_PTR_PREV_XS, E, id)) > -INFTY)
return xs;
/* Get pointer to energy grid */
erg = (long)RDB[rea0 + REACTION_PTR_EGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Get interpolation factor */
if ((f = GridFactor(erg, E, id)) < 0)
xs = 0.0;
else
{
/* Check interpolation factor */
CheckValue(FUNCTION_NAME, "f", "", f, 0.0, MAX_EGRID_NE);
/* Separate integer and decimal parts of interpolation factor */
i = (long)f;
f = f - (double)i;
/* Get number of points */
ne = (long)RDB[rea0 + REACTION_XS_NE];
CheckValue(FUNCTION_NAME, "ne", "", ne, 2, MAX_EGRID_NE);
/* Check boundaries */
if ((i < 0) || (i > ne - 1))
xs = 0.0;
else
{
/* Get tabulated cross sections */
xs0 = RDB[ptr + i];
xs1 = RDB[ptr + i + 1];
if (mt != MT_MACRO_TMP_MAJORANTXS)
{
/* Interpolate in normal case */
if (i == ne - 1)
xs = (1.0 - f)*xs0;
else
xs = f*(xs1 - xs0) + xs0;
}
else
{
/* TMS-tapauksessa majoranttia ei interpoloida */
/* (histogrammimajorantti) */
xs = xs0;
}
}
}
/* Add poison cross section */
if (((long)RDB[DATA_XENON_EQUILIBRIUM_MODE] == YES) ||
((long)RDB[DATA_SAMARIUM_EQUILIBRIUM_MODE] == YES))
if ((mt == MT_MACRO_TOTXS) || (mt == MT_MACRO_ABSXS))
xs = xs + PoisonXS(mat, E, mt, id);
/* Perform ures correction */
xs = MacroUresCorr(rea0, xs, E, id);
/* Store value */
StoreValuePair(rea0 + REACTION_PTR_PREV_XS, E, xs, id);
/* Return value */
return xs;
/***********************************************************************/
}
else if (((long)RDB[mat + MATERIAL_TMS_MODE] != TMS_MODE_NONE) &&
(mt != MT_MACRO_TMP_MAJORANTXS))
{
/***********************************************************************/
/***** TMS-moodi ******************************************************/
#ifdef DEBUG
/* Sanity check for TMS */
if ((RDB[mat + MATERIAL_TMS_TMIN] == 0.0) ||
(RDB[mat + MATERIAL_TMS_TMIN] > RDB[mat + MATERIAL_TMS_TMAX]))
Die(FUNCTION_NAME, "Error in temperature in %s",
GetText(mat + MATERIAL_PTR_NAME));
#endif
/* Get collision number */
ptr = (long)RDB[DATA_PTR_COLLISION_COUNT];
ncol = (long)GetPrivateData(ptr, id);
/* Test existing data (HUOM! ncol, koska lämpötila voi olla eri) */
if ((xs = TestValuePair(rea0 + REACTION_PTR_PREV_XS, ncol, id)) > -INFTY)
return xs;
/* Reset cross section */
xs = 0.0;
/* Get material temperature for on-the-fly temperature treatment */
if ((T = GetTemp(mat, id)) > 0.0)
{
/* Get pointer to partial list */
ptr = (long)RDB[rea0 + REACTION_PTR_PARTIAL_LIST];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Reset reaction pointer (rewind list) */
rea = -1;
/* Loop over reactions */
while (NextReaction(ptr, &rea, &adens, &Emin, &Emax, id) > VALID_PTR)
{
/* Check reaction pointer */
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* get multiplier */
mult = ReaMulti(rea, mt, E, id);
/* Pointer to nuclide */
nuc = (long)RDB[rea + REACTION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Add to cross section */
xs = xs + mult*adens*DopMicroXS(mat, rea, E, &Er, T, id);
/* Check energy cut-off */
if (E < Emin)
break;
}
/* Store cross section */
StoreValuePair(rea0 + REACTION_PTR_PREV_XS, ncol, xs, id);
/* Return interpolated value */
return xs;
}
/***********************************************************************/
}
/***************************************************************************/
/***** Calculate sum of partials *******************************************/
/* Test existing data */
if ((xs = TestValuePair(rea0 + REACTION_PTR_PREV_XS, E, id)) > -INFTY)
return xs;
/* Reset cross section */
xs = 0.0;
/* Get pointer to partial list */
ptr = (long)RDB[rea0 + REACTION_PTR_PARTIAL_LIST];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Reset reaction pointer (rewind list) */
rea = -1;
/* Loop over reactions */
while (NextReaction(ptr, &rea, &adens, &Emin, &Emax, id) > VALID_PTR)
{
/* Check reaction pointer */
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Get multiplier */
mult = ReaMulti(rea, mt, E, id);
/* Add to cross section */
if (mt != MT_MACRO_TMP_MAJORANTXS)
xs = xs + mult*adens*MicroXS(rea, E, id);
/* In case of majorantxs, use MicroMajorantXS */
else
xs = xs + mult*adens*MicroMajorantXS(rea, E, id);
/* Check energy cut-off */
if (E < Emin)
break;
}
/* Store cross section */
StoreValuePair(rea0 + REACTION_PTR_PREV_XS, E, xs, id);
/* Return value */
return xs;
/****************************************************************************/
}
void DistributeMaterialData()
{
#ifdef MPI
long mat, id, ptr, sz;
/* Check number of MPI tasks */
if (mpitasks == 1)
return;
fprintf(out, "Waiting for results from other MPI tasks...\n");
/* Start timers */
StartTimer(TIMER_MPI_OVERHEAD);
StartTimer(TIMER_MPI_OVERHEAD_TOTAL);
/***************************************************************************/
/***** Collect data ********************************************************/
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Check burn-flag */
if ((long)RDB[mat + MATERIAL_OPTIONS] & OPT_BURN_MAT)
{
/* Get MPI id */
id = (long)RDB[mat + MATERIAL_MPI_ID];
CheckValue(FUNCTION_NAME, "id", "", id, 0, mpitasks - 1);
/* Get pointer to data */
ptr = (long)RDB[mat + MATERIAL_PTR_DATA_BLOCK];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get block size */
sz = (long)RDB[mat + MATERIAL_DATA_BLOCK_SIZE];
/* Synchronise */
MPI_Barrier(MPI_COMM_WORLD);
/* Broadcast data to other tasks */
MPITransfer(&WDB[ptr], NULL, sz, id, MPI_METH_BC);
/* Synchronise */
MPI_Barrier(MPI_COMM_WORLD);
}
/* Next material */
mat = NextItem(mat);
}
/***************************************************************************/
fprintf(out, "OK.\n\n");
/* Stop timers */
StopTimer(TIMER_MPI_OVERHEAD);
StopTimer(TIMER_MPI_OVERHEAD_TOTAL);
#endif
}
void CalculateTransmuXS(long mat, long id)
{
long loc0, i, loc1, dep, rea, ptr, i0, ne, erg, erg0, sz, i1, nuc, rea1;
double g, sum, E, E0, E1, E2, Emin, Emax, *xs, *spec, flx;
/* Check burnup mode and burn flag */
if (((long)RDB[DATA_BURNUP_CALCULATION_MODE] == NO) ||
(!((long)RDB[mat + MATERIAL_OPTIONS] & OPT_BURN_MAT)))
return;
/* Check decay only mode */
if ((long)RDB[DATA_BURN_DECAY_CALC] == YES)
return;
/* Check divisor type */
if ((long)RDB[mat + MATERIAL_DIV_TYPE] == MAT_DIV_TYPE_PARENT)
Die(FUNCTION_NAME, "Divided parent material");
/* Get sum of flux spectrum */
ptr = (long)RDB[mat + MATERIAL_PTR_FLUX_SPEC_SUM];
CheckPointer(FUNCTION_NAME, "(ptr)", RES2_ARRAY, ptr);
flx = Truncate(GetPrivateRes(ptr), 6);
/* Check spectrum-collapse method */
if ((long)RDB[DATA_BU_SPECTRUM_COLLAPSE] == YES)
{
/* Pointer to unionized grid data */
erg0 = (long)RDB[DATA_ERG_PTR_UNIONIZED_NGRID];
CheckPointer(FUNCTION_NAME, "(erg0)", DATA_ARRAY, erg0);
/* Number of grid points */
sz = (long)RDB[erg0 + ENERGY_GRID_NE];
/* Pointer to points */
loc1 = (long)RDB[erg0 + ENERGY_GRID_PTR_DATA];
CheckPointer(FUNCTION_NAME, "(loc1)", DATA_ARRAY, loc1);
/* Allocate memory for spectrum */
/*
spec = Mem(MEM_ALLOC, sz, sizeof(double));
*/
spec = WorkArray(DATA_PTR_WORK_PRIVA_GRID1, PRIVA_ARRAY, sz, id);
/* Get pointer to flux spectrum */
loc0 = (long)RDB[mat + MATERIAL_PTR_FLUX_SPEC];
CheckPointer(FUNCTION_NAME, "(loc0)", RES2_ARRAY, loc0);
/* Reset sum */
sum = 0.0;
/* Read data */
for (i = 0; i < sz; i++)
{
spec[i] = Truncate(GetPrivateRes(loc0 + i), 6);
sum = sum + spec[i];
}
/* Check sum */
if (flx > 0.0)
if (fabs(sum/flx - 1.0) > 1E-5)
Die(FUNCTION_NAME, "Error in sum");
/* Allocate memory for temporary array if microscopic data is not */
/* reconstructed */
if ((long)RDB[DATA_OPTI_RECONSTRUCT_MICROXS] == NO)
{
xs = WorkArray(DATA_PTR_WORK_PRIVA_GRID2, PRIVA_ARRAY, sz, id);
/*
xs = Mem(MEM_ALLOC, sz, sizeof(double));
*/
}
else
xs = NULL;
}
else
{
/* Reset pointers and variables */
erg0 = -1;
sz = 0;
loc0 = -1;
loc1 = -1;
spec = NULL;
xs = NULL;
}
/***************************************************************************/
/***** Transmutation cross sections ****************************************/
/* Pointer to depletion list (onko toi lista aina olemassa?) */
dep = (long)RDB[mat + MATERIAL_PTR_DEP_TRA_LIST];
CheckPointer(FUNCTION_NAME, "(dep)", DATA_ARRAY, dep);
/* Loop over reactions */
while (dep > VALID_PTR)
{
/* Pointer to reaction */
rea = (long)RDB[dep + DEP_TRA_PTR_REA];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Check mt */
if ((long)RDB[rea + REACTION_MT] < 16)
Die(FUNCTION_NAME, "Error in mt");
/* Pointer to nuclide data */
nuc = (long)RDB[rea + REACTION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Set energy intervals */
Emin = RDB[rea + REACTION_URES_EMIN];
Emax = RDB[rea + REACTION_URES_EMAX];
/* Check that boundaries are set */
if (((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == YES) && (Emin >= Emax) &&
((long)RDB[rea + REACTION_PTR_URES] > VALID_PTR))
Die(FUNCTION_NAME, "Error in ures boundaries 1 %s %ld %E %E",
GetText(nuc + NUCLIDE_PTR_NAME), (long)RDB[rea + REACTION_MT],
Emin, Emax);
/* Pointer to data */
ptr = (long)RDB[dep + DEP_TRA_PTR_RESU];
CheckPointer(FUNCTION_NAME, "(ptr)", RES2_ARRAY, ptr);
/* Get value and truncate */
sum = Truncate(GetPrivateRes(ptr), 6);
/* Check spectrum-collapse method */
if ((long)RDB[DATA_BU_SPECTRUM_COLLAPSE] == YES)
{
/* Check tallied value */
if (sum > 0.0)
{
/* Check ures samling */
if ((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == NO)
Die(FUNCTION_NAME, "Value should be zero");
else if ((long)RDB[rea + REACTION_PTR_URES] < VALID_PTR)
Die(FUNCTION_NAME, "Value should be zero");
}
/* Get pointer to energy grid */
erg = (long)RDB[rea + REACTION_PTR_EGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Get pointer to grid data */
erg = (long)RDB[erg + ENERGY_GRID_PTR_DATA];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Get first energy point and number of points */
i0 = (long)RDB[rea + REACTION_XS_I0];
ne = (long)RDB[rea + REACTION_XS_NE];
/* Pointer to cross section data */
ptr = (long)RDB[rea + REACTION_PTR_XS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Check reconstruction option */
if ((long)RDB[DATA_OPTI_RECONSTRUCT_MICROXS] == YES)
{
/* Copy pointer */
xs = &WDB[ptr];
/* Set xs start index to zero */
i1 = 0;
}
else
{
/* Check pointer */
CheckPointer(FUNCTION_NAME, "(loc1)", DATA_ARRAY, loc1);
/* Reconstruct data on new array */
InterpolateData(&RDB[loc1], xs, sz, &RDB[erg + i0],
&RDB[ptr], ne, 0, &i1, &ne);
/* One step back if not at the beginning */
if (i1 > 0)
i1--;
/* Set energy grid start index equal to xs index */
i0 = i1;
}
/* Avoid compiler warning */
E = -1.0;
/* Loop over data and add to sum */
for (i = 0; i < ne; i++)
{
/* Get energy */
if (i0 + i > sz - 1)
Die(FUNCTION_NAME, "Energy array dimension exceeded");
else
E = RDB[loc1 + i0 + i];
/* Compare to spectrum boundaries (NOTE: Yhtäsuuruusmerkki */
/* tarvitaan) */
if (((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == NO) ||
(E <= Emin) || (E >= Emax))
sum = sum + spec[i0 + i]*xs[i1 + i];
}
}
/* Divide sum */
if (flx > 0.0)
sum = sum/flx;
else if (sum > 0.0)
Die(FUNCTION_NAME, "Error in sums");
/* Store value */
if ((long)RDB[rea + REACTION_PTR_TRANSMUXS] < VALID_PTR)
Die(FUNCTION_NAME, "Pointer error");
else
StoreValuePair(rea + REACTION_PTR_TRANSMUXS, mat, sum, id);
/* Next reaction */
dep = NextItem(dep);
}
/***************************************************************************/
/***** Partial fission cross sections **************************************/
/* Pointer to fission list (tätä ei välttämättä ole) */
dep = (long)RDB[mat + MATERIAL_PTR_DEP_FISS_LIST];
/* Loop over reactions */
while (dep > VALID_PTR)
{
/* Pointer to reaction */
rea = (long)RDB[dep + DEP_TRA_PTR_REA];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Pointer to nuclide data */
nuc = (long)RDB[rea + REACTION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Set energy intervals */
Emin = RDB[rea + REACTION_URES_EMIN];
Emax = RDB[rea + REACTION_URES_EMAX];
/* Check that boundaries are set */
if (((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == YES) && (Emin >= Emax) &&
((long)RDB[rea + REACTION_PTR_URES] > VALID_PTR))
Die(FUNCTION_NAME, "Error in ures boundaries 2 %s %ld %E %E",
GetText(nuc + NUCLIDE_PTR_NAME), (long)RDB[rea + REACTION_MT],
Emin, Emax);
/* Pointer to total fission */
rea1 = (long)RDB[nuc + NUCLIDE_PTR_TOTFISS_REA];
CheckPointer(FUNCTION_NAME, "(rea1)", DATA_ARRAY, rea1);
/* Get interpolation energies */
E0 = RDB[rea + REACTION_FISSY_IE0];
E1 = RDB[rea + REACTION_FISSY_IE1];
E2 = RDB[rea + REACTION_FISSY_IE2];
/* Check values */
CheckValue(FUNCTION_NAME, "E1" ,"", E1, E0, E2);
/* Pointer to data */
ptr = (long)RDB[dep + DEP_TRA_PTR_RESU];
CheckPointer(FUNCTION_NAME, "(ptr)", RES2_ARRAY, ptr);
/* Get value and truncate */
sum = Truncate(GetPrivateRes(ptr), 6);
/* Check spectrum-collapse method */
if ((long)RDB[DATA_BU_SPECTRUM_COLLAPSE] == YES)
{
/* Check tallied value */
if (sum > 0.0)
{
/* Check ures samling */
if ((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == NO)
Die(FUNCTION_NAME, "Value should be zero");
else if ((long)RDB[rea + REACTION_PTR_URES] < VALID_PTR)
Die(FUNCTION_NAME, "Value should be zero");
}
/* Check pointer to parent reaction */
if ((ptr = (long)RDB[rea + REACTION_PTR_BRANCH_PARENT]) > VALID_PTR)
{
/* Get first energy point and number of points */
i0 = (long)RDB[ptr + REACTION_XS_I0];
ne = (long)RDB[ptr + REACTION_XS_NE];
/* Get pointer to energy grid */
erg = (long)RDB[ptr + REACTION_PTR_EGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Get pointer to grid data */
erg = (long)RDB[erg + ENERGY_GRID_PTR_DATA];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Pointer to cross section data */
ptr = (long)RDB[ptr + REACTION_PTR_XS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
}
else
{
/* Get first energy point and number of points */
i0 = (long)RDB[rea + REACTION_XS_I0];
ne = (long)RDB[rea + REACTION_XS_NE];
/* Get pointer to energy grid */
erg = (long)RDB[rea + REACTION_PTR_EGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Get pointer to grid data */
erg = (long)RDB[erg + ENERGY_GRID_PTR_DATA];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Pointer to cross section data */
ptr = (long)RDB[rea + REACTION_PTR_XS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
}
/* Check reconstruction option */
if ((long)RDB[DATA_OPTI_RECONSTRUCT_MICROXS] == YES)
{
/* Copy pointer */
xs = &WDB[ptr];
/* Set xs start index to zero */
i1 = 0;
}
else
{
/* Reconstruct data on new array */
InterpolateData(&RDB[loc1], xs, sz, &RDB[erg + i0],
&RDB[ptr], ne, 0, &i1, &ne);
/* One step back if not at the beginning */
if (i1 > 0)
i1--;
/* Set energy grid start index equal to xs index */
i0 = i1;
}
/* Avoid compiler warning */
E = -1.0;
/* Loop over data and calculate sum */
for (i = 0; i < ne; i++)
{
/* Get energy */
if (i0 + i > sz - 1)
Die(FUNCTION_NAME, "Energy array dimension exceeded");
else
E = RDB[loc1 + i0 + i];
/* Compare to spectrum boundaries (NOTE: Yhtäsuuruusmerkki */
/* tarvitaan) */
if (((long)RDB[nuc + NUCLIDE_URES_SAMPLING] == NO) ||
(E <= Emin) || (E >= Emax))
{
/* Compare to interval boundaries */
if ((E >= E0) && (E <= E2))
{
/* Calculate interpolation factor */
if (E < E1)
{
/* Below interpolation energy */
if (E0 < 0.0)
g = 1.0;
else
g = (E - E0)/(E1 - E0);
}
else
{
/* Above interpolation energy */
if (E2 > 1000.0)
g = 1.0;
else
g = (E2 - E)/(E2 - E1);
}
/* Check factor */
CheckValue(FUNCTION_NAME, "f", "", g, 0.0, 1.0);
/* Add to sum */
sum = sum + g*spec[i0 + i]*xs[i1 + i];
}
}
}
}
/* Divide sum */
if (flx > 0.0)
sum = sum/flx;
else if (sum > 0.0)
Die(FUNCTION_NAME, "Error in sums");
/* Check value */
CheckValue(FUNCTION_NAME, "sum", "", sum, 0.0, 1E+6);
/* Store value */
if ((long)RDB[rea + REACTION_PTR_TRANSMUXS] < VALID_PTR)
Die(FUNCTION_NAME, "Pointer error");
else
StoreValuePair(rea + REACTION_PTR_TRANSMUXS, mat, sum, id);
/* Add to total fission */
if ((long)RDB[rea1 + REACTION_PTR_TRANSMUXS] < VALID_PTR)
Die(FUNCTION_NAME, "Pointer error");
else
AddValuePair(rea1 + REACTION_PTR_TRANSMUXS, mat, sum, id);
/* Next reaction */
dep = NextItem(dep);
}
/***************************************************************************/
/*
if (((long)RDB[DATA_OPTI_RECONSTRUCT_MICROXS] == NO) && (xs != NULL))
Mem(MEM_FREE, xs);
if (spec != NULL)
Mem(MEM_FREE, spec);
*/
/***************************************************************************/
}
bool mitk::TemporoSpatialStringProperty::HasValue(const TimeStepType& timeStep, const IndexValueType& zSlice, bool allowCloseTime, bool allowCloseSlice) const
{
return CheckValue(timeStep, zSlice, allowCloseTime, allowCloseSlice).first;
};
double OTFSabXS(long rea, double E, double T, long id){
long nuc, sab1, sab2, nuc1, nuc2, mt, rea2, sab0, ptr, ncol;
double f, xs1, xs2, T1, T2, xs;
/* Check reaction pointer */
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Avoid compiler warning */
sab1 = -1;
/* Get reaction mt and rea nuclide */
mt = (long)RDB[rea + REACTION_MT];
nuc = (long)RDB[rea + REACTION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
if (E > RDB[nuc + NUCLIDE_SAB_EMAX])
return MicroXS(rea, E, id);
/* Check that data exists */
if ((sab2 = (long)RDB[nuc + NUCLIDE_PTR_SAB]) < VALID_PTR )
Die(FUNCTION_NAME, "S(a,b) data not available for nuclide %s",
GetText(nuc + NUCLIDE_PTR_NAME));
/* Find correct temperature */
while(sab2 > VALID_PTR)
{
if (RDB[sab2 + SAB_T] > T)
break;
sab2 = NextItem(sab2);
}
/* Check that sab was found */
if (sab2 < VALID_PTR)
Die(FUNCTION_NAME, "S(a,b) OTF nuclide not found for %s",
GetText(nuc + NUCLIDE_PTR_NAME));
sab1 = PrevItem(sab2);
/* Check Pointers */
CheckPointer(FUNCTION_NAME, "(sab1)", DATA_ARRAY, sab1);
CheckPointer(FUNCTION_NAME, "(sab2)", DATA_ARRAY, sab2);
/* Temperatures */
T1 = RDB[sab1 + SAB_T];
T2 = RDB[sab2 + SAB_T];
/* Pointers to S(a,b) nuclides */
nuc1 = RDB[sab1 + SAB_PTR_ISO];
nuc2 = RDB[sab2 + SAB_PTR_ISO];
CheckPointer(FUNCTION_NAME, "(nuc1)", DATA_ARRAY, nuc1);
CheckPointer(FUNCTION_NAME, "(nuc2)", DATA_ARRAY, nuc2);
/* Find reaction pointers in S(a,b) data */
/* Elastic scattering xs = total xs in case of S(a,b) nuclides
(which only have 1004 and 1002 reactions and total is
calculated over them) */
if ((mt == 1) || (mt == 2))
rea2 = (long)RDB[nuc1 + NUCLIDE_PTR_TOTXS];
/* Find reaction at first temperature */
else
{
/* Pointer to reaction */
rea2 = (long)RDB[nuc1 + NUCLIDE_PTR_REA];
CheckPointer(FUNCTION_NAME, "(rea2)", DATA_ARRAY, rea2);
/* JLe: Tässä voisi käyttää SeekList():iä */
while (rea2 > VALID_PTR)
{
if ((long)RDB[rea2 + REACTION_MT] == mt - 1000)
break;
rea2 = NextItem(rea2);
}
if (rea2 < VALID_PTR)
Die(FUNCTION_NAME, "mt %ld not found for S(a,b) nuclide %s", mt,
GetText(nuc1 + NUCLIDE_PTR_NAME));
}
/* Get cross section */
xs1 = MicroXS(rea2, E, id);
CheckValue(FUNCTION_NAME, "xs1", "", xs1, 0.0, 1E+10);
if ((mt == 1) || (mt == 2))
rea2 = (long)RDB[nuc2 + NUCLIDE_PTR_TOTXS];
/* Find reaction at second temperature */
else
{
rea2 = (long)RDB[nuc2 + NUCLIDE_PTR_REA];
CheckPointer(FUNCTION_NAME, "(rea2)", DATA_ARRAY, rea2);
/* JLe: Tässä voisi käyttää SeekList():iä */
while (rea2 > VALID_PTR)
{
if ((long)RDB[rea2 + REACTION_MT] == mt - 1000)
break;
rea2 = NextItem(rea2);
}
if (rea2 < VALID_PTR)
Die(FUNCTION_NAME, "mt %ld not found for S(a,b) nuclide %s", mt,
GetText(nuc1 + NUCLIDE_PTR_NAME));
}
/* Get cross section */
xs2 = MicroXS(rea2, E, id);
CheckValue(FUNCTION_NAME, "xs2", "", xs2, 0.0, 1E+10);
/* Avoid compiler warning */
f = -1.0;
/* Calculate factor */
if (T1 != T2)
f = (T-T1)/(T2-T1);
else
Die(FUNCTION_NAME, "Division by zero");
/* Check value */
CheckValue(FUNCTION_NAME, "f", "", f, 0.0, 1.0);
/* Get collision number */
ptr = (long)RDB[DATA_PTR_COLLISION_COUNT];
ncol = (long)GetPrivateData(ptr, id);
/* Pointer to first item in sab list */
sab0 = (long)RDB[nuc + NUCLIDE_PTR_SAB];
/* Store values */
StoreValuePair(sab0 + SAB_PTR_PREV_FRAC, ncol, f, id);
StoreValuePair(sab0 + SAB_PTR_PREV_SAB1, ncol, (double)sab1, id);
xs = xs1 + f*(xs2-xs1);
/* Tämä poistettiin juuri ennen 2.1.25:n jakelua, sillä se sotkee */
/* myöhemmin käytettävän kokonaisvaikutusalan arvon (JLe / 19.2.2016). */
/*
StoreValuePair(rea + REACTION_PTR_PREV_XS, E, xs, id);
*/
/* Näillä voisi varmaan optimoida myös tuota rutiinin alkupäätä */
/* JLe: Jos palautettava arvo on samalla energialla aina sama, niin */
/* alkuun voi laittaa TestValuePair() -kutsun. Onko nuo kaksi ylempää */
/* tosiaan tarkoitus kiinnittää törmäykseen eikä energiaan? */
return xs;
}
void ScoreICMTrk(long part, double x0, double y0, double z0, double u,
double v, double w, double lmax, double E, double wgt,
long id)
{
long icm, ntot, nmu0, nmu1, nmu2, nseg, surf, type, ptr, np, in0, in1;
long idx, ng, ncross, icm0, icm1, idx0, idx1, ng0, ng1;
long mua, mus, mua0, mus0, mua1, mus1;
long s0, s1, s2;
double d, l, x, y, z, un0, vn0, wn0, un1, vn1, wn1, un2, vn2, wn2;
double wgt0, wgt1, mu0, mu1, mu2;
const double *params;
/* Check mode */
if ((long)RDB[DATA_ICM_CALC] == NO)
return;
/* Get sizes */
ntot = (long)RDB[DATA_ICM_NG0];
nmu0 = (long)RDB[DATA_ICM_NMU0];
nmu1 = (long)RDB[DATA_ICM_NMU1];
nmu2 = (long)RDB[DATA_ICM_NMU2];
nseg = (long)RDB[DATA_ICM_NSEG];
/* Get pointer to few-group structure */
ptr = (long)RDB[DATA_ICM_PTR_ENE0];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
/* Get few-group index */
if ((ng = GridSearch(ptr, E)) < 0)
return;
/* Convert index */
ng = ntot - ng - 1;
CheckValue(FUNCTION_NAME, "ng1", "", ng, 0, ntot - 1);
/* Reset new data */
icm1 = -1;
idx1 = -1;
mua1 = -1;
mus1 = -1;
ng1 = -1;
wgt1 = -1;
/* Loop over data */
icm = (long)RDB[DATA_PTR_ICM0];
while (icm > VALID_PTR)
{
/* Get original particle Albedo data */
icm0 = (long)RDB[part + PARTICLE_ICM_PTR_ICM];
idx0 = (long)RDB[part + PARTICLE_ICM_IDX];
mua0 = (long)RDB[part + PARTICLE_ICM_MUA];
mus0 = (long)RDB[part + PARTICLE_ICM_MUS];
ng0 = (long)RDB[part + PARTICLE_ICM_G];
wgt0 = RDB[part + PARTICLE_ICM_WGT];
/* Get surface pointer */
surf = (long)RDB[icm + ICM_PTR_SURF];
CheckPointer(FUNCTION_NAME, "(surf)", DATA_ARRAY, surf);
/* Get surface type */
type = (long)RDB[surf + SURFACE_TYPE];
/* Get number of parameters */
np = (long)RDB[surf + SURFACE_N_PARAMS];
/* Pointer to parameter list */
ptr = (long)RDB[surf + SURFACE_PTR_PARAMS];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
params = &RDB[ptr];
/* Move to starting position */
/* Toi ekstrapolointi lienee turhaa sen jälkeen kun */
/* trackin.c:tä muutettiin 14.8.2014 / 2.1.22 */
Die(FUNCTION_NAME, "HUOM!!!");
x = x0 - 2.0*EXTRAP_L*u;
y = y0 - 2.0*EXTRAP_L*v;
z = z0 - 2.0*EXTRAP_L*w;
/* Reset total distance and number of crossings */
l = 0.0;
ncross = 0;
/* Get initial position */
in0 = TestSurface(surf, x, y, z, NO, id);
in1 = -1;
/* Loop over all surfaces in track */
while (l < lmax)
{
/* Get distance */
d = SurfaceDistance(surf, params, type, np, x, y, z, u, v, w, id);
/* Extrapolate */
d = d + EXTRAP_L;
/* Update coordinates */
x = x + d*u;
y = y + d*v;
z = z + d*w;
/* Test position */
in1 = TestSurface(surf, x, y, z, NO, id);
/* Check with maximum */
if (l + d > lmax)
{
/* Go back to collision site (for debugging) */
x = x0 + lmax*u;
y = y0 + lmax*v;
z = z0 + lmax*w;
/* Cancel crossing */
in1 = in0;
/* Break loop */
break;
}
else
{
/* Update distance */
l = l + d;
}
/* Check if surface was crossed */
if (in0 != in1)
{
/* Add counter */
ncross++;
/* Get surface index */
if ((idx = ICMIdx(surf, x, y, z, &un0, &vn0, &wn0, &un1, &vn1,
&wn1, &un2, &vn2, &wn2)) > -1)
{
/* Calculate cosines */
mu0 = un0*u + vn0*v + wn0*w;
mu1 = un1*u + vn1*v + wn1*w;
mu2 = un2*u + vn2*v + wn2*w;
/* Get bins */
ptr = (long)RDB[DATA_ICM_PTR_MU0];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
s0 = SearchArray(&RDB[ptr], fabs(mu0), nmu0 + 1);
CheckValue(FUNCTION_NAME, "s0", "", s0, 0, nmu0 - 1);
ptr = (long)RDB[DATA_ICM_PTR_MU1];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
s1 = SearchArray(&RDB[ptr], mu1, nmu1 + 1);
CheckValue(FUNCTION_NAME, "s1", "", s1, 0, nmu1 - 1);
ptr = (long)RDB[DATA_ICM_PTR_MU2];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
s2 = SearchArray(&RDB[ptr], mu2, nmu2 + 1);
CheckValue(FUNCTION_NAME, "s2", "", s2, 0, nmu2 - 1);
/* Calculate asymmetric and symmetric part */
mua = s1;
mus = s0*nmu2 + s2;
/* Check direction */
if ((in0 == NO) && (in1 == YES))
{
/* Check bins */
CheckValue(FUNCTION_NAME, "idx", "(1)", idx, 0,
nseg - 1);
CheckValue(FUNCTION_NAME, "mua", "(1)", mua, 0,
nmu1 - 1);
CheckValue(FUNCTION_NAME, "mus", "(1)", mus, 0,
nmu0*nmu2 - 1);
CheckValue(FUNCTION_NAME, "ng", "(1)", ng, 0,
ntot - 1);
/* Score inward current */
if (RDB[DATA_CYCLE_IDX] > RDB[DATA_CRIT_SKIP] - 1.0)
{
ptr = (long)RDB[icm + ICM_RES_CURR0];
CheckPointer(FUNCTION_NAME, "(ptr)", DATA_ARRAY, ptr);
AddBuf(1.0, wgt, ptr, id, -1, idx, mua, mus, ng);
}
/* Put new data and reset weight */
icm0 = icm;
idx0 = idx;
mua0 = mua;
mus0 = mus;
ng0 = ng;
wgt0 = 1.0;
}
else if ((in0 == YES) && (in1 == NO))
{
/* Check active cycles */
if (RDB[DATA_CYCLE_IDX] > RDB[DATA_CRIT_SKIP] - 1.0)
{
/* Check index, group and angular bins */
if ((idx0 > -1) && (ng0 > -1) && (mua0 > -1) &&
(mus0 > -1))
{
/* Check bins */
CheckValue(FUNCTION_NAME, "idx0", "(2)", idx0, 0,
nseg - 1);
CheckValue(FUNCTION_NAME, "mua0", "(2)", mua0, 0,
nmu1 - 1);
CheckValue(FUNCTION_NAME, "mus0", "(2)", mus0, 0,
nmu0*nmu2 - 1);
CheckValue(FUNCTION_NAME, "ng0", "(2)", ng0, 0,
ntot - 1);
CheckValue(FUNCTION_NAME, "idx", "(2)", idx, 0,
nseg - 1);
CheckValue(FUNCTION_NAME, "mua", "(2)", mua, 0,
nmu1 - 1);
CheckValue(FUNCTION_NAME, "mus", "(2)", mus, 0,
nmu0*nmu2 - 1);
/* Score outward current */
ptr = (long)RDB[icm + ICM_RES_CC1];
CheckPointer(FUNCTION_NAME, "(ptr)",
DATA_ARRAY, ptr);
AddBuf(1.0, wgt, ptr, id, -1, idx0, mua0, mus0,
ng0, idx, mua, mus, ng);
ptr = (long)RDB[icm + ICM_RES_CC2];
CheckPointer(FUNCTION_NAME, "(ptr)",
DATA_ARRAY, ptr);
AddBuf(wgt0, wgt, ptr, id, -1, idx0, mua0, mus0,
ng0, idx, mua, mus, ng);
}
else if ((ng0 > -1) && (RDB[DATA_CYCLE_IDX] >
RDB[DATA_CRIT_SKIP] + 20.0))
Warn(FUNCTION_NAME, "Problem in geometry?");
}
/* Reset values */
icm0 = -1;
idx0 = -1;
mua0 = -1;
mus0 = -1;
ng0 = -1;
wgt0 = 1.0;
}
}
}
/* Put previous position */
in0 = in1;
}
/* Check if particle is in */
if (in1 == YES)
{
/* Update new values */
if (icm1 > VALID_PTR)
Die(FUNCTION_NAME, "Point (%E, %E, %E) is in multiple regions",
x, y, z);
else
{
icm1 = icm0;
idx1 = idx0;
mua1 = mua0;
mus1 = mus0;
ng1 = ng0;
wgt1 = wgt0;
}
/* Check number of crossings */
if (ncross == 0)
{
/* Surface index cannot have changed */
if (idx0 != (long)RDB[part + PARTICLE_ICM_IDX])
Die(FUNCTION_NAME, "This is impossible");
/* No other crossings are possible, add to counter */
ptr = (long)RDB[icm + ICM_BREAK_PTR_COUNT];
CheckPointer(FUNCTION_NAME, "(ptr)", PRIVA_ARRAY, ptr);
AddPrivateData(ptr, 1, id);
/* Break loop */
break;
}
}
/* Next */
icm = NextItem(icm);
}
/* Store values */
WDB[part + PARTICLE_ICM_PTR_ICM] = (double)icm1;
WDB[part + PARTICLE_ICM_IDX] = (double)idx1;
WDB[part + PARTICLE_ICM_MUA] = (double)mua1;
WDB[part + PARTICLE_ICM_MUS] = (double)mus1;
WDB[part + PARTICLE_ICM_G] = (double)ng1;
WDB[part + PARTICLE_ICM_WGT] = wgt1;
}
bool ProcessConfigFile (RFile aConfigFile,CConsoleBase* iConsole, LDDConfigPtr * LDDPtrPtr)
{
TUSB_PRINT ("Processing Configuration File");
OstTrace0 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS, "Processing Configuration File");
TBuf8<100> configBuf;
TBuf<101> stringBuf;
bool done = false;
bool error = false;
TInt rStatus;
XMLState state = EEmpty;
TChar nextChar(' ');
TChar lastChar(' ');
TBuf<50> keyString;
TBuf<50> endkeyString;
TBuf<50> attributeString;
TBuf<50> valueString;
TInt level = -1;
TInt levelKeys[KMaxXMLNesting+1];
* LDDPtrPtr = NULL;
ConfigPtrsPtr cpPtr = new ConfigPtrs (LDDPtrPtr);
while (!done && !error)
{
rStatus = aConfigFile.Read((TDes8&)configBuf);
if (rStatus != KErrNone)
{
error = true;
TUSB_PRINT1("Config file error %d", rStatus);
OstTrace1(TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP01, "Config file error %d", rStatus);
}
else
{
if (configBuf.Length() == 0)
{
done = true;
}
else
{
stringBuf.Copy(configBuf);
for (TInt i = 0; i < stringBuf.Length() && !error; i++)
{
lastChar = nextChar;
nextChar = stringBuf[i];
if (((nextChar == '<') && !((state == EEmpty) || (state == EValue))) ||
((nextChar == '>') && ((state == EEmpty) || (state == EValue))) ||
((nextChar == '/') && (lastChar != '<')))
{
error = true;
TUSB_PRINT2 ("Config File Syntax Error at index %d of %s",i,stringBuf.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP02, "Config File Syntax Error at index %d of %S",i,stringBuf);
}
switch (state)
{
case EEmpty:
if (nextChar == '<')
{
state = EStartKey;
}
else
if (!nextChar.IsSpace())
{
error = true;
TUSB_PRINT2 ("Config File Syntax Error at index %d of %s",i,stringBuf.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP03, "Config File Syntax Error at index %d of %S",i,stringBuf);
}
break;
case EStartKey:
if (nextChar == '/')
{
state = EEndKey;
endkeyString.SetLength(0);
}
else
{
if (nextChar == '>')
{
level++;
if (level > KMaxXMLNesting)
{
error = true;
TUSB_PRINT1 ("Config File Too Many levels %s",stringBuf.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP04, "Config File Too Many levels %S",stringBuf);
}
else
{
levelKeys[level] = CheckXmlKey (keyString,level);
if (levelKeys[level] < 0)
{
error = true;
TUSB_PRINT1 ("Invalid XML key %s",keyString.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP05, "Invalid XML key %S",keyString);
}
else
{
if (CheckAttribute(iConsole,cpPtr,levelKeys[level],attributeString))
{
state = EValue;
TUSB_VERBOSE_PRINT2 ("Start key: %s level %d",keyString.PtrZ(),level);
if(gVerbose)
{
OstTraceExt2 (TRACE_VERBOSE, CONFIGPTRS_CONFIGPTRS_DUP06, "Start key: %S level %d",keyString,level);
}
}
else
{
error = true;
TUSB_PRINT1 ("No attribute for XML key %s",keyString.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP07, "No attribute for XML key %S",keyString);
}
}
}
}
else
{
if (lastChar == '<')
{
keyString.SetLength(0);
valueString.SetLength(0);
attributeString.SetLength(0);
if (nextChar.IsSpace())
{
error = true;
TUSB_PRINT2 ("Config File Syntax Error at index %d of %s",i,stringBuf.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP08, "Config File Syntax Error at index %d of %S",i,stringBuf);
}
}
if (nextChar.IsSpace())
{
state = EAttribute;
}
else
{
keyString.Append(nextChar);
}
}
}
break;
case EEndKey:
if (nextChar == '>')
{
if (levelKeys[level] != CheckXmlKey (endkeyString,level))
{
error = true;
TUSB_PRINT1 ("Invalid XML end key %s",endkeyString.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP09, "Invalid XML end key %S",endkeyString);
}
else
{
if (CheckValue(iConsole,cpPtr,levelKeys[level],valueString))
{
state = EEmpty;
TUSB_VERBOSE_PRINT2 ("End Key: %s value %s",endkeyString.PtrZ(),valueString.PtrZ());
if(gVerbose)
{
OstTraceExt2 (TRACE_VERBOSE, CONFIGPTRS_CONFIGPTRS_DUP10, "End Key: %S value %S",endkeyString,valueString);
}
level--;
valueString.SetLength(0);
}
else
{
error = true;
TUSB_PRINT2 ("Incorrect value string %s for XML key %s",valueString.PtrZ(),endkeyString.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP11, "Incorrect value string %S for XML key %S",valueString,endkeyString);
}
}
}
if (nextChar.IsSpace())
{
error = true;
TUSB_PRINT2 ("Config File Syntax Error at index %d of %s",i,stringBuf.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP12, "Config File Syntax Error at index %d of %S",i,stringBuf);
}
else
{
endkeyString.Append(nextChar);
}
break;
case EAttribute:
if (nextChar == '>')
{
level++;
if (level > KMaxXMLNesting)
{
error = true;
TUSB_PRINT1 ("Config File Too Many levels %s",stringBuf.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP13, "Config File Too Many levels %s",stringBuf);
}
else
{
levelKeys[level] = CheckXmlKey (keyString,level);
if (levelKeys[level] < 0)
{
error = true;
TUSB_PRINT1 ("Invalid XML key %s",keyString.PtrZ());
OstTraceExt1 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP14, "Invalid XML key %s",keyString);
}
else
{
if (CheckAttribute(iConsole,cpPtr,levelKeys[level],attributeString))
{
state = EValue;
TUSB_VERBOSE_PRINT3 ("Start key: %s level %d attribute %s",keyString.PtrZ(),level,attributeString.PtrZ());
if(gVerbose)
{
OstTraceExt3 (TRACE_VERBOSE, CONFIGPTRS_CONFIGPTRS_DUP15, "Start key: %S level %d attribute %S",keyString,level,attributeString);
}
}
else
{
error = true;
TUSB_PRINT2 ("Incorrect attribute %s for XML key %s",attributeString.PtrZ(),keyString.PtrZ());
OstTraceExt2 (TRACE_NORMAL, CONFIGPTRS_CONFIGPTRS_DUP16, "Incorrect attribute %s for XML key %s",attributeString,keyString);
}
}
}
}
else
{
attributeString.Append(nextChar);
}
break;
case EValue:
if (nextChar == '<')
{
state = EStartKey;
}
else
{
// Don't add any leading spaces
if (!nextChar.IsSpace() || valueString.Length() != 0)
{
valueString.Append(nextChar);
}
}
break;
}
}
}
}
}
delete cpPtr;
return !error;
}