1c4762a1bSJed Brown! Test code contributed by Thibaut Appel <t.appel17@imperial.ac.uk> 2c4762a1bSJed Brown 3c4762a1bSJed Brown program test_assembly 4c4762a1bSJed Brown 5c4762a1bSJed Brown#include <petsc/finclude/petscmat.h> 6c4762a1bSJed Brown 7c4762a1bSJed Brown use PetscMat 8*d33816bfSBarry Smith use ISO_Fortran_Env, only : real64 9c4762a1bSJed Brown 10c4762a1bSJed Brown implicit none 11c4762a1bSJed Brown PetscInt, parameter :: wp = real64, n = 10 12c4762a1bSJed Brown PetscScalar, parameter :: zero = 0.0, one = 1.0 13c4762a1bSJed Brown Mat :: L 14c4762a1bSJed Brown PetscInt :: istart, iend, row, i1, i0 15c4762a1bSJed Brown PetscErrorCode :: ierr 16c4762a1bSJed Brown 17c4762a1bSJed Brown PetscInt cols(1),rows(1) 18c4762a1bSJed Brown PetscScalar vals(1) 19c4762a1bSJed Brown 20c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 21c4762a1bSJed Brown if (ierr .ne. 0) then 22c4762a1bSJed Brown print*,'Unable to initialize PETSc' 23c4762a1bSJed Brown stop 24c4762a1bSJed Brown endif 25c4762a1bSJed Brown 26c4762a1bSJed Brown i0 = 0 27c4762a1bSJed Brown i1 = 1 28c4762a1bSJed Brown 29c4762a1bSJed Brown call MatCreate(PETSC_COMM_WORLD,L,ierr); CHKERRA(ierr) 30c4762a1bSJed Brown call MatSetType(L,MATAIJ,ierr); CHKERRA(ierr) 31c4762a1bSJed Brown call MatSetSizes(L,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr); CHKERRA(ierr) 32c4762a1bSJed Brown 33c4762a1bSJed Brown call MatSeqAIJSetPreallocation(L,i1,PETSC_NULL_INTEGER,ierr); CHKERRA(ierr) 34c4762a1bSJed Brown call MatMPIAIJSetPreallocation(L,i1,PETSC_NULL_INTEGER,i0,PETSC_NULL_INTEGER,ierr); CHKERRA(ierr) ! No allocated non-zero in off-diagonal part 35c4762a1bSJed Brown call MatSetOption(L,MAT_IGNORE_ZERO_ENTRIES,PETSC_TRUE,ierr); CHKERRA(ierr) 36c4762a1bSJed Brown call MatSetOption(L,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_TRUE,ierr); CHKERRA(ierr) 37c4762a1bSJed Brown call MatSetOption(L,MAT_NO_OFF_PROC_ENTRIES,PETSC_TRUE,ierr); CHKERRA(ierr) 38c4762a1bSJed Brown 39c4762a1bSJed Brown call MatGetOwnershipRange(L,istart,iend,ierr); CHKERRA(ierr) 40c4762a1bSJed Brown 41c4762a1bSJed Brown ! assembling a diagonal matrix 42c4762a1bSJed Brown do row = istart,iend-1 43c4762a1bSJed Brown 44c4762a1bSJed Brown cols = [row]; vals = [one]; rows = [row]; 45c4762a1bSJed Brown call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr) 46c4762a1bSJed Brown 47c4762a1bSJed Brown end do 48c4762a1bSJed Brown 49c4762a1bSJed Brown call MatAssemblyBegin(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr) 50c4762a1bSJed Brown call MatAssemblyEnd(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr) 51c4762a1bSJed Brown 52c4762a1bSJed Brown call MatSetOption(L,MAT_NEW_NONZERO_LOCATION_ERR,PETSC_TRUE,ierr); CHKERRA(ierr) 53c4762a1bSJed Brown 54c4762a1bSJed Brown !call MatZeroEntries(L,ierr); CHKERRA(ierr) 55c4762a1bSJed Brown 56c4762a1bSJed Brown ! assembling a diagonal matrix, adding a zero value to non-diagonal part 57c4762a1bSJed Brown do row = istart,iend-1 58c4762a1bSJed Brown 59c4762a1bSJed Brown if (row == 0) then 60c4762a1bSJed Brown cols = [n-1] 61c4762a1bSJed Brown vals = [zero] 62c4762a1bSJed Brown rows = [row] 63c4762a1bSJed Brown call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr) 64c4762a1bSJed Brown end if 65c4762a1bSJed Brown cols = [row]; vals = [one] ; rows = [ row]; 66c4762a1bSJed Brown call MatSetValues(L,i1,rows,i1,cols,vals,ADD_VALUES,ierr); CHKERRA(ierr) 67c4762a1bSJed Brown 68c4762a1bSJed Brown end do 69c4762a1bSJed Brown 70c4762a1bSJed Brown call MatAssemblyBegin(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr) 71c4762a1bSJed Brown call MatAssemblyEnd(L,MAT_FINAL_ASSEMBLY,ierr); CHKERRA(ierr) 72c4762a1bSJed Brown call MatDestroy(L,ierr); CHKERRA(ierr) 73c4762a1bSJed Brown 74c4762a1bSJed Brown call PetscFinalize(ierr) 75c4762a1bSJed Brown 76c4762a1bSJed Brownend program test_assembly 77c4762a1bSJed Brown 78c4762a1bSJed Brown!/*TEST 79c4762a1bSJed Brown! 80c4762a1bSJed Brown! build: 81c4762a1bSJed Brown! requires: complex 82c4762a1bSJed Brown! 83c4762a1bSJed Brown! test: 84c4762a1bSJed Brown! nsize: 2 85c4762a1bSJed Brown! 86c4762a1bSJed Brown!TEST*/ 87