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

Fortran intrinsic: replace non standard (dimag) function with standard (aimag) one. (#318)

Browse Source 
Fortran intrinsic: replace non standard (dimag) function with standard (aimag) one. Nagfor compiler fix.
This commit is contained in:
Dima Pasechnik
2021-10-17 19:34:40 +02:00
committed by GitHub
parent 9cd6c25cb9
commit 645db9e647
7 changed files with 32 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGES
+1 -1
View File
@@ -2,7 +2,7 @@ arpack-ng - 3.9.0
[ Dima Pasechnik ]
* [BUG FIX] autotools: replace obsolete AC_TRY_COMPILE macros.
* Support for NAG's nagfor Fortran compiler
[ Franck Houssen ]
* [BUG FIX] autotools: ICB must be checked first (MPI changes compilers).
SRC/zgetv0.f
+2 -2
View File
@@ -294,7 +294,7 @@ c
first = .FALSE.
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
rnorm0 = sqrt(dlapy2(dble(cnorm),dimag(cnorm)))
rnorm0 = sqrt(dlapy2(dble(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm0 = dznrm2(n, resid, 1)
end if
@@ -351,7 +351,7 @@ c
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd, 1)
rnorm = sqrt(dlapy2(dble(cnorm),dimag(cnorm)))
rnorm = sqrt(dlapy2(dble(cnorm),aimag(cnorm)))
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
end if
SRC/znaitr.f
+8 -8
View File
@@ -289,7 +289,7 @@ c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag, dble, max, sqrt
intrinsic aimag, dble, max, sqrt
c
c %-----------------%
c | Data statements |
@@ -551,7 +551,7 @@ c %-------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
wnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
wnorm = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
wnorm = dznrm2(n, resid, 1)
end if
@@ -581,7 +581,7 @@ c
call zgemv ('N', n, j, -one, v, ldv, h(1,j), 1,
& one, resid, 1)
c
if (j .gt. 1) h(j,j-1) = dcmplx(betaj, rzero)
if (j .gt. 1) h(j,j-1) = cmplx(betaj, rzero, Kind=Kind(0d0))
c
call arscnd (t4)
c
@@ -623,7 +623,7 @@ c %------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
rnorm = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
rnorm = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm = dznrm2(n, resid, 1)
end if
@@ -723,7 +723,7 @@ c %-----------------------------------------------------%
c
if (bmat .eq. 'G') then
cnorm = zdotc (n, resid, 1, workd(ipj), 1)
rnorm1 = sqrt( dlapy2(dble(cnorm),dimag(cnorm)) )
rnorm1 = sqrt( dlapy2(dble(cnorm),aimag(cnorm)) )
else if (bmat .eq. 'I') then
rnorm1 = dznrm2(n, resid, 1)
end if
@@ -811,11 +811,11 @@ c | Use a standard test as in the QR algorithm |
c | REFERENCE: LAPACK subroutine zlahqr |
c %--------------------------------------------%
c
tst1 = dlapy2(dble(h(i,i)),dimag(h(i,i)))
& + dlapy2(dble(h(i+1,i+1)), dimag(h(i+1,i+1)))
tst1 = dlapy2(dble(h(i,i)),aimag(h(i,i)))
& + dlapy2(dble(h(i+1,i+1)), aimag(h(i+1,i+1)))
if( tst1.eq.dble(zero) )
& tst1 = zlanhs( '1', k+np, h, ldh, workd(n+1) )
if( dlapy2(dble(h(i+1,i)),dimag(h(i+1,i))) .le.
if( dlapy2(dble(h(i+1,i)),aimag(h(i+1,i))) .le.
& max( ulp*tst1, smlnum ) )
& h(i+1,i) = zero
110 continue
SRC/znapps.f
+5 -5
View File
@@ -198,7 +198,7 @@ c %----------------------%
c | Intrinsics Functions |
c %----------------------%
c
intrinsic abs, dimag, conjg, dcmplx, max, min, dble
intrinsic abs, aimag, conjg, cmplx, max, min, dble
c
c %---------------------%
c | Statement Functions |
@@ -206,7 +206,7 @@ c %---------------------%
c
Double precision
& zabs1
zabs1( cdum ) = abs( dble( cdum ) ) + abs( dimag( cdum ) )
zabs1( cdum ) = abs( dble( cdum ) ) + abs( aimag( cdum ) )
c
c %----------------%
c | Data statements |
@@ -405,12 +405,12 @@ c %---------------------------------------------------%
c
do 120 j=1,kev
if ( dble( h(j+1,j) ) .lt. rzero .or.
& dimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / dlapy2(dble(h(j+1,j)),dimag(h(j+1,j)))
& aimag( h(j+1,j) ) .ne. rzero ) then
t = h(j+1,j) / dlapy2(dble(h(j+1,j)),aimag(h(j+1,j)))
call zscal( kplusp-j+1, conjg(t), h(j+1,j), ldh )
call zscal( min(j+2, kplusp), t, h(1,j+1), 1 )
call zscal( min(j+np+1,kplusp), t, q(1,j+1), 1 )
h(j+1,j) = dcmplx( dble( h(j+1,j) ), rzero )
h(j+1,j) = cmplx( dble( h(j+1,j) ), rzero, Kind=Kind(0d0) )
end if
120 continue
c
SRC/znaup2.f
+7 -7
View File
@@ -256,7 +256,7 @@ c %---------------------%
c | Intrinsic Functions |
c %---------------------%
c
intrinsic dimag , dble , min, max
intrinsic aimag , dble , min, max
c
c %-----------------------%
c | Executable Statements |
@@ -489,8 +489,8 @@ c
c
do 25 i = 1, nev
rtemp = max( eps23, dlapy2 ( dble (ritz(np+i)),
& dimag (ritz(np+i)) ) )
if ( dlapy2 (dble (bounds(np+i)),dimag (bounds(np+i)))
& aimag (ritz(np+i)) ) )
if ( dlapy2 (dble (bounds(np+i)),aimag (bounds(np+i)))
& .le. tol*rtemp ) then
nconv = nconv + 1
end if
@@ -550,7 +550,7 @@ c | Use h( 3,1 ) as storage to communicate |
c | rnorm to zneupd if needed |
c %------------------------------------------%
h(3,1) = dcmplx (rnorm,rzero)
h(3,1) = cmplx (rnorm,rzero,Kind=Kind(0d0))
c
c %----------------------------------------------%
c | Sort Ritz values so that converged Ritz |
@@ -575,7 +575,7 @@ c %--------------------------------------------------%
c
do 35 j = 1, nev0
rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
& dimag (ritz(j)) ) )
& aimag (ritz(j)) ) )
bounds(j) = bounds(j)/rtemp
35 continue
c
@@ -596,7 +596,7 @@ c %----------------------------------------------%
c
do 40 j = 1, nev0
rtemp = max( eps23, dlapy2 ( dble (ritz(j)),
& dimag (ritz(j)) ) )
& aimag (ritz(j)) ) )
bounds(j) = bounds(j)*rtemp
40 continue
c
@@ -755,7 +755,7 @@ c
c
if (bmat .eq. 'G') then
cmpnorm = zdotc (n, resid, 1, workd, 1)
rnorm = sqrt(dlapy2 (dble (cmpnorm),dimag (cmpnorm)))
rnorm = sqrt(dlapy2 (dble (cmpnorm),aimag (cmpnorm)))
else if (bmat .eq. 'I') then
rnorm = dznrm2 (n, resid, 1)
end if
SRC/zneupd.f
+2 -2
View File
@@ -516,11 +516,11 @@ c
do 11 j = 1,ncv
rtemp = max(eps23,
& dlapy2 ( dble(workl(irz+ncv-j)),
& dimag(workl(irz+ncv-j)) ))
& aimag(workl(irz+ncv-j)) ))
jj = workl(bounds + ncv - j)
if (numcnv .lt. nconv .and.
& dlapy2( dble(workl(ibd+jj-1)),
& dimag(workl(ibd+jj-1)) )
& aimag(workl(ibd+jj-1)) )
& .le. tol*rtemp) then
select(jj) = .true.
numcnv = numcnv + 1
SRC/zsortc.f
+7 -7
View File
@@ -96,7 +96,7 @@ c %--------------------%
c | Intrinsic Functions |
c %--------------------%
Intrinsic
& dble, dimag
& dble, aimag
c
c %-----------------------%
c | Executable Statements |
@@ -119,8 +119,8 @@ c
c
if (j.lt.0) go to 30
c
temp1 = dlapy2(dble(x(j)),dimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap)))
temp1 = dlapy2(dble(x(j)),aimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),aimag(x(j+igap)))
c
if (temp1.gt.temp2) then
temp = x(j)
@@ -156,8 +156,8 @@ c
c
if (j .lt. 0) go to 60
c
temp1 = dlapy2(dble(x(j)),dimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),dimag(x(j+igap)))
temp1 = dlapy2(dble(x(j)),aimag(x(j)))
temp2 = dlapy2(dble(x(j+igap)),aimag(x(j+igap)))
c
if (temp1.lt.temp2) then
temp = x(j)
@@ -259,7 +259,7 @@ c
c
if (j.lt.0) go to 150
c
if (dimag(x(j)).gt.dimag(x(j+igap))) then
if (aimag(x(j)).gt.aimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp
@@ -292,7 +292,7 @@ c
c
if (j.lt.0) go to 180
c
if (dimag(x(j)).lt.dimag(x(j+igap))) then
if (aimag(x(j)).lt.aimag(x(j+igap))) then
temp = x(j)
x(j) = x(j+igap)
x(j+igap) = temp