Date: 2013-07-02T14:50:35+00:00

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

      1: !
      2: !
      3: !  Description: Uses the Newton method to solve a two-variable system.
      4: !
      5: !/*T
      6: !  Concepts: SNES^basic uniprocessor example
      7: !  Processors: 1
      8: !T*/
      9: !
     10: ! -----------------------------------------------------------------------

     12:       program main
     13:       implicit none

     15: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     16: !                    Include files
     17: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     18: !
     19: !  The following include statements are generally used in SNES Fortran
     20: !  programs:
     21: !     petscsys.h       - base PETSc routines
     22: !     petscvec.h    - vectors
     23: !     petscmat.h    - matrices
     24: !     petscksp.h    - Krylov subspace methods
     25: !     petscpc.h     - preconditioners
     26: !     petscsnes.h   - SNES interface
     27: !  Other include statements may be needed if using additional PETSc
     28: !  routines in a Fortran program, e.g.,
     29: !     petscviewer.h - viewers
     30: !     petscis.h     - index sets
     31: !
     32: #include <finclude/petscsys.h>
     33: #include <finclude/petscvec.h>
     34: #include <finclude/petscmat.h>
     35: #include <finclude/petscksp.h>
     36: #include <finclude/petscpc.h>
     37: #include <finclude/petscsnes.h>
     38: !
     39: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     40: !                   Variable declarations
     41: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     42: !
     43: !  Variables:
     44: !     snes        - nonlinear solver
     45: !     ksp        - linear solver
     46: !     pc          - preconditioner context
     47: !     ksp         - Krylov subspace method context
     48: !     x, r        - solution, residual vectors
     49: !     J           - Jacobian matrix
     50: !     its         - iterations for convergence
     51: !
     52:       SNES     snes
     53:       PC       pc
     54:       KSP      ksp
     55:       Vec      x,r
     56:       Mat      J
     57:       SNESLineSearch linesearch
     58:       PetscErrorCode  ierr
     59:       PetscInt its,i2,i20
     60:       PetscMPIInt size,rank
     61:       PetscScalar   pfive
     62:       double precision   tol
     63:       PetscBool   setls

     65: !  Note: Any user-defined Fortran routines (such as FormJacobian)
     66: !  MUST be declared as external.

     68:       external FormFunction, FormJacobian, MyLineSearch

     70: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     71: !                   Macro definitions
     72: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     73: !
     74: !  Macros to make clearer the process of setting values in vectors and
     75: !  getting values from vectors.  These vectors are used in the routines
     76: !  FormFunction() and FormJacobian().
     77: !   - The element lx_a(ib) is element ib in the vector x
     78: !
     79: #define lx_a(ib) lx_v(lx_i + (ib))
     80: #define lf_a(ib) lf_v(lf_i + (ib))
     81: !
     82: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     83: !                 Beginning of program
     84: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     86:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
     87:       call MPI_Comm_size(PETSC_COMM_WORLD,size,ierr)
     88:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr)
     89:       if (size .ne. 1) then
     90:          if (rank .eq. 0) then
     91:             write(6,*) 'This is a uniprocessor example only!'
     92:          endif
     93:          SETERRQ(PETSC_COMM_SELF,1,' ',ierr)
     94:       endif

     96:       i2  = 2
     97:       i20 = 20
     98: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -
     99: !  Create nonlinear solver context
    100: ! - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - -

    102:       call SNESCreate(PETSC_COMM_WORLD,snes,ierr)

    104: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    105: !  Create matrix and vector data structures; set corresponding routines
    106: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    108: !  Create vectors for solution and nonlinear function

    110:       call VecCreateSeq(PETSC_COMM_SELF,i2,x,ierr)
    111:       call VecDuplicate(x,r,ierr)

    113: !  Create Jacobian matrix data structure

    115:       call MatCreate(PETSC_COMM_SELF,J,ierr)
    116:       call MatSetSizes(J,PETSC_DECIDE,PETSC_DECIDE,i2,i2,ierr)
    117:       call MatSetFromOptions(J,ierr)
    118:       call MatSetUp(J,ierr)

    120: !  Set function evaluation routine and vector

    122:       call SNESSetFunction(snes,r,FormFunction,PETSC_NULL_OBJECT,ierr)

    124: !  Set Jacobian matrix data structure and Jacobian evaluation routine

    126:       call SNESSetJacobian(snes,J,J,FormJacobian,PETSC_NULL_OBJECT,     &
    127:      &     ierr)

    129: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    130: !  Customize nonlinear solver; set runtime options
    131: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    133: !  Set linear solver defaults for this problem. By extracting the
    134: !  KSP, KSP, and PC contexts from the SNES context, we can then
    135: !  directly call any KSP, KSP, and PC routines to set various options.

    137:       call SNESGetKSP(snes,ksp,ierr)
    138:       call KSPGetPC(ksp,pc,ierr)
    139:       call PCSetType(pc,PCNONE,ierr)
    140:       tol = 1.e-4
    141:       call KSPSetTolerances(ksp,tol,PETSC_DEFAULT_DOUBLE_PRECISION,     &
    142:      &                      PETSC_DEFAULT_DOUBLE_PRECISION,i20,ierr)

    144: !  Set SNES/KSP/KSP/PC runtime options, e.g.,
    145: !      -snes_view -snes_monitor -ksp_type <ksp> -pc_type <pc>
    146: !  These options will override those specified above as long as
    147: !  SNESSetFromOptions() is called _after_ any other customization
    148: !  routines.

    151:       call SNESSetFromOptions(snes,ierr)

    153:       call PetscOptionsHasName(PETSC_NULL_CHARACTER,'-setls',setls,ierr)

    155:       if (setls) then
    156:         call SNESGetLineSearch(snes, linesearch, ierr)
    157:         call SNESLineSearchSetType(linesearch, "shell", ierr)
    158:         call SNESLineSearchShellSetUserFunc(linesearch, MyLineSearch,   &
    159:      &PETSC_NULL_OBJECT, ierr)
    160:       endif

    162: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    163: !  Evaluate initial guess; then solve nonlinear system
    164: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    166: !  Note: The user should initialize the vector, x, with the initial guess
    167: !  for the nonlinear solver prior to calling SNESSolve().  In particular,
    168: !  to employ an initial guess of zero, the user should explicitly set
    169: !  this vector to zero by calling VecSet().

    171:       pfive = 0.5
    172:       call VecSet(x,pfive,ierr)
    173:       call SNESSolve(snes,PETSC_NULL_OBJECT,x,ierr)
    174:       call SNESGetIterationNumber(snes,its,ierr);
    175:       if (rank .eq. 0) then
    176:          write(6,100) its
    177:       endif
    178:   100 format('Number of SNES iterations = ',i5)

    180: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    181: !  Free work space.  All PETSc objects should be destroyed when they
    182: !  are no longer needed.
    183: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    185:       call VecDestroy(x,ierr)
    186:       call VecDestroy(r,ierr)
    187:       call MatDestroy(J,ierr)
    188:       call SNESDestroy(snes,ierr)
    189:       call PetscFinalize(ierr)
    190:       end
    191: !
    192: ! ------------------------------------------------------------------------
    193: !
    194: !  FormFunction - Evaluates nonlinear function, F(x).
    195: !
    196: !  Input Parameters:
    197: !  snes - the SNES context
    198: !  x - input vector
    199: !  dummy - optional user-defined context (not used here)
    200: !
    201: !  Output Parameter:
    202: !  f - function vector
    203: !
    204:       subroutine FormFunction(snes,x,f,dummy,ierr)
    205:       implicit none

    207: #include <finclude/petscsys.h>
    208: #include <finclude/petscvec.h>
    209: #include <finclude/petscsnes.h>

    211:       SNES     snes
    212:       Vec      x,f
    213:       PetscErrorCode ierr
    214:       integer dummy(*)

    216: !  Declarations for use with local arrays

    218:       PetscScalar  lx_v(1),lf_v(1)
    219:       PetscOffset  lx_i,lf_i

    221: !  Get pointers to vector data.
    222: !    - For default PETSc vectors, VecGetArray() returns a pointer to
    223: !      the data array.  Otherwise, the routine is implementation dependent.
    224: !    - You MUST call VecRestoreArray() when you no longer need access to
    225: !      the array.
    226: !    - Note that the Fortran interface to VecGetArray() differs from the
    227: !      C version.  See the Fortran chapter of the users manual for details.

    229:       call VecGetArray(x,lx_v,lx_i,ierr)
    230:       call VecGetArray(f,lf_v,lf_i,ierr)

    232: !  Compute function

    234:       lf_a(1) = lx_a(1)*lx_a(1)                                         &
    235:      &          + lx_a(1)*lx_a(2) - 3.0
    236:       lf_a(2) = lx_a(1)*lx_a(2)                                         &
    237:      &          + lx_a(2)*lx_a(2) - 6.0

    239: !  Restore vectors

    241:       call VecRestoreArray(x,lx_v,lx_i,ierr)
    242:       call VecRestoreArray(f,lf_v,lf_i,ierr)

    244:       return
    245:       end

    247: ! ---------------------------------------------------------------------
    248: !
    249: !  FormJacobian - Evaluates Jacobian matrix.
    250: !
    251: !  Input Parameters:
    252: !  snes - the SNES context
    253: !  x - input vector
    254: !  dummy - optional user-defined context (not used here)
    255: !
    256: !  Output Parameters:
    257: !  A - Jacobian matrix
    258: !  B - optionally different preconditioning matrix
    259: !  flag - flag indicating matrix structure
    260: !
    261:       subroutine FormJacobian(snes,X,jac,B,flag,dummy,ierr)
    262:       implicit none

    264: #include <finclude/petscsys.h>
    265: #include <finclude/petscvec.h>
    266: #include <finclude/petscmat.h>
    267: #include <finclude/petscpc.h>
    268: #include <finclude/petscsnes.h>

    270:       SNES         snes
    271:       Vec          X
    272:       Mat          jac,B
    273:       MatStructure flag
    274:       PetscScalar  A(4)
    275:       PetscErrorCode ierr
    276:       PetscInt idx(2),i2
    277:       integer dummy(*)

    279: !  Declarations for use with local arrays

    281:       PetscScalar lx_v(1)
    282:       PetscOffset lx_i

    284: !  Get pointer to vector data

    286:       i2 = 2
    287:       call VecGetArray(x,lx_v,lx_i,ierr)

    289: !  Compute Jacobian entries and insert into matrix.
    290: !   - Since this is such a small problem, we set all entries for
    291: !     the matrix at once.
    292: !   - Note that MatSetValues() uses 0-based row and column numbers
    293: !     in Fortran as well as in C (as set here in the array idx).

    295:       idx(1) = 0
    296:       idx(2) = 1
    297:       A(1) = 2.0*lx_a(1) + lx_a(2)
    298:       A(2) = lx_a(1)
    299:       A(3) = lx_a(2)
    300:       A(4) = lx_a(1) + 2.0*lx_a(2)
    301:       call MatSetValues(jac,i2,idx,i2,idx,A,INSERT_VALUES,ierr)
    302:       flag = SAME_NONZERO_PATTERN

    304: !  Restore vector

    306:       call VecRestoreArray(x,lx_v,lx_i,ierr)

    308: !  Assemble matrix

    310:       call MatAssemblyBegin(jac,MAT_FINAL_ASSEMBLY,ierr)
    311:       call MatAssemblyEnd(jac,MAT_FINAL_ASSEMBLY,ierr)

    313:       return
    314:       end

    317:       subroutine MyLineSearch(linesearch, lctx, ierr)
    318: #include <finclude/petscsys.h>
    319: #include <finclude/petscvec.h>
    320: #include <finclude/petscmat.h>
    321: #include <finclude/petscksp.h>
    322: #include <finclude/petscpc.h>
    323: #include <finclude/petscsnes.h>

    325:       SNES              snes
    326:       integer           lctx
    327:       Vec               x, f,g, y, w
    328:       PetscReal         ynorm,gnorm,xnorm
    329:       PetscBool         flag
    330:       PetscErrorCode    ierr

    332:       PetscScalar       mone

    334:       mone = -1.0d0
    335:       call SNESLineSearchGetSNES(linesearch, snes, ierr)
    336:       call SNESLineSearchGetVecs(linesearch, x, f, y, w, g, ierr)
    337:       call VecNorm(y,NORM_2,ynorm,ierr)
    338:       call VecAXPY(x,mone,y,ierr)
    339:       call SNESComputeFunction(snes,x,f,ierr)
    340:       call VecNorm(f,NORM_2,gnorm,ierr)
    341:       call VecNorm(x,NORM_2,xnorm,ierr)
    342:       call VecNorm(y,NORM_2,ynorm,ierr)
    343:       call SNESLineSearchSetNorms(linesearch, xnorm, gnorm, ynorm,      &
    344:      & ierr)
    345:       flag = PETSC_FALSE
    346:       return
    347:       end