具有16字节整数索引的ARPACK特征值

时间:2018-12-08 23:10:14

标签: fortran gfortran eigenvalue arpack

我有一段代码可以很好地计算出我的测试用例的特征值,该测试用例从here中无耻地获取了ARPACK,并适合于快速4x4矩阵。 (为简便起见,在我的示例代码中删除了顶部的注释)。

好的,我的问题。我的矩阵很大,或者至少我会解决我的实际问题。但是,当我将整数设为16时,ARPACK给出了一个错误。有没有简单的方法可以转换ARPACK函数以允许我对16字节的东西进行索引?或者,是否有可能改变它使库允许的方式?我用gfortran制作了库。

任何见识将不胜感激。

请注意:以下代码已被编辑(以实际运行)。我还添加了2个子例程,这些子例程可能对ARPACK入门的人们有用。请原谅错误打印语句格式的更改。

program main

implicit none

integer, parameter :: maxn = 256
integer, parameter :: maxnev = 10
integer, parameter :: maxncv = 25
integer, parameter :: ldv = maxn

intrinsic abs
real :: ax(maxn)
character :: bmat  
real :: d(maxncv,2)
integer :: ido, ierr, info
integer :: iparam(11), ipntr(11)
integer ishfts, j, lworkl, maxitr, mode1, n, nconv, ncv, nev, nx, resid(maxn)
logical rvec
logical select(maxncv)
real sigma, tol, v(ldv,maxncv)
real, external :: snrm2
character ( len = 2 ) which
real workl(maxncv*(maxncv+8))
real workd(3*maxn)
real, parameter :: zero = 0.0E+00
!
!  Set dimensions for this problem.
!
  nx = 4
  n = nx 
!
!  Specifications for ARPACK usage are set below:
!
                        !
!  2) NCV = 20 sets the length of the Arnoldi factorization.
!  3) This is a standard problem (indicated by bmat  = 'I')
!  4) Ask for the NEV eigenvalues of largest magnitude
!     (indicated by which = 'LM')
!
!  See documentation in SSAUPD for the other options SM, LA, SA, LI, SI.
!
!  NEV and NCV must satisfy the following conditions:
!
!    NEV <= MAXNEV
!    NEV + 1 <= NCV <= MAXNCV
!
  nev = 3 ! Asks for 4 eigenvalues to be computed.
  ncv = min(25,n)
  bmat = 'I'
  which = 'LM'

  if ( maxn < n ) then
    PRINT *, ' '
    PRINT *, 'SSSIMP - Fatal error!'
    PRINT *, '  N is greater than MAXN '
    stop
  else if ( maxnev < nev ) then
    PRINT *, ' '
    PRINT *, 'SSSIMP - Fatal error!'
    PRINT *, '  NEV is greater than MAXNEV '
    stop
  else if ( maxncv < ncv ) then
    PRINT *, ' '
    PRINT *, 'SSSIMP - Fatal error!'
    PRINT *, '  NCV is greater than MAXNCV '
    stop
  end if
!
!  Specification of stopping rules and initial
!  conditions before calling SSAUPD
!
!  TOL determines the stopping criterion.  Expect
!    abs(lambdaC - lambdaT) < TOL*abs(lambdaC)
!  computed   true
!  If TOL <= 0, then TOL <- macheps (machine precision) is used.
!
!  IDO is the REVERSE COMMUNICATION parameter. Initially be set to 0     before the first call to SSAUPD.
!
!  INFO on entry specifies starting vector information and on return     indicates error codes
!  Initially, setting INFO=0 indicates that a random starting vector is     requested to 
!  start the ARNOLDI iteration.  
!
!  The work array WORKL is used in SSAUPD as workspace.  Its dimension
!  LWORKL is set as illustrated below. 
!
  lworkl = ncv * ( ncv + 8 )
  tol = zero
  info = 0
  ido = 0
!
!  Specification of Algorithm Mode:
!
!  This program uses the exact shift strategy
!  (indicated by setting PARAM(1) = 1).
!
!  IPARAM(3) specifies the maximum number of Arnoldi iterations allowed.  
!
!  Mode 1 of SSAUPD is used (IPARAM(7) = 1). 
!
!  All these options can be changed by the user.  For details see the
!  documentation in SSAUPD.
!
  ishfts = 0
  maxitr = 300
  mode1 = 1

  iparam(1) = ishfts
  iparam(3) = maxitr
  iparam(7) = mode1
    !
    !  MAIN LOOP (Reverse communication loop)
    !
!  Repeatedly call SSAUPD and take actions indicated by parameter 
!  IDO until convergence is indicated or MAXITR is exceeded.
!
  do
    call ssaupd ( ido, bmat, n, which, nev, tol, resid, &
      ncv, v, ldv, iparam, ipntr, workd, workl, &
  lworkl, info )
    if ( ido /= -1 .and. ido /= 1 ) then
      exit
    end if
    call av ( nx, workd(ipntr(1)), workd(ipntr(2)) )

   end do
!
!  Either we have convergence or there is an error.
!

CALL dsaupderrormessage(info)

  if ( info < 0 ) then
!  Error message. Check the documentation in SSAUPD.
    PRINT *, 'SSSIMP - Fatal error!'
    PRINT *, '  Error with SSAUPD, INFO = ', info
    PRINT *, '  Check documentation in SSAUPD.'
  else
!
!  No fatal errors occurred.
!  Post-Process using SSEUPD.
!
!  Computed eigenvalues may be extracted.
!
!  Eigenvectors may be also computed now if
!  desired.  (indicated by rvec = .true.)
!
!  The routine SSEUPD now called to do this
!  post processing (Other modes may require
!  more complicated post processing than mode1.)
!
    rvec = .true.

    call sseupd ( rvec, 'All', select, d, v, ldv, sigma, &
  bmat, n, which, nev, tol, resid, ncv, v, ldv, &
  iparam, ipntr, workd, workl, lworkl, ierr )
!
!  Eigenvalues are returned in the first column of the two dimensional 
!  array D and the corresponding eigenvectors are returned in the first 
!  NCONV (=IPARAM(5)) columns of the two dimensional array V if     requested.
!
!  Otherwise, an orthogonal basis for the invariant subspace corresponding 
!  to the eigenvalues in D is returned in V.
!

CALL dseupderrormessage(ierr)

    if ( ierr /= 0 ) then
      PRINT *, 'SSSIMP - Fatal error!'
      PRINT *, '  Error with SSEUPD, IERR = ', ierr
      PRINT *, '  Check the documentation of SSEUPD.'
!  Compute the residual norm||  A*x - lambda*x || 
!  for the NCONV accurately computed eigenvalues and eigenvectors.  
!  (iparam(5) indicates how many are accurate to the requested tolerance)
!
    else
      nconv =  iparam(5)
      do j = 1, nconv
        call av ( nx, v(1,j), ax )
        call saxpy ( n, -d(j,1), v(1,j), 1, ax, 1 )
        d(j,2) = snrm2 ( n, ax, 1)
        d(j,2) = d(j,2) / abs ( d(j,1) )
      end do
!
!  Display computed residuals.
!
      call smout ( 6, nconv, 2, d, maxncv, -6, &
        'Ritz values and relative residuals' )
    ! 6: Output to screen Write(6, #internalnumber)
    ! nconv: number of rows in the matrix d
    ! 2: Number of columns in matrix d
    ! maxncv: Leading dimension of the matrix data
    ! -6: print the matrix d with iabs(-6) decimal digits per number
    ! Use formatting indexed by -6 to print A
    end if
!
!  Print additional convergence information.
!
    if ( info == 1) then
      PRINT *, ' '
          PRINT *, '  Maximum number of iterations reached.'
    else if ( info == 3) then
      PRINT *, ' '
      PRINT *, '  No shifts could be applied during implicit' &
        // ' Arnoldi update, try increasing NCV.'
    end if

    PRINT *, ' '
    PRINT *, 'SSSIMP:'
    PRINT *, '====== '
    PRINT *, ' '
    PRINT *, '  Size of the matrix is ', n
    PRINT *, '  The number of Ritz values requested is ', nev
    PRINT *, &
      '  The number of Arnoldi vectors generated (NCV) is ', ncv
    PRINT *, '  What portion of the spectrum: ' // which
    PRINT *, &
      '  The number of converged Ritz values is ', nconv
    PRINT *, &
      '  The number of Implicit Arnoldi update iterations taken is ',     iparam(3)
    PRINT *, '  The number of OP*x is ', iparam(9)
    PRINT *, '  The convergence criterion is ', tol

  end if

  PRINT *, ' '
  PRINT *, 'SSSIMP:'
  PRINT *, '  Normal end of execution.'

  ! write ( *, '(a)' ) ' '
  ! call timestamp ( )

  stop
end

!*******************************************************************************
!
!! Av computes w <- A * V where A is the matri used is
!      | 1 1 1 1 |
!      | 1 0 1 1 |
!      | 1 1 0 1 |
!      | 1 1 1 0 |     
!
!  Parameters:
!    Input, integer NX, the length of the vectors.
!    Input, real V(NX), the vector to be operated on by A.
!    Output, real W(NX), the result of A*V.
!
    !*******************************************************************************

subroutine av ( nx, v, w )
  implicit none

  integer nx
  integer :: j, i, lo, n2
  real, parameter :: one = 1.0E+00
  real :: A(4,4)
  real :: h2, temp, v(nx), w(nx)
A(:,:) = one
A(2,2) = 0.0E+00
A(3,3) = 0.0E+00
A(4,4) = 0.0E+00

  do j= 1,4
  temp = 0.0E+00
  do i= 1,4 
    temp = temp + v(i)* A(i,j)
  end do
  w(j) = temp
  end do 

  return
end subroutine


SUBROUTINE dsaupderrormessage(dsaupdinfo)
implicit none
integer :: dsaupdinfo

if (dsaupdinfo .EQ. 0) THEN 
   PRINT *, 'Normal Exit in dsaupd: info = 0.'
elseif (dsaupdinfo .EQ. -1) THEN 
   PRINT *, 'Error in dsaupd: info = -1.'
   PRINT *, 'N must be positive.'
elseif (dsaupdinfo .EQ. -2) THEN 
   PRINT *, 'Error in dsaupd: info = -2.'
   PRINT *, 'NEV must be positive.'
elseif (dsaupdinfo .EQ. -3) THEN 
   PRINT *, 'Error in dsaupd: info = -3.'
   PRINT *, 'NCV must be between NEV and N. '
elseif (dsaupdinfo .EQ. -4) THEN 
   PRINT *, 'Error in dsaupd: info = -4'
   PRINT *, 'The maximum number of Arnoldi update iterations allowed must be greater than zero.'
elseif (dsaupdinfo .EQ. -5) THEN 
   PRINT *, 'Error in dsaupd: info = -5'
   PRINT *, 'WHICH must be LM, SM, LA, SA, or BE. info = -5.'
elseif (dsaupdinfo .EQ. -6) THEN 
   PRINT *, 'Error in dsauupd: info = -6. '
   PRINT *, 'BMAT must be I or G. '
elseif (dsaupdinfo .EQ. -7) THEN  
   PRINT *, 'Error in dsaupd: info = -7.'
   PRINT *, 'Length of private work work WORKL array isnt sufficient.'
elseif (dsaupdinfo .EQ. -8) THEN 
   PRINT *, 'Error in dsaupd: info = -8.'
   PRINT *, 'Error in return from trid. eval calc. Error info from LAPACK dsteqr. info =-8'
elseif (dsaupdinfo .EQ. -9) THEN 
   PRINT *, 'Error in dsaupd: info = -9.'
   PRINT *, 'Starting vector is 0.'
elseif (dsaupdinfo .EQ. -10) THEN 
   PRINT *, 'Error in dsaupd: info = -10. '
   PRINT *, 'IPARAM(7) must be 1,2,3,4, or 5.'
elseif (dsaupdinfo .EQ. -11) THEN 
   PRINT *, 'Error in dsaupd: info = -11.' 
   PRINT *, 'IPARAM(7)=1 and BMAT=G are incompatible.'
elseif (dsaupdinfo .EQ. -12) THEN 
   PRINT *, 'Error in dsaupd: info = -12'
   PRINT *, 'NEV and WHICH=BE are incompatible.'
elseif (dsaupdinfo .EQ. -13) THEN 
   PRINT *, 'Error in dsaupd: info = -13.'
   PRINT *, 'DSAUPD did find any eigenvalues to sufficient accuracy.'
elseif (dsaupdinfo .EQ. -9999) THEN 
   PRINT *, 'Error in dsaupd: info = -9999'
   PRINT *, 'Could not build an Arnoldi factorization. IPARAM(5) returns the size of the current Arnoldi factorization. &
   The user is advised to check that enough workspace and array storage     has been allocated. '
elseif (dsaupdinfo .EQ. 1) THEN 
   PRINT *, 'Error in dsaupd: info = 1'
   PRINT *, 'Maximum number of iterations taken. All possible eigenvalues of OP has been found. '
   PRINT *, 'IPARAM(5) returns the number of wanted converged Ritz values.' 
elseif (dsaupdinfo .EQ. 3) THEN 
   PRINT *, 'Error in dsaupd: info =3'
   PRINT *, 'No shifts could be applied during a cycle of the Implicitly restarted Arnoldi iteration.'
   PRINT *, 'One possibility is to increase the size of NCV relative to NEV.'
else 
   PRINT *, 'Unknown error.  info =', dsaupdinfo
END IF    
end subroutine





SUBROUTINE dseupderrormessage(dseupdinfo)
implicit none
integer :: dseupdinfo

if (dseupdinfo .EQ. 0) THEN 
   PRINT *, 'Normal Exit in dseupd: info = 0.'
elseif (dseupdinfo .EQ. -1) THEN 
   PRINT *, 'Error in deseupd: N must be positive. info =-1.'
elseif (dseupdinfo .EQ. -2) THEN 
   PRINT *, 'Error in deseupd: NEV must be positive. info = -2.'
elseif (dseupdinfo .EQ. -3) THEN 
   PRINT *, 'Error in deseupd: NCV must be between NEV and N. info = -3.'
elseif (dseupdinfo .EQ. -5) THEN 
   PRINT *, 'Error in deseupd: WHICH must be LM, SM, LA, SA, or BE info = -5.'
elseif (dseupdinfo .EQ. -6) THEN 
   PRINT *, 'Error in deseupd: BMAT must be I or G. info = -6.'
elseif (dseupdinfo .EQ. -7) THEN  
   PRINT *, 'Error in deseupd: N Length of private work work WORKL array isnt sufficient. info = -7.'
elseif (dseupdinfo .EQ. -8) THEN 
   PRINT *, 'Error in deseupd: Error in return from trid. eval calc. Error info from LAPACK dsteqr. info = -8.'
elseif (dseupdinfo .EQ. -9) THEN 
   PRINT *, 'Error in deseupd: Starting vector is 0. info = -9.'
elseif (dseupdinfo .EQ. -10) THEN 
   PRINT *, 'Error in deseupd: IPARAM(7) must be 1,2,3,4, or 5. info = -10.'
elseif (dseupdinfo .EQ. -11) THEN 
   PRINT *, 'Error in deseupd: IPARAM(7)=1 and BMAT=G are incompatible. info = -11.'
elseif (dseupdinfo .EQ. -12) THEN 
   PRINT *, 'Error in deseupd: NEV and WHICH=BE are incompatible. info = -12.'
elseif (dseupdinfo .EQ. -14) THEN 
   PRINT *, 'Error in deseupd: DSAUPD did find any eigenvalues to sufficient accuracy. info = -14.'
elseif (dseupdinfo .EQ. -15) THEN 
   PRINT *, 'Error in deseupd: HOWMANY must one A or S if RVEC=1. info = -15.'
elseif (dseupdinfo .EQ. -16) THEN 
   PRINT *, 'Error in deseupd: HOWMANY =S not yet implemented. info = -16.'
elseif (dseupdinfo .EQ. -17) THEN 
   PRINT *, 'Error in deseupd: info =-17.' 
   PRINT *, 'DSEUPD got a different count of the number of converged Ritz values than DSAUPD.'
   PRINT *, 'User likely made an error in passing data DSAUPD -> DSEUPD. info = -17.'
else 
   PRINT *, 'Unknown error.  info =', dseupdinfo    
END IF    
end subroutine

0 个答案:

没有答案