153 lines
5.6 KiB
Plaintext
153 lines
5.6 KiB
Plaintext
c-----------------------------------------------------------------------
|
|
c
|
|
c\Example-1
|
|
c ... Suppose want to solve A*x = lambda*x in regular mode
|
|
c ... so OP = A and B = I.
|
|
c ... Assume "call matvecA(n,x,y)" computes y = A*x
|
|
c ... Assume exact shifts are used
|
|
c ...
|
|
c ido = 0
|
|
c iparam(7) = 1
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
|
|
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
|
|
c if (ido .eq. -1 .or. ido .eq. 1) then
|
|
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c go to 10
|
|
c end if
|
|
c %------------------------------%
|
|
c | End of Reverse communication |
|
|
c %------------------------------%
|
|
c
|
|
c ... call _neupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
|
|
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
|
|
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
|
|
c & lworkl, rwork, info )
|
|
c stop
|
|
c end
|
|
c
|
|
c\Example-2
|
|
c ... Suppose want to solve A*x = lambda*x in shift-invert mode
|
|
c ... so OP = inv[A - sigma*I] and B = I
|
|
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*I]*x = rhs
|
|
c ... Assume exact shifts are used
|
|
c ...
|
|
c ido = 0
|
|
c iaparam(7) = 3
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _naupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv,
|
|
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
|
|
c if (ido .eq. -1 .or. ido .eq. 1) then
|
|
c call solve (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c go to 10
|
|
c end if
|
|
c %------------------------------%
|
|
c | End of Reverse communication |
|
|
c %------------------------------%
|
|
c
|
|
c ... call _neupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
|
|
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
|
|
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
|
|
c & lworkl, rwork, info )
|
|
c stop
|
|
c end
|
|
c
|
|
c\Example-3
|
|
c ... Suppose want to solve A*x = lambda*M*x in regular mode
|
|
c ... so OP = inv[M]*A and B = M.
|
|
c ... Assume "call matvecM(n,x,y)" computes y = M*x
|
|
c ... Assume "call matvecA(n,x,y)" computes y = A*x
|
|
c ... Assume "call solveM(n,rhs,x)" solves M*x = rhs
|
|
c ... Assume user will supplied shifts
|
|
c ...
|
|
c ido = 0
|
|
c iparam(7) = 2
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
|
|
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
|
|
c if (ido .eq. -1 .or. ido .eq. 1) then
|
|
c call matvecA (n, workd(ipntr(1)), temp_array)
|
|
c call solveM (n, temp_array, workd(ipntr(2)))
|
|
c go to 10
|
|
c else if (ido .eq. 2) then
|
|
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c go to 10
|
|
c
|
|
c ... delete this last conditional if want to use exact shifts
|
|
c else if (ido .eq. 3) then
|
|
c ... compute shifts and put in workl starting from the position
|
|
c ... pointed by ipntr(14).
|
|
c np = iparam(8)
|
|
c call scopy (np, shifts, 1, workl(ipntr(14), 1)
|
|
c go to 10
|
|
c end if
|
|
c %------------------------------%
|
|
c | End of Reverse communication |
|
|
c %------------------------------%
|
|
c
|
|
c ... call _neupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
|
|
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
|
|
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
|
|
c & lworkl, rwork, info )
|
|
c stop
|
|
c end
|
|
c
|
|
c\Example-4
|
|
c ... Suppose want to solve A*x = lambda*M*x in shift-invert mode
|
|
c ... so OP = inv[A - sigma*M]*M and B = M
|
|
c ... Assume "call matvecM(n,x,y)" computes y = M*x
|
|
c ... Assume "call solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
|
|
c ... Assume exact shifts are used
|
|
c ...
|
|
c ido = 0
|
|
c iparam(7) = 3
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _naupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv,
|
|
c & iparam, ipntr, workd, workl, lworkl, rwork, info )
|
|
c if (ido .eq. -1) then
|
|
c call matvecM (n, workd(ipntr(1)), temp_array)
|
|
c call solve (n, temp_array, workd(ipntr(2)))
|
|
c go to 10
|
|
c else if (ido .eq. 1) then
|
|
c call solve (n, workd(ipntr(3)), workd(ipntr(2)))
|
|
c go to 10
|
|
c else if (ido .eq. 2) then
|
|
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c go to 10
|
|
c end if
|
|
c %------------------------------%
|
|
c | End of Reverse communication |
|
|
c %------------------------------%
|
|
c
|
|
c ... call _neupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _neupd ( rvec, 'All', select, d, d(1,2), v, ldv,
|
|
c & sigmar, sigmai, workev, bmat, n, which, nev, tol,
|
|
c & resid, ncv, v, ldv, iparam, ipntr, workd, workl,
|
|
c & lworkl, rwork, info )
|
|
c stop
|
|
c end
|
|
c\EndDoc
|