phynexis-deps/arpack-ng
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[c,z]dotc => [cc,zz]dotc (#346)

Browse Source 
[c,z]dotc => [cc,zz]dotc
This commit is contained in:
prj-
2022-04-17 21:56:24 +02:00
committed by GitHub
parent 7e85cb19ad
commit a5155ee72b
28 changed files with 168 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGES
+4 -1
View File
@@ -1,5 +1,8 @@
arpack-ng - 3.9.0
[ John Doe ]
* Avoid calling [c|z]dotc for better portability on macOS
[ Dima Pasechnik ]
* [BUG FIX] autotools: replace obsolete AC_TRY_COMPILE macros.
* Support for NAG's nagfor Fortran compiler
PARPACK/SRC/BLACS/pcgetv0.f
+4 -4
View File
@@ -197,8 +197,8 @@ c
Real
& pscnorm2, slapy2
Complex
& cdotc
external cdotc, pscnorm2, slapy2
& ccdotc
external ccdotc, pscnorm2, slapy2
c
c %-----------------%
c | Data Statements |
@@ -335,7 +335,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
cnorm = ccdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm0 = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
@@ -394,7 +394,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
cnorm = ccdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt(slapy2(real (cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pcnaitr.f
+5 -5
View File
@@ -303,10 +303,10 @@ c | External Functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& pslamch, pscnorm2, clanhs, slapy2
external cdotc, pscnorm2, clanhs, pslamch, slapy2
external ccdotc, pscnorm2, clanhs, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -573,7 +573,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
@@ -647,7 +647,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
@@ -749,7 +749,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pcnaup2.f
+3 -3
View File
@@ -254,10 +254,10 @@ c | External functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& pscnorm2, pslamch, slapy2
external cdotc, pscnorm2, pslamch, slapy2
external ccdotc, pscnorm2, pslamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -767,7 +767,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm = cdotc (n, resid, 1, workd, 1)
cmpnorm = ccdotc (n, resid, 1, workd, 1)
call cgsum2d( comm, 'All', ' ', 1, 1, cmpnorm, 1, -1, -1 )
rnorm = sqrt(slapy2(real(cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pcneupd.f
+3 -3
View File
@@ -340,8 +340,8 @@ c
external scnrm2,pslamch,slapy2
c
Complex
& cdotc
external cdotc
& ccdotc
external ccdotc
c
c %---------------------%
c | Intrinsic Functions |
@@ -743,7 +743,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
workev(j) = ccdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
PARPACK/SRC/BLACS/pzgetv0.f
+4 -4
View File
@@ -197,8 +197,8 @@ c
Double precision
& pdznorm2 , dlapy2
Complex*16
& zdotc
external zdotc , pdznorm2 , dlapy2
& zzdotc
external zzdotc , pdznorm2 , dlapy2
c
c %-----------------%
c | Data Statements |
@@ -335,7 +335,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
cnorm = zzdotc (n, resid, 1, workd, 1)
call zgsum2d ( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm0 = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
@@ -394,7 +394,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
cnorm = zzdotc (n, resid, 1, workd, 1)
call zgsum2d ( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt(dlapy2 (dble (cnorm),dimag (cnorm)))
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pznaitr.f
+5 -5
View File
@@ -303,10 +303,10 @@ c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& pdlamch, pdznorm2, zlanhs, dlapy2
external zdotc, pdznorm2, zlanhs, pdlamch, dlapy2
external zzdotc, pdznorm2, zlanhs, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -573,7 +573,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
@@ -647,7 +647,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
@@ -749,7 +749,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cnorm, 1, -1, -1 )
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pznaup2.f
+3 -3
View File
@@ -254,10 +254,10 @@ c | External functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& pdznorm2, pdlamch, dlapy2
external zdotc, pdznorm2, pdlamch, dlapy2
external zzdotc, pdznorm2, pdlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -767,7 +767,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm = zdotc (n, resid, 1, workd, 1)
cmpnorm = zzdotc (n, resid, 1, workd, 1)
call zgsum2d( comm, 'All', ' ', 1, 1, cmpnorm, 1, -1, -1 )
rnorm = sqrt(dlapy2(dble(cmpnorm),dimag(cmpnorm)))
else if (bmat .eq. 'I') then
PARPACK/SRC/BLACS/pzneupd.f
+3 -3
View File
@@ -340,8 +340,8 @@ c
external dznrm2,pdlamch,dlapy2
c
Complex*16
& zdotc
external zdotc
& zzdotc
external zzdotc
c
c %---------------------%
c | Intrinsic Functions |
@@ -743,7 +743,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
workev(j) = zzdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
PARPACK/SRC/MPI/pcgetv0.f
+4 -4
View File
@@ -200,8 +200,8 @@ c
Real
& pscnorm2, slapy2
Complex
& cdotc
external cdotc, pscnorm2, slapy2
& ccdotc
external ccdotc, pscnorm2, slapy2
c
c %-----------------%
c | Data Statements |
@@ -331,7 +331,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
cnorm_buf = ccdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -393,7 +393,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd, 1)
cnorm_buf = ccdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
PARPACK/SRC/MPI/pcnaitr.f
+5 -5
View File
@@ -307,10 +307,10 @@ c | External Functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& pslamch10, pscnorm2, clanhs, slapy2
external cdotc, pscnorm2, clanhs, pslamch10, slapy2
external ccdotc, pscnorm2, clanhs, pslamch10, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -576,7 +576,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = ccdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -653,7 +653,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = ccdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -758,7 +758,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = cdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = ccdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
PARPACK/SRC/MPI/pcnaup2.f
+3 -3
View File
@@ -257,10 +257,10 @@ c | External functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& pscnorm2, pslamch10, slapy2
external cdotc, pscnorm2, pslamch10, slapy2
external ccdotc, pscnorm2, pslamch10, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -770,7 +770,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm_buf = cdotc (n, resid, 1, workd, 1)
cmpnorm_buf = ccdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1,
& MPI_COMPLEX, MPI_SUM, comm, ierr )
cmpnorm = buf2(1)
PARPACK/SRC/MPI/pcneupd.f
+3 -3
View File
@@ -340,8 +340,8 @@ c
external scnrm2,pslamch10,slapy2
c
Complex
& cdotc
external cdotc
& ccdotc
external ccdotc
c
c %---------------------%
c | Intrinsic Functions |
@@ -743,7 +743,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
workev(j) = ccdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
PARPACK/SRC/MPI/pzgetv0.f
+4 -4
View File
@@ -200,8 +200,8 @@ c
Double precision
& pdznorm2 , dlapy2
Complex*16
& zdotc
external zdotc , pdznorm2 , dlapy2
& zzdotc
external zzdotc , pdznorm2 , dlapy2
c
c %-----------------%
c | Data Statements |
@@ -331,7 +331,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
cnorm_buf = zzdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -393,7 +393,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd, 1)
cnorm_buf = zzdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX , MPI_SUM, comm, ierr )
cnorm = buf2(1)
PARPACK/SRC/MPI/pznaitr.f
+5 -5
View File
@@ -307,10 +307,10 @@ c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& pdlamch10, pdznorm2, zlanhs, dlapy2
external zdotc, pdznorm2, zlanhs, pdlamch10, dlapy2
external zzdotc, pdznorm2, zlanhs, pdlamch10, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -576,7 +576,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = zzdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -653,7 +653,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = zzdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
@@ -758,7 +758,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm_buf = zdotc (n, resid, 1, workd(ipj), 1)
cnorm_buf = zzdotc (n, resid, 1, workd(ipj), 1)
call MPI_ALLREDUCE( [cnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cnorm = buf2(1)
PARPACK/SRC/MPI/pznaup2.f
+3 -3
View File
@@ -257,10 +257,10 @@ c | External functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& pdznorm2, pdlamch10, dlapy2
external zdotc, pdznorm2, pdlamch10, dlapy2
external zzdotc, pdznorm2, pdlamch10, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -770,7 +770,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm_buf = zdotc (n, resid, 1, workd, 1)
cmpnorm_buf = zzdotc (n, resid, 1, workd, 1)
call MPI_ALLREDUCE( [cmpnorm_buf], buf2, 1,
& MPI_DOUBLE_COMPLEX, MPI_SUM, comm, ierr )
cmpnorm = buf2(1)
PARPACK/SRC/MPI/pzneupd.f
+3 -3
View File
@@ -340,8 +340,8 @@ c
external dznrm2,pdlamch10,dlapy2
c
Complex*16
& zdotc
external zdotc
& zzdotc
external zzdotc
c
c %---------------------%
c | Intrinsic Functions |
@@ -743,7 +743,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
workev(j) = zzdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
SRC/Makefile.am
+2 -2
View File
@@ -9,10 +9,10 @@ DSRC = dnaitr.f dnapps.f dnaup2.f dnaupd.f dnconv.f dneigh.f dneupd.f dngets.f d
dgetv0.f dsortc.f dsortr.f dsesrt.f dstqrb.f
CSRC = cnaitr.f cnapps.f cnaup2.f cnaupd.f cneigh.f cneupd.f cngets.f cstatn.f \
cgetv0.f csortc.f
cgetv0.f csortc.f ccdotc.f
ZSRC = znaitr.f znapps.f znaup2.f znaupd.f zneigh.f zneupd.f zngets.f zstatn.f \
zgetv0.f zsortc.f
zgetv0.f zsortc.f zzdotc.f
if ICB
SSRC += icbass.F90 icbasn.F90
SRC/ccdotc.f
+36
View File
@@ -0,0 +1,36 @@
complex function ccdotc(n,zx,incx,zy,incy)
c
c forms the dot product of a vector.
c jack dongarra, 3/11/78.
c modified 12/3/93, array(1) declarations changed to array(*)
c
complex zx(*),zy(*),ztemp
integer i,incx,incy,ix,iy,n
ztemp = (0.0d0,0.0d0)
ccdotc = (0.0d0,0.0d0)
if(n.le.0)return
if(incx.eq.1.and.incy.eq.1)go to 20
c
c code for unequal increments or equal increments
c not equal to 1
c
ix = 1
iy = 1
if(incx.lt.0)ix = (-n+1)*incx + 1
if(incy.lt.0)iy = (-n+1)*incy + 1
do 10 i = 1,n
ztemp = ztemp + conjg(zx(ix))*zy(iy)
ix = ix + incx
iy = iy + incy
10 continue
ccdotc = ztemp
return
c
c code for both increments equal to 1
c
20 do 30 i = 1,n
ztemp = ztemp + conjg(zx(i))*zy(i)
30 continue
ccdotc = ztemp
return
end
SRC/cgetv0.f
+4 -4
View File
@@ -177,8 +177,8 @@ c
Real
& scnrm2, slapy2
Complex
& cdotc
external cdotc, scnrm2, slapy2
& ccdotc
external ccdotc, scnrm2, slapy2
c
c %-----------------%
c | Data Statements |
@@ -293,7 +293,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
cnorm = ccdotc (n, resid, 1, workd, 1)
rnorm0 = sqrt(slapy2(real(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = scnrm2(n, resid, 1)
@@ -350,7 +350,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd, 1)
cnorm = ccdotc (n, resid, 1, workd, 1)
rnorm = sqrt(slapy2(real(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
SRC/cnaitr.f
+5 -5
View File
@@ -280,10 +280,10 @@ c | External Functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& slamch, scnrm2, clanhs, slapy2
external cdotc, scnrm2, clanhs, slamch, slapy2
external ccdotc, scnrm2, clanhs, slamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -550,7 +550,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
wnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = scnrm2(n, resid, 1)
@@ -622,7 +622,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
rnorm = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
@@ -722,7 +722,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = cdotc (n, resid, 1, workd(ipj), 1)
cnorm = ccdotc (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt( slapy2(real(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = scnrm2(n, resid, 1)
SRC/cnaup2.f
+3 -3
View File
@@ -247,10 +247,10 @@ c | External functions |
c %--------------------%
c
Complex
& cdotc
& ccdotc
Real
& scnrm2, slamch, slapy2
external cdotc, scnrm2, slamch, slapy2
external ccdotc, scnrm2, slamch, slapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -754,7 +754,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm = cdotc (n, resid, 1, workd, 1)
cmpnorm = ccdotc (n, resid, 1, workd, 1)
rnorm = sqrt(slapy2(real (cmpnorm),aimag(cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = scnrm2(n, resid, 1)
SRC/cneupd.f
+3 -3
View File
@@ -325,8 +325,8 @@ c
external scnrm2, slamch, slapy2
c
Complex
& cdotc
external cdotc
& ccdotc
external ccdotc
c
c %-----------------------%
c | Executable Statements |
@@ -731,7 +731,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = cdotc(j, workl(ihbds), 1,
workev(j) = ccdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
SRC/zgetv0.f
+4 -4
View File
@@ -177,8 +177,8 @@ c
Double precision
& dznrm2, dlapy2
Complex*16
& zdotc
external zdotc, dznrm2, dlapy2
& zzdotc
external zzdotc, dznrm2, dlapy2
c
c %-----------------%
c | Data Statements |
@@ -293,7 +293,7 @@ c
c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
cnorm = zzdotc (n, resid, 1, workd, 1)
rnorm0 = sqrt(dlapy2(dble(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = dznrm2(n, resid, 1)
@@ -350,7 +350,7 @@ c
end if
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
cnorm = zzdotc (n, resid, 1, workd, 1)
rnorm = sqrt(dlapy2(dble(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
SRC/znaitr.f
+5 -5
View File
@@ -280,10 +280,10 @@ c | External Functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& dlamch, dznrm2, zlanhs, dlapy2
external zdotc, dznrm2, zlanhs, dlamch, dlapy2
external zzdotc, dznrm2, zlanhs, dlamch, dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -550,7 +550,7 @@ c | Compute the B-norm of OP*v_{j}. |
c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
wnorm = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = dznrm2(n, resid, 1)
@@ -622,7 +622,7 @@ c | Compute the B-norm of r_{j}. |
c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
rnorm = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
@@ -722,7 +722,7 @@ c | Compute the B-norm of the corrected residual r_{j}. |
c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
cnorm = zzdotc (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = dznrm2(n, resid, 1)
SRC/znaup2.f
+3 -3
View File
@@ -247,10 +247,10 @@ c | External functions |
c %--------------------%
c
Complex*16
& zdotc
& zzdotc
Double precision
& dznrm2 , dlamch , dlapy2
external zdotc , dznrm2 , dlamch , dlapy2
external zzdotc , dznrm2 , dlamch , dlapy2
c
c %---------------------%
c | Intrinsic Functions |
@@ -754,7 +754,7 @@ c
end if
c
if (bmat .eq. 'G') then
cmpnorm = zdotc (n, resid, 1, workd, 1)
cmpnorm = zzdotc (n, resid, 1, workd, 1)
rnorm = sqrt(dlapy2 (dble (cmpnorm),aimag (cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = dznrm2 (n, resid, 1)
SRC/zneupd.f
+3 -3
View File
@@ -325,8 +325,8 @@ c
external dznrm2, dlamch, dlapy2
c
Complex*16
& zdotc
external zdotc
& zzdotc
external zzdotc
c
c %-----------------------%
c | Executable Statements |
@@ -731,7 +731,7 @@ c | upper triangular, thus the length of the |
c | inner product can be set to j. |
c %------------------------------------------%
c
workev(j) = zdotc(j, workl(ihbds), 1,
workev(j) = zzdotc(j, workl(ihbds), 1,
& workl(invsub+(j-1)*ldq), 1)
40 continue
c
SRC/zzdotc.f
+36
View File
@@ -0,0 +1,36 @@
double complex function zzdotc(n,zx,incx,zy,incy)
c
c forms the dot product of a vector.
c jack dongarra, 3/11/78.
c modified 12/3/93, array(1) declarations changed to array(*)
c
double complex zx(*),zy(*),ztemp
integer i,incx,incy,ix,iy,n
ztemp = (0.0d0,0.0d0)
zzdotc = (0.0d0,0.0d0)
if(n.le.0)return
if(incx.eq.1.and.incy.eq.1)go to 20
c
c code for unequal increments or equal increments
c not equal to 1
c
ix = 1
iy = 1
if(incx.lt.0)ix = (-n+1)*incx + 1
if(incy.lt.0)iy = (-n+1)*incy + 1
do 10 i = 1,n
ztemp = ztemp + conjg(zx(ix))*zy(iy)
ix = ix + incx
iy = iy + incy
10 continue
zzdotc = ztemp
return
c
c code for both increments equal to 1
c
20 do 30 i = 1,n
ztemp = ztemp + conjg(zx(i))*zy(i)
30 continue
zzdotc = ztemp
return
end