Attachment #134930: Modified version of the patch from http://news.tiker.net/node/373 for bug #197796

c     pp 357-385.

c     pp 357-385.

c

c

c\Routines called:

c\Routines called:

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     clarnv  LAPACK routine for generating a random vector. 

c     clarnv  LAPACK routine for generating a random vector. 

c     cgemv   Level 2 BLAS routine for matrix vector multiplication.

c     cgemv   Level 2 BLAS routine for matrix vector multiplication.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mgetv0

         msglvl = mgetv0

c 

c 

         ierr   = 0

         ierr   = 0

c        | the generalized problem when B is possibly (singular).   |

c        | the generalized problem when B is possibly (singular).   |

c        %----------------------------------------------------------%

c        %----------------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nopx = nopx + 1

            nopx = nopx + 1

            ipntr(1) = 1

            ipntr(1) = 1

c

c

      if (orth)  go to 40

      if (orth)  go to 40

c 

c 

      tmvopx = tmvopx + (t3 - t2)

      tmvopx = tmvopx + (t3 - t2)

c 

c 

c     %------------------------------------------------------%

c     %------------------------------------------------------%

c     | Compute B-norm of starting vector.                   |

c     | Compute B-norm of starting vector.                   |

c     %------------------------------------------------------%

c     %------------------------------------------------------%

c

c

      first = .TRUE.

      first = .TRUE.

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

   20 continue

   20 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

c     | Compute the B-norm of the orthogonalized starting vector |

c     | Compute the B-norm of the orthogonalized starting vector |

c     %----------------------------------------------------------%

c     %----------------------------------------------------------%

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

         call ccopy (n, resid, 1, workd(n+1), 1)

         call ccopy (n, resid, 1, workd(n+1), 1)

   40 continue

   40 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

      end if

      end if

      ido = 99

      ido = 99

c 

c 

      tgetv0 = tgetv0 + (t1 - t0)

      tgetv0 = tgetv0 + (t1 - t0)

c 

c 

 9000 continue

 9000 continue

c\Routines called:

c\Routines called:

c     cgetv0  ARPACK routine to generate the initial vector.

c     cgetv0  ARPACK routine to generate the initial vector.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cmout   ARPACK utility routine that prints matrices

c     cmout   ARPACK utility routine that prints matrices

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     clanhs  LAPACK routine that computes various norms of a matrix.

c     clanhs  LAPACK routine that computes various norms of a matrix.

c     %----------------------%

c     %----------------------%

c

c

      external   caxpy, ccopy, cscal, csscal, cgemv, cgetv0, 

      external   caxpy, ccopy, cscal, csscal, cgemv, cgetv0, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mcaitr

         msglvl = mcaitr

c 

c 

c        %------------------------------%

c        %------------------------------%

c              %------------------------------------------------%

c              %------------------------------------------------%

c

c

               info = j - 1

               info = j - 1

               tcaitr = tcaitr + (t1 - t0)

               tcaitr = tcaitr + (t1 - t0)

               ido = 99

               ido = 99

               go to 9000

               go to 9000

c

c

         step3 = .true.

         step3 = .true.

         nopx  = nopx + 1

         nopx  = nopx + 1

         call ccopy (n, v(1,j), 1, workd(ivj), 1)

         call ccopy (n, v(1,j), 1, workd(ivj), 1)

         ipntr(1) = ivj

         ipntr(1) = ivj

         ipntr(2) = irj

         ipntr(2) = irj

c        | if step3 = .true.                |

c        | if step3 = .true.                |

c        %----------------------------------%

c        %----------------------------------%

c

c

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

         step3 = .false.

         step3 = .false.

c        |          factorization to length j.   |

c        |          factorization to length j.   |

c        %---------------------------------------%

c        %---------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            step4 = .true.

            step4 = .true.

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c

c

         if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero)

         if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero)

c

c

c 

c 

         orth1 = .true.

         orth1 = .true.

c 

c 

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call ccopy (n, resid, 1, workd(irj), 1)

            call ccopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

         call caxpy (j, one, workd(irj), 1, h(1,j), 1)

         call caxpy (j, one, workd(irj), 1, h(1,j), 1)

c 

c 

         orth2 = .true.

         orth2 = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call ccopy (n, resid, 1, workd(irj), 1)

            call ccopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if 

         end if 

c

c

         rstart = .false.

         rstart = .false.

         orth2  = .false.

         orth2  = .false.

c 

c 

         titref = titref + (t5 - t4)

         titref = titref + (t5 - t4)

c 

c 

c        %------------------------------------%

c        %------------------------------------%

c

c

         j = j + 1

         j = j + 1

         if (j .gt. k+np) then

         if (j .gt. k+np) then

            tcaitr = tcaitr + (t1 - t0)

            tcaitr = tcaitr + (t1 - t0)

            ido = 99

            ido = 99

            do 110 i = max(1,k), k+np-1

            do 110 i = max(1,k), k+np-1

c

c

c\Routines called:

c\Routines called:

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cmout   ARPACK utility routine that prints matrices

c     cmout   ARPACK utility routine that prints matrices

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     clacpy  LAPACK matrix copy routine.

c     clacpy  LAPACK matrix copy routine.

c     %----------------------%

c     %----------------------%

c

c

      external   caxpy, ccopy, cgemv, cscal, clacpy, clartg, 

      external   caxpy, ccopy, cgemv, cscal, clacpy, clartg, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mcapps

      msglvl = mcapps

c 

c 

      kplusp = kev + np 

      kplusp = kev + np 

      end if

      end if

c

c

 9000 continue

 9000 continue

      tcapps = tcapps + (t1 - t0)

      tcapps = tcapps + (t1 - t0)

c 

c 

      return

      return

c     cngets  ARPACK reorder Ritz values and error bounds routine.

c     cngets  ARPACK reorder Ritz values and error bounds routine.

c     csortc  ARPACK sorting routine.

c     csortc  ARPACK sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cmout   ARPACK utility routine that prints matrices

c     cmout   ARPACK utility routine that prints matrices

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     %----------------------%

c     %----------------------%

c

c

      external   ccopy, cgetv0, cnaitr, cneigh, cngets, cnapps,

      external   ccopy, cgetv0, cnaitr, cneigh, cngets, cnapps,

c

c

c     %--------------------%

c     %--------------------%

c     | External functions |

c     | External functions |

c

c

      if (ido .eq. 0) then

      if (ido .eq. 0) then

c 

c 

c 

c 

         msglvl = mcaup2

         msglvl = mcaup2

c 

c 

c        %---------------------------------------------%

c        %---------------------------------------------%

c

c

         cnorm = .true.

         cnorm = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call ccopy (n, resid, 1, workd(n+1), 1)

            call ccopy (n, resid, 1, workd(n+1), 1)

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c     | Error Exit |

c     | Error Exit |

c     %------------%

c     %------------%

c

c

      tcaup2 = t1 - t0

      tcaup2 = t1 - t0

c     

c     

 9000 continue

 9000 continue

c     cstatn  ARPACK routine that initializes the timing variables.

c     cstatn  ARPACK routine that initializes the timing variables.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     slamch  LAPACK routine that determines machine constants.

c     slamch  LAPACK routine that determines machine constants.

c

c

c\Author

c\Author

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        %-------------------------------%

c        %-------------------------------%

c

c

         call cstatn

         call cstatn

         msglvl = mcaupd

         msglvl = mcaupd

c

c

c        %----------------%

c        %----------------%

     &               '_naupd: Associated Ritz estimates')

     &               '_naupd: Associated Ritz estimates')

      end if

      end if

c

c

      tcaupd = t1 - t0

      tcaupd = t1 - t0

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c

c

c\Routines called:

c\Routines called:

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cmout   ARPACK utility routine that prints matrices

c     cmout   ARPACK utility routine that prints matrices

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     %----------------------%

c     %----------------------%

c

c

      external   clacpy, clahqr, ctrevc, ccopy, 

      external   clacpy, clahqr, ctrevc, ccopy, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mceigh

      msglvl = mceigh

c 

c 

      if (msglvl .gt. 2) then

      if (msglvl .gt. 2) then

     &              '_neigh: Ritz estimates for the eigenvalues of H')

     &              '_neigh: Ritz estimates for the eigenvalues of H')

      end if

      end if

c

c

      tceigh = tceigh + (t1 - t0)

      tceigh = tceigh + (t1 - t0)

c

c

 9000 continue

 9000 continue

c\Routines called:

c\Routines called:

c     csortc  ARPACK sorting routine.

c     csortc  ARPACK sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     cvout   ARPACK utility routine that prints vectors.

c     cvout   ARPACK utility routine that prints vectors.

c

c

c\Author

c\Author

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %-----------------------%

c     %-----------------------%

c     | Executable Statements |

c     | Executable Statements |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c 

c 

      msglvl = mcgets

      msglvl = mcgets

c 

c 

      call csortc (which, .true., kev+np, ritz, bounds)

      call csortc (which, .true., kev+np, ritz, bounds)

c

c

      end if

      end if

c     

c     

      tcgets = tcgets + (t1 - t0)

      tcgets = tcgets + (t1 - t0)

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c     TR95-13, Department of Computational and Applied Mathematics.

c     TR95-13, Department of Computational and Applied Mathematics.

c

c

c\Routines called:

c\Routines called:

c     dvout   ARPACK utility routine for vector output.

c     dvout   ARPACK utility routine for vector output.

c     dlarnv  LAPACK routine for generating a random vector.

c     dlarnv  LAPACK routine for generating a random vector.

c     dgemv   Level 2 BLAS routine for matrix vector multiplication.

c     dgemv   Level 2 BLAS routine for matrix vector multiplication.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mgetv0

         msglvl = mgetv0

c 

c 

         ierr   = 0

         ierr   = 0

c        | the generalized problem when B is possibly (singular).   |

c        | the generalized problem when B is possibly (singular).   |

c        %----------------------------------------------------------%

c        %----------------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nopx = nopx + 1

            nopx = nopx + 1

            ipntr(1) = 1

            ipntr(1) = 1

      if (orth)  go to 40

      if (orth)  go to 40

c 

c 

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

      end if

      end if

c 

c 

c     | Compute B-norm of starting vector.                   |

c     | Compute B-norm of starting vector.                   |

c     %------------------------------------------------------%

c     %------------------------------------------------------%

c

c

      first = .TRUE.

      first = .TRUE.

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

   20 continue

   20 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

c     | Compute the B-norm of the orthogonalized starting vector |

c     | Compute the B-norm of the orthogonalized starting vector |

c     %----------------------------------------------------------%

c     %----------------------------------------------------------%

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

         call dcopy (n, resid, 1, workd(n+1), 1)

         call dcopy (n, resid, 1, workd(n+1), 1)

   40 continue

   40 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

      end if

      end if

      ido = 99

      ido = 99

c 

c 

      tgetv0 = tgetv0 + (t1 - t0)

      tgetv0 = tgetv0 + (t1 - t0)

c 

c 

 9000 continue

 9000 continue

c\Routines called:

c\Routines called:

c     dgetv0  ARPACK routine to generate the initial vector.

c     dgetv0  ARPACK routine to generate the initial vector.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dmout   ARPACK utility routine that prints matrices

c     dmout   ARPACK utility routine that prints matrices

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlabad  LAPACK routine that computes machine constants.

c     dlabad  LAPACK routine that computes machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   daxpy, dcopy, dscal, dgemv, dgetv0, dlabad, 

      external   daxpy, dcopy, dscal, dgemv, dgetv0, dlabad, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mnaitr

         msglvl = mnaitr

c 

c 

c        %------------------------------%

c        %------------------------------%

c              %------------------------------------------------%

c              %------------------------------------------------%

c

c

               info = j - 1

               info = j - 1

               tnaitr = tnaitr + (t1 - t0)

               tnaitr = tnaitr + (t1 - t0)

               ido = 99

               ido = 99

               go to 9000

               go to 9000

c

c

         step3 = .true.

         step3 = .true.

         nopx  = nopx + 1

         nopx  = nopx + 1

         call dcopy (n, v(1,j), 1, workd(ivj), 1)

         call dcopy (n, v(1,j), 1, workd(ivj), 1)

         ipntr(1) = ivj

         ipntr(1) = ivj

         ipntr(2) = irj

         ipntr(2) = irj

c        | if step3 = .true.                |

c        | if step3 = .true.                |

c        %----------------------------------%

c        %----------------------------------%

c

c

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

         step3 = .false.

         step3 = .false.

c        |          factorization to length j.   |

c        |          factorization to length j.   |

c        %---------------------------------------%

c        %---------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            step4 = .true.

            step4 = .true.

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c

c

         if (j .gt. 1) h(j,j-1) = betaj

         if (j .gt. 1) h(j,j-1) = betaj

c

c

c 

c 

         orth1 = .true.

         orth1 = .true.

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(irj), 1)

            call dcopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

         call daxpy (j, one, workd(irj), 1, h(1,j), 1)

         call daxpy (j, one, workd(irj), 1, h(1,j), 1)

c 

c 

         orth2 = .true.

         orth2 = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(irj), 1)

            call dcopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c

c

         rstart = .false.

         rstart = .false.

         orth2  = .false.

         orth2  = .false.

c 

c 

         titref = titref + (t5 - t4)

         titref = titref + (t5 - t4)

c 

c 

c        %------------------------------------%

c        %------------------------------------%

c

c

         j = j + 1

         j = j + 1

         if (j .gt. k+np) then

         if (j .gt. k+np) then

            tnaitr = tnaitr + (t1 - t0)

            tnaitr = tnaitr + (t1 - t0)

            ido = 99

            ido = 99

            do 110 i = max(1,k), k+np-1

            do 110 i = max(1,k), k+np-1

c

c

c\Routines called:

c\Routines called:

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dmout   ARPACK utility routine that prints matrices.

c     dmout   ARPACK utility routine that prints matrices.

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlabad  LAPACK routine that computes machine constants.

c     dlabad  LAPACK routine that computes machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf,

      external   daxpy, dcopy, dscal, dlacpy, dlarfg, dlarf,

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mnapps

      msglvl = mnapps

      kplusp = kev + np 

      kplusp = kev + np 

c 

c 

      end if

      end if

c 

c 

 9000 continue

 9000 continue

      tnapps = tnapps + (t1 - t0)

      tnapps = tnapps + (t1 - t0)

c 

c 

      return

      return

c     dngets  ARPACK reorder Ritz values and error bounds routine.

c     dngets  ARPACK reorder Ritz values and error bounds routine.

c     dsortc  ARPACK sorting routine.

c     dsortc  ARPACK sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dmout   ARPACK utility routine that prints matrices

c     dmout   ARPACK utility routine that prints matrices

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlamch  LAPACK routine that determines machine constants.

c     dlamch  LAPACK routine that determines machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   dcopy , dgetv0, dnaitr, dnconv, dneigh, 

      external   dcopy , dgetv0, dnaitr, dnconv, dneigh, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c

c

      if (ido .eq. 0) then

      if (ido .eq. 0) then

c 

c 

c 

c 

         msglvl = mnaup2

         msglvl = mnaup2

c 

c 

c        %---------------------------------------------%

c        %---------------------------------------------%

c

c

         cnorm = .true.

         cnorm = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(n+1), 1)

            call dcopy (n, resid, 1, workd(n+1), 1)

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c     | Error Exit |

c     | Error Exit |

c     %------------%

c     %------------%

c

c

      tnaup2 = t1 - t0

      tnaup2 = t1 - t0

c     

c     

 9000 continue

 9000 continue

c     dnaup2  ARPACK routine that implements the Implicitly Restarted

c     dnaup2  ARPACK routine that implements the Implicitly Restarted

c             Arnoldi Iteration.

c             Arnoldi Iteration.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlamch  LAPACK routine that determines machine constants.

c     dlamch  LAPACK routine that determines machine constants.

c

c

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        %-------------------------------%

c        %-------------------------------%

c

c

         call dstatn

         call dstatn

         msglvl = mnaupd

         msglvl = mnaupd

c

c

c        %----------------%

c        %----------------%

     &               '_naupd: Associated Ritz estimates')

     &               '_naupd: Associated Ritz estimates')

      end if

      end if

c

c

      tnaupd = t1 - t0

      tnaupd = t1 - t0

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c     xxxxxx  real

c     xxxxxx  real

c

c

c\Routines called:

c\Routines called:

c     dlamch  LAPACK routine that determines machine constants.

c     dlamch  LAPACK routine that determines machine constants.

c     dlapy2  LAPACK routine to compute sqrt(x**2+y**2) carefully.

c     dlapy2  LAPACK routine to compute sqrt(x**2+y**2) carefully.

c

c

c     | for some appropriate choice of norm.                        |

c     | for some appropriate choice of norm.                        |

c     %-------------------------------------------------------------%

c     %-------------------------------------------------------------%

c

c

c

c

c     %---------------------------------%

c     %---------------------------------%

c     | Get machine dependent constant. |

c     | Get machine dependent constant. |

         if (bounds(i) .le. tol*temp)   nconv = nconv + 1

         if (bounds(i) .le. tol*temp)   nconv = nconv + 1

   20 continue

   20 continue

c 

c 

      tnconv = tnconv + (t1 - t0)

      tnconv = tnconv + (t1 - t0)

c 

c 

      return

      return

c\Routines called:

c\Routines called:

c     dlaqrb  ARPACK routine to compute the real Schur form of an

c     dlaqrb  ARPACK routine to compute the real Schur form of an

c             upper Hessenberg matrix and last row of the Schur vectors.

c             upper Hessenberg matrix and last row of the Schur vectors.

c     dmout   ARPACK utility routine that prints matrices

c     dmout   ARPACK utility routine that prints matrices

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlacpy  LAPACK matrix copy routine.

c     dlacpy  LAPACK matrix copy routine.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mneigh

      msglvl = mneigh

c 

c 

      if (msglvl .gt. 2) then

      if (msglvl .gt. 2) then

     &              '_neigh: Ritz estimates for the eigenvalues of H')

     &              '_neigh: Ritz estimates for the eigenvalues of H')

      end if

      end if

c

c

      tneigh = tneigh + (t1 - t0)

      tneigh = tneigh + (t1 - t0)

c

c

 9000 continue

 9000 continue

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %----------------------%

c     %----------------------%

c     | Intrinsics Functions |

c     | Intrinsics Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c 

c 

      msglvl = mngets

      msglvl = mngets

c 

c 

c     %----------------------------------------------------%

c     %----------------------------------------------------%

         call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )

         call dsortc ( 'SR', .true., np, bounds, ritzr, ritzi )

      end if

      end if

c     

c     

      tngets = tngets + (t1 - t0)

      tngets = tngets + (t1 - t0)

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c     %----------------------%

c     %----------------------%

c

c

      external   daxpy, dcopy, dscal, dgemv, dgetv0, dvout, dmout,

      external   daxpy, dcopy, dscal, dgemv, dgetv0, dvout, dmout,

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = msaitr

         msglvl = msaitr

c 

c 

c        %------------------------------%

c        %------------------------------%

c              %------------------------------------------------%

c              %------------------------------------------------%

c

c

               info = j - 1

               info = j - 1

               tsaitr = tsaitr + (t1 - t0)

               tsaitr = tsaitr + (t1 - t0)

               ido = 99

               ido = 99

               go to 9000

               go to 9000

c

c

         step3 = .true.

         step3 = .true.

         nopx  = nopx + 1

         nopx  = nopx + 1

         call dcopy (n, v(1,j), 1, workd(ivj), 1)

         call dcopy (n, v(1,j), 1, workd(ivj), 1)

         ipntr(1) = ivj

         ipntr(1) = ivj

         ipntr(2) = irj

         ipntr(2) = irj

c        | WORKD(IRJ:IRJ+N-1) := OP*v_{j}.   |

c        | WORKD(IRJ:IRJ+N-1) := OP*v_{j}.   |

c        %-----------------------------------%

c        %-----------------------------------%

c

c

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

c 

c 

         step3 = .false.

         step3 = .false.

c        %-------------------------------------------%

c        %-------------------------------------------%

c

c

         if (mode .eq. 2) go to 65

         if (mode .eq. 2) go to 65

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            step4 = .true.

            step4 = .true.

c        %-----------------------------------%

c        %-----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if 

         end if 

c

c

         else

         else

            h(j,1) = rnorm

            h(j,1) = rnorm

         end if

         end if

c 

c 

         orth1 = .true.

         orth1 = .true.

         iter  = 0

         iter  = 0

c 

c 

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(irj), 1)

            call dcopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

         h(j,2) = h(j,2) + workd(irj + j - 1)

         h(j,2) = h(j,2) + workd(irj + j - 1)

c 

c 

         orth2 = .true.

         orth2 = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(irj), 1)

            call dcopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c

c

         rstart = .false.

         rstart = .false.

         orth2  = .false.

         orth2  = .false.

c 

c 

         titref = titref + (t5 - t4)

         titref = titref + (t5 - t4)

c 

c 

c        %----------------------------------------------------------%

c        %----------------------------------------------------------%

c

c

         j = j + 1

         j = j + 1

         if (j .gt. k+np) then

         if (j .gt. k+np) then

            tsaitr = tsaitr + (t1 - t0)

            tsaitr = tsaitr + (t1 - t0)

            ido = 99

            ido = 99

c

c

c

c

c\Routines called:

c\Routines called:

c     ivout   ARPACK utility routine that prints integers. 

c     ivout   ARPACK utility routine that prints integers. 

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlamch  LAPACK routine that determines machine constants.

c     dlamch  LAPACK routine that determines machine constants.

c     dlartg  LAPACK Givens rotation construction routine.

c     dlartg  LAPACK Givens rotation construction routine.

c     %----------------------%

c     %----------------------%

c

c

      external   daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, dvout, 

      external   daxpy, dcopy, dscal, dlacpy, dlartg, dlaset, dvout, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = msapps

      msglvl = msapps

c 

c 

      kplusp = kev + np 

      kplusp = kev + np 

         end if

         end if

      end if

      end if

c

c

      tsapps = tsapps + (t1 - t0)

      tsapps = tsapps + (t1 - t0)

c 

c 

 9000 continue 

 9000 continue 

c     dsgets  ARPACK reorder Ritz values and error bounds routine.

c     dsgets  ARPACK reorder Ritz values and error bounds routine.

c     dsortr  ARPACK sorting routine.

c     dsortr  ARPACK sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dlamch  LAPACK routine that determines machine constants.

c     dlamch  LAPACK routine that determines machine constants.

c     dcopy   Level 1 BLAS that copies one vector to another.

c     dcopy   Level 1 BLAS that copies one vector to another.

c     %----------------------%

c     %----------------------%

c

c

      external   dcopy, dgetv0, dsaitr, dscal, dsconv, dseigt, dsgets, 

      external   dcopy, dgetv0, dsaitr, dscal, dsconv, dseigt, dsgets, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = msaup2

         msglvl = msaup2

c

c

c        %---------------------------------%

c        %---------------------------------%

c        %---------------------------------------------%

c        %---------------------------------------------%

c

c

         cnorm = .true.

         cnorm = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call dcopy (n, resid, 1, workd(n+1), 1)

            call dcopy (n, resid, 1, workd(n+1), 1)

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c     | Error exit |

c     | Error exit |

c     %------------%

c     %------------%

c

c

      tsaup2 = t1 - t0

      tsaup2 = t1 - t0

c 

c 

 9000 continue

 9000 continue

c     dstats   ARPACK routine that initialize timing and other statistics

c     dstats   ARPACK routine that initialize timing and other statistics

c             variables.

c             variables.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dvout    ARPACK utility routine that prints vectors.

c     dvout    ARPACK utility routine that prints vectors.

c     dlamch   LAPACK routine that determines machine constants.

c     dlamch   LAPACK routine that determines machine constants.

c

c

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        %-------------------------------%

c        %-------------------------------%

c

c

         call dstats 

         call dstats 

         msglvl = msaupd

         msglvl = msaupd

c

c

         ierr   = 0

         ierr   = 0

     &               '_saupd: corresponding error bounds')

     &               '_saupd: corresponding error bounds')

      end if 

      end if 

c

c

      tsaupd = t1 - t0

      tsaupd = t1 - t0

c 

c 

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c\BeginLib

c\BeginLib

c

c

c\Routines called:

c\Routines called:

c     dlamch  LAPACK routine that determines machine constants. 

c     dlamch  LAPACK routine that determines machine constants. 

c

c

c\Author

c\Author

c     | Executable Statements |

c     | Executable Statements |

c     %-----------------------%

c     %-----------------------%

c

c

c

c

      eps23 = dlamch('Epsilon-Machine') 

      eps23 = dlamch('Epsilon-Machine') 

      eps23 = eps23**(2.0D+0 / 3.0D+0)

      eps23 = eps23**(2.0D+0 / 3.0D+0)

c

c

   10 continue

   10 continue

c 

c 

      tsconv = tsconv + (t1 - t0)

      tsconv = tsconv + (t1 - t0)

c 

c 

      return

      return

c     dstqrb  ARPACK routine that computes the eigenvalues and the

c     dstqrb  ARPACK routine that computes the eigenvalues and the

c             last components of the eigenvectors of a symmetric

c             last components of the eigenvectors of a symmetric

c             and tridiagonal matrix.

c             and tridiagonal matrix.

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dcopy   Level 1 BLAS that copies one vector to another.

c     dcopy   Level 1 BLAS that copies one vector to another.

c

c

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %-----------------------%

c     %-----------------------%

c     | Executable Statements |

c     | Executable Statements |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------% 

c     %-------------------------------% 

c

c

      msglvl = mseigt

      msglvl = mseigt

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

         bounds(k) = rnorm*abs(bounds(k))

         bounds(k) = rnorm*abs(bounds(k))

   30 continue

   30 continue

c 

c 

      tseigt = tseigt + (t1 - t0)

      tseigt = tseigt + (t1 - t0)

c

c

 9000 continue

 9000 continue

c\Routines called:

c\Routines called:

c     dsortr  ARPACK utility sorting routine.

c     dsortr  ARPACK utility sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     dvout   ARPACK utility routine that prints vectors.

c     dvout   ARPACK utility routine that prints vectors.

c     dcopy   Level 1 BLAS that copies one vector to another.

c     dcopy   Level 1 BLAS that copies one vector to another.

c     dswap   Level 1 BLAS that swaps the contents of two vectors.

c     dswap   Level 1 BLAS that swaps the contents of two vectors.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %---------------------%

c     %---------------------%

c     | Intrinsic Functions |

c     | Intrinsic Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = msgets

      msglvl = msgets

c 

c 

      if (which .eq. 'BE') then

      if (which .eq. 'BE') then

         call dcopy (np, ritz, 1, shifts, 1)

         call dcopy (np, ritz, 1, shifts, 1)

      end if

      end if

c 

c 

      tsgets = tsgets + (t1 - t0)

      tsgets = tsgets + (t1 - t0)

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c     TR95-13, Department of Computational and Applied Mathematics.

c     TR95-13, Department of Computational and Applied Mathematics.

c

c

c\Routines called:

c\Routines called:

c     svout   ARPACK utility routine for vector output.

c     svout   ARPACK utility routine for vector output.

c     slarnv  LAPACK routine for generating a random vector.

c     slarnv  LAPACK routine for generating a random vector.

c     sgemv   Level 2 BLAS routine for matrix vector multiplication.

c     sgemv   Level 2 BLAS routine for matrix vector multiplication.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mgetv0

         msglvl = mgetv0

c 

c 

         ierr   = 0

         ierr   = 0

c        | the generalized problem when B is possibly (singular).   |

c        | the generalized problem when B is possibly (singular).   |

c        %----------------------------------------------------------%

c        %----------------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nopx = nopx + 1

            nopx = nopx + 1

            ipntr(1) = 1

            ipntr(1) = 1

      if (orth)  go to 40

      if (orth)  go to 40

c 

c 

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

      end if

      end if

c 

c 

c     | Compute B-norm of starting vector.                   |

c     | Compute B-norm of starting vector.                   |

c     %------------------------------------------------------%

c     %------------------------------------------------------%

c

c

      first = .TRUE.

      first = .TRUE.

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

   20 continue

   20 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

c     | Compute the B-norm of the orthogonalized starting vector |

c     | Compute the B-norm of the orthogonalized starting vector |

c     %----------------------------------------------------------%

c     %----------------------------------------------------------%

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         nbx = nbx + 1

         nbx = nbx + 1

         call scopy (n, resid, 1, workd(n+1), 1)

         call scopy (n, resid, 1, workd(n+1), 1)

   40 continue

   40 continue

c

c

      if (bmat .eq. 'G') then

      if (bmat .eq. 'G') then

         tmvbx = tmvbx + (t3 - t2)

         tmvbx = tmvbx + (t3 - t2)

      end if

      end if

c 

c 

      end if

      end if

      ido = 99

      ido = 99

c 

c 

      tgetv0 = tgetv0 + (t1 - t0)

      tgetv0 = tgetv0 + (t1 - t0)

c 

c 

 9000 continue

 9000 continue

c\Routines called:

c\Routines called:

c     sgetv0  ARPACK routine to generate the initial vector.

c     sgetv0  ARPACK routine to generate the initial vector.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     smout   ARPACK utility routine that prints matrices

c     smout   ARPACK utility routine that prints matrices

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     slabad  LAPACK routine that computes machine constants.

c     slabad  LAPACK routine that computes machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   saxpy, scopy, sscal, sgemv, sgetv0, slabad, 

      external   saxpy, scopy, sscal, sgemv, sgetv0, slabad, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        | & message level for debugging |

c        | & message level for debugging |

c        %-------------------------------%

c        %-------------------------------%

c

c

         msglvl = mnaitr

         msglvl = mnaitr

c 

c 

c        %------------------------------%

c        %------------------------------%

c              %------------------------------------------------%

c              %------------------------------------------------%

c

c

               info = j - 1

               info = j - 1

               tnaitr = tnaitr + (t1 - t0)

               tnaitr = tnaitr + (t1 - t0)

               ido = 99

               ido = 99

               go to 9000

               go to 9000

c

c

         step3 = .true.

         step3 = .true.

         nopx  = nopx + 1

         nopx  = nopx + 1

         call scopy (n, v(1,j), 1, workd(ivj), 1)

         call scopy (n, v(1,j), 1, workd(ivj), 1)

         ipntr(1) = ivj

         ipntr(1) = ivj

         ipntr(2) = irj

         ipntr(2) = irj

c        | if step3 = .true.                |

c        | if step3 = .true.                |

c        %----------------------------------%

c        %----------------------------------%

c

c

         tmvopx = tmvopx + (t3 - t2)

         tmvopx = tmvopx + (t3 - t2)

         step3 = .false.

         step3 = .false.

c        |          factorization to length j.   |

c        |          factorization to length j.   |

c        %---------------------------------------%

c        %---------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            step4 = .true.

            step4 = .true.

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c

c

         if (j .gt. 1) h(j,j-1) = betaj

         if (j .gt. 1) h(j,j-1) = betaj

c

c

c 

c 

         orth1 = .true.

         orth1 = .true.

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call scopy (n, resid, 1, workd(irj), 1)

            call scopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

         call saxpy (j, one, workd(irj), 1, h(1,j), 1)

         call saxpy (j, one, workd(irj), 1, h(1,j), 1)

c 

c 

         orth2 = .true.

         orth2 = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call scopy (n, resid, 1, workd(irj), 1)

            call scopy (n, resid, 1, workd(irj), 1)

c        %---------------------------------------------------%

c        %---------------------------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c

c

         rstart = .false.

         rstart = .false.

         orth2  = .false.

         orth2  = .false.

c 

c 

         titref = titref + (t5 - t4)

         titref = titref + (t5 - t4)

c 

c 

c        %------------------------------------%

c        %------------------------------------%

c

c

         j = j + 1

         j = j + 1

         if (j .gt. k+np) then

         if (j .gt. k+np) then

            tnaitr = tnaitr + (t1 - t0)

            tnaitr = tnaitr + (t1 - t0)

            ido = 99

            ido = 99

            do 110 i = max(1,k), k+np-1

            do 110 i = max(1,k), k+np-1

c

c

c\Routines called:

c\Routines called:

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     smout   ARPACK utility routine that prints matrices.

c     smout   ARPACK utility routine that prints matrices.

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     slabad  LAPACK routine that computes machine constants.

c     slabad  LAPACK routine that computes machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   saxpy, scopy, sscal, slacpy, slarfg, slarf,

      external   saxpy, scopy, sscal, slacpy, slarfg, slarf,

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mnapps

      msglvl = mnapps

      kplusp = kev + np 

      kplusp = kev + np 

c 

c 

      end if

      end if

c 

c 

 9000 continue

 9000 continue

      tnapps = tnapps + (t1 - t0)

      tnapps = tnapps + (t1 - t0)

c 

c 

      return

      return

c     sngets  ARPACK reorder Ritz values and error bounds routine.

c     sngets  ARPACK reorder Ritz values and error bounds routine.

c     ssortc  ARPACK sorting routine.

c     ssortc  ARPACK sorting routine.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     smout   ARPACK utility routine that prints matrices

c     smout   ARPACK utility routine that prints matrices

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     slamch  LAPACK routine that determines machine constants.

c     slamch  LAPACK routine that determines machine constants.

c     %----------------------%

c     %----------------------%

c

c

      external   scopy , sgetv0, snaitr, snconv, sneigh, 

      external   scopy , sgetv0, snaitr, snconv, sneigh, 

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c

c

      if (ido .eq. 0) then

      if (ido .eq. 0) then

c 

c 

c 

c 

         msglvl = mnaup2

         msglvl = mnaup2

c 

c 

c        %---------------------------------------------%

c        %---------------------------------------------%

c

c

         cnorm = .true.

         cnorm = .true.

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            nbx = nbx + 1

            nbx = nbx + 1

            call scopy (n, resid, 1, workd(n+1), 1)

            call scopy (n, resid, 1, workd(n+1), 1)

c        %----------------------------------%

c        %----------------------------------%

c

c

         if (bmat .eq. 'G') then

         if (bmat .eq. 'G') then

            tmvbx = tmvbx + (t3 - t2)

            tmvbx = tmvbx + (t3 - t2)

         end if

         end if

c 

c 

c     | Error Exit |

c     | Error Exit |

c     %------------%

c     %------------%

c

c

      tnaup2 = t1 - t0

      tnaup2 = t1 - t0

c     

c     

 9000 continue

 9000 continue

c     snaup2  ARPACK routine that implements the Implicitly Restarted

c     snaup2  ARPACK routine that implements the Implicitly Restarted

c             Arnoldi Iteration.

c             Arnoldi Iteration.

c     ivout   ARPACK utility routine that prints integers.

c     ivout   ARPACK utility routine that prints integers.

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     slamch  LAPACK routine that determines machine constants.

c     slamch  LAPACK routine that determines machine constants.

c

c

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c        %-------------------------------%

c        %-------------------------------%

c

c

         call sstatn

         call sstatn

         msglvl = mnaupd

         msglvl = mnaupd

c

c

c        %----------------%

c        %----------------%

     &               '_naupd: Associated Ritz estimates')

     &               '_naupd: Associated Ritz estimates')

      end if

      end if

c

c

      tnaupd = t1 - t0

      tnaupd = t1 - t0

c

c

      if (msglvl .gt. 0) then

      if (msglvl .gt. 0) then

c     xxxxxx  real

c     xxxxxx  real

c

c

c\Routines called:

c\Routines called:

c     slamch  LAPACK routine that determines machine constants.

c     slamch  LAPACK routine that determines machine constants.

c     slapy2  LAPACK routine to compute sqrt(x**2+y**2) carefully.

c     slapy2  LAPACK routine to compute sqrt(x**2+y**2) carefully.

c

c

c     | for some appropriate choice of norm.                        |

c     | for some appropriate choice of norm.                        |

c     %-------------------------------------------------------------%

c     %-------------------------------------------------------------%

c

c

c

c

c     %---------------------------------%

c     %---------------------------------%

c     | Get machine dependent constant. |

c     | Get machine dependent constant. |

         if (bounds(i) .le. tol*temp)   nconv = nconv + 1

         if (bounds(i) .le. tol*temp)   nconv = nconv + 1

   20 continue

   20 continue

c 

c 

      tnconv = tnconv + (t1 - t0)

      tnconv = tnconv + (t1 - t0)

c 

c 

      return

      return

c\Routines called:

c\Routines called:

c     slaqrb  ARPACK routine to compute the real Schur form of an

c     slaqrb  ARPACK routine to compute the real Schur form of an

c             upper Hessenberg matrix and last row of the Schur vectors.

c             upper Hessenberg matrix and last row of the Schur vectors.

c     smout   ARPACK utility routine that prints matrices

c     smout   ARPACK utility routine that prints matrices

c     svout   ARPACK utility routine that prints vectors.

c     svout   ARPACK utility routine that prints vectors.

c     slacpy  LAPACK matrix copy routine.

c     slacpy  LAPACK matrix copy routine.

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %--------------------%

c     %--------------------%

c     | External Functions |

c     | External Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%

c

c

      msglvl = mneigh

      msglvl = mneigh

c 

c 

      if (msglvl .gt. 2) then

      if (msglvl .gt. 2) then

     &              '_neigh: Ritz estimates for the eigenvalues of H')

     &              '_neigh: Ritz estimates for the eigenvalues of H')

      end if

      end if

c

c

      tneigh = tneigh + (t1 - t0)

      tneigh = tneigh + (t1 - t0)

c

c

 9000 continue

 9000 continue

c     | External Subroutines |

c     | External Subroutines |

c     %----------------------%

c     %----------------------%

c

c

c

c

c     %----------------------%

c     %----------------------%

c     | Intrinsics Functions |

c     | Intrinsics Functions |

c     | & message level for debugging |

c     | & message level for debugging |

c     %-------------------------------%

c     %-------------------------------%