Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- complex(R_P), dimension(:,:), intent(in) :: mat
- complex(R_P), dimension(:), intent(inout) :: gs_vec
- real(R_P), intent(out) :: gs_val
- integer, parameter :: nev = 1, ncv = 10
- integer :: iparam(11), ipntr(14)
- logical :: select(ncv)
- complex(R_P) :: d(ncv), v(size(mat,1),ncv), workd(3*size(mat,1)), workev(3*ncv), resid(size(mat,1))
- complex(R_P) :: workl(3*ncv*ncv+5*ncv)
- real(R_P) :: rwork(ncv)
- character(len=1) :: bmat = 'I'
- character(len=2) :: which = 'SR'
- integer, parameter :: ishfts = 1, maxitr = 300, mode = 1
- integer :: ido = 0, lworkl = 3 * ncv**2+5*ncv, info = 1, n, ldv, ierr = 0
- complex(R_P) :: sigma = (0.0,0.0_R_P)
- real(R_P) :: tol = 0.0_R_P
- logical :: rvec = .true.
- iparam = 0
- ipntr = 0
- select = .true.
- d = (0.0,0.0_R_P)
- v = (0.0,0.0_R_P)
- workd = (0.0,0.0_R_P)
- workev = (0.0,0.0_R_P)
- workl = (0.0,0.0_R_P)
- rwork = 0.0_R_P
- resid = gs_vec
- n = size(mat,1)
- ldv = n
- iparam(1) = ishfts
- iparam(3) = maxitr
- iparam(7) = mode
- do while (ido == 0 .or. ido == 1 .or. ido == -1)
- call znaupd( ido, bmat, n, which, nev, tol, resid, ncv,&
- v, ldv, iparam, ipntr, workd, workl, lworkl,&
- rwork,info )
- if (ido .eq. -1 .or. ido .eq. 1) then
- call av(workd(ipntr(1):(ipntr(1)+n-1)), workd(ipntr(2):(ipntr(2)+n-1)),mat)
- end if
- end do
- if ( info .lt. 0 ) then
- print *, ' '
- print *, ' Error with _naupd, info = ', info
- print *, ' Check the documentation of _naupd'
- print *, ' '
- else
- rvec = .true.
- call zneupd (rvec, 'A', select, d, v, ldv, sigma,&
- workev, bmat, n, which, nev, tol, resid, ncv,&
- v, ldv, iparam, ipntr, workd, workl, lworkl, &
- rwork, ierr)
- if ( ierr .ne. 0) then
- print *, ' '
- print *, ' Error with _neupd, info = ', ierr
- print *, ' Check the documentation of _neupd. '
- print *, ' '
- end if
- gs_vec = v(:,1)
- gs_val = d(1)
- if ( info .eq. 1) then
- print *, ' '
- print *, ' Maximum number of iterations reached.'
- print *, ' '
- else if ( info .eq. 3) then
- print *, ' '
- print *, ' No shifts could be applied during implicit Arnoldi update, try increasing NCV.'
- print *, ' '
- end if
- print *, ' '
- print *, '_NDRV1'
- print *, '====== '
- print *, ' '
- print *, ' Size of the matrix is ', n
- print *, ' The number of Ritz values requested is ', nev
- print *, ' The number of Arnoldi vectors generated (NCV) is ', ncv
- print *, ' What portion of the spectrum: ', which
- print *, ' The number of converged Ritz values is ', iparam(5)
- print *, ' The number of Implicit Arnoldi update iterations taken is ', iparam(3)
- print *, ' The number of OP*x is ', iparam(9)
- print *, ' The convergence criterion is ', tol
- print *, ' '
- end if
- contains
- subroutine av ( v, w, mat)
- complex(R_P), dimension(:), intent(in) :: v
- complex(R_P), dimension(:), intent(out) :: w
- complex(R_P), dimension(:,:), intent(in) :: mat
- w = matmul(mat,v)
- end subroutine av
- end subroutine zndrv1
- complex(R_P) :: sigma = (0.0,0.0_R_P)
- complex(R_P) :: sigma
- sigma = (0.0, 0.0_R_P)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement