1eb9c0419SKris Buschelman /* 2eb9c0419SKris Buschelman Defines projective product routines where A is a SeqAIJ matrix 3eb9c0419SKris Buschelman C = P^T * A * P 4eb9c0419SKris Buschelman */ 5eb9c0419SKris Buschelman 6eb9c0419SKris Buschelman #include "src/mat/impls/aij/seq/aij.h" 7eb9c0419SKris Buschelman #include "src/mat/utils/freespace.h" 8eb9c0419SKris Buschelman 9eb9c0419SKris Buschelman int MatSeqAIJPtAP(Mat,Mat,Mat*); 10eb9c0419SKris Buschelman int MatSeqAIJPtAPSymbolic(Mat,Mat,Mat*); 11eb9c0419SKris Buschelman int MatSeqAIJPtAPNumeric(Mat,Mat,Mat); 12eb9c0419SKris Buschelman 13eb9c0419SKris Buschelman static int MATSeqAIJ_PtAP = 0; 14eb9c0419SKris Buschelman static int MATSeqAIJ_PtAPSymbolic = 0; 15eb9c0419SKris Buschelman static int MATSeqAIJ_PtAPNumeric = 0; 16eb9c0419SKris Buschelman 17eb9c0419SKris Buschelman /* 18eb9c0419SKris Buschelman MatSeqAIJPtAP - Creates the SeqAIJ matrix product, C, 19eb9c0419SKris Buschelman of SeqAIJ matrix A and matrix P: 20eb9c0419SKris Buschelman C = P^T * A * P; 21eb9c0419SKris Buschelman 22eb9c0419SKris Buschelman Note: C is assumed to be uncreated. 23eb9c0419SKris Buschelman If this is not the case, Destroy C before calling this routine. 24eb9c0419SKris Buschelman */ 25eb9c0419SKris Buschelman #undef __FUNCT__ 26eb9c0419SKris Buschelman #define __FUNCT__ "MatSeqAIJPtAP" 27eb9c0419SKris Buschelman int MatSeqAIJPtAP(Mat A,Mat P,Mat *C) { 28eb9c0419SKris Buschelman int ierr; 29eb9c0419SKris Buschelman char funct[80]; 30eb9c0419SKris Buschelman 31eb9c0419SKris Buschelman PetscFunctionBegin; 32eb9c0419SKris Buschelman 33eb9c0419SKris Buschelman ierr = PetscLogEventBegin(MATSeqAIJ_PtAP,A,P,0,0);CHKERRQ(ierr); 34eb9c0419SKris Buschelman 35eb9c0419SKris Buschelman ierr = MatSeqAIJPtAPSymbolic(A,P,C);CHKERRQ(ierr); 36eb9c0419SKris Buschelman 37eb9c0419SKris Buschelman /* Avoid additional error checking included in */ 38eb9c0419SKris Buschelman /* ierr = MatSeqAIJApplyPtAPNumeric(A,P,*C);CHKERRQ(ierr); */ 39eb9c0419SKris Buschelman 40eb9c0419SKris Buschelman /* Query A for ApplyPtAPNumeric implementation based on types of P */ 41eb9c0419SKris Buschelman ierr = PetscStrcpy(funct,"MatApplyPtAPNumeric_seqaij_");CHKERRQ(ierr); 42eb9c0419SKris Buschelman ierr = PetscStrcat(funct,P->type_name);CHKERRQ(ierr); 43eb9c0419SKris Buschelman ierr = PetscTryMethod(A,funct,(Mat,Mat,Mat),(A,P,*C));CHKERRQ(ierr); 44eb9c0419SKris Buschelman 45eb9c0419SKris Buschelman ierr = PetscLogEventEnd(MATSeqAIJ_PtAP,A,P,0,0);CHKERRQ(ierr); 46eb9c0419SKris Buschelman 47eb9c0419SKris Buschelman PetscFunctionReturn(0); 48eb9c0419SKris Buschelman } 49eb9c0419SKris Buschelman 50eb9c0419SKris Buschelman /* 51eb9c0419SKris Buschelman MatSeqAIJPtAPSymbolic - Creates the (i,j) structure of the SeqAIJ matrix product, C, 52eb9c0419SKris Buschelman of SeqAIJ matrix A and matrix P, according to: 53eb9c0419SKris Buschelman C = P^T * A * P; 54eb9c0419SKris Buschelman 55eb9c0419SKris Buschelman Note: C is assumed to be uncreated. 56eb9c0419SKris Buschelman If this is not the case, Destroy C before calling this routine. 57eb9c0419SKris Buschelman */ 58eb9c0419SKris Buschelman #undef __FUNCT__ 59eb9c0419SKris Buschelman #define __FUNCT__ "MatSeqAIJPtAPSymbolic" 60eb9c0419SKris Buschelman int MatSeqAIJPtAPSymbolic(Mat A,Mat P,Mat *C) { 61eb9c0419SKris Buschelman int ierr; 62eb9c0419SKris Buschelman char funct[80]; 63eb9c0419SKris Buschelman 64eb9c0419SKris Buschelman PetscFunctionBegin; 65eb9c0419SKris Buschelman 66eb9c0419SKris Buschelman PetscValidPointer(C); 67eb9c0419SKris Buschelman 68eb9c0419SKris Buschelman PetscValidHeaderSpecific(A,MAT_COOKIE); 69eb9c0419SKris Buschelman PetscValidType(A); 70eb9c0419SKris Buschelman MatPreallocated(A); 71eb9c0419SKris Buschelman if (!A->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix"); 72eb9c0419SKris Buschelman if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 73eb9c0419SKris Buschelman 74eb9c0419SKris Buschelman PetscValidHeaderSpecific(P,MAT_COOKIE); 75eb9c0419SKris Buschelman PetscValidType(P); 76eb9c0419SKris Buschelman MatPreallocated(P); 77eb9c0419SKris Buschelman if (!P->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix"); 78eb9c0419SKris Buschelman if (P->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 79eb9c0419SKris Buschelman 80eb9c0419SKris Buschelman if (P->M!=A->N) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %d != %d",P->M,A->N); 81eb9c0419SKris Buschelman if (A->M!=A->N) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix 'A' must be square, %d != %d",A->M,A->N); 82eb9c0419SKris Buschelman 83eb9c0419SKris Buschelman /* Query A for ApplyPtAP implementation based on types of P */ 84eb9c0419SKris Buschelman ierr = PetscStrcpy(funct,"MatApplyPtAPSymbolic_seqaij_");CHKERRQ(ierr); 85eb9c0419SKris Buschelman ierr = PetscStrcat(funct,P->type_name);CHKERRQ(ierr); 86eb9c0419SKris Buschelman ierr = PetscTryMethod(A,funct,(Mat,Mat,Mat*),(A,P,C));CHKERRQ(ierr); 87eb9c0419SKris Buschelman 88eb9c0419SKris Buschelman PetscFunctionReturn(0); 89eb9c0419SKris Buschelman } 90eb9c0419SKris Buschelman 91eb9c0419SKris Buschelman EXTERN_C_BEGIN 92eb9c0419SKris Buschelman #undef __FUNCT__ 93eb9c0419SKris Buschelman #define __FUNCT__ "MatApplyPtAPSymbolic_SeqAIJ_SeqAIJ" 94eb9c0419SKris Buschelman int MatApplyPtAPSymbolic_SeqAIJ_SeqAIJ(Mat A,Mat P,Mat *C) { 95eb9c0419SKris Buschelman int ierr; 96eb9c0419SKris Buschelman FreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL; 97eb9c0419SKris Buschelman Mat_SeqAIJ *a=(Mat_SeqAIJ*)A->data,*p=(Mat_SeqAIJ*)P->data,*c; 98eb9c0419SKris Buschelman int aishift=a->indexshift,pishift=p->indexshift; 99eb9c0419SKris Buschelman int *pti,*ptj,*ptJ,*ai=a->i,*aj=a->j,*ajj,*pi=p->i,*pj=p->j,*pjj; 100eb9c0419SKris Buschelman int *ci,*cj,*denserow,*sparserow,*ptadenserow,*ptasparserow,*ptaj; 101eb9c0419SKris Buschelman int an=A->N,am=A->M,pn=P->N,pm=P->M; 102eb9c0419SKris Buschelman int i,j,k,ptnzi,arow,anzj,ptanzi,prow,pnzj,cnzi; 103eb9c0419SKris Buschelman MatScalar *ca; 104eb9c0419SKris Buschelman 105eb9c0419SKris Buschelman PetscFunctionBegin; 106eb9c0419SKris Buschelman 107eb9c0419SKris Buschelman /* some error checking which could be moved into interface layer */ 108eb9c0419SKris Buschelman if (aishift || pishift) SETERRQ(PETSC_ERR_SUP,"Shifted matrix indices are not supported."); 109eb9c0419SKris Buschelman 110eb9c0419SKris Buschelman /* Start timer */ 111eb9c0419SKris Buschelman ierr = PetscLogEventBegin(MATSeqAIJ_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr); 112eb9c0419SKris Buschelman 113eb9c0419SKris Buschelman /* Get ij structure of P^T */ 114eb9c0419SKris Buschelman ierr = MatGetSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr); 115eb9c0419SKris Buschelman ptJ=ptj; 116eb9c0419SKris Buschelman 117eb9c0419SKris Buschelman /* Allocate ci array, arrays for fill computation and */ 118eb9c0419SKris Buschelman /* free space for accumulating nonzero column info */ 1193985e5eaSKris Buschelman ierr = PetscMalloc((pn+1)*sizeof(int),&ci);CHKERRQ(ierr); 120eb9c0419SKris Buschelman ci[0] = 0; 121eb9c0419SKris Buschelman 122eb9c0419SKris Buschelman ierr = PetscMalloc((2*pn+2*an+1)*sizeof(int),&ptadenserow);CHKERRQ(ierr); 123eb9c0419SKris Buschelman ierr = PetscMemzero(ptadenserow,(2*pn+2*an+1)*sizeof(int));CHKERRQ(ierr); 124eb9c0419SKris Buschelman ptasparserow = ptadenserow + an; 125eb9c0419SKris Buschelman denserow = ptasparserow + an; 126eb9c0419SKris Buschelman sparserow = denserow + pn; 127eb9c0419SKris Buschelman 128eb9c0419SKris Buschelman /* Set initial free space to be nnz(A) scaled by aspect ratio of P. */ 129eb9c0419SKris Buschelman /* This should be reasonable if sparsity of PtAP is similar to that of A. */ 130eb9c0419SKris Buschelman ierr = GetMoreSpace((ai[am]/pm)*pn,&free_space); 131eb9c0419SKris Buschelman current_space = free_space; 132eb9c0419SKris Buschelman 133eb9c0419SKris Buschelman /* Determine symbolic info for each row of C: */ 134eb9c0419SKris Buschelman for (i=0;i<pn;i++) { 135eb9c0419SKris Buschelman ptnzi = pti[i+1] - pti[i]; 136eb9c0419SKris Buschelman ptanzi = 0; 137eb9c0419SKris Buschelman /* Determine symbolic row of PtA: */ 138eb9c0419SKris Buschelman for (j=0;j<ptnzi;j++) { 139eb9c0419SKris Buschelman arow = *ptJ++; 140eb9c0419SKris Buschelman anzj = ai[arow+1] - ai[arow]; 141eb9c0419SKris Buschelman ajj = aj + ai[arow]; 142eb9c0419SKris Buschelman for (k=0;k<anzj;k++) { 143eb9c0419SKris Buschelman if (!ptadenserow[ajj[k]]) { 144eb9c0419SKris Buschelman ptadenserow[ajj[k]] = -1; 145eb9c0419SKris Buschelman ptasparserow[ptanzi++] = ajj[k]; 146eb9c0419SKris Buschelman } 147eb9c0419SKris Buschelman } 148eb9c0419SKris Buschelman } 149eb9c0419SKris Buschelman /* Using symbolic info for row of PtA, determine symbolic info for row of C: */ 150eb9c0419SKris Buschelman ptaj = ptasparserow; 151eb9c0419SKris Buschelman cnzi = 0; 152eb9c0419SKris Buschelman for (j=0;j<ptanzi;j++) { 153eb9c0419SKris Buschelman prow = *ptaj++; 154eb9c0419SKris Buschelman pnzj = pi[prow+1] - pi[prow]; 155eb9c0419SKris Buschelman pjj = pj + pi[prow]; 156eb9c0419SKris Buschelman for (k=0;k<pnzj;k++) { 157eb9c0419SKris Buschelman if (!denserow[pjj[k]]) { 158eb9c0419SKris Buschelman denserow[pjj[k]] = -1; 159eb9c0419SKris Buschelman sparserow[cnzi++] = pjj[k]; 160eb9c0419SKris Buschelman } 161eb9c0419SKris Buschelman } 162eb9c0419SKris Buschelman } 163eb9c0419SKris Buschelman 164eb9c0419SKris Buschelman /* sort sparserow */ 165eb9c0419SKris Buschelman ierr = PetscSortInt(cnzi,sparserow);CHKERRQ(ierr); 166eb9c0419SKris Buschelman 167eb9c0419SKris Buschelman /* If free space is not available, make more free space */ 168eb9c0419SKris Buschelman /* Double the amount of total space in the list */ 169eb9c0419SKris Buschelman if (current_space->local_remaining<cnzi) { 170eb9c0419SKris Buschelman ierr = GetMoreSpace(current_space->total_array_size,¤t_space);CHKERRQ(ierr); 171eb9c0419SKris Buschelman } 172eb9c0419SKris Buschelman 173eb9c0419SKris Buschelman /* Copy data into free space, and zero out denserows */ 174eb9c0419SKris Buschelman ierr = PetscMemcpy(current_space->array,sparserow,cnzi*sizeof(int));CHKERRQ(ierr); 175eb9c0419SKris Buschelman current_space->array += cnzi; 176eb9c0419SKris Buschelman current_space->local_used += cnzi; 177eb9c0419SKris Buschelman current_space->local_remaining -= cnzi; 178eb9c0419SKris Buschelman 179eb9c0419SKris Buschelman for (j=0;j<ptanzi;j++) { 180eb9c0419SKris Buschelman ptadenserow[ptasparserow[j]] = 0; 181eb9c0419SKris Buschelman } 182eb9c0419SKris Buschelman for (j=0;j<cnzi;j++) { 183eb9c0419SKris Buschelman denserow[sparserow[j]] = 0; 184eb9c0419SKris Buschelman } 185eb9c0419SKris Buschelman /* Aside: Perhaps we should save the pta info for the numerical factorization. */ 186eb9c0419SKris Buschelman /* For now, we will recompute what is needed. */ 187eb9c0419SKris Buschelman ci[i+1] = ci[i] + cnzi; 188eb9c0419SKris Buschelman } 189eb9c0419SKris Buschelman /* nnz is now stored in ci[ptm], column indices are in the list of free space */ 190eb9c0419SKris Buschelman /* Allocate space for cj, initialize cj, and */ 191eb9c0419SKris Buschelman /* destroy list of free space and other temporary array(s) */ 192eb9c0419SKris Buschelman ierr = PetscMalloc((ci[pn]+1)*sizeof(int),&cj);CHKERRQ(ierr); 193eb9c0419SKris Buschelman ierr = MakeSpaceContiguous(&free_space,cj);CHKERRQ(ierr); 194eb9c0419SKris Buschelman ierr = PetscFree(ptadenserow);CHKERRQ(ierr); 195eb9c0419SKris Buschelman 196eb9c0419SKris Buschelman /* Allocate space for ca */ 197eb9c0419SKris Buschelman ierr = PetscMalloc((ci[pn]+1)*sizeof(MatScalar),&ca);CHKERRQ(ierr); 198eb9c0419SKris Buschelman ierr = PetscMemzero(ca,(ci[pn]+1)*sizeof(MatScalar));CHKERRQ(ierr); 199eb9c0419SKris Buschelman 200eb9c0419SKris Buschelman /* put together the new matrix */ 201eb9c0419SKris Buschelman ierr = MatCreateSeqAIJWithArrays(A->comm,pn,pn,ci,cj,ca,C);CHKERRQ(ierr); 202eb9c0419SKris Buschelman 203eb9c0419SKris Buschelman /* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */ 204eb9c0419SKris Buschelman /* Since these are PETSc arrays, change flags to free them as necessary. */ 205eb9c0419SKris Buschelman c = (Mat_SeqAIJ *)((*C)->data); 206eb9c0419SKris Buschelman c->freedata = PETSC_TRUE; 207eb9c0419SKris Buschelman c->nonew = 0; 208eb9c0419SKris Buschelman 209eb9c0419SKris Buschelman /* Clean up. */ 210eb9c0419SKris Buschelman ierr = MatRestoreSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr); 211eb9c0419SKris Buschelman 212eb9c0419SKris Buschelman ierr = PetscLogEventEnd(MATSeqAIJ_PtAPSymbolic,A,P,0,0);CHKERRQ(ierr); 213eb9c0419SKris Buschelman PetscFunctionReturn(0); 214eb9c0419SKris Buschelman } 215eb9c0419SKris Buschelman EXTERN_C_END 216eb9c0419SKris Buschelman 2173985e5eaSKris Buschelman #include "src/mat/impls/maij/maij.h" 2183985e5eaSKris Buschelman EXTERN_C_BEGIN 2193985e5eaSKris Buschelman #undef __FUNCT__ 2203985e5eaSKris Buschelman #define __FUNCT__ "MatApplyPtAPSymbolic_SeqAIJ_SeqMAIJ" 2213985e5eaSKris Buschelman int MatApplyPtAPSymbolic_SeqAIJ_SeqMAIJ(Mat A,Mat PP,Mat *C) { 2223985e5eaSKris Buschelman int ierr; 2233985e5eaSKris Buschelman FreeSpaceList free_space=PETSC_NULL,current_space=PETSC_NULL; 2243985e5eaSKris Buschelman Mat_SeqMAIJ *pp=(Mat_SeqMAIJ*)PP->data; 2253985e5eaSKris Buschelman Mat P=pp->AIJ; 2263985e5eaSKris Buschelman Mat_SeqAIJ *a=(Mat_SeqAIJ*)A->data,*p=(Mat_SeqAIJ*)P->data,*c; 2273985e5eaSKris Buschelman int aishift=a->indexshift,pishift=p->indexshift; 2283985e5eaSKris Buschelman int *pti,*ptj,*ptJ,*ai=a->i,*aj=a->j,*ajj,*pi=p->i,*pj=p->j,*pjj; 2293985e5eaSKris Buschelman int *ci,*cj,*denserow,*sparserow,*ptadenserow,*ptasparserow,*ptaj; 2303985e5eaSKris Buschelman int an=A->N,am=A->M,pn=P->N,pm=P->M,ppdof=pp->dof; 231*fe05a634SKris Buschelman int i,j,k,dof,pdof,ptnzi,arow,anzj,ptanzi,prow,pnzj,cnzi; 2323985e5eaSKris Buschelman MatScalar *ca; 2333985e5eaSKris Buschelman 2343985e5eaSKris Buschelman PetscFunctionBegin; 2353985e5eaSKris Buschelman 2363985e5eaSKris Buschelman /* some error checking which could be moved into interface layer */ 2373985e5eaSKris Buschelman if (aishift || pishift) SETERRQ(PETSC_ERR_SUP,"Shifted matrix indices are not supported."); 2383985e5eaSKris Buschelman 2393985e5eaSKris Buschelman /* Start timer */ 2403985e5eaSKris Buschelman ierr = PetscLogEventBegin(MATSeqAIJ_PtAPSymbolic,A,PP,0,0);CHKERRQ(ierr); 2413985e5eaSKris Buschelman 2423985e5eaSKris Buschelman /* Get ij structure of P^T */ 2433985e5eaSKris Buschelman ierr = MatGetSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr); 2443985e5eaSKris Buschelman 2453985e5eaSKris Buschelman /* Allocate ci array, arrays for fill computation and */ 2463985e5eaSKris Buschelman /* free space for accumulating nonzero column info */ 2473985e5eaSKris Buschelman ierr = PetscMalloc((pn+1)*sizeof(int),&ci);CHKERRQ(ierr); 2483985e5eaSKris Buschelman ci[0] = 0; 2493985e5eaSKris Buschelman 2503985e5eaSKris Buschelman ierr = PetscMalloc((2*pn+2*an+1)*sizeof(int),&ptadenserow);CHKERRQ(ierr); 2513985e5eaSKris Buschelman ierr = PetscMemzero(ptadenserow,(2*pn+2*an+1)*sizeof(int));CHKERRQ(ierr); 2523985e5eaSKris Buschelman ptasparserow = ptadenserow + an; 2533985e5eaSKris Buschelman denserow = ptasparserow + an; 2543985e5eaSKris Buschelman sparserow = denserow + pn; 2553985e5eaSKris Buschelman 2563985e5eaSKris Buschelman /* Set initial free space to be nnz(A) scaled by aspect ratio of P. */ 2573985e5eaSKris Buschelman /* This should be reasonable if sparsity of PtAP is similar to that of A. */ 2583985e5eaSKris Buschelman ierr = GetMoreSpace((ai[am]/pm)*pn,&free_space); 2593985e5eaSKris Buschelman current_space = free_space; 2603985e5eaSKris Buschelman 2613985e5eaSKris Buschelman /* Determine symbolic info for each row of C: */ 2623985e5eaSKris Buschelman for (i=0;i<pn/ppdof;i++) { 2633985e5eaSKris Buschelman ptnzi = pti[i+1] - pti[i]; 2643985e5eaSKris Buschelman ptanzi = 0; 2653985e5eaSKris Buschelman ptJ = ptj + pti[i]; 2663985e5eaSKris Buschelman for (dof=0;dof<ppdof;dof++) { 2673985e5eaSKris Buschelman /* Determine symbolic row of PtA: */ 2683985e5eaSKris Buschelman for (j=0;j<ptnzi;j++) { 2693985e5eaSKris Buschelman arow = ptJ[j] + dof; 2703985e5eaSKris Buschelman anzj = ai[arow+1] - ai[arow]; 2713985e5eaSKris Buschelman ajj = aj + ai[arow]; 2723985e5eaSKris Buschelman for (k=0;k<anzj;k++) { 2733985e5eaSKris Buschelman if (!ptadenserow[ajj[k]]) { 2743985e5eaSKris Buschelman ptadenserow[ajj[k]] = -1; 2753985e5eaSKris Buschelman ptasparserow[ptanzi++] = ajj[k]; 2763985e5eaSKris Buschelman } 2773985e5eaSKris Buschelman } 2783985e5eaSKris Buschelman } 2793985e5eaSKris Buschelman /* Using symbolic info for row of PtA, determine symbolic info for row of C: */ 2803985e5eaSKris Buschelman ptaj = ptasparserow; 2813985e5eaSKris Buschelman cnzi = 0; 2823985e5eaSKris Buschelman for (j=0;j<ptanzi;j++) { 283*fe05a634SKris Buschelman pdof = *ptaj%dof; 2843985e5eaSKris Buschelman prow = (*ptaj++)/dof; 2853985e5eaSKris Buschelman pnzj = pi[prow+1] - pi[prow]; 2863985e5eaSKris Buschelman pjj = pj + pi[prow]; 2873985e5eaSKris Buschelman for (k=0;k<pnzj;k++) { 288*fe05a634SKris Buschelman if (!denserow[pjj[k]+pdof]) { 289*fe05a634SKris Buschelman denserow[pjj[k]+pdof] = -1; 290*fe05a634SKris Buschelman sparserow[cnzi++] = pjj[k]+pdof; 2913985e5eaSKris Buschelman } 2923985e5eaSKris Buschelman } 2933985e5eaSKris Buschelman } 2943985e5eaSKris Buschelman 2953985e5eaSKris Buschelman /* sort sparserow */ 2963985e5eaSKris Buschelman ierr = PetscSortInt(cnzi,sparserow);CHKERRQ(ierr); 2973985e5eaSKris Buschelman 2983985e5eaSKris Buschelman /* If free space is not available, make more free space */ 2993985e5eaSKris Buschelman /* Double the amount of total space in the list */ 3003985e5eaSKris Buschelman if (current_space->local_remaining<cnzi) { 3013985e5eaSKris Buschelman ierr = GetMoreSpace(current_space->total_array_size,¤t_space);CHKERRQ(ierr); 3023985e5eaSKris Buschelman } 3033985e5eaSKris Buschelman 3043985e5eaSKris Buschelman /* Copy data into free space, and zero out denserows */ 3053985e5eaSKris Buschelman ierr = PetscMemcpy(current_space->array,sparserow,cnzi*sizeof(int));CHKERRQ(ierr); 3063985e5eaSKris Buschelman current_space->array += cnzi; 3073985e5eaSKris Buschelman current_space->local_used += cnzi; 3083985e5eaSKris Buschelman current_space->local_remaining -= cnzi; 3093985e5eaSKris Buschelman 3103985e5eaSKris Buschelman for (j=0;j<ptanzi;j++) { 3113985e5eaSKris Buschelman ptadenserow[ptasparserow[j]] = 0; 3123985e5eaSKris Buschelman } 3133985e5eaSKris Buschelman for (j=0;j<cnzi;j++) { 3143985e5eaSKris Buschelman denserow[sparserow[j]] = 0; 3153985e5eaSKris Buschelman } 3163985e5eaSKris Buschelman /* Aside: Perhaps we should save the pta info for the numerical factorization. */ 3173985e5eaSKris Buschelman /* For now, we will recompute what is needed. */ 3183985e5eaSKris Buschelman ci[i+1+dof] = ci[i+dof] + cnzi; 3193985e5eaSKris Buschelman } 3203985e5eaSKris Buschelman } 3213985e5eaSKris Buschelman /* nnz is now stored in ci[ptm], column indices are in the list of free space */ 3223985e5eaSKris Buschelman /* Allocate space for cj, initialize cj, and */ 3233985e5eaSKris Buschelman /* destroy list of free space and other temporary array(s) */ 3243985e5eaSKris Buschelman ierr = PetscMalloc((ci[pn]+1)*sizeof(int),&cj);CHKERRQ(ierr); 3253985e5eaSKris Buschelman ierr = MakeSpaceContiguous(&free_space,cj);CHKERRQ(ierr); 3263985e5eaSKris Buschelman ierr = PetscFree(ptadenserow);CHKERRQ(ierr); 3273985e5eaSKris Buschelman 3283985e5eaSKris Buschelman /* Allocate space for ca */ 3293985e5eaSKris Buschelman ierr = PetscMalloc((ci[pn]+1)*sizeof(MatScalar),&ca);CHKERRQ(ierr); 3303985e5eaSKris Buschelman ierr = PetscMemzero(ca,(ci[pn]+1)*sizeof(MatScalar));CHKERRQ(ierr); 3313985e5eaSKris Buschelman 3323985e5eaSKris Buschelman /* put together the new matrix */ 3333985e5eaSKris Buschelman ierr = MatCreateSeqAIJWithArrays(A->comm,pn,pn,ci,cj,ca,C);CHKERRQ(ierr); 3343985e5eaSKris Buschelman 3353985e5eaSKris Buschelman /* MatCreateSeqAIJWithArrays flags matrix so PETSc doesn't free the user's arrays. */ 3363985e5eaSKris Buschelman /* Since these are PETSc arrays, change flags to free them as necessary. */ 3373985e5eaSKris Buschelman c = (Mat_SeqAIJ *)((*C)->data); 3383985e5eaSKris Buschelman c->freedata = PETSC_TRUE; 3393985e5eaSKris Buschelman c->nonew = 0; 3403985e5eaSKris Buschelman 3413985e5eaSKris Buschelman /* Clean up. */ 3423985e5eaSKris Buschelman ierr = MatRestoreSymbolicTranspose_SeqAIJ(P,&pti,&ptj);CHKERRQ(ierr); 3433985e5eaSKris Buschelman 3443985e5eaSKris Buschelman ierr = PetscLogEventEnd(MATSeqAIJ_PtAPSymbolic,A,PP,0,0);CHKERRQ(ierr); 3453985e5eaSKris Buschelman PetscFunctionReturn(0); 3463985e5eaSKris Buschelman } 3473985e5eaSKris Buschelman EXTERN_C_END 3483985e5eaSKris Buschelman 349eb9c0419SKris Buschelman /* 350eb9c0419SKris Buschelman MatSeqAIJPtAPNumeric - Computes the SeqAIJ matrix product, C, 351eb9c0419SKris Buschelman of SeqAIJ matrix A and matrix P, according to: 352eb9c0419SKris Buschelman C = P^T * A * P 353eb9c0419SKris Buschelman Note: C must have been created by calling MatSeqAIJApplyPtAPSymbolic. 354eb9c0419SKris Buschelman */ 355eb9c0419SKris Buschelman #undef __FUNCT__ 356eb9c0419SKris Buschelman #define __FUNCT__ "MatSeqAIJPtAPNumeric" 357eb9c0419SKris Buschelman int MatSeqAIJPtAPNumeric(Mat A,Mat P,Mat C) { 358eb9c0419SKris Buschelman int ierr; 359eb9c0419SKris Buschelman char funct[80]; 360eb9c0419SKris Buschelman 361eb9c0419SKris Buschelman PetscFunctionBegin; 362eb9c0419SKris Buschelman 363eb9c0419SKris Buschelman PetscValidHeaderSpecific(A,MAT_COOKIE); 364eb9c0419SKris Buschelman PetscValidType(A); 365eb9c0419SKris Buschelman MatPreallocated(A); 366eb9c0419SKris Buschelman if (!A->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix"); 367eb9c0419SKris Buschelman if (A->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 368eb9c0419SKris Buschelman 369eb9c0419SKris Buschelman PetscValidHeaderSpecific(P,MAT_COOKIE); 370eb9c0419SKris Buschelman PetscValidType(P); 371eb9c0419SKris Buschelman MatPreallocated(P); 372eb9c0419SKris Buschelman if (!P->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix"); 373eb9c0419SKris Buschelman if (P->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 374eb9c0419SKris Buschelman 375eb9c0419SKris Buschelman PetscValidHeaderSpecific(C,MAT_COOKIE); 376eb9c0419SKris Buschelman PetscValidType(C); 377eb9c0419SKris Buschelman MatPreallocated(C); 378eb9c0419SKris Buschelman if (!C->assembled) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for unassembled matrix"); 379eb9c0419SKris Buschelman if (C->factor) SETERRQ(PETSC_ERR_ARG_WRONGSTATE,"Not for factored matrix"); 380eb9c0419SKris Buschelman 381eb9c0419SKris Buschelman if (P->N!=C->M) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %d != %d",P->N,C->M); 382eb9c0419SKris Buschelman if (P->M!=A->N) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %d != %d",P->M,A->N); 383eb9c0419SKris Buschelman if (A->M!=A->N) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix 'A' must be square, %d != %d",A->M,A->N); 384eb9c0419SKris Buschelman if (P->N!=C->N) SETERRQ2(PETSC_ERR_ARG_SIZ,"Matrix dimensions are incompatible, %d != %d",P->N,C->N); 385eb9c0419SKris Buschelman 386eb9c0419SKris Buschelman /* Query A for ApplyPtAP implementation based on types of P */ 387eb9c0419SKris Buschelman ierr = PetscStrcpy(funct,"MatApplyPtAPNumeric_seqaij_");CHKERRQ(ierr); 388eb9c0419SKris Buschelman ierr = PetscStrcat(funct,P->type_name);CHKERRQ(ierr); 389eb9c0419SKris Buschelman ierr = PetscTryMethod(A,funct,(Mat,Mat,Mat),(A,P,C));CHKERRQ(ierr); 390eb9c0419SKris Buschelman 391eb9c0419SKris Buschelman PetscFunctionReturn(0); 392eb9c0419SKris Buschelman } 393eb9c0419SKris Buschelman 394eb9c0419SKris Buschelman EXTERN_C_BEGIN 395eb9c0419SKris Buschelman #undef __FUNCT__ 396eb9c0419SKris Buschelman #define __FUNCT__ "MatApplyPtAPNumeric_SeqAIJ_SeqAIJ" 397eb9c0419SKris Buschelman int MatApplyPtAPNumeric_SeqAIJ_SeqAIJ(Mat A,Mat P,Mat C) { 398eb9c0419SKris Buschelman int ierr,flops=0; 399eb9c0419SKris Buschelman Mat_SeqAIJ *a = (Mat_SeqAIJ *) A->data; 400eb9c0419SKris Buschelman Mat_SeqAIJ *p = (Mat_SeqAIJ *) P->data; 401eb9c0419SKris Buschelman Mat_SeqAIJ *c = (Mat_SeqAIJ *) C->data; 402eb9c0419SKris Buschelman int aishift=a->indexshift,pishift=p->indexshift,cishift=c->indexshift; 403eb9c0419SKris Buschelman int *ai=a->i,*aj=a->j,*apj,*apjdense,*pi=p->i,*pj=p->j,*pJ=p->j,*pjj; 404eb9c0419SKris Buschelman int *ci=c->i,*cj=c->j,*cjj; 405eb9c0419SKris Buschelman int am=A->M,cn=C->N,cm=C->M; 406eb9c0419SKris Buschelman int i,j,k,anzi,pnzi,apnzj,nextap,pnzj,prow,crow; 407eb9c0419SKris Buschelman MatScalar *aa=a->a,*apa,*pa=p->a,*pA=p->a,*paj,*ca=c->a,*caj; 408eb9c0419SKris Buschelman 409eb9c0419SKris Buschelman PetscFunctionBegin; 410eb9c0419SKris Buschelman 411eb9c0419SKris Buschelman /* Currently not for shifted matrices! */ 412eb9c0419SKris Buschelman if (aishift || pishift || cishift) SETERRQ(PETSC_ERR_SUP,"Shifted matrix indices are not supported."); 413eb9c0419SKris Buschelman 414eb9c0419SKris Buschelman ierr = PetscLogEventBegin(MATSeqAIJ_PtAPNumeric,A,P,C,0);CHKERRQ(ierr); 415eb9c0419SKris Buschelman 416eb9c0419SKris Buschelman /* Allocate temporary array for storage of one row of A*P */ 417eb9c0419SKris Buschelman ierr = PetscMalloc(cn*(sizeof(MatScalar)+2*sizeof(int)),&apa);CHKERRQ(ierr); 418eb9c0419SKris Buschelman ierr = PetscMemzero(apa,cn*(sizeof(MatScalar)+2*sizeof(int)));CHKERRQ(ierr); 419eb9c0419SKris Buschelman 420eb9c0419SKris Buschelman apj = (int *)(apa + cn); 421eb9c0419SKris Buschelman apjdense = apj + cn; 422eb9c0419SKris Buschelman 423eb9c0419SKris Buschelman /* Clear old values in C */ 424eb9c0419SKris Buschelman ierr = PetscMemzero(ca,ci[cm]*sizeof(MatScalar));CHKERRQ(ierr); 425eb9c0419SKris Buschelman 426eb9c0419SKris Buschelman for (i=0;i<am;i++) { 427eb9c0419SKris Buschelman /* Form sparse row of A*P */ 428eb9c0419SKris Buschelman anzi = ai[i+1] - ai[i]; 429eb9c0419SKris Buschelman apnzj = 0; 430eb9c0419SKris Buschelman for (j=0;j<anzi;j++) { 431eb9c0419SKris Buschelman prow = *aj++; 432eb9c0419SKris Buschelman pnzj = pi[prow+1] - pi[prow]; 433eb9c0419SKris Buschelman pjj = pj + pi[prow]; 434eb9c0419SKris Buschelman paj = pa + pi[prow]; 435eb9c0419SKris Buschelman for (k=0;k<pnzj;k++) { 436eb9c0419SKris Buschelman if (!apjdense[pjj[k]]) { 437eb9c0419SKris Buschelman apjdense[pjj[k]] = -1; 438eb9c0419SKris Buschelman apj[apnzj++] = pjj[k]; 439eb9c0419SKris Buschelman } 440eb9c0419SKris Buschelman apa[pjj[k]] += (*aa)*paj[k]; 441eb9c0419SKris Buschelman } 442eb9c0419SKris Buschelman flops += 2*pnzj; 443eb9c0419SKris Buschelman aa++; 444eb9c0419SKris Buschelman } 445eb9c0419SKris Buschelman 446eb9c0419SKris Buschelman /* Sort the j index array for quick sparse axpy. */ 447eb9c0419SKris Buschelman ierr = PetscSortInt(apnzj,apj);CHKERRQ(ierr); 448eb9c0419SKris Buschelman 449eb9c0419SKris Buschelman /* Compute P^T*A*P using outer product (P^T)[:,j]*(A*P)[j,:]. */ 450eb9c0419SKris Buschelman pnzi = pi[i+1] - pi[i]; 451eb9c0419SKris Buschelman for (j=0;j<pnzi;j++) { 452eb9c0419SKris Buschelman nextap = 0; 453eb9c0419SKris Buschelman crow = *pJ++; 454eb9c0419SKris Buschelman cjj = cj + ci[crow]; 455eb9c0419SKris Buschelman caj = ca + ci[crow]; 456eb9c0419SKris Buschelman /* Perform sparse axpy operation. Note cjj includes apj. */ 457eb9c0419SKris Buschelman for (k=0;nextap<apnzj;k++) { 458eb9c0419SKris Buschelman if (cjj[k]==apj[nextap]) { 459eb9c0419SKris Buschelman caj[k] += (*pA)*apa[apj[nextap++]]; 460eb9c0419SKris Buschelman } 461eb9c0419SKris Buschelman } 462eb9c0419SKris Buschelman flops += 2*apnzj; 463eb9c0419SKris Buschelman pA++; 464eb9c0419SKris Buschelman } 465eb9c0419SKris Buschelman 466eb9c0419SKris Buschelman /* Zero the current row info for A*P */ 467eb9c0419SKris Buschelman for (j=0;j<apnzj;j++) { 468eb9c0419SKris Buschelman apa[apj[j]] = 0.; 469eb9c0419SKris Buschelman apjdense[apj[j]] = 0; 470eb9c0419SKris Buschelman } 471eb9c0419SKris Buschelman } 472eb9c0419SKris Buschelman 473eb9c0419SKris Buschelman /* Assemble the final matrix and clean up */ 474eb9c0419SKris Buschelman ierr = MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 475eb9c0419SKris Buschelman ierr = MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY);CHKERRQ(ierr); 476eb9c0419SKris Buschelman ierr = PetscFree(apa);CHKERRQ(ierr); 477eb9c0419SKris Buschelman ierr = PetscLogFlops(flops);CHKERRQ(ierr); 478eb9c0419SKris Buschelman ierr = PetscLogEventEnd(MATSeqAIJ_PtAPNumeric,A,P,C,0);CHKERRQ(ierr); 479eb9c0419SKris Buschelman 480eb9c0419SKris Buschelman PetscFunctionReturn(0); 481eb9c0419SKris Buschelman } 482eb9c0419SKris Buschelman EXTERN_C_END 483eb9c0419SKris Buschelman 484eb9c0419SKris Buschelman #undef __FUNCT__ 485eb9c0419SKris Buschelman #define __FUNCT__ "RegisterApplyPtAPRoutines_Private" 486eb9c0419SKris Buschelman int RegisterApplyPtAPRoutines_Private(Mat A) { 487eb9c0419SKris Buschelman int ierr; 488eb9c0419SKris Buschelman 489eb9c0419SKris Buschelman PetscFunctionBegin; 490eb9c0419SKris Buschelman 491eb9c0419SKris Buschelman if (!MATSeqAIJ_PtAP) { 492eb9c0419SKris Buschelman ierr = PetscLogEventRegister(&MATSeqAIJ_PtAP,"MatSeqAIJApplyPtAP",MAT_COOKIE);CHKERRQ(ierr); 493eb9c0419SKris Buschelman } 494eb9c0419SKris Buschelman 495eb9c0419SKris Buschelman if (!MATSeqAIJ_PtAPSymbolic) { 496eb9c0419SKris Buschelman ierr = PetscLogEventRegister(&MATSeqAIJ_PtAPSymbolic,"MatSeqAIJApplyPtAPSymbolic",MAT_COOKIE);CHKERRQ(ierr); 497eb9c0419SKris Buschelman } 498eb9c0419SKris Buschelman ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatApplyPtAPSymbolic_seqaij_seqaij", 499eb9c0419SKris Buschelman "MatApplyPtAPSymbolic_SeqAIJ_SeqAIJ", 500eb9c0419SKris Buschelman MatApplyPtAPSymbolic_SeqAIJ_SeqAIJ);CHKERRQ(ierr); 501eb9c0419SKris Buschelman 502eb9c0419SKris Buschelman if (!MATSeqAIJ_PtAPNumeric) { 503eb9c0419SKris Buschelman ierr = PetscLogEventRegister(&MATSeqAIJ_PtAPNumeric,"MatSeqAIJApplyPtAPNumeric",MAT_COOKIE);CHKERRQ(ierr); 504eb9c0419SKris Buschelman } 505eb9c0419SKris Buschelman ierr = PetscObjectComposeFunctionDynamic((PetscObject)A,"MatApplyPtAPNumeric_seqaij_seqaij", 506eb9c0419SKris Buschelman "MatApplyPtAPNumeric_SeqAIJ_SeqAIJ", 507eb9c0419SKris Buschelman MatApplyPtAPNumeric_SeqAIJ_SeqAIJ);CHKERRQ(ierr); 508eb9c0419SKris Buschelman PetscFunctionReturn(0); 509eb9c0419SKris Buschelman } 510