Fortran intrinsic: replace non standard (dimag) function with standar…

…d (aimag) one. (#318)

Fortran intrinsic: replace non standard (dimag) function with standard (aimag) one. Nagfor compiler fix.

CHANGES

@@ -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

@@ -294,7 +294,7 @@ subroutine zgetv0
       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 @@ subroutine zgetv0
 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

@@ -289,7 +289,7 @@ subroutine znaitr
 c     | Intrinsic Functions |
 c     %---------------------%
 c
-      intrinsic  dimag, dble, max, sqrt
+      intrinsic  aimag, dble, max, sqrt
 c
 c     %-----------------%
 c     | Data statements |
@@ -551,7 +551,7 @@ subroutine znaitr
 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 @@ subroutine znaitr
          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 @@ subroutine znaitr
 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 @@ subroutine znaitr
 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 @@ subroutine znaitr
 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

@@ -198,15 +198,15 @@ subroutine znapps
 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 |
 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 @@ subroutine znapps
 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

@@ -256,7 +256,7 @@ subroutine znaup2
 c     | Intrinsic Functions |
 c     %---------------------%
 c
-      intrinsic  dimag , dble , min, max
+      intrinsic  aimag , dble , min, max
 c
 c     %-----------------------%
 c     | Executable Statements |
@@ -489,8 +489,8 @@ subroutine znaup2
 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 @@ subroutine znaup2
 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 @@ subroutine znaup2
 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 @@ subroutine znaup2
 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 @@ subroutine znaup2
 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

@@ -516,11 +516,11 @@ subroutine zneupd(rvec , howmny, select, d     ,
          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

@@ -96,7 +96,7 @@ subroutine zsortc (which, apply, n, x, y)
 c     | Intrinsic Functions |
 c     %--------------------%
        Intrinsic
-     &           dble, dimag
+     &           dble, aimag
 c
 c     %-----------------------%
 c     | Executable Statements |
@@ -119,8 +119,8 @@ subroutine zsortc (which, apply, n, x, y)
 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 @@ subroutine zsortc (which, apply, n, x, y)
 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 @@ subroutine zsortc (which, apply, n, x, y)
 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 @@ subroutine zsortc (which, apply, n, x, y)
 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