arpackff.hpp

来自「FreeFem++可以生成高质量的有限元网格。可以用于流体力学」· HPP 代码 · 共 440 行 · 第 1/2 页

/*
  The freefem++ arpack interface without arpack ++ 
  aprack++ is do  too much c++ error  with modern  compiler
  but a by tanks  to arpack++ for the idea of this code
   F. Hecht. 
*/
//  Change V[1] -> V[0]
//  Change workev[1] -> workev[0]
#ifndef ARPACKFF_HPP
#define ARPACKFF_HPP
#include "error.hpp"

typedef int integer;
typedef int logical;

#define F77NAME(x) x ## _

#define HIDDEN_HBW ,int,int,int
#define HIDDEN_BW ,int,int
#define HIDDEN_12 ,1,2
#define HIDDEN_112 ,1,1,2


extern "C"
{
  /*
// debug "common" statement.

  struct { 
    integer logfil, ndigit, mgetv0;
    integer msaupd, msaup2, msaitr, mseigt, msapps, msgets, mseupd;
    integer mnaupd, mnaup2, mnaitr, mneigt, mnapps, mngets, mneupd;
    integer mcaupd, mcaup2, mcaitr, mceigt, mcapps, mcgets, mceupd;
  } F77NAME(debug);

  // add FH pour lib dynamic so win 32 
  struct { 
    integer           nopx, nbx, nrorth, nitref, nrstrt;
    float           tsaupd, tsaup2, tsaitr, tseigt, tsgets, tsapps, tsconv,
      tnaupd, tnaup2, tnaitr, tneigh, tngets, tnapps, tnconv,
      tcaupd, tcaup2, tcaitr, tceigh, tcgets, tcapps, tcconv,
      tmvopx, tmvbx, tgetv0, titref, trvec;
    
    
  } F77NAME(timing);

*/
// double precision symmetric routines.

  void F77NAME(dsaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, double *tol, double *resid,
                       integer *ncv, double *V, integer *ldv,
                       integer *iparam, integer *ipntr, double *workd,
                       double *workl, integer *lworkl, integer *info HIDDEN_BW);

  void F77NAME(dseupd)(logical *rvec, char *HowMny, logical *select,
                       double *d, double *Z, integer *ldz,
                       double *sigma, char *bmat, integer *n,
                       char *which, integer *nev, double *tol,
                       double *resid, integer *ncv, double *V,
                       integer *ldv, integer *iparam, integer *ipntr,
                       double *workd, double *workl,
                       integer *lworkl, integer *info HIDDEN_HBW );

// double precision nonsymmetric routines.

  void F77NAME(dnaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, double *tol, double *resid,
                       integer *ncv, double *V, integer *ldv,
                       integer *iparam, integer *ipntr, double *workd,
                       double *workl, integer *lworkl, integer *info HIDDEN_BW);

  void F77NAME(dneupd)(logical *rvec, char *HowMny, logical *select,
                       double *dr, double *di, double *Z,
                       integer *ldz, double *sigmar,
                       double *sigmai, double *workev,
                       char *bmat, integer *n, char *which,
                       integer *nev, double *tol, double *resid,
                       integer *ncv, double *V, integer *ldv,
                       integer *iparam, integer *ipntr,
                       double *workd, double *workl,
                       integer *lworkl, integer *info HIDDEN_HBW);

// single precision symmetric routines.

  void F77NAME(ssaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, float *tol, float *resid,
                       integer *ncv, float *V, integer *ldv,
                       integer *iparam, integer *ipntr, float *workd,
                       float *workl, integer *lworkl, integer *info HIDDEN_BW);

  void F77NAME(sseupd)(logical *rvec, char *HowMny, logical *select,
                       float *d, float *Z, integer *ldz,
                       float *sigma, char *bmat, integer *n,
                       char *which, integer *nev, float *tol,
                       float *resid, integer *ncv, float *V,
                       integer *ldv, integer *iparam, integer *ipntr,
                       float *workd, float *workl,
                       integer *lworkl, integer *info HIDDEN_HBW);

// single precision nonsymmetric routines.

  void F77NAME(snaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, float *tol, float *resid,
                       integer *ncv, float *V, integer *ldv,
                       integer *iparam, integer *ipntr, float *workd,
                       float *workl, integer *lworkl, integer *info HIDDEN_BW);

  void F77NAME(sneupd)(logical *rvec, char *HowMny, logical *select,
                       float *dr, float *di, float *Z,
                       integer *ldz, float *sigmar,
                       float *sigmai, float *workev, char *bmat,
                       integer *n, char *which, integer *nev,
                       float *tol, float *resid, integer *ncv,
                       float *V, integer *ldv, integer *iparam,
                       integer *ipntr, float *workd, float *workl,
                       integer *lworkl, integer *info HIDDEN_HBW);


  void F77NAME(cnaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, float *tol, complex<float> *resid,
                       integer *ncv, complex<float> *V, integer *ldv,
                       integer *iparam, integer *ipntr, complex<float> *workd,
                       complex<float> *workl, integer *lworkl,
                       float *rwork, integer *info HIDDEN_BW);

  void F77NAME(cneupd)(logical *rvec, char *HowMny, logical *select,
                       complex<float> *d, complex<float> *Z, integer *ldz,
                       complex<float> *sigma, complex<float> *workev,
                       char *bmat, integer *n, char *which, integer *nev,
                       float *tol, complex<float> *resid, integer *ncv,
                       complex<float> *V, integer *ldv, integer *iparam,
                       integer *ipntr, complex<float> *workd,
                       complex<float> *workl, integer *lworkl,
                       float *rwork, integer *info HIDDEN_HBW);

// double precision complex routines.

  void F77NAME(znaupd)(integer *ido, char *bmat, integer *n, char *which,
                       integer *nev, double *tol, complex<double> *resid,
                       integer *ncv, complex<double> *V, integer *ldv,
                       integer *iparam, integer *ipntr, complex<double> *workd,
                       complex<double> *workl, integer *lworkl,
                       double *rwork, integer *info HIDDEN_BW);

  void F77NAME(zneupd)(logical *rvec, char *HowMny, logical *select,
                       complex<double> *d, complex<double> *Z, integer *ldz,
                       complex<double> *sigma, complex<double> *workev,
                       char *bmat, integer *n, char *which, integer *nev,
                       double *tol, complex<double> *resid, integer *ncv,
                       complex<double> *V, integer *ldv, integer *iparam,
                       integer *ipntr, complex<double> *workd,
                       complex<double> *workl, integer *lworkl,
                       double *rwork, integer *info HIDDEN_HBW);

}

inline void saupp(int& ido, char bmat, int n, char* which, int nev,
                  double& tol, double resid[], int ncv, double V[],
                  int ldv, int iparam[], int ipntr[], double workd[],
                  double workl[], int lworkl, int& info)

{

  F77NAME(dsaupd)(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv,
                  &V[0], &ldv, &iparam[1], &ipntr[1], &workd[1], &workl[1],
                  &lworkl, &info HIDDEN_12);

} // saupp (double).

inline void saupp(int& ido, char bmat, int n, char* which, int nev,
                  float& tol, float resid[], int ncv, float V[],
                  int ldv, int iparam[], int ipntr[], float workd[],
                  float workl[], int lworkl, int& info)

{

  F77NAME(ssaupd)(&ido, &bmat, &n, which, &nev, &tol, resid, &ncv,
                  &V[0], &ldv, &iparam[1], &ipntr[1], &workd[1], &workl[1],
                  &lworkl, &info HIDDEN_12);

} // saupp (float).


inline void seupp(bool rvec, char HowMny, double d[], double Z[],
                  int ldz, double sigma, char bmat, int n,
                  char* which, int nev, double tol, double resid[],
                  int ncv, double V[], int ldv, int iparam[],
                  int ipntr[], double workd[], double workl[],
                  int lworkl, int& info)

{

  int      irvec;
  logical* iselect;
  double*  iZ;

  irvec   = (int) rvec;
  iselect = new logical[ncv];
  iZ = (Z == NULL) ? &V[0] : Z;

  F77NAME(dseupd)(&irvec, &HowMny, iselect, d, iZ, &ldz, &sigma, &bmat,
                  &n, which, &nev, &tol, resid, &ncv, &V[0], &ldv, &iparam[1],
                  &ipntr[1], &workd[1], &workl[1], &lworkl, &info HIDDEN_112);

  delete[] iselect;

} // seupp (double).
inline void seupp(bool rvec, char HowMny, float d[], float Z[],
                  int ldz, float sigma, char bmat, int n,
                  char* which, int nev, float tol, float resid[],
                  int ncv, float V[], int ldv, int iparam[],
                  int ipntr[], float workd[], float workl[],
                  int lworkl, int& info)
{

  int      irvec;
  logical* iselect;
  float*   iZ;