/*
------------------------------------------
destructor, free's the object and its data
created -- 95sep22, cca
------------------------------------------
*/
IVL *
IVL_free (
IVL *ivl
) {
if ( ivl == NULL ) {
fprintf(stderr, "\n fatal error in IVL_free(%p)"
"\n bad input\n", ivl) ;
exit(-1) ;
}
IVL_clearData(ivl) ;
FREE(ivl) ;
return(NULL) ; }
/*
---------------------------------------------------
purpose -- to read an IVL object from a binary file
return value -- 1 if success, 0 if failure
created -- 95sep29, cca
---------------------------------------------------
*/
int
IVL_readFromBinaryFile (
IVL *ivl,
FILE *fp
) {
int nlist, rc, type ;
int itemp[3] ;
int *sizes ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n fatal error in IVL_readFromBinaryFile(%p,%p)"
"\n bad input\n", ivl, fp) ;
return(0) ;
}
switch ( ivl->type ) {
case IVL_CHUNKED :
case IVL_SOLO :
break ;
default :
fprintf(stderr, "\n error in IVL_readBinaryFile(%p,%p)"
"\n bad type = %d", ivl, fp, ivl->type) ;
return(0) ;
}
/*
-------------------------------------------
save the ivl type and clear the data fields
-------------------------------------------
*/
type = ivl->type ;
IVL_clearData(ivl) ;
/*
-----------------------------------
read in the three scalar parameters
type, # of lists, # of indices
-----------------------------------
*/
if ( (rc = fread((void *) itemp, sizeof(int), 3, fp)) != 3 ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n itemp(3) : %d items of %d read\n", ivl, fp, rc, 3) ;
return(0) ;
}
nlist = itemp[1] ;
/*
--------------------------
read in the sizes[] vector
--------------------------
*/
sizes = IVinit(nlist, 0) ;
if ( (rc = fread((void *) sizes, sizeof(int), nlist, fp)) != nlist ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n sizes(%d) : %d items of %d read\n",
ivl, fp, nlist, rc, nlist) ;
return(0) ;
}
/*
---------------------
initialize the object
---------------------
*/
IVL_init3(ivl, type, nlist, sizes) ;
IVfree(sizes) ;
/*
-------------------
read in the indices
-------------------
*/
switch ( type ) {
case IVL_SOLO : {
int ilist, size ;
int *ind ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &ind) ;
if ( (rc = fread((void *) ind, sizeof(int), size, fp)) != size ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n list %d, %d items of %d read\n",
ivl, fp, ilist, rc, size) ;
return(0) ;
}
}
} break ;
case IVL_CHUNKED : {
/*
--------------------------------------------------------
read in the indices into the contiguous block of storage
--------------------------------------------------------
*/
if ( (rc = fread((void *) ivl->chunk->base,
sizeof(int), ivl->tsize, fp)) != ivl->tsize ) {
fprintf(stderr, "\n error in IVL_readFromBinaryFile(%p,%p)"
"\n indices(%d) : %d items of %d read\n",
ivl, fp, ivl->tsize, rc, ivl->tsize) ;
return(0) ;
}
} break ;
}
return(1) ; }
/*
------------------------------------------------------
purpose -- to read an IVL object from a formatted file
return value -- 1 if success, 0 if failure
created -- 95sep29, cca
------------------------------------------------------
*/
int
IVL_readFromFormattedFile (
IVL *ivl,
FILE *fp
) {
int nlist, rc, type ;
int itemp[3] ;
int *sizes ;
/*
---------------
check the input
---------------
*/
if ( ivl == NULL || fp == NULL ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n bad input\n", ivl, fp) ;
return(0) ;
}
switch ( ivl->type ) {
case IVL_CHUNKED :
case IVL_SOLO :
break ;
default :
fprintf(stderr, "\n error in IVL_readFormattedFile(%p,%p)"
"\n bad type = %d", ivl, fp, ivl->type) ;
return(0) ;
}
/*
-------------------------------------------
save the ivl type and clear the data fields
-------------------------------------------
*/
type = ivl->type ;
IVL_clearData(ivl) ;
/*
-----------------------------------
read in the three scalar parameters
type, # of lists, # of indices
-----------------------------------
*/
if ( (rc = IVfscanf(fp, 3, itemp)) != 3 ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, 3) ;
return(0) ;
}
nlist = itemp[1] ;
/*
fprintf(stdout, "\n itemp = { %d %d %d } ",
itemp[0], itemp[1], itemp[2]) ;
*/
/*
--------------------------
read in the sizes[] vector
--------------------------
*/
sizes = IVinit(nlist, 0) ;
if ( (rc = IVfscanf(fp, nlist, sizes)) != nlist ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, nlist) ;
return(0) ;
}
/*
---------------------
initialize the object
---------------------
*/
IVL_init3(ivl, type, nlist, sizes) ;
IVfree(sizes) ;
/*
-----------------------
now read in the indices
-----------------------
*/
switch ( type ) {
case IVL_SOLO : {
int ilist, size ;
int *ind ;
for ( ilist = 0 ; ilist < nlist ; ilist++ ) {
IVL_listAndSize(ivl, ilist, &size, &ind) ;
if ( size > 0 ) {
if ( (rc = IVfscanf(fp, size, ind)) != size ) {
fprintf(stderr,
"\n error in IVL_readFromFormattedFile(%p,%p)"
"\n list %d, %d items of %d read\n",
ivl, fp, ilist, rc, size) ;
return(0) ;
}
}
}
} break ;
case IVL_CHUNKED : {
/*
--------------------------------------------------------
read in the indices into the contiguous block of storage
--------------------------------------------------------
*/
if ( (rc = IVfscanf(fp, ivl->tsize, ivl->chunk->base))
!= ivl->tsize ) {
fprintf(stderr, "\n error in IVL_readFromFormattedFile(%p,%p)"
"\n %d items of %d read\n", ivl, fp, rc, ivl->tsize) ;
return(0) ;
}
} break ;
}
return(1) ; }
/*
------------------------------------------------------------------
this method is used during the setup for matrix-vector multiplies.
each processor has computed the vertices it needs from other
processors, these lists are contained in sendIVL. on return,
recvIVL contains the lists of vertices this processor must send
to all others.
sendIVL -- on input, list[q] contains the vertices needed by
this processor that are owned by q
recvIVL -- on output, list[q] contains the vertices owned by
this processor that are needed by q. note, if NULL
on input, a new IVL object is allocated
stats[] -- statistics vector
stats[0] -- contains # of sends
stats[1] -- contains # of receives
stats[2] -- contains # of bytes sent
stats[3] -- contains # of bytes received
firsttag -- first tag for messages,
tags in range [firsttag, firsttag+nproc-1] are used
return value -- recvIVL
created -- 98jul26, cca
------------------------------------------------------------------
*/
IVL *
IVL_MPI_alltoall (
IVL *sendIVL,
IVL *recvIVL,
int stats[],
int msglvl,
FILE *msgFile,
int firsttag,
MPI_Comm comm
) {
int count, destination, lasttag, left, myid, nproc, offset, q,
recvcount, right, sendcount, source, tag, tagbound ;
int *incounts, *outcounts, *recvvec, *sendvec ;
MPI_Status status ;
/*
---------------
check the input
---------------
*/
if ( sendIVL == NULL || stats == NULL || (msglvl > 0 && msgFile == NULL) ) {
fprintf(msgFile, "\n fatal error in IVL_MPI_alltoall()"
"\n bad input\n") ;
exit(-1) ;
}
/*
---------------------------------------
get id of self and number of processors
---------------------------------------
*/
MPI_Comm_rank(comm, &myid) ;
MPI_Comm_size(comm, &nproc) ;
if ( sendIVL->nlist != nproc ) {
fprintf(msgFile, "\n fatal error in IVL_MPI_alltoall()"
"\n sendIVL: nproc = %d, nlist = %d\n",
nproc, sendIVL->nlist) ;
exit(-1) ;
}
lasttag = firsttag + nproc ;
if ( lasttag > (tagbound = maxTagMPI(comm)) ) {
fprintf(stderr, "\n fatal error in IVL_MPI_alltoall()"
"\n lasttag = %d, tag_bound = %d", lasttag, tagbound) ;
exit(-1) ;
}
if ( recvIVL == NULL ) {
recvIVL = IVL_new() ;
} else {
IVL_clearData(recvIVL) ;
}
IVL_init1(recvIVL, IVL_CHUNKED, nproc) ;
/*
------------------------------------------
outcounts[] is sendIVL->sizes[]
incounts[] will be recvIVL->sizes[]
fill incounts via a call to MPI_Alltoall()
and then initialize the recvIVL lists.
------------------------------------------
*/
outcounts = sendIVL->sizes ;
incounts = IVinit(nproc, 0) ;
MPI_Alltoall((void *) outcounts, 1, MPI_INT,
(void *) incounts, 1, MPI_INT, comm) ;
for ( q = 0 ; q < nproc ; q++ ) {
IVL_setList(recvIVL, q, incounts[q], NULL) ;
}
IVfree(incounts) ;
/*
---------------------------------------------------
load list myid of sendIVL into list myid of recvIVL
---------------------------------------------------
*/
IVL_listAndSize(sendIVL, myid, &sendcount, &sendvec) ;
IVL_setList(recvIVL, myid, sendcount, sendvec) ;
/*
---------------------------------------------------------
now loop over the processes, send and receive information
---------------------------------------------------------
*/
for ( offset = 1, tag = firsttag ; offset < nproc ; offset++, tag++ ) {
right = (myid + offset) % nproc ;
if ( offset <= myid ) {
left = myid - offset ;
} else {
left = nproc + myid - offset ;
}
IVL_listAndSize(sendIVL, right, &sendcount, &sendvec) ;
IVL_listAndSize(recvIVL, left, &recvcount, &recvvec) ;
if ( sendcount > 0 ) {
destination = right ;
stats[0]++ ;
stats[2] += sendcount*sizeof(int) ;
} else {
destination = MPI_PROC_NULL ;
}
if ( recvcount > 0 ) {
source = left ;
stats[1]++ ;
stats[3] += recvcount*sizeof(int) ;
} else {
source = MPI_PROC_NULL ;
}
if ( msglvl > 2 ) {
fprintf(msgFile,
"\n offset %d, recvcount %d, source %d, sendcount %d, destination %d",
offset, recvcount, source, sendcount, destination) ;
fflush(msgFile) ;
}
/*
-----------------
do a send/receive
-----------------
*/
MPI_Sendrecv((void *) sendvec, sendcount, MPI_INT, destination, tag,
(void *) recvvec, recvcount, MPI_INT, source, tag,
comm, &status) ;
if ( source != MPI_PROC_NULL ) {
MPI_Get_count(&status, MPI_INT, &count) ;
if ( count != recvcount ) {
fprintf(stderr, "\n fatal error in IVL_MPI_alltoall()"
"\n proc %d : source %d, count %d, recvcount %d\n",
myid, source, count, recvcount) ;
exit(-1) ;
}
}
if ( msglvl > 2 ) {
fprintf(msgFile, "\n send/recv completed") ;
fflush(msgFile) ;
}
}
return(recvIVL) ;
}
