1*c4762a1bSJed Brown! 2*c4762a1bSJed Brown! Program to test recently added F90 features for Mat 3*c4762a1bSJed Brown! 4*c4762a1bSJed Brown program main 5*c4762a1bSJed Brown 6*c4762a1bSJed Brown#include <petsc/finclude/petscmat.h> 7*c4762a1bSJed Brown use petscmat 8*c4762a1bSJed Brown implicit none 9*c4762a1bSJed Brown 10*c4762a1bSJed Brown PetscErrorCode ierr 11*c4762a1bSJed Brown Mat A,B 12*c4762a1bSJed Brown Mat C,SC 13*c4762a1bSJed Brown MatNullSpace sp,sp1 14*c4762a1bSJed Brown PetscInt one,zero,rend 15*c4762a1bSJed Brown PetscScalar sone 16*c4762a1bSJed Brown Vec x,y 17*c4762a1bSJed Brown 18*c4762a1bSJed Brown zero = 0 19*c4762a1bSJed Brown one = 1 20*c4762a1bSJed Brown sone = 1 21*c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 22*c4762a1bSJed Brown if (ierr .ne. 0) then 23*c4762a1bSJed Brown print*, 'Unable to begin PETSc program' 24*c4762a1bSJed Brown endif 25*c4762a1bSJed Brown 26*c4762a1bSJed Brown call MatCreate(PETSC_COMM_WORLD,A,ierr) 27*c4762a1bSJed Brown call MatCreate(PETSC_COMM_WORLD,B,ierr) 28*c4762a1bSJed Brown 29*c4762a1bSJed Brown call MatGetNullSpace(A,sp,ierr) 30*c4762a1bSJed Brown if (sp .ne. PETSC_NULL_MATNULLSPACE) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Matrix null space should not exist"); endif 31*c4762a1bSJed Brown 32*c4762a1bSJed Brown call MatSetNullSpace(A,PETSC_NULL_MATNULLSPACE,ierr) 33*c4762a1bSJed Brown call MatGetNullSpace(A,sp,ierr) 34*c4762a1bSJed Brown if (sp .ne. PETSC_NULL_MATNULLSPACE) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Matrix null space should not exist"); endif 35*c4762a1bSJed Brown 36*c4762a1bSJed Brown call MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,zero,PETSC_NULL_VEC,sp,ierr) 37*c4762a1bSJed Brown call MatSetNullSpace(A,sp,ierr) 38*c4762a1bSJed Brown call MatGetNullSpace(A,sp1,ierr) 39*c4762a1bSJed Brown if (sp1 .eq. PETSC_NULL_MATNULLSPACE) then; SETERRA(PETSC_COMM_SELF,PETSC_ERR_PLIB,"Matrix null space should not be null"); endif 40*c4762a1bSJed Brown call MatNullSpaceDestroy(sp,ierr) 41*c4762a1bSJed Brown 42*c4762a1bSJed Brown call MatCreateSeqDense(PETSC_COMM_WORLD,one,one,PETSC_NULL_SCALAR,C,ierr) 43*c4762a1bSJed Brown call MatSetValues(C,one,zero,one,zero,sone,INSERT_VALUES,ierr) 44*c4762a1bSJed Brown call MatAssemblyBegin(C,MAT_FINAL_ASSEMBLY,ierr) 45*c4762a1bSJed Brown call MatAssemblyEnd(C,MAT_FINAL_ASSEMBLY,ierr) 46*c4762a1bSJed Brown call MatCreateSchurComplement(C,C,C,C,PETSC_NULL_MAT,SC,ierr) 47*c4762a1bSJed Brown call MatGetOwnershipRange(SC,PETSC_NULL_INTEGER,rend,ierr) 48*c4762a1bSJed Brown call VecCreateSeq(PETSC_COMM_SELF,one,x,ierr) 49*c4762a1bSJed Brown call VecDuplicate(x,y,ierr) 50*c4762a1bSJed Brown call VecSetValues(x,one,zero,sone,INSERT_VALUES,ierr) 51*c4762a1bSJed Brown call VecAssemblyBegin(x,ierr) 52*c4762a1bSJed Brown call VecAssemblyEnd(x,ierr) 53*c4762a1bSJed Brown call MatMult(SC,x,y,ierr) 54*c4762a1bSJed Brown call VecView(y,PETSC_VIEWER_STDOUT_SELF,ierr) 55*c4762a1bSJed Brown call VecSetRandom(x,PETSC_NULL_RANDOM,ierr) 56*c4762a1bSJed Brown call VecView(x,PETSC_VIEWER_STDOUT_SELF,ierr) 57*c4762a1bSJed Brown 58*c4762a1bSJed Brown call MatDestroy(SC,ierr) 59*c4762a1bSJed Brown call MatDestroy(C,ierr) 60*c4762a1bSJed Brown call VecDestroy(x,ierr) 61*c4762a1bSJed Brown call VecDestroy(y,ierr) 62*c4762a1bSJed Brown call MatDestroy(A,ierr) 63*c4762a1bSJed Brown call MatDestroy(B,ierr) 64*c4762a1bSJed Brown call PetscFinalize(ierr) 65*c4762a1bSJed Brown end 66*c4762a1bSJed Brown 67*c4762a1bSJed Brown!/*TEST 68*c4762a1bSJed Brown! 69*c4762a1bSJed Brown! test: 70*c4762a1bSJed Brown! requires: !complex 71*c4762a1bSJed Brown! 72*c4762a1bSJed Brown!TEST*/ 73