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);
}
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);
}
int G_matrix_read(FILE * fp, mat_struct * out)
{
char buff[100];
int rows, cols;
int i, j, row;
double val;
/* skip comments */
for (;;) {
if (!G_getl(buff, sizeof(buff), fp))
return -1;
if (buff[0] != '#')
break;
}
if (sscanf(buff, "Matrix: %d by %d", &rows, &cols) != 2) {
G_warning(_("Input format error"));
return -1;
}
G_matrix_set(out, rows, cols, rows);
for (i = 0; i < rows; i++) {
if (fscanf(fp, "row%d:", &row) != 1 || row != i) {
G_warning(_("Input format error"));
return -1;
}
for (j = 0; j < cols; j++) {
if (fscanf(fp, "%lf:", &val) != 1) {
G_warning(_("Input format error"));
return -1;
}
G_matrix_set_element(out, i, j, val);
}
}
return 0;
}
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;
}
