00001 //************************************************************************** 00002 // 00003 // NOTICE 00004 // 00005 // This software is a result of the research described in the report 00006 // 00007 // " A comparison of algorithms for modal analysis in the absence 00008 // of a sparse direct method", P. Arbenz, R. Lehoucq, and U. Hetmaniuk, 00009 // Sandia National Laboratories, Technical report SAND2003-1028J. 00010 // 00011 // It is based on the Epetra, AztecOO, and ML packages defined in the Trilinos 00012 // framework ( http://software.sandia.gov/trilinos/ ). 00013 // 00014 // The distribution of this software follows also the rules defined in Trilinos. 00015 // This notice shall be marked on any reproduction of this software, in whole or 00016 // in part. 00017 // 00018 // Under terms of Contract DE-AC04-94AL85000, there is a non-exclusive 00019 // license for use of this work by or on behalf of the U.S. Government. 00020 // 00021 // This program is distributed in the hope that it will be useful, but 00022 // WITHOUT ANY WARRANTY; without even the implied warranty of 00023 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00024 // 00025 // Code Authors: U. Hetmaniuk (ulhetma@sandia.gov), R. Lehoucq (rblehou@sandia.gov) 00026 // 00027 //************************************************************************** 00028 00029 /* for INTEL_CXML, the second arg may need to be changed to 'one'. If so 00030 the appropriate declaration of one will need to be added back into 00031 functions that include the macro: 00032 #if defined (INTEL_CXML) 00033 unsigned int one=1; 00034 #endif 00035 */ 00036 00037 #ifdef CHAR_MACRO 00038 #undef CHAR_MACRO 00039 #endif 00040 #if defined (INTEL_CXML) 00041 #define CHAR_MACRO(char_var) &char_var, 1 00042 #else 00043 #define CHAR_MACRO(char_var) &char_var 00044 #endif 00045 00046 #include "FortranRoutines.h" 00047 00048 // Double precision BLAS 1 // 00049 00050 void FortranRoutines::SCAL_INCX(int N, double ALPHA, double *X, int incX) const { 00051 DSCAL_F77(&N, &ALPHA, X, &incX); 00052 return; 00053 } 00054 00055 00056 void FortranRoutines::SWAP(int N, double *X, int incx, double *Y, int incy) const { 00057 F77_FUNC(dswap,DSWAP)(&N, X, &incx, Y, &incy); 00058 return; 00059 } 00060 00061 00062 // Double precision LAPACK // 00063 00064 /* 00065 void FortranRoutines::GEQRF(int M, int N, double *A, int lda, double *tau, double *work, 00066 int lwork, int *info) const { 00067 F77_FUNC(dgeqrf,DGEQRF)(&M, &N, A, &lda, tau, work, &lwork, info); 00068 return; 00069 } 00070 00071 void FortranRoutines::ORMQR(char SIDE, char TRANS, int M, int N, int K, double *A, int lda, 00072 double *tau, double *C, int ldc, double *work, int lwork, 00073 int *info) const { 00074 F77_FUNC(dormqr,DORMQR)(CHAR_MACRO(SIDE), CHAR_MACRO(TRANS), &M, &N, &K, A, &lda, tau, 00075 C, &ldc, work, &lwork, info); 00076 return; 00077 } 00078 00079 void FortranRoutines::SPEV(char JOBZ, char UPLO, int N, double *A, double *W, double *Z, 00080 int ldz, double *work, int *info) const { 00081 F77_FUNC(dspev,DSPEV)(CHAR_MACRO(JOBZ), CHAR_MACRO(UPLO), &N, A, W, Z, &ldz, work, info); 00082 return; 00083 } 00084 00085 void FortranRoutines::STEQR(char COMPZ, int N, double *D, double *E, double *Z, int ldz, 00086 double *work, int *info) const { 00087 F77_FUNC(dsteqr,DSTEQR)(CHAR_MACRO(COMPZ), &N, D, E, Z, &ldz, work, info); 00088 return; 00089 } 00090 */ 00091 void FortranRoutines::SYEV(char JOBZ, char UPLO, int N, double *A, int lda, double *W, 00092 double *work, int lwork, int *info) const { 00093 F77_FUNC(dsyev,DSYEV)(CHAR_MACRO(JOBZ), CHAR_MACRO(UPLO), &N, A, &lda, W, work, &lwork, info); 00094 return; 00095 } 00096 00097 00098 void FortranRoutines::SYGV(int itype, char JOBZ, char UPLO, int N, double *A, int lda, 00099 double *B, int ldb, double *W, double *work, int lwork, 00100 int *info) const { 00101 F77_FUNC(dsygv,DSYGV)(&itype, CHAR_MACRO(JOBZ), CHAR_MACRO(UPLO), &N, A, &lda, B, &ldb, 00102 W, work, &lwork, info); 00103 return; 00104 } 00105 00106 00107 int FortranRoutines::LAENV(int ispec, char *NAME, char *OPTS, int N1, int N2, int N3, 00108 int N4, int len_name, int len_opts) const { 00109 #if defined (INTEL_CXML) 00110 return F77_FUNC(ilaenv,ILAENV)(&ispec, NAME, len_name, OPTS, len_opts, &N1, &N2, &N3, &N4); 00111 #else 00112 return F77_FUNC(ilaenv,ILAENV)(&ispec, NAME, OPTS, &N1, &N2, &N3, &N4, len_name, len_opts); 00113 #endif 00114 } 00115 00116 00117 // Double precision ARPACK routines 00118 00119 #if 0 00120 00121 void FortranRoutines::SAUPD(int *ido, char BMAT, int N, char *which, int nev, double tol, 00122 double *resid, int ncv, double *V, int ldv, int *iparam, 00123 int *ipntr, double *workd, double *workl, int lworkl, int *info, 00124 int verbose) const { 00125 #if defined (INTEL_CXML) 00126 F77_FUNC(mydsaupd,MYDSAUPD)(ido, &BMAT, 1, &N, which, 2, &nev, &tol, resid, &ncv, V, &ldv, 00127 iparam, ipntr, workd, workl, &lworkl, info, &verbose); 00128 #else 00129 F77_FUNC(mydsaupd,MYDSAUPD)(ido, &BMAT, &N, which, &nev, &tol, resid, &ncv, V, &ldv, 00130 iparam, ipntr, workd, workl, &lworkl, info, &verbose, 1, 2); 00131 #endif 00132 return; 00133 } 00134 00135 /* 00136 void FortranRoutines::SEUPD(LOGICAL rvec, char HOWMNY, LOGICAL *select, double *D, 00137 double *Z, int ldz, double sigma, char BMAT, int N, 00138 char *which, int nev, double tol, double *resid, int ncv, double *V, 00139 int ldv, int *iparam, int *ipntr, double *workd, double *workl, 00140 int lworkl, int *info) const { 00141 #if defined (INTEL_CXML) 00142 F77_FUNC(dseupd,DSEUPD)(&rvec, &HOWMNY, 1, select, D, Z, &ldz, &sigma, &BMAT, 1, &N, 00143 which, 2, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, workl, &lworkl, 00144 info); 00145 #else 00146 F77_FUNC(dseupd,DSEUPD)(&rvec, &HOWMNY, select, D, Z, &ldz, &sigma, &BMAT, &N, which, 00147 &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, workl, &lworkl, info, 00148 1, 1, 2); 00149 #endif 00150 return; 00151 } 00152 */ 00153 00154 #ifdef EPETRA_MPI 00155 00156 // Double precision PARPACK routines 00157 00158 /* 00159 void FortranRoutines::PSAUPD(MPI_Comm MyComm, int *ido, char BMAT, int N, char *which, int nev, 00160 double tol, double *resid, int ncv, double *V, int ldv, int *iparam, 00161 int *ipntr, double *workd, double *workl, int lworkl, int *info, 00162 int verbose) const { 00163 #if defined (INTEL_CXML) 00164 F77_FUNC(mypdsaupd,MYPDSAUPD)(&MyComm, ido, &BMAT, 1, &N, which, 2, &nev, &tol, resid, &ncv, 00165 V, &ldv, iparam, ipntr, workd, workl, &lworkl, info, &verbose); 00166 #else 00167 F77_FUNC(mypdsaupd,MYPDSAUPD)(&MyComm, ido, &BMAT, &N, which, &nev, &tol, resid, &ncv, V, &ldv, 00168 iparam, ipntr, workd, workl, &lworkl, info, &verbose, 1, 2); 00169 #endif 00170 return; 00171 } 00172 */ 00173 00174 /* 00175 void FortranRoutines::PSEUPD(MPI_Comm MyComm, LOGICAL rvec, char HOWMNY, LOGICAL *select, 00176 double *D, double *Z, int ldz, double sigma, char BMAT, int N, 00177 char *which, int nev, double tol, double *resid, int ncv, double *V, 00178 int ldv, int *iparam, int *ipntr, double *workd, double *workl, 00179 int lworkl, int *info) const { 00180 #if defined (INTEL_CXML) 00181 F77_FUNC(pdseupd,PDSEUPD)(&MyComm, &rvec, &HOWMNY, 1, select, D, Z, &ldz, &sigma, &BMAT, 1, &N, 00182 which, 2, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, workl, &lworkl, info); 00183 #else 00184 F77_FUNC(pdseupd,PDSEUPD)(&MyComm, &rvec, &HOWMNY, select, D, Z, &ldz, &sigma, &BMAT, &N, 00185 which, &nev, &tol, resid, &ncv, V, &ldv, iparam, ipntr, workd, workl, &lworkl, info, 00186 1, 1, 2); 00187 #endif 00188 return; 00189 } 00190 */ 00191 00192 #endif 00193 00194 #endif