#include <string.h> // for `mem*` functions.

#include "config.h"
#include "matrix.h"

#include <R_ext/BLAS.h>

void matrixprod(const double *A, const int nrowA, const int ncolA,
                const double *B, const int nrowB, const int ncolB,
                double *C) {
    const double one = 1.0;
    const double zero = 0.0;

    // DGEMM with parameterization:
    //     C <- A %*% B
    F77_NAME(dgemm)("N", "N", &nrowA, &ncolB, &ncolA,
                    &one, A, &nrowA, B, &nrowB,
                    &zero, C, &nrowA);
}

void crossprod(const double *A, const int nrowA, const int ncolA,
               const double *B, const int nrowB, const int ncolB,
               double *C) {
    const double one = 1.0;
    const double zero = 0.0;

    // DGEMM with parameterization:
    //     C <- t(A) %*% B
    F77_NAME(dgemm)("T", "N", &ncolA, &ncolB, &nrowA,
                    &one, A, &nrowA, B, &nrowB,
                    &zero, C, &ncolA);
}

void nullProj(const double *B, const int nrowB, const int ncolB,
              double *Q) {
    const double minusOne = -1.0;
    const double one = 1.0;

    // Initialize as identity matrix.
    memset(Q, 0, sizeof(double) * nrowB * nrowB);
    double *Q_diag, *Q_end = Q + nrowB * nrowB;
    for (Q_diag = Q; Q_diag < Q_end; Q_diag += nrowB + 1) {
        *Q_diag = 1.0;
    }

    // DGEMM with parameterization:
    //     C <- (-1.0 * B %*% t(B)) + C
    F77_NAME(dgemm)("N", "T", &nrowB, &nrowB, &ncolB,
                    &minusOne, B, &nrowB, B, &nrowB,
                    &one, Q, &nrowB);
}

// A dence skwe-symmetric rank 2 update.
// Perform the update
//      C := alpha (A * B^T - B * A^T) + beta C
void skewSymRank2k(const int nrow, const int ncol,
                   double alpha, const double *A, const double *B,
                   double beta,
                   double *C) {
    F77_NAME(dgemm)("N", "T",
             &nrow, &nrow, &ncol,
             &alpha, A, &nrow, B, &nrow,
             &beta, C, &nrow);

    alpha *= -1.0;
    beta = 1.0;
    F77_NAME(dgemm)("N", "T",
             &nrow, &nrow, &ncol,
             &alpha, B, &nrow, A, &nrow,
             &beta, C, &nrow);
}