vec_struct *G_vector_sub(vec_struct * v1, vec_struct * v2, vec_struct * out)
{
int idx1, idx2, idx0;
int i;
if (!out->is_init) {
G_warning(_("Output vector is uninitialized"));
return NULL;
}
if (v1->type != v2->type) {
G_warning(_("Vectors are not of the same type"));
return NULL;
}
if (v1->type != out->type) {
G_warning(_("Output vector is of incorrect type"));
return NULL;
}
if (v1->type == MATRIX_) {
G_warning(_("Matrices not allowed"));
return NULL;
}
if ((v1->type == ROWVEC_ && v1->cols != v2->cols) ||
(v1->type == COLVEC_ && v1->rows != v2->rows)) {
G_warning(_("Vectors have differing dimensions"));
return NULL;
}
if ((v1->type == ROWVEC_ && v1->cols != out->cols) ||
(v1->type == COLVEC_ && v1->rows != out->rows)) {
G_warning(_("Output vector has incorrect dimension"));
return NULL;
}
idx1 = (v1->v_indx > 0) ? v1->v_indx : 0;
idx2 = (v2->v_indx > 0) ? v2->v_indx : 0;
idx0 = (out->v_indx > 0) ? out->v_indx : 0;
if (v1->type == ROWVEC_) {
for (i = 0; i < v1->cols; i++)
G_matrix_set_element(out, idx0, i,
G_matrix_get_element(v1, idx1, i) -
G_matrix_get_element(v2, idx2, i));
}
else {
for (i = 0; i < v1->rows; i++)
G_matrix_set_element(out, i, idx0,
G_matrix_get_element(v1, i, idx1) -
G_matrix_get_element(v2, i, idx2));
}
return out;
}
vec_struct *G_matvect_get_column(mat_struct * mt, int col)
{
int i; /* loop */
vec_struct *vc1;
if (col < 0 || col >= mt->cols) {
G_warning(_("Specified matrix column index is outside range"));
return NULL;
}
if (!mt->is_init) {
G_warning(_("Matrix is not initialised"));
return NULL;
}
if ((vc1 = G_vector_init(mt->rows, mt->ldim, CVEC)) == NULL) {
G_warning(_("Could not allocate space for vector structure"));
return NULL;
}
for (i = 0; i < mt->rows; i++)
G_matrix_set_element((mat_struct *) vc1, i, 0,
G_matrix_get_element(mt, i, col));
return vc1;
}
vec_struct *G_matvect_get_row(mat_struct * mt, int row)
{
int i; /* loop */
vec_struct *vc1;
if (row < 0 || row >= mt->cols) {
G_warning(_("Specified matrix row index is outside range"));
return NULL;
}
if (!mt->is_init) {
G_warning(_("Matrix is not initialised"));
return NULL;
}
if ((vc1 = G_vector_init(mt->cols, mt->ldim, RVEC)) == NULL) {
G_warning(_("Could not allocate space for vector structure"));
return NULL;
}
for (i = 0; i < mt->cols; i++)
G_matrix_set_element((mat_struct *) vc1, 0, i,
G_matrix_get_element(mt, row, i));
return vc1;
}
mat_struct *G_matrix_scalar_mul(double scalar, mat_struct *matrix, mat_struct *out)
{
int m, n, i, j;
int index = 0;
if (matrix == NULL) {
G_warning (_("Input matrix is uninitialized"));
return NULL;
}
if (out == NULL)
out = G_matrix_init(matrix->rows, matrix->cols, matrix->rows);
if (out->rows != matrix->rows || out->cols != matrix->cols)
out = G_matrix_resize(out, matrix->rows, matrix->cols);
m = matrix->rows;
n = matrix->cols;
for (i = 0; i < m; i++) {
for (j = 0; j < n; j++) {
doublereal value = scalar * G_matrix_get_element(matrix, i, j);
G_matrix_set_element (out, i,j, value);
}
}
return (out);
}
vec_struct *G_matvect_product(mat_struct *A, vec_struct *b, vec_struct *out)
{
unsigned int i, m, n, j;
register doublereal sum;
/* G_message("A=%d,%d,%d", A->cols, A->rows, A->ldim); */
/* G_message("B=%d,%d,%d", b->cols, b->rows, b->ldim); */
if (A->cols != b->cols) {
G_warning (_("Input matrix and vector have differing dimensions1"));
return NULL;
}
if (!out) {
G_warning (_("Output vector is uninitialized"));
return NULL;
}
/* if (out->ldim != A->rows) {*/
/* G_warning (_("Output vector has incorrect dimension"));*/
/* exit(1);*/
/* return NULL;*/
/* }*/
m = A->rows;
n = A->cols;
for (i = 0; i < m; i++) {
sum = 0.0;
int width = A->rows;
for (j = 0; j < n; j++) {
sum +=G_matrix_get_element(A, i, j) * G_matrix_get_element(b, 0, j);
/*sum += A->vals[i + j * width] * b->vals[j];*/
out->vals[i] = sum;
}
}
return (out);
}
double G_vector_norm1(vec_struct * vc)
{
double result = 0.0;
int idx;
int i;
if (!vc->is_init) {
G_warning(_("Matrix is not initialised"));
return 0.0 / 0.0; /* NaN */
}
idx = (vc->v_indx > 0) ? vc->v_indx : 0;
if (vc->type == ROWVEC_) {
for (i = 0; i < vc->cols; i++)
result += fabs(G_matrix_get_element(vc, idx, i));
}
else {
for (i = 0; i < vc->rows; i++)
result += fabs(G_matrix_get_element(vc, i, idx));
}
return result;
}
mat_struct *G_matrix_resize(mat_struct *in, int rows, int cols)
{
mat_struct *matrix;
matrix = G_matrix_init(rows, cols, rows);
int i, j, p, index = 0;
for (i = 0; i < rows; i++)
for (j = 0; j < cols; j++)
G_matrix_set_element(matrix, i, j, G_matrix_get_element(in, i, j));
/* matrix->vals[index++] = in->vals[i + j * cols];*/
int old_size = in->rows * in->cols;
int new_size = rows * cols;
if (new_size > old_size)
for (p = old_size; p < new_size; p++)
G_matrix_set_element(matrix, i, j, 0.0);
return (matrix);
}
void G_matrix_print(mat_struct * mt)
{
int i, j;
char buf[64], numbuf[64];
for (i = 0; i < mt->rows; i++) {
strcpy(buf, "");
for (j = 0; j < mt->cols; j++) {
sprintf(numbuf, "%14.6f", G_matrix_get_element(mt, i, j));
strcat(buf, numbuf);
if (j < mt->cols - 1)
strcat(buf, ", ");
}
G_message("%s", buf);
}
fprintf(stderr, "\n");
}
int G_matrix_eigen_sort(vec_struct * d, mat_struct * m)
{
mat_struct tmp;
int i, j;
int idx;
G_matrix_set(&tmp, m->rows + 1, m->cols, m->ldim + 1);
idx = (d->v_indx > 0) ? d->v_indx : 0;
/* concatenate (vertically) m and d into tmp */
for (i = 0; i < m->cols; i++) {
for (j = 0; j < m->rows; j++)
G_matrix_set_element(&tmp, j + 1, i,
G_matrix_get_element(m, j, i));
if (d->type == ROWVEC_)
G_matrix_set_element(&tmp, 0, i, G_matrix_get_element(d, idx, i));
else
G_matrix_set_element(&tmp, 0, i, G_matrix_get_element(d, i, idx));
}
/* sort the combined matrix */
qsort(tmp.vals, tmp.cols, tmp.ldim * sizeof(doublereal), egcmp);
/* split tmp into m and d */
for (i = 0; i < m->cols; i++) {
for (j = 0; j < m->rows; j++)
G_matrix_set_element(m, j, i,
G_matrix_get_element(&tmp, j + 1, i));
if (d->type == ROWVEC_)
G_matrix_set_element(d, idx, i, G_matrix_get_element(&tmp, 0, i));
else
G_matrix_set_element(d, i, idx, G_matrix_get_element(&tmp, 0, i));
}
G_free(tmp.vals);
return 0;
}
vec_struct *G_vector_product (vec_struct *v1, vec_struct *v2, vec_struct *out)
{
int idx1, idx2, idx0;
int i;
if (!out->is_init) {
G_warning (_("Output vector is uninitialized"));
return NULL;
}
if (v1->type != v2->type) {
G_warning (_("Vectors are not of the same type"));
return NULL;
}
if (v1->type != out->type) {
G_warning (_("Output vector is not the same type as others"));
return NULL;
}
if (v1->type == MATRIX_) {
G_warning (_("Matrices not allowed"));
return NULL;
}
if ((v1->type == ROWVEC_ && v1->cols != v2->cols) ||
(v1->type == COLVEC_ && v1->rows != v2->rows))
{
G_warning (_("Vectors have differing dimensions"));
return NULL;
}
if ((v1->type == ROWVEC_ && v1->cols != out->cols) ||
(v1->type == COLVEC_ && v1->rows != out->rows))
{
G_warning (_("Output vector has incorrect dimension"));
return NULL;
}
#if defined(HAVE_LAPACK) && defined(HAVE_LIBBLAS)
f77_dhad (v1->cols, 1.0, v1->vals, 1, v2->vals, 1, 0.0, out->vals, 1.0);
#else
idx1 = (v1->v_indx > 0) ? v1->v_indx : 0;
idx2 = (v2->v_indx > 0) ? v2->v_indx : 0;
idx0 = (out->v_indx > 0) ? out->v_indx : 0;
if (v1->type == ROWVEC_) {
for (i = 0; i < v1->cols; i++)
G_matrix_set_element(out, idx0, i,
G_matrix_get_element(v1, idx1, i) *
G_matrix_get_element(v2, idx2, i));
} else {
for (i = 0; i < v1->rows; i++)
G_matrix_set_element(out, i, idx0,
G_matrix_get_element(v1, i, idx1) *
G_matrix_get_element(v2, i, idx2));
}
#endif
return out;
}
