1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
|
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
|