ARPACK Eigenvalues with 16-Byte integer indexing - fortran

Question

I have code that works fine to compute eigenvalues in my test case for ARPACK Shamelessly taken from here and adapted to a quick 4x4 matrix. (Comments at the top removed in my sample code for brevity).
Okay, my problem. I have very large matrices, or at least, I will for my actual problems. But, when I make the integers kind 16, ARPACK gives an error. Is there a simple way to convert the ARPACK functions to allow my 16 byte indexing of things? Or, is it possible to alter how it makes the library to allow for this? I made the library with gfortran.
Any insight would be greatly appreciated.
PLEASE NOTE: The code below has been edited (to actually run properly). I've also added 2 subroutines that may be useful for the folks getting started with ARPACK. Please forgive the change in format of the error print statements.
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