← Back to branch summary

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

« back to all changes in this revision

Viewing changes to PARPACK/SRC/BLACS/pcnaup2.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:
PARPACK/SRC/BLACS/pcnaup2.f
2
2
c
3
3
c\Name: pcnaup2
4
4
c
5
 
c Message Passing Layer: BLACS 
 
5
c Message Passing Layer: BLACS
6
6
c
7
7
c\Description: 
8
8
c  Intermediate level interface called by pcnaupd.
39
39
c          IUPD .EQ. 0: use explicit restart instead implicit update.
40
40
c          IUPD .NE. 0: use implicit update.
41
41
c
42
 
c  V       Complex  N by (NEV+NP) array.  (INPUT/OUTPUT)
 
42
c  V       Complex N by (NEV+NP) array.  (INPUT/OUTPUT)
43
43
c          The Arnoldi basis vectors are returned in the first NEV 
44
44
c          columns of V.
45
45
c
47
47
c          Leading dimension of V exactly as declared in the calling 
48
48
c          program.
49
49
c
50
 
c  H       Complex  (NEV+NP) by (NEV+NP) array.  (OUTPUT)
 
50
c  H       Complex (NEV+NP) by (NEV+NP) array.  (OUTPUT)
51
51
c          H is used to store the generated upper Hessenberg matrix
52
52
c
53
53
c  LDH     Integer.  (INPUT)
54
54
c          Leading dimension of H exactly as declared in the calling 
55
55
c          program.
56
56
c
57
 
c  RITZ    Complex  array of length NEV+NP.  (OUTPUT)
 
57
c  RITZ    Complex array of length NEV+NP.  (OUTPUT)
58
58
c          RITZ(1:NEV)  contains the computed Ritz values of OP.
59
59
c
60
 
c  BOUNDS  Complex  array of length NEV+NP.  (OUTPUT)
 
60
c  BOUNDS  Complex array of length NEV+NP.  (OUTPUT)
61
61
c          BOUNDS(1:NEV) contain the error bounds corresponding to 
62
62
c          the computed Ritz values.
63
63
c          
64
 
c  Q       Complex  (NEV+NP) by (NEV+NP) array.  (WORKSPACE)
 
64
c  Q       Complex (NEV+NP) by (NEV+NP) array.  (WORKSPACE)
65
65
c          Private (replicated) work array used to accumulate the
66
66
c          rotation in the shift application step.
67
67
c
69
69
c          Leading dimension of Q exactly as declared in the calling
70
70
c          program.
71
71
c
72
 
c  WORKL   Complex  work array of length at least 
 
72
c  WORKL   Complex work array of length at least 
73
73
c          (NEV+NP)**2 + 3*(NEV+NP).  (WORKSPACE)
74
74
c          Private (replicated) array on each PE or array allocated on
75
75
c          the front end.  It is used in shifts calculation, shifts
86
86
c                    shift-and-invert mode.  X is the current operand.
87
87
c          -------------------------------------------------------------
88
88
c          
89
 
c  WORKD   Complex  work array of length 3*N.  (WORKSPACE)
 
89
c  WORKD   Complex work array of length 3*N.  (WORKSPACE)
90
90
c          Distributed array to be used in the basic Arnoldi iteration
91
91
c          for reverse communication.  The user should not use WORKD
92
92
c          as temporary workspace during the iteration !!!!!!!!!!
93
93
c          See Data Distribution Note in PCNAUPD.
94
94
c
95
 
c  RWORK   Real    work array of length  NEV+NP ( WORKSPACE)
 
95
c  RWORK   Real   work array of length  NEV+NP ( WORKSPACE)
96
96
c          Private (replicated) array on each PE or array allocated on
97
97
c          the front end.
98
98
c
119
119
c\BeginLib
120
120
c
121
121
c\Local variables:
122
 
c     xxxxxx  Complex 
 
122
c     xxxxxx  Complex
123
123
c
124
124
c\References:
125
125
c  1. D.C. Sorensen, "Implicit Application of Polynomial Filters in
156
156
c     Rice University           
157
157
c     Houston, Texas 
158
158
c 
159
 
c FILE: naup2.F   SID: 1.6   DATE OF SID: 06/01/00   RELEASE: 1
 
159
c FILE: naup2.F   SID: 1.7   DATE OF SID: 10/25/03   RELEASE: 1
160
160
c
161
161
c\Remarks
162
162
c     1. None
192
192
      character  bmat*1, which*2
193
193
      integer    ido, info, ishift, iupd, mode, ldh, ldq, ldv, mxiter,
194
194
     &           n, nev, np
195
 
      Real   
 
195
      Real  
196
196
     &           tol
197
197
c
198
198
c     %-----------------%
200
200
c     %-----------------%
201
201
c
202
202
      integer    ipntr(13)
203
 
      Complex 
 
203
      Complex
204
204
     &           bounds(nev+np), h(ldh,nev+np), q(ldq,nev+np), 
205
205
     &           resid(n), ritz(nev+np),  v(ldv,nev+np), 
206
206
     &           workd(3*n), workl( (nev+np)*(nev+np+3) )
207
 
       Real   
 
207
       Real  
208
208
     &           rwork(nev+np)
209
209
c
210
210
c     %------------%
211
211
c     | Parameters |
212
212
c     %------------%
213
213
c
214
 
      Complex 
 
214
      Complex
215
215
     &           one, zero
216
 
      Real 
 
216
      Real
217
217
     &           rzero
218
 
      parameter (one = (1.0, 0.0) , zero = (0.0, 0.0) ,
219
 
     &           rzero = 0.0 )
 
218
      parameter (one = (1.0, 0.0), zero = (0.0, 0.0),
 
219
     &           rzero = 0.0)
220
220
c
221
221
c     %---------------%
222
222
c     | Local Scalars |
226
226
      integer    ierr ,  iter , kplusp, msglvl, nconv,
227
227
     &           nevbef, nev0 , np0   , nptemp, i    ,
228
228
     &           j
229
 
      Complex 
 
229
      Complex
230
230
     &           cmpnorm
231
 
      Real 
 
231
      Real
232
232
     &           rnorm,  eps23, rtemp
233
233
      character  wprime*2
234
234
c
236
236
     &           rnorm,  iter , kplusp, msglvl, nconv, 
237
237
     &           nevbef, nev0 , np0,    eps23
238
238
c
239
 
 
240
239
c     %-----------------------%
241
240
c     | Local array arguments |
242
241
c     %-----------------------%
254
253
c     | External functions |
255
254
c     %--------------------%
256
255
c
257
 
      Complex 
 
256
      Complex
258
257
     &           cdotc
259
 
      Real   
 
258
      Real  
260
259
     &           pscnorm2, pslamch, slapy2
261
260
      external   cdotc, pscnorm2, pslamch, slapy2
262
261
c
264
263
c     | Intrinsic Functions |
265
264
c     %---------------------%
266
265
c
267
 
      intrinsic  aimag, real , min, max, sqrt
 
266
      intrinsic  aimag, real, min, max, sqrt
268
267
c
269
268
c     %-----------------------%
270
269
c     | Executable Statements |
297
296
c        %---------------------------------%
298
297
c
299
298
         eps23 = pslamch(comm, 'Epsilon-Machine')
300
 
         eps23 = eps23**(2.0  / 3.0 )
 
299
         eps23 = eps23**(2.0 / 3.0)
301
300
c
302
301
c        %---------------------------------------%
303
302
c        | Set flags for computing the first NEV |
500
499
         nconv  = 0
501
500
c
502
501
         do 25 i = 1, nev
503
 
            rtemp = max( eps23, slapy2( real (ritz(np+i)),
 
502
            rtemp = max( eps23, slapy2( real(ritz(np+i)),
504
503
     &                                  aimag(ritz(np+i)) ) )
505
 
            if ( slapy2(real (bounds(np+i)),aimag(bounds(np+i)))
 
504
            if ( slapy2(real(bounds(np+i)),aimag(bounds(np+i)))
506
505
     &                 .le. tol*rtemp ) then
507
506
               nconv = nconv + 1
508
507
            end if
587
586
c           %--------------------------------------------------%
588
587
c
589
588
            do 35 j = 1, nev0
590
 
                rtemp = max( eps23, slapy2( real (ritz(j)),
 
589
                rtemp = max( eps23, slapy2( real(ritz(j)),
591
590
     &                                       aimag(ritz(j)) ) )
592
591
                bounds(j) = bounds(j)/rtemp
593
592
 35         continue
608
607
c           %----------------------------------------------%
609
608
c
610
609
            do 40 j = 1, nev0
611
 
                rtemp = max( eps23, slapy2( real (ritz(j)),
 
610
                rtemp = max( eps23, slapy2( real(ritz(j)),
612
611
     &                                       aimag(ritz(j)) ) )
613
612
                bounds(j) = bounds(j)*rtemp
614
613
 40         continue
770
769
         if (bmat .eq. 'G') then
771
770
            cmpnorm = cdotc (n, resid, 1, workd, 1)
772
771
            call cgsum2d( comm, 'All', ' ', 1, 1, cmpnorm, 1, -1, -1 )
773
 
            rnorm = sqrt(slapy2(real (cmpnorm),aimag(cmpnorm)))
 
772
            rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
774
773
         else if (bmat .eq. 'I') then
775
774
            rnorm = pscnorm2(comm, n, resid, 1)
776
775
         end if