Date: 2024-04-26T10:22:04+00:00

Actual source code: ex1f.F90
slepc-3.21.1 2024-04-26
Report Typos and Errors

      1: !
      2: !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      3: !  SLEPc - Scalable Library for Eigenvalue Problem Computations
      4: !  Copyright (c) 2002-, 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> ./ex1f [-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    val(3)

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

     49:       one = 1
     50:       two = 2
     51:       three = 3
     52:       PetscCallA(SlepcInitialize(PETSC_NULL_CHARACTER,"ex1f test"//c_new_line,ierr))
     53:       if (ierr .ne. 0) then
     54:         print*,'SlepcInitialize failed'
     55:         stop
     56:       endif
     57:       PetscCallMPIA(MPI_Comm_rank(PETSC_COMM_WORLD,rank,ierr))
     58:       n = 30
     59:       PetscCallA(PetscOptionsGetInt(PETSC_NULL_OPTIONS,PETSC_NULL_CHARACTER,'-n',n,flg,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:       PetscCallA(MatCreate(PETSC_COMM_WORLD,A,ierr))
     71:       PetscCallA(MatSetSizes(A,PETSC_DECIDE,PETSC_DECIDE,n,n,ierr))
     72:       PetscCallA(MatSetFromOptions(A,ierr))

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

    104:       PetscCallA(MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,ierr))
    105:       PetscCallA(MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,ierr))

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

    111: !     ** Create eigensolver context
    112:       PetscCallA(EPSCreate(PETSC_COMM_WORLD,eps,ierr))

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

    118: !     ** Set solver parameters at runtime
    119:       PetscCallA(EPSSetFromOptions(eps,ierr))

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

    125:       PetscCallA(EPSSolve(eps,ierr))

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

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

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

    156:       PetscCallA(SlepcFinalize(ierr))
    157:       end

    159: !/*TEST
    160: !
    161: !   build:
    162: !      requires: defined(PETSC_USING_F2003) defined(PETSC_USING_F90FREEFORM)
    163: !
    164: !   test:
    165: !      args: -eps_nev 4 -terse
    166: !      filter: sed -e "s/3.83791/3.83792/"
    167: !
    168: !TEST*/