Revert "Avoid memory corruption with non-finite inputs in ?GEEV"

Adjust line reflow in LA_GEAM for ILP64 build

.github/workflows/scorecard.yml

@@ -32,12 +32,12 @@ jobs:
 
     steps:
       - name: "Checkout code"
-        uses: actions/checkout@c85c95e3d7251135ab7dc9ce3241c5835cc595a9 # v3.5.3
+        uses: actions/checkout@d632683dd7b4114ad314bca15554477dd762a938 # tag=v4.2.0
         with:
           persist-credentials: false
 
       - name: "Run analysis"
-        uses: ossf/scorecard-action@08b4669551908b1024bb425080c797723083c031 # v2.2.0
+        uses: ossf/scorecard-action@62b2cac7ed8198b15735ed49ab1e5cf35480ba46 # v2.4.0
         with:
           results_file: results.sarif
           results_format: sarif
@@ -59,7 +59,7 @@ jobs:
       # Upload the results as artifacts (optional). Commenting out will disable uploads of run results in SARIF
       # format to the repository Actions tab.
       - name: "Upload artifact"
-        uses: actions/upload-artifact@0b7f8abb1508181956e8e162db84b466c27e18ce # v3.1.2
+        uses: actions/upload-artifact@b4b15b8c7c6ac21ea08fcf65892d2ee8f75cf882 # v4.4.3
         with:
           name: SARIF file
           path: results.sarif
@@ -67,6 +67,6 @@ jobs:
 
       # Upload the results to GitHub's code scanning dashboard.
       - name: "Upload to code-scanning"
-        uses: github/codeql-action/upload-sarif@f9a7c6738f28efb36e31d49c53a201a9c5d6a476 # v2.14.2
+        uses: github/codeql-action/upload-sarif@662472033e021d55d94146f66f6058822b0b39fd # v3.27.0
         with:
           sarif_file: results.sarif

.gitignore

@@ -43,3 +43,7 @@ build*
 DOCS/man
 DOCS/explore-html
 output_err
+
+# Mod files from compilation in SRC
+SRC/la_constants.mod
+SRC/la_xisnan.mod

BLAS/SRC/CMakeLists.txt

@@ -32,7 +32,7 @@
 set(SBLAS1 isamax.f sasum.f saxpy.f scopy.f sdot.f snrm2.f90
 	srot.f srotg.f90 sscal.f sswap.f sdsdot.f srotmg.f srotm.f)
 
-set(CBLAS1 scabs1.f scasum.f scnrm2.f90 icamax.f caxpy.f ccopy.f
+set(CBLAS1 scabs1.f scasum.f scnrm2.f90 icamax.f90 caxpy.f ccopy.f
 	cdotc.f cdotu.f csscal.f crotg.f90 cscal.f cswap.f csrot.f)
 
 set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f90
@@ -40,7 +40,7 @@ set(DBLAS1 idamax.f dasum.f daxpy.f dcopy.f ddot.f dnrm2.f90
 
 set(DB1AUX sscal.f isamax.f)
 
-set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f90 izamax.f zaxpy.f zcopy.f
+set(ZBLAS1 dcabs1.f dzasum.f dznrm2.f90 izamax.f90 zaxpy.f zcopy.f
 	zdotc.f zdotu.f zdscal.f zrotg.f90 zscal.f zswap.f zdrot.f)
 
 set(CB1AUX
@@ -49,7 +49,7 @@ set(CB1AUX
     sswap.f)
 
 set(ZB1AUX
-    icamax.f idamax.f
+    icamax.f90 idamax.f
     cgemm.f cherk.f cscal.f ctrsm.f
     dasum.f daxpy.f dcopy.f ddot.f dgemm.f dgemv.f dnrm2.f90 drot.f dscal.f
     dswap.f

BLAS/SRC/cgemmtr.f

@@ -50,9 +50,9 @@
 *>           On entry, UPLO specifies whether the lower or the upper
 *>           triangular part of C is access and updated.
 *>
-*>              UPLO = 'L' or 'l', the lower tringular part of C is used.
+*>              UPLO = 'L' or 'l', the lower triangular part of C is used.
 *>
-*>              UPLO = 'U' or 'u', the upper tringular part of C is used.
+*>              UPLO = 'U' or 'u', the upper triangular part of C is used.
 *> \endverbatim
 *
 *> \param[in] TRANSA
@@ -154,7 +154,7 @@
 *>           Before entry, the leading  n by n  part of the array  C must
 *>           contain the matrix  C,  except when  beta  is zero, in which
 *>           case C need not be set on entry.
-*>           On exit, the upper or lower trinangular part of the matrix
+*>           On exit, the upper or lower triangular part of the matrix
 *>           C  is overwritten by the n by n matrix
 *>           ( alpha*op( A )*op( B ) + beta*C ).
 *> \endverbatim

BLAS/SRC/dgemmtr.f

@@ -50,9 +50,9 @@
 *>           On entry, UPLO specifies whether the lower or the upper
 *>           triangular part of C is access and updated.
 *>
-*>              UPLO = 'L' or 'l', the lower tringular part of C is used.
+*>              UPLO = 'L' or 'l', the lower triangular part of C is used.
 *>
-*>              UPLO = 'U' or 'u', the upper tringular part of C is used.
+*>              UPLO = 'U' or 'u', the upper triangular part of C is used.
 *> \endverbatim
 *
 *> \param[in] TRANSA
@@ -154,7 +154,7 @@
 *>           Before entry, the leading  n by n  part of the array  C must
 *>           contain the matrix  C,  except when  beta  is zero, in which
 *>           case C need not be set on entry.
-*>           On exit, the upper or lower trinangular part of the matrix
+*>           On exit, the upper or lower triangular part of the matrix
 *>           C  is overwritten by the n by n matrix
 *>           ( alpha*op( A )*op( B ) + beta*C ).
 *> \endverbatim

BLAS/SRC/dnrm2.f90

@@ -89,7 +89,7 @@ function DNRM2( n, x, incx )
    integer, parameter :: wp = kind(1.d0)
    real(wp) :: DNRM2
 !
-!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS level1 routine --
 !  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 !  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 !     March 2021

BLAS/SRC/drotm.f

@@ -38,6 +38,10 @@
 *>    H=(          )    (          )    (          )    (          )
 *>      (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0).
 *>    SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM.
+*>
+*>    IF DFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED.
+*>    NANS IN DFLAG MAY NOT PROPAGATE TO THE OUTPUT.
+*>
 *> \endverbatim
 *
 *  Arguments:

BLAS/SRC/dznrm2.f90

@@ -90,7 +90,7 @@ function DZNRM2( n, x, incx )
    integer, parameter :: wp = kind(1.d0)
    real(wp) :: DZNRM2
 !
-!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS level1 routine --
 !  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 !  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 !     March 2021

BLAS/SRC/icamax.f90

@@ -0,0 +1,189 @@
+!> \brief \b ICAMAX
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!       INTEGER FUNCTION ICAMAX(N,X,INCX)
+!
+!       .. Scalar Arguments ..
+!       INTEGER INCX,N
+!       ..
+!       .. Array Arguments ..
+!       COMPLEX X(*)
+!       ..
+!
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!>  ICAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in] N
+!> \verbatim
+!>          N is INTEGER
+!>         number of elements in input vector(s)
+!> \endverbatim
+!>
+!> \param[in] X
+!> \verbatim
+!>          X is COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+!> \endverbatim
+!>
+!> \param[in] INCX
+!> \verbatim
+!>          INCX is INTEGER
+!>         storage spacing between elements of X
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> James Demmel, University of California Berkeley, USA
+!> Weslley Pereira, National Renewable Energy Laboratory, USA
+!
+!> \ingroup iamax
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!> James Demmel et al. Proposed Consistent Exception Handling for the BLAS and
+!> LAPACK, 2022 (https://arxiv.org/abs/2207.09281).
+!>
+!> \endverbatim
+!>
+!  =====================================================================
+integer function icamax(n, x, incx)
+   integer, parameter :: wp = kind(1.e0)
+!
+!  -- Reference BLAS level1 routine --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!
+!  .. Constants ..
+   real(wp), parameter :: hugeval = huge(0.0_wp)
+!
+!  .. Scalar Arguments ..
+   integer :: n, incx
+!
+!  .. Array Arguments ..
+   complex(wp) :: x(*)
+!  ..
+!  .. Local Scalars ..
+   integer :: i, j, ix, jx
+   real(wp) :: val, smax
+   logical :: scaledsmax
+!
+!  Quick return if possible
+!
+   icamax = 0
+   if (n < 1 .or. incx < 1) return
+!
+   icamax = 1
+   if (n == 1) return
+!
+   icamax = 0
+   scaledsmax = .false.
+   smax = -1
+!
+!  scaledsmax = .true. indicates that x(icamax) is finite but
+!  abs(real(x(icamax))) + abs(imag(x(icamax))) overflows
+!
+   if (incx == 1) then
+      ! code for increment equal to 1
+      do i = 1, n
+         if (x(i) /= x(i)) then
+            ! return when first NaN found
+            icamax = i
+            return
+         elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
+            ! keep looking for first NaN
+            do j = i+1, n
+               if (x(j) /= x(j)) then
+                  ! return when first NaN found
+                  icamax = j
+                  return
+               endif
+            enddo
+            ! record location of first Inf
+            icamax = i
+            return
+         else ! still no Inf found yet
+            if (.not. scaledsmax) then
+               ! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
+               val = abs(real(x(i))) + abs(imag(x(i)))
+               if (val > hugeval) then
+                  scaledsmax = .true.
+                  smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
+                  icamax = i
+               elseif (val > smax) then ! everything finite so far
+                  smax = val
+                  icamax = i
+               endif
+            else ! scaledsmax
+               val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
+               if (val > smax) then
+                  smax = val
+                  icamax = i
+               endif
+            endif
+         endif
+      end do
+   else
+      ! code for increment not equal to 1
+      ix = 1
+      do i = 1, n
+         if (x(ix) /= x(ix)) then
+            ! return when first NaN found
+            icamax = i
+            return
+         elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
+            ! keep looking for first NaN
+            jx = ix + incx
+            do j = i+1, n
+               if (x(jx) /= x(jx)) then
+                  ! return when first NaN found
+                  icamax = j
+                  return
+               endif
+               jx = jx + incx
+            enddo
+            ! record location of first Inf
+            icamax = i
+            return
+         else ! still no Inf found yet
+            if (.not. scaledsmax) then
+               ! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
+               val = abs(real(x(ix))) + abs(imag(x(ix)))
+               if (val > hugeval) then
+                  scaledsmax = .true.
+                  smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
+                  icamax = i
+               elseif (val > smax) then ! everything finite so far
+                  smax = val
+                  icamax = i
+               endif
+            else ! scaledsmax
+               val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
+               if (val > smax) then
+                  smax = val
+                  icamax = i
+               endif
+            endif
+         endif
+         ix = ix + incx
+      end do
+   endif
+end

BLAS/SRC/izamax.f90

@@ -0,0 +1,189 @@
+!> \brief \b IZAMAX
+!
+!  =========== DOCUMENTATION ===========
+!
+! Online html documentation available at
+!            http://www.netlib.org/lapack/explore-html/
+!
+!  Definition:
+!  ===========
+!
+!       INTEGER FUNCTION IZAMAX(N,X,INCX)
+!
+!       .. Scalar Arguments ..
+!       INTEGER INCX,N
+!       ..
+!       .. Array Arguments ..
+!       DOUBLE COMPLEX X(*)
+!       ..
+!
+!
+!> \par Purpose:
+!  =============
+!>
+!> \verbatim
+!>
+!>  IZAMAX finds the index of the first element having maximum |Re(.)| + |Im(.)|
+!> \endverbatim
+!
+!  Arguments:
+!  ==========
+!
+!> \param[in] N
+!> \verbatim
+!>          N is INTEGER
+!>         number of elements in input vector(s)
+!> \endverbatim
+!>
+!> \param[in] X
+!> \verbatim
+!>          X is DOUBLE COMPLEX array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
+!> \endverbatim
+!>
+!> \param[in] INCX
+!> \verbatim
+!>          INCX is INTEGER
+!>         storage spacing between elements of X
+!> \endverbatim
+!
+!  Authors:
+!  ========
+!
+!> James Demmel, University of California Berkeley, USA
+!> Weslley Pereira, National Renewable Energy Laboratory, USA
+!
+!> \ingroup iamax
+!
+!> \par Further Details:
+!  =====================
+!>
+!> \verbatim
+!>
+!> James Demmel et al. Proposed Consistent Exception Handling for the BLAS and
+!> LAPACK, 2022 (https://arxiv.org/abs/2207.09281).
+!>
+!> \endverbatim
+!>
+!  =====================================================================
+integer function izamax(n, x, incx)
+   integer, parameter :: wp = kind(1.d0)
+!
+!  -- Reference BLAS level1 routine --
+!  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
+!  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+!
+!  .. Constants ..
+   real(wp), parameter :: hugeval = huge(0.0_wp)
+!
+!  .. Scalar Arguments ..
+   integer :: n, incx
+!
+!  .. Array Arguments ..
+   complex(wp) :: x(*)
+!  ..
+!  .. Local Scalars ..
+   integer :: i, j, ix, jx
+   real(wp) :: val, smax
+   logical :: scaledsmax
+!
+!  Quick return if possible
+!
+   izamax = 0
+   if (n < 1 .or. incx < 1) return
+!
+   izamax = 1
+   if (n == 1) return
+!
+   izamax = 0
+   scaledsmax = .false.
+   smax = -1
+!
+!  scaledsmax = .true. indicates that x(izamax) is finite but
+!  abs(real(x(izamax))) + abs(imag(x(izamax))) overflows
+!
+   if (incx == 1) then
+      ! code for increment equal to 1
+      do i = 1, n
+         if (x(i) /= x(i)) then
+            ! return when first NaN found
+            izamax = i
+            return
+         elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
+            ! keep looking for first NaN
+            do j = i+1, n
+               if (x(j) /= x(j)) then
+                  ! return when first NaN found
+                  izamax = j
+                  return
+               endif
+            enddo
+            ! record location of first Inf
+            izamax = i
+            return
+         else ! still no Inf found yet
+            if (.not. scaledsmax) then
+               ! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
+               val = abs(real(x(i))) + abs(imag(x(i)))
+               if (val > hugeval) then
+                  scaledsmax = .true.
+                  smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
+                  izamax = i
+               elseif (val > smax) then ! everything finite so far
+                  smax = val
+                  izamax = i
+               endif
+            else ! scaledsmax
+               val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
+               if (val > smax) then
+                  smax = val
+                  izamax = i
+               endif
+            endif
+         endif
+      end do
+   else
+      ! code for increment not equal to 1
+      ix = 1
+      do i = 1, n
+         if (x(ix) /= x(ix)) then
+            ! return when first NaN found
+            izamax = i
+            return
+         elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
+            ! keep looking for first NaN
+            jx = ix + incx
+            do j = i+1, n
+               if (x(jx) /= x(jx)) then
+                  ! return when first NaN found
+                  izamax = j
+                  return
+               endif
+               jx = jx + incx
+            enddo
+            ! record location of first Inf
+            izamax = i
+            return
+         else ! still no Inf found yet
+            if (.not. scaledsmax) then
+               ! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
+               val = abs(real(x(ix))) + abs(imag(x(ix)))
+               if (val > hugeval) then
+                  scaledsmax = .true.
+                  smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
+                  izamax = i
+               elseif (val > smax) then ! everything finite so far
+                  smax = val
+                  izamax = i
+               endif
+            else ! scaledsmax
+               val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
+               if (val > smax) then
+                  smax = val
+                  izamax = i
+               endif
+            endif
+         endif
+         ix = ix + incx
+      end do
+   endif
+end

BLAS/SRC/scnrm2.f90

@@ -90,7 +90,7 @@ function SCNRM2( n, x, incx )
    integer, parameter :: wp = kind(1.e0)
    real(wp) :: SCNRM2
 !
-!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS level1 routine --
 !  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 !  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 !     March 2021

BLAS/SRC/sgemmtr.f

@@ -50,9 +50,9 @@
 *>           On entry, UPLO specifies whether the lower or the upper
 *>           triangular part of C is access and updated.
 *>
-*>              UPLO = 'L' or 'l', the lower tringular part of C is used.
+*>              UPLO = 'L' or 'l', the lower triangular part of C is used.
 *>
-*>              UPLO = 'U' or 'u', the upper tringular part of C is used.
+*>              UPLO = 'U' or 'u', the upper triangular part of C is used.
 *> \endverbatim
 *
 *> \param[in] TRANSA
@@ -154,7 +154,7 @@
 *>           Before entry, the leading  n by n  part of the array  C must
 *>           contain the matrix  C,  except when  beta  is zero, in which
 *>           case C need not be set on entry.
-*>           On exit, the upper or lower trinangular part of the matrix
+*>           On exit, the upper or lower triangular part of the matrix
 *>           C  is overwritten by the n by n matrix
 *>           ( alpha*op( A )*op( B ) + beta*C ).
 *> \endverbatim

BLAS/SRC/snrm2.f90

@@ -89,7 +89,7 @@ function SNRM2( n, x, incx )
    integer, parameter :: wp = kind(1.e0)
    real(wp) :: SNRM2
 !
-!  -- Reference BLAS level1 routine (version 3.9.1) --
+!  -- Reference BLAS level1 routine --
 !  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
 !  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 !     March 2021

BLAS/SRC/srotm.f

@@ -39,6 +39,9 @@
 *>      (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0).
 *>    SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM.
 *>
+*>    IF SFLAG IS NOT ONE OF THE LISTED ABOVE, THE BEHAVIOR IS UNDEFINED.
+*>    NANS IN SFLAG MAY NOT PROPAGATE TO THE OUTPUT.
+*>
 *> \endverbatim
 *
 *  Arguments:

BLAS/SRC/zgemmtr.f

@@ -50,9 +50,9 @@
 *>           On entry, UPLO specifies whether the lower or the upper
 *>           triangular part of C is access and updated.
 *>
-*>              UPLO = 'L' or 'l', the lower tringular part of C is used.
+*>              UPLO = 'L' or 'l', the lower triangular part of C is used.
 *>
-*>              UPLO = 'U' or 'u', the upper tringular part of C is used.
+*>              UPLO = 'U' or 'u', the upper triangular part of C is used.
 *> \endverbatim
 *
 *> \param[in] TRANSA
@@ -154,7 +154,7 @@
 *>           Before entry, the leading  n by n  part of the array  C must
 *>           contain the matrix  C,  except when  beta  is zero, in which
 *>           case C need not be set on entry.
-*>           On exit, the upper or lower trinangular part of the matrix
+*>           On exit, the upper or lower triangular part of the matrix
 *>           C  is overwritten by the n by n matrix
 *>           ( alpha*op( A )*op( B ) + beta*C ).
 *> \endverbatim

BLAS/TESTING/cblat3.f

@@ -20,7 +20,7 @@
 *>
 *> The program must be driven by a short data file. The first 14 records
 *> of the file are read using list-directed input, the last 10 records
-*> are read using the format ( A6, L2 ). An annotated example of a data
+*> are read using the format ( A7, L2 ). An annotated example of a data
 *> file can be obtained by deleting the first 3 characters from the
 *> following 23 lines:
 *> 'cblat3.out'      NAME OF SUMMARY OUTPUT FILE
@@ -389,7 +389,7 @@
      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
      $      /' ******* TESTS ABANDONED *******' )
- 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T',
      $      'ESTS ABANDONED *******' )
  9989 FORMAT( ' ERROR IN CMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
      $      'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -674,15 +674,15 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',',
      $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -953,15 +953,15 @@
   120 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
      $      ',', F4.1, '), C,', I3, ')    .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1263,15 +1263,15 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
      $      '      .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1591,19 +1591,19 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
      $      '          .' )
- 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
      $      '), C,', I3, ')          .' )
  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1964,19 +1964,19 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
      $      ', C,', I3, ')           .' )
- 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
      $      ',', F4.1, '), C,', I3, ')    .' )
  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -2019,7 +2019,7 @@
       COMPLEX            A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
 *     .. External Subroutines ..
       EXTERNAL           CGEMM, CHEMM, CHER2K, CHERK, CHKXER, CSYMM,
-     $                   CSYR2K, CSYRK, CTRMM, CTRSM
+     $                   CSYR2K, CSYRK, CTRMM, CTRSM, CGEMMTR
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
@@ -3115,8 +3115,8 @@
       END IF
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
- 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+ 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
      $      '**' )
 *
 *     End of CCHKE
@@ -3629,7 +3629,7 @@
       RETURN
 *
  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
-     $      'ETECTED BY ', A6, ' *****' )
+     $      'ETECTED BY ', A7, ' *****' )
 *
 *     End of CHKXER
 *
@@ -3663,6 +3663,8 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUT, OK, LERR
       COMMON             /SRNAMC/SRNAMT
+*     .. Locals ..
+      INTEGER            SRLEN
 *     .. Executable Statements ..
       LERR = .TRUE.
       IF( INFO.NE.INFOT )THEN
@@ -3673,7 +3675,8 @@
          END IF
          OK = .FALSE.
       END IF
-      IF( SRNAME.NE.SRNAMT )THEN
+      SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
+      IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
          OK = .FALSE.
       END IF
@@ -3681,8 +3684,8 @@
 *
  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
      $      ' OF ', I2, ' *******' )
- 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
-     $      'AD OF ', A6, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A7, ' INSTE',
+     $      'AD OF ', A7, ' *******' )
  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
      $      ' *******' )
 *
@@ -3738,7 +3741,7 @@
       LOGICAL            LCE, LCERES
       EXTERNAL           LCE, LCERES
 *     .. External Subroutines ..
-      EXTERNAL           CGEMM, CMAKE, CMMCH
+      EXTERNAL           CGEMMTR, CMAKE, CMMTCH
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     .. Scalars in Common ..
@@ -3956,21 +3959,21 @@
 *
   120 CONTINUE
       WRITE( NOUT, FMT = 9996 )SNAME
-      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
+      WRITE( NOUT, FMT = 9995 )NC, SNAME, UPLO, TRANSA, TRANSB, N, K,
      $   ALPHA, LDA, LDB, BETA, LDC
 *
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',',
      $      2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',

BLAS/TESTING/dblat3.f

@@ -20,7 +20,7 @@
 *>
 *> The program must be driven by a short data file. The first 14 records
 *> of the file are read using list-directed input, the last 7 records
-*> are read using the format ( A6, L2 ). An annotated example of a data
+*> are read using the format ( A7, L2 ). An annotated example of a data
 *> file can be obtained by deleting the first 3 characters from the
 *> following 21 lines:
 *> 'dblat3.out'      NAME OF SUMMARY OUTPUT FILE
@@ -122,6 +122,7 @@
       EXTERNAL           DDIFF, LDE
 *     .. External Subroutines ..
       EXTERNAL           DCHK1, DCHK2, DCHK3, DCHK4, DCHK5, DCHKE, DMMCH
+      EXTERNAL           DCHK6
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     .. Scalars in Common ..
@@ -379,7 +380,7 @@
  9992 FORMAT( '   FOR BETA           ', 7F6.1 )
  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
      $      /' ******* TESTS ABANDONED *******' )
- 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T',
      $      'ESTS ABANDONED *******' )
  9989 FORMAT( ' ERROR IN DMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
      $      'ATED WRONGLY.', /' DMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -660,15 +661,15 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',',
      $      3( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
      $      'C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -930,15 +931,15 @@
   120 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
      $      ' .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1236,15 +1237,15 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ', B,', I3, ')        .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
@@ -1510,16 +1511,16 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')           .' )
  9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
      $      '******' )
@@ -1823,16 +1824,16 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', C,', I3, ')   ',
      $      ' .' )
  9993 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1873,7 +1874,7 @@
       DOUBLE PRECISION   A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
 *     .. External Subroutines ..
       EXTERNAL           CHKXER, DGEMM, DSYMM, DSYR2K, DSYRK, DTRMM,
-     $                   DTRSM
+     $                   DTRSM, DGEMMTR
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
 *     .. Executable Statements ..
@@ -2468,8 +2469,8 @@
       END IF
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
- 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+ 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
      $      '**' )
 *
 *     End of DCHKE
@@ -2893,7 +2894,7 @@
       RETURN
 *
  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
-     $      'ETECTED BY ', A6, ' *****' )
+     $      'ETECTED BY ', A7, ' *****' )
 *
 *     End of CHKXER
 *
@@ -2927,6 +2928,8 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUT, OK, LERR
       COMMON             /SRNAMC/SRNAMT
+*     .. Locals ..
+      INTEGER            SRLEN
 *     .. Executable Statements ..
       LERR = .TRUE.
       IF( INFO.NE.INFOT )THEN
@@ -2937,7 +2940,8 @@
          END IF
          OK = .FALSE.
       END IF
-      IF( SRNAME.NE.SRNAMT )THEN
+      SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
+      IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
          OK = .FALSE.
       END IF
@@ -2945,8 +2949,8 @@
 *
  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
      $      ' OF ', I2, ' *******' )
- 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
-     $      'AD OF ', A6, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A7, ' INSTE',
+     $      'AD OF ', A7, ' *******' )
  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
      $      ' *******' )
 *
@@ -3221,15 +3225,15 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',',
      $      2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
      $      'C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',

BLAS/TESTING/sblat3.f

@@ -122,6 +122,7 @@
       EXTERNAL           SDIFF, LSE
 *     .. External Subroutines ..
       EXTERNAL           SCHK1, SCHK2, SCHK3, SCHK4, SCHK5, SCHKE, SMMCH
+      EXTERNAL           SCHK6
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
 *     .. Scalars in Common ..
@@ -2927,6 +2928,8 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUT, OK, LERR
       COMMON             /SRNAMC/SRNAMT
+*     .. Locals ..
+      INTEGER            SRLEN
 *     .. Executable Statements ..
       LERR = .TRUE.
       IF( INFO.NE.INFOT )THEN
@@ -2937,7 +2940,8 @@
          END IF
          OK = .FALSE.
       END IF
-      IF( SRNAME .NE. SRNAME ) THEN
+      SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
+      IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
          OK = .FALSE.
       END IF
@@ -2996,7 +3000,7 @@
       LOGICAL            LSE, LSERES
       EXTERNAL           LSE, LSERES
 *     .. External Subroutines ..
-      EXTERNAL           SGEMMTR, DMAKE, DMMTCH
+      EXTERNAL           SGEMMTR, SMAKE, SMMTCH
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     .. Scalars in Common ..

BLAS/TESTING/zblat3.f

@@ -20,7 +20,7 @@
 *>
 *> The program must be driven by a short data file. The first 14 records
 *> of the file are read using list-directed input, the last 10 records
-*> are read using the format ( A6, L2 ). An annotated example of a data
+*> are read using the format ( A7, L2 ). An annotated example of a data
 *> file can be obtained by deleting the first 3 characters from the
 *> following 23 lines:
 *> 'zblat3.out'      NAME OF SUMMARY OUTPUT FILE
@@ -393,7 +393,7 @@
      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
      $      /' ******* TESTS ABANDONED *******' )
- 9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
+ 9990 FORMAT( ' SUBPROGRAM NAME ', A7, ' NOT RECOGNIZED', /' ******* T',
      $      'ESTS ABANDONED *******' )
  9989 FORMAT( ' ERROR IN ZMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
      $      'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1,
@@ -678,15 +678,15 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''', A1, ''',''', A1, ''',',
      $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -957,15 +957,15 @@
   120 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
      $      ',', F4.1, '), C,', I3, ')    .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1268,15 +1268,15 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
      $      '      .' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1596,19 +1596,19 @@
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
      $      '          .' )
- 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
      $      '), C,', I3, ')          .' )
  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -1970,19 +1970,19 @@
   160 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
- 9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9994 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
      $      ', C,', I3, ')           .' )
- 9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
+ 9993 FORMAT( 1X, I6, ': ', A7, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
      $      ',', F4.1, '), C,', I3, ')    .' )
  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
@@ -2026,7 +2026,7 @@
       COMPLEX*16         A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
 *     .. External Subroutines ..
       EXTERNAL           ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
-     $                   ZSYR2K, ZSYRK, ZTRMM, ZTRSM
+     $                   ZSYR2K, ZSYRK, ZTRMM, ZTRSM, ZGEMMTR
 *     .. Intrinsic Functions ..
       INTRINSIC          DCMPLX
 *     .. Common blocks ..
@@ -3124,8 +3124,8 @@
       END IF
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
- 9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
+ 9999 FORMAT( ' ', A7, ' PASSED THE TESTS OF ERROR-EXITS' )
+ 9998 FORMAT( ' ******* ', A7, ' FAILED THE TESTS OF ERROR-EXITS *****',
      $      '**' )
 *
 *     End of ZCHKE
@@ -3641,7 +3641,7 @@
       RETURN
 *
  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
-     $      'ETECTED BY ', A6, ' *****' )
+     $      'ETECTED BY ', A7, ' *****' )
 *
 *     End of CHKXER
 *
@@ -3675,6 +3675,8 @@
 *     .. Common blocks ..
       COMMON             /INFOC/INFOT, NOUT, OK, LERR
       COMMON             /SRNAMC/SRNAMT
+*     .. Locals ..
+      INTEGER            SRLEN
 *     .. Executable Statements ..
       LERR = .TRUE.
       IF( INFO.NE.INFOT )THEN
@@ -3685,7 +3687,8 @@
          END IF
          OK = .FALSE.
       END IF
-      IF( SRNAME.NE.SRNAMT )THEN
+      SRLEN = MIN(LEN_TRIM(SRNAME), LEN_TRIM(SRNAMT))
+      IF( SRNAME(1:SRLEN).NE.SRNAMT(1:SRLEN) )THEN
          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
          OK = .FALSE.
       END IF
@@ -3693,8 +3696,8 @@
 *
  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
      $      ' OF ', I2, ' *******' )
- 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
-     $      'AD OF ', A6, ' *******' )
+ 9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A7, ' INSTE',
+     $      'AD OF ', A7, ' *******' )
  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
      $      ' *******' )
 *
@@ -3752,7 +3755,7 @@
       LOGICAL            LZE, LZERES
       EXTERNAL           LZE, LZERES
 *     .. External Subroutines ..
-      EXTERNAL           CGEMM, ZMAKE, CMMCH
+      EXTERNAL           ZGEMMTR, ZMAKE, ZMMTCH
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX
 *     .. Scalars in Common ..
@@ -3970,21 +3973,21 @@
 *
   120 CONTINUE
       WRITE( NOUT, FMT = 9996 )SNAME
-      WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, N, K,
+      WRITE( NOUT, FMT = 9995 )NC, UPLO, SNAME, TRANSA, TRANSB, N, K,
      $   ALPHA, LDA, LDB, BETA, LDC
 *
   130 CONTINUE
       RETURN
 *
- 9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
+ 9999 FORMAT( ' ', A7, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
      $      'S)' )
  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
      $      'ANGED INCORRECTLY *******' )
- 9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
+ 9997 FORMAT( ' ', A7, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
      $      ' - SUSPECT *******' )
- 9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
- 9995 FORMAT( 1X, I6, ': ', A6, '(''',A1, ''',''',A1, ''',''', A1,''',',
+ 9996 FORMAT( ' ******* ', A7, ' FAILED ON CALL NUMBER:' )
+ 9995 FORMAT( 1X, I6, ': ', A7, '(''',A1, ''',''',A1, ''',''', A1,''',',
      $      2( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',

CBLAS/examples/cblas_example1_64.c

@@ -61,7 +61,7 @@ int main ( )
                 y, incy );
    /* Print y */
    for( i = 0; i < n; i++ )
-      printf(" y%" CBLAS_IFMT " = %f\n", i, y[i]);
+      printf(" y%d = %f\n", (int) i, y[i]);
    free(a);
    free(x);
    free(y);

CBLAS/src/cblas_cgbmv.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_cgbmv)(const CBLAS_LAYOUT layout,
@@ -26,6 +28,7 @@ void API_SUFFIX(cblas_cgbmv)(const CBLAS_LAYOUT layout,
    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
    F77_INT F77_KL=KL,F77_KU=KU;
 #else
+   CBLAS_INT incx=incX;
    #define F77_M M
    #define F77_N N
    #define F77_lda lda
@@ -34,15 +37,19 @@ void API_SUFFIX(cblas_cgbmv)(const CBLAS_LAYOUT layout,
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n=0, i=0, incx=incX;
-   const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+   CBLAS_INT n=0, i=0;
+   const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta;
    float ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
+   float *x, *y, *st=0, *tx=0;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+    memcpy(&x, &X, sizeof(float*));
+    memcpy(&y, &Y, sizeof(float*));
+
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -125,7 +132,7 @@ void API_SUFFIX(cblas_cgbmv)(const CBLAS_LAYOUT layout,
                y -= n;
             }
          }
-         else x = (float *) X;
+         else memcpy(&x, &X, sizeof(float*));
 
 
       }

CBLAS/src/cblas_cgemv.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_cgemv)(const CBLAS_LAYOUT layout,
@@ -31,18 +32,22 @@ void API_SUFFIX(cblas_cgemv)(const CBLAS_LAYOUT layout,
    #define F77_incY incY
 #endif
 
-   CBLAS_INT n=0, i=0, incx=incX;
+   CBLAS_INT n=0, i=0;
    const float *xx= (const float *)X;
    float ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   float *x=(float *)X, *y=(float *)Y, *st=0, *tx=0;
-   const float *stx = x;
+   float *x, *y, *st=0, *tx=0;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
    CBLAS_CallFromC = 1;
 
+   memcpy(&x, &X, sizeof(float *));
+   memcpy(&y, &Y, sizeof(float *));
+
+   const float *stx = x;
+
    if (layout == CblasColMajor)
    {
       if (TransA == CblasNoTrans) TA = 'N';

CBLAS/src/cblas_cgerc.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_cgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N,
@@ -16,6 +18,7 @@ void API_SUFFIX(cblas_cgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
 #ifdef F77_INT
    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incy = incY;
    #define F77_M M
    #define F77_N N
    #define F77_incX incX
@@ -23,8 +26,10 @@ void API_SUFFIX(cblas_cgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
    #define F77_lda lda
 #endif
 
-   CBLAS_INT n, i, tincy, incy=incY;
-   float *y=(float *)Y, *yy=(float *)Y, *ty, *st;
+   CBLAS_INT n, i, tincy;
+   float *y, *yy, *ty, *st;
+   memcpy(&y,&Y,sizeof(float*));
+   memcpy(&yy,&Y,sizeof(float*));
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
@@ -70,7 +75,8 @@ void API_SUFFIX(cblas_cgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
             incy = 1;
          #endif
       }
-      else y = (float *) Y;
+      else
+        memcpy(&y,&Y,sizeof(float*));
 
       F77_cgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
                       &F77_lda);

CBLAS/src/cblas_chbmv.c

@@ -9,6 +9,7 @@
 #include "cblas_f77.h"
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 void API_SUFFIX(cblas_chbmv)(const CBLAS_LAYOUT layout,
                  const CBLAS_UPLO Uplo,const CBLAS_INT N,const CBLAS_INT K,
                  const void *alpha, const void  *A, const CBLAS_INT lda,
@@ -24,21 +25,25 @@ void API_SUFFIX(cblas_chbmv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_K K
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+   CBLAS_INT n, i=0;
+   const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta;
    float ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+   float *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x, &X, sizeof(float*));
+   memcpy(&y, &Y, sizeof(float*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -114,7 +119,7 @@ void API_SUFFIX(cblas_chbmv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (float *) X;
+         memcpy(&x, &X, sizeof(float*));
 
       if (Uplo == CblasUpper) UL = 'L';
       else if (Uplo == CblasLower) UL = 'U';

CBLAS/src/cblas_chemv.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_chemv)(const CBLAS_LAYOUT layout,
@@ -24,20 +26,24 @@ void API_SUFFIX(cblas_chemv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n=0, i=0, incx=incX;
-   const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+   CBLAS_INT n=0, i=0;
+   const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta;
    float ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+   float *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x, &X, sizeof(float*));
+   memcpy(&y, &Y, sizeof(float*));
+
 
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
@@ -114,7 +120,7 @@ void API_SUFFIX(cblas_chemv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (float *) X;
+         memcpy(&x, &X, sizeof(float*));
 
 
       if (Uplo == CblasUpper) UL = 'L';

CBLAS/src/cblas_cher.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_cher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,17 +24,22 @@ void API_SUFFIX(cblas_cher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
 #else
+   CBLAS_INT incx;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
 #endif
-   CBLAS_INT n, i, tincx, incx=incX;
-   float *x=(float *)X, *xx=(float *)X, *tx, *st;
+   CBLAS_INT n, i, tincx;
+   float *x, *xx, *tx, *st;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(float*));
+   memcpy(&xx,&X,sizeof(float*));
+
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -98,7 +104,9 @@ void API_SUFFIX(cblas_cher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
            incx = 1;
          #endif
       }
-      else x = (float *) X;
+      else
+        memcpy(&x,&X,sizeof(float*));
+
       F77_cher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
    } else
    {

CBLAS/src/cblas_cher2.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_cher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,19 +24,25 @@ void API_SUFFIX(cblas_cher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX, incy = incY;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incy
 #endif
-   CBLAS_INT n, i, j, tincx, tincy, incx=incX, incy=incY;
-   float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
-         *yy=(float *)Y, *tx, *ty, *stx, *sty;
+   CBLAS_INT n, i, j, tincx, tincy;
+   float *x, *xx, *y,
+         *yy, *tx, *ty, *stx, *sty;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(float*));
+   memcpy(&xx,&X,sizeof(float*));
+   memcpy(&y,&Y,sizeof(float*));
+   memcpy(&yy,&Y,sizeof(float*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -129,8 +136,8 @@ void API_SUFFIX(cblas_cher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
          #endif
       }  else
       {
-         x = (float *) X;
-         y = (float *) Y;
+         memcpy(&x,&X,sizeof(float*));
+         memcpy(&y,&Y,sizeof(float*));
       }
       F77_cher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
                                       &F77_incX, A, &F77_lda);

CBLAS/src/cblas_cher2k.c

@@ -37,7 +37,7 @@ void API_SUFFIX(cblas_cher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    float ALPHA[2];
-   const float *alp=(float *)alpha;
+   const float *alp=(const float *)alpha;
 
    CBLAS_CallFromC = 1;
    RowMajorStrg = 0;

CBLAS/src/cblas_chpmv.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_chpmv)(const CBLAS_LAYOUT layout,
@@ -24,19 +26,24 @@ void API_SUFFIX(cblas_chpmv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const float *xx= (float *)X, *alp= (float *)alpha, *bet = (float *)beta;
+   CBLAS_INT n, i=0;
+   const float *xx= (const float *)X, *alp= (const float *)alpha, *bet = (const float *)beta;
    float ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   float *x=(float *)X, *y=(float *)Y, *st=0, *tx;
+   float *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(float*));
+   memcpy(&y,&Y,sizeof(float*));
+
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -112,8 +119,7 @@ void API_SUFFIX(cblas_chpmv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (float *) X;
-
+         memcpy(&x,&X,sizeof(float*));
 
       if (Uplo == CblasUpper) UL = 'L';
       else if (Uplo == CblasLower) UL = 'U';

CBLAS/src/cblas_chpr.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_chpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,16 +25,20 @@ void API_SUFFIX(cblas_chpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_incX=incX;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_incX incx
 #endif
-   CBLAS_INT n, i, tincx, incx=incX;
-   float *x=(float *)X, *xx=(float *)X, *tx, *st;
+   CBLAS_INT n, i, tincx;
+   float *x, *xx, *tx, *st;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(float*));
+   memcpy(&xx,&X,sizeof(float*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -96,7 +102,8 @@ void API_SUFFIX(cblas_chpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
             incx = 1;
          #endif
       }
-      else x = (float *) X;
+      else
+          memcpy(&x,&X,sizeof(float*));
 
       F77_chpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
 

CBLAS/src/cblas_chpr2.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_chpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -24,18 +25,25 @@ void API_SUFFIX(cblas_chpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N,  F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
+   CBLAS_INT incy = incY;
    #define F77_N N
    #define F77_incX incx
    #define F77_incY incy
 #endif
-   CBLAS_INT n, i, j, tincx, tincy, incx=incX, incy=incY;
-   float *x=(float *)X, *xx=(float *)X, *y=(float *)Y,
-         *yy=(float *)Y, *tx, *ty, *stx, *sty;
+   CBLAS_INT n, i, j, tincx, tincy;
+   float *x, *xx, *y,
+         *yy, *tx, *ty, *stx, *sty;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(float*));
+   memcpy(&xx,&X,sizeof(float*));
+   memcpy(&y,&Y,sizeof(float*));
+   memcpy(&yy,&Y,sizeof(float*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -128,8 +136,8 @@ void API_SUFFIX(cblas_chpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 
       }  else
       {
-         x = (float *) X;
-         y = (void  *) Y;
+         memcpy(&x,&X,sizeof(float*));
+         memcpy(&y,&Y,sizeof(float*));
       }
       F77_chpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
    } else

CBLAS/src/cblas_zgbmv.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zgbmv)(const CBLAS_LAYOUT layout,
@@ -26,6 +27,7 @@ void API_SUFFIX(cblas_zgbmv)(const CBLAS_LAYOUT layout,
    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
    F77_INT F77_KL=KL,F77_KU=KU;
 #else
+   CBLAS_INT incx = incX;
    #define F77_M M
    #define F77_N N
    #define F77_lda lda
@@ -34,15 +36,18 @@ void API_SUFFIX(cblas_zgbmv)(const CBLAS_LAYOUT layout,
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+   CBLAS_INT n, i=0;
+   const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta;
    double ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+   double *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -125,7 +130,8 @@ void API_SUFFIX(cblas_zgbmv)(const CBLAS_LAYOUT layout,
                y -= n;
             }
          }
-         else x = (double *) X;
+         else
+            memcpy(&x,&X,sizeof(double*));
 
 
       }

CBLAS/src/cblas_zgemv.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout,
@@ -24,6 +25,7 @@ void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_M M
    #define F77_N N
    #define F77_lda lda
@@ -31,15 +33,18 @@ void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout,
    #define F77_incY incY
 #endif
 
-   CBLAS_INT n, i=0, incx=incX;
-   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+   CBLAS_INT n, i=0;
+   const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta;
    double ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+   double *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
 
    if (layout == CblasColMajor)
@@ -124,7 +129,8 @@ void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout,
                y -= n;
             }
          }
-         else x = (double *) X;
+         else
+            memcpy(&x,&X,sizeof(double*));
       }
       else
       {
@@ -145,7 +151,7 @@ void API_SUFFIX(cblas_zgemv)(const CBLAS_LAYOUT layout,
 
       if (TransA == CblasConjTrans)
       {
-         if (x != (double *)X) free(x);
+         if (x != X) free(x);
          if (N > 0)
          {
             do

CBLAS/src/cblas_zgerc.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const CBLAS_INT N,
@@ -16,6 +18,7 @@ void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
 #ifdef F77_INT
    F77_INT F77_M=M, F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incy = incY;
    #define F77_M M
    #define F77_N N
    #define F77_incX incX
@@ -23,13 +26,16 @@ void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
    #define F77_lda lda
 #endif
 
-   CBLAS_INT n, i, tincy, incy=incY;
-   double *y=(double *)Y, *yy=(double *)Y, *ty, *st;
+   CBLAS_INT n, i, tincy;
+   double *y,  *yy, *ty, *st;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&y,&Y,sizeof(double*));
+   memcpy(&yy,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -56,7 +62,7 @@ void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
          }
          do
          {
-            *y = *yy;
+            *y = (double) *yy;
             y[1] = -yy[1];
             y += tincy ;
             yy += i;
@@ -70,7 +76,8 @@ void API_SUFFIX(cblas_zgerc)(const CBLAS_LAYOUT layout, const CBLAS_INT M, const
             incy = 1;
          #endif
       }
-      else y = (double *) Y;
+      else
+          memcpy(&y,&Y,sizeof(double*));
 
       F77_zgeru( &F77_N, &F77_M, alpha, y, &F77_incY, X, &F77_incX, A,
                       &F77_lda);

CBLAS/src/cblas_zhbmv.c

@@ -9,6 +9,8 @@
 #include "cblas_f77.h"
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 void API_SUFFIX(cblas_zhbmv)(const CBLAS_LAYOUT layout,
                  const CBLAS_UPLO Uplo,const CBLAS_INT N,const CBLAS_INT K,
                  const void *alpha, const void  *A, const CBLAS_INT lda,
@@ -24,21 +26,25 @@ void API_SUFFIX(cblas_zhbmv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_K=K, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_K K
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+   CBLAS_INT n, i=0;
+   const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta;
    double ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+   double *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -114,7 +120,7 @@ void API_SUFFIX(cblas_zhbmv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (double *) X;
+        memcpy(&x,&X,sizeof(double*));
 
       if (Uplo == CblasUpper) UL = 'L';
       else if (Uplo == CblasLower) UL = 'U';

CBLAS/src/cblas_zhemv.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zhemv)(const CBLAS_LAYOUT layout,
@@ -24,20 +25,23 @@ void API_SUFFIX(cblas_zhemv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+   CBLAS_INT n, i=0;
+   const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta;
    double ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+   double *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
 
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
@@ -114,7 +118,8 @@ void API_SUFFIX(cblas_zhemv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (double *) X;
+         memcpy(&x,&X,sizeof(double*));
+
 
 
       if (Uplo == CblasUpper) UL = 'L';

CBLAS/src/cblas_zher.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,17 +24,22 @@ void API_SUFFIX(cblas_zher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
 #endif
-   CBLAS_INT n, i, tincx, incx=incX;
-   double *x=(double *)X, *xx=(double *)X, *tx, *st;
+   CBLAS_INT n, i, tincx;
+   double *x, *xx, *tx, *st;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&xx,&X,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -98,7 +104,8 @@ void API_SUFFIX(cblas_zher)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
            incx = 1;
          #endif
       }
-      else x = (double *) X;
+      else
+          memcpy(&x,&X,sizeof(double*));
       F77_zher(F77_UL, &F77_N, &alpha, x, &F77_incX, A, &F77_lda);
    } else API_SUFFIX(cblas_xerbla)(1, "cblas_zher", "Illegal layout setting, %d\n", layout);
    if(X!=x)

CBLAS/src/cblas_zher2.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,19 +24,27 @@ void API_SUFFIX(cblas_zher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_lda=lda, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX, incy = incY;
    #define F77_N N
    #define F77_lda lda
    #define F77_incX incx
    #define F77_incY incy
 #endif
-   CBLAS_INT n, i, j, tincx, tincy, incx=incX, incy=incY;
-   double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
-         *yy=(double *)Y, *tx, *ty, *stx, *sty;
+   CBLAS_INT n, i, j, tincx, tincy;
+   double *x, *xx, *y,
+         *yy, *tx, *ty, *stx, *sty;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&xx,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+   memcpy(&yy,&Y,sizeof(double*));
+
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -129,8 +138,9 @@ void API_SUFFIX(cblas_zher2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
          #endif
       }  else
       {
-         x = (double *) X;
-         y = (double *) Y;
+
+        memcpy(&x,&X,sizeof(double*));
+        memcpy(&y,&Y,sizeof(double*));
       }
       F77_zher2(F77_UL, &F77_N, alpha, y, &F77_incY, x,
                                       &F77_incX, A, &F77_lda);

CBLAS/src/cblas_zher2k.c

@@ -37,7 +37,7 @@ void API_SUFFIX(cblas_zher2k)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    double ALPHA[2];
-   const double *alp=(double *)alpha;
+   const double *alp=(const double *)alpha;
 
    CBLAS_CallFromC = 1;
    RowMajorStrg = 0;

CBLAS/src/cblas_zhpmv.c

@@ -7,6 +7,8 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
+
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zhpmv)(const CBLAS_LAYOUT layout,
@@ -24,19 +26,23 @@ void API_SUFFIX(cblas_zhpmv)(const CBLAS_LAYOUT layout,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_incX incx
    #define F77_incY incY
 #endif
-   CBLAS_INT n, i=0, incx=incX;
-   const double *xx= (double *)X, *alp= (double *)alpha, *bet = (double *)beta;
+   CBLAS_INT n, i=0;
+   const double *xx= (const double *)X, *alp= (const double *)alpha, *bet = (const double *)beta;
    double ALPHA[2],BETA[2];
    CBLAS_INT tincY, tincx;
-   double *x=(double *)X, *y=(double *)Y, *st=0, *tx;
+   double *x, *y, *st=0, *tx;
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -112,8 +118,7 @@ void API_SUFFIX(cblas_zhpmv)(const CBLAS_LAYOUT layout,
          } while(y != st);
          y -= n;
       }  else
-         x = (double *) X;
-
+        memcpy(&x,&X,sizeof(double*));
 
       if (Uplo == CblasUpper) UL = 'L';
       else if (Uplo == CblasLower) UL = 'U';

CBLAS/src/cblas_zhpr.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zhpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -23,16 +24,20 @@ void API_SUFFIX(cblas_zhpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N, F77_incX=incX;
 #else
+   CBLAS_INT incx = incX;
    #define F77_N N
    #define F77_incX incx
 #endif
-   CBLAS_INT n, i, tincx, incx=incX;
-   double *x=(double *)X, *xx=(double *)X, *tx, *st;
+   CBLAS_INT n, i, tincx;
+   double *x, *xx, *tx, *st;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&xx,&X,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -96,7 +101,8 @@ void API_SUFFIX(cblas_zhpr)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
             incx = 1;
          #endif
       }
-      else x = (double *) X;
+      else
+          memcpy(&x,&X,sizeof(double*));
 
       F77_zhpr(F77_UL, &F77_N, &alpha, x, &F77_incX, A);
 

CBLAS/src/cblas_zhpr2.c

@@ -7,6 +7,7 @@
  */
 #include <stdio.h>
 #include <stdlib.h>
+#include <string.h>
 #include "cblas.h"
 #include "cblas_f77.h"
 void API_SUFFIX(cblas_zhpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
@@ -24,18 +25,24 @@ void API_SUFFIX(cblas_zhpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 #ifdef F77_INT
    F77_INT F77_N=N,  F77_incX=incX, F77_incY=incY;
 #else
+   CBLAS_INT incx = incX, incy = incY;
    #define F77_N N
    #define F77_incX incx
    #define F77_incY incy
 #endif
-   CBLAS_INT n, i, j, incx=incX, incy=incY;
-   double *x=(double *)X, *xx=(double *)X, *y=(double *)Y,
-         *yy=(double *)Y, *stx, *sty;
+   CBLAS_INT n, i, j;
+   double *x, *xx, *y,
+         *yy, *stx, *sty;
 
    extern int CBLAS_CallFromC;
    extern int RowMajorStrg;
    RowMajorStrg = 0;
 
+   memcpy(&x,&X,sizeof(double*));
+   memcpy(&xx,&X,sizeof(double*));
+   memcpy(&y,&Y,sizeof(double*));
+   memcpy(&yy,&Y,sizeof(double*));
+
    CBLAS_CallFromC = 1;
    if (layout == CblasColMajor)
    {
@@ -128,8 +135,9 @@ void API_SUFFIX(cblas_zhpr2)(const CBLAS_LAYOUT layout, const CBLAS_UPLO Uplo,
 
       }  else
       {
-         x = (double *) X;
-         y = (void  *) Y;
+
+        memcpy(&x,&X,sizeof(double*));
+        memcpy(&y,&Y,sizeof(double*));
       }
       F77_zhpr2(F77_UL, &F77_N, alpha, y, &F77_incY, x, &F77_incX, Ap);
    }

CBLAS/testing/c_c2chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_c2chke(char *rout

CBLAS/testing/c_c3chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void  F77_c3chke(char *  rout

CBLAS/testing/c_d2chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_d2chke(char *rout

CBLAS/testing/c_d3chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_d3chke(char *rout

CBLAS/testing/c_s2chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_s2chke(char *rout

CBLAS/testing/c_s3chke.c

@@ -22,10 +22,12 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
+
 }
 
 void F77_s3chke(char *rout

CBLAS/testing/c_xerbla.c

@@ -83,7 +83,7 @@ void cblas_xerbla(CBLAS_INT info, const char *rout, const char *form, ...)
    }
 
    if (info != cblas_info){
-      printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT " INSTEAD OF %d in %s *******\n",info, cblas_info, rout);
+      printf("***** XERBLA WAS CALLED WITH INFO = %" CBLAS_IFMT " INSTEAD OF %d in %s *******\n",info, (int) cblas_info, rout);
       cblas_lerr = PASSED;
       cblas_ok = FALSE;
    } else cblas_lerr = FAILED;

CBLAS/testing/c_z2chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_z2chke(char *rout

CBLAS/testing/c_z3chke.c

@@ -22,10 +22,11 @@ void chkxer(void) {
    extern CBLAS_INT link_xerbla;
    extern char *cblas_rout;
    if (cblas_lerr == 1 ) {
-      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", cblas_info, cblas_rout);
+      printf("***** ILLEGAL VALUE OF PARAMETER NUMBER %d NOT DETECTED BY %s *****\n", (int) cblas_info, cblas_rout);
       cblas_ok = 0 ;
    }
    cblas_lerr = 1 ;
+   link_xerbla = TRUE;
 }
 
 void F77_z3chke(char *rout

CMakeLists.txt

@@ -4,7 +4,7 @@ project(LAPACK C)
 
 set(LAPACK_MAJOR_VERSION 3)
 set(LAPACK_MINOR_VERSION 12)
-set(LAPACK_PATCH_VERSION 0)
+set(LAPACK_PATCH_VERSION 1)
 set(
   LAPACK_VERSION
   ${LAPACK_MAJOR_VERSION}.${LAPACK_MINOR_VERSION}.${LAPACK_PATCH_VERSION}

DOCS/DoxygenLayout.xml

@@ -1,23 +1,44 @@
+<?xml version="1.0" encoding="UTF-8"?>
 <doxygenlayout version="1.0">
-  <!-- Generated by doxygen 1.8.13 -->
+  <!-- Generated by doxygen 1.12.0 -->
   <!-- Navigation index tabs for HTML output -->
   <navindex>
     <tab type="mainpage" visible="yes" title=""/>
     <tab type="pages" visible="yes" title="" intro=""/>
 
-    <!-- LAPACK: change "Modules" to "Routines" -->
-    <tab type="modules" visible="yes" title="Routines" intro=""/>
+    <!-- LAPACK: change "Topics" to "Routines" -->
+    <tab type="topics" visible="yes" title="Routines" intro=""/>
 
+    <tab type="modules" visible="yes" title="" intro="">
+      <tab type="modulelist" visible="yes" title="" intro=""/>
+      <tab type="modulemembers" visible="yes" title="" intro=""/>
+    </tab>
     <tab type="namespaces" visible="yes" title="">
       <tab type="namespacelist" visible="yes" title="" intro=""/>
       <tab type="namespacemembers" visible="yes" title="" intro=""/>
     </tab>
+    <tab type="concepts" visible="yes" title="">
+    </tab>
+    <tab type="interfaces" visible="yes" title="">
+      <tab type="interfacelist" visible="yes" title="" intro=""/>
+      <tab type="interfaceindex" visible="$ALPHABETICAL_INDEX" title=""/>
+      <tab type="interfacehierarchy" visible="yes" title="" intro=""/>
+    </tab>
     <tab type="classes" visible="yes" title="">
       <tab type="classlist" visible="yes" title="" intro=""/>
       <tab type="classindex" visible="$ALPHABETICAL_INDEX" title=""/>
       <tab type="hierarchy" visible="yes" title="" intro=""/>
       <tab type="classmembers" visible="yes" title="" intro=""/>
     </tab>
+    <tab type="structs" visible="yes" title="">
+      <tab type="structlist" visible="yes" title="" intro=""/>
+      <tab type="structindex" visible="$ALPHABETICAL_INDEX" title=""/>
+    </tab>
+    <tab type="exceptions" visible="yes" title="">
+      <tab type="exceptionlist" visible="yes" title="" intro=""/>
+      <tab type="exceptionindex" visible="$ALPHABETICAL_INDEX" title=""/>
+      <tab type="exceptionhierarchy" visible="yes" title="" intro=""/>
+    </tab>
     <tab type="files" visible="yes" title="">
       <tab type="filelist" visible="yes" title="" intro=""/>
       <tab type="globals" visible="yes" title="" intro=""/>
@@ -28,9 +49,9 @@
   <!-- Layout definition for a class page -->
   <class>
     <briefdescription visible="yes"/>
-    <includes visible="$SHOW_INCLUDE_FILES"/>
-    <inheritancegraph visible="$CLASS_GRAPH"/>
-    <collaborationgraph visible="$COLLABORATION_GRAPH"/>
+    <includes visible="$SHOW_HEADERFILE"/>
+    <inheritancegraph visible="yes"/>
+    <collaborationgraph visible="yes"/>
     <memberdecl>
       <nestedclasses visible="yes" title=""/>
       <publictypes title=""/>
@@ -90,40 +111,66 @@
     <memberdecl>
       <nestednamespaces visible="yes" title=""/>
       <constantgroups visible="yes" title=""/>
+      <interfaces visible="yes" title=""/>
       <classes visible="yes" title=""/>
+      <concepts visible="yes" title=""/>
+      <structs visible="yes" title=""/>
+      <exceptions visible="yes" title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <functions title=""/>
       <variables title=""/>
+      <properties title=""/>
       <membergroups visible="yes"/>
     </memberdecl>
     <detaileddescription title=""/>
     <memberdef>
       <inlineclasses title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <functions title=""/>
       <variables title=""/>
+      <properties title=""/>
     </memberdef>
     <authorsection visible="yes"/>
   </namespace>
 
+  <!-- Layout definition for a concept page -->
+  <concept>
+    <briefdescription visible="yes"/>
+    <includes visible="$SHOW_HEADERFILE"/>
+    <definition visible="yes" title=""/>
+    <detaileddescription title=""/>
+    <authorsection visible="yes"/>
+  </concept>
+
   <!-- Layout definition for a file page -->
   <file>
     <briefdescription visible="yes"/>
     <includes visible="$SHOW_INCLUDE_FILES"/>
-    <includegraph visible="$INCLUDE_GRAPH"/>
-    <includedbygraph visible="$INCLUDED_BY_GRAPH"/>
+    <includegraph visible="yes"/>
+    <includedbygraph visible="yes"/>
     <sourcelink visible="yes"/>
     <memberdecl>
+      <interfaces visible="yes" title=""/>
       <classes visible="yes" title=""/>
+      <structs visible="yes" title=""/>
+      <exceptions visible="yes" title=""/>
       <namespaces visible="yes" title=""/>
+      <concepts visible="yes" title=""/>
       <constantgroups visible="yes" title=""/>
       <defines title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <functions title=""/>
       <variables title=""/>
+      <properties title=""/>
       <membergroups visible="yes"/>
     </memberdecl>
     <detaileddescription title=""/>
@@ -131,9 +178,12 @@
       <inlineclasses title=""/>
       <defines title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <functions title=""/>
       <variables title=""/>
+      <properties title=""/>
     </memberdef>
     <authorsection/>
   </file>
@@ -141,15 +191,19 @@
   <!-- Layout definition for a group page -->
   <group>
     <briefdescription visible="yes"/>
-    <groupgraph visible="$GROUP_GRAPHS"/>
+    <groupgraph visible="yes"/>
     <memberdecl>
       <nestedgroups visible="yes" title=""/>
+      <modules visible="yes" title=""/>
       <dirs visible="yes" title=""/>
       <files visible="yes" title=""/>
       <namespaces visible="yes" title=""/>
+      <concepts visible="yes" title=""/>
       <classes visible="yes" title=""/>
       <defines title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <enumvalues title=""/>
       <functions title=""/>
@@ -169,6 +223,8 @@
       <inlineclasses title=""/>
       <defines title=""/>
       <typedefs title=""/>
+      <sequences title=""/>
+      <dictionaries title=""/>
       <enums title=""/>
       <enumvalues title=""/>
       <functions title=""/>
@@ -184,6 +240,25 @@
     <authorsection visible="yes"/>
   </group>
 
+  <!-- Layout definition for a C++20 module page -->
+  <module>
+    <briefdescription visible="yes"/>
+    <exportedmodules visible="yes"/>
+    <memberdecl>
+      <concepts visible="yes" title=""/>
+      <classes visible="yes" title=""/>
+      <enums title=""/>
+      <typedefs title=""/>
+      <functions title=""/>
+      <variables title=""/>
+      <membergroups title=""/>
+    </memberdecl>
+    <detaileddescription title=""/>
+    <memberdecl>
+      <files visible="yes"/>
+    </memberdecl>
+  </module>
+
   <!-- Layout definition for a directory page -->
   <directory>
     <briefdescription visible="yes"/>

DOCS/groups-usr.dox

@@ -963,7 +963,6 @@ https://www.netlib.org/xblas/
             @defgroup gemm          gemm:           general matrix-matrix multiply
             @defgroup gemmtr        gemmtr:         general matrix-matrix multiply with triangular output
 
-
             @defgroup hemm          {he,sy}mm:      Hermitian/symmetric matrix-matrix multiply
             @defgroup herk          {he,sy}rk:      Hermitian/symmetric rank-k update
             @defgroup her2k         {he,sy}r2k:     Hermitian/symmetric rank-2k update

INSTALL/ilaver.f

@@ -59,7 +59,7 @@
 *  =====================================================================
       VERS_MAJOR = 3
       VERS_MINOR = 12
-      VERS_PATCH = 0
+      VERS_PATCH = 1
 *  =====================================================================
 *
       RETURN

LAPACKE/example/example_DGELS_rowmajor.c

@@ -86,6 +86,9 @@ int main (int argc, const char * argv[])
    /* Solve least squares problem*/
    info = LAPACKE_dgels(LAPACK_ROW_MAJOR,'N',m,n,nrhs,*A,lda,*b,ldb);
 
+   if ( info != 0) {
+        printf("DGELS failed with %d\n", (int) info);
+   }
    /* Print Solution */
    print_matrix_rowmajor( "Solution", n, nrhs, *b, ldb );
    printf( "\n" );

LAPACKE/example/example_DGELS_rowmajor_64.c

@@ -86,6 +86,9 @@ int main (int argc, const char * argv[])
    /* Solve least squares problem*/
    info = LAPACKE_dgels_64(LAPACK_ROW_MAJOR,'N',m,n,nrhs,*A,lda,*b,ldb);
 
+   if ( info != 0 ) {
+      printf("DGELS failed with info = %d\n", (int) info);
+   }
    /* Print Solution */
    print_matrix_rowmajor_64( "Solution", n, nrhs, *b, ldb );
    printf( "\n" );

LAPACKE/example/example_DGESV_colmajor_64.c

@@ -92,7 +92,7 @@ int main(int argc, char **argv) {
         /* Check for the exact singularity */
         if( info > 0 ) {
             printf( "The diagonal element of the triangular factor of A,\n" );
-            printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info );
+            printf( "U(%d,%d) is zero, so that A is singular;\n", (int) info, (int) info );
             printf( "the solution could not be computed.\n" );
             free(A);
             free(b);

LAPACKE/example/example_DGESV_rowmajor_64.c

@@ -89,7 +89,7 @@ int main(int argc, char **argv) {
         /* Check for the exact singularity */
         if( info > 0 ) {
             printf( "The diagonal element of the triangular factor of A,\n" );
-            printf( "U(%" LAPACK_IFMT ",%" LAPACK_IFMT ") is zero, so that A is singular;\n", info, info );
+            printf( "U(%d,%d) is zero, so that A is singular;\n", (int) info, (int) info );
             printf( "the solution could not be computed.\n" );
             free(A);
             free(b);

LAPACKE/example/lapacke_example_aux.c

@@ -60,6 +60,6 @@ void print_matrix_colmajor_64( char* desc, int64_t m, int64_t n, double* mat, in
 void print_vector_64( char* desc, int64_t n, int64_t* vec ) {
         int64_t j;
         printf( "\n %s\n", desc );
-        for( j = 0; j < n; j++ ) printf( " %6" LAPACK_IFMT, vec[j] );
+        for( j = 0; j < n; j++ ) printf( " %6d", (int) vec[j] );
         printf( "\n" );
 }

LAPACKE/src/lapacke_cgesdd_work.c

@@ -58,6 +58,9 @@ lapack_int API_SUFFIX(LAPACKE_cgesdd_work)( int matrix_layout, char jobz, lapack
         lapack_int nrows_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n :
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1);
+        lapack_int ncols_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
+                              API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ||
+                              ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n : 1;
         lapack_int lda_t = MAX(1,m);
         lapack_int ldu_t = MAX(1,nrows_u);
         lapack_int ldvt_t = MAX(1,nrows_vt);
@@ -75,7 +78,7 @@ lapack_int API_SUFFIX(LAPACKE_cgesdd_work)( int matrix_layout, char jobz, lapack
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd_work", info );
             return info;
         }
-        if( ldvt < n ) {
+        if( ldvt < ncols_vt ) {
             info = -11;
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd_work", info );
             return info;

LAPACKE/src/lapacke_cunmlq.c

@@ -49,7 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_cunmlq)( int matrix_layout, char side, char trans,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, m, a, lda ) ) {
+        lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n;
+        if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, k, r, a, lda ) ) {
             return -7;
         }
         if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, c, ldc ) ) {

LAPACKE/src/lapacke_cunmlq_work.c

@@ -90,7 +90,7 @@ lapack_int API_SUFFIX(LAPACKE_cunmlq_work)( int matrix_layout, char side, char t
             goto exit_level_1;
         }
         /* Transpose input matrices */
-        API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t );
+        API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, k, r, a, lda, a_t, lda_t );
         API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */
         LAPACK_cunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

LAPACKE/src/lapacke_dgesdd_work.c

@@ -56,6 +56,9 @@ lapack_int API_SUFFIX(LAPACKE_dgesdd_work)( int matrix_layout, char jobz, lapack
         lapack_int nrows_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n :
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1);
+        lapack_int ncols_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
+                              API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ||
+                              ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n : 1;
         lapack_int lda_t = MAX(1,m);
         lapack_int ldu_t = MAX(1,nrows_u);
         lapack_int ldvt_t = MAX(1,nrows_vt);
@@ -73,7 +76,7 @@ lapack_int API_SUFFIX(LAPACKE_dgesdd_work)( int matrix_layout, char jobz, lapack
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd_work", info );
             return info;
         }
-        if( ldvt < n ) {
+        if( ldvt < ncols_vt ) {
             info = -11;
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_dgesdd_work", info );
             return info;

LAPACKE/src/lapacke_sgesdd_work.c

@@ -56,6 +56,9 @@ lapack_int API_SUFFIX(LAPACKE_sgesdd_work)( int matrix_layout, char jobz, lapack
         lapack_int nrows_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n :
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1);
+        lapack_int ncols_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
+                              API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ||
+                              ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n : 1;
         lapack_int lda_t = MAX(1,m);
         lapack_int ldu_t = MAX(1,nrows_u);
         lapack_int ldvt_t = MAX(1,nrows_vt);
@@ -73,7 +76,7 @@ lapack_int API_SUFFIX(LAPACKE_sgesdd_work)( int matrix_layout, char jobz, lapack
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd_work", info );
             return info;
         }
-        if( ldvt < n ) {
+        if( ldvt < ncols_vt ) {
             info = -11;
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_sgesdd_work", info );
             return info;

LAPACKE/src/lapacke_zgesdd_work.c

@@ -58,6 +58,9 @@ lapack_int API_SUFFIX(LAPACKE_zgesdd_work)( int matrix_layout, char jobz, lapack
         lapack_int nrows_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n :
                               ( API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ? MIN(m,n) : 1);
+        lapack_int ncols_vt = ( API_SUFFIX(LAPACKE_lsame)( jobz, 'a' ) ||
+                              API_SUFFIX(LAPACKE_lsame)( jobz, 's' ) ||
+                              ( API_SUFFIX(LAPACKE_lsame)( jobz, 'o' ) && m>=n) ) ? n : 1;
         lapack_int lda_t = MAX(1,m);
         lapack_int ldu_t = MAX(1,nrows_u);
         lapack_int ldvt_t = MAX(1,nrows_vt);
@@ -75,7 +78,7 @@ lapack_int API_SUFFIX(LAPACKE_zgesdd_work)( int matrix_layout, char jobz, lapack
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd_work", info );
             return info;
         }
-        if( ldvt < n ) {
+        if( ldvt < ncols_vt ) {
             info = -11;
             API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_zgesdd_work", info );
             return info;

LAPACKE/src/lapacke_zunmlq.c

@@ -49,7 +49,8 @@ lapack_int API_SUFFIX(LAPACKE_zunmlq)( int matrix_layout, char side, char trans,
 #ifndef LAPACK_DISABLE_NAN_CHECK
     if( LAPACKE_get_nancheck() ) {
         /* Optionally check input matrices for NaNs */
-        if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, m, a, lda ) ) {
+        lapack_int r = API_SUFFIX(LAPACKE_lsame)( side, 'l' ) ? m : n;
+        if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, k, r, a, lda ) ) {
             return -7;
         }
         if( API_SUFFIX(LAPACKE_zge_nancheck)( matrix_layout, m, n, c, ldc ) ) {

LAPACKE/src/lapacke_zunmlq_work.c

@@ -90,7 +90,7 @@ lapack_int API_SUFFIX(LAPACKE_zunmlq_work)( int matrix_layout, char side, char t
             goto exit_level_1;
         }
         /* Transpose input matrices */
-        API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, m, a, lda, a_t, lda_t );
+        API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, k, r, a, lda, a_t, lda_t );
         API_SUFFIX(LAPACKE_zge_trans)( matrix_layout, m, n, c, ldc, c_t, ldc_t );
         /* Call LAPACK function and adjust info */
         LAPACK_zunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,

LICENSE

@@ -1,9 +1,9 @@
-Copyright (c) 1992-2023 The University of Tennessee and The University
+Copyright (c) 1992-2025 The University of Tennessee and The University
                         of Tennessee Research Foundation.  All rights
                         reserved.
-Copyright (c) 2000-2023 The University of California Berkeley. All
+Copyright (c) 2000-2025 The University of California Berkeley. All
                         rights reserved.
-Copyright (c) 2006-2023 The University of Colorado Denver.  All rights
+Copyright (c) 2006-2025 The University of Colorado Denver.  All rights
                         reserved.
 
 $COPYRIGHT$

README.md

@@ -38,6 +38,7 @@
 * VERSION 3.10.1 : April 2022
 * VERSION 3.11.0 : November 2022
 * VERSION 3.12.0 : November 2023
+* VERSION 3.12.1 : January 2025
 
 LAPACK is a library of Fortran subroutines for solving the most commonly
 occurring problems in numerical linear algebra.
@@ -107,8 +108,8 @@ Please see as well the [GitHub issue tracker](https://github.com/Reference-LAPAC
 For further information on LAPACK please read our [FAQ](http://www.netlib.org/lapack/faq.html)
 and [Users' Guide](http://www.netlib.org/lapack/lug/lapack_lug.html).
 A [user forum](http://icl.cs.utk.edu/lapack-forum/) and specific information for
-[running LAPACK under Windows](http://icl.cs.utk.edu/lapack-for-windows/lapack/).
-is also available to help you with the LAPACK library.
+[running LAPACK under Windows](http://icl.cs.utk.edu/lapack-for-windows/lapack/)
+are also available to help you with the LAPACK library.
 
 
 ## Testing

SRC/DEPRECATED/cgegs.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGEGS + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgegs.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgegs.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -219,9 +217,9 @@
 *> \ingroup complexGEeigen
 *
 *  =====================================================================
-      SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA, BETA,
-     $                  VSL, LDVSL, VSR, LDVSR, WORK, LWORK, RWORK,
-     $                  INFO )
+      SUBROUTINE CGEGS( JOBVSL, JOBVSR, N, A, LDA, B, LDB, ALPHA,
+     $                  BETA, VSL, LDVSL, VSR, LDVSR, WORK, LWORK,
+     $                  RWORK, INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -360,7 +358,8 @@
       END IF
 *
       IF( ILASCL ) THEN
-         CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
+         CALL CLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -380,7 +379,8 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
+         CALL CLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -493,12 +493,14 @@
 *     Undo scaling
 *
       IF( ILASCL ) THEN
-         CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
+         CALL CLASCL( 'U', -1, -1, ANRMTO, ANRM, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
          END IF
-         CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N, IINFO )
+         CALL CLASCL( 'G', -1, -1, ANRMTO, ANRM, N, 1, ALPHA, N,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -506,12 +508,14 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO )
+         CALL CLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
          END IF
-         CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO )
+         CALL CLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN

SRC/DEPRECATED/cgegv.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGEGV + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgegv.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgegv.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========

SRC/DEPRECATED/cgelqs.f

@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@
 *     ..
 *     .. Array Arguments ..
       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================

SRC/DEPRECATED/cgelsx.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGELSX + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgelsx.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgelsx.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -179,8 +177,8 @@
 *> \ingroup complexGEsolve
 *
 *  =====================================================================
-      SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, RWORK, INFO )
+      SUBROUTINE CGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK, WORK, RWORK, INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -294,13 +292,15 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
@@ -362,8 +362,8 @@
 *
 *     B(1:M,1:NRHS) := Q**H * B(1:M,1:NRHS)
 *
-      CALL CUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A, LDA,
-     $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
+      CALL CUNM2R( 'Left', 'Conjugate transpose', M, NRHS, MN, A,
+     $             LDA, WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
 *
 *     workspace NRHS
 *
@@ -420,18 +420,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL CLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL CLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
   100 CONTINUE

SRC/DEPRECATED/cgeqpf.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGEQPF + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgeqpf.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgeqpf.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========

SRC/DEPRECATED/cgeqrs.f

@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@
 *     ..
 *     .. Array Arguments ..
       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================

SRC/DEPRECATED/cggsvd.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGGSVD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggsvd.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggsvd.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========

SRC/DEPRECATED/cggsvp.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGGSVP + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cggsvp.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cggsvp.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -382,7 +380,8 @@
    30    CONTINUE
    40 CONTINUE
       IF( P.GT.L )
-     $   CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ), LDB )
+     $   CALL CLASET( 'Full', P-L, N, CZERO, CZERO, B( L+1, 1 ),
+     $                LDB )
 *
       IF( WANTQ ) THEN
 *
@@ -400,8 +399,8 @@
 *
 *        Update A := A*Z**H
 *
-         CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B, LDB,
-     $                TAU, A, LDA, WORK, INFO )
+         CALL CUNMR2( 'Right', 'Conjugate transpose', M, N, L, B,
+     $                LDB, TAU, A, LDA, WORK, INFO )
          IF( WANTQ ) THEN
 *
 *           Update Q := Q*Z**H
@@ -444,8 +443,9 @@
 *
 *     Update A12 := U**H*A12, where A12 = A( 1:M, N-L+1:N )
 *
-      CALL CUNM2R( 'Left', 'Conjugate transpose', M, L, MIN( M, N-L ),
-     $             A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK, INFO )
+      CALL CUNM2R( 'Left', 'Conjugate transpose', M, L,
+     $             MIN( M, N-L ), A, LDA, TAU, A( 1, N-L+1 ), LDA, WORK,
+     $             INFO )
 *
       IF( WANTU ) THEN
 *
@@ -453,8 +453,8 @@
 *
          CALL CLASET( 'Full', M, M, CZERO, CZERO, U, LDU )
          IF( M.GT.1 )
-     $      CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ),
-     $                   LDU )
+     $      CALL CLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA,
+     $                   U( 2, 1 ), LDU )
          CALL CUNG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
       END IF
 *
@@ -474,7 +474,8 @@
    90    CONTINUE
   100 CONTINUE
       IF( M.GT.K )
-     $   CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ), LDA )
+     $   CALL CLASET( 'Full', M-K, N-L, CZERO, CZERO, A( K+1, 1 ),
+     $                LDA )
 *
       IF( N-L.GT.K ) THEN
 *
@@ -486,8 +487,8 @@
 *
 *           Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**H
 *
-            CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K, A,
-     $                   LDA, TAU, Q, LDQ, WORK, INFO )
+            CALL CUNMR2( 'Right', 'Conjugate transpose', N, N-L, K,
+     $                   A, LDA, TAU, Q, LDQ, WORK, INFO )
          END IF
 *
 *        Clean up A
@@ -511,9 +512,9 @@
 *
 *           Update U(:,K+1:M) := U(:,K+1:M)*U1
 *
-            CALL CUNM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ),
-     $                   A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU,
-     $                   WORK, INFO )
+            CALL CUNM2R( 'Right', 'No transpose', M, M-K,
+     $                   MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU,
+     $                   U( 1, K+1 ), LDU, WORK, INFO )
          END IF
 *
 *        Clean up

SRC/DEPRECATED/clahrd.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLAHRD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clahrd.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clahrd.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -236,13 +234,14 @@
 *
 *           w := T**H *w
 *
-            CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit', I-1,
-     $                  T, LDT, T( 1, NB ), 1 )
+            CALL CTRMV( 'Upper', 'Conjugate transpose', 'Non-unit',
+     $                  I-1, T, LDT, T( 1, NB ), 1 )
 *
 *           b2 := b2 - V2*w
 *
-            CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
+            CALL CGEMV( 'No transpose', N-K-I+1, I-1, -ONE,
+     $                  A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE,
+     $                  A( K+I, I ), 1 )
 *
 *           b1 := b1 - V1*w
 *
@@ -263,20 +262,20 @@
 *
 *        Compute  Y(1:n,i)
 *
-         CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
+         CALL CGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ),
+     $               LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
          CALL CGEMV( 'Conjugate transpose', N-K-I+1, I-1, ONE,
      $               A( K+I, 1 ), LDA, A( K+I, I ), 1, ZERO, T( 1, I ),
      $               1 )
-         CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
-     $               ONE, Y( 1, I ), 1 )
+         CALL CGEMV( 'No transpose', N, I-1, -ONE, Y, LDY,
+     $               T( 1, I ), 1, ONE, Y( 1, I ), 1 )
          CALL CSCAL( N, TAU( I ), Y( 1, I ), 1 )
 *
 *        Compute T(1:i,i)
 *
          CALL CSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
-     $               T( 1, I ), 1 )
+         CALL CTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+     $               LDT, T( 1, I ), 1 )
          T( I, I ) = TAU( I )
 *
    10 CONTINUE

SRC/DEPRECATED/clatzm.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLATZM + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clatzm.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clatzm.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -148,7 +146,8 @@
 *> \ingroup latzm
 *
 *  =====================================================================
-      SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
+      SUBROUTINE CLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC,
+     $                   WORK )
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -206,8 +205,8 @@
 *        w := C1 + C2 * v
 *
          CALL CCOPY( M, C1, 1, WORK, 1 )
-         CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
-     $               WORK, 1 )
+         CALL CGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV,
+     $               ONE, WORK, 1 )
 *
 *        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**H]
 *

SRC/DEPRECATED/ctzrqf.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CTZRQF + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctzrqf.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctzrqf.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -217,14 +215,15 @@
 *
 *              Form   w = a( k ) + B*z( k )  in TAU.
 *
-               CALL CGEMV( 'No transpose', K-1, N-M, CONE, A( 1, M1 ),
-     $                     LDA, A( K, M1 ), LDA, CONE, TAU, 1 )
+               CALL CGEMV( 'No transpose', K-1, N-M, CONE,
+     $                     A( 1, M1 ), LDA, A( K, M1 ), LDA, CONE,
+     $                     TAU, 1 )
 *
 *              Now form  a( k ) := a( k ) - conjg(tau)*w
 *              and       B      := B      - conjg(tau)*w*z( k )**H.
 *
-               CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1, A( 1, K ),
-     $                     1 )
+               CALL CAXPY( K-1, -CONJG( TAU( K ) ), TAU, 1,
+     $                     A( 1, K ), 1 )
                CALL CGERC( K-1, N-M, -CONJG( TAU( K ) ), TAU, 1,
      $                     A( K, M1 ), LDA, A( 1, M1 ), LDA )
             END IF

SRC/DEPRECATED/dgegs.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGEGS + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgegs.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegs.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -358,7 +356,8 @@
       END IF
 *
       IF( ILASCL ) THEN
-         CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
+         CALL DLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -378,7 +377,8 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
+         CALL DLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -496,7 +496,8 @@
 *     Undo scaling
 *
       IF( ILASCL ) THEN
-         CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
+         CALL DLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -516,12 +517,14 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO )
+         CALL DLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
          END IF
-         CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO )
+         CALL DLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN

SRC/DEPRECATED/dgegv.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGEGV + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgegv.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgegv.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -301,8 +299,9 @@
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-     $                  BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
+      SUBROUTINE DGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
+     $                  ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK,
+     $                  INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --

SRC/DEPRECATED/dgelqs.f

@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
@@ -174,18 +174,19 @@
 *
 *     Solve L*X = B(1:m,:)
 *
-      CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
-     $            ONE, A, LDA, B, LDB )
+      CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M,
+     $            NRHS, ONE, A, LDA, B, LDB )
 *
 *     Set B(m+1:n,:) to zero
 *
       IF( M.LT.N )
-     $   CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
+     $   CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ),
+     $                LDB )
 *
 *     B := Q' * B
 *
-      CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
-     $             WORK, LWORK, INFO )
+      CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B,
+     $             LDB, WORK, LWORK, INFO )
 *
       RETURN
 *

SRC/DEPRECATED/dgelsx.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGELSX + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelsx.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelsx.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -173,8 +171,8 @@
 *> \ingroup doubleGEsolve
 *
 *  =====================================================================
-      SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, INFO )
+      SUBROUTINE DGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK, WORK, INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -283,20 +281,23 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
 *     Compute QR factorization with column pivoting of A:
 *        A * P = Q * R
 *
-      CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO )
+      CALL DGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
+     $             INFO )
 *
 *     workspace 3*N. Details of Householder rotations stored
 *     in WORK(1:MN).
@@ -350,8 +351,8 @@
 *
 *     B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
 *
-      CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
-     $             B, LDB, WORK( 2*MN+1 ), INFO )
+      CALL DORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA,
+     $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
 *
 *     workspace NRHS
 *
@@ -408,18 +409,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL DLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
   100 CONTINUE

SRC/DEPRECATED/dgeqpf.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGEQPF + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgeqpf.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgeqpf.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -218,8 +216,8 @@
          MA = MIN( ITEMP, M )
          CALL DGEQR2( M, MA, A, LDA, TAU, WORK, INFO )
          IF( MA.LT.N ) THEN
-            CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA, TAU,
-     $                   A( 1, MA+1 ), LDA, WORK, INFO )
+            CALL DORM2R( 'Left', 'Transpose', M, N-MA, MA, A, LDA,
+     $                   TAU, A( 1, MA+1 ), LDA, WORK, INFO )
          END IF
       END IF
 *
@@ -253,7 +251,8 @@
 *           Generate elementary reflector H(i)
 *
             IF( I.LT.M ) THEN
-               CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1, TAU( I ) )
+               CALL DLARFG( M-I+1, A( I, I ), A( I+1, I ), 1,
+     $                      TAU( I ) )
             ELSE
                CALL DLARFG( 1, A( M, M ), A( M, M ), 1, TAU( M ) )
             END IF
@@ -264,8 +263,8 @@
 *
                AII = A( I, I )
                A( I, I ) = ONE
-               CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1, TAU( I ),
-     $                     A( I, I+1 ), LDA, WORK( 2*N+1 ) )
+               CALL DLARF( 'LEFT', M-I+1, N-I, A( I, I ), 1,
+     $                     TAU( I ), A( I, I+1 ), LDA, WORK( 2*N+1 ) )
                A( I, I ) = AII
             END IF
 *

SRC/DEPRECATED/dgeqrs.f

@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================

SRC/DEPRECATED/dggsvd.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGGSVD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggsvd.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvd.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========

SRC/DEPRECATED/dggsvp.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DGGSVP + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dggsvp.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dggsvp.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -392,8 +390,8 @@
 *
 *           Update Q := Q*Z**T
 *
-            CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU, Q,
-     $                   LDQ, WORK, INFO )
+            CALL DORMR2( 'Right', 'Transpose', N, N, L, B, LDB, TAU,
+     $                   Q, LDQ, WORK, INFO )
          END IF
 *
 *        Clean up B
@@ -439,9 +437,10 @@
 *
          CALL DLASET( 'Full', M, M, ZERO, ZERO, U, LDU )
          IF( M.GT.1 )
-     $      CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA, U( 2, 1 ),
-     $                   LDU )
-         CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK, INFO )
+     $      CALL DLACPY( 'Lower', M-1, N-L, A( 2, 1 ), LDA,
+     $                   U( 2, 1 ), LDU )
+         CALL DORG2R( M, M, MIN( M, N-L ), U, LDU, TAU, WORK,
+     $                INFO )
       END IF
 *
       IF( WANTQ ) THEN
@@ -460,7 +459,8 @@
    90    CONTINUE
   100 CONTINUE
       IF( M.GT.K )
-     $   CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ), LDA )
+     $   CALL DLASET( 'Full', M-K, N-L, ZERO, ZERO, A( K+1, 1 ),
+     $                LDA )
 *
       IF( N-L.GT.K ) THEN
 *
@@ -472,8 +472,8 @@
 *
 *           Update Q( 1:N,1:N-L ) = Q( 1:N,1:N-L )*Z1**T
 *
-            CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA, TAU,
-     $                   Q, LDQ, WORK, INFO )
+            CALL DORMR2( 'Right', 'Transpose', N, N-L, K, A, LDA,
+     $                   TAU, Q, LDQ, WORK, INFO )
          END IF
 *
 *        Clean up A
@@ -497,9 +497,9 @@
 *
 *           Update U(:,K+1:M) := U(:,K+1:M)*U1
 *
-            CALL DORM2R( 'Right', 'No transpose', M, M-K, MIN( M-K, L ),
-     $                   A( K+1, N-L+1 ), LDA, TAU, U( 1, K+1 ), LDU,
-     $                   WORK, INFO )
+            CALL DORM2R( 'Right', 'No transpose', M, M-K,
+     $                   MIN( M-K, L ), A( K+1, N-L+1 ), LDA, TAU,
+     $                   U( 1, K+1 ), LDU, WORK, INFO )
          END IF
 *
 *        Clean up

SRC/DEPRECATED/dlahrd.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DLAHRD + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlahrd.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlahrd.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -221,8 +219,8 @@
 *           w := V1**T * b1
 *
             CALL DCOPY( I-1, A( K+1, I ), 1, T( 1, NB ), 1 )
-            CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1, A( K+1, 1 ),
-     $                  LDA, T( 1, NB ), 1 )
+            CALL DTRMV( 'Lower', 'Transpose', 'Unit', I-1,
+     $                  A( K+1, 1 ), LDA, T( 1, NB ), 1 )
 *
 *           w := w + V2**T *b2
 *
@@ -231,13 +229,14 @@
 *
 *           w := T**T *w
 *
-            CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', I-1, T, LDT,
-     $                  T( 1, NB ), 1 )
+            CALL DTRMV( 'Upper', 'Transpose', 'Non-unit', I-1,
+     $                  T, LDT, T( 1, NB ), 1 )
 *
 *           b2 := b2 - V2*w
 *
-            CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE, A( K+I, 1 ),
-     $                  LDA, T( 1, NB ), 1, ONE, A( K+I, I ), 1 )
+            CALL DGEMV( 'No transpose', N-K-I+1, I-1, -ONE,
+     $                  A( K+I, 1 ), LDA, T( 1, NB ), 1, ONE,
+     $                  A( K+I, I ), 1 )
 *
 *           b1 := b1 - V1*w
 *
@@ -258,19 +257,19 @@
 *
 *        Compute  Y(1:n,i)
 *
-         CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
-         CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ), LDA,
-     $               A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
-         CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ), 1,
-     $               ONE, Y( 1, I ), 1 )
+         CALL DGEMV( 'No transpose', N, N-K-I+1, ONE, A( 1, I+1 ),
+     $               LDA, A( K+I, I ), 1, ZERO, Y( 1, I ), 1 )
+         CALL DGEMV( 'Transpose', N-K-I+1, I-1, ONE, A( K+I, 1 ),
+     $               LDA, A( K+I, I ), 1, ZERO, T( 1, I ), 1 )
+         CALL DGEMV( 'No transpose', N, I-1, -ONE, Y, LDY, T( 1, I ),
+     $               1, ONE, Y( 1, I ), 1 )
          CALL DSCAL( N, TAU( I ), Y( 1, I ), 1 )
 *
 *        Compute T(1:i,i)
 *
          CALL DSCAL( I-1, -TAU( I ), T( 1, I ), 1 )
-         CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T, LDT,
-     $               T( 1, I ), 1 )
+         CALL DTRMV( 'Upper', 'No transpose', 'Non-unit', I-1,
+     $               T, LDT, T( 1, I ), 1 )
          T( I, I ) = TAU( I )
 *
    10 CONTINUE

SRC/DEPRECATED/dlatzm.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DLATZM + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlatzm.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlatzm.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -147,7 +145,8 @@
 *> \ingroup doubleOTHERcomputational
 *
 *  =====================================================================
-      SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC, WORK )
+      SUBROUTINE DLATZM( SIDE, M, N, V, INCV, TAU, C1, C2, LDC,
+     $                   WORK )
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -202,8 +201,8 @@
 *        w := C1 + C2 * v
 *
          CALL DCOPY( M, C1, 1, WORK, 1 )
-         CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV, ONE,
-     $               WORK, 1 )
+         CALL DGEMV( 'No transpose', M, N-1, ONE, C2, LDC, V, INCV,
+     $               ONE, WORK, 1 )
 *
 *        [ C1, C2 ] := [ C1, C2 ] - tau* w * [ 1 , v**T]
 *

SRC/DEPRECATED/dtzrqf.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DTZRQF + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtzrqf.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtzrqf.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -194,7 +192,8 @@
 *           Use a Householder reflection to zero the kth row of A.
 *           First set up the reflection.
 *
-            CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA, TAU( K ) )
+            CALL DLARFG( N-M+1, A( K, K ), A( K, M1 ), LDA,
+     $                   TAU( K ) )
 *
             IF( ( TAU( K ).NE.ZERO ) .AND. ( K.GT.1 ) ) THEN
 *
@@ -216,8 +215,8 @@
 *              and       B      := B      - tau*w*z( k )**T.
 *
                CALL DAXPY( K-1, -TAU( K ), TAU, 1, A( 1, K ), 1 )
-               CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ), LDA,
-     $                    A( 1, M1 ), LDA )
+               CALL DGER( K-1, N-M, -TAU( K ), TAU, 1, A( K, M1 ),
+     $                    LDA, A( 1, M1 ), LDA )
             END IF
    20    CONTINUE
       END IF

SRC/DEPRECATED/sgegs.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download SGEGS + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgegs.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegs.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -358,7 +356,8 @@
       END IF
 *
       IF( ILASCL ) THEN
-         CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA, IINFO )
+         CALL SLASCL( 'G', -1, -1, ANRM, ANRMTO, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -378,7 +377,8 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB, IINFO )
+         CALL SLASCL( 'G', -1, -1, BNRM, BNRMTO, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -496,7 +496,8 @@
 *     Undo scaling
 *
       IF( ILASCL ) THEN
-         CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA, IINFO )
+         CALL SLASCL( 'H', -1, -1, ANRMTO, ANRM, N, N, A, LDA,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
@@ -516,12 +517,14 @@
       END IF
 *
       IF( ILBSCL ) THEN
-         CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB, IINFO )
+         CALL SLASCL( 'U', -1, -1, BNRMTO, BNRM, N, N, B, LDB,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN
          END IF
-         CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N, IINFO )
+         CALL SLASCL( 'G', -1, -1, BNRMTO, BNRM, N, 1, BETA, N,
+     $                IINFO )
          IF( IINFO.NE.0 ) THEN
             INFO = N + 9
             RETURN

SRC/DEPRECATED/sgegv.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download SGEGV + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgegv.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgegv.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -301,8 +299,9 @@
 *> \endverbatim
 *>
 *  =====================================================================
-      SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
-     $                  BETA, VL, LDVL, VR, LDVR, WORK, LWORK, INFO )
+      SUBROUTINE SGEGV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR,
+     $                  ALPHAI, BETA, VL, LDVL, VR, LDVR, WORK, LWORK,
+     $                  INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --

SRC/DEPRECATED/sgelqs.f

@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@
 *     ..
 *     .. Array Arguments ..
       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
@@ -174,18 +174,19 @@
 *
 *     Solve L*X = B(1:m,:)
 *
-      CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
-     $            ONE, A, LDA, B, LDB )
+      CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M,
+     $            NRHS, ONE, A, LDA, B, LDB )
 *
 *     Set B(m+1:n,:) to zero
 *
       IF( M.LT.N )
-     $   CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
+     $   CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ),
+     $                LDB )
 *
 *     B := Q' * B
 *
-      CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
-     $             WORK, LWORK, INFO )
+      CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B,
+     $             LDB, WORK, LWORK, INFO )
 *
       RETURN
 *

SRC/DEPRECATED/sgelsx.f

@@ -5,7 +5,6 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download SGELSX + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgelsx.f">
 *> [TGZ]</a>
@@ -13,7 +12,6 @@
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgelsx.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -173,8 +171,8 @@
 *> \ingroup realGEsolve
 *
 *  =====================================================================
-      SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
-     $                   WORK, INFO )
+      SUBROUTINE SGELSX( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND,
+     $                   RANK, WORK, INFO )
 *
 *  -- LAPACK driver routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -283,20 +281,23 @@
 *
 *        Scale matrix norm up to SMLNUM
 *
-         CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 1
       ELSE IF( BNRM.GT.BIGNUM ) THEN
 *
 *        Scale matrix norm down to BIGNUM
 *
-         CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BNRM, BIGNUM, M, NRHS, B, LDB,
+     $                INFO )
          IBSCL = 2
       END IF
 *
 *     Compute QR factorization with column pivoting of A:
 *        A * P = Q * R
 *
-      CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ), INFO )
+      CALL SGEQPF( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
+     $             INFO )
 *
 *     workspace 3*N. Details of Householder rotations stored
 *     in WORK(1:MN).
@@ -350,15 +351,15 @@
 *
 *     B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
 *
-      CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
-     $             B, LDB, WORK( 2*MN+1 ), INFO )
+      CALL SORM2R( 'Left', 'Transpose', M, NRHS, MN, A, LDA,
+     $             WORK( 1 ), B, LDB, WORK( 2*MN+1 ), INFO )
 *
 *     workspace NRHS
 *
 *     B(1:RANK,1:NRHS) := inv(T11) * B(1:RANK,1:NRHS)
 *
-      CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', RANK,
-     $            NRHS, ONE, A, LDA, B, LDB )
+      CALL STRSM( 'Left', 'Upper', 'No transpose', 'Non-unit',
+     $            RANK, NRHS, ONE, A, LDA, B, LDB )
 *
       DO 40 I = RANK + 1, N
          DO 30 J = 1, NRHS
@@ -408,18 +409,22 @@
 *     Undo scaling
 *
       IF( IASCL.EQ.1 ) THEN
-         CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL SLASCL( 'U', 0, 0, SMLNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       ELSE IF( IASCL.EQ.2 ) THEN
-         CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, N, NRHS, B, LDB,
+     $                INFO )
          CALL SLASCL( 'U', 0, 0, BIGNUM, ANRM, RANK, RANK, A, LDA,
      $                INFO )
       END IF
       IF( IBSCL.EQ.1 ) THEN
-         CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       ELSE IF( IBSCL.EQ.2 ) THEN
-         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB,
+     $                INFO )
       END IF
 *
   100 CONTINUE