Date: 2013-07-02T14:49:04+00:00

Actual source code: ex13f90.F
petsc-3.4.2 2013-07-02

      1: !
      2: !
      3: !/*T
      4: !   Concepts: KSP^basic sequential example
      5: !   Concepts: KSP^Laplacian, 2d
      6: !   Concepts: Laplacian, 2d
      7: !   Processors: 1
      8: !T*/
      9: ! -----------------------------------------------------------------------

     11:       program main
     12:       implicit none

     14: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     15: !                    Include files
     16: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     17: !
     18: !  The following include statements are required for KSP Fortran programs:
     19: !     petscsys.h  - base PETSc routines
     20: !     petscvec.h    - vectors
     21: !     petscmat.h    - matrices
     22: !     petscksp.h    - Krylov subspace methods
     23: !     petscpc.h     - preconditioners
     24: !
     25: #include <finclude/petscsys.h>
     26: #include <finclude/petscvec.h>
     27: #include <finclude/petscmat.h>
     28: #include <finclude/petscksp.h>
     29: #include <finclude/petscpc.h>

     31: !    User-defined context that contains all the data structures used
     32: !    in the linear solution process.

     34: !   Vec    x,b      /* solution vector, right hand side vector and work vector */
     35: !   Mat    A        /* sparse matrix */
     36: !   KSP   ksp     /* linear solver context */
     37: !   int    m,n      /* grid dimensions */
     38: !
     39: !   Since we cannot store Scalars and integers in the same context,
     40: !   we store the integers/pointers in the user-defined context, and
     41: !   the scalar values are carried in the common block.
     42: !   The scalar values in this simplistic example could easily
     43: !   be recalculated in each routine, where they are needed.
     44: !
     45: !   Scalar hx2,hy2  /* 1/(m+1)*(m+1) and 1/(n+1)*(n+1) */

     47: !  Note: Any user-defined Fortran routines MUST be declared as external.

     49:       external UserInitializeLinearSolver
     50:       external UserFinalizeLinearSolver
     51:       external UserDoLinearSolver

     53: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     54: !                   Variable declarations
     55: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     57:       PetscScalar  hx,hy,x,y
     58:       PetscFortranAddr userctx(6)
     59:       PetscErrorCode ierr
     60:       PetscInt m,n,t,tmax,i,j
     61:       PetscBool  flg
     62:       PetscMPIInt size,rank
     63:       PetscReal  enorm
     64:       PetscScalar cnorm
     65:       PetscScalar,ALLOCATABLE :: userx(:,:)
     66:       PetscScalar,ALLOCATABLE :: userb(:,:)
     67:       PetscScalar,ALLOCATABLE :: solution(:,:)
     68:       PetscScalar,ALLOCATABLE :: rho(:,:)

     70:       double precision hx2,hy2
     71:       common /param/ hx2,hy2

     73:       tmax = 2
     74:       m = 6
     75:       n = 7

     77: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     78: !                 Beginning of program
     79: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     81:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     82:       call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
     83:       if (size .ne. 1) then
     84:          call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
     85:          if (rank .eq. 0) then
     86:             write(6,*) 'This is a uniprocessor example only!'
     87:          endif
     88:          SETERRQ(PETSC_COMM_WORLD,1,' ',ierr)
     89:       endif

     91: !  The next two lines are for testing only; these allow the user to
     92: !  decide the grid size at runtime.

     94:       call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-m',m,flg,ierr)
     95:       call PetscOptionsGetInt(PETSC_NULL_CHARACTER,'-n',n,flg,ierr)

     97: !  Create the empty sparse matrix and linear solver data structures

     99:       call UserInitializeLinearSolver(m,n,userctx,ierr)

    101: !  Allocate arrays to hold the solution to the linear system.  This
    102: !  approach is not normally done in PETSc programs, but in this case,
    103: !  since we are calling these routines from a non-PETSc program, we
    104: !  would like to reuse the data structures from another code. So in
    105: !  the context of a larger application these would be provided by
    106: !  other (non-PETSc) parts of the application code.

    108:       ALLOCATE (userx(m,n),userb(m,n),solution(m,n))

    110: !  Allocate an array to hold the coefficients in the elliptic operator

    112:        ALLOCATE (rho(m,n))

    114: !  Fill up the array rho[] with the function rho(x,y) = x; fill the
    115: !  right-hand-side b[] and the solution with a known problem for testing.

    117:       hx = 1.0/(m+1)
    118:       hy = 1.0/(n+1)
    119:       y  = hy
    120:       do 20 j=1,n
    121:          x = hx
    122:          do 10 i=1,m
    123:             rho(i,j)      = x
    124:             solution(i,j) = sin(2.*PETSC_PI*x)*sin(2.*PETSC_PI*y)
    125:             userb(i,j)    = -2.*PETSC_PI*cos(2.*PETSC_PI*x)*              &
    126:      &                sin(2.*PETSC_PI*y) +                                &
    127:      &                8*PETSC_PI*PETSC_PI*x*                              &
    128:      &                sin(2.*PETSC_PI*x)*sin(2.*PETSC_PI*y)
    129:            x = x + hx
    130:  10      continue
    131:          y = y + hy
    132:  20   continue

    134: !  Loop over a bunch of timesteps, setting up and solver the linear
    135: !  system for each time-step.
    136: !  Note that this loop is somewhat artificial. It is intended to
    137: !  demonstrate how one may reuse the linear solvers in each time-step.

    139:       do 100 t=1,tmax
    140:          call UserDoLinearSolver(rho,userctx,userb,userx,ierr)

    142: !        Compute error: Note that this could (and usually should) all be done
    143: !        using the PETSc vector operations. Here we demonstrate using more
    144: !        standard programming practices to show how they may be mixed with
    145: !        PETSc.
    146:          cnorm = 0.0
    147:          do 90 j=1,n
    148:             do 80 i=1,m
    149:                cnorm = cnorm +                                           &
    150:      &    PetscConj(solution(i,j)-userx(i,j))*                                            &
    151:      &                             (solution(i,j)-userx(i,j))
    152:  80         continue
    153:  90      continue
    154:          enorm =  PetscRealPart(cnorm*hx*hy)
    155:          write(6,115) m,n,enorm
    156:  115     format ('m = ',I2,' n = ',I2,' error norm = ',1PE11.4)
    157:  100  continue

    159: !  We are finished solving linear systems, so we clean up the
    160: !  data structures.

    162:       DEALLOCATE (userx,userb,solution,rho)

    164:       call UserFinalizeLinearSolver(userctx,ierr)
    165:       call PetscFinalize(ierr)
    166:       end

    168: ! ----------------------------------------------------------------
    169:       subroutine UserInitializeLinearSolver(m,n,userctx,ierr)

    171:       implicit none

    173: #include <finclude/petscsys.h>
    174: #include <finclude/petscvec.h>
    175: #include <finclude/petscmat.h>
    176: #include <finclude/petscksp.h>
    177: #include <finclude/petscpc.h>

    179:       PetscInt m,n
    180:       PetscErrorCode ierr
    181:       PetscFortranAddr userctx(*)

    183:       common /param/ hx2,hy2
    184:       double precision hx2,hy2

    186: !  Local variable declararions
    187:       Mat     A
    188:       Vec     b,x
    189:       KSP    ksp
    190:       PetscInt Ntot,five,one

    193: !  Here we assume use of a grid of size m x n, with all points on the
    194: !  interior of the domain, i.e., we do not include the points corresponding
    195: !  to homogeneous Dirichlet boundary conditions.  We assume that the domain
    196: !  is [0,1]x[0,1].

    198:       hx2 = (m+1)*(m+1)
    199:       hy2 = (n+1)*(n+1)
    200:       Ntot = m*n

    202:       five = 5
    203:       one = 1

    205: !  Create the sparse matrix. Preallocate 5 nonzeros per row.

    207:       call MatCreateSeqAIJ(PETSC_COMM_SELF,Ntot,Ntot,five,              &
    208:      &     PETSC_NULL_INTEGER,A,ierr)
    209: !
    210: !  Create vectors. Here we create vectors with no memory allocated.
    211: !  This way, we can use the data structures already in the program
    212: !  by using VecPlaceArray() subroutine at a later stage.
    213: !
    214:       call VecCreateSeqWithArray(PETSC_COMM_SELF,one,Ntot,              &
    215:      &     PETSC_NULL_SCALAR,b,ierr)
    216:       call VecDuplicate(b,x,ierr)

    218: !  Create linear solver context. This will be used repeatedly for all
    219: !  the linear solves needed.

    221:       call KSPCreate(PETSC_COMM_SELF,ksp,ierr)

    223:       userctx(1) = x
    224:       userctx(2) = b
    225:       userctx(3) = A
    226:       userctx(4) = ksp
    227:       userctx(5) = m
    228:       userctx(6) = n

    230:       return
    231:       end
    232: ! -----------------------------------------------------------------------

    234: !   Solves -div (rho grad psi) = F using finite differences.
    235: !   rho is a 2-dimensional array of size m by n, stored in Fortran
    236: !   style by columns. userb is a standard one-dimensional array.

    238:       subroutine UserDoLinearSolver(rho,userctx,userb,userx,ierr)

    240:       implicit none

    242: #include <finclude/petscsys.h>
    243: #include <finclude/petscvec.h>
    244: #include <finclude/petscmat.h>
    245: #include <finclude/petscksp.h>
    246: #include <finclude/petscpc.h>

    248:       PetscErrorCode ierr
    249:       PetscFortranAddr userctx(*)
    250:       PetscScalar rho(*),userb(*),userx(*)

    253:       common /param/ hx2,hy2
    254:       double precision hx2,hy2

    256:       PC   pc
    257:       KSP ksp
    258:       Vec  b,x
    259:       Mat  A
    260:       PetscInt m,n,one
    261:       PetscInt i,j,II,JJ
    262:       PetscScalar  v

    264: !      PetscScalar tmpx(*),tmpb(*)

    266:       one  = 1
    267:       x    = userctx(1)
    268:       b    = userctx(2)
    269:       A    = userctx(3)
    270:       ksp  = userctx(4)
    271:       m    = int(userctx(5))
    272:       n    = int(userctx(6))

    274: !  This is not the most efficient way of generating the matrix,
    275: !  but let's not worry about it.  We should have separate code for
    276: !  the four corners, each edge and then the interior. Then we won't
    277: !  have the slow if-tests inside the loop.
    278: !
    279: !  Compute the operator
    280: !          -div rho grad
    281: !  on an m by n grid with zero Dirichlet boundary conditions. The rho
    282: !  is assumed to be given on the same grid as the finite difference
    283: !  stencil is applied.  For a staggered grid, one would have to change
    284: !  things slightly.

    286:       II = 0
    287:       do 110 j=1,n
    288:          do 100 i=1,m
    289:             if (j .gt. 1) then
    290:                JJ = II - m
    291:                v = -0.5*(rho(II+1) + rho(JJ+1))*hy2
    292:                call MatSetValues(A,one,II,one,JJ,v,INSERT_VALUES,ierr)
    293:             endif
    294:             if (j .lt. n) then
    295:                JJ = II + m
    296:                v = -0.5*(rho(II+1) + rho(JJ+1))*hy2
    297:                call MatSetValues(A,one,II,one,JJ,v,INSERT_VALUES,ierr)
    298:             endif
    299:             if (i .gt. 1) then
    300:                JJ = II - 1
    301:                v = -0.5*(rho(II+1) + rho(JJ+1))*hx2
    302:                call MatSetValues(A,one,II,one,JJ,v,INSERT_VALUES,ierr)
    303:             endif
    304:             if (i .lt. m) then
    305:                JJ = II + 1
    306:                v = -0.5*(rho(II+1) + rho(JJ+1))*hx2
    307:                call MatSetValues(A,one,II,one,JJ,v,INSERT_VALUES,ierr)
    308:             endif
    309:             v = 2*rho(II+1)*(hx2+hy2)
    310:             call MatSetValues(A,one,II,one,II,v,INSERT_VALUES,ierr)
    311:             II = II+1
    312:  100     continue
    313:  110  continue
    314: !
    315: !     Assemble matrix
    316: !
    317:       call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr)
    318:       call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr)

    320: !
    321: !     Set operators. Here the matrix that defines the linear system
    322: !     also serves as the preconditioning matrix. Since all the matrices
    323: !     will have the same nonzero pattern here, we indicate this so the
    324: !     linear solvers can take advantage of this.
    325: !
    326:       call KSPSetOperators(ksp,A,A,SAME_NONZERO_PATTERN,ierr)

    328: !
    329: !     Set linear solver defaults for this problem (optional).
    330: !     - Here we set it to use direct LU factorization for the solution
    331: !
    332:       call KSPGetPC(ksp,pc,ierr)
    333:       call PCSetType(pc,PCLU,ierr)

    335: !
    336: !     Set runtime options, e.g.,
    337: !        -ksp_type <type> -pc_type <type> -ksp_monitor -ksp_rtol <rtol>
    338: !     These options will override those specified above as long as
    339: !     KSPSetFromOptions() is called _after_ any other customization
    340: !     routines.
    341: !
    342: !     Run the program with the option -help to see all the possible
    343: !     linear solver options.
    344: !
    345:       call KSPSetFromOptions(ksp,ierr)

    347: !
    348: !     This allows the PETSc linear solvers to compute the solution
    349: !     directly in the user's array rather than in the PETSc vector.
    350: !
    351: !     This is essentially a hack and not highly recommend unless you
    352: !     are quite comfortable with using PETSc. In general, users should
    353: !     write their entire application using PETSc vectors rather than
    354: !     arrays.
    355: !
    356:       call VecPlaceArray(x,userx,ierr)
    357:       call VecPlaceArray(b,userb,ierr)

    359: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    360: !                      Solve the linear system
    361: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    363:       call KSPSolve(ksp,b,x,ierr)

    365:       call VecResetArray(x,ierr)
    366:       call VecResetArray(b,ierr)

    368:       return
    369:       end

    371: ! ------------------------------------------------------------------------

    373:       subroutine UserFinalizeLinearSolver(userctx,ierr)

    375:       implicit none

    377: #include <finclude/petscsys.h>
    378: #include <finclude/petscvec.h>
    379: #include <finclude/petscmat.h>
    380: #include <finclude/petscksp.h>
    381: #include <finclude/petscpc.h>

    383:       PetscErrorCode ierr
    384:       PetscFortranAddr userctx(*)

    386: !  Local variable declararions

    388:       Vec  x,b
    389:       Mat  A
    390:       KSP ksp
    391: !
    392: !     We are all done and don't need to solve any more linear systems, so
    393: !     we free the work space.  All PETSc objects should be destroyed when
    394: !     they are no longer needed.
    395: !
    396:       x    = userctx(1)
    397:       b    = userctx(2)
    398:       A    = userctx(3)
    399:       ksp = userctx(4)

    401:       call VecDestroy(x,ierr)
    402:       call VecDestroy(b,ierr)
    403:       call MatDestroy(A,ierr)
    404:       call KSPDestroy(ksp,ierr)

    406:       return
    407:       end