void
F77_NAME(dtrmv)(const char *uplo, const char *trans, const char *diag,
const int *n, const double *a, const int *lda,
double *x, const int *incx)
{
DTRMV(uplo, trans, diag, n, a, lda, x, incx);
}
static int rmvnorm_rng (lua_State *L) {
nl_RNG *r = getrng(L);
nl_Matrix *m = nl_checkmatrix(L, 1);
nl_Matrix *S = nl_checkmatrix(L, 2);
nl_Matrix *u;
int i, n = m->size;
lua_Number *em, *ev, *eu;
/* check args */
checkrvector(L, m, 1);
luaL_argcheck(L, !S->iscomplex, 2, "real matrix expected");
if (S->ndims == 1) {
luaL_argcheck(L, S->size == n, 2, "arguments are not conformable");
for (i = 0, ev = S->data; i < n; i++, ev += S->stride)
luaL_argcheck(L, *ev > 0, 2, "variance is not positive");
}
else
luaL_argcheck(L, S->ndims == 2 && S->dim[0] == n && S->dim[1] == n, 2,
"arguments are not conformable");
/* setup destination */
lua_settop(L, 3);
if (lua_isnil(L, 3))
u = nl_pushmatrix(L, 0, 1, &n, 1, n,
lua_newuserdata(L, n * sizeof(lua_Number)));
else {
u = nl_checkmatrix(L, 3);
checkrvector(L, u, 3);
luaL_argcheck(L, u->size == n, 3, "arguments are not conformable");
}
/* sample */
if (S->ndims == 1) {
em = m->data; ev = S->data; eu = u->data;
for (i = 0; i < n; i++) {
*eu = gennor(r, *em, *ev);
em += m->stride; ev += S->stride; eu += u->stride;
}
}
else {
char uplo = 'L', trans = 'N', diag = 'N';
lua_Number one = 1.0;
/* u ~ N(0, I_n) */
eu = u->data;
for (i = 0; i < n; i++, eu += u->stride)
*eu = gennor(r, 0, 1);
/* u = S * u */
if (S->stride != 1 /* non-unitary stride? */
|| (S->section != NULL /* non-block section? */
&& (S->section[0].step != 1 || S->section[1].step != 1))) {
nl_Buffer *buf = nl_getbuffer(L, n * n);
/* copy S to buffer */
for (i = 0; i < S->size; i++)
buf->data.bnum[i] = S->data[nl_mshift(S, i)];
DTRMV(&uplo, &trans, &diag, &n, buf->data.bnum, &n,
u->data, &u->stride, 1, 1, 1);
nl_freebuffer(buf);
}
else {
int ld = S->section ? S->section[0].ld : S->dim[0];
DTRMV(&uplo, &trans, &diag, &n, S->data, &ld,
u->data, &u->stride, 1, 1, 1);
}
/* u = u + m */
DAXPY(&n, &one, m->data, &m->stride, u->data, &u->stride);
}
return 1;
}
