Actual source code: ex1f90.F90
slepc-3.10.1 2018-10-23
Report Typos and Errors

      1: !
      2: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3: !  SLEPc - Scalable Library for Eigenvalue Problem Computations
      4: !  Copyright (c) 2002-2018, Universitat Politecnica de Valencia, Spain
      5: !
      6: !  This file is part of SLEPc.
      7: !  SLEPc is distributed under a 2-clause BSD license (see LICENSE).
      8: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      9: !
     10: !  Program usage: mpiexec -n <np> ./ex1f90 [-help] [-n <n>] [all SLEPc options]
     11: !
     12: !  Description: Simple example that solves an eigensystem with the EPS object.
     13: !  The standard symmetric eigenvalue problem to be solved corresponds to the
     14: !  Laplacian operator in 1 dimension.
     15: !
     16: !  The command line options are:
     17: !    -n <n>, where <n> = number of grid points = matrix size
     18: !
     19: ! ----------------------------------------------------------------------
     20: !
     21:       program main
     22: #include <slepc/finclude/slepceps.h>
     23:       use slepceps
     24:       implicit none

     26: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     27: !     Declarations
     28: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     29: !
     30: !  Variables:
     31: !     A      operator matrix
     32: !     eps    eigenproblem solver context

     34:       Mat            A
     35:       EPS            eps
     36:       EPSType        tname
     37:       PetscInt       n, i, Istart, Iend, one, two, three
     38:       PetscInt       nev
     39:       PetscInt       row(1), col(3)
     40:       PetscMPIInt    rank
     41:       PetscErrorCode ierr
     42:       PetscBool      flg, terse
     43:       PetscScalar    value(3)

     45: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     46: !     Beginning of program
     47: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     49:       one = 1
     50:       two = 2
     51:       three = 3
     52:       call SlepcInitialize(PETSC_NULL_CHARACTER,ierr)
     53:       if (ierr .ne. 0) then
     54:         print*,'SlepcInitialize failed'
     55:         stop
     56:       endif
     57:       call MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr);CHKERRA(ierr)
     58:       n = 30
     59:       call PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,ierr);CHKERRA(ierr)

     61:       if (rank .eq. 0) then
     62:         write(*,100) n
     63:       endif
     64:  100  format (/'1-D Laplacian Eigenproblem, n =',I4,' (Fortran)')

     66: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     67: !     Compute the operator matrix that defines the eigensystem, Ax=kx
     68: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

     70:       call MatCreate(PETSC_COMM_WORLD,A,ierr);CHKERRA(ierr)
     71:       call MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr);CHKERRA(ierr)
     72:       call MatSetFromOptions(A,ierr);CHKERRA(ierr)
     73:       call MatSetUp(A,ierr);CHKERRA(ierr)

     75:       call MatGetOwnershipRange(A,Istart,Iend,ierr);CHKERRA(ierr)
     76:       if (Istart .eq. 0) then
     77:         row(1) = 0
     78:         col(1) = 0
     79:         col(2) = 1
     80:         value(1) =  2.0
     81:         value(2) = -1.0
     82:         call MatSetValues(A,one,row,two,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
     83:         Istart = Istart+1
     84:       endif
     85:       if (Iend .eq. n) then
     86:         row(1) = n-1
     87:         col(1) = n-2
     88:         col(2) = n-1
     89:         value(1) = -1.0
     90:         value(2) =  2.0
     91:         call MatSetValues(A,one,row,two,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
     92:         Iend = Iend-1
     93:       endif
     94:       value(1) = -1.0
     95:       value(2) =  2.0
     96:       value(3) = -1.0
     97:       do i=Istart,Iend-1
     98:         row(1) = i
     99:         col(1) = i-1
    100:         col(2) = i
    101:         col(3) = i+1
    102:         call MatSetValues(A,one,row,three,col,value,INSERT_VALUES,ierr);CHKERRA(ierr)
    103:       enddo

    105:       call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)
    106:       call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr);CHKERRA(ierr)

    108: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    109: !     Create the eigensolver and display info
    110: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    112: !     ** Create eigensolver context
    113:       call EPSCreate(PETSC_COMM_WORLD,eps,ierr);CHKERRA(ierr)

    115: !     ** Set operators. In this case, it is a standard eigenvalue problem
    116:       call EPSSetOperators(eps,A,PETSC_NULL_MAT,ierr);CHKERRA(ierr)
    117:       call EPSSetProblemType(eps,EPS_HEP,ierr);CHKERRA(ierr)

    119: !     ** Set solver parameters at runtime
    120:       call EPSSetFromOptions(eps,ierr);CHKERRA(ierr)

    122: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    123: !     Solve the eigensystem
    124: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    126:       call EPSSolve(eps,ierr);CHKERRA(ierr)

    128: !     ** Optional: Get some information from the solver and display it
    129:       call EPSGetType(eps,tname,ierr);CHKERRA(ierr)
    130:       if (rank .eq. 0) then
    131:         write(*,120) tname
    132:       endif
    133:  120  format (' Solution method: ',A)
    134:       call EPSGetDimensions(eps,nev,PETSC_NULL_INTEGER,PETSC_NULL_INTEGER,ierr);CHKERRA(ierr)
    135:       if (rank .eq. 0) then
    136:         write(*,130) nev
    137:       endif
    138:  130  format (' Number of requested eigenvalues:',I4)

    140: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    141: !     Display solution and clean up
    142: ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

    144: !     ** show detailed info unless -terse option is given by user
    145:       call PetscOptionsHasName(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-terse',terse,ierr);CHKERRA(ierr)
    146:       if (terse) then
    147:         call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_NULL_VIEWER,ierr);CHKERRA(ierr)
    148:       else
    149:         call PetscViewerPushFormat(PETSC_VIEWER_STDOUT_WORLD,PETSC_VIEWER_ASCII_INFO_DETAIL,ierr);CHKERRA(ierr)
    150:         call EPSReasonView(eps,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
    151:         call EPSErrorView(eps,EPS_ERROR_RELATIVE,PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
    152:         call PetscViewerPopFormat(PETSC_VIEWER_STDOUT_WORLD,ierr);CHKERRA(ierr)
    153:       endif
    154:       call EPSDestroy(eps,ierr);CHKERRA(ierr)
    155:       call MatDestroy(A,ierr);CHKERRA(ierr)

    157:       call SlepcFinalize(ierr)
    158:       end

    160: !/*TEST
    161: !
    162: !   test:
    163: !      suffix: 1
    164: !      args: -eps_nev 4 -terse
    165: !
    166: !TEST*/