Hello,
I'm working on solve a linear system in parallel, following ex12 of the ksp
tutorial i don't see major complication on doing so, so for a working
linear system solver with PCJACOBI and KSPGCR i did only the following
changes:
call MatCreate(PETSC_COMM_WORLD,Ap,ierr)
! call MatSetType(Ap,MATSEQAIJ,ierr)
call MatSetType(Ap,MATMPIAIJ,ierr) !paralellization
call MatSetSizes(Ap,PETSC_DECIDE,PETSC_DECIDE,nbdp,nbdp,ierr);
! call MatSeqAIJSetPreallocationCSR(Ap,iapi,japi,app,ierr)
call MatSetFromOptions(Ap,ierr)
! call
MatCreateSeqAIJWithArrays(PETSC_COMM_WORLD,nbdp,nbdp,iapi,japi,app,Ap,ierr)
call
MatCreateMPIAIJWithArrays(PETSC_COMM_WORLD,floor(real(nbdp)/sizel),PETSC_DECIDE,nbdp,nbdp,iapi,japi,app,Ap,ierr)
I grayed out the changes from sequential implementation.
So, it does not complain at runtime until it reaches KSPSolve(), with the
following error:
[1]PETSC ERROR: --------------------- Error Message
--------------------------------------------------------------
[1]PETSC ERROR: Object is in wrong state
[1]PETSC ERROR: Matrix is missing diagonal entry 0
[1]PETSC ERROR: See http://www.mcs.anl.gov/petsc/documentation/faq.html for
trouble shooting.
[1]PETSC ERROR: Petsc Release Version 3.7.3, unknown
[1]PETSC ERROR: ./solvelinearmgPETSc
� � on a arch-linux2-c-debug
named valera-HP-xw4600-Workstation by valera Mon Sep 26 13:35:15 2016
[1]PETSC ERROR: Configure options --with-cc=gcc --with-cxx=g++
--with-fc=gfortran --download-fblaslapack=1 --download-mpich=1
--download-ml=1
[1]PETSC ERROR: #1 MatILUFactorSymbolic_SeqAIJ() line 1733 in
/home/valera/v5PETSc/petsc/petsc/src/mat/impls/aij/seq/aijfact.c
[1]PETSC ERROR: #2 MatILUFactorSymbolic() line 6579 in
/home/valera/v5PETSc/petsc/petsc/src/mat/interface/matrix.c
[1]PETSC ERROR: #3 PCSetUp_ILU() line 212 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/pc/impls/factor/ilu/ilu.c
[1]PETSC ERROR: #4 PCSetUp() line 968 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/pc/interface/precon.c
[1]PETSC ERROR: #5 KSPSetUp() line 390 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/ksp/interface/itfunc.c
[1]PETSC ERROR: #6 PCSetUpOnBlocks_BJacobi_Singleblock() line 650 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/pc/impls/bjacobi/bjacobi.c
[1]PETSC ERROR: #7 PCSetUpOnBlocks() line 1001 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/pc/interface/precon.c
[1]PETSC ERROR: #8 KSPSetUpOnBlocks() line 220 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/ksp/interface/itfunc.c
[1]PETSC ERROR: #9 KSPSolve() line 600 in
/home/valera/v5PETSc/petsc/petsc/src/ksp/ksp/interface/itfunc.c
At line 333 of file solvelinearmgPETSc.f90
Fortran runtime error: Array bound mismatch for dimension 1 of array 'sol'
(213120/106560)
This code works for -n 1 cores, but it gives this error when using more
than one core.
What am i missing?
Regards,
Manuel.
PROGRAM solvelinearmgpetsc
IMPLICIT NONE
!PETSc Implementation, include files:
!Created by Manuel Valera 6/10/16:
#include <petsc/finclude/petscsys.h> !core PETSc
#include <petsc/finclude/petscvec.h> !vectors
#include <petsc/finclude/petscvec.h90> !special vectors f90 functions
#include <petsc/finclude/petscmat.h> !matrixes
#include <petsc/finclude/petscis.h> !index sets
#include <petsc/finclude/petscviewer.h> !viewers
#include <petsc/finclude/petscpc.h> !preconditioners
#include <petsc/finclude/petscksp.h> !Krylov subspaces (Solver)
! Local Variables: matrix dimensions for Seamount Testcase (97x61x38)
INTEGER, parameter :: nbnodos = 213120, nnz = 3934732
! Matrix dimension for Angie Testing case
!INTEGER, parameter :: nbnodos = 36, nnz = 394
DOUBLE PRECISION :: ui,uj,uk
DOUBLE PRECISION :: vi,vj,vk
DOUBLE PRECISION :: wi,wj,wk
DOUBLE PRECISION :: const,maxdiff
DOUBLE PRECISION, DIMENSION(nbnodos) :: Rhs
DOUBLE PRECISION, DIMENSION(nbnodos) :: sol,sol2,soldiff
INTEGER :: i,j,k,l
real (kind(0d0)) :: tolp,norm2
integer :: iter,iprint
INTEGER :: ierr0,ierrm
! PETSc IMPLEMENTATION, Variables:
PC :: pc,mg
KSP :: ksp
Vec :: xp,bp,up,x,y,work
Mat :: Ap,pmat
MatNullSpace :: nullsp
PetscErrorCode :: ierr
PetscInt :: nbdp,nnzp,ii,nel,its,spa
PetscReal :: norm,tol
PetscScalar :: negone,one
PetscScalar, pointer :: soln(:)
PetscScalar, pointer :: rpia(:)
PetscInt, allocatable :: iapi(:),japi(:),ind(:)
PetscScalar, allocatable :: app(:)
PetscScalar :: rpi
PetscViewer :: viewer
KSPConvergedReason :: reason
PetscMPIInt :: rankl, sizel
PetscLogDouble :: ti,tf,tt
!TODO: IMPORTANT ALL USER-DEFINED ROUTINES SHOULD BE DECLARED AS EXTERNAL
!external SampleShellPCSetUp,SampleShellPCApply
!common /mypcs/ jacobi,mg,work
!PC jacobi,mg
!Vec work
!Testing AGMG reading from a file.
DOUBLE PRECISION,allocatable :: a(:)
integer,allocatable :: ja(:),ia(:)
allocate(a(nnz), stat=ierr)
allocate(ja(nnz), stat=ierr)
allocate(ia(nbnodos+1), stat=ierr)
open(15,file='iac.txt', status='old')
read(15,*) ia
close(15,status='KEEP')
open(16,file='jac.txt', status='old')
read(16,*) ja
close(16,status='KEEP')
open(17,file='ac.txt', status='old')
read(17,*) a
close(17,status='KEEP')
open(18,file='rhsc.txt', status='old')
read(18,*) Rhs
close(18,status='KEEP')
!PETSc IMPLEMENTATION, MAT-VEC Population:
!by Manuel Valera, June 2016.
call MPI_Init(ierrm)
call MPI_Comm_Rank(MPI_COMM_WORLD,rankl,ierrm)
call MPI_Comm_split(MPI_COMM_WORLD,1,0,PETSC_COMM_WORLD,ierrm)
call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
call PetscTime(ti,ierr)
call MPI_Comm_rank(PETSC_COMM_WORLD, rankl, ierr)
call MPI_Comm_size(PETSC_COMM_WORLD, sizel, ierr)
!Adapted from Chris Paolini examples:
! 1.- SETUP VECTORS-
! Create vectors. Note that we form 1 vector from scratch and
! then duplicate to form b.
! Prepare PETSc integers:
nbdp = nbnodos !matrix dimension
nnzp = nnz !nonzero entries in each matrix row
allocate(iapi(nbdp+1), stat=ierr)
allocate(japi(nnzp), stat=ierr)
allocate(app(nnzp), stat=ierr)
allocate(ind(nnzp), stat=ierr)
allocate(soln(nbdp), stat=ierr)
call VecCreate(PETSC_COMM_WORLD,xp,ierr)
call VecSetSizes(xp,PETSC_DECIDE,nbdp,ierr) ! Size of xp - nbnodos
!VecSetSizes(Vec v, PetscInt n, PetscInt N)
call VecSetFromOptions(xp,ierr)
call VecDuplicate(xp,bp,ierr) ! duplicate xp (soln vector) into bp(RHS),both have same length
call VecDuplicate(xp,up,ierr) ! up = exact solution
call VecDuplicate(xp,work,ierr) ! some other vector
call VecDuplicate(xp,y,ierr) ! some other vector
CHKERRQ(ierr)
! 1.2.- SET VECTORS VALUES:
call VecSet(xp,0.0D0,ierr) !initializing SOLN to zeros
call VecAssemblyBegin(xp,ierr) ; call VecAssemblyEnd(xp,ierr)
call VecSet(up,1.0D0,ierr) !initializing exact soln to ones
call VecAssemblyBegin(up,ierr) ; call VecAssemblyEnd(up,ierr)
call VecAssemblyBegin(work,ierr) ; call VecAssemblyEnd(work,ierr)
call VecAssemblyBegin(y,ierr) ; call VecAssemblyEnd(y,ierr)
call VecGetSize(xp,nel,ierr)
print*, "TrivSoln loaded, size: ", nel, "/",nbdp
! call VecGetArrayF90(xp,soln,ierr)
! sol = soln
! call VecRestoreArrayF90(xp,soln,ierr)
! print*, "XP EYE maxval:", MAXVAL(sol)
! print*, "XP EYE minval:", MINVAL(sol)
! Load RHS:
! call VecSet(bp,5.0D0,ierr) !making Rhs something else (all 5's)
do i=0,nbdp-1,1
ind(i+1) = i
enddo
call VecSetValues(bp,nbdp,ind,Rhs,INSERT_VALUES,ierr) !feeding whole RHS in one call
call VecAssemblyBegin(bp,ierr) ; call VecAssemblyEnd(bp,ierr) !rhs
! call VecView(bp,PETSC_VIEWER_STDOUT_WORLD,ierr) ! RHS looks OK
call VecGetSize(bp,nel,ierr)
print*, "RHS loaded, size: ", nel, "/",nbdp
! allocate(rpia(nbdp),stat=ierr)
! call VecGetArrayF90(bp,rpia,ierr)
! print*, "RHS maxvalue:", MAXVAL(rpia) !a way to look if rhs is changing
! call VecRestoreArrayF90(bp,rpia,ierr)
! deallocate(rpia,stat=ierr)
!!! Converting CSR arrays into PETSc
iapi = ia
japi = ja
app = a
!Reordering CSR Matrix to Sorted-CSR
do i=1,nbdp,1
spa = iapi(i+1)-iapi(i)
select case (i)
case(1)
call PetscSortIntWithScalarArray(spa,japi(i),app(i),ierr); !1st row case
case default
call PetscSortIntWithScalarArray(spa,japi(iapi(i)+1),app(iapi(i)+1),ierr); !other rows case
end select
enddo
! 2.- SETUP MATRIXES:
! Create matrix from CSR arrays directly:
!Recommended Paradigm:
call MatCreate(PETSC_COMM_WORLD,Ap,ierr)
! call MatSetType(Ap,MATSEQAIJ,ierr) !in parallel, type changes. check.
call MatSetType(Ap,MATMPIAIJ,ierr) !paralellization
call MatSetSizes(Ap,PETSC_DECIDE,PETSC_DECIDE,nbdp,nbdp,ierr);
! call MatSetBlockSize(Ap,3,ierr) ! NEEDED ? 3 == Freedom degrees *** for pcgamg
! call MatSeqAIJSetPreallocationCSR(Ap,iapi,japi,app,ierr)
call MatSetFromOptions(Ap,ierr)
! call MatCreateSeqAIJWithArrays(PETSC_COMM_WORLD,nbdp,nbdp,iapi,japi,app,Ap,ierr)
call MatCreateMPIAIJWithArrays(PETSC_COMM_WORLD,floor(real(nbdp)/sizel),PETSC_DECIDE,nbdp,nbdp,iapi,japi,app,Ap,ierr)
print*, "local size:", floor(real(nbdp)/sizel)
! call exit()
! 2.1.- ASSEMBLE MATRIX:
! Setup Matrix:
call MatSetUp(Ap,ierr)
call MatNullSpaceCreate(PETSC_COMM_WORLD,PETSC_TRUE,0,0,nullsp,ierr); !NO IDEA ABOUT THIS. TODO
call MatSetNearNullSpace(Ap,nullsp,ierr) ! NEEDED ? ***for pcgamg
call MatNullSpaceDestroy(nullsp,ierr);
CHKERRQ(ierr)
call MatAssemblyBegin(Ap,MAT_FINAL_ASSEMBLY,ierr)
call MatAssemblyEnd(Ap,MAT_FINAL_ASSEMBLY,ierr)
!Matrix viewer (off diagonals not shown ?)
! call MatView(Ap,PETSC_VIEWER_DRAW_WORLD,ierr)
! call sleep(10)
!!!! Creating A*eye=RHS
call MatMult(Ap,up,bp,ierr) !Ap*up=bp
!!!
! 4.- PETSc IMPLEMENTATION, ACTUAL SOLVER:
!/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Create the linear solver and set various options
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! /*
! Create linear solver context
! */
call KSPCreate(PETSC_COMM_WORLD,ksp,ierr) ! Solver (linear, for nonlinear must use SNES)
call KSPSetOperators(ksp,Ap,Ap,ierr)
call KSPGetPC(ksp,pc,ierr)
tol = 1.e-5
call KSPSetTolerances(ksp,tol,PETSC_DEFAULT_REAL,PETSC_DEFAULT_REAL,PETSC_DEFAULT_INTEGER,ierr)
!Create PC
call PCGetOperators(pc,Ap,pmat,ierr)
call PCCreate(PETSC_COMM_WORLD,mg,ierr)
call PCSetType(mg,PCJACOBI,ierr)
call PCSetOperators(mg,Ap,pmat,ierr)
call PCSetUp(mg,ierr)
! call PCGetOperators(pc,PETSC_NULL_OBJECT,pmat,ierr)
! call PCCreate(PETSC_COMM_WORLD,mg,ierr)
! call PCSetType(mg,PCGAMG,ierr)
! call PCSetOperators(mg,pmat,pmat,ierr)
! call PCSetUp(mg,ierr)
!MG options
! call PCGAMGSetNLevels(mg,3,PETSC_NULL_OBJECT,ierr)
! call PCGAMGSetNSmooths(mg,1,ierr)
! call PCGAMGSetThreshold(mg,0.0d0,ierr)
!Apply PC
call PCApply(mg,xp,work,ierr)
one = 1.0
call VecAXPY(y,one,work,ierr)
!!Calling PCs as example42KSP:
! call PCSetType(pc,PCSHELL,ierr) !PC setted as ex42 of ksp
! call PCSetType(pc,PCJACOBI,ierr) !
! call PCShellSetApply(pc,SampleShellPCApply,ierr)
! call SampleShellPCSetUp(pc,xp,ierr)
call KSPSetType(ksp,KSPGCR,ierr) !agmg uses this, basically.
call KSPSetCheckNormIteration(ksp,100,ierr) !agmg has 5000
CHKERRQ(ierr)
call KSPSetFromOptions(ksp,ierr)
CHKERRQ(ierr)
call KSPSetUp(ksp,ierr);
! call KSPSetUpOnBlocks(ksp,ierr);
CHKERRQ(ierr)
!/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! Solve the linear system
! - - - - - - - - - - - - - - - - - - - - - - - */
call KSPSolve(ksp,bp,xp,ierr)
! call KSPMonitorTrueResidualNorm(ksp,its,norm,viewer,ierr)
call VecGetArrayF90(xp,soln,ierr)
sol = soln !Copying new solution to regular scalar array
call VecRestoreArrayF90(xp,soln,ierr)
print*, "soln maxval:", MAXVAL(sol)
print*, "soln minval:", MINVAL(sol)
!Check the error as in ex1.c from petsc manual:
negone = -1.0d0
call VecAXPY(xp,negone,up,ierr);
call VecNorm(xp,NORM_2,norm,ierr);
call KSPGetIterationNumber(ksp,its,ierr);
iter = its
norm2 = norm
print *, "Norm:", norm2
print *, "Its:", iter
!End checking error
deallocate(iapi,stat=ierr0)
IF (ierr0 /= 0) STOP "*** iapi ***"
deallocate(japi,stat=ierr0)
IF (ierr0 /= 0) STOP "*** japi ***"
! 5.- CLEAN UP OBJECTS:
call MatDestroy(Ap,ierr)
call VecDestroy(xp,ierr)
call VecDestroy(bp,ierr)
call VecDestroy(up,ierr)
call KSPDestroy(ksp,ierr)
call PCDestroy(mg,ierr)
! call PCDestroy(pc,ierr) !this gives error - weird
call VecDestroy(work,ierr)
call VecDestroy(y,ierr)
CHKERRQ(ierr)
deallocate(app,stat=ierr0)
IF (ierr0 /= 0) STOP "*** app ***"
CHKERRQ(ierr)
call PetscTime(tf,ierr)
tt = tf - ti
print*, "Total time:", tt
call PetscFinalize(ierr)
call MPI_Finalize(ierrm)
call EXIT() !abort program at this point.
END PROGRAM solvelinearmgpetsc
!Subroutines from example42 KSP-PETSc:
!/***********************************************************************/
!/* Routines for a user-defined shell preconditioner */
!/***********************************************************************/
!
! SampleShellPCSetUp - This routine sets up a user-defined
! preconditioner context.
!
! Input Parameters:
! pc - preconditioner object
! x - vector
!
! Output Parameter:
! ierr - error code (nonzero if error has been detected)
!
! Notes:
! In this example, we define the shell preconditioner to be Jacobi
! method. Thus, here we create a work vector for storing the reciprocal
! of the diagonal of the preconditioner matrix; this vector is then
! used within the routine SampleShellPCApply().
!
! subroutine SampleShellPCSetUp(pc,x,ierr)
! implicit none
!#include <petsc/finclude/petscsys.h>
!#include <petsc/finclude/petscvec.h>
!#include <petsc/finclude/petscvec.h90>
!#include <petsc/finclude/petscmat.h>
!#include <petsc/finclude/petscpc.h>
!#include <petsc/finclude/petscksp.h>
! PC pc
! Vec x
! Mat pmat
! PetscErrorCode ierr
! PetscInt nl,k,finest
! DM da_list,daclist
! Mat R
! Common block to store data for user-provided preconditioner
! common /mypcs/ jacobi,mg,work
! PC jacobi,mg
! Vec work
!! adapting from example 42 of ksp - Petsc
! call PCGetOperators(pc,PETSC_NULL_OBJECT,pmat,ierr)
! call PCCreate(PETSC_COMM_WORLD,jacobi,ierr)
! call PCSetType(jacobi,PCJACOBI,ierr)
! call PCSetOperators(jacobi,pmat,pmat,ierr)
! call PCSetUp(jacobi,ierr)
! .- SOR "2nd level" Preconditioner - as Ex42-ksp
! call PCSetType(mg,PCSOR,ierr) !This was PCSOR before
! call PCSetOperators(mg,pmat,pmat,ierr)
! call PCSORSetSymmetric(mg,SOR_LOCAL_SYMMETRIC_SWEEP,ierr)
! 3.- MULTIGRID SETUP (PCGAMG): !THIS IS PCAMG = ALGEBRAIC MG (same results than MG)
! call PCGetOperators(pc,PETSC_NULL_OBJECT,pmat,ierr)
! call PCCreate(PETSC_COMM_WORLD,mg,ierr)
! call PCSetType(mg,PCGAMG,ierr)
! call PCSetOperators(mg,pmat,pmat,ierr)
! call PCGAMGSetNLevels(mg,3,PETSC_NULL_OBJECT,ierr)
! call PCGAMGSetNSmooths(mg,1,ierr)
! call PCGAMGSetThreshold(mg,0.0d0,ierr)
! call PCSetUp(mg,ierr)
! call PCApply(mg,x,y,ierr)
! call VecAXPY(y,one,x,ierr)
!!!! Endof
! call VecDuplicate(x,work,ierr)
! end
! -------------------------------------------------------------------
!
! SampleShellPCApply - This routine demonstrates the use of a
! user-provided preconditioner.
!
! Input Parameters:
! pc - preconditioner object
! x - input vector
!
! Output Parameters:
! y - preconditioned vector
! ierr - error code (nonzero if error has been detected)
!
! Notes:
! This code implements the Jacobi preconditioner plus the
! SOR preconditioner
!
! YOU CAN GET THE EXACT SAME EFFECT WITH THE PCCOMPOSITE preconditioner using
! mpiexec -n 1 ex21f -ksp_monitor -pc_type composite -pc_composite_pcs jacobi,sor -pc_composite_type additive
!
! subroutine SampleShellPCApply(pc,x,y,ierr)
! implicit none
!#include <petsc/finclude/petscsys.h>
!#include <petsc/finclude/petscvec.h>
!#include <petsc/finclude/petscpc.h>
! PC pc
! Vec x,y
! PetscErrorCode ierr
! PetscScalar one
! Common block to store data for user-provided preconditioner
! common /mypcs/ jacobi,mg,work
! PC jacobi,mg
! Vec work
! one = 1.0
! call PCApply(jacobi,x,y,ierr)
! call PCApply(mg,x,work,ierr)
! call VecAXPY(y,one,work,ierr)
! end
