diff --git a/SRC/cgebd2.f b/SRC/cgebd2.f
index 4fa194373e..db949f90cf 100644
--- 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
index d25b2b4408..359fa2afec 100644
--- 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
index 17e290cfb2..1113563ba2 100644
--- 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
index e66443a630..25ab813028 100644
--- 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
index 4f2c49573b..04defbb2e4 100644
--- 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
index 4ec989e0d2..3efca1e713 100644
--- 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
index f18c406667..4785941dbe 100644
--- 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
index 9dcf225c27..febd9be8de 100644
--- 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
index 1341965cc8..b43febc1f5 100644
--- 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
index 0e0edbd512..6f82cc46ba 100644
--- 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
index 1cbca4b7b1..1598f4de5e 100644
--- 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
index 3424bdea6c..6b5f549a7f 100644
--- 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
index 68a8a3c11d..d05ce42f77 100644
--- 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
index 1bffe54924..3ea7a1627a 100644
--- 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
index e1c184774d..fb8e451df8 100644
--- 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
index 143e1b64be..9a4a1efb7d 100644
--- 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
index 3dd41abd17..1cec902aa3 100644
--- 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 )
diff --git a/SRC/chegs2.f b/SRC/chegs2.f
index d731016e78..0a949b4935 100644
--- a/SRC/chegs2.f
+++ b/SRC/chegs2.f
@@ -194,8 +194,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the upper triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = REAL( A( K, K ) )
+               BKK = REAL( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -224,8 +224,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the lower triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = REAL( A( K, K ) )
+               BKK = REAL( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -249,8 +249,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the upper triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = REAL( A( K, K ) )
+               BKK = REAL( B( K, K ) )
                CALL CTRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
      $                     LDB, A( 1, K ), 1 )
                CT = HALF*AKK
@@ -269,8 +269,8 @@ SUBROUTINE CHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the lower triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = REAL( A( K, K ) )
+               BKK = REAL( B( K, K ) )
                CALL CLACGV( K-1, A( K, 1 ), LDA )
                CALL CTRMV( UPLO, 'Conjugate transpose', 'Non-unit', K-1,
      $                     B, LDB, A( K, 1 ), LDA )
diff --git a/SRC/chesv_rk.f b/SRC/chesv_rk.f
index 7280447fec..a659c8e795 100644
--- a/SRC/chesv_rk.f
+++ b/SRC/chesv_rk.f
@@ -280,7 +280,7 @@ SUBROUTINE CHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = REAL( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/chetd2.f b/SRC/chetd2.f
index 50d001081b..ae4f72df15 100644
--- a/SRC/chetd2.f
+++ b/SRC/chetd2.f
@@ -245,7 +245,7 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
             ALPHA = A( I, I+1 )
             CALL CLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = REAL( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -273,10 +273,10 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
                A( I, I ) = REAL( A( I, I ) )
             END IF
             A( I, I+1 ) = E( I )
-            D( I+1 ) = A( I+1, I+1 )
+            D( I+1 ) = REAL( A( I+1, I+1 ) )
             TAU( I ) = TAUI
    10    CONTINUE
-         D( 1 ) = A( 1, 1 )
+         D( 1 ) = REAL( A( 1, 1 ) )
       ELSE
 *
 *        Reduce the lower triangle of A
@@ -289,7 +289,7 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
             ALPHA = A( I+1, I )
             CALL CLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = REAL( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -318,10 +318,10 @@ SUBROUTINE CHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
                A( I+1, I+1 ) = REAL( A( I+1, I+1 ) )
             END IF
             A( I+1, I ) = E( I )
-            D( I ) = A( I, I )
+            D( I ) = REAL( A( I, I ) )
             TAU( I ) = TAUI
    20    CONTINUE
-         D( N ) = A( N, N )
+         D( N ) = REAL( A( N, N ) )
       END IF
 *
       RETURN
diff --git a/SRC/chetf2_rk.f b/SRC/chetf2_rk.f
index f55368ad17..4bb0323827 100644
--- a/SRC/chetf2_rk.f
+++ b/SRC/chetf2_rk.f
@@ -608,8 +608,8 @@ SUBROUTINE CHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
 *                 D = |A12|
                   D = SLAPY2( REAL( A( K-1, K ) ),
      $                AIMAG( A( K-1, K ) ) )
-                  D11 = A( K, K ) / D
-                  D22 = A( K-1, K-1 ) / D
+                  D11 = REAL( A( K, K ) / D )
+                  D22 = REAL( A( K-1, K-1 ) / D )
                   D12 = A( K-1, K ) / D
                   TT = ONE / ( D11*D22-ONE )
 *
diff --git a/SRC/chetf2_rook.f b/SRC/chetf2_rook.f
index a237b95ac1..ee4eaf68f2 100644
--- a/SRC/chetf2_rook.f
+++ b/SRC/chetf2_rook.f
@@ -528,8 +528,8 @@ SUBROUTINE CHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO )
 *                 D = |A12|
                   D = SLAPY2( REAL( A( K-1, K ) ),
      $                AIMAG( A( K-1, K ) ) )
-                  D11 = A( K, K ) / D
-                  D22 = A( K-1, K-1 ) / D
+                  D11 = REAL( A( K, K ) / D )
+                  D22 = REAL( A( K-1, K-1 ) / D )
                   D12 = A( K-1, K ) / D
                   TT = ONE / ( D11*D22-ONE )
 *
diff --git a/SRC/chetrd.f b/SRC/chetrd.f
index 94edbb76bf..52b9a895a9 100644
--- a/SRC/chetrd.f
+++ b/SRC/chetrd.f
@@ -325,7 +325,7 @@ SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
             DO 10 J = I, I + NB - 1
                A( J-1, J ) = E( J-1 )
-               D( J ) = A( J, J )
+               D( J ) = REAL( A( J, J ) )
    10       CONTINUE
    20    CONTINUE
 *
@@ -357,7 +357,7 @@ SUBROUTINE CHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
             DO 30 J = I, I + NB - 1
                A( J+1, J ) = E( J )
-               D( J ) = A( J, J )
+               D( J ) = REAL( A( J, J ) )
    30       CONTINUE
    40    CONTINUE
 *
diff --git a/SRC/chpev.f b/SRC/chpev.f
index c1629c9a5b..1be8c0c6d8 100644
--- a/SRC/chpev.f
+++ b/SRC/chpev.f
@@ -203,7 +203,7 @@ SUBROUTINE CHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AP( 1 )
+         W( 1 ) = REAL( AP( 1 ) )
          RWORK( 1 ) = 1
          IF( WANTZ )
      $      Z( 1, 1 ) = ONE
diff --git a/SRC/chpevd.f b/SRC/chpevd.f
index 7d5f6ae681..c44462394e 100644
--- a/SRC/chpevd.f
+++ b/SRC/chpevd.f
@@ -300,7 +300,7 @@ SUBROUTINE CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AP( 1 )
+         W( 1 ) = REAL( AP( 1 ) )
          IF( WANTZ )
      $      Z( 1, 1 ) = CONE
          RETURN
diff --git a/SRC/chpevx.f b/SRC/chpevx.f
index 322ec35f0b..a5af973a73 100644
--- a/SRC/chpevx.f
+++ b/SRC/chpevx.f
@@ -332,11 +332,11 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
       IF( N.EQ.1 ) THEN
          IF( ALLEIG .OR. INDEIG ) THEN
             M = 1
-            W( 1 ) = AP( 1 )
+            W( 1 ) = REAL( AP( 1 ) )
          ELSE
             IF( VL.LT.REAL( AP( 1 ) ) .AND. VU.GE.REAL( AP( 1 ) ) ) THEN
                M = 1
-               W( 1 ) = AP( 1 )
+               W( 1 ) = REAL( AP( 1 ) )
             END IF
          END IF
          IF( WANTZ )
diff --git a/SRC/chpgst.f b/SRC/chpgst.f
index 56fc577038..17f10b034b 100644
--- a/SRC/chpgst.f
+++ b/SRC/chpgst.f
@@ -182,7 +182,7 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *              Compute the j-th column of the upper triangle of A
 *
                AP( JJ ) = REAL( AP( JJ ) )
-               BJJ = BP( JJ )
+               BJJ = REAL( BP( JJ ) )
                CALL CTPSV( UPLO, 'Conjugate transpose', 'Non-unit', J,
      $                     BP, AP( J1 ), 1 )
                CALL CHPMV( UPLO, J-1, -CONE, AP, BP( J1 ), 1, CONE,
@@ -203,8 +203,8 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Update the lower triangle of A(k:n,k:n)
 *
-               AKK = AP( KK )
-               BKK = BP( KK )
+               AKK = REAL( AP( KK ) )
+               BKK = REAL( BP( KK ) )
                AKK = AKK / BKK**2
                AP( KK ) = AKK
                IF( K.LT.N ) THEN
@@ -234,8 +234,8 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Update the upper triangle of A(1:k,1:k)
 *
-               AKK = AP( KK )
-               BKK = BP( KK )
+               AKK = REAL( AP( KK ) )
+               BKK = REAL( BP( KK ) )
                CALL CTPMV( UPLO, 'No transpose', 'Non-unit', K-1, BP,
      $                     AP( K1 ), 1 )
                CT = HALF*AKK
@@ -258,8 +258,8 @@ SUBROUTINE CHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Compute the j-th column of the lower triangle of A
 *
-               AJJ = AP( JJ )
-               BJJ = BP( JJ )
+               AJJ = REAL( AP( JJ ) )
+               BJJ = REAL( BP( JJ ) )
                AP( JJ ) = AJJ*BJJ + CDOTC( N-J, AP( JJ+1 ), 1,
      $                    BP( JJ+1 ), 1 )
                CALL CSSCAL( N-J, BJJ, AP( JJ+1 ), 1 )
diff --git a/SRC/chptrd.f b/SRC/chptrd.f
index f1cdd43809..5618e014f6 100644
--- a/SRC/chptrd.f
+++ b/SRC/chptrd.f
@@ -221,7 +221,7 @@ SUBROUTINE CHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             ALPHA = AP( I1+I-1 )
             CALL CLARFG( I, ALPHA, AP( I1 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = REAL( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -246,11 +246,11 @@ SUBROUTINE CHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             END IF
             AP( I1+I-1 ) = E( I )
-            D( I+1 ) = AP( I1+I )
+            D( I+1 ) = REAL( AP( I1+I ) )
             TAU( I ) = TAUI
             I1 = I1 - I
    10    CONTINUE
-         D( 1 ) = AP( 1 )
+         D( 1 ) = REAL( AP( 1 ) )
       ELSE
 *
 *        Reduce the lower triangle of A. II is the index in AP of
@@ -266,7 +266,7 @@ SUBROUTINE CHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             ALPHA = AP( II+1 )
             CALL CLARFG( N-I, ALPHA, AP( II+2 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = REAL( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -293,11 +293,11 @@ SUBROUTINE CHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             END IF
             AP( II+1 ) = E( I )
-            D( I ) = AP( II )
+            D( I ) = REAL( AP( II ) )
             TAU( I ) = TAUI
             II = I1I1
    20    CONTINUE
-         D( N ) = AP( II )
+         D( N ) = REAL( AP( II ) )
       END IF
 *
       RETURN
diff --git a/SRC/clabrd.f b/SRC/clabrd.f
index 138c91ff53..765d71e509 100644
--- a/SRC/clabrd.f
+++ b/SRC/clabrd.f
@@ -267,7 +267,7 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
             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 )
             IF( I.LT.N ) THEN
                A( I, I ) = ONE
 *
@@ -307,7 +307,7 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
                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
 *
 *              Compute X(i+1:m,i)
@@ -351,7 +351,7 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
             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 )
             IF( I.LT.M ) THEN
                A( I, I ) = ONE
 *
@@ -385,7 +385,7 @@ SUBROUTINE CLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
                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
 *
 *              Compute Y(i+1:n,i)
diff --git a/SRC/claic1.f b/SRC/claic1.f
index e0b5badc2c..773c718d1d 100644
--- a/SRC/claic1.f
+++ b/SRC/claic1.f
@@ -191,7 +191,7 @@ SUBROUTINE CLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             ELSE
                S = ALPHA / S1
                C = GAMMA / S1
-               TMP = SQRT( S*CONJG( S )+C*CONJG( C ) )
+               TMP = REAL( SQRT( S*CONJG( S )+C*CONJG( C ) ) )
                S = S / TMP
                C = C / TMP
                SESTPR = S1*TMP
@@ -245,14 +245,15 @@ SUBROUTINE CLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
             C = ZETA1*ZETA1
             IF( B.GT.ZERO ) THEN
-               T = C / ( B+SQRT( B*B+C ) )
+               T = REAL( C / ( B+SQRT( B*B+C ) ) )
             ELSE
-               T = SQRT( B*B+C ) - B
+               T = REAL( SQRT( B*B+C ) - B )
             END IF
 *
             SINE = -( ALPHA / ABSEST ) / T
             COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
-            TMP = SQRT( SINE*CONJG( SINE )+COSINE*CONJG( COSINE ) )
+            TMP = REAL( SQRT( SINE * CONJG( SINE )
+     $        + COSINE * CONJG( COSINE ) ) )
             S = SINE / TMP
             C = COSINE / TMP
             SESTPR = SQRT( T+ONE )*ABSEST
@@ -277,7 +278,7 @@ SUBROUTINE CLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             S1 = MAX( ABS( SINE ), ABS( COSINE ) )
             S = SINE / S1
             C = COSINE / S1
-            TMP = SQRT( S*CONJG( S )+C*CONJG( C ) )
+            TMP = REAL( SQRT( S*CONJG( S )+C*CONJG( C ) ) )
             S = S / TMP
             C = C / TMP
             RETURN
@@ -335,7 +336,7 @@ SUBROUTINE CLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
 *
                B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
                C = ZETA2*ZETA2
-               T = C / ( B+SQRT( ABS( B*B-C ) ) )
+               T = REAL( C / ( B+SQRT( ABS( B*B-C ) ) ) )
                SINE = ( ALPHA / ABSEST ) / ( ONE-T )
                COSINE = -( GAMMA / ABSEST ) / T
                SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
@@ -346,15 +347,16 @@ SUBROUTINE CLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
                B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
                C = ZETA1*ZETA1
                IF( B.GE.ZERO ) THEN
-                  T = -C / ( B+SQRT( B*B+C ) )
+                  T = REAL( -C / ( B+SQRT( B*B+C ) ) )
                ELSE
-                  T = B - SQRT( B*B+C )
+                  T = REAL( B - SQRT( B*B+C ) )
                END IF
                SINE = -( ALPHA / ABSEST ) / T
                COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
                SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
             END IF
-            TMP = SQRT( SINE*CONJG( SINE )+COSINE*CONJG( COSINE ) )
+            TMP = REAL( SQRT( SINE * CONJG( SINE )
+     $        + COSINE * CONJG( COSINE ) ) )
             S = SINE / TMP
             C = COSINE / TMP
             RETURN
diff --git a/SRC/clarfgp.f b/SRC/clarfgp.f
index 066dfe1c7a..b584484c7f 100644
--- a/SRC/clarfgp.f
+++ b/SRC/clarfgp.f
@@ -235,7 +235,7 @@ SUBROUTINE CLARFGP( N, ALPHA, X, INCX, TAU )
                   DO J = 1, N-1
                      X( 1 + (J-1)*INCX ) = ZERO
                   END DO
-                  BETA = -SAVEALPHA
+                  BETA = REAL( -SAVEALPHA )
                END IF
             ELSE
                XNORM = SLAPY2( ALPHR, ALPHI )
diff --git a/SRC/clatrd.f b/SRC/clatrd.f
index 66f1b056e8..6e9da3b27f 100644
--- a/SRC/clatrd.f
+++ b/SRC/clatrd.f
@@ -268,7 +268,7 @@ SUBROUTINE CLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
 *
                ALPHA = A( I-1, I )
                CALL CLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) )
-               E( I-1 ) = ALPHA
+               E( I-1 ) = REAL( ALPHA )
                A( I-1, I ) = ONE
 *
 *              Compute W(1:i-1,i)
@@ -322,7 +322,7 @@ SUBROUTINE CLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
                ALPHA = A( I+1, I )
                CALL CLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1,
      $                      TAU( I ) )
-               E( I ) = ALPHA
+               E( I ) = REAL( ALPHA )
                A( I+1, I ) = ONE
 *
 *              Compute W(i+1:n,i)
diff --git a/SRC/clauu2.f b/SRC/clauu2.f
index 6d474dc465..240ec20c08 100644
--- a/SRC/clauu2.f
+++ b/SRC/clauu2.f
@@ -162,7 +162,7 @@ SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO )
 *        Compute the product U * U**H.
 *
          DO 10 I = 1, N
-            AII = A( I, I )
+            AII = REAL( A( I, I ) )
             IF( I.LT.N ) THEN
                A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I, I+1 ), LDA,
      $                     A( I, I+1 ), LDA ) )
@@ -181,7 +181,7 @@ SUBROUTINE CLAUU2( UPLO, N, A, LDA, INFO )
 *        Compute the product L**H * L.
 *
          DO 20 I = 1, N
-            AII = A( I, I )
+            AII = REAL( A( I, I ) )
             IF( I.LT.N ) THEN
                A( I, I ) = AII*AII + REAL( CDOTC( N-I, A( I+1, I ), 1,
      $                     A( I+1, I ), 1 ) )
diff --git a/SRC/cpoequb.f b/SRC/cpoequb.f
index 2dd5f4e27e..22f5387b50 100644
--- a/SRC/cpoequb.f
+++ b/SRC/cpoequb.f
@@ -180,11 +180,11 @@ SUBROUTINE CPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
 *
 *     Find the minimum and maximum diagonal elements.
 *
-      S( 1 ) = A( 1, 1 )
+      S( 1 ) = REAL( A( 1, 1 ) )
       SMIN = S( 1 )
       AMAX = S( 1 )
       DO 10 I = 2, N
-         S( I ) = A( I, I )
+         S( I ) = REAL( A( I, I ) )
          SMIN = MIN( SMIN, S( I ) )
          AMAX = MAX( AMAX, S( I ) )
    10 CONTINUE
diff --git a/SRC/cpotf2.f b/SRC/cpotf2.f
index 7779cd5017..2f4658bae3 100644
--- a/SRC/cpotf2.f
+++ b/SRC/cpotf2.f
@@ -174,8 +174,8 @@ SUBROUTINE CPOTF2( UPLO, N, A, LDA, INFO )
 *
 *           Compute U(J,J) and test for non-positive-definiteness.
 *
-            AJJ = REAL( A( J, J ) ) - CDOTC( J-1, A( 1, J ), 1,
-     $            A( 1, J ), 1 )
+            AJJ = REAL( REAL( A( J, J ) ) - CDOTC( J-1, A( 1, J ), 1,
+     $            A( 1, J ), 1 ) )
             IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
                A( J, J ) = AJJ
                GO TO 30
@@ -201,8 +201,8 @@ SUBROUTINE CPOTF2( UPLO, N, A, LDA, INFO )
 *
 *           Compute L(J,J) and test for non-positive-definiteness.
 *
-            AJJ = REAL( A( J, J ) ) - CDOTC( J-1, A( J, 1 ), LDA,
-     $            A( J, 1 ), LDA )
+            AJJ = REAL( REAL( A( J, J ) ) - CDOTC( J-1, A( J, 1 ), LDA,
+     $            A( J, 1 ), LDA ) )
             IF( AJJ.LE.ZERO.OR.SISNAN( AJJ ) ) THEN
                A( J, J ) = AJJ
                GO TO 30
diff --git a/SRC/cpptrf.f b/SRC/cpptrf.f
index e5f90af614..4e81458cbc 100644
--- a/SRC/cpptrf.f
+++ b/SRC/cpptrf.f
@@ -189,8 +189,8 @@ SUBROUTINE CPPTRF( UPLO, N, AP, INFO )
 *
 *           Compute U(J,J) and test for non-positive-definiteness.
 *
-            AJJ = REAL( AP( JJ ) ) - CDOTC( J-1, AP( JC ), 1, AP( JC ),
-     $            1 )
+            AJJ = REAL( REAL( AP( JJ ) ) - CDOTC( J-1,
+     $            AP( JC ), 1, AP( JC ), 1 ) )
             IF( AJJ.LE.ZERO ) THEN
                AP( JJ ) = AJJ
                GO TO 30
diff --git a/SRC/cpptri.f b/SRC/cpptri.f
index d6afc98922..3f24d20bd2 100644
--- a/SRC/cpptri.f
+++ b/SRC/cpptri.f
@@ -161,7 +161,7 @@ SUBROUTINE CPPTRI( UPLO, N, AP, INFO )
             JJ = JJ + J
             IF( J.GT.1 )
      $         CALL CHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
-            AJJ = AP( JJ )
+            AJJ = REAL( AP( JJ ) )
             CALL CSSCAL( J, AJJ, AP( JC ), 1 )
    10    CONTINUE
 *
diff --git a/SRC/csyequb.f b/SRC/csyequb.f
index f3502e544d..185501d04f 100644
--- a/SRC/csyequb.f
+++ b/SRC/csyequb.f
@@ -263,7 +263,7 @@ SUBROUTINE CSYEQUB( 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 CSYEQUB( 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 ) * ( REAL( WORK( I ) ) - T*SI )
+            C0 = -(T*SI)*SI + 2 * REAL( WORK( I ) ) * SI - N*AVG
             D = C1*C1 - 4*C0*C2
 
             IF ( D .LE. 0 ) THEN
@@ -316,7 +316,7 @@ SUBROUTINE CSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
                END DO
             END IF
 
-            AVG = AVG + ( U + WORK( I ) ) * D / N
+            AVG = AVG + ( U + REAL( WORK( I ) ) ) * D / N
             S( I ) = SI
          END DO
       END DO
diff --git a/SRC/csysv.f b/SRC/csysv.f
index 78b8b81972..6f175e381b 100644
--- a/SRC/csysv.f
+++ b/SRC/csysv.f
@@ -223,7 +223,7 @@ SUBROUTINE CSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL CSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = REAL( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/csysv_rk.f b/SRC/csysv_rk.f
index 35e762e300..793e39df5a 100644
--- a/SRC/csysv_rk.f
+++ b/SRC/csysv_rk.f
@@ -280,7 +280,7 @@ SUBROUTINE CSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = REAL( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/csysv_rook.f b/SRC/csysv_rook.f
index 49c9258e98..daa9f27c41 100644
--- a/SRC/csysv_rook.f
+++ b/SRC/csysv_rook.f
@@ -256,7 +256,7 @@ SUBROUTINE CSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = REAL( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/cungbr.f b/SRC/cungbr.f
index 055264dde0..c973d0b0a7 100644
--- a/SRC/cungbr.f
+++ b/SRC/cungbr.f
@@ -233,7 +233,7 @@ SUBROUTINE CUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
                END IF
             END IF
          END IF
-         LWKOPT = WORK( 1 )
+         LWKOPT = REAL( WORK( 1 ) )
          LWKOPT = MAX (LWKOPT, MN)
       END IF
 *
diff --git a/SRC/zgebd2.f b/SRC/zgebd2.f
index b82fb05958..9a403e4008 100644
--- a/SRC/zgebd2.f
+++ b/SRC/zgebd2.f
@@ -244,7 +244,7 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             ALPHA = A( I, I )
             CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
      $                   TAUQ( I ) )
-            D( I ) = ALPHA
+            D( I ) = DBLE( ALPHA )
             A( I, I ) = ONE
 *
 *           Apply H(i)**H to A(i:m,i+1:n) from the left
@@ -263,7 +263,7 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                ALPHA = A( I, I+1 )
                CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
      $                      TAUP( I ) )
-               E( I ) = ALPHA
+               E( I ) = DBLE( ALPHA )
                A( I, I+1 ) = ONE
 *
 *              Apply G(i) to A(i+1:m,i+1:n) from the right
@@ -288,7 +288,7 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             ALPHA = A( I, I )
             CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
      $                   TAUP( I ) )
-            D( I ) = ALPHA
+            D( I ) = DBLE( ALPHA )
             A( I, I ) = ONE
 *
 *           Apply G(i) to A(i+1:m,i:n) from the right
@@ -307,7 +307,7 @@ SUBROUTINE ZGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                ALPHA = A( I+1, I )
                CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
      $                      TAUQ( I ) )
-               E( I ) = ALPHA
+               E( I ) = DBLE( 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/zgees.f b/SRC/zgees.f
index ee4e4a25c4..40fe78d345 100644
--- a/SRC/zgees.f
+++ b/SRC/zgees.f
@@ -282,7 +282,7 @@ SUBROUTINE ZGEES( JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS,
 *
             CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
      $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
+            HSWORK = DBLE( WORK( 1 ) )
 *
             IF( .NOT.WANTVS ) THEN
                MAXWRK = MAX( MAXWRK, HSWORK )
diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f
index 963c10fe23..ca4f5c9135 100644
--- a/SRC/zgeesx.f
+++ b/SRC/zgeesx.f
@@ -337,7 +337,7 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, W,
 *
             CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
      $             WORK, -1, IEVAL )
-            HSWORK = WORK( 1 )
+            HSWORK = DBLE( WORK( 1 ) )
 *
             IF( .NOT.WANTVS ) THEN
                MAXWRK = MAX( MAXWRK, HSWORK )
diff --git a/SRC/zgejsv.f b/SRC/zgejsv.f
index c6780f2721..0c2226f9f0 100644
--- a/SRC/zgejsv.f
+++ b/SRC/zgejsv.f
@@ -707,11 +707,11 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
           IF ( LQUERY ) THEN 
               CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, 
      $             RDUMMY, IERR )
-              LWRK_ZGEQP3 = CDUMMY(1)
+              LWRK_ZGEQP3 = DBLE( CDUMMY(1) )
               CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
-              LWRK_ZGEQRF = CDUMMY(1)
+              LWRK_ZGEQRF = DBLE( CDUMMY(1) )
               CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
-              LWRK_ZGELQF = CDUMMY(1)             
+              LWRK_ZGELQF = DBLE( CDUMMY(1) )
           END IF
           MINWRK  = 2
           OPTWRK  = 2
@@ -727,7 +727,7 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
               IF ( LQUERY ) THEN 
                   CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, 
      $                 LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                  LWRK_ZGESVJ = CDUMMY(1)
+                  LWRK_ZGESVJ = DBLE( CDUMMY(1) )
                   IF ( ERREST ) THEN 
                       OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON, 
      $                              N+LWRK_ZGEQRF, LWRK_ZGESVJ )
@@ -763,10 +763,10 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
      $                LDA, CDUMMY, -1, RDUMMY, -1, IERR )
-                 LWRK_ZGESVJ = CDUMMY(1)
+                 LWRK_ZGESVJ = DBLE( CDUMMY(1) )
                  CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
      $                V, LDV, CDUMMY, -1, IERR )
-                 LWRK_ZUNMLQ = CDUMMY(1)                
+                 LWRK_ZUNMLQ = DBLE( CDUMMY(1) )
                  IF ( ERREST ) THEN 
                  OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ, 
      $                         N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF,
@@ -802,10 +802,10 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
      $                LDA, CDUMMY, -1, RDUMMY, -1, IERR )
-                 LWRK_ZGESVJ = CDUMMY(1)
+                 LWRK_ZGESVJ = DBLE( CDUMMY(1) )
                  CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $               LDU, CDUMMY, -1, IERR )
-                 LWRK_ZUNMQRM = CDUMMY(1)
+                 LWRK_ZUNMQRM = DBLE( CDUMMY(1) )
                  IF ( ERREST ) THEN
                  OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF,
      $                             LWRK_ZGESVJ, LWRK_ZUNMQRM )
@@ -864,26 +864,26 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
              IF ( LQUERY ) THEN
                  CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $                LDU, CDUMMY, -1, IERR )
-                 LWRK_ZUNMQRM = CDUMMY(1)
+                 LWRK_ZUNMQRM = DBLE( CDUMMY(1) )
                  CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,
      $                LDU, CDUMMY, -1, IERR )
-                 LWRK_ZUNMQR = CDUMMY(1)
+                 LWRK_ZUNMQR = DBLE( CDUMMY(1) )
                  IF ( .NOT. JRACC ) THEN
                      CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,
      $                    RDUMMY, IERR )
-                     LWRK_ZGEQP3N = CDUMMY(1)
+                     LWRK_ZGEQP3N = DBLE( CDUMMY(1) )
                      CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_ZGESVJ = CDUMMY(1)
+                     LWRK_ZGESVJ = DBLE( CDUMMY(1) )
                      CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_ZGESVJU = CDUMMY(1)
+                     LWRK_ZGESVJU = DBLE( CDUMMY(1) )
                      CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_ZGESVJV = CDUMMY(1)
+                     LWRK_ZGESVJV = DBLE( CDUMMY(1) )
                      CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
      $                    V, LDV, CDUMMY, -1, IERR )
-                     LWRK_ZUNMLQ = CDUMMY(1)
+                     LWRK_ZUNMLQ = DBLE( CDUMMY(1) )
                      IF ( ERREST ) THEN 
                        OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, 
      $                          2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, 
@@ -912,13 +912,13 @@ SUBROUTINE ZGEJSV( JOBA, JOBU, JOBV, JOBR, JOBT, JOBP,
                  ELSE
                      CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
      $                    N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
-                     LWRK_ZGESVJV = CDUMMY(1)
+                     LWRK_ZGESVJV = DBLE( CDUMMY(1) )
                      CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,
      $                    V, LDV, CDUMMY, -1, IERR )
-                     LWRK_ZUNMQR = CDUMMY(1)
+                     LWRK_ZUNMQR = DBLE( CDUMMY(1) )
                      CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
      $                    LDU, CDUMMY, -1, IERR )
-                     LWRK_ZUNMQRM = CDUMMY(1)   
+                     LWRK_ZUNMQRM = DBLE( CDUMMY(1) )
                      IF ( ERREST ) THEN 
                         OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON,   
      $                           2*N+LWRK_ZGEQRF, 2*N+N**2,  
diff --git a/SRC/zgelss.f b/SRC/zgelss.f
index a58086eabb..e4aba64970 100644
--- a/SRC/zgelss.f
+++ b/SRC/zgelss.f
@@ -266,11 +266,11 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *
 *              Compute space needed for ZGEQRF
                CALL ZGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
-               LWORK_ZGEQRF=DUM(1)
+               LWORK_ZGEQRF = DBLE( DUM(1) )
 *              Compute space needed for ZUNMQR
                CALL ZUNMQR( 'L', 'C', M, NRHS, N, A, LDA, DUM(1), B,
      $                   LDB, DUM(1), -1, INFO )
-               LWORK_ZUNMQR=DUM(1)
+               LWORK_ZUNMQR = DBLE( DUM(1) )
                MM = N
                MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'ZGEQRF', ' ', M,
      $                       N, -1, -1 ) )
@@ -284,15 +284,15 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *              Compute space needed for ZGEBRD
                CALL ZGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1),
      $                      -1, INFO )
-               LWORK_ZGEBRD=DUM(1)
+               LWORK_ZGEBRD = DBLE( DUM(1) )
 *              Compute space needed for ZUNMBR
                CALL ZUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1),
      $                B, LDB, DUM(1), -1, INFO )
-               LWORK_ZUNMBR=DUM(1)
+               LWORK_ZUNMBR = DBLE( DUM(1) )
 *              Compute space needed for ZUNGBR
                CALL ZUNGBR( 'P', N, N, N, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-               LWORK_ZUNGBR=DUM(1)
+               LWORK_ZUNGBR = DBLE( DUM(1) )
 *              Compute total workspace needed
                MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZGEBRD )
                MAXWRK = MAX( MAXWRK, 2*N + LWORK_ZUNMBR )
@@ -310,23 +310,23 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *                 Compute space needed for ZGELQF
                   CALL ZGELQF( M, N, A, LDA, DUM(1), DUM(1),
      $                -1, INFO )
-                  LWORK_ZGELQF=DUM(1)
+                  LWORK_ZGELQF = DBLE( DUM(1) )
 *                 Compute space needed for ZGEBRD
                   CALL ZGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1),
      $                         DUM(1), -1, INFO )
-                  LWORK_ZGEBRD=DUM(1)
+                  LWORK_ZGEBRD = DBLE( DUM(1) )
 *                 Compute space needed for ZUNMBR
                   CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA,
      $                DUM(1), B, LDB, DUM(1), -1, INFO )
-                  LWORK_ZUNMBR=DUM(1)
+                  LWORK_ZUNMBR = DBLE( DUM(1) )
 *                 Compute space needed for ZUNGBR
                   CALL ZUNGBR( 'P', M, M, M, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-                  LWORK_ZUNGBR=DUM(1)
+                  LWORK_ZUNGBR = DBLE( DUM(1) )
 *                 Compute space needed for ZUNMLQ
                   CALL ZUNMLQ( 'L', 'C', N, NRHS, M, A, LDA, DUM(1),
      $                 B, LDB, DUM(1), -1, INFO )
-                  LWORK_ZUNMLQ=DUM(1)
+                  LWORK_ZUNMLQ = DBLE( DUM(1) )
 *                 Compute total workspace needed
                   MAXWRK = M + LWORK_ZGELQF
                   MAXWRK = MAX( MAXWRK, 3*M + M*M + LWORK_ZGEBRD )
@@ -345,15 +345,15 @@ SUBROUTINE ZGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
 *                 Compute space needed for ZGEBRD
                   CALL ZGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1),
      $                         DUM(1), -1, INFO )
-                  LWORK_ZGEBRD=DUM(1)
+                  LWORK_ZGEBRD = DBLE( DUM(1) )
 *                 Compute space needed for ZUNMBR
                   CALL ZUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA,
      $                DUM(1), B, LDB, DUM(1), -1, INFO )
-                  LWORK_ZUNMBR=DUM(1)
+                  LWORK_ZUNMBR = DBLE( DUM(1) )
 *                 Compute space needed for ZUNGBR
                   CALL ZUNGBR( 'P', M, N, M, A, LDA, DUM(1),
      $                   DUM(1), -1, INFO )
-                  LWORK_ZUNGBR=DUM(1)
+                  LWORK_ZUNGBR = DBLE( DUM(1) )
                   MAXWRK = 2*M + LWORK_ZGEBRD
                   MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNMBR )
                   MAXWRK = MAX( MAXWRK, 2*M + LWORK_ZUNGBR )
diff --git a/SRC/zggglm.f b/SRC/zggglm.f
index 7537529247..6c24131aa3 100644
--- a/SRC/zggglm.f
+++ b/SRC/zggglm.f
@@ -289,7 +289,7 @@ SUBROUTINE ZGGGLM( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
 *
       CALL ZGGQRF( 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 = DBLE( WORK( M+NP+1 ) )
 *
 *     Update left-hand-side vector d = Q**H*d = ( d1 ) M
 *                                               ( d2 ) N-M
diff --git a/SRC/zgglse.f b/SRC/zgglse.f
index 4dc5798f1c..e5869a7d40 100644
--- a/SRC/zgglse.f
+++ b/SRC/zgglse.f
@@ -276,7 +276,7 @@ SUBROUTINE ZGGLSE( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
 *
       CALL ZGGRQF( 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 = DBLE( WORK( P+MN+1 ) )
 *
 *     Update c = Z**H *c = ( c1 ) N-P
 *                       ( c2 ) M+P-N
diff --git a/SRC/zggqrf.f b/SRC/zggqrf.f
index a091ef2f5b..93b1dc0fc6 100644
--- a/SRC/zggqrf.f
+++ b/SRC/zggqrf.f
@@ -276,7 +276,7 @@ SUBROUTINE ZGGQRF( N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK,
 *     QR factorization of N-by-M matrix A: A = Q*R
 *
       CALL ZGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
-      LOPT = WORK( 1 )
+      LOPT = DBLE( WORK( 1 ) )
 *
 *     Update B := Q**H*B.
 *
diff --git a/SRC/zggrqf.f b/SRC/zggrqf.f
index 75fe05b46a..a2d4a9d553 100644
--- a/SRC/zggrqf.f
+++ b/SRC/zggrqf.f
@@ -275,7 +275,7 @@ SUBROUTINE ZGGRQF( M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK,
 *     RQ factorization of M-by-N matrix A: A = R*Q
 *
       CALL ZGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
-      LOPT = WORK( 1 )
+      LOPT = DBLE( WORK( 1 ) )
 *
 *     Update B := B*Q**H
 *
diff --git a/SRC/zhbev.f b/SRC/zhbev.f
index 4be27f282e..341a6fb2bb 100644
--- a/SRC/zhbev.f
+++ b/SRC/zhbev.f
@@ -220,9 +220,9 @@ SUBROUTINE ZHBEV( 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 ) = DBLE( AB( 1, 1 ) )
          ELSE
-            W( 1 ) = AB( KD+1, 1 )
+            W( 1 ) = DBLE( AB( KD+1, 1 ) )
          END IF
          IF( WANTZ )
      $      Z( 1, 1 ) = ONE
diff --git a/SRC/zhbevd.f b/SRC/zhbevd.f
index 402b5e0360..0db5515409 100644
--- a/SRC/zhbevd.f
+++ b/SRC/zhbevd.f
@@ -320,7 +320,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ, WORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AB( 1, 1 )
+         W( 1 ) = DBLE( AB( 1, 1 ) )
          IF( WANTZ )
      $      Z( 1, 1 ) = CONE
          RETURN
diff --git a/SRC/zhbevx.f b/SRC/zhbevx.f
index d87bcc8e34..77bd721b3c 100644
--- a/SRC/zhbevx.f
+++ b/SRC/zhbevx.f
@@ -379,7 +379,7 @@ SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
      $         M = 0
          END IF
          IF( M.EQ.1 ) THEN
-            W( 1 ) = CTMP1
+            W( 1 ) = DBLE( CTMP1 )
             IF( WANTZ )
      $         Z( 1, 1 ) = CONE
          END IF
diff --git a/SRC/zhbtrd.f b/SRC/zhbtrd.f
index 395e708ad2..63dc7a9343 100644
--- a/SRC/zhbtrd.f
+++ b/SRC/zhbtrd.f
@@ -456,7 +456,7 @@ SUBROUTINE ZHBTRD( 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 ) = DBLE( AB( KD1, I ) )
   120    CONTINUE
 *
       ELSE
@@ -663,7 +663,7 @@ SUBROUTINE ZHBTRD( 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 ) = DBLE( AB( 1, I ) )
   240    CONTINUE
       END IF
 *
diff --git a/SRC/zheequb.f b/SRC/zheequb.f
index 154922791f..93747172eb 100644
--- a/SRC/zheequb.f
+++ b/SRC/zheequb.f
@@ -263,7 +263,7 @@ SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
 *        avg = s^T beta / n
          AVG = 0.0D0
          DO I = 1, N
-            AVG = AVG + S( I )*WORK( I )
+            AVG = AVG + DBLE( S( I )*WORK( I ) )
          END DO
          AVG = AVG / N
 
@@ -280,8 +280,8 @@ SUBROUTINE ZHEEQUB( 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 = ( N-2 ) * ( DBLE( WORK( I ) ) - T*SI )
+            C0 = -(T*SI)*SI + 2 * DBLE( WORK( I ) ) * SI - N*AVG
             D = C1*C1 - 4*C0*C2
 
             IF ( D .LE. 0 ) THEN
@@ -316,7 +316,7 @@ SUBROUTINE ZHEEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
                END DO
             END IF
 
-            AVG = AVG + ( U + WORK( I ) ) * D / N
+            AVG = AVG + ( U + DBLE( WORK( I ) ) ) * D / N
             S( I ) = SI
          END DO
       END DO
diff --git a/SRC/zheev.f b/SRC/zheev.f
index bb10ce8216..59af34a742 100644
--- a/SRC/zheev.f
+++ b/SRC/zheev.f
@@ -221,7 +221,7 @@ SUBROUTINE ZHEEV( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
       END IF
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = A( 1, 1 )
+         W( 1 ) = DBLE( A( 1, 1 ) )
          WORK( 1 ) = 1
          IF( WANTZ )
      $      A( 1, 1 ) = CONE
diff --git a/SRC/zheevd.f b/SRC/zheevd.f
index f0ff2a66be..a6484eb032 100644
--- a/SRC/zheevd.f
+++ b/SRC/zheevd.f
@@ -314,7 +314,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = A( 1, 1 )
+         W( 1 ) = DBLE( A( 1, 1 ) )
          IF( WANTZ )
      $      A( 1, 1 ) = CONE
          RETURN
diff --git a/SRC/zheevx.f b/SRC/zheevx.f
index fc1c605d75..71c358b371 100644
--- a/SRC/zheevx.f
+++ b/SRC/zheevx.f
@@ -378,12 +378,12 @@ SUBROUTINE ZHEEVX( 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 ) = DBLE( A( 1, 1 ) )
          ELSE IF( VALEIG ) THEN
             IF( VL.LT.DBLE( A( 1, 1 ) ) .AND. VU.GE.DBLE( A( 1, 1 ) ) )
      $           THEN
                M = 1
-               W( 1 ) = A( 1, 1 )
+               W( 1 ) = DBLE( A( 1, 1 ) )
             END IF
          END IF
          IF( WANTZ )
diff --git a/SRC/zhegs2.f b/SRC/zhegs2.f
index f8a8b557d3..ba1c3fb017 100644
--- a/SRC/zhegs2.f
+++ b/SRC/zhegs2.f
@@ -194,8 +194,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the upper triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -224,8 +224,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the lower triangle of A(k:n,k:n)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                AKK = AKK / BKK**2
                A( K, K ) = AKK
                IF( K.LT.N ) THEN
@@ -249,8 +249,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the upper triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                CALL ZTRMV( UPLO, 'No transpose', 'Non-unit', K-1, B,
      $                     LDB, A( 1, K ), 1 )
                CT = HALF*AKK
@@ -269,8 +269,8 @@ SUBROUTINE ZHEGS2( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
 *
 *              Update the lower triangle of A(1:k,1:k)
 *
-               AKK = A( K, K )
-               BKK = B( K, K )
+               AKK = DBLE( A( K, K ) )
+               BKK = DBLE( B( K, K ) )
                CALL ZLACGV( K-1, A( K, 1 ), LDA )
                CALL ZTRMV( UPLO, 'Conjugate transpose', 'Non-unit', K-1,
      $                     B, LDB, A( K, 1 ), LDA )
diff --git a/SRC/zhesv_rk.f b/SRC/zhesv_rk.f
index 1081c6ca0b..1ec75cc04b 100644
--- a/SRC/zhesv_rk.f
+++ b/SRC/zhesv_rk.f
@@ -280,7 +280,7 @@ SUBROUTINE ZHESV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = DBLE( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/zhetd2.f b/SRC/zhetd2.f
index 303ceea70e..a6d900b7c7 100644
--- a/SRC/zhetd2.f
+++ b/SRC/zhetd2.f
@@ -245,7 +245,7 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
             ALPHA = A( I, I+1 )
             CALL ZLARFG( I, ALPHA, A( 1, I+1 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = DBLE( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -273,10 +273,10 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
                A( I, I ) = DBLE( A( I, I ) )
             END IF
             A( I, I+1 ) = E( I )
-            D( I+1 ) = A( I+1, I+1 )
+            D( I+1 ) = DBLE( A( I+1, I+1 ) )
             TAU( I ) = TAUI
    10    CONTINUE
-         D( 1 ) = A( 1, 1 )
+         D( 1 ) = DBLE( A( 1, 1 ) )
       ELSE
 *
 *        Reduce the lower triangle of A
@@ -289,7 +289,7 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
 *
             ALPHA = A( I+1, I )
             CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = DBLE( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -318,10 +318,10 @@ SUBROUTINE ZHETD2( UPLO, N, A, LDA, D, E, TAU, INFO )
                A( I+1, I+1 ) = DBLE( A( I+1, I+1 ) )
             END IF
             A( I+1, I ) = E( I )
-            D( I ) = A( I, I )
+            D( I ) = DBLE( A( I, I ) )
             TAU( I ) = TAUI
    20    CONTINUE
-         D( N ) = A( N, N )
+         D( N ) = DBLE( A( N, N ) )
       END IF
 *
       RETURN
diff --git a/SRC/zhetf2_rk.f b/SRC/zhetf2_rk.f
index 5330f5db94..fe737e631b 100644
--- a/SRC/zhetf2_rk.f
+++ b/SRC/zhetf2_rk.f
@@ -608,8 +608,8 @@ SUBROUTINE ZHETF2_RK( UPLO, N, A, LDA, E, IPIV, INFO )
 *                 D = |A12|
                   D = DLAPY2( DBLE( A( K-1, K ) ),
      $                DIMAG( A( K-1, K ) ) )
-                  D11 = A( K, K ) / D
-                  D22 = A( K-1, K-1 ) / D
+                  D11 = DBLE( A( K, K ) / D )
+                  D22 = DBLE( A( K-1, K-1 ) / D )
                   D12 = A( K-1, K ) / D
                   TT = ONE / ( D11*D22-ONE )
 *
diff --git a/SRC/zhetf2_rook.f b/SRC/zhetf2_rook.f
index 04b313a69e..f9fd900c34 100644
--- a/SRC/zhetf2_rook.f
+++ b/SRC/zhetf2_rook.f
@@ -528,8 +528,8 @@ SUBROUTINE ZHETF2_ROOK( UPLO, N, A, LDA, IPIV, INFO )
 *                 D = |A12|
                   D = DLAPY2( DBLE( A( K-1, K ) ),
      $                DIMAG( A( K-1, K ) ) )
-                  D11 = A( K, K ) / D
-                  D22 = A( K-1, K-1 ) / D
+                  D11 = DBLE( A( K, K ) / D )
+                  D22 = DBLE( A( K-1, K-1 ) / D )
                   D12 = A( K-1, K ) / D
                   TT = ONE / ( D11*D22-ONE )
 *
diff --git a/SRC/zhetrd.f b/SRC/zhetrd.f
index b5bfa1cbc8..5b7d6546cc 100644
--- a/SRC/zhetrd.f
+++ b/SRC/zhetrd.f
@@ -325,7 +325,7 @@ SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
             DO 10 J = I, I + NB - 1
                A( J-1, J ) = E( J-1 )
-               D( J ) = A( J, J )
+               D( J ) = DBLE( A( J, J ) )
    10       CONTINUE
    20    CONTINUE
 *
@@ -357,7 +357,7 @@ SUBROUTINE ZHETRD( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
 *
             DO 30 J = I, I + NB - 1
                A( J+1, J ) = E( J )
-               D( J ) = A( J, J )
+               D( J ) = DBLE( A( J, J ) )
    30       CONTINUE
    40    CONTINUE
 *
diff --git a/SRC/zhetri2x.f b/SRC/zhetri2x.f
index a517419bcb..c1a3908dcf 100644
--- a/SRC/zhetri2x.f
+++ b/SRC/zhetri2x.f
@@ -239,8 +239,8 @@ SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
          ELSE
 *           2 x 2 diagonal NNB
              T = ABS ( WORK(K+1,1) )
-             AK = REAL ( A( K, K ) ) / T
-             AKP1 = REAL ( A( K+1, K+1 ) ) / T
+             AK = DBLE ( A( K, K ) ) / T
+             AKP1 = DBLE ( A( K+1, K+1 ) ) / T
              AKKP1 = WORK(K+1,1)  / T
              D = T*( AK*AKP1-ONE )
              WORK(K,INVD) = AKP1 / D
@@ -416,8 +416,8 @@ SUBROUTINE ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
          ELSE
 *           2 x 2 diagonal NNB
              T = ABS ( WORK(K-1,1) )
-             AK = REAL ( A( K-1, K-1 ) ) / T
-             AKP1 = REAL ( A( K, K ) ) / T
+             AK = DBLE ( A( K-1, K-1 ) ) / T
+             AKP1 = DBLE ( A( K, K ) ) / T
              AKKP1 = WORK(K-1,1) / T
              D = T*( AK*AKP1-ONE )
              WORK(K-1,INVD) = AKP1 / D
diff --git a/SRC/zhpev.f b/SRC/zhpev.f
index 56aa383cbd..bc43049d87 100644
--- a/SRC/zhpev.f
+++ b/SRC/zhpev.f
@@ -203,7 +203,7 @@ SUBROUTINE ZHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AP( 1 )
+         W( 1 ) = DBLE( AP( 1 ) )
          RWORK( 1 ) = 1
          IF( WANTZ )
      $      Z( 1, 1 ) = ONE
diff --git a/SRC/zhpevd.f b/SRC/zhpevd.f
index ab7e12d438..7625c8fe81 100644
--- a/SRC/zhpevd.f
+++ b/SRC/zhpevd.f
@@ -300,7 +300,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
      $   RETURN
 *
       IF( N.EQ.1 ) THEN
-         W( 1 ) = AP( 1 )
+         W( 1 ) = DBLE( AP( 1 ) )
          IF( WANTZ )
      $      Z( 1, 1 ) = CONE
          RETURN
diff --git a/SRC/zhpevx.f b/SRC/zhpevx.f
index 296ff39657..f22e84bd70 100644
--- a/SRC/zhpevx.f
+++ b/SRC/zhpevx.f
@@ -332,11 +332,11 @@ SUBROUTINE ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU,
       IF( N.EQ.1 ) THEN
          IF( ALLEIG .OR. INDEIG ) THEN
             M = 1
-            W( 1 ) = AP( 1 )
+            W( 1 ) = DBLE( AP( 1 ) )
          ELSE
             IF( VL.LT.DBLE( AP( 1 ) ) .AND. VU.GE.DBLE( AP( 1 ) ) ) THEN
                M = 1
-               W( 1 ) = AP( 1 )
+               W( 1 ) = DBLE( AP( 1 ) )
             END IF
          END IF
          IF( WANTZ )
diff --git a/SRC/zhpgst.f b/SRC/zhpgst.f
index 4592d25926..49822e09d7 100644
--- a/SRC/zhpgst.f
+++ b/SRC/zhpgst.f
@@ -182,7 +182,7 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *              Compute the j-th column of the upper triangle of A
 *
                AP( JJ ) = DBLE( AP( JJ ) )
-               BJJ = BP( JJ )
+               BJJ = DBLE( BP( JJ ) )
                CALL ZTPSV( UPLO, 'Conjugate transpose', 'Non-unit', J,
      $                     BP, AP( J1 ), 1 )
                CALL ZHPMV( UPLO, J-1, -CONE, AP, BP( J1 ), 1, CONE,
@@ -203,8 +203,8 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Update the lower triangle of A(k:n,k:n)
 *
-               AKK = AP( KK )
-               BKK = BP( KK )
+               AKK = DBLE( AP( KK ) )
+               BKK = DBLE( BP( KK ) )
                AKK = AKK / BKK**2
                AP( KK ) = AKK
                IF( K.LT.N ) THEN
@@ -234,8 +234,8 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Update the upper triangle of A(1:k,1:k)
 *
-               AKK = AP( KK )
-               BKK = BP( KK )
+               AKK = DBLE( AP( KK ) )
+               BKK = DBLE( BP( KK ) )
                CALL ZTPMV( UPLO, 'No transpose', 'Non-unit', K-1, BP,
      $                     AP( K1 ), 1 )
                CT = HALF*AKK
@@ -258,8 +258,8 @@ SUBROUTINE ZHPGST( ITYPE, UPLO, N, AP, BP, INFO )
 *
 *              Compute the j-th column of the lower triangle of A
 *
-               AJJ = AP( JJ )
-               BJJ = BP( JJ )
+               AJJ = DBLE( AP( JJ ) )
+               BJJ = DBLE( BP( JJ ) )
                AP( JJ ) = AJJ*BJJ + ZDOTC( N-J, AP( JJ+1 ), 1,
      $                    BP( JJ+1 ), 1 )
                CALL ZDSCAL( N-J, BJJ, AP( JJ+1 ), 1 )
diff --git a/SRC/zhptrd.f b/SRC/zhptrd.f
index 68b6a6ab9b..d933af8942 100644
--- a/SRC/zhptrd.f
+++ b/SRC/zhptrd.f
@@ -221,7 +221,7 @@ SUBROUTINE ZHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             ALPHA = AP( I1+I-1 )
             CALL ZLARFG( I, ALPHA, AP( I1 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = DBLE( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -246,11 +246,11 @@ SUBROUTINE ZHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             END IF
             AP( I1+I-1 ) = E( I )
-            D( I+1 ) = AP( I1+I )
+            D( I+1 ) = DBLE( AP( I1+I ) )
             TAU( I ) = TAUI
             I1 = I1 - I
    10    CONTINUE
-         D( 1 ) = AP( 1 )
+         D( 1 ) = DBLE( AP( 1 ) )
       ELSE
 *
 *        Reduce the lower triangle of A. II is the index in AP of
@@ -266,7 +266,7 @@ SUBROUTINE ZHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             ALPHA = AP( II+1 )
             CALL ZLARFG( N-I, ALPHA, AP( II+2 ), 1, TAUI )
-            E( I ) = ALPHA
+            E( I ) = DBLE( ALPHA )
 *
             IF( TAUI.NE.ZERO ) THEN
 *
@@ -293,11 +293,11 @@ SUBROUTINE ZHPTRD( UPLO, N, AP, D, E, TAU, INFO )
 *
             END IF
             AP( II+1 ) = E( I )
-            D( I ) = AP( II )
+            D( I ) = DBLE( AP( II ) )
             TAU( I ) = TAUI
             II = I1I1
    20    CONTINUE
-         D( N ) = AP( II )
+         D( N ) = DBLE( AP( II ) )
       END IF
 *
       RETURN
diff --git a/SRC/zlabrd.f b/SRC/zlabrd.f
index 55203d1f3c..ab3b3217fd 100644
--- a/SRC/zlabrd.f
+++ b/SRC/zlabrd.f
@@ -267,7 +267,7 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
             ALPHA = A( I, I )
             CALL ZLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
      $                   TAUQ( I ) )
-            D( I ) = ALPHA
+            D( I ) = DBLE( ALPHA )
             IF( I.LT.N ) THEN
                A( I, I ) = ONE
 *
@@ -307,7 +307,7 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
                ALPHA = A( I, I+1 )
                CALL ZLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ), LDA,
      $                      TAUP( I ) )
-               E( I ) = ALPHA
+               E( I ) = DBLE( ALPHA )
                A( I, I+1 ) = ONE
 *
 *              Compute X(i+1:m,i)
@@ -351,7 +351,7 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
             ALPHA = A( I, I )
             CALL ZLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
      $                   TAUP( I ) )
-            D( I ) = ALPHA
+            D( I ) = DBLE( ALPHA )
             IF( I.LT.M ) THEN
                A( I, I ) = ONE
 *
@@ -385,7 +385,7 @@ SUBROUTINE ZLABRD( M, N, NB, A, LDA, D, E, TAUQ, TAUP, X, LDX, Y,
                ALPHA = A( I+1, I )
                CALL ZLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
      $                      TAUQ( I ) )
-               E( I ) = ALPHA
+               E( I ) = DBLE( ALPHA )
                A( I+1, I ) = ONE
 *
 *              Compute Y(i+1:n,i)
diff --git a/SRC/zlaic1.f b/SRC/zlaic1.f
index 08fd3a749a..72948cde9f 100644
--- a/SRC/zlaic1.f
+++ b/SRC/zlaic1.f
@@ -191,7 +191,7 @@ SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             ELSE
                S = ALPHA / S1
                C = GAMMA / S1
-               TMP = SQRT( S*DCONJG( S )+C*DCONJG( C ) )
+               TMP = DBLE( SQRT( S*DCONJG( S )+C*DCONJG( C ) ) )
                S = S / TMP
                C = C / TMP
                SESTPR = S1*TMP
@@ -245,14 +245,16 @@ SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
             C = ZETA1*ZETA1
             IF( B.GT.ZERO ) THEN
-               T = C / ( B+SQRT( B*B+C ) )
+               T = DBLE( C / ( B+SQRT( B*B+C ) ) )
             ELSE
-               T = SQRT( B*B+C ) - B
+               T = DBLE( SQRT( B*B+C ) - B )
             END IF
 *
             SINE = -( ALPHA / ABSEST ) / T
             COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
-            TMP = SQRT( SINE*DCONJG( SINE )+COSINE*DCONJG( COSINE ) )
+            TMP = DBLE( SQRT( SINE * DCONJG( SINE )
+     $        + COSINE * DCONJG( COSINE ) ) )
+
             S = SINE / TMP
             C = COSINE / TMP
             SESTPR = SQRT( T+ONE )*ABSEST
@@ -277,7 +279,7 @@ SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
             S1 = MAX( ABS( SINE ), ABS( COSINE ) )
             S = SINE / S1
             C = COSINE / S1
-            TMP = SQRT( S*DCONJG( S )+C*DCONJG( C ) )
+            TMP = DBLE( SQRT( S*DCONJG( S )+C*DCONJG( C ) ) )
             S = S / TMP
             C = C / TMP
             RETURN
@@ -335,7 +337,7 @@ SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
 *
                B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
                C = ZETA2*ZETA2
-               T = C / ( B+SQRT( ABS( B*B-C ) ) )
+               T = DBLE( C / ( B+SQRT( ABS( B*B-C ) ) ) )
                SINE = ( ALPHA / ABSEST ) / ( ONE-T )
                COSINE = -( GAMMA / ABSEST ) / T
                SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
@@ -354,7 +356,8 @@ SUBROUTINE ZLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
                COSINE = -( GAMMA / ABSEST ) / ( ONE+T )
                SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
             END IF
-            TMP = SQRT( SINE*DCONJG( SINE )+COSINE*DCONJG( COSINE ) )
+            TMP = DBLE( SQRT( SINE * DCONJG( SINE )
+     $        + COSINE * DCONJG( COSINE ) ) )
             S = SINE / TMP
             C = COSINE / TMP
             RETURN
diff --git a/SRC/zlarfgp.f b/SRC/zlarfgp.f
index 7cf0d47862..77eba8e869 100644
--- a/SRC/zlarfgp.f
+++ b/SRC/zlarfgp.f
@@ -235,7 +235,7 @@ SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU )
                   DO J = 1, N-1
                      X( 1 + (J-1)*INCX ) = ZERO
                   END DO
-                  BETA = -SAVEALPHA
+                  BETA = DBLE( -SAVEALPHA )
                END IF
             ELSE
                XNORM = DLAPY2( ALPHR, ALPHI )
diff --git a/SRC/zlatrd.f b/SRC/zlatrd.f
index 538ac0aaca..ee2a484723 100644
--- a/SRC/zlatrd.f
+++ b/SRC/zlatrd.f
@@ -268,7 +268,7 @@ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
 *
                ALPHA = A( I-1, I )
                CALL ZLARFG( I-1, ALPHA, A( 1, I ), 1, TAU( I-1 ) )
-               E( I-1 ) = ALPHA
+               E( I-1 ) = DBLE( ALPHA )
                A( I-1, I ) = ONE
 *
 *              Compute W(1:i-1,i)
@@ -322,7 +322,7 @@ SUBROUTINE ZLATRD( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
                ALPHA = A( I+1, I )
                CALL ZLARFG( N-I, ALPHA, A( MIN( I+2, N ), I ), 1,
      $                      TAU( I ) )
-               E( I ) = ALPHA
+               E( I ) = DBLE( ALPHA )
                A( I+1, I ) = ONE
 *
 *              Compute W(i+1:n,i)
diff --git a/SRC/zlauu2.f b/SRC/zlauu2.f
index d899a36662..7d7faebdf5 100644
--- a/SRC/zlauu2.f
+++ b/SRC/zlauu2.f
@@ -162,7 +162,7 @@ SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
 *        Compute the product U * U**H.
 *
          DO 10 I = 1, N
-            AII = A( I, I )
+            AII = DBLE( A( I, I ) )
             IF( I.LT.N ) THEN
                A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I, I+1 ), LDA,
      $                     A( I, I+1 ), LDA ) )
@@ -181,7 +181,7 @@ SUBROUTINE ZLAUU2( UPLO, N, A, LDA, INFO )
 *        Compute the product L**H * L.
 *
          DO 20 I = 1, N
-            AII = A( I, I )
+            AII = DBLE( A( I, I ) )
             IF( I.LT.N ) THEN
                A( I, I ) = AII*AII + DBLE( ZDOTC( N-I, A( I+1, I ), 1,
      $                     A( I+1, I ), 1 ) )
diff --git a/SRC/zpoequb.f b/SRC/zpoequb.f
index 5d48851baa..fd8a000b2a 100644
--- a/SRC/zpoequb.f
+++ b/SRC/zpoequb.f
@@ -180,11 +180,11 @@ SUBROUTINE ZPOEQUB( N, A, LDA, S, SCOND, AMAX, INFO )
 *
 *     Find the minimum and maximum diagonal elements.
 *
-      S( 1 ) = A( 1, 1 )
+      S( 1 ) = DBLE( A( 1, 1 ) )
       SMIN = S( 1 )
       AMAX = S( 1 )
       DO 10 I = 2, N
-         S( I ) = A( I, I )
+         S( I ) = DBLE( A( I, I ) )
          SMIN = MIN( SMIN, S( I ) )
          AMAX = MAX( AMAX, S( I ) )
    10 CONTINUE
diff --git a/SRC/zpotf2.f b/SRC/zpotf2.f
index 19ceeb727c..eb88d617cc 100644
--- a/SRC/zpotf2.f
+++ b/SRC/zpotf2.f
@@ -174,8 +174,8 @@ SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO )
 *
 *           Compute U(J,J) and test for non-positive-definiteness.
 *
-            AJJ = DBLE( A( J, J ) ) - ZDOTC( J-1, A( 1, J ), 1,
-     $            A( 1, J ), 1 )
+            AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( 1, J ), 1,
+     $            A( 1, J ), 1 ) )
             IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
                A( J, J ) = AJJ
                GO TO 30
@@ -201,8 +201,8 @@ SUBROUTINE ZPOTF2( UPLO, N, A, LDA, INFO )
 *
 *           Compute L(J,J) and test for non-positive-definiteness.
 *
-            AJJ = DBLE( A( J, J ) ) - ZDOTC( J-1, A( J, 1 ), LDA,
-     $            A( J, 1 ), LDA )
+            AJJ = DBLE( A( J, J ) ) - DBLE( ZDOTC( J-1, A( J, 1 ), LDA,
+     $            A( J, 1 ), LDA ) )
             IF( AJJ.LE.ZERO.OR.DISNAN( AJJ ) ) THEN
                A( J, J ) = AJJ
                GO TO 30
diff --git a/SRC/zpptrf.f b/SRC/zpptrf.f
index 2903088190..a34d639131 100644
--- a/SRC/zpptrf.f
+++ b/SRC/zpptrf.f
@@ -189,8 +189,8 @@ SUBROUTINE ZPPTRF( UPLO, N, AP, INFO )
 *
 *           Compute U(J,J) and test for non-positive-definiteness.
 *
-            AJJ = DBLE( AP( JJ ) ) - ZDOTC( J-1, AP( JC ), 1, AP( JC ),
-     $            1 )
+            AJJ = DBLE( AP( JJ ) ) - DBLE( ZDOTC( J-1,
+     $            AP( JC ), 1, AP( JC ), 1 ) )
             IF( AJJ.LE.ZERO ) THEN
                AP( JJ ) = AJJ
                GO TO 30
diff --git a/SRC/zpptri.f b/SRC/zpptri.f
index 5a02deb006..a74466eb80 100644
--- a/SRC/zpptri.f
+++ b/SRC/zpptri.f
@@ -161,7 +161,7 @@ SUBROUTINE ZPPTRI( UPLO, N, AP, INFO )
             JJ = JJ + J
             IF( J.GT.1 )
      $         CALL ZHPR( 'Upper', J-1, ONE, AP( JC ), 1, AP )
-            AJJ = AP( JJ )
+            AJJ = DBLE( AP( JJ ) )
             CALL ZDSCAL( J, AJJ, AP( JC ), 1 )
    10    CONTINUE
 *
diff --git a/SRC/zsyequb.f b/SRC/zsyequb.f
index 3b13d14d0e..84d5330ad3 100644
--- a/SRC/zsyequb.f
+++ b/SRC/zsyequb.f
@@ -263,7 +263,7 @@ SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
 *        avg = s^T beta / n
          AVG = 0.0D0
          DO I = 1, N
-            AVG = AVG + S( I )*WORK( I )
+            AVG = AVG + S( I ) * DBLE( WORK( I ) )
          END DO
          AVG = AVG / N
 
@@ -280,8 +280,8 @@ SUBROUTINE ZSYEQUB( 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 = ( N-2 ) * ( DBLE( WORK( I ) ) - T*SI )
+            C0 = -(T*SI)*SI + 2 * DBLE( WORK( I ) ) * SI - N*AVG
             D = C1*C1 - 4*C0*C2
 
             IF ( D .LE. 0 ) THEN
@@ -316,7 +316,7 @@ SUBROUTINE ZSYEQUB( UPLO, N, A, LDA, S, SCOND, AMAX, WORK, INFO )
                END DO
             END IF
 
-            AVG = AVG + ( U + WORK( I ) ) * D / N
+            AVG = AVG + ( U + DBLE( WORK( I ) ) ) * D / N
             S( I ) = SI
          END DO
       END DO
diff --git a/SRC/zsysv.f b/SRC/zsysv.f
index e143315ac8..ed173dadca 100644
--- a/SRC/zsysv.f
+++ b/SRC/zsysv.f
@@ -223,7 +223,7 @@ SUBROUTINE ZSYSV( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = DBLE( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/zsysv_rk.f b/SRC/zsysv_rk.f
index da4f31a7fb..df828ee337 100644
--- a/SRC/zsysv_rk.f
+++ b/SRC/zsysv_rk.f
@@ -280,7 +280,7 @@ SUBROUTINE ZSYSV_RK( UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = DBLE( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/zsysv_rook.f b/SRC/zsysv_rook.f
index 56ceb76663..7c9fb4bf64 100644
--- a/SRC/zsysv_rook.f
+++ b/SRC/zsysv_rook.f
@@ -256,7 +256,7 @@ SUBROUTINE ZSYSV_ROOK( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK,
             LWKOPT = 1
          ELSE
             CALL ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
-            LWKOPT = WORK(1)
+            LWKOPT = DBLE( WORK(1) )
          END IF
          WORK( 1 ) = LWKOPT
       END IF
diff --git a/SRC/zsytri2x.f b/SRC/zsytri2x.f
index a5fe2a46c6..61814ae6d8 100644
--- a/SRC/zsytri2x.f
+++ b/SRC/zsytri2x.f
@@ -231,7 +231,7 @@ SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
         DO WHILE ( K .LE. N )
          IF( IPIV( K ).GT.0 ) THEN
 *           1 x 1 diagonal NNB
-             WORK(K,INVD) = 1/  A( K, K )
+             WORK(K,INVD) = ONE / A( K, K )
              WORK(K,INVD+1) = 0
             K=K+1
          ELSE
@@ -408,7 +408,7 @@ SUBROUTINE ZSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NB, INFO )
         DO WHILE ( K .GE. 1 )
          IF( IPIV( K ).GT.0 ) THEN
 *           1 x 1 diagonal NNB
-             WORK(K,INVD) = 1/  A( K, K )
+             WORK(K,INVD) = ONE / A( K, K )
              WORK(K,INVD+1) = 0
             K=K-1
          ELSE
diff --git a/SRC/zungbr.f b/SRC/zungbr.f
index 49c6fc8d13..3dfca43be2 100644
--- a/SRC/zungbr.f
+++ b/SRC/zungbr.f
@@ -233,7 +233,7 @@ SUBROUTINE ZUNGBR( VECT, M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
                END IF
             END IF
          END IF
-         LWKOPT = WORK( 1 )
+         LWKOPT = DBLE( WORK( 1 ) )
          LWKOPT = MAX (LWKOPT, MN)
       END IF
 *