f77interface.cc

Go to the documentation of this file.

#define AFF_F77INTERFACE_CC_VERSION \
  "AFF_F77INTERFACE_CC   V1.2"

// include assertions
#include<aff/lib/error.h>
// include FortranArray stuff
#include<aff/fortranshape.h>
#include<aff/subarray.h>
#include<aff/shaper.h>
#include<aff/lib/checkedcast.h>

/*----------------------------------------------------------------------*/

// include interface prototypes
#include"f77proto.h"

/*----------------------------------------------------------------------*/

// get common block
#include"f77common_com.P"

/*----------------------------------------------------------------------*/

// f2c declarations
#include "f2c.h"

#ifdef __cplusplus
  extern "C" {
#endif

// include prototypes of Fortran subroutines
#include"f77procs.P"

int MAIN__() 
{
  AFF_abort("should never be called!");
}

#ifdef __cplusplus
  }
#endif

/*======================================================================*/

namespace f77interface {

int fill(const aff::Array<int>& a)
{
  aff::FortranArray<aff::Array<int> > fa(a);
  integer* pa=fa.castedpointer<integer>();
  integer n1=fa.last(0);
  integer n2=fa.last(1);
  integer n3=fa.last(2);
  integer l1=fa.dimlast(0);
  integer l2=fa.dimlast(1);
  integer l3=fa.dimlast(2);
  return(fill_(pa, &l1, &n1, &l2, &n2, &l3, &n3));
}

/*----------------------------------------------------------------------*/

int fillarray(const aff::Array<float>& v1,
              const aff::Array<float>& v2)
{
  aff::FortranArray<aff::Array<float> > fv1(v1),fv2(v2);
  real* p1=fv1.castedpointer<real>();
  real* p2=fv2.castedpointer<real>();
  integer n1=fv1.last(0);
  integer n2=fv2.last(0);
  return(fillarray_(p1, p2, &n1, &n2));
}

/*----------------------------------------------------------------------*/

Tcarray sums()
{
  typedef Tcarray::Tvalue Tcvalue;
  // prepare array that is large enough
  integer maxa,maxb;
  comdim_(&maxa, &maxb);
  Tcarray result(maxa);
  // prepare Fortran view
  aff::FortranArray<Tcarray> fa(result);
  complex* p=fa.castedpointer<complex>();
  integer size;
  sums_(p, &maxa, &size);
  return(aff::subarray(result)(size));
}

/*----------------------------------------------------------------------*/

Tzarray viewcommon()
{
  typedef Tzarray::Tvalue Tzvalue;
  typedef aff::util::SizeCheckedCast<doublecomplex, Tzvalue> Tcast;
  integer maxa,maxb;
  comdim_(&maxa, &maxb);
  Tzvalue* p=Tcast::cast(f77common_.array);
  // create a shape
  aff::Strided shape(aff::Shaper(1,f77common_.na,maxa)(1,f77common_.nb,maxb));
  // create a representation
  aff::SharedHeap<Tzvalue> repr(p, shape.memory_size());
  // create array and return
  return Tzarray(shape, repr);
}

} // namespace f77interface

/* ----- END OF f77interface.cc ----- */