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