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_copy(const mat_struct * A)
{
mat_struct *B;
if (!A->is_init) {
G_warning(_("Matrix is not initialised fully."));
return NULL;
}
if ((B = G_matrix_init(A->rows, A->cols, A->ldim)) == NULL) {
G_warning(_("Unable to allocate space for matrix copy"));
return NULL;
}
memcpy(&B->vals[0], &A->vals[0], A->cols * A->ldim * sizeof(doublereal));
return B;
}
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);
}
mat_struct *G_matrix_inverse(mat_struct * mt)
{
mat_struct *mt0, *res;
int i, j, k; /* loop */
if (mt->rows != mt->cols) {
G_warning(_("Matrix is not square. Cannot determine inverse"));
return NULL;
}
if ((mt0 = G_matrix_init(mt->rows, mt->rows, mt->ldim)) == NULL) {
G_warning(_("Unable to allocate space for matrix"));
return NULL;
}
/* Set `B' matrix to unit matrix */
for (i = 0; i < mt0->rows - 1; i++) {
mt0->vals[i + i * mt0->ldim] = 1.0;
for (j = i + 1; j < mt0->cols; j++) {
mt0->vals[i + j * mt0->ldim] = mt0->vals[j + i * mt0->ldim] = 0.0;
}
}
mt0->vals[mt0->rows - 1 + (mt0->rows - 1) * mt0->ldim] = 1.0;
/* Solve system */
if ((k = G_matrix_LU_solve(mt, &res, mt0, NONSYM)) == 1) {
G_warning(_("Matrix is singular"));
G_matrix_free(mt0);
return NULL;
}
else if (k < 0) {
G_warning(_("Problem in LA procedure."));
G_matrix_free(mt0);
return NULL;
}
else {
G_matrix_free(mt0);
return res;
}
}
mat_struct *G_matrix_transpose(mat_struct * mt)
{
mat_struct *mt1;
int ldim, ldo;
doublereal *dbo, *dbt, *dbx, *dby;
int cnt, cnt2;
/* Word align the workspace blocks */
if (mt->cols % 2 == 0)
ldim = mt->cols;
else
ldim = mt->cols + 1;
mt1 = G_matrix_init(mt->cols, mt->rows, ldim);
/* Set initial values for reading arrays */
dbo = &mt->vals[0];
dbt = &mt1->vals[0];
ldo = mt->ldim;
for (cnt = 0; cnt < mt->cols; cnt++) {
dbx = dbo;
dby = dbt;
for (cnt2 = 0; cnt2 < ldo - 1; cnt2++) {
*dby = *dbx;
dby += ldim;
dbx++;
}
*dby = *dbx;
if (cnt < mt->cols - 1) {
dbo += ldo;
dbt++;
}
}
return mt1;
}
mat_struct *G_matrix_product(mat_struct * mt1, mat_struct * mt2)
{
mat_struct *mt3;
doublereal unity = 1, zero = 0;
integer rows, cols, interdim, lda, ldb;
integer1 no_trans = 'n';
if (!((mt1->is_init) || (mt2->is_init))) {
G_warning(_("One or both input matrices uninitialised"));
return NULL;
}
if (mt1->cols != mt2->rows) {
G_warning(_("Matrix order does not match"));
return NULL;
}
if ((mt3 = G_matrix_init(mt1->rows, mt2->cols, mt1->ldim)) == NULL) {
G_warning(_("Unable to allocate space for matrix product"));
return NULL;
}
/* Call the driver */
rows = (integer) mt1->rows;
interdim = (integer) mt1->cols;
cols = (integer) mt2->cols;
lda = (integer) mt1->ldim;
ldb = (integer) mt2->ldim;
f77_dgemm(&no_trans, &no_trans, &rows, &cols, &interdim, &unity,
mt1->vals, &lda, mt2->vals, &ldb, &zero, mt3->vals, &lda);
return mt3;
}
mat_struct *G__matrix_add(mat_struct * mt1, mat_struct * mt2, const double c1,
const double c2)
{
mat_struct *mt3;
int i, j; /* loop variables */
if (c1 == 0) {
G_warning(_("First scalar multiplier must be non-zero"));
return NULL;
}
if (c2 == 0) {
if (!mt1->is_init) {
G_warning(_("One or both input matrices uninitialised"));
return NULL;
}
}
else {
if (!((mt1->is_init) && (mt2->is_init))) {
G_warning(_("One or both input matrices uninitialised"));
return NULL;
}
if (mt1->rows != mt2->rows || mt1->cols != mt2->cols) {
G_warning(_("Matrix order does not match"));
return NULL;
}
}
if ((mt3 = G_matrix_init(mt1->rows, mt1->cols, mt1->ldim)) == NULL) {
G_warning(_("Unable to allocate space for matrix sum"));
return NULL;
}
if (c2 == 0) {
for (i = 0; i < mt3->rows; i++) {
for (j = 0; j < mt3->cols; j++) {
mt3->vals[i + mt3->ldim * j] =
c1 * mt1->vals[i + mt1->ldim * j];
}
}
}
else {
for (i = 0; i < mt3->rows; i++) {
for (j = 0; j < mt3->cols; j++) {
mt3->vals[i + mt3->ldim * j] =
c1 * mt1->vals[i + mt1->ldim * j] + c2 * mt2->vals[i +
mt2->
ldim *
j];
}
}
}
return mt3;
}