/*
* Append a character to a dynamically allocated string, increasing the
* buffer size if necessary. Returns a pointer to a buffer containing the
* new data.
*/
static char *got_char( char *buf, size_t *bufsize, size_t offset, char ch )
/*************************************************************************/
{
const size_t blocksize = 64;
/*** Increase the buffer size if necessary ***/
while( offset+1 >= *bufsize ) {
*bufsize += blocksize;
buf = ReallocMem( buf, (*bufsize)+blocksize);
}
/*** Append the character ***/
buf[offset] = ch;
buf[offset+1] = '\0';
return( buf );
}
/*
* Add one more parameter to the section specified by block. Reallocates
* memory if necessary, and does all necessary bookkeeping.
*/
void AppendCmdLine( CmdLine *cmdLine, int section, const char *parm )
/*******************************************************************/
{
/*** Allocate GRANULARITY more elements if we're out of room ***/
if( section < 0 || section >= cmdLine->numSections ) Zoinks();
if( cmdLine[section].curItems+2 > cmdLine[section].maxItems ) {
cmdLine[section].args = ReallocMem( cmdLine[section].args, (cmdLine[section].maxItems+GRANULARITY) * sizeof(char*) );
cmdLine[section].maxItems += GRANULARITY;
}
/*** Store the specified pointer and update curItems ***/
if( parm != NULL ) parm = DupStrMem( parm ); /* copy it */
cmdLine[section].args[ cmdLine[section].curItems ] = (char*)parm;
cmdLine[section].args[ cmdLine[section].curItems+1 ] = NULL;/* last one */
cmdLine[section].curItems++;
}
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 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");
}
/***************************************************************************/
}
void ProcessPhotonAtt()
{
long mat, iso, nuc, Z, ne, n, N, i0, i, ptr;
double Ei[100], fi[100], *E, *f, mdens, mfrac, val;
/* Avoid compiler warning (photon_attenuation.h sisältää dataa jota */
/* käytetään useammassa aliohjelmassa) */
n = idx1[0][0];
val = dat1[0][0];
/* Adjust coincident points */
ne = (long)idx0[91][0] + (long)idx0[91][1];
for (n = 1; n < ne; n++)
if (dat0[n][1] == dat0[n - 1][1])
dat0[n][1] = dat0[n][1] + 1E-11;
fprintf(out, "Processing reponse functions for photon dose rates...\n");
/* Loop over materials */
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/***********************************************************************/
/***** Unionize energy grid ********************************************/
/* Reset pointer */
E = NULL;
N = 0;
/* Get mass density */
if ((mdens = RDB[mat + MATERIAL_MDENS]) == 0.0)
{
/* Skip zero-density material */
mat = NextItem(mat);
/* Cycle loop */
continue;
}
/* Loop over composition */
iso = (long)RDB[mat + MATERIAL_PTR_COMP];
while (iso > VALID_PTR)
{
/* Pointer to nuclide */
nuc = (long)RDB[iso + COMPOSITION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Get Z */
Z = (long)RDB[nuc + NUCLIDE_Z];
/* Data only goes up to 92 */
if (Z > 92)
{
/* Skip */
iso = NextItem(iso);
/* Cycle loop */
continue;
}
/* Get index to data array and number of points */
i0 = (long)idx0[Z - 1][0];
ne = (long)idx0[Z - 1][1];
/* Check first and last energy point */
if (dat0[i0][1] != 1E-3)
Die(FUNCTION_NAME, "Mismatch in first energy point");
else if (dat0[i0 + ne - 1][1] != 20.0)
Die(FUNCTION_NAME, "Mismatch in last energy point");
/* Read data */
for (n = 0; n < ne; n++)
{
/* Check Z and read value */
if (dat0[i0 + n][0] != Z)
Die(FUNCTION_NAME, "Mismatch in Z");
else
Ei[n] = dat0[i0 + n][1];
}
/* Add points to main array */
E = AddPts(E, &N, Ei, ne);
/* Next */
iso = NextItem(iso);
}
/* Check order */
for (n = 1; n < N; n++)
if (E[n] <= E[n - 1])
Die(FUNCTION_NAME, "Error in order");
/***********************************************************************/
/***** Reconstruct data ************************************************/
/* Put number of points */
WDB[mat + MATERIAL_PHOTON_ATT_NE] = (double)N;
/* Put energy array in material structure */
ptr = ReallocMem(DATA_ARRAY, N);
WDB[mat + MATERIAL_PTR_PHOTON_ATT_E] = (double)ptr;
for (n = 0; n < N; n++)
WDB[ptr++] = E[n];
/* Allocate memory for data array */
ptr = ReallocMem(DATA_ARRAY, N);
WDB[mat + MATERIAL_PTR_PHOTON_ATT_F] = (double)ptr;
f = &WDB[ptr];
/* Reset vector (just to be safe) */
memset(f, 0.0, N*sizeof(double));
/* Loop over composition */
iso = (long)RDB[mat + MATERIAL_PTR_COMP];
while (iso > VALID_PTR)
{
/* Pointer to nuclide */
nuc = (long)RDB[iso + COMPOSITION_PTR_NUCLIDE];
CheckPointer(FUNCTION_NAME, "(nuc)", DATA_ARRAY, nuc);
/* Calculate mass fraction */
mfrac = RDB[nuc + NUCLIDE_AW]*RDB[iso + COMPOSITION_ADENS]/
mdens/N_AVOGADRO;
/* Get Z */
Z = (long)RDB[nuc + NUCLIDE_Z];
/* Data only goes up to 92 */
if (Z > 92)
{
/* Skip */
iso = NextItem(iso);
/* Cycle loop */
continue;
}
/* Get index to data array and number of points */
i0 = (long)idx0[Z - 1][0];
ne = (long)idx0[Z - 1][1];
/* Read data */
for (n = 0; n < ne; n++)
{
Ei[n] = dat0[i0 + n][1];
fi[n] = dat0[i0 + n][3];
}
/* Loop over unionized grid */
for (n = 0; n < N - 1; n++)
{
/* Find index */
if ((i = SearchArray(Ei, E[n], ne)) < 0)
Die(FUNCTION_NAME, "Point not in grid: %ld %E", n, E[n]);
/* Interpolate */
val = ENDFInterp(5, E[n], Ei[i], Ei[i + 1], fi[i], fi[i + 1]);
/* Add to data */
f[n] = f[n] + val*mfrac;
}
/* Add last point */
f[N - 1] = f[N -1] + fi[ne - 1]*mfrac;
/* Next */
iso = NextItem(iso);
}
/***********************************************************************/
/* Free memory */
if (E != NULL)
Mem(MEM_FREE, E);
/* Next material */
mat = NextItem(mat);
}
/* Exit OK */
fprintf(out, "OK.\n\n");
}
void ShuntingYard(long cell, long *infix, long ni)
{
long np, stack[10000], ptr, n;
/* Check cell pointer */
CheckPointer(FUNCTION_NAME, "(cell)", DATA_ARRAY, cell);
/* Allocate memory for composition list */
ptr = ReallocMem(DATA_ARRAY, ni + 1);
WDB[cell + CELL_PTR_SURF_COMP] = (double)ptr;
/* Reset count */
np = 0;
/* Loop over values */
for (n = 0; n < ni; n++)
{
/* Check error */
if ((n > 0) && (infix[n] == SURF_OP_OR) &&
(infix[n - 1] < 0) && (infix[n - 1] != SURF_OP_RIGHT))
Error(cell, "Error in surface list");
/* Handle parameters */
if ((infix[n] < 0) && (infix[n] != SURF_OP_RIGHT) &&
(infix[n] != SURF_OP_LEFT))
{
/* Pop operators with higher precedence */
while ((np > 0) && (stack[np - 1] > infix[n]) )
WDB[ptr++] = (double)stack[--np];
/* Push operator */
stack[np++] = infix[n];
}
else if (infix[n] == SURF_OP_LEFT)
{
/* Push left parenthesis */
stack[np++] = infix[n];
}
else if (infix[n] == SURF_OP_RIGHT)
{
/* Check parenthesis error */
if (--np < 0)
Error(cell, "Missing left parenthesis");
/* Pull stack */
while (stack[np] != SURF_OP_LEFT)
{
WDB[ptr++] = (double)stack[np];
/* Check error */
if (--np < 0)
Error(cell, "Missing left parenthesis");
}
}
else
WDB[ptr++] = (double)infix[n];
}
/* Check parenthesis error */
for (n = 0; n < np; n++)
if (stack[n] == SURF_OP_LEFT)
Error(cell, "Missing right parenthesis");
/* Pull stack */
while (--np > -1)
WDB[ptr++] = (double)stack[np];
/* Put null terminator */
WDB[ptr] = 0.0;
}
void AllocMacroXS()
{
long mat, mat0, sz, mode, loc0, loc1, n, lst, rea, ptr, erg, ne, nr;
double Emin, Emax, mem;
/* Check decay only mode */
if ((long)RDB[DATA_BURN_DECAY_CALC] == YES)
return;
fprintf(out, "Allocating memory for macroscopic cross section data...\n");
/***************************************************************************/
/***** Estimate and pre-allocate memory ************************************/
/* Check pointer to unionized grid */
if ((ptr = (long)RDB[DATA_ERG_PTR_UNIONIZED_NGRID]) > VALID_PTR)
{
/* Get number of energy points */
ne = RDB[ptr + ENERGY_GRID_NE];
/* Memory allocated for majorant */
sz = ne;
/* Memory allocated for material-wise cross sections */
if ((long)RDB[DATA_OPTI_RECONSTRUCT_MACROXS] == YES)
{
/* Loop over materials */
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Exclude divisors */
if ((long)RDB[mat + MATERIAL_DIV_TYPE] != MAT_DIV_TYPE_PARENT)
{
/* Check CE TMS mode and fissile flag */
if ((long)RDB[mat + MATERIAL_TMS_MODE] == TMS_MODE_CE)
sz = sz + ne;
if ((long)RDB[mat + MATERIAL_OPTIONS] & OPT_FISSILE_MAT)
sz = sz + 6*ne;
else
sz = sz + 4*ne;
}
/* Next material */
mat = NextItem(mat);
}
}
/* Pre-allocate memory */
PreallocMem(sz, DATA_ARRAY);
}
/***************************************************************************/
/***** Create reaction lists for materials *********************************/
/* NOTE: Tää luo sen RLS-perusrakenteen kaikille materiaaleille, mutta */
/* jättää jaettujen materiaalien RLS_DATA -rakenteet pois. Ne linkataan */
/* parent-materiaaleista mukaan seuraavassa silmukassa. */
/* Loop over materials */
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Calculate data size */
CalculateBytes();
/* Get memory size */
mem = RDB[DATA_TOTAL_BYTES];
/* Check that composition exists */
if ((long)RDB[mat + MATERIAL_PTR_COMP] < VALID_PTR)
Die(FUNCTION_NAME, "Composition not defined");
/* Avoid compiler warning */
mode = -1;
/* Loop over lists */
for (n = 0; n < 15; n++)
{
/* Get mode */
if (n == 0)
mode = MATERIAL_PTR_TOT_REA_LIST;
else if (n == 1)
mode = MATERIAL_PTR_ELA_REA_LIST;
else if (n == 2)
mode = MATERIAL_PTR_ABS_REA_LIST;
else if (n == 3)
mode = MATERIAL_PTR_FISS_REA_LIST;
else if (n == 4)
mode = MATERIAL_PTR_HEATT_REA_LIST;
else if (n == 5)
mode = MATERIAL_PTR_PHOTP_REA_LIST;
else if (n == 6)
mode = MATERIAL_PTR_INLP_REA_LIST;
else if (n == 7)
mode = MATERIAL_PTR_PHOT_TOT_LIST;
else if (n == 8)
mode = MATERIAL_PTR_PHOT_HEAT_LIST;
else if (n == 9)
mode = MATERIAL_PTR_TOT_URES_LIST;
else if (n == 10)
mode = MATERIAL_PTR_ABS_URES_LIST;
else if (n == 11)
mode = MATERIAL_PTR_ELA_URES_LIST;
else if (n == 12)
mode = MATERIAL_PTR_FISS_URES_LIST;
else if (n == 13)
mode = MATERIAL_PTR_HEAT_URES_LIST;
else if (n == 14)
mode = MATERIAL_PTR_TMP_MAJORANT_LIST;
else
Die(FUNCTION_NAME, "Overflow");
/* Create list */
NewReaList(mat, mode);
}
/* Calculate data size */
CalculateBytes();
/* Update memory size */
WDB[mat + MATERIAL_MEM_SIZE] = RDB[mat + MATERIAL_MEM_SIZE]
+ RDB[DATA_TOTAL_BYTES] - mem;
/* Next material */
mat = NextItem(mat);
}
/****************************************************************************/
/***** Reaction lists for divided materials *********************************/
/* Loop over materials */
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Pointer to parent */
if ((mat0 = (long)RDB[mat + MATERIAL_DIV_PTR_PARENT]) < VALID_PTR)
{
/* Skip material */
mat = NextItem(mat);
/* Cycle loop */
continue;
}
/* Check that composition exists */
if ((long)RDB[mat + MATERIAL_PTR_COMP] < VALID_PTR)
Die(FUNCTION_NAME, "Composition not defined");
/* Avoid compiler warning */
mode = -1;
/* Loop over lists */
for (n = 0; n < 15; n++)
{
/* Get mode */
if (n == 0)
mode = MATERIAL_PTR_TOT_REA_LIST;
else if (n == 1)
mode = MATERIAL_PTR_ELA_REA_LIST;
else if (n == 2)
mode = MATERIAL_PTR_ABS_REA_LIST;
else if (n == 3)
mode = MATERIAL_PTR_FISS_REA_LIST;
else if (n == 4)
mode = MATERIAL_PTR_HEATT_REA_LIST;
else if (n == 5)
mode = MATERIAL_PTR_PHOTP_REA_LIST;
else if (n == 6)
mode = MATERIAL_PTR_INLP_REA_LIST;
else if (n == 7)
mode = MATERIAL_PTR_PHOT_TOT_LIST;
else if (n == 8)
mode = MATERIAL_PTR_PHOT_HEAT_LIST;
else if (n == 9)
mode = MATERIAL_PTR_TOT_URES_LIST;
else if (n == 10)
mode = MATERIAL_PTR_ABS_URES_LIST;
else if (n == 11)
mode = MATERIAL_PTR_ELA_URES_LIST;
else if (n == 12)
mode = MATERIAL_PTR_FISS_URES_LIST;
else if (n == 13)
mode = MATERIAL_PTR_HEAT_URES_LIST;
else if (n == 14)
mode = MATERIAL_PTR_TMP_MAJORANT_LIST;
else
Die(FUNCTION_NAME, "Overflow");
/* Check if list was erased */
if ((loc0 = (long)RDB[mat0 + mode]) < VALID_PTR)
WDB[mat + mode] = NULLPTR;
else
{
/* Get pointer to list */
loc1 = (long)RDB[mat + mode];
CheckPointer(FUNCTION_NAME, "(loc1)", DATA_ARRAY, loc1);
/* Copy data pointer */
WDB[loc1 + RLS_PTR_REA0] = RDB[loc0 + RLS_PTR_REA0];
}
}
/* Next material */
mat = NextItem(mat);
}
/***************************************************************************/
/***** Allocate memory for reaction structures *****************************/
/* Loop over materials */
mat = (long)RDB[DATA_PTR_M0];
while (mat > VALID_PTR)
{
/* Check divisor type */
if ((long)RDB[mat + MATERIAL_DIV_TYPE] == MAT_DIV_TYPE_PARENT)
{
/* Skip material */
mat = NextItem(mat);
/* Cycle loop */
continue;
}
/* Calculate data size */
CalculateBytes();
/* Get memory size */
mem = RDB[DATA_TOTAL_BYTES];
/* Loop over reaction modes */
for (n = 0; n < 12; n++)
{
/* Avoid compiler warning */
mode = -1;
lst = -1;
/* Get mode and list pointer */
if (n == 0)
{
mode = MATERIAL_PTR_TOTXS;
lst = MATERIAL_PTR_TOT_REA_LIST;
}
else if (n == 1)
{
mode = MATERIAL_PTR_ABSXS;
lst = MATERIAL_PTR_ABS_REA_LIST;
}
else if (n == 2)
{
mode = MATERIAL_PTR_ELAXS;
lst = MATERIAL_PTR_ELA_REA_LIST;
}
else if (n == 3)
{
mode = MATERIAL_PTR_FISSXS;
lst = MATERIAL_PTR_FISS_REA_LIST;
}
else if (n == 4)
{
mode = MATERIAL_PTR_HEATTXS;
lst = MATERIAL_PTR_HEATT_REA_LIST;
}
else if (n == 5)
{
mode = MATERIAL_PTR_PHOTPXS;
lst = MATERIAL_PTR_PHOTP_REA_LIST;
}
else if (n == 6)
{
mode = MATERIAL_PTR_INLPXS;
lst = MATERIAL_PTR_INLP_REA_LIST;
}
else if (n == 7)
{
mode = MATERIAL_PTR_FISSE;
lst = MATERIAL_PTR_FISS_REA_LIST;
}
else if (n == 8)
{
mode = MATERIAL_PTR_NSF;
lst = MATERIAL_PTR_FISS_REA_LIST;
}
else if (n == 9)
{
mode = MATERIAL_PTR_TOTPHOTXS;
lst = MATERIAL_PTR_PHOT_TOT_LIST;
}
else if (n == 10)
{
mode = MATERIAL_PTR_HEATPHOTXS;
lst = MATERIAL_PTR_PHOT_HEAT_LIST;
}
else if (n == 11)
{
mode = MATERIAL_PTR_TMP_MAJORANTXS;
lst = MATERIAL_PTR_TMP_MAJORANT_LIST;
}
else
Die (FUNCTION_NAME, "Invalid reaction mode");
/* Check that reaction pointer doesn't exist */
if ((long)RDB[mat + mode] > VALID_PTR)
Die(FUNCTION_NAME, "Reaction already exists");
/* Cycle loop if nuclide has no reactions of this type */
if ((long)RDB[mat + lst] < VALID_PTR)
continue;
/* Allocate memory for block */
rea = NewItem(mat + mode, REACTION_BLOCK_SIZE);
/* Put type */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SUM;
/* Put mt */
if (mode == MATERIAL_PTR_TOTXS)
WDB[rea + REACTION_MT] = MT_MACRO_TOTXS;
else if (mode == MATERIAL_PTR_ABSXS)
WDB[rea + REACTION_MT] = MT_MACRO_ABSXS;
else if (mode == MATERIAL_PTR_ELAXS)
WDB[rea + REACTION_MT] = MT_MACRO_ELAXS;
else if (mode == MATERIAL_PTR_FISSXS)
WDB[rea + REACTION_MT] = MT_MACRO_FISSXS;
else if (mode == MATERIAL_PTR_HEATTXS)
WDB[rea + REACTION_MT] = MT_MACRO_HEATXS;
else if (mode == MATERIAL_PTR_PHOTPXS)
WDB[rea + REACTION_MT] = MT_MACRO_PHOTXS;
else if (mode == MATERIAL_PTR_INLPXS)
WDB[rea + REACTION_MT] = MT_MACRO_INLPRODXS;
else if (mode == MATERIAL_PTR_FISSE)
WDB[rea + REACTION_MT] = MT_MACRO_FISSE;
else if (mode == MATERIAL_PTR_NSF)
WDB[rea + REACTION_MT] = MT_MACRO_NSF;
else if (mode == MATERIAL_PTR_TOTPHOTXS)
WDB[rea + REACTION_MT] = MT_MACRO_TOTPHOTXS;
else if (mode == MATERIAL_PTR_HEATPHOTXS)
WDB[rea + REACTION_MT] = MT_MACRO_HEATPHOTXS;
else if (mode == MATERIAL_PTR_TMP_MAJORANTXS)
WDB[rea + REACTION_MT] = MT_MACRO_TMP_MAJORANTXS;
else
Die (FUNCTION_NAME, "Invalid reaction mode");
/* Put mode */
WDB[rea + REACTION_MODE] = (double)lst;
/* Put material pointer */
WDB[rea + REACTION_PTR_MAT] = (double)mat;
/* Put pointer to partial list */
WDB[rea + REACTION_PTR_PARTIAL_LIST] = RDB[mat + lst];
/* Reset minimum and maximum energy */
WDB[rea + REACTION_EMIN] = INFTY;
WDB[rea + REACTION_EMAX] = -INFTY;
/* Reset ures energy boundaries */
WDB[rea + REACTION_URES_EMIN] = INFTY;
WDB[rea + REACTION_URES_EMAX] = -INFTY;
/* Reset pointer to energy grid */
WDB[rea + REACTION_PTR_EGRID] = NULLPTR;
/* Reset pointer to xs data */
WDB[rea + REACTION_PTR_XS] = NULLPTR;
/* Reset first point and number of points */
WDB[rea + REACTION_XS_I0] = -1.0;
WDB[rea + REACTION_XS_NE] = -1.0;
/* Allocate memory for previous value */
AllocValuePair(rea + REACTION_PTR_PREV_XS);
}
/* Calculate number of bytes */
CalculateBytes();
/* Store beginning of data block */
WDB[mat + MATERIAL_PTR_DATA_BLOCK] = RDB[DATA_ALLOC_MAIN_SIZE];
/***********************************************************************/
/***** Allocate memory for multi-group total cross sections ************/
if ((long)RDB[DATA_OPTI_MG_MODE] == YES)
{
/* Get pointer to total cross section */
rea = (long)RDB[mat + MATERIAL_PTR_TOTXS];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Get number of points */
ne = (long)RDB[DATA_COARSE_MG_NE];
CheckValue(FUNCTION_NAME, "np", "", ne, 10, 50000);
/* Allocate memory for data */
ptr = ReallocMem(DATA_ARRAY, ne);
/* Put pointer */
WDB[rea + REACTION_PTR_MGXS] = (double)ptr;
}
/* Check if macroscopic cross sections are reconstructed */
if ((long)RDB[DATA_OPTI_RECONSTRUCT_MACROXS] == NO)
{
/* Calculate number of bytes */
CalculateBytes();
/* Update memory size */
WDB[mat + MATERIAL_MEM_SIZE] = RDB[mat + MATERIAL_MEM_SIZE]
+ RDB[DATA_TOTAL_BYTES] - mem;
/* Store data block size */
WDB[mat + MATERIAL_DATA_BLOCK_SIZE] =
RDB[DATA_ALLOC_MAIN_SIZE] - WDB[mat + MATERIAL_PTR_DATA_BLOCK];
/* Next material */
mat = NextItem(mat);
/* Cycle loop */
continue;
}
/***********************************************************************/
/***** Allocate memory for pre-calculated neutron cross sections *******/
/* Get pointer to unionized neutron energy grid */
if ((erg = (long)RDB[DATA_ERG_PTR_UNIONIZED_NGRID]) > VALID_PTR)
{
/* Get number of energy points */
ne = RDB[erg + ENERGY_GRID_NE];
/* Get minimum and maximum energy */
Emin = RDB[erg + ENERGY_GRID_EMIN];
Emax = RDB[erg + ENERGY_GRID_EMAX];
}
else
{
/* Avoid compiler warning */
ne = -1;
Emin = INFTY;
Emax = -INFTY;
}
/* Set number of modes */
if ((long)RDB[mat + MATERIAL_TMS_MODE] == TMS_MODE_CE)
nr = 1;
else
nr = 10;
/* Loop over reaction modes */
for (n = 0; n < nr; n++)
{
/* Avoid compiler warning */
mode = -1;
lst = -1;
/* Get mode and list pointer */
if (n == 0)
{
mode = MATERIAL_PTR_TMP_MAJORANTXS;
lst = (long)RDB[mat + MATERIAL_PTR_TMP_MAJORANT_LIST];
}
else if (n == 1)
{
mode = MATERIAL_PTR_TOTXS;
lst = (long)RDB[mat + MATERIAL_PTR_TOT_REA_LIST];
}
else if (n == 2)
{
mode = MATERIAL_PTR_ABSXS;
lst = (long)RDB[mat + MATERIAL_PTR_ABS_REA_LIST];
}
else if (n == 3)
{
mode = MATERIAL_PTR_ELAXS;
lst = (long)RDB[mat + MATERIAL_PTR_ELA_REA_LIST];
}
else if (n == 4)
{
mode = MATERIAL_PTR_FISSXS;
lst = (long)RDB[mat + MATERIAL_PTR_FISS_REA_LIST];
}
else if (n == 5)
{
mode = MATERIAL_PTR_HEATTXS;
lst = (long)RDB[mat + MATERIAL_PTR_HEATT_REA_LIST];
}
else if (n == 6)
{
mode = MATERIAL_PTR_PHOTPXS;
lst = (long)RDB[mat + MATERIAL_PTR_PHOTP_REA_LIST];
}
else if (n == 7)
{
mode = MATERIAL_PTR_INLPXS;
lst = (long)RDB[mat + MATERIAL_PTR_INLP_REA_LIST];
}
else if (n == 8)
{
mode = MATERIAL_PTR_FISSE;
lst = (long)RDB[mat + MATERIAL_PTR_FISS_REA_LIST];
}
else if (n == 9)
{
mode = MATERIAL_PTR_NSF;
lst = (long)RDB[mat + MATERIAL_PTR_FISS_REA_LIST];
}
else
Die (FUNCTION_NAME, "Invalid reaction mode");
/* Cycle loop if list is not defined */
if (lst < VALID_PTR)
continue;
/* Check unionized grid pointer */
if (erg < VALID_PTR)
Die(FUNCTION_NAME, "Reconstruction without unionized grid (1)");
/* Pointer to reaction data */
rea = (long)RDB[mat + mode];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Put minimum and maximum energy */
WDB[rea + REACTION_EMIN] = Emin;
WDB[rea + REACTION_EMAX] = Emax;
/* Put pointer to energy grid */
WDB[rea + REACTION_PTR_EGRID] = (double)erg;
/* Put first point and number of points */
WDB[rea + REACTION_XS_I0] = 0.0;
WDB[rea + REACTION_XS_NE] = (double)ne;
/* Allocate memory */
ptr = ReallocMem(DATA_ARRAY, ne);
WDB[rea + REACTION_PTR_XS] = (double)ptr;
}
/***********************************************************************/
/***** Allocate memory for pre-calculated photon cross sections ********/
/* Get pointer to unionized neutron energy grid */
if ((erg = (long)RDB[DATA_ERG_PTR_UNIONIZED_PGRID]) > VALID_PTR)
{
/* Get number of energy points */
ne = RDB[erg + ENERGY_GRID_NE];
/* Get minimum and maximum energy */
Emin = RDB[erg + ENERGY_GRID_EMIN];
Emax = RDB[erg + ENERGY_GRID_EMAX];
}
else
{
/* Avoid compiler warning */
ne = -1;
Emin = INFTY;
Emax = -INFTY;
}
/* Loop over reaction modes */
for (n = 0; n < 2; n++)
{
/* Avoid compiler warning */
mode = -1;
lst = -1;
/* Get mode */
if (n == 0)
{
mode = MATERIAL_PTR_TOTPHOTXS;
lst = (long)RDB[mat + MATERIAL_PTR_PHOT_TOT_LIST];
}
else if (n == 1)
{
mode = MATERIAL_PTR_HEATPHOTXS;
lst = (long)RDB[mat + MATERIAL_PTR_PHOT_HEAT_LIST];
}
else
Die (FUNCTION_NAME, "Invalid reaction mode");
/* Cycle loop if list is not defined */
if (lst < VALID_PTR)
continue;
/* Check unionized grid pointer */
if (erg < VALID_PTR)
Die(FUNCTION_NAME, "Reconstruction without unionized grid (2)");
/* Pointer to reaction data */
rea = (long)RDB[mat + mode];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Put minimum and maximum energy */
WDB[rea + REACTION_EMIN] = Emin;
WDB[rea + REACTION_EMAX] = Emax;
/* Put pointer to energy grid */
WDB[rea + REACTION_PTR_EGRID] = (double)erg;
/* Put first point and number of points */
WDB[rea + REACTION_XS_I0] = 0.0;
WDB[rea + REACTION_XS_NE] = (double)ne;
/* Allocate memory */
ptr = ReallocMem(DATA_ARRAY, ne);
WDB[rea + REACTION_PTR_XS] = (double)ptr;
}
/***********************************************************************/
/* Calculate number of bytes */
CalculateBytes();
/* Update memory size */
WDB[mat + MATERIAL_MEM_SIZE] = RDB[mat + MATERIAL_MEM_SIZE]
+ RDB[DATA_TOTAL_BYTES] - mem;
/* Store data block size */
WDB[mat + MATERIAL_DATA_BLOCK_SIZE] =
RDB[DATA_ALLOC_MAIN_SIZE] - WDB[mat + MATERIAL_PTR_DATA_BLOCK];
/* Next material */
mat = NextItem(mat);
}
fprintf(out, "OK.\n\n");
/***************************************************************************/
/***** Allocate memory for DT neutron majorant *****************************/
/* Check DT flag */
if ((long)RDB[DATA_OPT_USE_DT] == YES)
{
/* Check number of nuclides */
if ((long)RDB[DATA_N_TRANSPORT_NUCLIDES] > 0)
{
/* Get pointer to unionized neutron energy grid */
erg = (long)RDB[DATA_ERG_PTR_UNIONIZED_NGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Create reaction block */
rea = NewItem(DATA_PTR_MAJORANT, REACTION_BLOCK_SIZE);
/* Put mt */
WDB[rea + REACTION_MT] = (double)MT_MACRO_MAJORANT;
/* Allocate memory for previous value */
AllocValuePair(rea + REACTION_PTR_PREV_XS);
/* Copy energy grid pointer */
WDB[rea + REACTION_PTR_EGRID] = (double)erg;
/* Get number of energy points */
ne = (long)RDB[erg + ENERGY_GRID_NE];
/* Put number of energy points */
WDB[rea + REACTION_XS_NE] = (double)ne;
/* Put minimum and maximum energy */
WDB[rea + REACTION_EMIN] = RDB[erg + ENERGY_GRID_EMIN];
WDB[rea + REACTION_EMAX] = RDB[erg + ENERGY_GRID_EMAX];
/* Allocate memory for data */
ptr = ReallocMem(DATA_ARRAY, ne);
WDB[rea + REACTION_PTR_MAJORANT_XS] = (double)ptr;
/* Allocate memory for coarse multi-group majorants */
if ((long)RDB[DATA_OPTI_MG_MODE] == YES)
{
/* Get number of groups */
ne = (long)RDB[DATA_COARSE_MG_NE];
CheckValue(FUNCTION_NAME, "np", "", ne, 10, 50000);
/* Allocate memory for data */
ptr = ReallocMem(DATA_ARRAY, ne);
/* Put pointer */
WDB[rea + REACTION_PTR_MGXS] = (double)ptr;
}
}
}
/***************************************************************************/
/***** Allocate memory for DT photon majorant ******************************/
/* Check DT flag */
if ((long)RDB[DATA_OPT_USE_DT] == YES)
{
/* Check number of nuclides */
if ((long)RDB[DATA_N_PHOTON_NUCLIDES] > 0)
{
/* Get pointer to unionized neutron energy grid */
erg = (long)RDB[DATA_ERG_PTR_UNIONIZED_PGRID];
CheckPointer(FUNCTION_NAME, "(erg)", DATA_ARRAY, erg);
/* Create reaction block */
rea = NewItem(DATA_PTR_PHOTON_MAJORANT, REACTION_BLOCK_SIZE);
/* Put mt */
WDB[rea + REACTION_MT] = (double)MT_MACRO_MAJORANT;
/* Allocate memory for previous value */
AllocValuePair(rea + REACTION_PTR_PREV_XS);
/* Copy energy grid pointer */
WDB[rea + REACTION_PTR_EGRID] = (double)erg;
/* Get number of energy points */
ne = (long)RDB[erg + ENERGY_GRID_NE];
/* Put number of energy points */
WDB[rea + REACTION_XS_NE] = (double)ne;
/* Put minimum and maximum energy */
WDB[rea + REACTION_EMIN] = RDB[erg + ENERGY_GRID_EMIN];
WDB[rea + REACTION_EMAX] = RDB[erg + ENERGY_GRID_EMAX];
/* Allocate memory for data */
ptr = ReallocMem(DATA_ARRAY, ne);
WDB[rea + REACTION_PTR_MAJORANT_XS] = (double)ptr;
}
}
/***************************************************************************/
}
// add a variable to the environment or alias to the alias list
int add_list( char *envstr, PCH pchList )
{
char *line;
PCH feptr, env_arg, env_end, last_var;
unsigned int length;
int rval = 0;
ULONG size; // size of environment or alias blocks
// OS/2 & NT need semaphores to keep processes from simultaneously
// writing the alias list
HMTX SemHandle = 0;
char szVarName[32];
if ( pchList == 0L )
pchList = glpEnvironment;
line = envstr;
if ( *line == '=' ) {
return ( error( ERROR_4DOS_BAD_SYNTAX, envstr ));
}
for ( ; (( *line ) && ( *line != '=' )); line++ ) {
if ( pchList == glpAliasList ) {
if ( iswhite( *line )) {
strcpy( line, skipspace( line ) );
break;
}
}
else // ensure environment entry is in upper case
*line = (unsigned char)_ctoupper( *line );
}
if ( *line == '=' ) {
// point to the first char of the argument
line++;
// collapse whitespace around '=' in aliases, but not in env
// variables, for COMMAND.COM compatibility (set abc def= ghi)
if ( pchList == glpAliasList )
strcpy( line, skipspace( line ));
} else if ( *line ) {
// add the missing '='
strins( line, "=" );
line++;
}
// removing single back quotes at the beginning and end of an alias
// argument (they're illegal there; the user is probably making a
// mistake with ALIAS /R)
if (( *line == SINGLE_QUOTE ) && ( pchList == glpAliasList )) {
// remove leading single quote
strcpy( line, line + 1 );
// remove trailing single quote
if ((( length = strlen( line )) != 0 ) && ( line[--length] == SINGLE_QUOTE ))
line[length] = '\0';
}
// block other processes & threads while updating alias list
if ( pchList == glpAliasList ) {
// disable signals temporarily
HoldSignals();
// get & lock a semaphore
RequestSemaphore( &SemHandle, SEMAPHORE_NAME );
}
// get pointers to beginning & end of alias/environment space
size = QueryMemSize( pchList );
env_end = pchList + ( size - 4 );
// get pointer to end of environment or alias variables
last_var = end_of_env( pchList );
length = strlen( envstr ) + 1;
// special case for BeginLIBPATH and EndLIBPATH
sscanf( envstr, "%31[^=]", szVarName );
if (stricmp( szVarName, BEGINLIBPATH ) == 0) {
if ((DosSetExtLIBPATH( line, BEGIN_LIBPATH ) == NO_ERROR))
return 0;
return ERROR_EXIT;
}
if (stricmp( szVarName, ENDLIBPATH ) == 0) {
if ((DosSetExtLIBPATH( line, END_LIBPATH ) == NO_ERROR))
return 0;
return ERROR_EXIT;
}
// check for modification or deletion of existing entry
if (( env_arg = get_list( envstr, pchList )) != 0L ) {
// get the start of the alias or variable name
for ( feptr = env_arg; (( feptr > pchList ) && ( feptr[-1] != '\0' )); feptr-- )
;
if ( *line == '\0' ) {
// delete an alias or environment variable
memmove( feptr, next_env( feptr ), (unsigned int)( last_var - next_env(feptr)) + 1);
} else {
// get the relative length (vs. the old variable)
length = strlen( line ) - strlen( env_arg );
}
}
if ( *line != '\0' ) {
// check for out of environment space
if (( last_var + length ) >= env_end ) {
// boost environment or alias list size
if ( ReallocMem( pchList, size + ENVIRONMENT_SIZE ) == NULL) {
rval = error((( pchList == glpAliasList ) ? ERROR_4DOS_OUT_OF_ALIAS : ERROR_4DOS_OUT_OF_ENVIRONMENT), NULL);
goto add_bye;
}
// adjust the environment / alias list size
size = QueryMemSize( pchList );
if ( pchList == glpEnvironment )
gpIniptr->EnvSize = (unsigned int)size;
else if ( pchList == glpAliasList )
gpIniptr->AliasSize = (unsigned int)size;
}
if ( env_arg != 0L ) {
// modify an existing alias or environment variable
// adjust the space & insert new value
feptr = next_env( feptr );
memmove(( feptr + length ), feptr, (unsigned int)( last_var - feptr) + 1 );
strcpy( env_arg, line );
} else {
// put it at the end & add an extra null
strcpy( last_var, envstr );
last_var[length] = '\0';
}
}
add_bye:
if ( pchList == glpAliasList ) {
// clear the semaphore
FreeSemaphore( SemHandle );
EnableSignals();
}
return rval;
}
void ReadACEFile(long nuc)
{
long ace, ptr, rea, n, sz, NXS[16], JXS[32], NES, L0, L, NTR, nr, mt, nc, I0;
double *XSS, awr, Emax, T;
char HZ1[MAX_STR], HZ2[MAX_STR], dummy[MAX_STR], name[MAX_STR];
char file[MAX_STR], date[MAX_STR];
FILE *fp;
/* Check nuclide type */
if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DECAY)
if (!((long)RDB[nuc + NUCLIDE_TYPE_FLAGS] & NUCLIDE_FLAG_TRANSMU_DATA))
Die(FUNCTION_NAME, "Decay data");
/* Get pointer to ACE data */
ace = (long)RDB[nuc + NUCLIDE_PTR_ACE];
CheckPointer(FUNCTION_NAME, "ace", ACE_ARRAY, ace);
/* Put name */
WDB[DATA_DUMMY] = ACE[ace + ACE_PTR_NAME];
strcpy(name, GetText(DATA_DUMMY));
/* Get file name */
WDB[DATA_DUMMY] = ACE[ace + ACE_PTR_FILE];
strcpy(file, GetText(DATA_DUMMY));
/* Test format */
TestDOSFile(GetText(DATA_DUMMY));
/* Open file for writing */
fp = OpenDataFile(DATA_DUMMY, "ACE data file");
/***************************************************************************/
/***** Read data ***********************************************************/
/* Reset HZ */
*HZ1 = '\0';
*HZ2 = '\0';
/* Read ZAID and data */
while (fscanf(fp, "%s", HZ1) != EOF)
{
/* Check for new format (assuming here that the character string */
/* is '2.0.0' -- this is something that may need to be checked in */
/* the future). */
if (!strcmp(HZ1, "2.0.0"))
{
/* New format, read reminder of line */
if (fgets(dummy, 81, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
/* Get new HZ */
sscanf(dummy, "%s", HZ2);
/* Next line */
if (fgets(dummy, 81, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
/* Reset number of comment lines */
nc = 0;
/* Get atomic weight ratio, temperature, date and number of */
/* comment lines (new ACE format). Only the last entry is */
/* used here. */
sscanf(dummy, "%lf %lf %s %ld", &awr, &T, date, &nc);
CheckValue(FUNCTION_NAME, "nc", "", nc, 3, 10000);
/* Skip comment lines */
for (n = 0; n < nc - 2; n++)
if (fgets(dummy, 82, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
/* The next line is the first line of 'old-style' ACE, get ZAID */
if (fscanf(fp, "%s", HZ1) == EOF)
Die(FUNCTION_NAME, "fscanf error");
}
/* Get atomic weight ratio. Temperature is the next entry after */
/* AWR, but it is not used. The value is taken from the directory */
/* file. */
if (fgets(dummy, 81, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
sscanf(dummy, "%lf", &awr);
/* Skip comment line */
if (fgets(dummy, 81, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
/* Preserve decay awr */
if ((long)RDB[nuc + NUCLIDE_TYPE] != NUCLIDE_TYPE_DECAY)
{
/* Put atomic weight ratio */
WDB[nuc + NUCLIDE_AWR] = awr;
/* Use value read from directory file for atomic weight */
WDB[nuc + NUCLIDE_AW] = ACE[ace + ACE_AW];
}
/* 16 IZ AW pairs */
for (n = 0; n < 32; n++)
if (fscanf(fp, "%s", dummy) == EOF)
Die(FUNCTION_NAME, "fscanf error");
/* Read the NXS array */
for (n = 0; n < 16; n++)
if (fscanf(fp, "%ld", &NXS[n]) == EOF)
Die(FUNCTION_NAME, "Error in NXS array (%s)",
GetText(nuc + NUCLIDE_PTR_NAME));
/* Get data size (NXS[0]) */
if ((sz = NXS[0]) < 10)
Die(FUNCTION_NAME, "Error in ACE file");
/* Read the JXS array */
for (n = 0; n < 32; n++)
if (fscanf(fp, "%ld", &JXS[n]) == EOF)
Die(FUNCTION_NAME, "Error in JXS array (%s)",
GetText(nuc + NUCLIDE_PTR_NAME));
/* Compare ZAIDs */
if ((!strcmp(HZ1, name)) || (!strcmp(HZ2, name)))
{
/* Allocate memory for NXS array */
ptr = ReallocMem(ACE_ARRAY, 16);
ACE[ace + ACE_PTR_NXS] = (double)ptr;
/* Copy data */
for (n = 0; n < 16; n++)
ACE[ptr++] = (double)NXS[n];
/* Allocate memory for JXS array */
ptr = ReallocMem(ACE_ARRAY, 32);
ACE[ace + ACE_PTR_JXS] = (double)ptr;
/* Copy data */
for (n = 0; n < 32; n++)
ACE[ptr++] = (double)JXS[n];
/* Allocate memory for XSS array */
ptr = ReallocMem(ACE_ARRAY, sz);
/* Set pointer */
ACE[ace + ACE_PTR_XSS] = (double)ptr;
/* Read data */
for (n = 0; n < sz; n++)
if (fscanf(fp, "%lf", &ACE[ptr + n]) == EOF)
{
/* Print warning */
Warn(FUNCTION_NAME, "Error in XSS array (%s)",
GetText(nuc + NUCLIDE_PTR_NAME));
/* Break */
break;
}
/* Break loop */
break;
}
/* Seek to next header (muutettu 25.6.2013, katso Martin Magillin */
/* meili 13.6.2014)) */
/*
fseek(fp, 81*sz/4 + 1, SEEK_CUR);
*/
fseek(fp, 81*sz/4, SEEK_CUR);
if (fgets(dummy, 81, fp) == NULL)
Die(FUNCTION_NAME, "fgets error");
}
/* Check that data was found */
if ((strcmp(HZ1, name)) && (strcmp(HZ2, name)))
Die(FUNCTION_NAME, "Unable to find isotope %s in file %s", name, file);
/* Pointer to XSS array */
ptr = (long)ACE[ace + ACE_PTR_XSS];
XSS = &ACE[ptr];
/* Set ures energy boundaries */
if ((L = JXS[22] - 1) > 0)
{
/* Get number of energy points */
NES = (long)XSS[L];
/* Set minimum and maximum energies */
WDB[nuc + NUCLIDE_URES_EMIN] = XSS[L + 6];
WDB[nuc + NUCLIDE_URES_EMAX] = XSS[L + 6 + NES - 1];
}
else
{
/* Reset boundaries */
WDB[nuc + NUCLIDE_URES_EMIN] = INFTY;
WDB[nuc + NUCLIDE_URES_EMAX] = -INFTY;
}
/**************************************************************************/
/***** Add reaction channels for transport data ***************************/
/* Check type */
if (((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_TRANSPORT) ||
((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DBRC))
{
/**********************************************************************/
/***** Transport nuclide **********************************************/
/* Number of energy points */
NES = NXS[2];
/* Put pointer to nuclide energy grid and nuber of points */
WDB[nuc + NUCLIDE_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[nuc + NUCLIDE_EGRID_NE] = NES;
/* Get number of reactions (minus elastic scattering). Include */
/* only elastic scattering for DBRC nuclides. */
if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DBRC)
NTR = 0;
else
NTR = NXS[3];
/* Compare minimum and maximum value to XS limits */
if (XSS[JXS[0] - 1] < RDB[DATA_NEUTRON_XS_EMIN])
WDB[DATA_NEUTRON_XS_EMIN] = XSS[JXS[0] - 1];
if (XSS[JXS[0] + NES - 2] > RDB[DATA_NEUTRON_XS_EMAX])
WDB[DATA_NEUTRON_XS_EMAX] = XSS[JXS[0] + NES - 2];
/* Number of delayed neutron precursor groups */
WDB[nuc + NUCLIDE_ACE_PREC_GROUPS] = NXS[7];
/* Add elastic scattering */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Reaction index (used for energy distributions) */
WDB[rea + REACTION_NR] = -1.0;
/* Put type and MT */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
WDB[rea + REACTION_MT] = 2.0;
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Set minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[JXS[0] - 1];
WDB[rea + REACTION_EMAX] = XSS[JXS[0] + NES - 2];
WDB[nuc + NUCLIDE_EMIN] = XSS[JXS[0] - 1];
WDB[nuc + NUCLIDE_EMAX] = XSS[JXS[0] + NES - 2];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = 0.0;
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(JXS[0] - 1 + 3*NES);
/* Set ures energy boundaries */
WDB[rea + REACTION_URES_EMIN] = RDB[nuc + NUCLIDE_URES_EMIN];
WDB[rea + REACTION_URES_EMAX] = RDB[nuc + NUCLIDE_URES_EMIN];
/* Set Q-value */
WDB[rea + REACTION_Q] = 0.0;
/* Multiplication and frame of reference */
WDB[rea + REACTION_TY] = -1.0;
WDB[rea + REACTION_WGT_F] = 1.0;
/* Set branching fraction to 1.0 */
WDB[rea + REACTION_BR] = 1.0;
/* Set interpolation mode */
WDB[rea + REACTION_ITP] = 0.0;
/* Pointer to angular distribution (Tables F-11 and F-12) */
if ((L = (long)XSS[JXS[7] - 1]) > 0)
WDB[rea + REACTION_PTR_ANG] = (double)(L - 1 + JXS[8]);
else
WDB[rea + REACTION_PTR_ANG] = NULLPTR;
/* Include heat production */
if ((long)RDB[DATA_INCLUDE_HEAT_PROD_XS] == YES)
{
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
WDB[nuc + NUCLIDE_PTR_HEATPRODXS] = (double)rea;
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Put type and MT */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
WDB[rea + REACTION_MT] = 301.0;
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Set minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[JXS[0] - 1];
WDB[rea + REACTION_EMAX] = XSS[JXS[0] + NES - 2];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = 0.0;
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(JXS[0] - 1 + 4*NES);
/* Set ures energy boundaries (mites nää?) */
WDB[rea + REACTION_URES_EMIN] = RDB[nuc + NUCLIDE_URES_EMIN];
WDB[rea + REACTION_URES_EMAX] = RDB[nuc + NUCLIDE_URES_EMIN];
/* Multiplication (not used but must be set to avoid error) */
WDB[rea + REACTION_WGT_F] = 1.0;
}
/* Include photon production from total block */
if (((long)RDB[DATA_INCLUDE_PHOT_PROD_XS] == YES) && (JXS[11] > 0))
{
/* Add photon production */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
WDB[nuc + NUCLIDE_PTR_PHOTPRODXS] = (double)rea;
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Put type and MT */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
WDB[rea + REACTION_MT] = 202.0;
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Set minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[JXS[0] - 1];
WDB[rea + REACTION_EMAX] = XSS[JXS[0] + NES - 2];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = 0.0;
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(JXS[11] - 1);
/* Set ures energy boundaries (mites nää?) */
WDB[rea + REACTION_URES_EMIN] = INFTY;
WDB[rea + REACTION_URES_EMAX] = -INFTY;
/* Multiplication (not used but must be set to avoid error) */
WDB[rea + REACTION_WGT_F] = 1.0;
}
/* Loop over reaction channels in SIG block*/
for (nr = 0; nr < NTR; nr++)
{
/* Get pointer to SIG-block (Table F-10, page F-17) */
L = (long)XSS[JXS[5] - 1 + nr] + JXS[6] - 1;
/* Get number of energy points */
NES = (long)XSS[L];
/* Pointer to energy array */
L0 = JXS[0] - 1 + NXS[2] - NES;
/* Tässä oli 22.8.2011 asti tarkistus > 2, mutta se jättää */
/* mt 37:n 94244 / endfb68 pois */
if (NES > 0)
{
/* Allocate memory */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Reaction index (used for energy distributions) */
WDB[rea + REACTION_NR] = (double)nr;
/* Get mt */
mt = (long)XSS[JXS[2] + nr - 1];
WDB[rea + REACTION_MT] = (double)mt;
/* Check fissile */
if (((mt > 17) && (mt < 22)) || (mt == 38))
{
/* Set flag */
SetOption(nuc + NUCLIDE_TYPE_FLAGS, NUCLIDE_FLAG_FISSILE);
/* Set default energy boundaries */
WDB[rea + REACTION_FISSY_IE0] = -INFTY;
WDB[rea + REACTION_FISSY_IE1] = 1E+6;
WDB[rea + REACTION_FISSY_IE2] = 1E+9;
}
/* Store minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[L0];
WDB[rea + REACTION_EMAX] = XSS[L0 + NES - 1];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = (double)(NXS[2] - NES);
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(L + 1);
/* Set ures energy boundaries */
if ((mt == 102) || (mt == 18) || (mt == 19))
{
/* Set ures energy boundaries */
WDB[rea + REACTION_URES_EMIN] =
RDB[nuc + NUCLIDE_URES_EMIN];
WDB[rea + REACTION_URES_EMAX] =
RDB[nuc + NUCLIDE_URES_EMIN];
}
else
{
/* Reset boundaries */
WDB[rea + REACTION_URES_EMIN] = INFTY;
WDB[rea + REACTION_URES_EMAX] = -INFTY;
}
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Store Q-value */
WDB[rea + REACTION_Q] = XSS[JXS[3] - 1 + nr];
/* Multiplication and frame of reference */
WDB[rea + REACTION_TY] = XSS[JXS[4] - 1 + nr];
/* Check known error in ACE files */
if ((XSS[JXS[4] - 1 + nr] == 0.0) &&
(((mt > 17) && (mt < 22)) || (mt == 38)))
{
/* Print warning */
#ifdef DEBUG
Warn(FUNCTION_NAME,
"Conflicting reaction type for fission (%s mt %ld)",
GetText(nuc + NUCLIDE_PTR_NAME), mt);
#endif
/* Set ty for fission */
WDB[rea + REACTION_TY] = 19.0;
}
/* Put weight multiplicator */
if((RDB[rea + REACTION_TY] == 0.0) ||
(RDB[rea + REACTION_TY] == 19.0) ||
(fabs(RDB[rea + REACTION_TY]) > 100.0))
WDB[rea + REACTION_WGT_F] = 1.0;
else if (fabs(RDB[rea + REACTION_TY]) < 5)
WDB[rea + REACTION_WGT_F] = fabs(RDB[rea + REACTION_TY]);
else
Die(FUNCTION_NAME, "Invalid TYR value: %ld\n",
(long)RDB[rea + REACTION_TY]);
/* Override fission if switched off (18.7.2013 / 2.1.15) */
if (((long)RDB[DATA_NPHYS_SAMPLE_FISS] == NO) &&
((long)RDB[rea + REACTION_TY] == 19.0))
WDB[rea + REACTION_TY] = 0.0;
/* Set interpolation mode */
WDB[rea + REACTION_ITP] = 0.0;
/* Set branching fraction to 1.0 */
WDB[rea + REACTION_BR] = 1.0;
/* Pointer to angular distribution (NOTE: L is re-used) */
if ((L = (long)XSS[JXS[7] + nr]) > 0)
WDB[rea + REACTION_PTR_ANG] = (double)(L - 1 + JXS[8]);
else
WDB[rea + REACTION_PTR_ANG] = NULLPTR;
/* Check type */
if (((mt > 10) && (mt < 100)) || ((mt > 101) && (mt < 200)) ||
((mt > 599) && (mt < 851)) || ((mt > 874) && (mt < 892)))
{
/* Partial reaction */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
}
else if (mt == 5)
{
/* Combination of multiple inelastic channels */
/* (this used to be a problem) */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
}
else
{
/* Special */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
}
}
}
/* Get number of photon production reactions */
if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DBRC)
NTR = 0;
else
NTR = NXS[5];
/* Loop over reaction channels in SIGP block*/
for (nr = 0; nr < NTR; nr++)
{
/* Get pointer to SIGP-block (Table F-10, page F-17) */
L = (long)XSS[JXS[13] - 1 + nr] + JXS[14] - 1;
/* Tää on ihan vaiheessa */
I0 = (long)XSS[L - 1];
NES = (long)XSS[L];
}
/***********************************************************************/
/***** URES data *******************************************************/
/* Check if ures probability table data is available (ures data */
/* is now read for DBRC nuclides as well). */
if ((L = JXS[22] - 1) > 0)
{
/* Add to ures counter */
WDB[DATA_URES_AVAIL] = RDB[DATA_URES_AVAIL] + 1.0;
/* Set available flag */
SetOption(nuc + NUCLIDE_TYPE_FLAGS, NUCLIDE_FLAG_URES_AVAIL);
/* Check ures option */
if ((long)RDB[DATA_USE_URES] == NO)
{
/* Pointer to list */
if ((ptr = (long)RDB[DATA_URES_PTR_USE_LIST]) < VALID_PTR)
L = -1;
else
{
/* Loop over list and compare */
while ((long)RDB[ptr] > 0)
{
if (!strcmp(GetText(ptr),
GetText(nuc + NUCLIDE_PTR_NAME)))
{
L = -1;
break;
}
ptr++;
}
}
}
else if ((ptr = (long)RDB[DATA_URES_PTR_USE_LIST]) > VALID_PTR)
{
/* Loop over list and compare */
while ((long)RDB[ptr] > 0)
{
if (!strcmp(GetText(ptr), GetText(nuc + NUCLIDE_PTR_NAME)))
break;
ptr++;
}
if ((long)RDB[ptr] < 1)
L = -1;
}
}
/* Check if data is available and used */
if (L > 0)
{
/* Set flag */
SetOption(nuc + NUCLIDE_TYPE_FLAGS, NUCLIDE_FLAG_URES_USED);
/* Add counter */
WDB[DATA_URES_USED] = RDB[DATA_URES_USED] + 1.0;
}
/**********************************************************************/
}
else if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DOSIMETRY)
{
/**********************************************************************/
/***** Dosimetry data *************************************************/
/* Get number of reactions */
NTR = NXS[3];
/* Reset nuclide-wise minimum and maximum energy */
WDB[nuc + NUCLIDE_EMIN] = INFTY;
WDB[nuc + NUCLIDE_EMAX] = -INFTY;
/* Loop over reaction channels */
for (nr = 0; nr < NTR; nr++)
{
/* Get pointer to SIGD-block (Table F-22, page F-35) */
L0 = (long)XSS[JXS[5] - 1 + nr] + JXS[6] - 1;
/* Get reaction MT (Table F-6, page F-15) */
mt = (long)XSS[JXS[2] - 1 + nr];
/* Check number of interpolation regions */
if ((long)XSS[L0 - 1] > 0)
Die(FUNCTION_NAME, "Non-linear interpolation (%s mt %ld)",
GetText(nuc + NUCLIDE_PTR_NAME), mt);
/* Get number original energy points */
NES = (long)XSS[L0];
CheckValue(FUNCTION_NAME, "NES", " (dosimetry)", NES, 0, INFTY);
/* Allocate memory for data */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Reaction index (used for energy distributions) */
WDB[rea + REACTION_NR] = (double)nr;
/* Set mt */
WDB[rea + REACTION_MT] = (double)mt;
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Store minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[L0 + 1];
WDB[rea + REACTION_EMAX] = XSS[L0 + NES];
/* Compare to nuclide-wise values */
if (RDB[rea + REACTION_EMIN] < RDB[nuc + NUCLIDE_EMIN])
WDB[nuc + NUCLIDE_EMIN] = RDB[rea + REACTION_EMIN];
if (RDB[rea + REACTION_EMAX] > RDB[nuc + NUCLIDE_EMAX])
WDB[nuc + NUCLIDE_EMAX] = RDB[rea + REACTION_EMAX];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(L0 + 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(L0 + NES + 1);
/* Set reaction type */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
}
/**********************************************************************/
}
else if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_SAB)
{
/**********************************************************************/
/***** S(a,b) data ****************************************************/
/* Set S(a,b) flag */
SetOption(nuc + NUCLIDE_TYPE_FLAGS, NUCLIDE_FLAG_SAB_DATA);
/* Number of reaction modes */
if (JXS[3] - 1 > 0)
NTR = 2;
else
NTR = 1;
/* Reset nuclide energy boundaries */
WDB[nuc + NUCLIDE_EMIN] = INFTY;
WDB[nuc + NUCLIDE_EMAX] = -INFTY;
/* Avoid compiler warning */
Emax = -1.0;
/* Loop over reaction channels */
for (nr = 0; nr < NTR; nr++)
{
/* Pointer to (in)elastic data (Table F-23, page F-36) */
if (nr == 0)
L0 = JXS[0] - 1;
else
L0 = JXS[3] - 1;
/* Get number of energy points */
NES = (long)XSS[L0];
/* Allocate memory for reaction data */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Set mt */
if (nr == 0)
WDB[rea + REACTION_MT] = 1004.0;
else
WDB[rea + REACTION_MT] = 1002.0;
/* Set interpolation mode */
if ((nr == 1) && (NXS[4] == 4))
WDB[rea + REACTION_ITP] = 4.0;
else
WDB[rea + REACTION_ITP] = 0.0;
/* Store minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[L0 + 1];
WDB[rea + REACTION_EMAX] = XSS[L0 + NES];
/* Reset minimum and maximum emission energy */
WDB[rea + REACTION_SAB_MIN_EM_E] = INFTY;
WDB[rea + REACTION_SAB_MAX_EM_E] = -INFTY;
/* Maximum S(a,b) energy (needed to get the extra point in */
/* elastic channel */
if (nr == 0)
Emax = XSS[L0 + NES];
else if (Emax < XSS[L0 + NES])
Emax = XSS[L0 + NES];
/* Store */
WDB[rea + REACTION_SAB_EMAX] = Emax;
/* Compare to nuclide minimum */
if (RDB[rea + REACTION_EMIN] < RDB[nuc + NUCLIDE_EMIN])
WDB[nuc + NUCLIDE_EMIN] = RDB[rea + REACTION_EMIN];
/* Compare to nuclide maximum */
if (RDB[rea + REACTION_EMAX] > RDB[nuc + NUCLIDE_EMAX])
WDB[nuc + NUCLIDE_EMAX] = RDB[rea + REACTION_EMAX];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(L0 + 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = 0.0;
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(L0 + 1 + NES);
/* Reset ures energy boundaries */
WDB[rea + REACTION_URES_EMIN] = INFTY;
WDB[rea + REACTION_URES_EMAX] = -INFTY;
/* Store Q-value */
WDB[rea + REACTION_Q] = 0.0;
/* Multiplication and frame of reference */
WDB[rea + REACTION_TY] = 1.0;
WDB[rea + REACTION_WGT_F] = 1.0;
/* Set branching fraction to 1.0 */
WDB[rea + REACTION_BR] = 1.0;
/* Set type */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
}
/**********************************************************************/
}
else if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_PHOTON)
{
/**********************************************************************/
/***** Photon interaction data ****************************************/
/* Number of energy points */
NES = NXS[2];
/* Put pointer to nuclide energy grid and nuber of points */
WDB[nuc + NUCLIDE_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[nuc + NUCLIDE_EGRID_NE] = NES;
/* Compare minimum and maximum value to XS limits */
if (exp(XSS[JXS[0] - 1]) < RDB[DATA_PHOTON_XS_EMIN])
WDB[DATA_PHOTON_XS_EMIN] = exp(XSS[JXS[0] - 1]);
if (exp(XSS[JXS[0] + NES - 2]) > RDB[DATA_PHOTON_XS_EMAX])
WDB[DATA_PHOTON_XS_EMAX] = exp(XSS[JXS[0] + NES - 2]);
/* Loop over 4 reaction modes (incoherent, coherent, photoelectric */
/* and pair production) and average heating numbers. */
for (nr = 0; nr < 5; nr++)
{
/* Add reaction */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Reaction index (used for energy distributions) */
WDB[rea + REACTION_NR] = -1.0;
/* Put type */
if (nr < 4)
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
else
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Put mt */
if (nr == 0)
WDB[rea + REACTION_MT] = 504.0;
else if (nr == 1)
WDB[rea + REACTION_MT] = 502.0;
else if (nr == 2)
WDB[rea + REACTION_MT] = 522.0;
else if (nr == 3)
WDB[rea + REACTION_MT] = 516.0;
else if (nr == 4)
WDB[rea + REACTION_MT] = 301.0;
/* Set minimum and maximum energy */
WDB[rea + REACTION_EMIN] = exp(XSS[JXS[0] - 1]);
WDB[rea + REACTION_EMAX] = exp(XSS[JXS[0] + NES - 2]);
WDB[nuc + NUCLIDE_EMIN] = exp(XSS[JXS[0] - 1]);
WDB[nuc + NUCLIDE_EMAX] = exp(XSS[JXS[0] + NES - 2]);
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = 0.0;
/* Store pointer to XS data */
if (nr < 4)
WDB[rea + REACTION_PTR_XS] = (double)(JXS[0] - 1 + (nr + 1)*NES);
else
WDB[rea + REACTION_PTR_XS] = (double)(JXS[4] - 1);
/* Multiplication */
WDB[rea + REACTION_WGT_F] = 1.0;
}
/**********************************************************************/
}
else if ((long)RDB[nuc + NUCLIDE_TYPE] == NUCLIDE_TYPE_DECAY)
{
/**********************************************************************/
/***** Transmutation data *********************************************/
/* Check ace type */
if ((long)ACE[ace + ACE_TYPE] != NUCLIDE_TYPE_TRANSMUXS)
Die(FUNCTION_NAME, "Invalid ace type");
/* Number of energy points */
NES = NXS[2];
/* Put pointer to nuclide energy grid and nuber of points */
WDB[nuc + NUCLIDE_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[nuc + NUCLIDE_EGRID_NE] = NES;
/* Set minimum and maximum energy */
WDB[nuc + NUCLIDE_EMIN] = XSS[JXS[0] - 1];
WDB[nuc + NUCLIDE_EMAX] = XSS[JXS[0] + NES - 2];
/* Get number of reactions (minus elastic scattering). Include */
/* only elastic scattering for DBRC nuclides. */
NTR = NXS[3];
/* Loop over reaction channels */
for (nr = 0; nr < NTR; nr++)
{
/* Get pointer to SIG-block (Table F-10, page F-17) */
L = (long)XSS[JXS[5] - 1 + nr] + JXS[6] - 1;
/* Get number of energy points */
NES = (long)XSS[L];
/* Pointer to energy array (tää vaikuttaa epäilyttävältä) */
L0 = JXS[0] - 1 + NXS[2] - NES;
/* Get mt */
mt = (long)XSS[JXS[2] + nr - 1];
/* Check number of energy points and mt (ei fissiota nyt) */
if ((NES > 0) && ((mt > 101) && (mt < 200)))
{
/* Allocate memory */
rea = NewItem(nuc + NUCLIDE_PTR_REA, REACTION_BLOCK_SIZE);
/* Put nuclide pointer */
WDB[rea + REACTION_PTR_NUCLIDE] = (double)nuc;
/* Put mt */
WDB[rea + REACTION_MT] = (double)mt;
/* Store minimum and maximum energy */
WDB[rea + REACTION_EMIN] = XSS[L0];
WDB[rea + REACTION_EMAX] = XSS[L0 + NES - 1];
/* Store number of energy points, pointer to grid and */
/* index to first point */
WDB[rea + REACTION_PTR_EGRID] = (double)(JXS[0] - 1);
WDB[rea + REACTION_XS_NE] = (double)NES;
WDB[rea + REACTION_XS_I0] = (double)(NXS[2] - NES);
/* Store pointer to XS data */
WDB[rea + REACTION_PTR_XS] = (double)(L + 1);
/* Put awr */
WDB[rea + REACTION_AWR] = RDB[nuc + NUCLIDE_AWR];
/* Store Q-value */
WDB[rea + REACTION_Q] = XSS[JXS[3] - 1 + nr];
/* Multiplication and frame of reference */
WDB[rea + REACTION_TY] = XSS[JXS[4] - 1 + nr];
/* Check known error in ACE files (jos fissio joskus lisätään) */
if ((XSS[JXS[4] - 1 + nr] == 0.0) &&
(((mt > 17) && (mt < 22)) || (mt == 38)))
{
/* Print warning */
#ifdef DEBUG
Warn(FUNCTION_NAME,
"Conflicting reaction type for fission (%s mt %ld)",
GetText(nuc + NUCLIDE_PTR_NAME), mt);
#endif
/* Set ty for fission */
WDB[rea + REACTION_TY] = 19.0;
}
/* Set branching fraction to 1.0 */
WDB[rea + REACTION_BR] = 1.0;
/* Set type */
WDB[rea + REACTION_TYPE] = (double)REACTION_TYPE_PARTIAL;
}
}
/**********************************************************************/
}
else
Die(FUNCTION_NAME, "Invalid nuclide type (%s)", name);
/**************************************************************************/
/***** Remove redundant reaction modes ************************************/
rea = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (rea > VALID_PTR)
{
/* Redundant (n,p) */
if ((long)RDB[rea + REACTION_MT] == 103)
{
/* Loop over reactions */
ptr = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (ptr > VALID_PTR)
{
/* Check mt and set type to special */
if (((long)RDB[ptr + REACTION_MT] > 599) &&
((long)RDB[ptr + REACTION_MT] < 650))
WDB[ptr + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Next reaction */
ptr = NextItem(ptr);
}
}
/* Redundant (n,d) */
if ((long)RDB[rea + REACTION_MT] == 104)
{
/* Loop over reactions */
ptr = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (ptr > VALID_PTR)
{
/* Check mt and set type to special */
if (((long)RDB[ptr + REACTION_MT] > 649) &&
((long)RDB[ptr + REACTION_MT] < 700))
WDB[ptr + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Next reaction */
ptr = NextItem(ptr);
}
}
/* Redundant (n,t) */
if ((long)RDB[rea + REACTION_MT] == 105)
{
/* Loop over reactions */
ptr = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (ptr > VALID_PTR)
{
/* Check mt and set type to special */
if (((long)RDB[ptr + REACTION_MT] > 699) &&
((long)RDB[ptr + REACTION_MT] < 750))
WDB[ptr + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Next reaction */
ptr = NextItem(ptr);
}
}
/* Redundant (n,He-3) */
if ((long)RDB[rea + REACTION_MT] == 106)
{
/* Loop over reactions */
ptr = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (ptr > VALID_PTR)
{
/* Check mt and set type to special */
if (((long)RDB[ptr + REACTION_MT] > 749) &&
((long)RDB[ptr + REACTION_MT] < 800))
WDB[ptr + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Next reaction */
ptr = NextItem(ptr);
}
}
/* Redundant (n,a) */
if ((long)RDB[rea + REACTION_MT] == 107)
{
/* Loop over reactions */
ptr = (long)RDB[nuc + NUCLIDE_PTR_REA];
while (ptr > VALID_PTR)
{
/* Check mt and set type to special */
if (((long)RDB[ptr + REACTION_MT] > 799) &&
((long)RDB[ptr + REACTION_MT] < 850))
WDB[ptr + REACTION_TYPE] = (double)REACTION_TYPE_SPECIAL;
/* Next reaction */
ptr = NextItem(ptr);
}
}
/* Next reaction */
rea = NextItem(rea);
}
/**************************************************************************/
/* Close file */
fclose(fp);
}
void ProcessTmpData()
{
long nuc, nuc0, rea, rea0, ptr, ne;
double maxT;
/* Check DBRC and TMS modes */
if (((long)RDB[DATA_USE_DBRC] == NO) &&
((long)RDB[DATA_TMS_MODE] == TMS_MODE_NONE))
return;
/***************************************************************************/
/***** DBRC data ***********************************************************/
/* Reset DBRC flag */
WDB[DATA_USE_DBRC] = (double)NO;
/* Loop over nuclides with DBRC data */
nuc0 = (long)RDB[DATA_PTR_NUC0];
while (nuc0 > VALID_PTR)
{
/* Check DBRC flag */
if ((long)RDB[nuc0 + NUCLIDE_TYPE_FLAGS] & NUCLIDE_FLAG_DBRC)
{
/* Check cross section temperature */
if (RDB[nuc0 + NUCLIDE_XS_TEMP] != 0.0)
Die(FUNCTION_NAME, "DBRC nuclide %s above 0K temperature",
GetText(nuc0 + NUCLIDE_PTR_NAME));
/* Reset maximum temperature */
maxT = -INFTY;
/* Find nuclides with same ZAI */
nuc = (long)RDB[DATA_PTR_NUC0];
while (nuc > VALID_PTR)
{
/* Compare ZAI */
if ((RDB[nuc0 + NUCLIDE_ZAI] == RDB[nuc + NUCLIDE_ZAI]) &&
(!((long)RDB[nuc + NUCLIDE_TYPE_FLAGS] & NUCLIDE_FLAG_DBRC)))
{
/* Compare maximum temperature */
if (RDB[nuc + NUCLIDE_XS_TEMP] > maxT)
maxT = RDB[nuc + NUCLIDE_XS_TEMP];
if (RDB[nuc + NUCLIDE_TMS_MAX_TEMP] > maxT)
maxT = RDB[nuc + NUCLIDE_TMS_MAX_TEMP];
/* Pointers to elastic cross section */
rea0 = (long)RDB[nuc0 + NUCLIDE_PTR_ELAXS];
CheckPointer(FUNCTION_NAME, "(rea0)", DATA_ARRAY, rea0);
rea = (long)RDB[nuc + NUCLIDE_PTR_ELAXS];
CheckPointer(FUNCTION_NAME, "(rea)", DATA_ARRAY, rea);
/* Link reaction channels */
WDB[rea + REACTION_PTR_0K_DATA] = (double)rea0;
}
/* Next nuclide */
nuc = NextItem(nuc);
}
/* Check temperature */
if (maxT < 0.0)
{
/* Reset DBRC flag */
ResetOption(nuc0 + NUCLIDE_TYPE_FLAGS, NUCLIDE_FLAG_DBRC);
/* Pointer to next nuclide */
nuc0 = NextItem(nuc0);
/* Cycle loop */
continue;
}
/* Set DBRC flag */
WDB[DATA_USE_DBRC] = (double)YES;
/* Set maximum temperature (this will cause the nuclide to be */
/* included in the next loop) */
WDB[nuc0 + NUCLIDE_DBRC_MAX_TEMP] = maxT;
}
/* Next nuclide */
nuc0 = NextItem(nuc0);
}
/***************************************************************************/
/**** Allocate memory for majorant reactions *******************************/
/* Loop over nuclides */
nuc0 = (long)RDB[DATA_PTR_NUC0];
while (nuc0 > VALID_PTR)
{
/* Pointer to elastic or total cross section */
if ((long)RDB[nuc0 + NUCLIDE_TYPE_FLAGS] & NUCLIDE_FLAG_DBRC)
rea0 = (long)RDB[nuc0 + NUCLIDE_PTR_ELAXS];
else if (((long)RDB[nuc0 + NUCLIDE_TYPE_FLAGS] & NUCLIDE_FLAG_TMS) &&
((long)RDB[nuc0 + NUCLIDE_TYPE] != NUCLIDE_TYPE_DECAY))
rea0 = (long)RDB[nuc0 + NUCLIDE_PTR_TOTXS];
else
{
/* Pointer to next */
nuc0 = NextItem(nuc0);
/* Cycle loop */
continue;
}
/* Check pointer */
CheckPointer(FUNCTION_NAME, "(rea0)", DATA_ARRAY, rea0);
/* Duplicate reaction channel */
rea = DuplicateItem(rea0);
/* Allocate memory for previous values */
WDB[rea + REACTION_PTR_PREV_XS] = NULLPTR;
AllocValuePair(rea + REACTION_PTR_PREV_XS);
/* Disable cache optimization mode */
WDB[rea + REACTION_CACHE_OPTI_IDX] = -1.0;
/* Get number of energy points */
ne = (long)RDB[rea0 + REACTION_XS_NE];
CheckValue(FUNCTION_NAME, "ne", "", ne, 10, 50000000);
/* Allocate memory for data */
ptr = ReallocMem(DATA_ARRAY, ne);
WDB[rea + REACTION_PTR_XS] = (double)ptr;
/* Remove reaction from list */
RemoveItem(rea);
/* Put pointer */
WDB[rea0 + REACTION_PTR_TMP_MAJORANT] = (double)rea;
/* Next nuclide */
nuc0 = NextItem(nuc0);
}
/* Calculate majorant cross sections */
TmpMajorants();
}
