← Back to branch summary

~ubuntu-branches/debian/sid/arpack/sid

« back to all changes in this revision

Viewing changes to SRC/cneupd.f

  • Committer: Package Import Robot
  • Author(s): Sylvestre Ledru
  • Date: 2012-02-22 11:05:03 UTC
  • mfrom: (1.2.5)
  • Revision ID: package-import@ubuntu.com-20120222110503-h6ux3f5ilm5q76w0
Tags: 3.1.0-1
New upstream release

Show diffs side-by-side

added added

removed removed

Lines of Context:
SRC/cneupd.f
66
66
c          If HOWMNY = 'A' or 'P', SELECT need not be initialized 
67
67
c          but it is used as internal workspace.
68
68
c
69
 
c  D       Complex  array of dimension NEV+1.  (OUTPUT)
 
69
c  D       Complex array of dimension NEV+1.  (OUTPUT)
70
70
c          On exit, D contains the  Ritz  approximations 
71
71
c          to the eigenvalues lambda for A*z = lambda*B*z.
72
72
c
73
 
c  Z       Complex  N by NEV array    (OUTPUT)
 
73
c  Z       Complex N by NEV array    (OUTPUT)
74
74
c          On exit, if RVEC = .TRUE. and HOWMNY = 'A', then the columns of 
75
75
c          Z represents approximate eigenvectors (Ritz vectors) corresponding 
76
76
c          to the NCONV=IPARAM(5) Ritz values for eigensystem
88
88
c          desired, then  LDZ .ge.  max( 1, N ) is required.  
89
89
c          In any case,  LDZ .ge. 1 is required.
90
90
c
91
 
c  SIGMA   Complex   (INPUT)
 
91
c  SIGMA   Complex  (INPUT)
92
92
c          If IPARAM(7) = 3 then SIGMA represents the shift. 
93
93
c          Not referenced if IPARAM(7) = 1 or 2.
94
94
c
95
 
c  WORKEV  Complex  work array of dimension 2*NCV.  (WORKSPACE)
 
95
c  WORKEV  Complex work array of dimension 2*NCV.  (WORKSPACE)
96
96
c
97
97
c  **** The remaining arguments MUST be the same as for the   ****
98
98
c  **** call to CNAUPD that was just completed.               ****
108
108
c
109
109
c  Three of these parameters (V, WORKL and INFO) are also output parameters:
110
110
c
111
 
c  V       Complex  N by NCV array.  (INPUT/OUTPUT)
 
111
c  V       Complex N by NCV array.  (INPUT/OUTPUT)
112
112
c
113
113
c          Upon INPUT: the NCV columns of V contain the Arnoldi basis
114
114
c                      vectors for OP as constructed by CNAUPD .
124
124
c          the first NCONV=IPARAM(5) columns of V will contain approximate
125
125
c          Schur vectors that span the desired invariant subspace.
126
126
c
127
 
c  WORKL   Real  work array of length LWORKL.  (OUTPUT/WORKSPACE)
 
127
c  WORKL   Real work array of length LWORKL.  (OUTPUT/WORKSPACE)
128
128
c          WORKL(1:ncv*ncv+2*ncv) contains information obtained in
129
129
c          cnaupd.  They are not changed by cneupd.
130
130
c          WORKL(ncv*ncv+2*ncv+1:3*ncv*ncv+4*ncv) holds the
266
266
      character  bmat, howmny, which*2
267
267
      logical    rvec
268
268
      integer    info, ldz, ldv, lworkl, n, ncv, nev
269
 
      Complex      
 
269
      Complex     
270
270
     &           sigma
271
 
      Real  
 
271
      Real 
272
272
     &           tol
273
273
c
274
274
c     %-----------------%
277
277
c
278
278
      integer    iparam(11), ipntr(14)
279
279
      logical    select(ncv)
280
 
      Real 
 
280
      Real
281
281
     &           rwork(ncv)
282
 
      Complex 
 
282
      Complex
283
283
     &           d(nev)     , resid(n)     , v(ldv,ncv),
284
284
     &           z(ldz, nev), 
285
285
     &           workd(3*n) , workl(lworkl), workev(2*ncv)
288
288
c     | Parameters |
289
289
c     %------------%
290
290
c
291
 
      Complex 
 
291
      Complex
292
292
     &           one, zero
293
 
      parameter  (one = (1.0E+0, 0.0E+0) , zero = (0.0E+0, 0.0E+0) )
 
293
      parameter  (one = (1.0E+0, 0.0E+0), zero = (0.0E+0, 0.0E+0))
294
294
c
295
295
c     %---------------%
296
296
c     | Local Scalars |
304
304
     &           ishift, nconv2
305
305
      Complex 
306
306
     &           rnorm, temp, vl(1)
307
 
      Real 
 
307
      Real
308
308
     &           conds, sep, rtemp, eps23
309
309
      logical    reord
310
310
c
320
320
c     | External Functions |
321
321
c     %--------------------%
322
322
c
323
 
      Real 
 
323
      Real
324
324
     &           scnrm2, slamch, slapy2
325
325
      external   scnrm2, slamch, slapy2
326
326
c
327
 
      Complex 
 
327
      Complex
328
328
     &           cdotc
329
329
      external   cdotc
330
330
c
347
347
c     %---------------------------------%
348
348
c
349
349
      eps23 = slamch('Epsilon-Machine')
350
 
      eps23 = eps23**(2.0E+0  / 3.0E+0 )
 
350
      eps23 = eps23**(2.0E+0 / 3.0E+0)
351
351
c
352
352
c     %-------------------------------%
353
353
c     | Quick return                  |
515
515
         numcnv = 0
516
516
         do 11 j = 1,ncv
517
517
            rtemp = max(eps23,
518
 
     &                 slapy2 ( real (workl(irz+ncv-j)),
 
518
     &                 slapy2 ( real(workl(irz+ncv-j)),
519
519
     &                          aimag(workl(irz+ncv-j)) ))
520
520
            jj = workl(bounds + ncv - j)
521
521
            if (numcnv .lt. nconv .and.
522
 
     &          slapy2( real (workl(ibd+jj-1)),
 
522
     &          slapy2( real(workl(ibd+jj-1)),
523
523
     &          aimag(workl(ibd+jj-1)) )
524
524
     &          .le. tol*rtemp) then
525
525
               select(jj) = .true.
526
526
               numcnv = numcnv + 1
527
 
               if (jj .gt. nev) reord = .true.
 
527
               if (jj .gt. nconv) reord = .true.
528
528
            endif
529
529
   11    continue
530
530
c
674
674
c           | matrix consisting of plus or minus ones.          |
675
675
c           %---------------------------------------------------%
676
676
c
677
 
            if ( real ( workl(invsub+(j-1)*ldq+j-1) ) .lt. 
678
 
     &                  real (zero) ) then
 
677
            if ( real( workl(invsub+(j-1)*ldq+j-1) ) .lt. 
 
678
     &                  real(zero) ) then
679
679
               call cscal(nconv, -one, workl(iuptri+j-1), ldq)
680
680
               call cscal(nconv, -one, workl(iuptri+(j-1)*ldq), 1)
681
681
            end if
718
718
c
719
719
            do 40 j=1, nconv
720
720
                  rtemp = scnrm2(ncv, workl(invsub+(j-1)*ldq), 1)
721
 
                  rtemp = real (one) / rtemp
 
721
                  rtemp = real(one) / rtemp
722
722
                  call csscal ( ncv, rtemp,
723
723
     &                 workl(invsub+(j-1)*ldq), 1 )
724
724
c