fapid_sff_wtracefi.cc

Go to the documentation of this file.

#define TF_FAPID_SFF_WTRACEFI_CC_VERSION \
  "TF_FAPID_SFF_WTRACEFI_CC   V1.0   "

#include <fapidxx/fapidsff.h>
#include <fapidxx/fileunit.h>
#include <fapidxx/helper.h>
#include <fapidxx/wid2container.h>
#include <fapidxx/error.h>

using namespace fapidxx;

int sff_wtracefi__(integer *lu, char *wid2line, integer *nsamp, real *fdata,
                   integer *idata, logical *last, integer *nline, char *lines,
                   char *cs, real *c1, real *c2, real *c3, integer *nstack,
                   integer *ierr, ftnlen wid2line_len,
                   ftnlen lines_len, ftnlen cs_len)
{
  int retval=0;
  *ierr=0;
  try {
    datrw::oanystream &os=ostreammanager(static_cast<int>(*lu));
    WID2container wid2c(wid2line, wid2line_len);
    unsigned int nsamples=static_cast<unsigned int>(*nsamp);
    os << wid2c.wid2;
    if (os.handlesinfo())
    {
      sff::INFO info;
      info.cs=sff::coosysID(*cs);
      info.cx=static_cast<double>(*c1);
      info.cy=static_cast<double>(*c2);
      info.cz=static_cast<double>(*c3);
      info.nstacks=static_cast<int>(*nstack);
      os << info;
    }
    if (os.handlestracefree())
    {
      sff::FREE tracefree=freeblock(nline, lines, lines_len);
      os << tracefree;
    }
    aff::LinearShape shape(0, nsamples-1, 0);
    datrw::Tfseries series(shape, aff::SharedHeap<real>(fdata, *nsamp));
    os << series;
    if (*last) ostreammanager.close(static_cast<int>(*lu));
  }
  catch (...) {
    *ierr=1;
  }
  return(retval);
} // int sff_wtracefi__

/* ----- END OF fapid_sff_wtracefi.cc ----- */