SEXP R_dgsum2d1(SEXP ICTXT, SEXP SCOPE, SEXP M, SEXP N, SEXP A, SEXP LDA, SEXP RDEST, SEXP CDEST)
{
const int m = INT(M, 0), n = INT(N, 0);
char top = ' ';
SEXP OUT;
PROTECT(OUT = allocMatrix(REALSXP, m, n));
memcpy(REAL(OUT), REAL(A), m*n*sizeof(double));
Cdgsum2d(INTEGER(ICTXT)[0], CHARPT(SCOPE, 0), &top, m, n, REAL(OUT),
INTEGER(LDA)[0], INTEGER(RDEST)[0], INTEGER(CDEST)[0]);
UNPROTECT(1);
return(OUT);
}
int
slcombine_(int *ictxt, char *scope, char *op, char * timetype, int *n, int *ibeg, double *times) {
/* System generated locals */
int i__1;
/* Local variables */
static int i__;
static int tmpdis;
/* -- ScaLAPACK tools routine (version 1.7) -- */
/* University of Tennessee, Knoxville, Oak Ridge National Laboratory, */
/* and University of California, Berkeley. */
/* May 1, 1997 */
/* Purpose */
/* SLCOMBINE takes the timing information stored on a scope of processes */
/* and combines them into the user's TIMES array. */
/* Arguments */
/* ICTXT (local input) INTEGER */
/* The BLACS context handle. */
/* SCOPE (global input) CHARACTER */
/* Controls what processes in grid participate in combine. */
/* Options are 'Rowwise', 'Columnwise', or 'All'. */
/* OP (global input) CHARACTER */
/* Controls what combine should be done: */
/* = '>': get maximal time on any process (default), */
/* = '<': get minimal time on any process, */
/* = '+': get sum of times across processes. */
/* TIMETYPE (global input) CHARACTER */
/* Controls what time will be returned in TIMES: */
/* = 'W': wall clock time, */
/* = 'C': CPU time (default). */
/* N (global input) INTEGER */
/* The number of timers to combine. */
/* IBEG (global input) INTEGER */
/* The first timer to be combined. */
/* TIMES (global output) DOUBLE PRECISION array, dimension (N) */
/* The requested timing information is returned in this array. */
/* Disable timer for combine operation */
/* Parameter adjustments */
--times;
/* Function Body */
tmpdis = sltimer00_1.disabled;
sltimer00_1.disabled = 1;
/* Copy timer information into user's times array */
if (*timetype == 'W') {
/* If walltime not available on this machine, fill in times */
/* with -1 flag, and return */
if (dwalltime00() == -1.) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
times[i__] = -1.;
/* L10: */
}
return 0;
} else {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
times[i__] = sltimer00_1.wallsec[*ibeg + i__ - 2];
/* L20: */
}
}
} else {
if (dcputime00() == -1.) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
times[i__] = -1.;
/* L30: */
}
return 0;
} else {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
times[i__] = sltimer00_1.cpusec[*ibeg + i__ - 2];
/* L40: */
}
}
}
/* Combine all nodes' information, restore disabled, and return */
if (*(unsigned char *)op == '>') {
Cdgamx2d(*ictxt,scope," ",*n,c__1,×[1],*n,&c_n1,&c_n1,c_n1,c_n1,c__0);
} else if (*(unsigned char *)op == '<') {
Cdgamn2d(*ictxt,scope," ",*n,c__1,×[1],*n,&c_n1,&c_n1,c_n1,c_n1,c__0);
} else if (*(unsigned char *)op == '+') {
Cdgsum2d(*ictxt,scope," ",*n,c__1,×[1],*n,c_n1,c__0);
} else {
Cdgamx2d(*ictxt,scope," ",*n,c__1,×[1],*n,&c_n1,&c_n1,c_n1,c_n1,c__0);
}
sltimer00_1.disabled = tmpdis;
return 0;
} /* slcombine_ */
