/* symbfac.c */ #include "../spoolesMPI.h" #define MYDEBUG 0 /*--------------------------------------------------------------------*/ typedef struct _Msg Msg ; struct _Msg { int id ; int size ; void *base ; MPI_Request req ; Msg *next ; } ; static IVL * initSupportedIVL ( ETree *frontETree, IV *frontOwnersIV, int myid, int msglvl, FILE *msgFile ) ; static void loadInternalIndices ( ETree *frontETree, InpMtx *inpmtxA, InpMtx *inpmtxB, IV *frontOwnersIV, int myid, IVL *symbfacIVL, int msglvl, FILE *msgFile ) ; static void doCooperativeWork ( ETree *frontETree, IV *frontOwnersIV, IVL *symbfacIVL, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) ; static int mergeIndices ( int sizeJ, int indJ[], int sizeK, int indK[], int nleft ) ; static Msg * Msg_new ( void ) ; static void Msg_setDefaultFields ( Msg *msg ) ; static void Msg_clearData ( Msg *msg ) ; static void Msg_free ( Msg *msg ) ; static Msg * wakeupFront ( int J, int myid, int owners[], char supportTable[], ETree *frontETree, IVL *symbfacIVL, int firsttag, int stats[], MPI_Comm comm, int msglvl, FILE *msgFile ) ; static Msg * checkRecvMessages ( int J, Msg *firstmsg, int nLeft[], int nodwghts[], IVL *symbfacIVL, int msglvl, FILE *msgFile ) ; static Msg * sendMessages ( int J, int myid, int owners[], int nfront, int nproc, char supportTable[], int par[], IVL *symbfacIVL, Msg *firstMsgSent, int firsttag, int stats[], MPI_Comm comm, int msglvl, FILE *msgFile ) ; static Msg * checkSendMessages ( Msg *firstMsgSent, int msglvl, FILE *msgFile ) ; /*--------------------------------------------------------------------*/ /* ------------------------------------------------------------ perform the symbolic factorization in parallel input -- frontETree -- front tree for the factorization frontOwnersIV -- map from fronts to owning process inpmtx -- matrix object firsttag -- first tag to be used for messages, will use tag, ..., tag + nfront - 1 msglvl -- message level msgFile -- message file comm -- MPI communicator return value -- symbfacIVL -- contains front indices for supported fronts created -- 98may20, cca ------------------------------------------------------------ */ IVL * SymbFac_MPI_initFromInpMtx ( ETree *frontETree, IV *frontOwnersIV, InpMtx *inpmtx, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) { int lasttag, myid, nproc, tagbound; IVL *symbfacIVL ; /* --------------- check the input --------------- */ if ( frontETree == NULL || frontOwnersIV == NULL || inpmtx == NULL || stats == NULL || (msglvl > 0 && msgFile == NULL) ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromInpMtx()" "\n comm = %p, frontETree = %p, frontOwnersIV = %p" "\n inpmtx = %p, firsttag = %d, msglvl = %d, msgFile = %p" "\n bad input\n", comm, frontETree, frontOwnersIV, inpmtx, firsttag, msglvl, msgFile) ; exit(-1) ; } MPI_Comm_rank(comm, &myid) ; MPI_Comm_size(comm, &nproc) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n myid = %d, nproc = %d", myid, nproc) ; fflush(msgFile) ; } if ( firsttag < 0 ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromInpMtx()" "\n firsttag = %d\n", firsttag) ; exit(-1) ; } lasttag = firsttag + frontETree->nfront ; if ( lasttag > (tagbound = maxTagMPI(comm)) ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromInpMtx()" "\n lasttag = %d, tag_bound = %d", lasttag, tagbound) ; exit(-1) ; } /* -------------------------------------- first, set up the supported IVL object -------------------------------------- */ symbfacIVL = initSupportedIVL(frontETree, frontOwnersIV, myid, msglvl, msgFile) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n local supported IVL after initialization") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------------------ second, fill the index lists of the owned fronts with the internal vertices and boundary vertices available from the matrix pencil ------------------------------------------------------------------ */ loadInternalIndices(frontETree, inpmtx, NULL, frontOwnersIV, myid, symbfacIVL, msglvl, msgFile ) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n after loading internal indices") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------- third, cooperate among the processors to generate the rest of the supported symbolic factorization ------------------------------------------------- */ doCooperativeWork(frontETree, frontOwnersIV, symbfacIVL, stats, msglvl, msgFile, firsttag, comm) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n final local supported IVL ") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } return(symbfacIVL) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------------------ perform the symbolic factorization in parallel input -- frontETree -- front tree for the factorization frontOwnersIV -- map from fronts to owning process pencil -- matrix pencil object firsttag -- first tag to be used for messages, will use tag, ..., tag + nfront - 1 msglvl -- message level msgFile -- message file comm -- MPI communicator return value -- symbfacIVL -- contains front indices for supported fronts created -- 98may20, cca ------------------------------------------------------------ */ IVL * SymbFac_MPI_initFromPencil ( ETree *frontETree, IV *frontOwnersIV, Pencil *pencil, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) { int lasttag, myid, nproc, tagbound; IVL *symbfacIVL ; /* --------------- check the input --------------- */ if ( frontETree == NULL || frontOwnersIV == NULL || pencil == NULL || stats == NULL || (msglvl > 0 && msgFile == NULL) ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromPencil()" "\n comm = %p, frontETree = %p, frontOwnersIV = %p" "\n pencil = %p, firsttag = %d, msglvl = %d, msgFile = %p" "\n bad input\n", comm, frontETree, frontOwnersIV, pencil, firsttag, msglvl, msgFile) ; exit(-1) ; } MPI_Comm_rank(comm, &myid) ; MPI_Comm_size(comm, &nproc) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n myid = %d, nproc = %d", myid, nproc) ; fflush(msgFile) ; } if ( firsttag < 0 ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromPencil()" "\n firsttag = %d\n", firsttag) ; exit(-1) ; } lasttag = firsttag + frontETree->nfront ; if ( lasttag > (tagbound = maxTagMPI(comm)) ) { fprintf(stderr, "\n fatal error in SymbFac_MPI_initFromPencil()" "\n lasttag = %d, tag_bound = %d", lasttag, tagbound) ; exit(-1) ; } /* -------------------------------------- first, set up the supported IVL object -------------------------------------- */ symbfacIVL = initSupportedIVL(frontETree, frontOwnersIV, myid, msglvl, msgFile) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n local supported IVL after initialization") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------------------------ second, fill the index lists of the owned fronts with the internal vertices and boundary vertices available from the matrix pencil ------------------------------------------------------------------ */ loadInternalIndices(frontETree, pencil->inpmtxA, pencil->inpmtxB, frontOwnersIV, myid, symbfacIVL, msglvl, msgFile ) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n after loading internal indices") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } /* ------------------------------------------------- third, cooperate among the processors to generate the rest of the supported symbolic factorization ------------------------------------------------- */ doCooperativeWork(frontETree, frontOwnersIV, symbfacIVL, stats, msglvl, msgFile, firsttag, comm) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n\n final local supported IVL ") ; IVL_writeForHumanEye(symbfacIVL, msgFile) ; fflush(msgFile) ; } return(symbfacIVL) ; } /*--------------------------------------------------------------------*/ /* --------------------------------------------------------------------- purpose -- initialize the symbolic factorization IVL for process myid created -- 98may20 --------------------------------------------------------------------- */ static IVL * initSupportedIVL ( ETree *frontETree, IV *frontOwnersIV, int myid, int msglvl, FILE *msgFile ) { char *frontSupported ; int J, K, nfront ; int *bndwghts, *nodwghts, *owners, *par, *sizes ; IVL *symbfacIVL ; nfront = ETree_nfront(frontETree) ; nodwghts = ETree_nodwghts(frontETree), bndwghts = ETree_bndwghts(frontETree), par = ETree_par(frontETree) ; owners = IV_entries(frontOwnersIV) ; /* ----------------------------------------------------------------- create the frontSupported[] vector, frontSupported[J] = 'Y' --> this process supports front J frontSupported[J] = 'N' --> this process does not support front J ----------------------------------------------------------------- */ frontSupported = CVinit(nfront, 'N') ; for ( J = 0 ; J < nfront ; J++ ) { if ( owners[J] == myid ) { K = J ; while ( K != -1 && frontSupported[K] == 'N' ) { frontSupported[K] = 'Y' ; K = par[K] ; } } } /* ----------------------------------------------- initialize the local symbolic factorization IVL ----------------------------------------------- */ symbfacIVL = IVL_new() ; sizes = IVinit(nfront, 0) ; for ( J = 0 ; J < nfront ; J++ ) { if ( frontSupported[J] == 'Y' ) { sizes[J] = nodwghts[J] + bndwghts[J] ; } } IVL_init3(symbfacIVL, IVL_CHUNKED, nfront, sizes) ; /* ------------------------ free the working storage ------------------------ */ IVfree(sizes) ; CVfree(frontSupported) ; return(symbfacIVL) ; } /*--------------------------------------------------------------------*/ /* -------------------------------------------------------------------- perform the symbolic factorization in parallel input -- frontETree -- front tree for the factorization frontOwnersIV -- map from fronts to owning process pencil -- matrix pencil firsttag -- first tag to be used for messages, will use tag, ..., tag + nfront - 1 msglvl -- message level msgFile -- message file comm -- MPI communicator return value -- symbfacIVL -- contains front indices for supported fronts created -- 98may20, cca -------------------------------------------------------------------- */ static void doCooperativeWork ( ETree *frontETree, IV *frontOwnersIV, IVL *symbfacIVL, int stats[], int msglvl, FILE *msgFile, int firsttag, MPI_Comm comm ) { char *frontIsSupported, *status, *supportTable ; Ideq *dequeue ; int count, ii, iproc, J, K, myid, nDJ, nfront, npath, nproc, nvtx, sizeJ, sizeK ; int *bndwghts, *frontOwners, *indicesJ, *indicesK, *nactiveChild, *nLeft, *nodwghts, *par, *vtxToFront ; Msg *firstMsgSent ; Msg **p_msg ; /* ------------------------------- extract pointers and dimensions ------------------------------- */ nfront = ETree_nfront(frontETree) ; nvtx = ETree_nvtx(frontETree) ; nodwghts = ETree_nodwghts(frontETree), bndwghts = ETree_bndwghts(frontETree), vtxToFront = ETree_vtxToFront(frontETree), par = ETree_par(frontETree) ; IV_sizeAndEntries(frontOwnersIV, &nfront, &frontOwners) ; MPI_Comm_rank(comm, &myid) ; MPI_Comm_size(comm, &nproc) ; if ( msglvl > 2 ) { fprintf(msgFile, "\n\n myid = %d, nproc = %d", myid, nproc) ; fflush(msgFile) ; } /* -------------------------- generate the support table -------------------------- */ supportTable = CVinit(nfront*nproc, 'N') ; for ( J = 0 ; J < nfront ; J++ ) { iproc = frontOwners[J] ; frontIsSupported = supportTable + iproc*nfront ; for ( K = J ; K != -1 && frontIsSupported[K] == 'N' ; K = par[K] ) { frontIsSupported[K] = 'Y' ; } } if ( msglvl > 3 ) { fprintf(msgFile, "\n\n supportTable") ; for ( J = 0 ; J < nfront ; J++ ) { fprintf(msgFile, "\n") ; for ( iproc = 0 ; iproc < nproc ; iproc++ ) { fprintf(msgFile, " %c", supportTable[J + iproc*nfront]) ; } } fflush(msgFile) ; } /* --------------------------------------------------------- initialize the status[] and nactiveChild[] vectors and load the dequeue with the leaves of the supported subtree --------------------------------------------------------- */ frontIsSupported = supportTable + myid*nfront ; status = CVinit(nfront, 'F') ; for ( J = npath = 0 ; J < nfront ; J++ ) { if ( status[J] == 'F' && frontIsSupported[J] == 'Y' ) { npath++ ; for ( K = J ; K != -1 && status[K] == 'F' ; K = par[K] ) { status[K] = 'W' ; } } } dequeue = Ideq_new() ; Ideq_resize(dequeue, npath) ; nactiveChild = IVinit(nfront, 0) ; for ( J = 0 ; J < nfront ; J++ ) { if ( status[J] == 'W' ) { if ( (K = par[J]) != -1 ) { nactiveChild[K]++ ; } } } for ( J = 0 ; J < nfront ; J++ ) { if ( frontOwners[J] == myid && nactiveChild[J] == 0 ) { Ideq_insertAtTail(dequeue, J) ; } } /* --------------------------- generate the nLeft[] vector --------------------------- */ nLeft = IVinit(nfront, -1) ; for ( J = 0 ; J < nfront ; J++ ) { if ( frontOwners[J] == myid ) { IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; for ( ii = sizeJ - 1, count = 0 ; ii >= 0 ; ii-- ) { if ( indicesJ[ii] != -1 ) { break ; } count++ ; } nLeft[J] = count ; } } /* ------------------------------------------- generate the vector of pointers to messages ------------------------------------------- */ firstMsgSent = NULL ; ALLOCATE(p_msg, struct _Msg *, nfront) ; for ( J = 0 ; J < nfront ; J++ ) { p_msg[J] = NULL ; } /* ---------------------------------- loop while the dequeue is nonempty ---------------------------------- */ while ( (J = Ideq_removeFromHead(dequeue)) != -1 ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n\n ### popping %d from dequeue", J) ; fflush(msgFile) ; } if ( status[J] == 'W' ) { /* -------------------------------------------- wake up the front, post its receive messages -------------------------------------------- */ p_msg[J] = wakeupFront(J, myid, frontOwners, supportTable, frontETree, symbfacIVL, firsttag, stats, comm, msglvl, msgFile) ; status[J] = 'A' ; } if ( p_msg[J] != NULL ) { /* ----------------------------- try to receive messages for J ----------------------------- */ p_msg[J] = checkRecvMessages(J, p_msg[J], nLeft, nodwghts, symbfacIVL, msglvl, msgFile) ; } if ( p_msg[J] == NULL ) { if ( msglvl > 3 ) { IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; fprintf(msgFile, "\n adjacency list for J = %d, nJ = %d, bndJ = %d", J, nodwghts[J], bndwghts[J]) ; IVfprintf(msgFile, sizeJ, indicesJ) ; fflush(msgFile) ; } /* ------------------------------------------- all messages received: check for the length of the indices vector, set the boundary size of the front ------------------------------------------ */ status[J] = 'D' ; IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; for ( ii = 0 ; ii < sizeJ ; ii++ ) { if ( indicesJ[ii] == -1 ) { break ; } } if ( ii != sizeJ ) { if ( msglvl > 3 ) { fprintf(msgFile, "\n WHOA, front J %d, sizeJ %d", J, sizeJ); fprintf(msgFile, "\n old bndwght = %d, new bndwght = %d", bndwghts[J], ii - nodwghts[J]) ; IVfprintf(msgFile, sizeJ, indicesJ) ; fflush(msgFile) ; } bndwghts[J] = ii - nodwghts[J] ; IVL_setList(symbfacIVL, J, ii, indicesJ) ; } if ( frontOwners[J] == myid ) { /* ------------------------------------------ front is owned, send messages if necessary ------------------------------------------ */ firstMsgSent = sendMessages(J, myid, frontOwners, nfront, nproc, supportTable, par, symbfacIVL, firstMsgSent, firsttag, stats, comm, msglvl, msgFile) ; } if ( (K = par[J]) != -1 ) { if ( frontOwners[K] == myid && nLeft[K] > 0 ) { /* ------------------------------ merge bnd{J} into K cup bnd{K} ------------------------------ */ nDJ = nodwghts[J] ; IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; IVL_listAndSize(symbfacIVL, K, &sizeK, &indicesK) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n merging J = %d into K = %d", J, K) ; fprintf(msgFile, ", nleft = %d", nLeft[K]) ; fprintf(msgFile, "\n before, boundary indices of J") ; IVfprintf(msgFile, sizeJ - nDJ, indicesJ + nDJ) ; fprintf(msgFile, "\n before, indices of K") ; IVfprintf(msgFile, sizeK, indicesK) ; } nLeft[K] = mergeIndices(sizeJ - nDJ, indicesJ + nDJ, sizeK, indicesK, nLeft[K]) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n after, indices of K, nleft = %d", nLeft[K]) ; IVfprintf(msgFile, sizeK, indicesK) ; } } if ( --nactiveChild[K] == 0 ) { /* ---------------------- put K on head of queue ---------------------- */ Ideq_insertAtHead(dequeue, K) ; } } } else { /* ---------------------- put J on tail of queue ---------------------- */ Ideq_insertAtTail(dequeue, J) ; } firstMsgSent = checkSendMessages(firstMsgSent, msglvl, msgFile) ; } /* ------------------------------------------ check for all sent messages to be received ------------------------------------------ */ do { firstMsgSent = checkSendMessages(firstMsgSent, msglvl, msgFile) ; } while ( firstMsgSent != NULL ) ; /* -------------------------------- post-process the adjacency lists -------------------------------- */ /* if ( msglvl > 2 ) { fprintf(msgFile, "\n bndwghts") ; IVfprintf(msgFile, nfront, bndwghts) ; fprintf(msgFile, "\n nodwghts") ; IVfprintf(msgFile, nfront, nodwghts) ; } frontIsSupported = supportTable + myid*nfront ; for ( J = 0 ; J < nfront ; J++ ) { if ( frontIsSupported[J] == 'Y' ) { IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; for ( ii = 0 ; ii < sizeJ ; ii++ ) { if ( indicesJ[ii] == -1 ) { break ; } } if ( ii != sizeJ ) { if ( msglvl > 3 ) { fprintf(msgFile, "\n WHOA, front J %d, sizeJ %d", J, sizeJ); fprintf(msgFile, "\n old bndwght = %d, new bndwght = %d", bndwghts[J], ii - nodwghts[J]) ; IVfprintf(msgFile, sizeJ, indicesJ) ; fflush(msgFile) ; } bndwghts[J] = ii - nodwghts[J] ; IVL_setList(symbfacIVL, J, ii, indicesJ) ; } } } */ /* ------------------------ free the working storage ------------------------ */ CVfree(supportTable) ; CVfree(status) ; IVfree(nactiveChild) ; IVfree(nLeft) ; Ideq_free(dequeue) ; FREE(p_msg) ; return ; } /*--------------------------------------------------------------------*/ /* ----------------------- constructor created -- 98may20, cca ----------------------- */ static Msg * Msg_new ( void ) { Msg *msg ; ALLOCATE(msg, struct _Msg, 1) ; Msg_setDefaultFields(msg) ; return(msg) ; } /*--------------------------------------------------------------------*/ /* ----------------------- set the default fields created -- 98may20, cca ----------------------- */ static void Msg_setDefaultFields ( Msg *msg ) { msg->id = -1 ; msg->size = 0 ; msg->base = NULL ; msg->next = NULL ; return ; } /*--------------------------------------------------------------------*/ /* ----------------------- clear the data created -- 98may20, cca ----------------------- */ static void Msg_clearData ( Msg *msg ) { Msg_setDefaultFields(msg) ; return ; } /*--------------------------------------------------------------------*/ /* ----------------------- free the object created -- 98may20, cca ----------------------- */ static void Msg_free ( Msg *msg ) { Msg_clearData(msg) ; FREE(msg) ; return ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------------------- when front J is first examined, post Irecv's for its messages created -- 98may20, cca ------------------------------------------------------------- */ static Msg * wakeupFront ( int J, int myid, int owners[], char supportTable[], ETree *frontETree, IVL *symbfacIVL, int firsttag, int stats[], MPI_Comm comm, int msglvl, FILE *msgFile ) { Msg *first, *msg ; int I, nfront ; int *bndwghts, *fch, *indices, *nodwghts, *sib ; nfront = ETree_nfront(frontETree) ; first = NULL ; if ( owners[J] == myid ) { /* --------------------------------------------------- owned front, post messages for unsupported children --------------------------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n\n waking up owned front %d", J) ; fflush(msgFile) ; } fch = ETree_fch(frontETree) ; sib = ETree_sib(frontETree) ; nodwghts = ETree_nodwghts(frontETree) ; bndwghts = ETree_bndwghts(frontETree) ; for ( I = fch[J] ; I != -1 ; I = sib[I] ) { if ( supportTable[I + myid*nfront] != 'Y' ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n unsupported child %d", I) ; fflush(msgFile) ; } /* -------------------------------------------------------- create a message, allocate temporary storage for indices -------------------------------------------------------- */ msg = Msg_new() ; msg->id = I ; msg->size = nodwghts[I] + bndwghts[I] ; msg->base = (void *) IVinit(msg->size, -1) ; msg->next = first ; first = msg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n 1. posting Irecv, msg %p, source = %d, tag = %d", msg, owners[I], firsttag + I) ; fflush(msgFile) ; } stats[1]++ ; stats[3] += msg->size * sizeof(int) ; MPI_Irecv(msg->base, msg->size, MPI_INT, owners[I], firsttag + I, comm, &msg->req) ; } } } else if ( supportTable[J + myid*nfront] == 'Y' ) { /* -------------------------------------------------------- supported but not owned. create a message but point into storage for the indices in the symbolic IVL object. -------------------------------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n\n waking up supported front %d", J) ; fflush(msgFile) ; } msg = Msg_new() ; msg->id = J ; IVL_listAndSize(symbfacIVL, J, &msg->size, &indices) ; msg->base = (void *) indices ; msg->next = first ; first = msg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n 1. posting Irecv, msg %p, source = %d, tag = %d", msg, owners[J], firsttag + J) ; fflush(msgFile) ; } stats[1]++ ; stats[3] += msg->size * sizeof(int) ; MPI_Irecv(msg->base, msg->size, MPI_INT, owners[J], firsttag + J, comm, &msg->req) ; } return(first) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------------------- check the messages waiting to be received for front J return value -- pointer to first message still to be received created -- 98may20, cca ------------------------------------------------------------- */ static Msg * checkRecvMessages ( int J, Msg *firstmsg, int nLeft[], int nodwghts[], IVL *symbfacIVL, int msglvl, FILE *msgFile ) { int flag, I, nDI, sizeI, sizeJ ; int *indicesI, *indicesJ ; MPI_Status status ; Msg *msg, *nextmsg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n checking for received messages") ; fflush(msgFile) ; } for ( msg = firstmsg, firstmsg = NULL ; msg != NULL ; msg = nextmsg ) { nextmsg = msg->next ; msg->next = NULL ; if ( msglvl > 2 ) { fprintf(msgFile, "\n checking msg %p : id %d, size %d", msg, msg->id, msg->size) ; fflush(msgFile) ; } MPI_Test(&msg->req, &flag, &status) ; if ( msglvl > 2 ) { fprintf(msgFile, ", flag = %d", flag) ; fflush(msgFile) ; } if ( flag != 0 ) { if ( msg->id == J ) { /* -------------------------------- J is supported but not owned, indices are in the symbolic IVL, free the message -------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n supported front %d", J) ; fflush(msgFile) ; } Msg_free(msg) ; } else { /* --------------------------------------------------- message is from an unsupported child merge indices, then free indices, then free message --------------------------------------------------- */ if ( msglvl > 2 ) { fprintf(msgFile, "\n unsupported child front %d", msg->id) ; fflush(msgFile) ; } if ( nLeft[J] > 0 ) { I = msg->id ; nDI = nodwghts[I] ; sizeI = msg->size - nDI ; indicesI = (int *) msg->base + nDI ; /* sizeI = msg->size ; indicesI = (int *) msg->base ; */ IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; if ( msglvl > 3 ) { fprintf(msgFile, "\n merging I = %d into J = %d", I, J) ; fprintf(msgFile, ", nleft = %d", nLeft[J]) ; fprintf(msgFile, "\n before, boundary indices of I") ; IVfprintf(msgFile, sizeI, indicesI) ; fprintf(msgFile, "\n before, indices of J") ; IVfprintf(msgFile, sizeJ, indicesJ) ; } nLeft[J] = mergeIndices(sizeI, indicesI, sizeJ, indicesJ, nLeft[J]) ; } if ( msglvl > 3 ) { fprintf(msgFile, "\n after, indices of J, nleft = %d", nLeft[J]) ; IVfprintf(msgFile, sizeJ, indicesJ) ; } IVfree(msg->base) ; Msg_free(msg) ; } } else { /* ---------------------------- keep the message on the list ---------------------------- */ msg->next = firstmsg ; firstmsg = msg ; } } return(firstmsg) ; } /*--------------------------------------------------------------------*/ /* */ static Msg * sendMessages ( int J, int myid, int owners[], int nfront, int nproc, char supportTable[], int par[], IVL *symbfacIVL, Msg *firstMsgSent, int firsttag, int stats[], MPI_Comm comm, int msglvl, FILE *msgFile ) { int destination, K, sizeJ ; int *indicesJ ; Msg *msg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n ready to send messages") ; fflush(msgFile) ; } /* ------------------------------- get size and pointer to indices ------------------------------- */ IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; /* ----------------------------------- send indices to supported processes ----------------------------------- */ for ( destination = 0 ; destination < nproc ; destination++ ) { if ( destination != myid && supportTable[J + destination*nfront] == 'Y' ) { msg = Msg_new() ; msg->id = J ; msg->size = sizeJ ; msg->base = (void *) indicesJ ; msg->next = firstMsgSent ; firstMsgSent = msg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n 1. posting Isend, msg %p, destination = %d, tag = %d", msg, destination, firsttag + J) ; fflush(msgFile) ; } stats[0]++ ; stats[2] += msg->size * sizeof(int) ; MPI_Isend(msg->base, msg->size, MPI_INT, destination, firsttag + J, comm, &msg->req) ; } } if ( (K = par[J]) != -1 && supportTable[J + owners[K]*nfront] != 'Y' ) { /* ---------------------------------------------------- send indices to unsupported process that owns parent ---------------------------------------------------- */ msg = Msg_new() ; msg->id = J ; msg->size = sizeJ ; msg->base = (void *) indicesJ ; msg->next = firstMsgSent ; firstMsgSent = msg ; if ( msglvl > 2 ) { fprintf(msgFile, "\n 2. posting Isend, msg %p, destination = %d, tag = %d", msg, owners[K], firsttag + J) ; fflush(msgFile) ; } stats[0]++ ; stats[2] += msg->size * sizeof(int) ; MPI_Isend(msg->base, msg->size, MPI_INT, owners[K], firsttag + J, comm, &msg->req) ; } return(firstMsgSent) ; } /*--------------------------------------------------------------------*/ /* --------------------------------------------------------------- merge indices in indJ[sizeJ] into indK[sizeK], there are nleft free locations at the end of indK[]. both indJ[sizeJ] and indK[sizeK] are in ascending order. return value is the number of present free locations in indK[]. created -- 98may20, cca --------------------------------------------------------------- */ static int mergeIndices ( int sizeJ, int indJ[], int sizeK, int indK[], int nleft ) { int firstK, ii, jj, jlast, kk, v ; firstK = indK[0] ; kk = jlast = sizeK - nleft ; ii = 0, jj = 0 ; while ( ii < sizeJ && jj < jlast ) { v = indJ[ii] ; if ( v < firstK ) { ii++ ; } else if ( v < indK[jj] ) { indK[kk++] = v ; ii++ ; } else if ( v == indK[jj] ) { ii++, jj++ ; } else { jj++ ; } } for ( ; ii < sizeJ ; ii++ ) { v = indJ[ii] ; if ( v >= 0 ) { indK[kk++] = indJ[ii] ; } } if ( kk > jlast ) { IVqsortUp(kk, indK) ; } return(sizeK - kk) ; } /*--------------------------------------------------------------------*/ /* ------------------------------------------------------------------ load the owned index lists with information from the InpMtx object created -- 98may20, cca ------------------------------------------------------------------ */ static void loadInternalIndices ( ETree *frontETree, InpMtx *inpmtxA, InpMtx *inpmtxB, IV *frontOwnersIV, int myid, IVL *symbfacIVL, int msglvl, FILE *msgFile ) { int count, ii, J, nfront, nvtx, off, sizeJ, v, vsize, w ; int *frontOwners, *head, *indicesJ, *link, *mark, *vind, *vtxToFront ; nfront = ETree_nfront(frontETree) ; nvtx = ETree_nvtx(frontETree) ; vtxToFront = ETree_vtxToFront(frontETree) ; frontOwners = IV_entries(frontOwnersIV) ; /* ------------------------------------------------- set up the lists of vertices for each owned front ------------------------------------------------- */ head = IVinit(nfront, -1) ; link = IVinit(nvtx, -1) ; mark = IVinit(nvtx, -1) ; for ( v = 0 ; v < nvtx ; v++ ) { J = vtxToFront[v] ; if ( frontOwners[J] == myid ) { link[v] = head[J] ; head[J] = v ; } } /* -------------------------------------------------------- load the internal indices into the owned adjacency lists -------------------------------------------------------- */ for ( J = 0 ; J < nfront ; J++ ) { if ( frontOwners[J] == myid ) { IVL_listAndSize(symbfacIVL, J, &sizeJ, &indicesJ) ; count = 0 ; /* --------------------- load internal indices --------------------- */ for ( v = head[J] ; v != -1 ; v = link[v] ) { mark[v] = J ; indicesJ[count++] = v ; } /* ----------------------------------------- load indices from the first InpMtx object ----------------------------------------- */ for ( v = head[J] ; v != -1 && count < sizeJ ; v = link[v] ) { InpMtx_vector(inpmtxA, v, &vsize, &vind) ; for ( ii = 0 ; ii < vsize && count < sizeJ ; ii++ ) { off = vind[ii] ; if ( off >= 0 ) { w = v + off ; } else { w = v - off ; } if ( vtxToFront[w] < J ) { fprintf(msgFile, "\n error, J = %d, w = %d, map[%d] = %d", J, w, w, vtxToFront[w]) ; exit(-1) ; } if ( mark[w] != J ) { mark[w] = J ; indicesJ[count++] = w ; } } } if ( inpmtxB != NULL ) { /* ------------------- load indices from B ------------------- */ for ( v = head[J] ; v != -1 && count < sizeJ ; v = link[v] ) { InpMtx_vector(inpmtxB, v, &vsize, &vind) ; for ( ii = 0 ; ii < vsize && count < sizeJ ; ii++ ) { off = vind[ii] ; if ( off >= 0 ) { w = v + off ; } else { w = v - off ; } if ( vtxToFront[w] < J ) { fprintf(msgFile, "\n error, J = %d, w = %d, map[%d] = %d", J, w, w, vtxToFront[w]) ; exit(-1) ; } if ( mark[w] != J ) { mark[w] = J ; indicesJ[count++] = w ; } } } } /* ----------------------------------- sort the indices in ascending order ----------------------------------- */ IVqsortUp(count, indicesJ) ; } } /* ------------------------ free the working storage ------------------------ */ IVfree(head) ; IVfree(link) ; IVfree(mark) ; return ; } /*--------------------------------------------------------------------*/ /* */ static Msg * checkSendMessages ( Msg *firstMsgSent, int msglvl, FILE *msgFile ) { int flag ; MPI_Status status ; Msg *msg, *nextmsg ; if ( firstMsgSent != NULL ) { if ( msglvl > 2 ) { fprintf(msgFile, "\n checking for sent messages") ; fflush(msgFile) ; } for ( msg = firstMsgSent, firstMsgSent = NULL ; msg != NULL ; msg = nextmsg ) { nextmsg = msg->next ; if ( msglvl > 2 ) { fprintf(msgFile, "\n checking msg %p : id %d, size %d", msg, msg->id, msg->size) ; fflush(msgFile) ; } MPI_Test(&msg->req, &flag, &status) ; if ( msglvl > 2 ) { fprintf(msgFile, ", flag = %d", flag) ; fflush(msgFile) ; } if ( flag != 0 ) { if ( msglvl > 2 ) { fprintf(msgFile, ", free'ing object") ; fflush(msgFile) ; } Msg_free(msg) ; } else { msg->next = firstMsgSent ; firstMsgSent = msg ; } } } return(firstMsgSent) ; } /*--------------------------------------------------------------------*/