Beispiel #1
0
double Num_dlamch_primme(const char *cmach) {
#ifdef NUM_CRAY
   _fcd cmach_fcd;

   cmach_fcd = _cptofcd(cmach, strlen(cmach));
   return (DLAMCH(cmach_fcd));
#else
   return (DLAMCH(cmach));
#endif

}
Beispiel #2
0
double ProtoMol::Lapack::dlamch(char *cmach) {
  FAHCheckIn();
#if defined(HAVE_LAPACK)
  return dlamch_(cmach);
#elif defined(HAVE_SIMTK_LAPACK)
  return dlamch_(*cmach, 1);
#elif defined(HAVE_MKL_LAPACK)
  return DLAMCH(cmach);
#else
  THROW(std::string(__func__) + " not supported");
#endif
}
Beispiel #3
0
void symeigx(double a[],    
	      int n,         
	      double d[],    
	      double v[],    
	      int    ell,
	      int    *fl)
{
  int    itype    =   1;
  char   jobz     = 'v';
  char   range    = 'i';
  char   uplo     = 'l';
  char   trans    = 't';
  char   side     = 'l';
  char   diag     = 'n';
  char   under    = 'u';
  int    nfound;
  int    *ifail;
  int    info;
  int    neig;
  double abstol   =  2.0 * DLAMCH(under);
  double one      =  1.0;
  double zero     =  0.0;

#ifdef CBLAS
  double *work;
  int    lwork;
  int    *iwork;            
  char   *dsytrd  = "DSYTRD";
  int    monei    = -1;
  /*  int    nell     = n-ell+1;
      int    n1       = n;*/
  int    nell     = 1;
  int    n1       = ell ;
#else
  /*int    nell     = n-ell;
    int    n1       = n-1;*/
  int    nell     = 0;
  int    n1       = ell-1;
#endif
  
  ifail = (int *) malloc(sizeof(int) * n);

#ifdef CBLAS
  lwork = ilaenv_(&itype, dsytrd, &uplo, &n, 
		  &monei, &monei, &monei, 6L, 1L);
  lwork = (lwork+3)*n;
  if (lwork < 8*n)
    lwork = 8*n;
  iwork = (int *) malloc(sizeof(int) * n * 5);
  work  = (double *) malloc(sizeof(double) * lwork);
  dsyevx_(&jobz,&range,&uplo,&n,a,&n,&zero,&zero,&nell,&n1,
	  &abstol,&nfound,d,v,&n,work,&lwork,iwork,ifail,&info);
  free(iwork);
  free(work);
#else
  dsyevx(jobz, range, uplo, n, a, n, zero, zero, nell, n1, abstol, &nfound,
	 d, v, n, ifail, &info);
#endif
  
  neig = ell;
  if (info > 0)
    neig = info - 1;
  
  free(ifail);
  printf("%i\n", nfound) ;
  *fl = 1;
  if (info < 0) 
    {
      fprintf(stderr, "sygvx: Illegal argument %i.\n", info);
      *fl = -1;
    }
  else if ((info > 0) && (info <= n))
    {
      fprintf(stderr, "sygvx: Convergence failure.\n");
      *fl = -1;
    }
  else if (info > n)
    {
      fprintf(stderr,
	      "sygvx: Leading minor of order %i of B not pos. def.\n", 
	      info-n);
      *fl = -1;
    }
  
  return;
}