Merge pull request #543 from Matthew-Badin/dev/explicit-cast

Add Explicit Casts For Complex To Real Cases
Reference-LAPACK · May 3, 2021 · 2dafa3d · 2dafa3d
2 parents 7b16a30 + c1b96f8
commit 2dafa3d
Show file tree

Hide file tree

Showing 86 changed files with 265 additions and 260 deletions.
diff --git a/SRC/cgebd2.f b/SRC/cgebd2.f
@@ -245,7 +245,7 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             ALPHA = A( I, I )
             CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
      $                   TAUQ( I ) )
-            D( I ) = ALPHA
+            D( I ) = REAL( ALPHA )
             A( I, I ) = ONE
 *
 *           Apply H(i)**H to A(i:m,i+1:n) from the left
@@ -264,7 +264,7 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                ALPHA = A( I, I+1 )
                CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ),
      $                      LDA, TAUP( I ) )
-               E( I ) = ALPHA
+               E( I ) = REAL( ALPHA )
                A( I, I+1 ) = ONE
 *
 *              Apply G(i) to A(i+1:m,i+1:n) from the right
@@ -289,7 +289,7 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             ALPHA = A( I, I )
             CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
      $                   TAUP( I ) )
-            D( I ) = ALPHA
+            D( I ) = REAL( ALPHA )
             A( I, I ) = ONE
 *
 *           Apply G(i) to A(i+1:m,i:n) from the right
@@ -308,7 +308,7 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                ALPHA = A( I+1, I )
                CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
      $                      TAUQ( I ) )
-               E( I ) = ALPHA
+               E( I ) = REAL( ALPHA )
                A( I+1, I ) = ONE
 *
 *              Apply H(i)**H to A(i+1:m,i+1:n) from the left

diff --git a/SRC/cgees.f b/SRC/cgees.f
@@ -282,7 +282,7 @@ SUBROUTINE CGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS,
 *
             CALL CHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
      $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
+            HSWORK = REAL( WORK( 1 ) )
 *
             IF( .NOT.WANTVS ) THEN
                MAXWRK = MAX( MAXWRK, HSWORK )

diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f
@@ -337,7 +337,7 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W,
 *
             CALL CHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
      $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
+            HSWORK = REAL( WORK( 1 ) )
 *
             IF( .NOT.WANTVS ) THEN
                MAXWRK = MAX( MAXWRK, HSWORK )

diff --git a/SRC/cgejsv.f b/SRC/cgejsv.f
@@ -704,11 +704,11 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
           IF ( LQUERY ) THEN 
               CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, 
      $             RDUMMY, IERR )
-              LWRK_CGEQP3 = CDUMMY(1)
+              LWRK_CGEQP3 = REAL( CDUMMY(1) )
               CALL CGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
-              LWRK_CGEQRF = CDUMMY(1)
+              LWRK_CGEQRF = REAL( CDUMMY(1) )
               CALL CGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
-              LWRK_CGELQF = CDUMMY(1)             
+              LWRK_CGELQF = REAL( CDUMMY(1) )
           END IF
           MINWRK  = 2
           OPTWRK  = 2
@@ -724,7 +724,7 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
               IF ( LQUERY ) THEN 
                   CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, 
      $                 LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                  LWRK_CGESVJ = CDUMMY(1)
+                  LWRK_CGESVJ = REAL( CDUMMY(1) )
                   IF ( ERREST ) THEN 
                       OPTWRK = MAX( N+LWRK_CGEQP3, N**2+LWCON, 
      $                              N+LWRK_CGEQRF, LWRK_CGESVJ )
@@ -760,10 +760,10 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
      $                LDA, CDUMMY, -1, RDUMMY, -1, IERR )
-                 LWRK_CGESVJ = CDUMMY(1)
+                 LWRK_CGESVJ = REAL( CDUMMY(1) )
                  CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
      $                V, LDV, CDUMMY, -1, IERR )
-                 LWRK_CUNMLQ = CDUMMY(1)                
+                 LWRK_CUNMLQ = REAL( CDUMMY(1) )
                  IF ( ERREST ) THEN 
                  OPTWRK = MAX( N+LWRK_CGEQP3, LWCON, LWRK_CGESVJ, 
      $                         N+LWRK_CGELQF, 2*N+LWRK_CGEQRF,
@@ -799,10 +799,10 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
      $                LDA, CDUMMY, -1, RDUMMY, -1, IERR )
-                 LWRK_CGESVJ = CDUMMY(1)
+                 LWRK_CGESVJ = REAL( CDUMMY(1) )
                  CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $               LDU, CDUMMY, -1, IERR )
-                 LWRK_CUNMQRM = CDUMMY(1)
+                 LWRK_CUNMQRM = REAL( CDUMMY(1) )
                  IF ( ERREST ) THEN
                  OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, N+LWRK_CGEQRF,
      $                             LWRK_CGESVJ, LWRK_CUNMQRM )
@@ -861,26 +861,26 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $                LDU, CDUMMY, -1, IERR )
-                 LWRK_CUNMQRM = CDUMMY(1)
+                 LWRK_CUNMQRM = REAL( CDUMMY(1) )
                  CALL CUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,
      $                LDU, CDUMMY, -1, IERR )
-                 LWRK_CUNMQR = CDUMMY(1)
+                 LWRK_CUNMQR = REAL( CDUMMY(1) )
                  IF ( .NOT. JRACC ) THEN
                      CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,
      $                    RDUMMY, IERR )
-                     LWRK_CGEQP3N = CDUMMY(1)
+                     LWRK_CGEQP3N = REAL( CDUMMY(1) )
                      CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_CGESVJ = CDUMMY(1)
+                     LWRK_CGESVJ = REAL( CDUMMY(1) )
                      CALL CGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_CGESVJU = CDUMMY(1)
+                     LWRK_CGESVJU = REAL( CDUMMY(1) )
                      CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_CGESVJV = CDUMMY(1)
+                     LWRK_CGESVJV = REAL( CDUMMY(1) )
                      CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
      $                    V, LDV, CDUMMY, -1, IERR )
-                     LWRK_CUNMLQ = CDUMMY(1)
+                     LWRK_CUNMLQ = REAL( CDUMMY(1) )
                      IF ( ERREST ) THEN 
                        OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, 
      $                          2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, 
@@ -909,13 +909,13 @@ SUBROUTINE CGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
                  ELSE
                      CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_CGESVJV = CDUMMY(1)
+                     LWRK_CGESVJV = REAL( CDUMMY(1) )
                      CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,
      $                    V, LDV, CDUMMY, -1, IERR )
-                     LWRK_CUNMQR = CDUMMY(1)
+                     LWRK_CUNMQR = REAL( CDUMMY(1) )
                      CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $                    LDU, CDUMMY, -1, IERR )
-                     LWRK_CUNMQRM = CDUMMY(1)   
+                     LWRK_CUNMQRM = REAL( CDUMMY(1) )
                      IF ( ERREST ) THEN 
                         OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON,   
      $                           2*N+LWRK_CGEQRF, 2*N+N**2,  

diff --git a/SRC/cgelss.f b/SRC/cgelss.f
@@ -266,11 +266,11 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *
 *              Compute space needed for CGEQRF
                CALL CGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
-               LWORK_CGEQRF=DUM(1)
+               LWORK_CGEQRF = REAL( DUM(1) )
 *              Compute space needed for CUNMQR
                CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, DUM(1), B,
      $                   LDB, DUM(1), -1, INFO )
-               LWORK_CUNMQR=DUM(1)
+               LWORK_CUNMQR = REAL( DUM(1) )
                MM = N
                MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'CGEQRF', ' ', M,
      $                       N, -1, -1 ) )
@@ -284,15 +284,15 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *              Compute space needed for CGEBRD
                CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1),
      $                      -1, INFO )
-               LWORK_CGEBRD=DUM(1)
+               LWORK_CGEBRD = REAL( DUM(1) )
 *              Compute space needed for CUNMBR
                CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1),
      $                B, LDB, DUM(1), -1, INFO )
-               LWORK_CUNMBR=DUM(1)
+               LWORK_CUNMBR = REAL( DUM(1) )
 *              Compute space needed for CUNGBR
                CALL CUNGBR( 'P', N, N, N, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-               LWORK_CUNGBR=DUM(1)
+               LWORK_CUNGBR = REAL( DUM(1) )
 *              Compute total workspace needed
                MAXWRK = MAX( MAXWRK, 2*N + LWORK_CGEBRD )
                MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR )
@@ -310,23 +310,23 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *                 Compute space needed for CGELQF
                   CALL CGELQF( M, N, A, LDA, DUM(1), DUM(1),
      $                -1, INFO )
-                  LWORK_CGELQF=DUM(1)
+                  LWORK_CGELQF = REAL( DUM(1) )
 *                 Compute space needed for CGEBRD
                   CALL CGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1),
      $                         DUM(1), -1, INFO )
-                  LWORK_CGEBRD=DUM(1)
+                  LWORK_CGEBRD = REAL( DUM(1) )
 *                 Compute space needed for CUNMBR
                   CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA,
      $                DUM(1), B, LDB, DUM(1), -1, INFO )
-                  LWORK_CUNMBR=DUM(1)
+                  LWORK_CUNMBR = REAL( DUM(1) )
 *                 Compute space needed for CUNGBR
                   CALL CUNGBR( 'P', M, M, M, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-                  LWORK_CUNGBR=DUM(1)
+                  LWORK_CUNGBR = REAL( DUM(1) )
 *                 Compute space needed for CUNMLQ
                   CALL CUNMLQ( 'L', 'C', N, NRHS, M, A, LDA, DUM(1),
      $                 B, LDB, DUM(1), -1, INFO )
-                  LWORK_CUNMLQ=DUM(1)
+                  LWORK_CUNMLQ = REAL( DUM(1) )
 *                 Compute total workspace needed
                   MAXWRK = M + LWORK_CGELQF
                   MAXWRK = MAX( MAXWRK, 3*M + M*M + LWORK_CGEBRD )
@@ -345,15 +345,15 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *                 Compute space needed for CGEBRD
                   CALL CGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1),
      $                         DUM(1), -1, INFO )
-                  LWORK_CGEBRD=DUM(1)
+                  LWORK_CGEBRD = REAL( DUM(1) )
 *                 Compute space needed for CUNMBR
                   CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA,
      $                DUM(1), B, LDB, DUM(1), -1, INFO )
-                  LWORK_CUNMBR=DUM(1)
+                  LWORK_CUNMBR = REAL( DUM(1) )
 *                 Compute space needed for CUNGBR
                   CALL CUNGBR( 'P', M, N, M, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-                  LWORK_CUNGBR=DUM(1)
+                  LWORK_CUNGBR = REAL( DUM(1) )
                   MAXWRK = 2*M + LWORK_CGEBRD
                   MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR )
                   MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR )

diff --git a/SRC/cggglm.f b/SRC/cggglm.f
@@ -289,7 +289,7 @@ SUBROUTINE CGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
 *
       CALL CGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ),
      $             WORK( M+NP+1 ), LWORK-M-NP, INFO )
-      LOPT = WORK( M+NP+1 )
+      LOPT = REAL( WORK( M+NP+1 ) )
 *
 *     Update left-hand-side vector d = Q**H*d = ( d1 ) M
 *                                               ( d2 ) N-M

diff --git a/SRC/cgglse.f b/SRC/cgglse.f
@@ -276,7 +276,7 @@ SUBROUTINE CGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
 *
       CALL CGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ),
      $             WORK( P+MN+1 ), LWORK-P-MN, INFO )
-      LOPT = WORK( P+MN+1 )
+      LOPT = REAL( WORK( P+MN+1 ) )
 *
 *     Update c = Z**H *c = ( c1 ) N-P
 *                       ( c2 ) M+P-N

diff --git a/SRC/cggqrf.f b/SRC/cggqrf.f
@@ -276,7 +276,7 @@ SUBROUTINE CGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
 *     QR factorization of N-by-M matrix A: A = Q*R
 *
       CALL CGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
-      LOPT = WORK( 1 )
+      LOPT = REAL( WORK( 1 ) )
 *
 *     Update B := Q**H*B.
 *

diff --git a/SRC/cggrqf.f b/SRC/cggrqf.f
@@ -275,7 +275,7 @@ SUBROUTINE CGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
 *     RQ factorization of M-by-N matrix A: A = R*Q
 *
       CALL CGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
-      LOPT = WORK( 1 )
+      LOPT = REAL( WORK( 1 ) )
 *
 *     Update B := B*Q**H
 *

diff --git a/SRC/chbev.f b/SRC/chbev.f
@@ -220,9 +220,9 @@ SUBROUTINE CHBEV( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
 *
       IF( N.EQ.1 ) THEN
          IF( LOWER ) THEN
-            W( 1 ) = AB( 1, 1 )
+            W( 1 ) = REAL( AB( 1, 1 ) )
          ELSE
-            W( 1 ) = AB( KD+1, 1 )
+            W( 1 ) = REAL( AB( KD+1, 1 ) )
          END IF
          IF( WANTZ )
      $      Z( 1, 1 ) = ONE

diff --git a/SRC/chbevd.f b/SRC/chbevd.f
@@ -320,7 +320,7 @@ SUBROUTINE CHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AB( 1, 1 )
+         W( 1 ) = REAL( AB( 1, 1 ) )
          IF( WANTZ )
      $      Z( 1, 1 ) = CONE
          RETURN

diff --git a/SRC/chbevx.f b/SRC/chbevx.f
@@ -379,7 +379,7 @@ SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
      $         M = 0
          END IF
          IF( M.EQ.1 ) THEN
-            W( 1 ) = CTMP1
+            W( 1 ) = REAL( CTMP1 )
             IF( WANTZ )
      $         Z( 1, 1 ) = CONE
          END IF

diff --git a/SRC/chbtrd.f b/SRC/chbtrd.f
@@ -456,7 +456,7 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
 *        copy diagonal elements to D
 *
          DO 120 I = 1, N
-            D( I ) = AB( KD1, I )
+            D( I ) = REAL( AB( KD1, I ) )
   120    CONTINUE
 *
       ELSE
@@ -663,7 +663,7 @@ SUBROUTINE CHBTRD( VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ,
 *        copy diagonal elements to D
 *
          DO 240 I = 1, N
-            D( I ) = AB( 1, I )
+            D( I ) = REAL( AB( 1, I ) )
   240    CONTINUE
       END IF
 *

diff --git a/SRC/cheequb.f b/SRC/cheequb.f
@@ -263,7 +263,7 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
 *        avg = s^T beta / n
          AVG = 0.0E0
          DO I = 1, N
-            AVG = AVG + S( I )*WORK( I )
+            AVG = AVG + REAL( S( I )*WORK( I ) )
          END DO
          AVG = AVG / N
 
@@ -280,8 +280,8 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
             T = CABS1( A( I, I ) )
             SI = S( I )
             C2 = ( N-1 ) * T
-            C1 = ( N-2 ) * ( WORK( I ) - T*SI )
-            C0 = -(T*SI)*SI + 2*WORK( I )*SI - N*AVG
+            C1 = REAL( ( N-2 ) * ( WORK( I ) - T*SI ) )
+            C0 = REAL( -(T*SI)*SI + 2*WORK( I )*SI - N*AVG )
             D = C1*C1 - 4*C0*C2
 
             IF ( D .LE. 0 ) THEN
@@ -316,7 +316,7 @@ SUBROUTINE CHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
                END DO
             END IF
 
-            AVG = AVG + ( U + WORK( I ) ) * D / N
+            AVG = AVG + REAL( ( U + WORK( I ) ) * D / N )
             S( I ) = SI
          END DO
       END DO

diff --git a/SRC/cheev.f b/SRC/cheev.f
@@ -221,7 +221,7 @@ SUBROUTINE CHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
       END IF
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = A( 1, 1 )
+         W( 1 ) = REAL( A( 1, 1 ) )
          WORK( 1 ) = 1
          IF( WANTZ )
      $      A( 1, 1 ) = CONE

diff --git a/SRC/cheevd.f b/SRC/cheevd.f
@@ -314,7 +314,7 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = A( 1, 1 )
+         W( 1 ) = REAL( A( 1, 1 ) )
          IF( WANTZ )
      $      A( 1, 1 ) = CONE
          RETURN

diff --git a/SRC/cheevx.f b/SRC/cheevx.f
@@ -378,12 +378,12 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
       IF( N.EQ.1 ) THEN
          IF( ALLEIG .OR. INDEIG ) THEN
             M = 1
-            W( 1 ) = A( 1, 1 )
+            W( 1 ) = REAL( A( 1, 1 ) )
          ELSE IF( VALEIG ) THEN
             IF( VL.LT.REAL( A( 1, 1 ) ) .AND. VU.GE.REAL( A( 1, 1 ) ) )
      $           THEN
                M = 1
-               W( 1 ) = A( 1, 1 )
+               W( 1 ) = REAL( A( 1, 1 ) )
             END IF
          END IF
          IF( WANTZ )