void kass(int levelk, int rat, SymbolMatrix * symbptr, PASTIX_INT baseval, PASTIX_INT vertnbr, PASTIX_INT edgenbr, PASTIX_INT * verttab, PASTIX_INT * edgetab, Order * orderptr, MPI_Comm pastix_comm) { PASTIX_INT snodenbr; PASTIX_INT *snodetab = NULL; PASTIX_INT *treetab = NULL; PASTIX_INT *ia = NULL; PASTIX_INT *ja = NULL; PASTIX_INT i, j, n; PASTIX_INT ind; csptr mat; PASTIX_INT *tmpj = NULL; PASTIX_INT *perm = NULL; PASTIX_INT *iperm = NULL; PASTIX_INT newcblknbr; PASTIX_INT *newrangtab = NULL; Dof dofstr; Clock timer1; double nnzS; int procnum; (void)edgenbr; MPI_Comm_rank(pastix_comm,&procnum); #ifdef DEBUG_KASS print_one("--- kass begin ---\n"); #endif /* graphData (graphptr, */ /* (SCOTCH_Num * )&baseval, */ /* (SCOTCH_Num * )&vertnbr, */ /* (SCOTCH_Num **)&verttab, */ /* NULL, NULL, NULL, */ /* (SCOTCH_Num * )&edgenbr, */ /* (SCOTCH_Num **)&edgetab, */ /* NULL); */ n = vertnbr; ia = verttab; ja = edgetab; perm = orderptr->permtab; iperm = orderptr->peritab; /*** Convert Fortran to C numbering ***/ if(baseval == 1) { for(i=0;i<=n;i++) ia[i]--; for(i=0;i<n;i++) for(j=ia[i];j<ia[i+1];j++) ja[j]--; for(i=0;i<n;i++) orderptr->permtab[i]--; for(i=0;i<n;i++) orderptr->peritab[i]--; } MALLOC_INTERN(treetab, n, PASTIX_INT); #ifndef SCOTCH_SNODE /*if(rat != -1 )*/ { /***** FIND THE SUPERNODE PARTITION FROM SCRATCH ********/ /*** Find the supernodes of the direct factorization ***/ MALLOC_INTERN(snodetab, n+1, PASTIX_INT); clockInit(&timer1); clockStart(&timer1); find_supernodes(n, ia, ja, perm, iperm, &snodenbr, snodetab, treetab); clockStop(&timer1); print_one("Time to find the supernode (direct) %.3g s \n", clockVal(&timer1)); /*memfree(treetab);*/ print_one("Number of supernode for direct factorization %ld \n", (long)snodenbr); } #else /*else*/ { /***** USE THE SUPERNODE PARTITION OF SCOTCH ********/ snodenbr = orderptr->cblknbr; MALLOC_INTERN(snodetab, n+1, PASTIX_INT); memCpy(snodetab, orderptr->rangtab, sizeof(PASTIX_INT)*(snodenbr+1)); print_one("Number of column block found in scotch (direct) %ld \n", (long)snodenbr); } #endif /****************************************/ /* Convert the graph */ /****************************************/ MALLOC_INTERN(mat, 1, struct SparRow); initCS(mat, n); MALLOC_INTERN(tmpj, n, PASTIX_INT); /**** Convert and permute the matrix in sparrow form ****/ /**** The diagonal is not present in the CSR matrix, we have to put it in the matrix ***/ bzero(tmpj, sizeof(PASTIX_INT)*n); for(i=0;i<n;i++) { /*** THE GRAPH DOES NOT CONTAIN THE DIAGONAL WE ADD IT ***/ tmpj[0] = i; ind = 1; for(j=ia[i];j<ia[i+1];j++) tmpj[ind++] = ja[j]; mat->nnzrow[i] = ind; MALLOC_INTERN(mat->ja[i], ind, PASTIX_INT); memCpy(mat->ja[i], tmpj, sizeof(PASTIX_INT)*ind); mat->ma[i] = NULL; } CS_Perm(mat, perm); /*** Reorder the matrix ***/ sort_row(mat); memFree(tmpj); /***** COMPUTE THE SYMBOL MATRIX OF ILU(K) WITH AMALGAMATION *****/ kass_symbol(mat, levelk, (double)(rat)/100.0, perm, iperm, snodenbr, snodetab, treetab, &newcblknbr, &newrangtab, symbptr, pastix_comm); cleanCS(mat); memFree(mat); memFree(treetab); dofInit(&dofstr); dofConstant(&dofstr, 0, symbptr->nodenbr, 1); nnzS = recursive_sum(0, symbptr->cblknbr-1, nnz, symbptr, &dofstr); print_one("Number of non zero in the non patched symbol matrix = %g, fillrate1 %.3g \n", nnzS+n, (nnzS+n)/(ia[n]/2.0 +n)); dofExit(&dofstr); if(symbolCheck(symbptr) != 0) { errorPrint("SymbolCheck after kass_symbol."); ASSERT(0, MOD_KASS); } if(levelk != -1) { /********************************************************/ /** ADD BLOCKS IN ORDER TO GET A REAL ELIMINATION TREE **/ /********************************************************/ Patch_SymbolMatrix(symbptr); } dofInit(&dofstr); dofConstant(&dofstr, 0, symbptr->nodenbr, 1); nnzS = recursive_sum(0, symbptr->cblknbr-1, nnz, symbptr, &dofstr); dofExit(&dofstr); print_one("Number of block in final symbol matrix = %ld \n", (long)symbptr->bloknbr); print_one("Number of non zero in final symbol matrix = %g, fillrate2 %.3g \n", nnzS+n, (nnzS+n)/(ia[n]/2.0 +n)); if(symbolCheck(symbptr) != 0) { errorPrint("SymbolCheck after Patch_SymbolMatrix."); ASSERT(0, MOD_KASS); } #ifdef DEBUG_KASS print_one("--- kass end ---\n"); #endif memFree(snodetab); orderptr->cblknbr = newcblknbr; memFree(orderptr->rangtab); orderptr->rangtab = newrangtab; }
void kass_symbol(csptr mat, PASTIX_INT levelk, double rat, PASTIX_INT *perm, PASTIX_INT *iperm, PASTIX_INT snodenbr, PASTIX_INT *snodetab, PASTIX_INT *streetab, PASTIX_INT *cblknbr, PASTIX_INT **rangtab, SymbolMatrix *symbmtx, MPI_Comm pastix_comm) { /**************************************************************************************/ /* This function computes a symbolic factorization ILU(k) given a CSR matrix and an */ /* ordering. Then it computes a block partition of the factor to get BLAS3 */ /* efficiency */ /* NOTE: the CSC matrix is given symmetrized and without the diagonal */ /**************************************************************************************/ PASTIX_INT i, j; PASTIX_INT nnzL; PASTIX_INT *iperm2 = NULL; PASTIX_INT *treetab = NULL; PASTIX_INT n; csptr P; Clock timer1; int procnum; MPI_Comm_rank(pastix_comm,&procnum); n = mat->n; MALLOC_INTERN(iperm2, n, PASTIX_INT); /*compact_graph(mat, NULL, NULL, NULL);*/ /*** Compute the ILU(k) pattern of the quotient matrix ***/ MALLOC_INTERN(P, 1, struct SparRow); initCS(P, n); print_one("Level of fill = %ld\nAmalgamation ratio = %d \n", (long)levelk, (int)(rat*100)); clockInit(&timer1); clockStart(&timer1); if(levelk == -1) { /***** FACTORISATION DIRECT *******/ /***** (Re)compute also the streetab (usefull when SCOTCH_SNODE is active) ***/ SF_Direct(mat, snodenbr, snodetab, streetab, P); clockStop(&timer1); print_one("Time to compute scalar symbolic direct factorization %.3g s \n", clockVal(&timer1)); #ifdef DEBUG_KASS print_one("non-zeros in P = %ld \n", (long)CSnnz(P)); #endif nnzL = 0; for(i=0;i<P->n;i++) { PASTIX_INT ncol; ncol = snodetab[i+1]-snodetab[i]; nnzL += (ncol*(ncol+1))/2; #ifdef DEBUG_KASS ASSERT(P->nnzrow[i] >= ncol, MOD_KASS); if(P->nnzrow[i] >= n) fprintf(stderr,"P->nnzrow[%ld] = %ld \n", (long)i, (long)P->nnzrow[i]); ASSERT(P->nnzrow[i] < n, MOD_KASS); #endif nnzL += (P->nnzrow[i]-ncol)*ncol; } #ifdef DEBUG_KASS print_one("NNZL = %ld \n", (long)nnzL); #endif } else { /***** FACTORISATION INCOMPLETE *******/ nnzL = SF_level(2, mat, levelk, P); clockStop(&timer1); print_one("Time to compute scalar symbolic factorization of ILU(%ld) %.3g s \n", (long)levelk, clockVal(&timer1)); } print_one("Scalar nnza = %ld nnzlk = %ld, fillrate0 = %.3g \n", (long)( CSnnz(mat) + n)/2, (long)nnzL, (double)nnzL/(double)( (CSnnz(mat)+n)/2.0 )); /** Sort the rows of the symbolic matrix */ sort_row(P); clockInit(&timer1); clockStart(&timer1); if(levelk != -1) { /********************************/ /** Compute the "k-supernodes" **/ /********************************/ #ifdef KS assert(levelk >= 0); KSupernodes(P, rat, snodenbr, snodetab, cblknbr, rangtab); #else #ifdef SCOTCH_SNODE if(rat == -1) assert(0); /** do not have treetab with this version of Scotch **/ #endif MALLOC_INTERN(treetab, P->n, PASTIX_INT); for(j=0;j<snodenbr;j++) { for(i=snodetab[j];i<snodetab[j+1]-1;i++) treetab[i] = i+1; /*** Version generale ****/ if(streetab[j] == -1 || streetab[j] == j) treetab[i] = -1; else treetab[i]=snodetab[streetab[j]]; /*** Version restricted inside the supernode (like KSupernodes) ***/ /*treetab[snodetab[j+1]-1] = -1;*/ /** this should give the same results than KSupernodes **/ } /** NEW ILUK + DIRECT **/ amalgamate(rat, P, -1, NULL, treetab, cblknbr, rangtab, iperm2, pastix_comm); memFree(treetab); for(i=0;i<n;i++) iperm2[i] = iperm[iperm2[i]]; memcpy(iperm, iperm2, sizeof(PASTIX_INT)*n); for(i=0;i<n;i++) perm[iperm[i]] = i; #endif } else{ /*if(0)*/ { amalgamate(rat, P, snodenbr, snodetab, streetab, cblknbr, rangtab, iperm2, pastix_comm); /** iperm2 is the iperm vector of P **/ for(i=0;i<n;i++) iperm2[i] = iperm[iperm2[i]]; memcpy(iperm, iperm2, sizeof(PASTIX_INT)*n); for(i=0;i<n;i++) perm[iperm[i]] = i; } /*else { fprintf(stderr, "RAT = 0 SKIP amalgamation \n"); *cblknbr = snodenbr; MALLOC_INTERN(*rangtab, snodenbr+1, PASTIX_INT); memcpy(*rangtab, snodetab, sizeof(PASTIX_INT)*(snodenbr+1)); }*/ } clockStop(&timer1); print_one("Time to compute the amalgamation of supernodes %.3g s\n", clockVal(&timer1)); print_one("Number of cblk in the amalgamated symbol matrix = %ld \n", (long)*cblknbr); Build_SymbolMatrix(P, *cblknbr, *rangtab, symbmtx); print_one("Number of block in the non patched symbol matrix = %ld \n", (long)symbmtx->bloknbr); memFree(iperm2); cleanCS(P); memFree(P); }
void Patch_SymbolMatrix(SymbolMatrix *symbmtx) { PASTIX_INT i,j, k; PASTIX_INT vroot; PASTIX_INT *father = NULL; /** For the cblk of the symbol matrix **/ SymbolBlok *newbloktab = NULL; SymbolCblk *cblktab = NULL; SymbolBlok *bloktab = NULL; csptr Q; cblktab = symbmtx->cblktab; bloktab = symbmtx->bloktab; MALLOC_INTERN(father, symbmtx->cblknbr, PASTIX_INT); MALLOC_INTERN(newbloktab, symbmtx->bloknbr + symbmtx->cblknbr, SymbolBlok); MALLOC_INTERN(Q, 1, struct SparRow); initCS(Q, symbmtx->cblknbr); /* Count how many extra-diagonal bloks are facing each diagonal blok */ for(i=0;i<symbmtx->cblknbr;i++) for(j=cblktab[i].bloknum+1;j<cblktab[i+1].bloknum;j++) Q->nnzrow[bloktab[j].cblknum]++; /* Allocate nFacingBlok integer for each diagonal blok */ for(i=0;i<symbmtx->cblknbr;i++) { MALLOC_INTERN(Q->ja[i], Q->nnzrow[i], PASTIX_INT); Q->ma[i] = NULL; } for(i=0;i<symbmtx->cblknbr;i++) Q->nnzrow[i] = 0; /* Q->ja[k] will contain, for each extra-diagonal facing blok * of the column blok k, its column blok. */ for(i=0;i<symbmtx->cblknbr;i++) for(j=cblktab[i].bloknum+1;j<cblktab[i+1].bloknum;j++) { k = bloktab[j].cblknum; Q->ja[k][Q->nnzrow[k]++] = i; } for(i=0;i<Q->n;i++) father[i] = -1; for(i=0;i<Q->n;i++) { /* for each blok facing diagonal blok i, * belonging to column blok k. * */ for(j=0;j<Q->nnzrow[i];j++) { k = Q->ja[i][j]; #ifdef DEBUG_KASS assert(k<i); #endif vroot = k; while(father[vroot] != -1 && father[vroot] != i) vroot = father[vroot]; father[vroot] = i; } } for(i=0;i<Q->n;i++) if(father[i] == -1) father[i]=i+1; cleanCS(Q); memFree(Q); k = 0; for(i=0;i<symbmtx->cblknbr-1;i++) { PASTIX_INT odb, fbloknum; fbloknum = cblktab[i].bloknum; memCpy(newbloktab+k, bloktab + fbloknum, sizeof(SymbolBlok)); cblktab[i].bloknum = k; k++; odb = cblktab[i+1].bloknum-fbloknum; if(odb <= 1 || bloktab[fbloknum+1].cblknum != father[i]) { /** Add a blok toward the father **/ newbloktab[k].frownum = cblktab[ father[i] ].fcolnum; newbloktab[k].lrownum = cblktab[ father[i] ].fcolnum; /** OIMBE try lcolnum **/ newbloktab[k].cblknum = father[i]; #ifdef DEBUG_KASS if(father[i] != i) assert(cblktab[father[i]].fcolnum > cblktab[i].lcolnum); #endif newbloktab[k].levfval = 0; k++; } if( odb > 1) { memCpy(newbloktab +k, bloktab + fbloknum+1, sizeof(SymbolBlok)*(odb-1)); k+=odb-1; } } /** Copy the last one **/ memCpy(newbloktab+k, bloktab + symbmtx->cblktab[symbmtx->cblknbr-1].bloknum, sizeof(SymbolBlok)); cblktab[symbmtx->cblknbr-1].bloknum = k; k++; /** Virtual cblk **/ symbmtx->cblktab[symbmtx->cblknbr].bloknum = k; #ifdef DEBUG_KASS assert(k >= symbmtx->bloknbr); assert(k < symbmtx->cblknbr+symbmtx->bloknbr); #endif symbmtx->bloknbr = k; memFree(symbmtx->bloktab); MALLOC_INTERN(symbmtx->bloktab, k, SymbolBlok); memCpy( symbmtx->bloktab, newbloktab, sizeof(SymbolBlok)*symbmtx->bloknbr); /* virtual cblk to avoid side effect in the loops on cblk bloks */ cblktab[symbmtx->cblknbr].bloknum = k; memFree(father); memFree(newbloktab); }
/*-------------------- end protos */ int arms2(csptr Amat, int *ipar, double *droptol, int *lfil, double tolind, arms PreMat, FILE *ft) { /*--------------------------------------------------------------------- | MULTI-LEVEL BLOCK ILUT PRECONDITIONER. | ealier version: June 23, 1999 BJS -- | version2: Dec. 07th, 2000, YS [reorganized ] | version 3 (latest) Aug. 2005. [reorganized + includes ddpq] +---------------------------------------------------------------------- | ON ENTRY: | ========= | ( Amat ) = original matrix A stored in C-style Compressed Sparse | Row (CSR) format -- | see LIB/heads.h for the formal definition of this format. | | ipar[0:17] = integer array to store parameters for | arms construction (arms2) | | ipar[0]:=nlev. number of levels (reduction processes). | see also "on return" below. | | ipar[1]:= level-reordering option to be used. | if ipar[1]==0 ARMS uses a block independent set ordering | with a sort of reverse cutill Mc Kee ordering to build | the blocks. This yields a symmetric ordering. | in this case the reordering routine called is indsetC | if ipar[1] == 1, then a nonsymmetric ordering is used. | In this case, the B matrix is constructed to be as | diagonally dominant as possible and as sparse as possble. | in this case the reordering routine called is ddPQ. | | ipar[2]:=bsize. for indset Dimension of the blocks. | bsize is only a target block size. The size of | each block can vary and is >= bsize. | for ddPQ: this is only the smallest size of the | last level. arms will stop when either the number | of levels reaches nlev (ipar[0]) or the size of the | next level (C block) is less than bsize. | | ipar[3]:=iout if (iout > 0) statistics on the run are | printed to FILE *ft | | ipar[4-9] NOT used [reserved for later use] - set to zero. | | The following set method options for arms2. Their default values can | all be set to zero if desired. | | ipar[10-13] == meth[0:3] = method flags for interlevel blocks | ipar[14-17] == meth[0:3] = method flags for last level block - | with the following meaning in both cases: | meth[0] nonsummetric permutations of 1: yes. affects rperm | USED FOR LAST SCHUR COMPLEMENT | meth[1] permutations of columns 0:no 1: yes. So far this is | USED ONLY FOR LAST BLOCK [ILUTP instead of ILUT]. | (so ipar[11] does no matter - enter zero). If | ipar[15] is one then ILUTP will be used instead | of ILUT. Permutation data stored in: perm2. | meth[2] diag. row scaling. 0:no 1:yes. Data: D1 | meth[3] diag. column scaling. 0:no 1:yes. Data: D2 | all transformations related to parametres in meth[*] (permutation, | scaling,..) are applied to the matrix before processing it | | ft = file for printing statistics on run | | droptol = Threshold parameters for dropping elements in ILU | factorization. | droptol[0:4] = related to the multilevel block factorization | droptol[5:6] = related to ILU factorization of last block. | This flexibility is more than is really needed. one can use | a single parameter for all. it is preferable to use one value | for droptol[0:4] and another (smaller) for droptol[5:6] | droptol[0] = threshold for dropping in L [B]. See piluNEW.c: | droptol[1] = threshold for dropping in U [B]. | droptol[2] = threshold for dropping in L^{-1} F | droptol[3] = threshold for dropping in E U^{-1} | droptol[4] = threshold for dropping in Schur complement | droptol[5] = threshold for dropping in L in last block | [see ilutpC.c] | droptol[6] = threshold for dropping in U in last block | [see ilutpC.c] | This provides a rich selection - though in practice only 4 | parameters are needed [which can be set to be the same actually] -- indeed it makes sense to take | droptol[0] = droptol[1], droptol[2] = droptol[3], | and droptol[4] = droptol[5] | | lfil = lfil[0:6] is an array containing the fill-in parameters. | similar explanations as above, namely: | lfil[0] = amount of fill-in kept in L [B]. | lfil[1] = amount of fill-in kept in U [B]. | lfil[2] = amount of fill-in kept in E L\inv | lfil[3] = amount of fill-in kept in U \inv F | lfil[4] = amount of fill-in kept in S . | lfil[5] = amount of fill-in kept in L_S . | lfil[6] = amount of fill-in kept in U_S | | tolind = tolerance parameter used by the indset function. | a row is not accepted into the independent set if | the *relative* diagonal tolerance is below tolind. | see indset function for details. Good values are | between 0.05 and 0.5 -- larger values tend to be better | for harder problems. | | ON RETURN: |============= | | (PreMat) = arms data structure which consists of two parts: | levmat and ilsch. | | ++(levmat)= permuted and sorted matrices for each level of the block | factorization stored in PerMat4 struct. Specifically | each level in levmat contains the 4 matrices in: | | | |\ | | | | \ U | | | | \ | F | | | L \ | | | | \ | | | |----------+-------| | | | | | | E | | | | | | | | plus a few other things. See LIB/heads.h for details. | | ++(ilsch) = IluSpar struct. If the block of the last level is: | | | B F | | A_l = | | | | E C | | | then IluSpar contains the block C and an ILU | factorization (matrices L and U) for the last | Schur complement [S ~ C - E inv(B) F ] | (modulo dropping) see LIB/heads.h for details. | | ipar[0] = number of levels found (may differ from input value) | +---------------------------------------------------------------------*/ /*-------------------- function prototyping done in LIB/protos.h */ /*-------------------- move above to protos.h */ p4ptr levp, levc, levn, levmat = PreMat->levmat; csptr schur, B, F, E, C=NULL; ilutptr ilsch = PreMat->ilus; /*-------------------- local variables (initialized) */ double *dd1, *dd2; int nlev = ipar[0], bsize = ipar[2], iout = ipar[3], ierr = 0; int methL[4], methS[4]; /*-------------------- local variables (not initialized) */ int nA, nB, nC, j, n, ilev, symperm; /*-------------------- work arrays: */ int *iwork, *uwork; /* timer arrays: */ /* double *symtime, *unstime, *factime, *tottime;*/ /*---------------------------BEGIN ARMS-------------------------------*/ /* schur matrix starts being original A */ /*-------------------- begin */ schur = (csptr) Malloc(sizeof(SparMat), "arms2:1" ); /*--------------------------------------------------------------------- | The matrix (a,ja,ia) plays role of Schur compl. from the 0th level. +--------------------------------------------------------------------*/ nC = nA = n = Amat->n; if (bsize >= n) bsize = n-1; levmat->n = n; levmat->nB = 0; setupCS(schur, n,1); cscpy(Amat,schur); levc = levmat; /*--------------------------------------- */ levc->prev = levc->next = levp = NULL; levc->n = 0; memcpy(methL, &ipar[10], 4*sizeof(int)); memcpy(methS, &ipar[14], 4*sizeof(int)); /*--------------------------------------------------------------------- | The preconditioner construction is divided into two parts: | 1st part: construct and store multi-level L and U factors; | 2nd part: construct the ILUT factorization for the coarsest level +--------------------------------------------------------------------*/ if ( (iout > 0) && (nlev > 0) ) { fprintf(ft," \n"); fprintf(ft,"Level Total Unknowns B-block Coarse set\n"); fprintf(ft,"===== ============== ======= ==========\n"); } /*--------------------------------------------------------------------- | main loop to construct multi-level LU preconditioner. Loop is on the | level ilev. nA is the dimension of matrix A_l at each level. +--------------------------------------------------------------------*/ for (ilev = 0; ilev < nlev; ilev++) { /*-------------------- new nA is old nC -- from previous level */ nA = nC; if ( nA <= bsize ) goto label1000; /*-------------------- allocate work space */ iwork = (int *) Malloc(nA*sizeof(int), "arms2:2.5" ); symperm = 0; /* 0nly needed in cleanP4 */ if (ipar[1] == 1) uwork = (int *) Malloc(nA*sizeof(int), "arms2:2.5" ); else{ symperm = 1; uwork = iwork; } /*-------------------- SCALING*/ dd1 = NULL; dd2 = NULL; if (methL[2]) { dd1 = (double *) Malloc(nA*sizeof(double), "arms2:3" ); j=roscalC(schur, dd1,1); if (j) printf("ERROR in roscalC - row %d is a zero row\n",j); } if (methL[3]) { dd2 = (double *) Malloc(nA*sizeof(double), "arms2:4" ); j=coscalC(schur, dd2,1); if (j) printf("ERROR in coscalC - column %d is a zero column\n",j); } /*--------------------independent-sets-permutation------------------- | do reordering -- The matrix and its transpose are used. +--------------------------------------------------------------------*/ /* if (SHIFTTOL > 0.0) shiftsD(schur,SHIFTTOL); */ // printf(" ipar1 = %d \n", ipar[1]); if (ipar[1] == 1) PQperm(schur, bsize, uwork, iwork, &nB, tolind) ; else indsetC (schur, bsize, iwork, &nB, tolind) ; /*--------------------------------------------------------------------- | nB is the total number of nodes in the independent set. | nC : nA - nB = the size of the reduced system. +--------------------------------------------------------------------*/ nC = nA - nB; /* if the size of B or C is zero , exit the main loop */ /* printf (" nB %d nC %d \n",nB, nC); */ if ( nB == 0 || nC == 0 ) goto label1000; /*--------------------------------------------------------------------- | The matrix for the current level is in (schur). | The permutations arrays are in iwork and uwork (row). | The routines rpermC, cpermC permute the matrix in place. *-----------------------------------------------------------------------*/ /* DEBUG : SHOULD THIS GO BEFORE GOTO LABEL1000 ?? */ rpermC(schur,uwork); cpermC(schur,iwork); /* prtC(schur, ilev) ; print matrix - debugging */ /*----------------------------------------------------------------------- | If this is the first level, the permuted matrix is stored in | (levc) = (levmat). Otherwise, the next level is created in (levc). +--------------------------------------------------------------------*/ if (ilev > 0) { /*- delete C matrix of any level except last one (no longer needed) */ cleanCS(C); /*-------------------- create the next level */ levn = (p4ptr) Malloc(sizeof(Per4Mat), "arms2:6" ); /* levc->prev = levp; */ levc->next = levn; levp = levc; levc = levn; levc->prev = levp; } /*-------------------- p4ptr struct for current schur complement */ B = (csptr) Malloc(sizeof(SparMat), "arms2:7" ); E = (csptr) Malloc(sizeof(SparMat), "arms2:8" ); F = (csptr) Malloc(sizeof(SparMat), "arms2:9" ); C = (csptr) Malloc(sizeof(SparMat), "arms2:10" ); csSplit4(schur, nB, nC, B, F, E, C); setupP4(levc, nB, nC, F, E); /*-------------------- copy a few pointers ---- */ levc->perm = iwork; levc->rperm = uwork; levc->symperm = symperm; levc->D1=dd1; levc->D2=dd2; /*--------------------------------------------------------------------- | a copy of the matrix (schur) has been permuted. Now perform the | block factorization: | | | B F | | L 0 | | U L^-1 F | | | | = | | X | | = L x U | | E C | | E U^-1 I | | 0 A1 | | | The factors E U^-1 and L^-1 F are discarded after the factorization. | +--------------------------------------------------------------------*/ if (iout > 0) fprintf(ft,"%3d %13d %13d %10d\n", ilev+1,nA,nB,nC); /*--------------------------------------------------------------------- | PILUT constructs one level of the block ILU fact. The permuted matrix | is in (levc). The L and U factors will be stored in the p4mat struct. | destroy current Schur complement - no longer needed - and set-up new | one for next level... +--------------------------------------------------------------------*/ cleanCS(schur); schur = (csptr) Malloc(sizeof(SparMat), "arms2:11" ); setupCS(schur, nC,1); /*---------------------------------------------------------------------- | calling PILU to construct this level block factorization | ! core dump in extreme case of empty matrices. +----------------------------------------------------------------------*/ ierr = pilu(levc, B, C, droptol, lfil, schur) ; /* prtC(levc->L, ilev) ; */ if (ierr) { fprintf(ft," ERROR IN PILU -- IERR = %d\n", ierr); return(1); } cleanCS(B); } /*--------------------------------------------------------------------- | done with the reduction. Record the number of levels in ipar[0] |********************************************************************** +--------------------------------------------------------------------*/ label1000: /* printf (" nnz_Schur %d \n",cs_nnz (schur)); */ levc->next = NULL; ipar[0] = ilev; PreMat->nlev = ilev; PreMat->n = n; nC = schur->n; setupILUT(ilsch,nC); /*--------------------------------------------------------------------*/ /* define C-matrix (member of ilsch) to be last C matrix */ if (ilev > 0) ilsch->C=C; /*-------------------- for ilut fact of schur matrix */ /* SCALING */ ilsch->D1 = NULL; if (methS[2]) { ilsch->D1 = (double *) Malloc(nC*sizeof(double), "arms2:iluschD1" ); j=roscalC(schur, ilsch->D1, 1); if (j) printf("ERROR in roscalC - row %d is a zero row\n",j); } ilsch->D2 = NULL; if (methS[3]) { ilsch->D2 = (double *) Malloc(nC*sizeof(double), "arms2:iluschD1" ); j =coscalC(schur, ilsch->D2, 1); if (j) printf("ERROR in coscalC - column %d is a zero column\n",j); } /*--------------------------------------------------------------------- | get ILUT factorization for the last reduced system. +--------------------------------------------------------------------*/ uwork = NULL; iwork = NULL; if (methS[0]) { iwork = (int *) Malloc(nC*sizeof(int), "arms2:3" ); uwork = (int *) Malloc(nC*sizeof(int), "arms2:3.5" ); tolind = 0.0; PQperm(schur, bsize, uwork, iwork, &nB, tolind) ; rpermC(schur,uwork); cpermC(schur,iwork); } ilsch->rperm = uwork; ilsch->perm = iwork; /* printf(" lf : %d %d %d %d %d %d %d \n",lfil[0], lfil[1], lfil[2], lfil[3], lfil[4], lfil[5], lfil[6]) ; */ ilsch->perm2 = NULL; if (methS[1] == 0) ierr = ilutD(schur, droptol, lfil, ilsch); else { ilsch->perm2 = (int *) Malloc(nC*sizeof(int), "arms2:ilutpC" ); for (j=0; j<nC; j++) ilsch->perm2[j] = j; ierr = ilutpC(schur, droptol, lfil, PERMTOL, nC, ilsch); } /*---------- OPTIMIZATION: NEED TO COMPOUND THE TWO RIGHT PERMUTATIONS -- CHANGES HERE AND IN USCHUR SOLVE == compound permutations */ if (ierr) { fprintf(ft," ERROR IN ILUT -- IERR = %d\n", ierr); return(1); } /*-------------------- Last Schur complement no longer needed */ cleanCS(schur); return 0; }