First commit for Zlatko Drmac Contribution - Fixing z precisions issues + modif sent by Zlatko

1 files changed, 55 insertions, 55 deletions

diff --git a/SRC/zgsvj0.f b/SRC/zgsvj0.f
index f1c607d1..a9e663d4 100644
--- a/SRC/zgsvj0.f
+++ b/SRC/zgsvj0.f
@@ -254,20 +254,20 @@
 *     ..
 *     ..
 *     .. Intrinsic Functions ..
-      INTRINSIC ABS, AMAX1, DCONJG, DBLE, MIN0, MAX0, SIGN, SQRT
+      INTRINSIC ABS, DMAX1, DCONJG, DFLOAT, MIN0, DSIGN, DSQRT
 *     ..
 *     .. External Functions ..
       DOUBLE PRECISION   DZNRM2
       COMPLEX*16         ZDOTC
-      INTEGER            IZAMAX
+      INTEGER            IDAMAX
       LOGICAL            LSAME
-      EXTERNAL           IZAMAX, LSAME, ZDOTC, DZNRM2
+      EXTERNAL           IDAMAX, LSAME, ZDOTC, DZNRM2
 *     ..
 *     ..
 *     .. External Subroutines ..
 *     ..
 *     from BLAS
-      EXTERNAL           ZCOPY, ZDROT, ZDSCAL, ZSWAP
+      EXTERNAL           ZCOPY, ZROT, ZSWAP
 *     from LAPACK
       EXTERNAL           ZLASCL, ZLASSQ, XERBLA
 *     ..
@@ -313,13 +313,13 @@
       END IF
       RSVEC = RSVEC .OR. APPLV
 
-      ROOTEPS = SQRT( EPS )
-      ROOTSFMIN = SQRT( SFMIN )
+      ROOTEPS = DSQRT( EPS )
+      ROOTSFMIN = DSQRT( SFMIN )
       SMALL = SFMIN / EPS
       BIG = ONE / SFMIN
       ROOTBIG = ONE / ROOTSFMIN
       BIGTHETA = ONE / ROOTEPS
-      ROOTTOL = SQRT( TOL )
+      ROOTTOL = DSQRT( TOL )
 *
 *     .. Row-cyclic Jacobi SVD algorithm with column pivoting ..
 *
@@ -391,7 +391,7 @@
 *
 *     .. de Rijk's pivoting
 *
-                  q = IZAMAX( N-p+1, SVA( p ), 1 ) + p - 1
+                  q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
                   IF( p.NE.q ) THEN
                      CALL ZSWAP( M, A( 1, p ), 1, A( 1, q ), 1 )
                      IF( RSVEC )CALL ZSWAP( MVL, V( 1, p ), 1,  
@@ -425,7 +425,7 @@
                         TEMP1 = ZERO
                         AAPP = ONE
                         CALL ZLASSQ( M, A( 1, p ), 1, TEMP1, AAPP )
-                        SVA( p ) = TEMP1*SQRT( AAPP )
+                        SVA( p ) = TEMP1*DSQRT( AAPP )
                      END IF
                      AAPP = SVA( p )
                   ELSE
@@ -475,7 +475,7 @@
                            OMPQ = AAPQ / ABS(AAPQ) 
 *                           AAPQ = AAPQ * DCONJG( CWORK(p) ) * CWORK(q) 
                            AAPQ1  = -ABS(AAPQ) 
-                           MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 )
+                           MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
 *
 *        TO rotate or NOT to rotate, THAT is the question ...
 *
@@ -501,39 +501,39 @@
                                     T  = HALF / THETA
                                     CS = ONE
 
-                                    CALL CROT( M, A(1,p), 1, A(1,q), 1,
+                                    CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*T )
                                     IF ( RSVEC ) THEN
-                                        CALL CROT( MVL, V(1,p), 1, 
+                                        CALL ZROT( MVL, V(1,p), 1, 
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*T )
                                     END IF
                                     
-                                    SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,  
+                                    SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO, 
      $                                          ONE+T*APOAQ*AAPQ1 ) )
-                                    AAPP = AAPP*SQRT( AMAX1( ZERO,
+                                    AAPP = AAPP*DSQRT( DMAX1( ZERO,
      $                                          ONE-T*AQOAP*AAPQ1 ) )
-                                    MXSINJ = AMAX1( MXSINJ, ABS( T ) )
+                                    MXSINJ = DMAX1( MXSINJ, ABS( T ) )
 *
                                  ELSE
 *
 *                 .. choose correct signum for THETA and rotate
 *
-                                    THSIGN = -SIGN( ONE, AAPQ1 )
+                                    THSIGN = -DSIGN( ONE, AAPQ1 )
                                     T = ONE / ( THETA+THSIGN*       
-     $                                   SQRT( ONE+THETA*THETA ) )
-                                    CS = SQRT( ONE / ( ONE+T*T ) )
+     $                                   DSQRT( ONE+THETA*THETA ) )
+                                    CS = DSQRT( ONE / ( ONE+T*T ) )
                                     SN = T*CS
 *
-                                    MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
-                                    SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
+                                    MXSINJ = DMAX1( MXSINJ, ABS( SN ) )
+                                    SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
      $                                          ONE+T*APOAQ*AAPQ1 ) )
-                                    AAPP = AAPP*SQRT( AMAX1( ZERO,  
+                                    AAPP = AAPP*DSQRT( DMAX1( ZERO,  
      $                                      ONE-T*AQOAP*AAPQ1 ) )
 *
-                                    CALL CROT( M, A(1,p), 1, A(1,q), 1,
+                                    CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*SN )
                                     IF ( RSVEC ) THEN
-                                        CALL CROT( MVL, V(1,p), 1, 
+                                        CALL ZROT( MVL, V(1,p), 1, 
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*SN )
                                     END IF   
                                  END IF 
@@ -548,13 +548,13 @@
      $                                        IERR )
                                  CALL ZLASCL( 'G', 0, 0, AAQQ, ONE, M,
      $                                        1, A( 1, q ), LDA, IERR )
-                                 CALL CAXPY( M, -AAPQ, WORK, 1,
+                                 CALL ZAXPY( M, -AAPQ, WORK, 1,
      $                                       A( 1, q ), 1 )
                                  CALL ZLASCL( 'G', 0, 0, ONE, AAQQ, M,
      $                                        1, A( 1, q ), LDA, IERR )
-                                 SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
+                                 SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
      $                                      ONE-AAPQ1*AAPQ1 ) )
-                                 MXSINJ = AMAX1( MXSINJ, SFMIN )
+                                 MXSINJ = DMAX1( MXSINJ, SFMIN )
                               END IF
 *           END IF ROTOK THEN ... ELSE
 *
@@ -571,7 +571,7 @@
                                     AAQQ = ONE
                                     CALL ZLASSQ( M, A( 1, q ), 1, T,
      $                                           AAQQ )
-                                    SVA( q ) = T*SQRT( AAQQ )
+                                    SVA( q ) = T*DSQRT( AAQQ )
                                  END IF
                               END IF
                               IF( ( AAPP / AAPP0 ).LE.ROOTEPS ) THEN
@@ -583,7 +583,7 @@
                                     AAPP = ONE
                                     CALL ZLASSQ( M, A( 1, p ), 1, T,
      $                                           AAPP )
-                                    AAPP = T*SQRT( AAPP )
+                                    AAPP = T*DSQRT( AAPP )
                                  END IF
                                  SVA( p ) = AAPP
                               END IF
@@ -696,7 +696,7 @@
                            OMPQ = AAPQ / ABS(AAPQ) 
 *                           AAPQ = AAPQ * DCONJG(CWORK(p))*CWORK(q)   
                            AAPQ1  = -ABS(AAPQ)
-                           MXAAPQ = AMAX1( MXAAPQ, -AAPQ1 )
+                           MXAAPQ = DMAX1( MXAAPQ, -AAPQ1 )
 *
 *        TO rotate or NOT to rotate, THAT is the question ...
 *
@@ -716,37 +716,37 @@
                                  IF( ABS( THETA ).GT.BIGTHETA ) THEN
                                     T  = HALF / THETA
                                     CS = ONE 
-                                    CALL CROT( M, A(1,p), 1, A(1,q), 1,
+                                    CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*T )
                                     IF( RSVEC ) THEN
-                                        CALL CROT( MVL, V(1,p), 1, 
+                                        CALL ZROT( MVL, V(1,p), 1, 
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*T )
                                     END IF
-                                    SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
+                                    SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
      $                                         ONE+T*APOAQ*AAPQ1 ) )
-                                    AAPP = AAPP*SQRT( AMAX1( ZERO,
+                                    AAPP = AAPP*DSQRT( DMAX1( ZERO,
      $                                     ONE-T*AQOAP*AAPQ1 ) )
-                                    MXSINJ = AMAX1( MXSINJ, ABS( T ) )
+                                    MXSINJ = DMAX1( MXSINJ, ABS( T ) )
                                  ELSE
 *
 *                 .. choose correct signum for THETA and rotate
 *
-                                    THSIGN = -SIGN( ONE, AAPQ1 )
+                                    THSIGN = -DSIGN( ONE, AAPQ1 )
                                     IF( AAQQ.GT.AAPP0 )THSIGN = -THSIGN
                                     T = ONE / ( THETA+THSIGN*
-     $                                  SQRT( ONE+THETA*THETA ) )
-                                    CS = SQRT( ONE / ( ONE+T*T ) )
+     $                                  DSQRT( ONE+THETA*THETA ) )
+                                    CS = DSQRT( ONE / ( ONE+T*T ) )
                                     SN = T*CS
-                                    MXSINJ = AMAX1( MXSINJ, ABS( SN ) )
-                                    SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
+                                    MXSINJ = DMAX1( MXSINJ, ABS( SN ) )
+                                    SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
      $                                         ONE+T*APOAQ*AAPQ1 ) )
-                                    AAPP = AAPP*SQRT( AMAX1( ZERO,  
+                                    AAPP = AAPP*DSQRT( DMAX1( ZERO,  
      $                                         ONE-T*AQOAP*AAPQ1 ) )
 *
-                                    CALL CROT( M, A(1,p), 1, A(1,q), 1,
+                                    CALL ZROT( M, A(1,p), 1, A(1,q), 1,
      $                                          CS, DCONJG(OMPQ)*SN ) 
                                     IF( RSVEC ) THEN
-                                        CALL CROT( MVL, V(1,p), 1, 
+                                        CALL ZROT( MVL, V(1,p), 1, 
      $                                  V(1,q), 1, CS, DCONJG(OMPQ)*SN )
                                     END IF
                                  END IF
@@ -763,14 +763,14 @@
                                     CALL ZLASCL( 'G', 0, 0, AAQQ, ONE,
      $                                           M, 1, A( 1, q ), LDA,
      $                                           IERR )
-                                    CALL CAXPY( M, -AAPQ, WORK,
+                                    CALL ZAXPY( M, -AAPQ, WORK,
      $                                          1, A( 1, q ), 1 )
                                     CALL ZLASCL( 'G', 0, 0, ONE, AAQQ,
      $                                           M, 1, A( 1, q ), LDA,
      $                                           IERR )
-                                    SVA( q ) = AAQQ*SQRT( AMAX1( ZERO,
+                                    SVA( q ) = AAQQ*DSQRT( DMAX1( ZERO,
      $                                         ONE-AAPQ1*AAPQ1 ) )
-                                    MXSINJ = AMAX1( MXSINJ, SFMIN )
+                                    MXSINJ = DMAX1( MXSINJ, SFMIN )
                                ELSE
                                    CALL ZCOPY( M, A( 1, q ), 1,
      $                                          WORK, 1 )
@@ -780,14 +780,14 @@
                                     CALL ZLASCL( 'G', 0, 0, AAPP, ONE,
      $                                           M, 1, A( 1, p ), LDA,
      $                                           IERR )
-                                    CALL CAXPY( M, -DCONJG(AAPQ), 
+                                    CALL ZAXPY( M, -DCONJG(AAPQ), 
      $                                   WORK, 1, A( 1, p ), 1 )
                                     CALL ZLASCL( 'G', 0, 0, ONE, AAPP,
      $                                           M, 1, A( 1, p ), LDA,
      $                                           IERR )
-                                    SVA( p ) = AAPP*SQRT( AMAX1( ZERO,
+                                    SVA( p ) = AAPP*DSQRT( DMAX1( ZERO,
      $                                         ONE-AAPQ1*AAPQ1 ) )
-                                    MXSINJ = AMAX1( MXSINJ, SFMIN )
+                                    MXSINJ = DMAX1( MXSINJ, SFMIN )
                                END IF
                               END IF
 *           END IF ROTOK THEN ... ELSE
@@ -804,7 +804,7 @@
                                     AAQQ = ONE
                                     CALL ZLASSQ( M, A( 1, q ), 1, T,
      $                                           AAQQ )
-                                    SVA( q ) = T*SQRT( AAQQ )
+                                    SVA( q ) = T*DSQRT( AAQQ )
                                  END IF
                               END IF
                               IF( ( AAPP / AAPP0 )**2.LE.ROOTEPS ) THEN
@@ -816,7 +816,7 @@
                                     AAPP = ONE
                                     CALL ZLASSQ( M, A( 1, p ), 1, T,
      $                                           AAPP )
-                                    AAPP = T*SQRT( AAPP )
+                                    AAPP = T*DSQRT( AAPP )
                                  END IF
                                  SVA( p ) = AAPP
                               END IF
@@ -881,7 +881,7 @@
             T = ZERO
             AAPP = ONE
             CALL ZLASSQ( M, A( 1, N ), 1, T, AAPP )
-            SVA( N ) = T*SQRT( AAPP )
+            SVA( N ) = T*DSQRT( AAPP )
          END IF
 *
 *     Additional steering devices
@@ -889,8 +889,8 @@
          IF( ( i.LT.SWBAND ) .AND. ( ( MXAAPQ.LE.ROOTTOL ) .OR.
      $       ( ISWROT.LE.N ) ) )SWBAND = i
 *
-         IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.SQRT( DBLE( N ) )*
-     $       TOL ) .AND. ( DBLE( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
+         IF( ( i.GT.SWBAND+1 ) .AND. ( MXAAPQ.LT.DSQRT( DFLOAT( N ) )*
+     $       TOL ) .AND. ( DFLOAT( N )*MXAAPQ*MXSINJ.LT.TOL ) ) THEN
             GO TO 1994
          END IF
 *
@@ -909,11 +909,11 @@
 *
       INFO = 0
 * #:) INFO = 0 confirms successful iterations.
- 1995 CONTINUE
+ 1995  CONTINUE
 *
 *     Sort the vector SVA() of column norms.
       DO 5991 p = 1, N - 1
-         q = IZAMAX( N-p+1, SVA( p ), 1 ) + p - 1
+         q = IDAMAX( N-p+1, SVA( p ), 1 ) + p - 1
          IF( p.NE.q ) THEN
             TEMP1 = SVA( p )
             SVA( p ) = SVA( q )