From 7dfcc480ba1e19bd3232349fc733caef94034292 Mon Sep 17 00:00:00 2001
From: stainer_t <thomas.stainer@oecd-nea.org>
Date: Mon, 8 Sep 2025 13:48:49 +0200
Subject: Initial commit from Polytechnique Montreal

---
 Dragon/src/xsdf.c | 1026 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 1026 insertions(+)
 create mode 100644 Dragon/src/xsdf.c

(limited to 'Dragon/src/xsdf.c')

diff --git a/Dragon/src/xsdf.c b/Dragon/src/xsdf.c
new file mode 100644
index 0000000..a1f759b
--- /dev/null
+++ b/Dragon/src/xsdf.c
@@ -0,0 +1,1026 @@
+
+/***************************************/
+/* Fortran bindings for the NDAS C API */
+/* Copyright: Peter J. Laughton, AECL  */
+/***************************************/
+
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include "xsdbops.h"
+#include "sdbm.h"
+#include "xsdb-defs.h"
+
+static char AbortString[132];
+static int packIndex;
+typedef enum {Int, Float, Char8} PackType;
+static char *packedBurnupData=0;
+static char AbortString[132];
+
+typedef struct {
+  int ib1, ib2;
+  float rb1, rb2;
+} BurnQuad;
+
+typedef struct {
+  /* From subinx.inc: NBURN, ISOID, AW, IAN, NFISS, NTEMP, NR,
+     NSUBNK, NNA, NP1, NFSPEC, IENDFB */
+     /* nomenclature of crnl-2866, page 3 */
+
+  int nburn;
+  int numericId;		
+  float aw;
+  int iz;
+  int nf;
+  int nt;
+  int nr;
+  int ndat2;			/* not in xs block on unf-seq file */
+  int ndat3;                 /* not in xs block on unf-seq file */
+  int np1;
+  int ns;
+  int iendfb;                /* not in xs block on unf-seq file */
+  char name[9];
+  int installed;             /* flagged true when all of this block has been loaded */
+  BurnQuad *burnQuad;
+} Nuclide;
+
+Nuclide *nuclide;		/* array of all nuclides */
+
+static int nLoadedNuclides=0;	/* number actually available */
+static int lastNuclideAccessed=0; /* library index (1,...,nel) of last nuclide accessed */
+
+typedef struct {
+  int code;
+  char *name;
+} CodeNamePair;
+
+static CodeNamePair itemMap[]={
+  {BickleyFunctionTablesKi3, "BickleyFunctionTablesKi3"},
+  {BickleyFunctionTablesKi35, "BickleyFunctionTablesKi35"},
+  {BurnCount, "BurnCount"},
+  {BurnInteger, "BurnInteger"},
+  {BurnReal, "BurnReal"},
+  {Absorption, "Absorption"},
+  {Transport, "Transport"},
+  {Fission, "Fission"},
+  {NuFission, "NuFission"},
+  {N2n, "N2n"},
+  {FissionSpectrum, "FissionSpectrum"},
+  {PotScatSlowingDown, "PotScatSlowingDown"},
+  {LengthsThermalP0, "LengthsThermalP0"},
+  {GCLambda, "GCLambda"},
+  {Header, "Header"},
+  {ResHeader, "ResHeader"},
+  {LengthsScatP1, "LengthsScatP1"},
+  {ScatP0, "ScatP0"},
+  {ScatP1, "ScatP1"},
+  {ThermalXSTemp, "ThermalXSTemp"},
+  {ThermalP1Temp, "ThermalP1Temp"},
+  {GroupBoundaries, "GroupBoundaries"},
+  {PotScat, "PotScat"},
+  {NJOYFlux, "NJOYFlux"},
+  {Hequivalence, "Hequivalence"},
+  {HeqHeader, "HeqHeader"},
+  {TransportCorrection, "TransportCorrection"}
+};
+
+static char *unknownMessage="--unknown--";
+
+#define NITEMS (sizeof(itemMap)/sizeof(CodeNamePair))
+
+char *itemName(int code) {
+  int i;
+  for (i=0; i<NITEMS; i++) {
+    if (itemMap[i].code == code)
+      return itemMap[i].name;
+  }
+  return unknownMessage;
+}
+
+#ifdef VerboseXSDB
+static int verbose=1;
+#else
+static int verbose=0;
+#endif
+
+typedef int DBItem;		/* fortran integer type */
+
+static FILE *logFile=0;
+static FILE *indexFile;
+
+/* constant parameters local to this file */
+
+static int nel;
+static int ng, ng0, ng1, ng2, ng3; 
+static int nnfpd;
+static int p1NuclideCount;
+static int fissileNuclideCount;
+static int n1rc, m1rc, n1m1rc, nresmc, lsctfl;
+static int jp0max, jp1max;
+
+/* Prototypes of functions that appears below: */
+
+int nuclideId(char *name);
+int nuclideIndex(char *name);
+int bcodeNumber(char *bname);
+void unpackBD(void *ptr, PackType type);
+
+#define CAPTURE  1
+#define DECAY    2
+#define FISSPROD 3
+#define FISSION  4
+#define N2N      5
+#define min_macro(A,B)  ((A) < (B) ? (A) : (B))
+#define MAKE_ARRAY(thing,number) \
+               ((thing *) calloc((unsigned) (number),sizeof(thing)))
+
+void xsdopn_c(char *nomC, int *status)
+{
+  int i;
+  int endFlag;
+  int nbytes;
+  char *flist, *idxfn;
+  logFile=fopen("xsdb.log","w");
+  if (verbose) {
+    fprintf(logFile,"In XSDOPN open file -->%s<--\n",nomC);
+    fflush(logFile);
+  }
+  flist=strchr(nomC,':');
+  if(!flist) {
+    fprintf(logFile,"index file missing; namfil=%s\n",nomC);
+    *status=OPEN_FAILURE;
+    return;
+  } 
+  flist++;
+  xsdbReadInit(flist,status);
+  if (*status) 		/* non-zero means something is wrong */
+    return;
+
+  idxfn=strtok(nomC,":\n");
+
+  indexFile=fopen(idxfn,"r");
+  if (!indexFile) {
+    perror(idxfn);
+    fprintf(logFile,"open failure for index file %s\n",idxfn);
+    *status=OPEN_FAILURE;
+    return;
+  }
+
+  if(fscanf(indexFile,"%d",&nel) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&ng) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&ng0) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&ng1) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&ng2) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&ng3) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&fissileNuclideCount) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&nnfpd) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&p1NuclideCount) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&nresmc) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&n1rc) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&m1rc) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&n1m1rc) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&lsctfl) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&jp0max) == EOF) goto L10;
+  if(fscanf(indexFile,"%d",&jp1max) == EOF) goto L10;
+
+  nuclide=MAKE_ARRAY(Nuclide,nel);
+
+  if (!nuclide) {
+    fprintf(logFile,"error:  memory allocation failure\n");
+    exit(1);
+  }
+
+  for (i=0; i<nel; i++) {
+    if(fscanf(indexFile,"%s %d",nuclide[i].name,&nuclide[i].numericId) == EOF) goto L10;
+    nuclide[i].installed=0;
+    nuclide[i].nburn=0;  /* default length of burnup data record */
+  }
+
+  fclose(indexFile);
+
+  packedBurnupData=xsdbRetrieveItem("BurnupData", &nbytes, verbose);
+
+  packIndex=0;
+  endFlag=0;
+  do {
+    char thisNuclideName[9];
+    char type[9];
+    int thisNburn;
+    int sourceIndex;
+    int bcode;
+
+    if (packIndex==nbytes) {
+      endFlag=1;
+      continue;
+    }
+
+    unpackBD(thisNuclideName,Char8);
+    unpackBD(&thisNburn,Int);
+
+    if (thisNburn==0)	/* no burnup data follows */
+      continue;
+    sourceIndex=nuclideIndex(thisNuclideName);
+
+    if (sourceIndex == -1) {
+      *status=UnknownRequest;
+      return;
+    }
+
+    nuclide[sourceIndex].nburn=thisNburn;
+    nuclide[sourceIndex].burnQuad=MAKE_ARRAY(BurnQuad,thisNburn);
+
+    if (!nuclide[sourceIndex].burnQuad) {
+      fprintf(logFile,"error:  memory allocation failure\n");
+      exit(1);
+    }
+
+    for (i=0; i<thisNburn; i++) {
+      unpackBD(type,Char8);
+      bcode=bcodeNumber(type);
+
+      if (bcode== -1) {
+	*status=UnknownRequest;
+	return;
+      }
+
+      nuclide[sourceIndex].burnQuad[i].ib2=bcode;
+
+      if (bcode==FISSION) {
+	unpackBD(&nuclide[sourceIndex].burnQuad[i].ib1,Int);
+	unpackBD(&nuclide[sourceIndex].burnQuad[i].rb1,Float);
+	unpackBD(&nuclide[sourceIndex].burnQuad[i].rb2,Float);
+      } else {
+	unpackBD(thisNuclideName,Char8);
+	unpackBD(&nuclide[sourceIndex].burnQuad[i].rb1,Float);
+	unpackBD(&nuclide[sourceIndex].burnQuad[i].rb2,Float);
+
+	nuclide[sourceIndex].burnQuad[i].ib1=nuclideId(thisNuclideName);
+
+	if (nuclide[sourceIndex].burnQuad[i].ib1== -1) {
+	  *status=UnknownNuclide;
+	  return;
+	}
+      }
+    }
+  } while (!endFlag);
+
+  free(packedBurnupData);
+
+  *status=NORMAL;
+  return;
+L10:
+  printf("\n XSDF error: fscanf failure --\n");
+  fflush(stdout);
+  exit(1);
+}
+
+void xsdcl_c()
+{
+  int irc;
+  closeSDBRead();
+  irc = fclose(logFile);
+  if (irc != 0) perror ("close error of xsdb.log ");  
+  }
+
+void xsdnam_c(int *iset, int *numericId, char *isonam, int *status)
+{
+  char *nomsub="XSDNAM";
+  char *cp;
+  int j, len;
+
+  if (verbose) {
+    fprintf(logFile,"In xsdbnam...\n");
+    fflush(logFile);
+  }
+
+  if (*iset-1 > nel) {
+    sprintf(AbortString,"%s: Insufficent allocation to hold isotope names",nomsub);
+    *status=RECORD_INDEX_OVERFLOW;
+    return;
+  }
+
+  if (verbose) {
+    fprintf(logFile,"%10s %d\n",nuclide[*iset-1].name,nuclide[*iset-1].numericId);
+    fflush(logFile);
+  }
+  *numericId=nuclide[*iset-1].numericId;
+  
+  len=strlen(nuclide[*iset-1].name);
+  cp=isonam;
+  for (j=0; j<len; j++) {
+    *cp=nuclide[*iset-1].name[j];
+    cp++;
+  }
+  *cp='\0';
+
+  *status=NORMAL;
+}
+
+void xsdbld_c(DBItem *item, int *where, int *status) {
+  float *fp, *fpTarget;
+  int *ip, *ipTarget;
+  int nbytes;
+  int i;
+
+  if (verbose) {
+    fprintf(logFile,"In xsdbl with item %25s and location %016llX\n",
+	    itemName(*item),(long long)where);
+    fflush(logFile);
+  }
+
+  switch (*item) {
+
+  case FissionSpectrum:	/* library default fission spectrum */
+    fp=xsdbRetrieveItem("FissionSpectrum", &nbytes, verbose);
+    if (nbytes/4 != ng0) {
+      fprintf(logFile,"warning:  fission-spectrum vector length mismatch\n");
+    }
+    fpTarget=(float *) where;
+    for (i=0, fpTarget=(float *)where; i<ng0; i++, fpTarget++) {
+      *fpTarget=fp[i];
+    }
+    free(fp);
+    break;
+
+  case Header:
+    ipTarget=(int *) where;
+    ipTarget[0]=nel;
+    ipTarget[1]=ng;
+    ipTarget[2]=ng0;
+    ipTarget[3]=ng1;
+    ipTarget[4]=ng2;
+    ipTarget[5]=ng3;
+    ipTarget[6]=fissileNuclideCount;
+    ipTarget[7]=nnfpd;
+    ipTarget[8]=p1NuclideCount;
+    ipTarget[9]=nresmc;
+    ipTarget[10]=n1rc;
+    ipTarget[11]=m1rc;
+    ipTarget[12]=n1m1rc;
+    ipTarget[13]=lsctfl;
+    ipTarget[14]=jp0max;
+    ipTarget[15]=jp1max;
+    break;
+
+  case ResHeader:
+    ip=xsdbRetrieveItem("ResHeader", &nbytes, verbose);
+    ipTarget=(int *) where;
+    for (i=0; i<nbytes/4; i++) {
+      ipTarget[i]=ip[i];
+    }
+    free(ip);
+    break;
+
+  case GroupBoundaries:
+    fp=xsdbRetrieveItem("GroupBoundaries", &nbytes, verbose);
+    if (nbytes/4 != ng+1) {
+      fprintf(logFile,"warning:  group-boundary vector length mismatch\n");
+    }
+    fpTarget=(float *) where;
+    for (i=0, fpTarget=(float *)where; i<ng+1; i++, fpTarget++) {
+      *fpTarget=fp[i];
+    }
+    free(fp);
+    break;
+
+  default:
+    fprintf(logFile,"Serious error: unknown xsdb request %d!\n",*item);
+    *status=UnknownRequest;
+    return;
+  }
+  *status=NORMAL;
+}
+
+void xsdiso_c(int *groupRange, DBItem *item, int *nuclideIndex, int *where, int *status)
+{
+  float *fp, *fpTarget;
+  int *ip, *ipTarget;
+  int nbytes;
+  int i;
+  int j;
+  fpTarget=(float *)where;
+  ipTarget=(int *)where;
+  j=*nuclideIndex;
+
+  if (j==LastNuclideAccessed)
+    j=lastNuclideAccessed;
+  else
+    lastNuclideAccessed=j;
+  j--;			/* offset now */
+
+  if (verbose) {
+    if (nuclide[j].installed)
+      fprintf(logFile,"In xsdbloadnuclide with item %25s, nuclide %10s (%5d) and location %016llX\n",
+	      itemName(*item),nuclide[j].name,j+1,(long long)where);
+    else
+      fprintf(logFile,"In xsdbloadnuclide with item %25s, nuclide %5d and location %016llX\n",
+	      itemName(*item),j+1,(long long)where);
+    fflush(logFile);
+  }
+
+  switch (*item) {
+
+  case BurnCount:
+    ipTarget[0]=nuclide[j].nburn;
+    break;
+
+  case BurnInteger:
+    if (verbose)
+      fprintf(logFile,"Nuclide index %3d (%s)\n",j,nuclide[j].name);
+    for (i=0; i<nuclide[j].nburn; i++) {
+      ipTarget[i*2]=nuclide[j].burnQuad[i].ib1;
+      ipTarget[i*2+1]=nuclide[j].burnQuad[i].ib2;
+    }
+    break;
+
+  case BurnReal:
+    for (i=0; i<nuclide[j].nburn; i++) {
+      fpTarget[i*2]=nuclide[j].burnQuad[i].rb1;
+      fpTarget[i*2+1]=nuclide[j].burnQuad[i].rb2;
+    }
+    break;
+
+  case GCLambda:
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "GCLambda/Res",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i]; 
+    free(fp);
+    break;
+
+  case Transport:
+
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "Transport/Epithermal",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case Absorption:
+
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "ParticleBalance/Epithermal",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case TransportCorrection:
+
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "TransportCorrection/Epithermal",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case Fission:
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "Fission/Epithermal",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case NuFission:
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "NuFission/Epithermal",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case N2n:
+
+    switch(*groupRange) {
+
+    case Fast:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "n2n/Fast",&nbytes,verbose);
+      for (i=0; i< nbytes/4; i++) 
+	fpTarget[i]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case FissionSpectrum:	/* read NGFISS chi values */
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "FissionSpectrum",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case PotScatSlowingDown:	
+
+    /* potential scattering and slowing-down power back-to-back.  */
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "PotScat/Res",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "SDP/Res",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[ng2+i]=fp[i];
+    free(fp);
+    break;
+
+  case PotScat:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "PotScat/Res",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case LengthsThermalP0:     /* includes only the thermal-scattering lengths */
+
+    ip=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "LThermalP0",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      ipTarget[i]=ip[i];
+    free(ip);
+    break;
+
+  case LengthsScatP1:        /* includes the epithermal length, too, at the end */
+
+    ip=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "LScatP1",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      ipTarget[i]=ip[i];
+    free(ip);
+    break;
+
+  case ScatP0:
+
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "ScatP0/Epithermal",&nbytes,verbose);
+      for (i=1; i< nbytes/4; i++) /* first element holds ndat; skip it */
+	fpTarget[i-1]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case ScatP1:
+
+    switch(*groupRange) {
+
+    case FastRes:
+      fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+				 "ScatP1/Epithermal",&nbytes,verbose);
+      for (i=1; i< nbytes/4; i++) /* first element holds ndat; skip it */
+	fpTarget[i-1]=fp[i];
+      break;
+
+    default:
+      fprintf(logFile,"error:  unknown groupRange request\n");
+      exit(1);
+    }
+    free(fp);
+    break;
+
+  case ThermalXSTemp:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case ThermalP1Temp:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalP1Temp",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case HeqHeader:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "HeqHeader",&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case Header:
+    if ( !nuclide[j].installed) {
+      ip=xsdbRetrieveNuclideItem(nuclide[j].name,"Header",&nbytes,verbose);
+      fp=(float *)ip;
+      nuclide[j].numericId=ip[0];
+      nuclide[j].aw=fp[1];
+      nuclide[j].iz=ip[2];
+      nuclide[j].nf=ip[3];
+      nuclide[j].nt=ip[4];
+      nuclide[j].nr=ip[5];
+      nuclide[j].ndat2=0; /* temporary -- ndat2, length of epithermal P0 scat rec */
+      nuclide[j].ndat3=0; /* temporary -- ndat3, length of nt'th thermal P0 scat rec */
+      nuclide[j].np1=ip[6];
+      nuclide[j].ns=ip[7];
+      nuclide[j].iendfb=ip[8];
+      nuclide[j].installed=1;
+      nLoadedNuclides++;
+      free(ip);
+    }
+    ipTarget[0]=nuclide[j].nburn;	
+    ipTarget[1]=nuclide[j].numericId;
+    fpTarget[2]=nuclide[j].aw;
+    ipTarget[3]=nuclide[j].iz;
+    ipTarget[4]=nuclide[j].nf;
+    ipTarget[5]=nuclide[j].nt;
+    ipTarget[6]=nuclide[j].nr;
+    ipTarget[7]=nuclide[j].ndat2;
+    ipTarget[8]=nuclide[j].ndat3;
+    ipTarget[9]=nuclide[j].np1;
+    ipTarget[10]=nuclide[j].ns;
+    ipTarget[11]=nuclide[j].iendfb;
+    break;
+
+  default:
+    fprintf(logFile,"Serious error: unknown xsdb request %d!\n",*item);
+    *status=UnknownRequest;
+    return;
+  }
+  *status=NORMAL;
+}
+
+#ifdef NotNow
+
+for (i=0; i<9; i++) {
+  fprintf(logFile,"%4d: %d\n",i,((int *)where)[i]);
+}
+for (i=9; i<2510; i++) {
+  fprintf(logFile,"%4d: %f\n",i,((float *)where)[i]);
+}
+
+#endif
+
+void xsdthe_c(int *groupRange, DBItem *item, int *nuclideIndex, int *index, int *where, int *status)
+{
+  float *fp, *fpTarget;
+  int nbytes;
+  int i,j;
+  float thisT;
+  fpTarget=(float *)where;
+  j=*nuclideIndex;
+
+  if (j==LastNuclideAccessed)
+    j=lastNuclideAccessed;
+  else
+    lastNuclideAccessed=j;
+  j--;			/* offset now */
+
+  if (verbose) {
+    if (nuclide[j].installed)
+      fprintf(logFile,"In xsdbloadnuclidetset with item %25s, nuclide %10s (%5d), index %5d, and location %016llX\n",
+	      itemName(*item),nuclide[j].name,j+1,*index,(long long)where);
+    else
+      fprintf(logFile,"In xsdbloadnuclidetset with item %25s, nuclide %5d index %5d, and location %016llX\n",
+	      itemName(*item),j+1,*index,(long long)where);
+    fflush(logFile);
+  }
+
+  switch (*item) {
+
+  case ScatP0:
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "ScatP0/Thermal",thisT,&nbytes,verbose);
+
+    for (i=1; i< nbytes/4; i++) 
+      fpTarget[i-1]=fp[i];
+    free(fp);
+    break;
+
+  case ScatP1:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalP1Temp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    if (verbose) {
+      fprintf(logFile,"read thermal P1 -- %d, %e\n",*index,thisT);
+      fflush(logFile);
+    }
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "ScatP1/Thermal",thisT,&nbytes,verbose);
+
+    for (i=1; i< nbytes/4; i++) 
+      fpTarget[i-1]=fp[i];
+    free(fp);
+    break;
+
+  case Absorption:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "ParticleBalance/Thermal",thisT,&nbytes,verbose);
+
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case NuFission:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "NuFission/Thermal",thisT,&nbytes,verbose);
+
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case Fission:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "Fission/Thermal",thisT,&nbytes,verbose);
+
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case Transport:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "Transport/Thermal",thisT,&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  case TransportCorrection:
+
+    fp=xsdbRetrieveNuclideItem(nuclide[j].name,
+			       "ThermalXSTemp",&nbytes,verbose);
+    thisT=fp[*index-1];
+    free(fp);
+
+    fp=xsdbRetrieveNuclideTempItem(nuclide[j].name,
+				   "TransportCorrection/Thermal",thisT,&nbytes,verbose);
+    for (i=0; i< nbytes/4; i++) 
+      fpTarget[i]=fp[i];
+    free(fp);
+    break;
+
+  default:
+
+    fprintf(logFile,"Serious error: unknown xsdb request %d!\n",*item);
+    *status=UnknownRequest;
+    return;
+  }
+  *status=NORMAL;
+}
+
+void xsdres_c(int *nuclideIndex, int *where, int *status)
+{
+  int i, j;
+  int nbytes;
+  float *fp, *fpTarget;
+  int *ip, *ipTarget;
+  fpTarget=(float *)where+2;
+  ipTarget=(int *)where;
+  j=*nuclideIndex;
+
+  if (j==LastNuclideAccessed)
+    j=lastNuclideAccessed;
+  else
+    lastNuclideAccessed=j;
+  j--;			/* offset now */
+
+  if (verbose) 
+    fprintf(logFile,"In XSDRES with nuclide %5d and location %016llX\n",j+1,(long long)where);
+
+  ip=xsdbRetrieveNuclideItem(nuclide[j].name,"ResHeader",&nbytes,verbose);
+  fp=(float *)ip+2;
+  ipTarget[0]=ip[0]; /* m1 */
+  ipTarget[1]=ip[1]; /* m2 */
+
+  for (i=0; i<ip[0]+ip[1]; i++)
+	fpTarget[i]=fp[i]; /* sigma-0 and T values */
+  free(ip);
+
+  *status=NORMAL;
+  return;
+}
+
+void xsdtab_c(DBItem *item, int *nuclideIndex, int *resGroup, int *where, int *status)
+{
+  int i, j;
+  int nbytes;
+  float *fp, *fpTarget;
+  fpTarget=(float *)where;
+  j=*nuclideIndex;
+
+  if (j==LastNuclideAccessed)
+    j=lastNuclideAccessed;
+  else
+    lastNuclideAccessed=j;
+  j--;			/* offset now */
+
+
+  if (verbose)
+    fprintf(logFile,"In XSDTAB with item %25s, nuclide %5d, resGroup %5d, and location %016llX\n",
+	    itemName(*item),j+1,*resGroup,(long long)where);
+
+  *status=UnknownNuclide;
+
+  switch (*item) {
+
+  case Absorption:
+    fp=xsdbRetrieveNuclideGroupItem(nuclide[j].name,
+				    "ResTable/ParticleBalance",*resGroup,
+				    &nbytes,verbose);
+    break;
+
+  case NuFission:
+    fp=xsdbRetrieveNuclideGroupItem(nuclide[j].name,
+				    "ResTable/NuFission",*resGroup,
+				    &nbytes,verbose);
+    break;
+
+  case ScatP0:
+    fp=xsdbRetrieveNuclideGroupItem(nuclide[j].name,
+				    "ResTable/ScatP0",*resGroup,
+				    &nbytes,verbose);
+    break;
+
+  case NJOYFlux:
+    fp=xsdbRetrieveNuclideGroupItem(nuclide[j].name,
+				    "ResTable/NJOYFlux",*resGroup,
+				    &nbytes,verbose);
+    break;
+
+  case Hequivalence:
+    fp=xsdbRetrieveNuclideGroupItem(nuclide[j].name,
+				    "Hequivalence",*resGroup,
+				    &nbytes,verbose);
+    break;
+
+  default:
+    fprintf(logFile,"Serious error: unknown xsdb request %d!\n",*item);
+    *status=UnknownRequest;
+    return;
+  }
+  for (i=0; i<nbytes/4; i++) {
+    fpTarget[i]=fp[i];
+  }
+  free(fp);
+  *status=NORMAL;
+  return;
+}
+
+static char *nullName="NULL";
+
+int nuclideId(char *name) {
+  int i;
+  if (!strcmp(name,nullName))
+    return 0;
+  for (i=0; i<nel; i++)
+    if (!strcmp(nuclide[i].name,name))
+      return nuclide[i].numericId;
+  return -1;
+}
+
+int nuclideIndex(char *name) {
+  int i;
+  for (i=0; i<nel; i++)
+    if (!strcmp(nuclide[i].name,name))
+      return i;
+  return -1;
+}
+
+static CodeNamePair btyp[]=
+{
+  {FISSION, "FISSION"},
+  {FISSPROD,"FISSPROD"},
+  {CAPTURE, "CAPTURE"},
+  {DECAY,   "DECAY"},
+  {N2N,     "N2N"},
+};
+
+int bcodeNumber(char *bname) {
+  int i;
+  for (i=0; i<5; i++)
+    if (!strcmp(btyp[i].name,bname))
+      return btyp[i].code;
+  return -1;
+}
+
+/* unpackBD unravels fragments in the burnup-data structure */
+
+void unpackBD(void *ptr, PackType type) {
+  char *cptr=ptr;
+  int i;
+  switch (type) {
+  case Char8:
+    cptr[8]='\0';
+    for (i=0; i<8; i++) {
+      if (packedBurnupData[packIndex+i]==' ')
+	cptr[i]='\0';
+      else
+	cptr[i]=packedBurnupData[packIndex+i];
+    }
+    packIndex+=8;
+    break;
+  case Int:
+  case Float:
+    for (i=0; i<4; i++) {
+      cptr[i]=packedBurnupData[packIndex+i];
+    }
+    packIndex+=4;
+    break;
+  }
+}
-- 
cgit v1.2.3