235 lines
8.6 KiB
Plaintext
235 lines
8.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 _saupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, 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 _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c
|
|
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 iparam(7) = 3
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _saupd ( ido, 'I', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, 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 _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
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 _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c if (ido .eq. -1 .or. ido .eq. 1) then
|
|
c call matvecA (n, workd(ipntr(1)), temp_array)
|
|
c call _scopy (n, temp_array, 1, workd(ipntr(1)), 1)
|
|
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 the first np locations of work
|
|
c np = iparam(8)
|
|
c call _copy (np, shifts, 1, workl(ipntr(11), 1)
|
|
c go to 10
|
|
c end if
|
|
c %------------------------------%
|
|
c | End of Reverse communication |
|
|
c %------------------------------%
|
|
c
|
|
c ... call _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, 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 _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, 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 _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c
|
|
c stop
|
|
c end
|
|
c
|
|
c\Example-5
|
|
c ... Suppose want to solve K*x = lambda*KG*x in Buckling mode
|
|
c ... so OP = (inv[K - sigma*KG])*K and B = K.
|
|
c ... Assume "call matvecM(n,x,y)" computes y = KG*x
|
|
c ... Assume "call matvecA(n,x,y)" computes y = K*x
|
|
c ... Assume "call solve(n,rhs,x)" solves [K - sigma*KG]*x = rhs
|
|
c ... Assume exact shifts are used
|
|
c
|
|
c ido = 0
|
|
c iparam(7) = 4
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c if (ido .eq. -1) then
|
|
c call matvecA (n, workd(ipntr(1)), temp_array)
|
|
c 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 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 _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c stop
|
|
c end
|
|
c
|
|
c\Example-6
|
|
c ... Suppose want to solve A*x = lambda*M*x in Cayley mode
|
|
c ... so OP = inv[A - sigma*M]*[A + sigma*M] 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 solve(n,rhs,x)" solves [A - sigma*M]*x = rhs
|
|
c ... Assume exact shifts are used
|
|
c ...
|
|
c ido = 0
|
|
c iparam(7) = 5
|
|
c
|
|
c %------------------------------------%
|
|
c | Beginning of reverse communication |
|
|
c %------------------------------------%
|
|
c 10 continue
|
|
c call _saupd ( ido, 'G', n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c if (ido .eq. -1) then
|
|
c call matvecM (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c call matvecA (n, workd(ipntr(1)), temp_array)
|
|
c call _axpy (n, sigma, workd(inptr(2)), 1, temp_array, 1)
|
|
c call solve (n, temp_array, workd(ipntr(2)))
|
|
c go to 10
|
|
c else if (ido .eq. 1) then
|
|
c call matvecA (n, workd(ipntr(1)), workd(ipntr(2)))
|
|
c call _axpy (n, sigma, workd(inptr(3)), 1, workd(ipntr(2)), 1)
|
|
c call _copy (n, workd(inptr(2)), 1, workd(ipntr(3)), 1)
|
|
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 _seupd to postprocess
|
|
c ... want the Ritz vectors set rvec = .true. else rvec = .false.
|
|
c call _seupd ( rvec, 'All', select, d, z, ldz, sigma, bmat,
|
|
c & n, which, nev, tol, resid, ncv, v, ldv, iparam,
|
|
c & ipntr, workd, workl, lworkl, info )
|
|
c stop
|
|
c end
|
|
c\EndDoc
|
|
c
|