void calcstep(int m, int n, double *A, double *B, double *s, double *y, double *r1, double *r2, double r3, double *r4, double *dx, double *ds, double *dt, double *dy) { char Transpose = 'T'; char Normal = 'N'; int n1 = n + 1; int oneI = 1; double none = -1.0; double one = 1.0; int info; int i; int *myworkI; double *dxdt; double *tmp; double *tmpB; tmp = pswarm_malloc(m * sizeof(double)); dxdt = pswarm_malloc(n1 * sizeof(double)); memset(dxdt, 0, n1 * sizeof(double)); dxdt[n] = 0.0; for (i = 0; i < m; i++) { tmp[i] = (r1[i] * y[i] - r4[i]) / s[i]; dxdt[n] += tmp[i]; } memcpy(dxdt, r2, n * sizeof(double)); dgemv_(&Transpose, &m, &n, &one, A, &m, tmp, &oneI, &one, dxdt, &oneI); /* dpotrs_(&Upper, &n1, &oneI, B, &n1, dxdt, &n1, &info); */ free(tmp); tmpB = pswarm_malloc(n1 * n1 * sizeof(double)); myworkI = pswarm_malloc(n1 * sizeof(int)); memcpy(tmpB, B, n1 * n1 * sizeof(double)); dgesv_(&n1, &oneI, tmpB, &n1, myworkI, dxdt, &n1, &info); memcpy(dx, dxdt, n * sizeof(double)); *dt = dxdt[n]; memcpy(ds, r1, m * sizeof(double)); dgemv_(&Normal, &m, &n, &none, A, &m, dx, &oneI, &one, ds, &oneI); for (i = 0; i < m; i++) { ds[i] -= (*dt); dy[i] = (r4[i] - y[i] * ds[i]) / s[i]; } free(myworkI); free(dxdt); free(tmpB); }
void ProtoMol::Lapack::dgemv(char *transA, int *m, int *n, double *alpha, double *A, int *lda, double *x, int *incx, double *beta, double *Y, int *incY) { FAHCheckIn(); #if defined(HAVE_LAPACK) dgemv_(transA, m, n, alpha, A, lda, x, incx, beta, Y, incY); #elif defined(HAVE_SIMTK_LAPACK) dgemv_(*transA, *m, *n, *alpha, A, *lda, x, *incx, *beta, Y, *incY, 1); #elif defined(HAVE_MKL_LAPACK) DGEMV(transA, m, n, alpha, A, lda, x, incx, beta, Y, incY); #else THROW(std::string(__func__) + " not supported"); #endif }
/* Subroutine */ int bicgkernel_(integer *lda, integer *n, doublereal *a, doublereal *p, doublereal *r__, real *s, real *q) { /* System generated locals */ integer a_dim1, a_offset; /* Local variables */ static doublereal one; static integer incx, incy; static doublereal zero; extern /* Subroutine */ int dgemv_(char *, integer *, integer *, doublereal *, doublereal *, integer *, doublereal *, integer *, doublereal *, real *, integer *, ftnlen); /* BICG */ /* in */ /* A : column matrix, p : vector, r : vector */ /* out */ /* q : vector, s : vector */ /* { */ /* q = A * p */ /* s = A' * r */ /* } */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --p; --r__; /* Function Body */ incx = 1; incy = 1; one = 1.; zero = 0.; /* Put A*p in q */ dgemv_("n", n, n, &one, &a[a_offset], lda, &p[1], &incx, &zero, q, &incy, (ftnlen)1); /* Put A'*r in s */ dgemv_("t", n, n, &one, &a[a_offset], lda, &r__[1], &incx, &zero, s, & incy, (ftnlen)1); return 0; } /* bicgkernel_ */
void FCItdm12kern_b(double *tdm1, double *tdm2, double *bra, double *ket, int bcount, int stra_id, int strb_id, int norb, int na, int nb, int nlinka, int nlinkb, _LinkT *clink_indexa, _LinkT *clink_indexb, int symm) { const int INC1 = 1; const char TRANS_N = 'N'; const char TRANS_T = 'T'; const double D1 = 1; const int nnorb = norb * norb; double csum; double *buf0 = calloc(nnorb*bcount, sizeof(double)); double *buf1 = calloc(nnorb*bcount, sizeof(double)); csum = FCIrdm2_b_t1ci(bra, buf1, bcount, stra_id, strb_id, norb, nb, nlinkb, clink_indexb); if (csum < CSUMTHR) { goto _normal_end; } csum = FCIrdm2_b_t1ci(ket, buf0, bcount, stra_id, strb_id, norb, nb, nlinkb, clink_indexb); if (csum < CSUMTHR) { goto _normal_end; } dgemv_(&TRANS_N, &nnorb, &bcount, &D1, buf0, &nnorb, bra+stra_id*nb+strb_id, &INC1, &D1, tdm1, &INC1); switch (symm) { case PARTICLESYM: tril_particle_symm(tdm2, buf1, buf0, bcount, norb, D1, D1); break; default: dgemm_(&TRANS_N, &TRANS_T, &nnorb, &nnorb, &bcount, &D1, buf0, &nnorb, buf1, &nnorb, &D1, tdm2, &nnorb); } _normal_end: free(buf0); free(buf1); }
static void make_rdm12_sf(double *rdm1, double *rdm2, double *bra, double *ket, double *t1bra, double *t1ket, int bcount, int stra_id, int strb_id, int norb, int na, int nb) { const char TRANS_N = 'N'; const char TRANS_T = 'T'; const int INC1 = 1; const double D1 = 1; const int nnorb = norb * norb; int k, l; size_t n; double *tbra = malloc(sizeof(double) * nnorb * bcount); double *pbra, *pt1; for (n = 0; n < bcount; n++) { pbra = tbra + n * nnorb; pt1 = t1bra + n * nnorb; for (k = 0; k < norb; k++) { for (l = 0; l < norb; l++) { pbra[k*norb+l] = pt1[l*norb+k]; } } } dgemm_(&TRANS_N, &TRANS_T, &nnorb, &nnorb, &bcount, &D1, t1ket, &nnorb, tbra, &nnorb, &D1, rdm2, &nnorb); dgemv_(&TRANS_N, &nnorb, &bcount, &D1, t1ket, &nnorb, bra+stra_id*nb+strb_id, &INC1, &D1, rdm1, &INC1); free(tbra); }
/*! dgematrix*_dcovector operator */ inline _dcovector operator*(const dgematrix& mat, const _dcovector& vec) { #ifdef CPPL_VERBOSE std::cerr << "# [MARK] operator*(const dgematrix&, const _dcovector&)" << std::endl; #endif//CPPL_VERBOSE #ifdef CPPL_DEBUG if(mat.N!=vec.L){ std::cerr << "[ERROR] operator*(const dgematrix&, const _dcovector&)" << std::endl << "These matrix and vector can not make a product." << std::endl << "Your input was (" << mat.M << "x" << mat.N << ") * (" << vec.L << ")." << std::endl; exit(1); } #endif//CPPL_DEBUG dcovector newvec(mat.M); dgemv_( 'N', mat.M, mat.N, 1.0, mat.Array, mat.M, vec.Array, 1, 0.0, newvec.array, 1 ); vec.destroy(); return _(newvec); }
/* * 2pdm kernel for beta^i beta_j | ci0 > */ void FCIrdm12kern_b(double *rdm1, double *rdm2, double *bra, double *ket, int bcount, int stra_id, int strb_id, int norb, int na, int nb, int nlinka, int nlinkb, _LinkT *clink_indexa, _LinkT *clink_indexb, int symm) { const int INC1 = 1; const char UP = 'U'; const char TRANS_N = 'N'; const char TRANS_T = 'T'; const double D1 = 1; const int nnorb = norb * norb; double csum; double *buf = calloc(nnorb*bcount, sizeof(double)); csum = FCIrdm2_b_t1ci(ket, buf, bcount, stra_id, strb_id, norb, nb, nlinkb, clink_indexb); if (csum > CSUMTHR) { dgemv_(&TRANS_N, &nnorb, &bcount, &D1, buf, &nnorb, ket+stra_id*nb+strb_id, &INC1, &D1, rdm1, &INC1); switch (symm) { case BRAKETSYM: dsyrk_(&UP, &TRANS_N, &nnorb, &bcount, &D1, buf, &nnorb, &D1, rdm2, &nnorb); break; case PARTICLESYM: tril_particle_symm(rdm2, buf, buf, bcount, norb, 1, 1); break; default: dgemm_(&TRANS_N, &TRANS_T, &nnorb, &nnorb, &bcount, &D1, buf, &nnorb, buf, &nnorb, &D1, rdm2, &nnorb); } } free(buf); }
/** Calculates w = G * s. */ void calc_w(int m, int p, double** G, double* s, double* w) { double a = 1.0; int inc = 1; double b = 0.0; dgemv_(&noT, &m, &p, &a, G[0], &m, s, &inc, &b, w, &inc); }
void THBlas_(gemv)(char trans, int64_t m, int64_t n, real alpha, real *a, int64_t lda, real *x, int64_t incx, real beta, real *y, int64_t incy) { if(n == 1) lda = m; #if defined(USE_BLAS) && (defined(TH_REAL_IS_DOUBLE) || defined(TH_REAL_IS_FLOAT)) if( (m <= INT_MAX) && (n <= INT_MAX) && (lda <= INT_MAX) && (incx > 0) && (incx <= INT_MAX) && (incy > 0) && (incy <= INT_MAX) ) { THArgCheck(lda >= THMax(1, m), 6, "lda should be at least max(1, m=%d), but have %d", m, lda); int i_m = (int)m; int i_n = (int)n; int i_lda = (int)lda; int i_incx = (int)incx; int i_incy = (int)incy; #if defined(TH_REAL_IS_DOUBLE) dgemv_(&trans, &i_m, &i_n, &alpha, a, &i_lda, x, &i_incx, &beta, y, &i_incy); #else sgemv_(&trans, &i_m, &i_n, &alpha, a, &i_lda, x, &i_incx, &beta, y, &i_incy); #endif return; } #endif { int64_t i, j; if( (trans == 'T') || (trans == 't') ) { for(i = 0; i < n; i++) { real sum = 0; real *row_ = a+lda*i; for(j = 0; j < m; j++) sum += x[j*incx]*row_[j]; if (beta == 0) y[i*incy] = alpha*sum; else y[i*incy] = beta*y[i*incy] + alpha*sum; } } else { if(beta != 1) THBlas_(scal)(m, beta, y, incy); for(j = 0; j < n; j++) { real *column_ = a+lda*j; real z = alpha*x[j*incx]; for(i = 0; i < m; i++) y[i*incy] += z*column_[i]; } } } }
/* ---- PBC functions ---- */ void DoCorrectionTable(double *ChebyshevWeightSource, double *ChebyshevWeightField, int n, int2 dof, double Len, double alpha, int lpbc, kernel_t kernel, double *Tkz) { kfun_t kfun = kernel.kfun; double homogen = kernel.homogen; char kpbcFilename[50]; sprintf(kpbcFilename, "Kn%dpbc%da%.1f.out", n, lpbc, alpha); FILE *kfile = fopen(kpbcFilename, "r"); // Create correction table if (kfile == NULL) { printf("kpbc file: %s does not exist. Creating now ...\n", kpbcFilename); CreateTableCorrection(kfun, n, dof, alpha, lpbc, Tkz, kpbcFilename); kfile = fopen(kpbcFilename, "r"); assert(kfile != NULL); } else printf("kpbc file exits. Reading now ...\n"); // Read and scale for elastic constants int i, j=0; double c3Read[3]; for (i=0; i<3; i++) j += fscanf(kfile, "%lf", c3Read+i); assert (j == 3); int n3 = n*n*n; int n3f = n3 * dof.f, n3s = n3 * dof.s; int dof2n6 = n3f * n3s; double *KPBC = (double *) malloc( dof2n6 * sizeof(double) ); for (i=0; i<dof2n6; i++) j += fscanf(kfile, "%lf", KPBC+i); fclose(kfile); assert( j-3 == dof2n6 ); // Compute stress from PBC int incr = 1; double beta = 0; char trans = 'n'; double scale = pow(1/Len, homogen); // Scale for the box size // check if parameters are exactly scaled if ( fabs(AnisoParameters->c3[0]/c3Read[0] - AnisoParameters->c3[1]/c3Read[1]) <1e-6 && fabs(AnisoParameters->c3[2]/c3Read[2] - AnisoParameters->c3[1]/c3Read[1]) <1e-6 ) scale *= AnisoParameters->c3[0]/c3Read[0]; else printf("Error: elastic constants do not match (scale).\n"); dgemv_(&trans, &n3f, &n3s, &scale, KPBC, &n3f, ChebyshevWeightSource, &incr, &beta, ChebyshevWeightField, &incr); free(KPBC), KPBC=NULL; }
void DenseGenMatrix::mult ( double beta, double y[], int incy, double alpha, double x[], int incx ) { char fortranTrans = 'T'; int n = mStorage->n, m = mStorage->m; dgemv_( &fortranTrans, &n, &m, &alpha, &mStorage->M[0][0], &n, x, &incx, &beta, y, &incy ); }
/* y := alpha*A*x + beta*y. * INPUT * m : the number of rows of the matrix A, that is, y[m] * n : the number of colums of the matrix A, that is, x[n] * A is 'm by n' matrix. * dgemv_() is implemented in FORTRAN, so that, * for 'N' case, * y[i] = sum_j A[i,j] x[j] * = sum_J a[I+m*J] * x[J], where I:=i-1, etc. * = sum_J a[J*m+I] * x[J] * = A_C[J,I] * x[J] * for 'T' case, * y[i] = sum_j A[j,i] x[j] * = sum_J a[J+n*I] * x[J], where I:=i-1, etc. * = sum_J a[I*n+J] * x[J] * = A_C[I,J] * x[J] * NOTE, in this case, m and n also should be exchanged... */ void dgemv_wrap (int m, int n, double alpha, double *a, double *x, double beta, double *y) { char trans = 'T'; /* fortran's memory allocation is transposed */ int one = 1; dgemv_ (&trans, &n, &m, &alpha, a, &n, x, &one, &beta, y, &one); }
/* * _spin0 assumes the strict symmetry on alpha and beta electrons */ void FCIrdm12kern_spin0(double *rdm1, double *rdm2, double *bra, double *ket, int bcount, int stra_id, int strb_id, int norb, int na, int nb, int nlinka, int nlinkb, _LinkT *clink_indexa, _LinkT *clink_indexb, int symm) { if (stra_id < strb_id) { return; } const int INC1 = 1; const char UP = 'U'; const char TRANS_N = 'N'; const char TRANS_T = 'T'; const double D1 = 1; const double D2 = 2; const int nnorb = norb * norb; int fill0, fill1, i; double csum = 0; double *buf = calloc(nnorb * na, sizeof(double)); if (strb_id+bcount <= stra_id) { fill0 = bcount; fill1 = bcount; csum = FCIrdm2_b_t1ci(ket, buf, fill0, stra_id, strb_id, norb, na, nlinka, clink_indexa) + FCIrdm2_a_t1ci(ket, buf, fill1, stra_id, strb_id, norb, na, nlinka, clink_indexa); } else if (stra_id >= strb_id) { fill0 = stra_id - strb_id; fill1 = stra_id - strb_id + 1; csum = FCIrdm2_b_t1ci(ket, buf, fill0, stra_id, strb_id, norb, na, nlinka, clink_indexa) + FCIrdm2_a_t1ci(ket, buf, fill1, stra_id, strb_id, norb, na, nlinka, clink_indexa); } if (csum > CSUMTHR) { dgemv_(&TRANS_N, &nnorb, &fill1, &D2, buf, &nnorb, ket+stra_id*na+strb_id, &INC1, &D1, rdm1, &INC1); for (i = fill0*nnorb; i < fill1*nnorb; i++) { buf[i] *= SQRT2; } switch (symm) { case BRAKETSYM: dsyrk_(&UP, &TRANS_N, &nnorb, &fill1, &D2, buf, &nnorb, &D1, rdm2, &nnorb); break; case PARTICLESYM: tril_particle_symm(rdm2, buf, buf, fill1, norb, D2, D1); break; default: dgemm_(&TRANS_N, &TRANS_T, &nnorb, &nnorb, &fill1, &D2, buf, &nnorb, buf, &nnorb, &D1, rdm2, &nnorb); } } free(buf); }
INLINE void do_dgemv(double *a, double *x, double *y, int iterations, int *limit, int *lda) { REGISTER int i = 0; extern int dgemv_(); for (;i<iterations;i++) { dgemv_(foo,limit,limit,&dalpha,a,lda,x,&stride,&dbeta,y,&stride); } }
void EucQuadratic::HessianEta(Variable *x, Vector *etax, Vector *xix) const { const double *v = etax->ObtainReadData(); double *xixTV = xix->ObtainWriteEntireData(); char *transn = const_cast<char *> ("n"); integer N = Dim, inc = 1; double two = 2, zero = 0; dgemv_(transn, &N, &N, &two, A, &N, const_cast<double *> (v), &inc, &zero, xixTV, &inc); };
PyObject* gemv(PyObject *self, PyObject *args) { Py_complex alpha; PyArrayObject* a; PyArrayObject* x; Py_complex beta; PyArrayObject* y; char trans = 't'; if (!PyArg_ParseTuple(args, "DOODO|c", &alpha, &a, &x, &beta, &y, &trans)) return NULL; int m, n, lda, itemsize, incx, incy; if (trans == 'n') { m = PyArray_DIMS(a)[1]; for (int i = 2; i < PyArray_NDIM(a); i++) m *= PyArray_DIMS(a)[i]; n = PyArray_DIMS(a)[0]; lda = MAX(1, m); } else { n = PyArray_DIMS(a)[0]; for (int i = 1; i < PyArray_NDIM(a)-1; i++) n *= PyArray_DIMS(a)[i]; m = PyArray_DIMS(a)[PyArray_NDIM(a)-1]; lda = MAX(1, m); } if (PyArray_DESCR(a)->type_num == NPY_DOUBLE) itemsize = sizeof(double); else itemsize = sizeof(double_complex); incx = PyArray_STRIDES(x)[0]/itemsize; incy = 1; if (PyArray_DESCR(a)->type_num == NPY_DOUBLE) dgemv_(&trans, &m, &n, &(alpha.real), DOUBLEP(a), &lda, DOUBLEP(x), &incx, &(beta.real), DOUBLEP(y), &incy); else zgemv_(&trans, &m, &n, &alpha, (void*)COMPLEXP(a), &lda, (void*)COMPLEXP(x), &incx, &beta, (void*)COMPLEXP(y), &incy); Py_RETURN_NONE; }
void EucQuadratic::HessianEta(Variable *x, Vector *etax, Vector *xix) const { const double *v = etax->ObtainReadData(); double *xixTV = xix->ObtainWriteEntireData(); char *transn = const_cast<char *> ("n"); integer N = Dim, inc = 1; double two = 2, zero = 0; // xixTV <- 2 * A * v, details: http://www.netlib.org/lapack/explore-html/dc/da8/dgemv_8f.html dgemv_(transn, &N, &N, &two, A, &N, const_cast<double *> (v), &inc, &zero, xixTV, &inc); };
GURLS_EXPORT void gemv(const CBLAS_TRANSPOSE TransA, const int M, const int N, const double alpha, const double *A, const int lda, const double *X, const int incX, const double beta, double *Y, const int incY) { char transA = BlasUtils::charValue(TransA); dgemv_(&transA, const_cast<int*>(&M), const_cast<int*>(&N), const_cast<double*>(&alpha), const_cast<double*>(A), const_cast<int*>(&lda), const_cast<double*>(X), const_cast<int*>(&incX), const_cast<double*>(&beta), const_cast<double*>(Y), const_cast<int*>(&incY)); }
int f2c_dgemv(char* trans, integer* M, integer* N, doublereal* alpha, doublereal* A, integer* lda, doublereal* X, integer* incX, doublereal* beta, doublereal* Y, integer* incY) { dgemv_(trans, M, N, alpha, A, lda, X, incX, beta, Y, incY); return 0; }
/* * INPUT * *user_data = (double *) mat */ static void atimes_by_matrix (int n, const double *x, double *b, void *user_data) { char trans = 'T'; /* fortran's memory allocation is transposed */ int i_1 = 1; double d_1 = 1.0; double d_0 = 0.0; double *mat = (double *)user_data; dgemv_ (&trans, &n, &n, &d_1, mat, &n, x, &i_1, &d_0, b, &i_1); }
void dgemv(const TRANSPOSE TransA, const int M, const int N, const double alpha, const double *A, const int lda, const double *X, const int incX, const double beta, double *Y, const int incY) { dgemv_(TransposeChar[TransA], &M, &N, &alpha, A, &lda, X, &incX, &beta, Y, &incY); }
void matrix_dgemv(const matrix_type * A , const double *x , double * y, bool transA , double alpha , double beta) { int m = matrix_get_rows( A ); int n = matrix_get_columns( A ); int lda = matrix_get_column_stride( A ); int incx = 1; int incy = 1; char transA_c; if (transA) transA_c = 'T'; else transA_c = 'N'; dgemv_(&transA_c , &m , &n , &alpha , matrix_get_data( A ) , &lda , x , &incx , &beta , y , &incy); }
/* z = alpha * d * y(:,k) + beta * z, where d is dense matrix and y is dense general */ static void mm_real_d_dot_yk (const bool trans, const double alpha, const mm_dense *d, const mm_dense *y, const int k, const double beta, mm_dense *z) { double *yk = y->data + k * y->m; double *zk = z->data + k * z->m; if (!mm_real_is_symmetric (d)) { // z = alpha * d * y + beta * z dgemv_ ((trans) ? "T" : "N", &d->m, &d->n, &alpha, d->data, &d->m, yk, &ione, &beta, zk, &ione); } else { char uplo = (mm_real_is_upper (d)) ? 'U' : 'L'; // z = alpha * d * y + beta * z dsymv_ (&uplo, &d->m, &alpha, d->data, &d->m, yk, &ione, &beta, zk, &ione); } return; }
double EucQuadratic::f(Variable *x) const { const double *v = x->ObtainReadData(); SharedSpace *Temp = new SharedSpace(1, Dim); double *temp = Temp->ObtainWriteEntireData(); char *transn = const_cast<char *> ("n"); double one = 1, zero = 0; integer inc = 1, N = Dim; dgemv_(transn, &N, &N, &one, A, &N, const_cast<double *> (v), &inc, &zero, temp, &inc); x->AddToTempData("Ax", Temp); return ddot_(&N, const_cast<double *> (v), &inc, temp, &inc); };
/* ---------------------------------------------------------------------- */ void tpfa_htrans_compute(struct UnstructuredGrid *G, const double *perm, double *htrans) /* ---------------------------------------------------------------------- */ { int c, d, f, i, j; double s, dist, denom; double Kn[3]; double *cc, *fc, *n; const double *K; MAT_SIZE_T nrows, ncols, ldA, incx, incy; double a1, a2; d = G->dimensions; nrows = ncols = ldA = d; incx = incy = 1 ; a1 = 1.0; a2 = 0.0 ; for (c = i = 0; c < G->number_of_cells; c++) { K = perm + (c * d * d); cc = G->cell_centroids + (c * d); for (; i < G->cell_facepos[c + 1]; i++) { f = G->cell_faces[i]; s = 2.0*(G->face_cells[2*f + 0] == c) - 1.0; n = G->face_normals + (f * d); fc = G->face_centroids + (f * d); dgemv_("No Transpose", &nrows, &ncols, &a1, K, &ldA, n, &incx, &a2, &Kn[0], &incy); htrans[i] = denom = 0.0; for (j = 0; j < d; j++) { dist = fc[j] - cc[j]; htrans[i] += s * dist * Kn[j]; denom += dist * dist; } assert (denom > 0); htrans[i] /= denom; htrans[i] = fabs(htrans[i]); } } }
void draw_uncollapsed_xaya(std::vector<double> &xaya, std::vector<double> &xa, std::vector<double> &xag, std::vector<double> Bg, double phi, int na, int p, int p_gamma) { double sd=sqrt(1/phi); std::vector<double> Z(na); for(std::vector<double>::iterator it=Z.begin(); it!=Z.end(); ++it) *it=Rf_rnorm(0,1); if(p_gamma!=0){ dgemv_(&transN , &na, &p_gamma, &unity, &*xag.begin(), &na, &*Bg.begin(), &inc, &inputscale0, &*xaya.begin(), &inc); daxpy_(&p, &sd, &*Z.begin(), &inc, &*xaya.begin(), &inc); //dtrmv_(&uplo, &transT, &unit_tri, &na, &*xa.begin(), &na, &*xaya.begin(), &inc); dtpmv_(&uplo, &transT, &unit_tri, &na, &*xa.begin(), &*xaya.begin(), &inc); }else{ for(size_t i=0; i!=xaya.size(); ++i) xaya[i]=sd*Z[i]; //dtrmv_(&uplo, &transT, &unit_tri, &na, &*xa.begin(), &na, &*xaya.begin(), &inc); dtpmv_(&uplo, &transT, &unit_tri, &na, &*xa.begin(), &*xaya.begin(), &inc); } }
void linalg_matvec_plus_vec (double alpha, double *A, double *v, double beta, double *b, int m, int n) { char ytran = 'T'; int dimM = m; int dimN = n; int incb = 1; int incv = 1; /* printf("\n\nmatvec plus vec\n\n"); */ /* util_print_matrix(A, m, n, "A = ", 0); */ /* util_print_matrix(v, n, 1, "v = ", 0); */ dgemv_ (&ytran, &dimN, &dimM, &alpha, A, &dimN, v, &incv, &beta, b, &incb); }
/*! drovector*dgematrix operator */ inline _drovector operator*(const drovector& vec, const dgematrix& mat) {VERBOSE_REPORT; #ifdef CPPL_DEBUG if(vec.l!=mat.m){ ERROR_REPORT; std::cerr << "These vector and matrix can not make a product." << std::endl << "Your input was (" << vec.l << ") * (" << mat.m << "x" << mat.n << ")." << std::endl; exit(1); } #endif//CPPL_DEBUG drovector newvec(mat.n); dgemv_( 'T', mat.m, mat.n, 1.0, mat.array, mat.m, vec.array, 1, 0.0, newvec.array, 1 ); return _(newvec); }
double EucQuadratic::f(Variable *x) const { const double *v = x->ObtainReadData(); SharedSpace *Temp = new SharedSpace(1, Dim); double *temp = Temp->ObtainWriteEntireData(); char *transn = const_cast<char *> ("n"); double one = 1, zero = 0; integer inc = 1, N = Dim; // temp <- A * v, details: http://www.netlib.org/lapack/explore-html/dc/da8/dgemv_8f.html dgemv_(transn, &N, &N, &one, A, &N, const_cast<double *> (v), &inc, &zero, temp, &inc); x->AddToTempData("Ax", Temp); // output v^T temp, details: http://www.netlib.org/lapack/explore-html/d5/df6/ddot_8f.html return ddot_(&N, const_cast<double *> (v), &inc, temp, &inc); };
/*! dgematrix*_dcovector operator */ inline _dcovector operator*(const dgematrix& mat, const _dcovector& vec) {VERBOSE_REPORT; #ifdef CPPL_DEBUG if(mat.n!=vec.l){ ERROR_REPORT; std::cerr << "These matrix and vector can not make a product." << std::endl << "Your input was (" << mat.m << "x" << mat.n << ") * (" << vec.l << ")." << std::endl; exit(1); } #endif//CPPL_DEBUG dcovector newvec(mat.m); dgemv_( 'n', mat.m, mat.n, 1.0, mat.array, mat.m, vec.array, 1, 0.0, newvec.array, 1 ); vec.destroy(); return _(newvec); }