Index: trunk/SOURCES/BLAS/ilaslc.f
===================================================================
--- trunk/SOURCES/BLAS/ilaslc.f	(revision 22)
+++ trunk/SOURCES/BLAS/ilaslc.f	(revision 22)
@@ -0,0 +1,118 @@
+*> \brief \b ILASLC
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ILASLC + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslc.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslc.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslc.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION ILASLC( M, N, A, LDA )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            M, N, LDA
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ILASLC scans A for its last non-zero column.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          The m by n matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*  =====================================================================
+      INTEGER FUNCTION ILASLC( M, N, A, LDA )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            M, N, LDA
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL             ZERO
+      PARAMETER ( ZERO = 0.0D+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER I
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick test for the common case where one corner is non-zero.
+      IF( N.EQ.0 ) THEN
+         ILASLC = N
+      ELSE IF( A(1, N).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+         ILASLC = N
+      ELSE
+*     Now scan each column from the end, returning with the first non-zero.
+         DO ILASLC = N, 1, -1
+            DO I = 1, M
+               IF( A(I, ILASLC).NE.ZERO ) RETURN
+            END DO
+         END DO
+      END IF
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/ilaslr.f
===================================================================
--- trunk/SOURCES/BLAS/ilaslr.f	(revision 22)
+++ trunk/SOURCES/BLAS/ilaslr.f	(revision 22)
@@ -0,0 +1,124 @@
+*> \brief \b ILASLR
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ILASLR + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaslr.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaslr.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaslr.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       INTEGER FUNCTION ILASLR( M, N, A, LDA )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            M, N, LDA
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ILASLR scans A for its last non-zero row.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          The m by n matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*  =====================================================================
+      INTEGER FUNCTION ILASLR( M, N, A, LDA )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            M, N, LDA
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL             ZERO
+      PARAMETER ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER I, J
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick test for the common case where one corner is non-zero.
+      IF( M.EQ.0 ) THEN
+         ILASLR = M
+      ELSEIF( A(M, 1).NE.ZERO .OR. A(M, N).NE.ZERO ) THEN
+         ILASLR = M
+      ELSE
+*     Scan up each column tracking the last zero row seen.
+         ILASLR = 0
+         DO J = 1, N
+            I=M
+            DO WHILE ((A(I,J).NE.ZERO).AND.(I.GE.1))
+              I=I-1
+              IF (I.EQ.0) THEN
+                 EXIT
+              END IF
+            ENDDO
+            ILASLR = MAX( ILASLR, I )
+         END DO
+      END IF
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/saxpy.f
===================================================================
--- trunk/SOURCES/BLAS/saxpy.f	(revision 22)
+++ trunk/SOURCES/BLAS/saxpy.f	(revision 22)
@@ -0,0 +1,69 @@
+      SUBROUTINE SAXPY(N,SA,SX,INCX,SY,INCY)
+*     .. Scalar Arguments ..
+      REAL SA
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     SAXPY constant times a vector plus a vector.
+*     uses unrolled loops for increments equal to one.
+*
+*  Further Details
+*  ===============
+*
+*     jack dongarra, linpack, 3/11/78.
+*     modified 12/3/93, array(1) declarations changed to array(*)
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      IF (N.LE.0) RETURN
+      IF (SA.EQ.0.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,4)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               SY(I) = SY(I) + SA*SX(I)
+            END DO
+         END IF
+         IF (N.LT.4) RETURN
+         MP1 = M + 1
+         DO I = MP1,N,4
+            SY(I) = SY(I) + SA*SX(I)
+            SY(I+1) = SY(I+1) + SA*SX(I+1)
+            SY(I+2) = SY(I+2) + SA*SX(I+2)
+            SY(I+3) = SY(I+3) + SA*SX(I+3)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+          SY(IY) = SY(IY) + SA*SX(IX)
+          IX = IX + INCX
+          IY = IY + INCY
+         END DO
+      END IF
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/sdot.f
===================================================================
--- trunk/SOURCES/BLAS/sdot.f	(revision 22)
+++ trunk/SOURCES/BLAS/sdot.f	(revision 22)
@@ -0,0 +1,72 @@
+      REAL FUNCTION SDOT(N,SX,INCX,SY,INCY)
+*     .. Scalar Arguments ..
+      INTEGER INCX,INCY,N
+*     ..
+*     .. Array Arguments ..
+      REAL SX(*),SY(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*     SDOT forms the dot product of two vectors.
+*     uses unrolled loops for increments equal to one.
+*
+*  Further Details
+*  ===============
+*
+*     jack dongarra, linpack, 3/11/78.
+*     modified 12/3/93, array(1) declarations changed to array(*)
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      REAL STEMP
+      INTEGER I,IX,IY,M,MP1
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MOD
+*     ..
+      STEMP = 0.0e0
+      SDOT = 0.0e0
+      IF (N.LE.0) RETURN
+      IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
+*
+*        code for both increments equal to 1
+*
+*
+*        clean-up loop
+*
+         M = MOD(N,5)
+         IF (M.NE.0) THEN
+            DO I = 1,M
+               STEMP = STEMP + SX(I)*SY(I)
+            END DO
+            IF (N.LT.5) THEN
+               SDOT=STEMP
+            RETURN
+            END IF
+         END IF
+         MP1 = M + 1
+         DO I = MP1,N,5
+          STEMP = STEMP + SX(I)*SY(I) + SX(I+1)*SY(I+1) +
+     $            SX(I+2)*SY(I+2) + SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4)
+         END DO
+      ELSE
+*
+*        code for unequal increments or equal increments
+*          not equal to 1
+*
+         IX = 1
+         IY = 1
+         IF (INCX.LT.0) IX = (-N+1)*INCX + 1
+         IF (INCY.LT.0) IY = (-N+1)*INCY + 1
+         DO I = 1,N
+            STEMP = STEMP + SX(IX)*SY(IY)
+            IX = IX + INCX
+            IY = IY + INCY
+         END DO
+      END IF
+      SDOT = STEMP
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/sgbsv.f
===================================================================
--- trunk/SOURCES/BLAS/sgbsv.f	(revision 22)
+++ trunk/SOURCES/BLAS/sgbsv.f	(revision 22)
@@ -0,0 +1,223 @@
+*> \brief <b> SGBSV computes the solution to system of linear equations A * X = B for GB matrices</b> (simple driver)
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SGBSV + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgbsv.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgbsv.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgbsv.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, KL, KU, LDAB, LDB, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            IPIV( * )
+*       REAL               AB( LDAB, * ), B( LDB, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGBSV computes the solution to a real system of linear equations
+*> A * X = B, where A is a band matrix of order N with KL subdiagonals
+*> and KU superdiagonals, and X and B are N-by-NRHS matrices.
+*>
+*> The LU decomposition with partial pivoting and row interchanges is
+*> used to factor A as A = L * U, where L is a product of permutation
+*> and unit lower triangular matrices with KL subdiagonals, and U is
+*> upper triangular with KL+KU superdiagonals.  The factored form of A
+*> is then used to solve the system of equations A * X = B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of linear equations, i.e., the order of the
+*>          matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] KL
+*> \verbatim
+*>          KL is INTEGER
+*>          The number of subdiagonals within the band of A.  KL >= 0.
+*> \endverbatim
+*>
+*> \param[in] KU
+*> \verbatim
+*>          KU is INTEGER
+*>          The number of superdiagonals within the band of A.  KU >= 0.
+*> \endverbatim
+*>
+*> \param[in] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of columns
+*>          of the matrix B.  NRHS >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] AB
+*> \verbatim
+*>          AB is REAL array, dimension (LDAB,N)
+*>          On entry, the matrix A in band storage, in rows KL+1 to
+*>          2*KL+KU+1; rows 1 to KL of the array need not be set.
+*>          The j-th column of A is stored in the j-th column of the
+*>          array AB as follows:
+*>          AB(KL+KU+1+i-j,j) = A(i,j) for max(1,j-KU)<=i<=min(N,j+KL)
+*>          On exit, details of the factorization: U is stored as an
+*>          upper triangular band matrix with KL+KU superdiagonals in
+*>          rows 1 to KL+KU+1, and the multipliers used during the
+*>          factorization are stored in rows KL+KU+2 to 2*KL+KU+1.
+*>          See below for further details.
+*> \endverbatim
+*>
+*> \param[in] LDAB
+*> \verbatim
+*>          LDAB is INTEGER
+*>          The leading dimension of the array AB.  LDAB >= 2*KL+KU+1.
+*> \endverbatim
+*>
+*> \param[out] IPIV
+*> \verbatim
+*>          IPIV is INTEGER array, dimension (N)
+*>          The pivot indices that define the permutation matrix P;
+*>          row i of the matrix was interchanged with row IPIV(i).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,NRHS)
+*>          On entry, the N-by-NRHS right hand side matrix B.
+*>          On exit, if INFO = 0, the N-by-NRHS solution matrix X.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,N).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*>          > 0:  if INFO = i, U(i,i) is exactly zero.  The factorization
+*>                has been completed, but the factor U is exactly
+*>                singular, and the solution has not been computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realGBsolve
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The band storage scheme is illustrated by the following example, when
+*>  M = N = 6, KL = 2, KU = 1:
+*>
+*>  On entry:                       On exit:
+*>
+*>      *    *    *    +    +    +       *    *    *   u14  u25  u36
+*>      *    *    +    +    +    +       *    *   u13  u24  u35  u46
+*>      *   a12  a23  a34  a45  a56      *   u12  u23  u34  u45  u56
+*>     a11  a22  a33  a44  a55  a66     u11  u22  u33  u44  u55  u66
+*>     a21  a32  a43  a54  a65   *      m21  m32  m43  m54  m65   *
+*>     a31  a42  a53  a64   *    *      m31  m42  m53  m64   *    *
+*>
+*>  Array elements marked * are not used by the routine; elements marked
+*>  + need not be set on entry, but are required by the routine to store
+*>  elements of U because of fill-in resulting from the row interchanges.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGBSV( N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO )
+*
+*  -- LAPACK driver routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, KL, KU, LDAB, LDB, N, NRHS
+*     ..
+*     .. Array Arguments ..
+      INTEGER            IPIV( * )
+      REAL               AB( LDAB, * ), B( LDB, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. External Subroutines ..
+      EXTERNAL           SGBTRF, SGBTRS, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF( N.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( KL.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( KU.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDAB.LT.2*KL+KU+1 ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGBSV ', -INFO )
+         RETURN
+      END IF
+*
+*     Compute the LU factorization of the band matrix A.
+*
+      CALL SGBTRF( N, N, KL, KU, AB, LDAB, IPIV, INFO )
+      IF( INFO.EQ.0 ) THEN
+*
+*        Solve the system A*X = B, overwriting B with X.
+*
+         CALL SGBTRS( 'No transpose', N, KL, KU, NRHS, AB, LDAB, IPIV,
+     $                B, LDB, INFO )
+      END IF
+      RETURN
+*
+*     End of SGBSV
+*
+      END
Index: trunk/SOURCES/BLAS/sgelsy.f
===================================================================
--- trunk/SOURCES/BLAS/sgelsy.f	(revision 22)
+++ trunk/SOURCES/BLAS/sgelsy.f	(revision 22)
@@ -0,0 +1,392 @@
+	SUBROUTINE SGELSY( M, N, NRHS, A, LDA, B, LDB, JPVT, RCOND, RANK,
+     $                   WORK, LWORK, INFO )
+*
+*  -- LAPACK driver routine (version 3.3.1) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*  -- April 2011                                                      --
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, RANK
+      REAL               RCOND
+*     ..
+*     .. Array Arguments ..
+      INTEGER            JPVT( * )
+      REAL               A( LDA, * ), B( LDB, * ), WORK( * )
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  SGELSY computes the minimum-norm solution to a real linear least
+*  squares problem:
+*      minimize || A * X - B ||
+*  using a complete orthogonal factorization of A.  A is an M-by-N
+*  matrix which may be rank-deficient.
+*
+*  Several right hand side vectors b and solution vectors x can be
+*  handled in a single call; they are stored as the columns of the
+*  M-by-NRHS right hand side matrix B and the N-by-NRHS solution
+*  matrix X.
+*
+*  The routine first computes a QR factorization with column pivoting:
+*      A * P = Q * [ R11 R12 ]
+*                  [  0  R22 ]
+*  with R11 defined as the largest leading submatrix whose estimated
+*  condition number is less than 1/RCOND.  The order of R11, RANK,
+*  is the effective rank of A.
+*
+*  Then, R22 is considered to be negligible, and R12 is annihilated
+*  by orthogonal transformations from the right, arriving at the
+*  complete orthogonal factorization:
+*     A * P = Q * [ T11 0 ] * Z
+*                 [  0  0 ]
+*  The minimum-norm solution is then
+*     X = P * Z**T [ inv(T11)*Q1**T*B ]
+*                  [        0         ]
+*  where Q1 consists of the first RANK columns of Q.
+*
+*  This routine is basically identical to the original xGELSX except
+*  three differences:
+*    o The call to the subroutine xGEQPF has been substituted by the
+*      the call to the subroutine xGEQP3. This subroutine is a Blas-3
+*      version of the QR factorization with column pivoting.
+*    o Matrix B (the right hand side) is updated with Blas-3.
+*    o The permutation of matrix B (the right hand side) is faster and
+*      more simple.
+*
+*  Arguments
+*  =========
+*
+*  M       (input) INTEGER
+*          The number of rows of the matrix A.  M &gt;= 0.
+*
+*  N       (input) INTEGER
+*          The number of columns of the matrix A.  N &gt;= 0.
+*
+*  NRHS    (input) INTEGER
+*          The number of right hand sides, i.e., the number of
+*          columns of matrices B and X. NRHS &gt;= 0.
+*
+*  A       (input/output) REAL array, dimension (LDA,N)
+*          On entry, the M-by-N matrix A.
+*          On exit, A has been overwritten by details of its
+*          complete orthogonal factorization.
+*
+*  LDA     (input) INTEGER
+*          The leading dimension of the array A.  LDA &gt;= max(1,M).
+*
+*  B       (input/output) REAL array, dimension (LDB,NRHS)
+*          On entry, the M-by-NRHS right hand side matrix B.
+*          On exit, the N-by-NRHS solution matrix X.
+*
+*  LDB     (input) INTEGER
+*          The leading dimension of the array B. LDB &gt;= max(1,M,N).
+*
+*  JPVT    (input/output) INTEGER array, dimension (N)
+*          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+*          to the front of AP, otherwise column i is a free column.
+*          On exit, if JPVT(i) = k, then the i-th column of AP
+*          was the k-th column of A.
+*
+*  RCOND   (input) REAL
+*          RCOND is used to determine the effective rank of A, which
+*          is defined as the order of the largest leading triangular
+*          submatrix R11 in the QR factorization with pivoting of A,
+*          whose estimated condition number &lt; 1/RCOND.
+*
+*  RANK    (output) INTEGER
+*          The effective rank of A, i.e., the order of the submatrix
+*          R11.  This is the same as the order of the submatrix T11
+*          in the complete orthogonal factorization of A.
+*
+*  WORK    (workspace/output) REAL array, dimension (MAX(1,LWORK))
+*          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*
+*  LWORK   (input) INTEGER
+*          The dimension of the array WORK.
+*          The unblocked strategy requires that:
+*             LWORK &gt;= MAX( MN+3*N+1, 2*MN+NRHS ),
+*          where MN = min( M, N ).
+*          The block algorithm requires that:
+*             LWORK &gt;= MAX( MN+2*N+NB*(N+1), 2*MN+NB*NRHS ),
+*          where NB is an upper bound on the blocksize returned
+*          by ILAENV for the routines SGEQP3, STZRZF, STZRQF, SORMQR,
+*          and SORMRZ.
+*
+*          If LWORK = -1, then a workspace query is assumed; the routine
+*          only calculates the optimal size of the WORK array, returns
+*          this value as the first entry of the WORK array, and no error
+*          message related to LWORK is issued by XERBLA.
+*
+*  INFO    (output) INTEGER
+*          = 0: successful exit
+*          &lt; 0: If INFO = -i, the i-th argument had an illegal value.
+*
+*  Further Details
+*  ===============
+*
+*  Based on contributions by
+*    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*    E. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+*    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER            IMAX, IMIN
+      PARAMETER          ( IMAX = 1, IMIN = 2 )
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            I, IASCL, IBSCL, ISMAX, ISMIN, J, LWKMIN,
+     $                   LWKOPT, MN, NB, NB1, NB2, NB3, NB4
+      REAL               ANRM, BIGNUM, BNRM, C1, C2, S1, S2, SMAX,
+     $                   SMAXPR, SMIN, SMINPR, SMLNUM, WSIZE
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANGE
+      EXTERNAL           ILAENV, SLAMCH, SLANGE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SGEQP3, SLABAD, SLAIC1, SLASCL, SLASET,
+     $                   SORMQR, SORMRZ, STRSM, STZRZF, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+      MN = MIN( M, N )
+      ISMIN = MN + 1
+      ISMAX = 2*MN + 1
+*
+*     Test the input arguments.
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( M.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
+         INFO = -7
+      END IF
+*
+*     Figure out optimal block size
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
+            LWKMIN = 1
+            LWKOPT = 1
+         ELSE
+            NB1 = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
+            NB2 = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
+            NB3 = ILAENV( 1, 'SORMQR', ' ', M, N, NRHS, -1 )
+            NB4 = ILAENV( 1, 'SORMRQ', ' ', M, N, NRHS, -1 )
+            NB = MAX( NB1, NB2, NB3, NB4 )
+            LWKMIN = MN + MAX( 2*MN, N + 1, MN + NRHS )
+            LWKOPT = MAX( LWKMIN,
+     $                    MN + 2*N + NB*( N + 1 ), 2*MN + NB*NRHS )
+         END IF
+         WORK( 1 ) = LWKOPT
+*
+         IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -12
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGELSY', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MN.EQ.0 .OR. NRHS.EQ.0 ) THEN
+         RANK = 0
+         RETURN
+      END IF
+*
+*     Get machine parameters
+*
+      SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
+      BIGNUM = ONE / SMLNUM
+      CALL SLABAD( SMLNUM, BIGNUM )
+*
+*     Scale A, B if max entries outside range [SMLNUM,BIGNUM]
+*
+      ANRM = SLANGE( 'M', M, N, A, LDA, WORK )
+      IASCL = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, M, N, A, LDA, INFO )
+         IASCL = 1
+      ELSE IF( ANRM.GT.BIGNUM ) THEN
+*
+*        Scale matrix norm down to BIGNUM
+*
+         CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, M, N, A, LDA, INFO )
+         IASCL = 2
+      ELSE IF( ANRM.EQ.ZERO ) THEN
+*
+*        Matrix all zero. Return zero solution.
+*
+         CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
+         RANK = 0
+         GO TO 70
+      END IF
+*
+      BNRM = SLANGE( 'M', M, NRHS, B, LDB, WORK )
+      IBSCL = 0
+      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         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 )
+         IBSCL = 2
+      END IF
+*
+*     Compute QR factorization with column pivoting of A:
+*        A * P = Q * R
+*
+      CALL SGEQP3( M, N, A, LDA, JPVT, WORK( 1 ), WORK( MN+1 ),
+     $             LWORK-MN, INFO )
+      WSIZE = MN + WORK( MN+1 )
+*
+*     workspace: MN+2*N+NB*(N+1).
+*     Details of Householder rotations stored in WORK(1:MN).
+*
+*     Determine RANK using incremental condition estimation
+*
+      WORK( ISMIN ) = ONE
+      WORK( ISMAX ) = ONE
+      SMAX = ABS( A( 1, 1 ) )
+      SMIN = SMAX
+      IF( ABS( A( 1, 1 ) ).EQ.ZERO ) THEN
+         RANK = 0
+         CALL SLASET( 'F', MAX( M, N ), NRHS, ZERO, ZERO, B, LDB )
+         GO TO 70
+      ELSE
+         RANK = 1
+      END IF
+*
+   10 CONTINUE
+      IF( RANK.LT.MN ) THEN
+         I = RANK + 1
+         CALL SLAIC1( IMIN, RANK, WORK( ISMIN ), SMIN, A( 1, I ),
+     $                A( I, I ), SMINPR, S1, C1 )
+         CALL SLAIC1( IMAX, RANK, WORK( ISMAX ), SMAX, A( 1, I ),
+     $                A( I, I ), SMAXPR, S2, C2 )
+*
+         IF( SMAXPR*RCOND.LE.SMINPR ) THEN
+            DO 20 I = 1, RANK
+               WORK( ISMIN+I-1 ) = S1*WORK( ISMIN+I-1 )
+               WORK( ISMAX+I-1 ) = S2*WORK( ISMAX+I-1 )
+   20       CONTINUE
+            WORK( ISMIN+RANK ) = C1
+            WORK( ISMAX+RANK ) = C2
+            SMIN = SMINPR
+            SMAX = SMAXPR
+            RANK = RANK + 1
+            GO TO 10
+         END IF
+      END IF
+*
+*     workspace: 3*MN.
+*
+*     Logically partition R = [ R11 R12 ]
+*                             [  0  R22 ]
+*     where R11 = R(1:RANK,1:RANK)
+*
+*     [R11,R12] = [ T11, 0 ] * Y
+*
+      IF( RANK.LT.N )
+     $   CALL STZRZF( RANK, N, A, LDA, WORK( MN+1 ), WORK( 2*MN+1 ),
+     $                LWORK-2*MN, INFO )
+*
+*     workspace: 2*MN.
+*     Details of Householder rotations stored in WORK(MN+1:2*MN)
+*
+*     B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
+*
+      CALL SORMQR( 'Left', 'Transpose', M, NRHS, MN, A, LDA, WORK( 1 ),
+     $             B, LDB, WORK( 2*MN+1 ), LWORK-2*MN, INFO )
+      WSIZE = MAX( WSIZE, 2*MN+WORK( 2*MN+1 ) )
+*
+*     workspace: 2*MN+NB*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 )
+*
+      DO 40 J = 1, NRHS
+         DO 30 I = RANK + 1, N
+            B( I, J ) = ZERO
+   30    CONTINUE
+   40 CONTINUE
+*
+*     B(1:N,1:NRHS) := Y**T * B(1:N,1:NRHS)
+*
+      IF( RANK.LT.N ) THEN
+         CALL SORMRZ( 'Left', 'Transpose', N, NRHS, RANK, N-RANK, A,
+     $                LDA, WORK( MN+1 ), B, LDB, WORK( 2*MN+1 ),
+     $                LWORK-2*MN, INFO )
+      END IF
+*
+*     workspace: 2*MN+NRHS.
+*
+*     B(1:N,1:NRHS) := P * B(1:N,1:NRHS)
+*
+      DO 60 J = 1, NRHS
+         DO 50 I = 1, N
+            WORK( JPVT( I ) ) = B( I, J )
+   50    CONTINUE
+         CALL SCOPY( N, WORK( 1 ), 1, B( 1, J ), 1 )
+   60 CONTINUE
+*
+*     workspace: N.
+*
+*     Undo scaling
+*
+      IF( IASCL.EQ.1 ) THEN
+         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( '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 )
+      ELSE IF( IBSCL.EQ.2 ) THEN
+         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, N, NRHS, B, LDB, INFO )
+      END IF
+*
+   70 CONTINUE
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of SGELSY
+*
+      END
Index: trunk/SOURCES/BLAS/sgeqp3.f
===================================================================
--- trunk/SOURCES/BLAS/sgeqp3.f	(revision 22)
+++ trunk/SOURCES/BLAS/sgeqp3.f	(revision 22)
@@ -0,0 +1,364 @@
+*> \brief \b SGEQP3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SGEQP3 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqp3.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqp3.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqp3.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            JPVT( * )
+*       REAL               A( LDA, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGEQP3 computes a QR factorization with column pivoting of a
+*> matrix A:  A*P = Q*R  using Level 3 BLAS.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the upper triangle of the array contains the
+*>          min(M,N)-by-N upper trapezoidal matrix R; the elements below
+*>          the diagonal, together with the array TAU, represent the
+*>          orthogonal matrix Q as a product of min(M,N) elementary
+*>          reflectors.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] JPVT
+*> \verbatim
+*>          JPVT is INTEGER array, dimension (N)
+*>          On entry, if JPVT(J).ne.0, the J-th column of A is permuted
+*>          to the front of A*P (a leading column); if JPVT(J)=0,
+*>          the J-th column of A is a free column.
+*>          On exit, if JPVT(J)=K, then the J-th column of A*P was the
+*>          the K-th column of A.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (min(M,N))
+*>          The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO=0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK. LWORK >= 3*N+1.
+*>          For optimal performance LWORK >= 2*N+( N+1 )*NB, where NB
+*>          is the optimal blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit.
+*>          < 0: if INFO = -i, the i-th argument had an illegal value.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix Q is represented as a product of elementary reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real/complex scalar, and v is a real/complex vector
+*>  with v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in
+*>  A(i+1:m,i), and tau in TAU(i).
+*> \endverbatim
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+*>    X. Sun, Computer Science Dept., Duke University, USA
+*>
+*  =====================================================================
+      SUBROUTINE SGEQP3( M, N, A, LDA, JPVT, TAU, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      INTEGER            JPVT( * )
+      REAL               A( LDA, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER            INB, INBMIN, IXOVER
+      PARAMETER          ( INB = 1, INBMIN = 2, IXOVER = 3 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            FJB, IWS, J, JB, LWKOPT, MINMN, MINWS, NA, NB,
+     $                   NBMIN, NFXD, NX, SM, SMINMN, SN, TOPBMN
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEQRF, SLAQP2, SLAQPS, SORMQR, SSWAP, XERBLA
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      REAL               SNRM2
+      EXTERNAL           ILAENV, SNRM2
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( M.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -4
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         MINMN = MIN( M, N )
+         IF( MINMN.EQ.0 ) THEN
+            IWS = 1
+            LWKOPT = 1
+         ELSE
+            IWS = 3*N + 1
+            NB = ILAENV( INB, 'SGEQRF', ' ', M, N, -1, -1 )
+            LWKOPT = 2*N + ( N + 1 )*NB
+         END IF
+         WORK( 1 ) = LWKOPT
+*
+         IF( ( LWORK.LT.IWS ) .AND. .NOT.LQUERY ) THEN
+            INFO = -8
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGEQP3', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF( MINMN.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+*     Move initial columns up front.
+*
+      NFXD = 1
+      DO 10 J = 1, N
+         IF( JPVT( J ).NE.0 ) THEN
+            IF( J.NE.NFXD ) THEN
+               CALL SSWAP( M, A( 1, J ), 1, A( 1, NFXD ), 1 )
+               JPVT( J ) = JPVT( NFXD )
+               JPVT( NFXD ) = J
+            ELSE
+               JPVT( J ) = J
+            END IF
+            NFXD = NFXD + 1
+         ELSE
+            JPVT( J ) = J
+         END IF
+   10 CONTINUE
+      NFXD = NFXD - 1
+*
+*     Factorize fixed columns
+*  =======================
+*
+*     Compute the QR factorization of fixed columns and update
+*     remaining columns.
+*
+      IF( NFXD.GT.0 ) THEN
+         NA = MIN( M, NFXD )
+*CC      CALL SGEQR2( M, NA, A, LDA, TAU, WORK, INFO )
+         CALL SGEQRF( M, NA, A, LDA, TAU, WORK, LWORK, INFO )
+         IWS = MAX( IWS, INT( WORK( 1 ) ) )
+         IF( NA.LT.N ) THEN
+*CC         CALL SORM2R( 'Left', 'Transpose', M, N-NA, NA, A, LDA,
+*CC  $                   TAU, A( 1, NA+1 ), LDA, WORK, INFO )
+            CALL SORMQR( 'Left', 'Transpose', M, N-NA, NA, A, LDA, TAU,
+     $                   A( 1, NA+1 ), LDA, WORK, LWORK, INFO )
+            IWS = MAX( IWS, INT( WORK( 1 ) ) )
+         END IF
+      END IF
+*
+*     Factorize free columns
+*  ======================
+*
+      IF( NFXD.LT.MINMN ) THEN
+*
+         SM = M - NFXD
+         SN = N - NFXD
+         SMINMN = MINMN - NFXD
+*
+*        Determine the block size.
+*
+         NB = ILAENV( INB, 'SGEQRF', ' ', SM, SN, -1, -1 )
+         NBMIN = 2
+         NX = 0
+*
+         IF( ( NB.GT.1 ) .AND. ( NB.LT.SMINMN ) ) THEN
+*
+*           Determine when to cross over from blocked to unblocked code.
+*
+            NX = MAX( 0, ILAENV( IXOVER, 'SGEQRF', ' ', SM, SN, -1,
+     $           -1 ) )
+*
+*
+            IF( NX.LT.SMINMN ) THEN
+*
+*              Determine if workspace is large enough for blocked code.
+*
+               MINWS = 2*SN + ( SN+1 )*NB
+               IWS = MAX( IWS, MINWS )
+               IF( LWORK.LT.MINWS ) THEN
+*
+*                 Not enough workspace to use optimal NB: Reduce NB and
+*                 determine the minimum value of NB.
+*
+                  NB = ( LWORK-2*SN ) / ( SN+1 )
+                  NBMIN = MAX( 2, ILAENV( INBMIN, 'SGEQRF', ' ', SM, SN,
+     $                    -1, -1 ) )
+*
+*
+               END IF
+            END IF
+         END IF
+*
+*        Initialize partial column norms. The first N elements of work
+*        store the exact column norms.
+*
+         DO 20 J = NFXD + 1, N
+            WORK( J ) = SNRM2( SM, A( NFXD+1, J ), 1 )
+            WORK( N+J ) = WORK( J )
+   20    CONTINUE
+*
+         IF( ( NB.GE.NBMIN ) .AND. ( NB.LT.SMINMN ) .AND.
+     $       ( NX.LT.SMINMN ) ) THEN
+*
+*           Use blocked code initially.
+*
+            J = NFXD + 1
+*
+*           Compute factorization: while loop.
+*
+*
+            TOPBMN = MINMN - NX
+   30       CONTINUE
+            IF( J.LE.TOPBMN ) THEN
+               JB = MIN( NB, TOPBMN-J+1 )
+*
+*              Factorize JB columns among columns J:N.
+*
+               CALL SLAQPS( M, N-J+1, J-1, JB, FJB, A( 1, J ), LDA,
+     $                      JPVT( J ), TAU( J ), WORK( J ), WORK( N+J ),
+     $                      WORK( 2*N+1 ), WORK( 2*N+JB+1 ), N-J+1 )
+*
+               J = J + FJB
+               GO TO 30
+            END IF
+         ELSE
+            J = NFXD + 1
+         END IF
+*
+*        Use unblocked code to factor the last or only block.
+*
+*
+         IF( J.LE.MINMN )
+     $      CALL SLAQP2( M, N-J+1, J-1, A( 1, J ), LDA, JPVT( J ),
+     $                   TAU( J ), WORK( J ), WORK( N+J ),
+     $                   WORK( 2*N+1 ) )
+*
+      END IF
+*
+      WORK( 1 ) = IWS
+      RETURN
+*
+*     End of SGEQP3
+*
+      END
Index: trunk/SOURCES/BLAS/sgeqr2.f
===================================================================
--- trunk/SOURCES/BLAS/sgeqr2.f	(revision 22)
+++ trunk/SOURCES/BLAS/sgeqr2.f	(revision 22)
@@ -0,0 +1,192 @@
+*> \brief \b SGEQR2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SGEQR2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqr2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqr2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqr2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGEQR2 computes a QR factorization of a real m by n matrix A:
+*> A = Q * R.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the m by n matrix A.
+*>          On exit, the elements on and above the diagonal of the array
+*>          contain the min(m,n) by n upper trapezoidal matrix R (R is
+*>          upper triangular if m >= n); the elements below the diagonal,
+*>          with the array TAU, represent the orthogonal matrix Q as a
+*>          product of elementary reflectors (see Further Details).
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (min(M,N))
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (N)
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix Q is represented as a product of elementary reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+*>  and tau in TAU(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEQR2( M, N, A, LDA, TAU, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, K
+      REAL               AII
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARF, SLARFG, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      IF( M.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGEQR2', -INFO )
+         RETURN
+      END IF
+*
+      K = MIN( M, N )
+*
+      DO 10 I = 1, K
+*
+*        Generate elementary reflector H(i) to annihilate A(i+1:m,i)
+*
+         CALL SLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1,
+     $                TAU( I ) )
+         IF( I.LT.N ) THEN
+*
+*           Apply H(i) to A(i:m,i+1:n) from the left
+*
+            AII = A( I, I )
+            A( I, I ) = ONE
+            CALL SLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ),
+     $                  A( I, I+1 ), LDA, WORK )
+            A( I, I ) = AII
+         END IF
+   10 CONTINUE
+      RETURN
+*
+*     End of SGEQR2
+*
+      END
Index: trunk/SOURCES/BLAS/sgeqrf.f
===================================================================
--- trunk/SOURCES/BLAS/sgeqrf.f	(revision 22)
+++ trunk/SOURCES/BLAS/sgeqrf.f	(revision 22)
@@ -0,0 +1,270 @@
+*> \brief \b SGEQRF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SGEQRF + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgeqrf.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgeqrf.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgeqrf.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGEQRF computes a QR factorization of a real M-by-N matrix A:
+*> A = Q * R.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and above the diagonal of the array
+*>          contain the min(M,N)-by-N upper trapezoidal matrix R (R is
+*>          upper triangular if m >= n); the elements below the diagonal,
+*>          with the array TAU, represent the orthogonal matrix Q as a
+*>          product of min(m,n) elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (min(M,N))
+*>          The scalar factors of the elementary reflectors (see Further
+*>          Details).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  LWORK >= max(1,N).
+*>          For optimum performance LWORK >= N*NB, where NB is 
+*>          the optimal blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix Q is represented as a product of elementary reflectors
+*>
+*>     Q = H(1) H(2) . . . H(k), where k = min(m,n).
+*>
+*>  Each H(i) has the form
+*>
+*>     H(i) = I - tau * v * v**T
+*>
+*>  where tau is a real scalar, and v is a real vector with
+*>  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i),
+*>  and tau in TAU(i).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IINFO, IWS, K, LDWORK, LWKOPT, NB,
+     $                   NBMIN, NX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEQR2, SLARFB, SLARFT, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      NB = ILAENV( 1, 'SGEQRF', ' ', M, N, -1, -1 )
+      LWKOPT = N*NB
+      WORK( 1 ) = LWKOPT
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( M.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -4
+      ELSE IF( LWORK.LT.MAX( 1, N ) .AND. .NOT.LQUERY ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGEQRF', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      K = MIN( M, N )
+      IF( K.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      NX = 0
+      IWS = N
+      IF( NB.GT.1 .AND. NB.LT.K ) THEN
+*
+*        Determine when to cross over from blocked to unblocked code.
+*
+         NX = MAX( 0, ILAENV( 3, 'SGEQRF', ' ', M, N, -1, -1 ) )
+         IF( NX.LT.K ) THEN
+*
+*           Determine if workspace is large enough for blocked code.
+*
+            LDWORK = N
+            IWS = LDWORK*NB
+            IF( LWORK.LT.IWS ) THEN
+*
+*              Not enough workspace to use optimal NB:  reduce NB and
+*              determine the minimum value of NB.
+*
+               NB = LWORK / LDWORK
+               NBMIN = MAX( 2, ILAENV( 2, 'SGEQRF', ' ', M, N, -1,
+     $                 -1 ) )
+            END IF
+         END IF
+      END IF
+*
+      IF( NB.GE.NBMIN .AND. NB.LT.K .AND. NX.LT.K ) THEN
+*
+*        Use blocked code initially
+*
+         DO 10 I = 1, K - NX, NB
+            IB = MIN( K-I+1, NB )
+*
+*           Compute the QR factorization of the current block
+*           A(i:m,i:i+ib-1)
+*
+            CALL SGEQR2( M-I+1, IB, A( I, I ), LDA, TAU( I ), WORK,
+     $                   IINFO )
+            IF( I+IB.LE.N ) THEN
+*
+*              Form the triangular factor of the block reflector
+*              H = H(i) H(i+1) . . . H(i+ib-1)
+*
+               CALL SLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+     $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
+*
+*              Apply H**T to A(i:m,i+ib:n) from the left
+*
+               CALL SLARFB( 'Left', 'Transpose', 'Forward',
+     $                      'Columnwise', M-I+1, N-I-IB+1, IB,
+     $                      A( I, I ), LDA, WORK, LDWORK, A( I, I+IB ),
+     $                      LDA, WORK( IB+1 ), LDWORK )
+            END IF
+   10    CONTINUE
+      ELSE
+         I = 1
+      END IF
+*
+*     Use unblocked code to factor the last or only block.
+*
+      IF( I.LE.K )
+     $   CALL SGEQR2( M-I+1, N-I+1, A( I, I ), LDA, TAU( I ), WORK,
+     $                IINFO )
+*
+      WORK( 1 ) = IWS
+      RETURN
+*
+*     End of SGEQRF
+*
+      END
Index: trunk/SOURCES/BLAS/sisnan.f
===================================================================
--- trunk/SOURCES/BLAS/sisnan.f	(revision 22)
+++ trunk/SOURCES/BLAS/sisnan.f	(revision 22)
@@ -0,0 +1,80 @@
+*> \brief \b SISNAN
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SISNAN + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sisnan.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sisnan.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sisnan.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       LOGICAL FUNCTION SISNAN( SIN )
+* 
+*       .. Scalar Arguments ..
+*       REAL               SIN
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SISNAN returns .TRUE. if its argument is NaN, and .FALSE.
+*> otherwise.  To be replaced by the Fortran 2003 intrinsic in the
+*> future.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIN
+*> \verbatim
+*>          SIN is REAL
+*>          Input to test for NaN.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      LOGICAL FUNCTION SISNAN( SIN )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      REAL               SIN
+*     ..
+*
+*  =====================================================================
+*
+*  .. External Functions ..
+      LOGICAL SLAISNAN
+      EXTERNAL SLAISNAN
+*  ..
+*  .. Executable Statements ..
+      SISNAN = SLAISNAN(SIN,SIN)
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/slabad.f
===================================================================
--- trunk/SOURCES/BLAS/slabad.f	(revision 22)
+++ trunk/SOURCES/BLAS/slabad.f	(revision 22)
@@ -0,0 +1,105 @@
+*> \brief \b SLABAD
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLABAD + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slabad.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slabad.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slabad.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLABAD( SMALL, LARGE )
+* 
+*       .. Scalar Arguments ..
+*       REAL               LARGE, SMALL
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLABAD takes as input the values computed by SLAMCH for underflow and
+*> overflow, and returns the square root of each of these values if the
+*> log of LARGE is sufficiently large.  This subroutine is intended to
+*> identify machines with a large exponent range, such as the Crays, and
+*> redefine the underflow and overflow limits to be the square roots of
+*> the values computed by SLAMCH.  This subroutine is needed because
+*> SLAMCH does not compensate for poor arithmetic in the upper half of
+*> the exponent range, as is found on a Cray.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in,out] SMALL
+*> \verbatim
+*>          SMALL is REAL
+*>          On entry, the underflow threshold as computed by SLAMCH.
+*>          On exit, if LOG10(LARGE) is sufficiently large, the square
+*>          root of SMALL, otherwise unchanged.
+*> \endverbatim
+*>
+*> \param[in,out] LARGE
+*> \verbatim
+*>          LARGE is REAL
+*>          On entry, the overflow threshold as computed by SLAMCH.
+*>          On exit, if LOG10(LARGE) is sufficiently large, the square
+*>          root of LARGE, otherwise unchanged.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLABAD( SMALL, LARGE )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      REAL               LARGE, SMALL
+*     ..
+*
+*  =====================================================================
+*
+*     .. Intrinsic Functions ..
+      INTRINSIC          LOG10, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+*     If it looks like we're on a Cray, take the square root of
+*     SMALL and LARGE to avoid overflow and underflow problems.
+*
+      IF( LOG10( LARGE ).GT.2000. ) THEN
+         SMALL = SQRT( SMALL )
+         LARGE = SQRT( LARGE )
+      END IF
+*
+      RETURN
+*
+*     End of SLABAD
+*
+      END
Index: trunk/SOURCES/BLAS/slaic1.f
===================================================================
--- trunk/SOURCES/BLAS/slaic1.f	(revision 22)
+++ trunk/SOURCES/BLAS/slaic1.f	(revision 22)
@@ -0,0 +1,367 @@
+*> \brief \b SLAIC1
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLAIC1 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaic1.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaic1.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaic1.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            J, JOB
+*       REAL               C, GAMMA, S, SEST, SESTPR
+*       ..
+*       .. Array Arguments ..
+*       REAL               W( J ), X( J )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLAIC1 applies one step of incremental condition estimation in
+*> its simplest version:
+*>
+*> Let x, twonorm(x) = 1, be an approximate singular vector of an j-by-j
+*> lower triangular matrix L, such that
+*>          twonorm(L*x) = sest
+*> Then SLAIC1 computes sestpr, s, c such that
+*> the vector
+*>                 [ s*x ]
+*>          xhat = [  c  ]
+*> is an approximate singular vector of
+*>                 [ L      0  ]
+*>          Lhat = [ w**T gamma ]
+*> in the sense that
+*>          twonorm(Lhat*xhat) = sestpr.
+*>
+*> Depending on JOB, an estimate for the largest or smallest singular
+*> value is computed.
+*>
+*> Note that [s c]**T and sestpr**2 is an eigenpair of the system
+*>
+*>     diag(sest*sest, 0) + [alpha  gamma] * [ alpha ]
+*>                                           [ gamma ]
+*>
+*> where  alpha =  x**T*w.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] JOB
+*> \verbatim
+*>          JOB is INTEGER
+*>          = 1: an estimate for the largest singular value is computed.
+*>          = 2: an estimate for the smallest singular value is computed.
+*> \endverbatim
+*>
+*> \param[in] J
+*> \verbatim
+*>          J is INTEGER
+*>          Length of X and W
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array, dimension (J)
+*>          The j-vector x.
+*> \endverbatim
+*>
+*> \param[in] SEST
+*> \verbatim
+*>          SEST is REAL
+*>          Estimated singular value of j by j matrix L
+*> \endverbatim
+*>
+*> \param[in] W
+*> \verbatim
+*>          W is REAL array, dimension (J)
+*>          The j-vector w.
+*> \endverbatim
+*>
+*> \param[in] GAMMA
+*> \verbatim
+*>          GAMMA is REAL
+*>          The diagonal element gamma.
+*> \endverbatim
+*>
+*> \param[out] SESTPR
+*> \verbatim
+*>          SESTPR is REAL
+*>          Estimated singular value of (j+1) by (j+1) matrix Lhat.
+*> \endverbatim
+*>
+*> \param[out] S
+*> \verbatim
+*>          S is REAL
+*>          Sine needed in forming xhat.
+*> \endverbatim
+*>
+*> \param[out] C
+*> \verbatim
+*>          C is REAL
+*>          Cosine needed in forming xhat.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLAIC1( JOB, J, X, SEST, W, GAMMA, SESTPR, S, C )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            J, JOB
+      REAL               C, GAMMA, S, SEST, SESTPR
+*     ..
+*     .. Array Arguments ..
+      REAL               W( J ), X( J )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE, TWO
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0 )
+      REAL               HALF, FOUR
+      PARAMETER          ( HALF = 0.5E0, FOUR = 4.0E0 )
+*     ..
+*     .. Local Scalars ..
+      REAL               ABSALP, ABSEST, ABSGAM, ALPHA, B, COSINE, EPS,
+     $                   NORMA, S1, S2, SINE, T, TEST, TMP, ZETA1, ZETA2
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, SIGN, SQRT
+*     ..
+*     .. External Functions ..
+      REAL               SDOT, SLAMCH
+      EXTERNAL           SDOT, SLAMCH
+*     ..
+*     .. Executable Statements ..
+*
+      EPS = SLAMCH( 'Epsilon' )
+      ALPHA = SDOT( J, X, 1, W, 1 )
+*
+      ABSALP = ABS( ALPHA )
+      ABSGAM = ABS( GAMMA )
+      ABSEST = ABS( SEST )
+*
+      IF( JOB.EQ.1 ) THEN
+*
+*        Estimating largest singular value
+*
+*        special cases
+*
+         IF( SEST.EQ.ZERO ) THEN
+            S1 = MAX( ABSGAM, ABSALP )
+            IF( S1.EQ.ZERO ) THEN
+               S = ZERO
+               C = ONE
+               SESTPR = ZERO
+            ELSE
+               S = ALPHA / S1
+               C = GAMMA / S1
+               TMP = SQRT( S*S+C*C )
+               S = S / TMP
+               C = C / TMP
+               SESTPR = S1*TMP
+            END IF
+            RETURN
+         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
+            S = ONE
+            C = ZERO
+            TMP = MAX( ABSEST, ABSALP )
+            S1 = ABSEST / TMP
+            S2 = ABSALP / TMP
+            SESTPR = TMP*SQRT( S1*S1+S2*S2 )
+            RETURN
+         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
+            S1 = ABSGAM
+            S2 = ABSEST
+            IF( S1.LE.S2 ) THEN
+               S = ONE
+               C = ZERO
+               SESTPR = S2
+            ELSE
+               S = ZERO
+               C = ONE
+               SESTPR = S1
+            END IF
+            RETURN
+         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
+            S1 = ABSGAM
+            S2 = ABSALP
+            IF( S1.LE.S2 ) THEN
+               TMP = S1 / S2
+               S = SQRT( ONE+TMP*TMP )
+               SESTPR = S2*S
+               C = ( GAMMA / S2 ) / S
+               S = SIGN( ONE, ALPHA ) / S
+            ELSE
+               TMP = S2 / S1
+               C = SQRT( ONE+TMP*TMP )
+               SESTPR = S1*C
+               S = ( ALPHA / S1 ) / C
+               C = SIGN( ONE, GAMMA ) / C
+            END IF
+            RETURN
+         ELSE
+*
+*           normal case
+*
+            ZETA1 = ALPHA / ABSEST
+            ZETA2 = GAMMA / ABSEST
+*
+            B = ( ONE-ZETA1*ZETA1-ZETA2*ZETA2 )*HALF
+            C = ZETA1*ZETA1
+            IF( B.GT.ZERO ) THEN
+               T = C / ( B+SQRT( B*B+C ) )
+            ELSE
+               T = SQRT( B*B+C ) - B
+            END IF
+*
+            SINE = -ZETA1 / T
+            COSINE = -ZETA2 / ( ONE+T )
+            TMP = SQRT( SINE*SINE+COSINE*COSINE )
+            S = SINE / TMP
+            C = COSINE / TMP
+            SESTPR = SQRT( T+ONE )*ABSEST
+            RETURN
+         END IF
+*
+      ELSE IF( JOB.EQ.2 ) THEN
+*
+*        Estimating smallest singular value
+*
+*        special cases
+*
+         IF( SEST.EQ.ZERO ) THEN
+            SESTPR = ZERO
+            IF( MAX( ABSGAM, ABSALP ).EQ.ZERO ) THEN
+               SINE = ONE
+               COSINE = ZERO
+            ELSE
+               SINE = -GAMMA
+               COSINE = ALPHA
+            END IF
+            S1 = MAX( ABS( SINE ), ABS( COSINE ) )
+            S = SINE / S1
+            C = COSINE / S1
+            TMP = SQRT( S*S+C*C )
+            S = S / TMP
+            C = C / TMP
+            RETURN
+         ELSE IF( ABSGAM.LE.EPS*ABSEST ) THEN
+            S = ZERO
+            C = ONE
+            SESTPR = ABSGAM
+            RETURN
+         ELSE IF( ABSALP.LE.EPS*ABSEST ) THEN
+            S1 = ABSGAM
+            S2 = ABSEST
+            IF( S1.LE.S2 ) THEN
+               S = ZERO
+               C = ONE
+               SESTPR = S1
+            ELSE
+               S = ONE
+               C = ZERO
+               SESTPR = S2
+            END IF
+            RETURN
+         ELSE IF( ABSEST.LE.EPS*ABSALP .OR. ABSEST.LE.EPS*ABSGAM ) THEN
+            S1 = ABSGAM
+            S2 = ABSALP
+            IF( S1.LE.S2 ) THEN
+               TMP = S1 / S2
+               C = SQRT( ONE+TMP*TMP )
+               SESTPR = ABSEST*( TMP / C )
+               S = -( GAMMA / S2 ) / C
+               C = SIGN( ONE, ALPHA ) / C
+            ELSE
+               TMP = S2 / S1
+               S = SQRT( ONE+TMP*TMP )
+               SESTPR = ABSEST / S
+               C = ( ALPHA / S1 ) / S
+               S = -SIGN( ONE, GAMMA ) / S
+            END IF
+            RETURN
+         ELSE
+*
+*           normal case
+*
+            ZETA1 = ALPHA / ABSEST
+            ZETA2 = GAMMA / ABSEST
+*
+            NORMA = MAX( ONE+ZETA1*ZETA1+ABS( ZETA1*ZETA2 ),
+     $              ABS( ZETA1*ZETA2 )+ZETA2*ZETA2 )
+*
+*           See if root is closer to zero or to ONE
+*
+            TEST = ONE + TWO*( ZETA1-ZETA2 )*( ZETA1+ZETA2 )
+            IF( TEST.GE.ZERO ) THEN
+*
+*              root is close to zero, compute directly
+*
+               B = ( ZETA1*ZETA1+ZETA2*ZETA2+ONE )*HALF
+               C = ZETA2*ZETA2
+               T = C / ( B+SQRT( ABS( B*B-C ) ) )
+               SINE = ZETA1 / ( ONE-T )
+               COSINE = -ZETA2 / T
+               SESTPR = SQRT( T+FOUR*EPS*EPS*NORMA )*ABSEST
+            ELSE
+*
+*              root is closer to ONE, shift by that amount
+*
+               B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
+               C = ZETA1*ZETA1
+               IF( B.GE.ZERO ) THEN
+                  T = -C / ( B+SQRT( B*B+C ) )
+               ELSE
+                  T = B - SQRT( B*B+C )
+               END IF
+               SINE = -ZETA1 / T
+               COSINE = -ZETA2 / ( ONE+T )
+               SESTPR = SQRT( ONE+T+FOUR*EPS*EPS*NORMA )*ABSEST
+            END IF
+            TMP = SQRT( SINE*SINE+COSINE*COSINE )
+            S = SINE / TMP
+            C = COSINE / TMP
+            RETURN
+*
+         END IF
+      END IF
+      RETURN
+*
+*     End of SLAIC1
+*
+      END
Index: trunk/SOURCES/BLAS/slaisnan.f
===================================================================
--- trunk/SOURCES/BLAS/slaisnan.f	(revision 22)
+++ trunk/SOURCES/BLAS/slaisnan.f	(revision 22)
@@ -0,0 +1,91 @@
+*> \brief \b SLAISNAN
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLAISNAN + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaisnan.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaisnan.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaisnan.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
+* 
+*       .. Scalar Arguments ..
+*       REAL               SIN1, SIN2
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> This routine is not for general use.  It exists solely to avoid
+*> over-optimization in SISNAN.
+*>
+*> SLAISNAN checks for NaNs by comparing its two arguments for
+*> inequality.  NaN is the only floating-point value where NaN != NaN
+*> returns .TRUE.  To check for NaNs, pass the same variable as both
+*> arguments.
+*>
+*> A compiler must assume that the two arguments are
+*> not the same variable, and the test will not be optimized away.
+*> Interprocedural or whole-program optimization may delete this
+*> test.  The ISNAN functions will be replaced by the correct
+*> Fortran 03 intrinsic once the intrinsic is widely available.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIN1
+*> \verbatim
+*>          SIN1 is REAL
+*> \endverbatim
+*>
+*> \param[in] SIN2
+*> \verbatim
+*>          SIN2 is REAL
+*>          Two numbers to compare for inequality.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      LOGICAL FUNCTION SLAISNAN( SIN1, SIN2 )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      REAL               SIN1, SIN2
+*     ..
+*
+*  =====================================================================
+*
+*  .. Executable Statements ..
+      SLAISNAN = (SIN1.NE.SIN2)
+      RETURN
+      END
Index: trunk/SOURCES/BLAS/slamch.f
===================================================================
--- trunk/SOURCES/BLAS/slamch.f	(revision 22)
+++ trunk/SOURCES/BLAS/slamch.f	(revision 22)
@@ -0,0 +1,192 @@
+*> \brief \b SLAMCH
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*  Definition:
+*  ===========
+*
+*      REAL             FUNCTION SLAMCH( CMACH )
+*
+*     .. Scalar Arguments ..
+*      CHARACTER          CMACH
+*     ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLAMCH determines single precision machine parameters.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] CMACH
+*> \verbatim
+*>          Specifies the value to be returned by SLAMCH:
+*>          = 'E' or 'e',   SLAMCH := eps
+*>          = 'S' or 's ,   SLAMCH := sfmin
+*>          = 'B' or 'b',   SLAMCH := base
+*>          = 'P' or 'p',   SLAMCH := eps*base
+*>          = 'N' or 'n',   SLAMCH := t
+*>          = 'R' or 'r',   SLAMCH := rnd
+*>          = 'M' or 'm',   SLAMCH := emin
+*>          = 'U' or 'u',   SLAMCH := rmin
+*>          = 'L' or 'l',   SLAMCH := emax
+*>          = 'O' or 'o',   SLAMCH := rmax
+*>          where
+*>          eps   = relative machine precision
+*>          sfmin = safe minimum, such that 1/sfmin does not overflow
+*>          base  = base of the machine
+*>          prec  = eps*base
+*>          t     = number of (base) digits in the mantissa
+*>          rnd   = 1.0 when rounding occurs in addition, 0.0 otherwise
+*>          emin  = minimum exponent before (gradual) underflow
+*>          rmin  = underflow threshold - base**(emin-1)
+*>          emax  = largest exponent before overflow
+*>          rmax  = overflow threshold  - (base**emax)*(1-eps)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      REAL             FUNCTION SLAMCH( CMACH )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          CMACH
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      REAL               RND, EPS, SFMIN, SMALL, RMACH
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DIGITS, EPSILON, HUGE, MAXEXPONENT,
+     $                   MINEXPONENT, RADIX, TINY
+*     ..
+*     .. Executable Statements ..
+*
+*
+*     Assume rounding, not chopping. Always.
+*
+      RND = ONE
+*
+      IF( ONE.EQ.RND ) THEN
+         EPS = EPSILON(ZERO) * 0.5
+      ELSE
+         EPS = EPSILON(ZERO)
+      END IF
+*
+      IF( LSAME( CMACH, 'E' ) ) THEN
+         RMACH = EPS
+      ELSE IF( LSAME( CMACH, 'S' ) ) THEN
+         SFMIN = TINY(ZERO)
+         SMALL = ONE / HUGE(ZERO)
+         IF( SMALL.GE.SFMIN ) THEN
+*
+*           Use SMALL plus a bit, to avoid the possibility of rounding
+*           causing overflow when computing  1/sfmin.
+*
+            SFMIN = SMALL*( ONE+EPS )
+         END IF
+         RMACH = SFMIN
+      ELSE IF( LSAME( CMACH, 'B' ) ) THEN
+         RMACH = RADIX(ZERO)
+      ELSE IF( LSAME( CMACH, 'P' ) ) THEN
+         RMACH = EPS * RADIX(ZERO)
+      ELSE IF( LSAME( CMACH, 'N' ) ) THEN
+         RMACH = DIGITS(ZERO)
+      ELSE IF( LSAME( CMACH, 'R' ) ) THEN
+         RMACH = RND
+      ELSE IF( LSAME( CMACH, 'M' ) ) THEN
+         RMACH = MINEXPONENT(ZERO)
+      ELSE IF( LSAME( CMACH, 'U' ) ) THEN
+         RMACH = tiny(zero)
+      ELSE IF( LSAME( CMACH, 'L' ) ) THEN
+         RMACH = MAXEXPONENT(ZERO)
+      ELSE IF( LSAME( CMACH, 'O' ) ) THEN
+         RMACH = HUGE(ZERO)
+      ELSE
+         RMACH = ZERO
+      END IF
+*
+      SLAMCH = RMACH
+      RETURN
+*
+*     End of SLAMCH
+*
+      END
+************************************************************************
+*> \brief \b SLAMC3
+*> \details
+*> \b Purpose:
+*> \verbatim
+*> SLAMC3  is intended to force  A  and  B  to be stored prior to doing
+*> the addition of  A  and  B ,  for use in situations where optimizers
+*> might hold one of these in a register.
+*> \endverbatim
+*> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
+*> \date November 2011
+*> \ingroup auxOTHERauxiliary
+*>
+*> \param[in] A
+*> \verbatim
+*> \endverbatim
+*>
+*> \param[in] B
+*> \verbatim
+*>          The values A and B.
+*> \endverbatim
+*>
+*
+      REAL             FUNCTION SLAMC3( A, B )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
+*     November 2010
+*
+*     .. Scalar Arguments ..
+      REAL               A, B
+*     ..
+* =====================================================================
+*
+*     .. Executable Statements ..
+*
+      SLAMC3 = A + B
+*
+      RETURN
+*
+*     End of SLAMC3
+*
+      END
+*
+************************************************************************
Index: trunk/SOURCES/BLAS/slange.f
===================================================================
--- trunk/SOURCES/BLAS/slange.f	(revision 22)
+++ trunk/SOURCES/BLAS/slange.f	(revision 22)
@@ -0,0 +1,209 @@
+*> \brief \b SLANGE
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLANGE + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slange.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slange.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slange.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       REAL             FUNCTION SLANGE( NORM, M, N, A, LDA, WORK )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          NORM
+*       INTEGER            LDA, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLANGE  returns the value of the one norm,  or the Frobenius norm, or
+*> the  infinity norm,  or the  element of  largest absolute value  of a
+*> real matrix A.
+*> \endverbatim
+*>
+*> \return SLANGE
+*> \verbatim
+*>
+*>    SLANGE = ( max(abs(A(i,j))), NORM = 'M' or 'm'
+*>             (
+*>             ( norm1(A),         NORM = '1', 'O' or 'o'
+*>             (
+*>             ( normI(A),         NORM = 'I' or 'i'
+*>             (
+*>             ( normF(A),         NORM = 'F', 'f', 'E' or 'e'
+*>
+*> where  norm1  denotes the  one norm of a matrix (maximum column sum),
+*> normI  denotes the  infinity norm  of a matrix  (maximum row sum) and
+*> normF  denotes the  Frobenius norm of a matrix (square root of sum of
+*> squares).  Note that  max(abs(A(i,j)))  is not a consistent matrix norm.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] NORM
+*> \verbatim
+*>          NORM is CHARACTER*1
+*>          Specifies the value to be returned in SLANGE as described
+*>          above.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.  When M = 0,
+*>          SLANGE is set to zero.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.  When N = 0,
+*>          SLANGE is set to zero.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          The m by n matrix A.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(M,1).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK)),
+*>          where LWORK >= M when NORM = 'I'; otherwise, WORK is not
+*>          referenced.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realGEauxiliary
+*
+*  =====================================================================
+      REAL             FUNCTION SLANGE( NORM, M, N, A, LDA, WORK )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          NORM
+      INTEGER            LDA, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J
+      REAL               SCALE, SUM, VALUE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLASSQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+      IF( MIN( M, N ).EQ.0 ) THEN
+         VALUE = ZERO
+      ELSE IF( LSAME( NORM, 'M' ) ) THEN
+*
+*        Find max(abs(A(i,j))).
+*
+         VALUE = ZERO
+         DO 20 J = 1, N
+            DO 10 I = 1, M
+               VALUE = MAX( VALUE, ABS( A( I, J ) ) )
+   10       CONTINUE
+   20    CONTINUE
+      ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN
+*
+*        Find norm1(A).
+*
+         VALUE = ZERO
+         DO 40 J = 1, N
+            SUM = ZERO
+            DO 30 I = 1, M
+               SUM = SUM + ABS( A( I, J ) )
+   30       CONTINUE
+            VALUE = MAX( VALUE, SUM )
+   40    CONTINUE
+      ELSE IF( LSAME( NORM, 'I' ) ) THEN
+*
+*        Find normI(A).
+*
+         DO 50 I = 1, M
+            WORK( I ) = ZERO
+   50    CONTINUE
+         DO 70 J = 1, N
+            DO 60 I = 1, M
+               WORK( I ) = WORK( I ) + ABS( A( I, J ) )
+   60       CONTINUE
+   70    CONTINUE
+         VALUE = ZERO
+         DO 80 I = 1, M
+            VALUE = MAX( VALUE, WORK( I ) )
+   80    CONTINUE
+      ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN
+*
+*        Find normF(A).
+*
+         SCALE = ZERO
+         SUM = ONE
+         DO 90 J = 1, N
+            CALL SLASSQ( M, A( 1, J ), 1, SCALE, SUM )
+   90    CONTINUE
+         VALUE = SCALE*SQRT( SUM )
+      END IF
+*
+      SLANGE = VALUE
+      RETURN
+*
+*     End of SLANGE
+*
+      END
Index: trunk/SOURCES/BLAS/slapy2.f
===================================================================
--- trunk/SOURCES/BLAS/slapy2.f	(revision 22)
+++ trunk/SOURCES/BLAS/slapy2.f	(revision 22)
@@ -0,0 +1,104 @@
+*> \brief \b SLAPY2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLAPY2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       REAL             FUNCTION SLAPY2( X, Y )
+* 
+*       .. Scalar Arguments ..
+*       REAL               X, Y
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
+*> overflow.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] X
+*> \verbatim
+*>          X is REAL
+*> \endverbatim
+*>
+*> \param[in] Y
+*> \verbatim
+*>          Y is REAL
+*>          X and Y specify the values x and y.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      REAL             FUNCTION SLAPY2( X, Y )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      REAL               X, Y
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E0 )
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      REAL               W, XABS, YABS, Z
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. Executable Statements ..
+*
+      XABS = ABS( X )
+      YABS = ABS( Y )
+      W = MAX( XABS, YABS )
+      Z = MIN( XABS, YABS )
+      IF( Z.EQ.ZERO ) THEN
+         SLAPY2 = W
+      ELSE
+         SLAPY2 = W*SQRT( ONE+( Z / W )**2 )
+      END IF
+      RETURN
+*
+*     End of SLAPY2
+*
+      END
Index: trunk/SOURCES/BLAS/slaqp2.f
===================================================================
--- trunk/SOURCES/BLAS/slaqp2.f	(revision 22)
+++ trunk/SOURCES/BLAS/slaqp2.f	(revision 22)
@@ -0,0 +1,262 @@
+*> \brief \b SLAQP2
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLAQP2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqp2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqp2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqp2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
+*                          WORK )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            LDA, M, N, OFFSET
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            JPVT( * )
+*       REAL               A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+*      $                   WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLAQP2 computes a QR factorization with column pivoting of
+*> the block A(OFFSET+1:M,1:N).
+*> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] OFFSET
+*> \verbatim
+*>          OFFSET is INTEGER
+*>          The number of rows of the matrix A that must be pivoted
+*>          but no factorized. OFFSET >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the upper triangle of block A(OFFSET+1:M,1:N) is 
+*>          the triangular factor obtained; the elements in block 
+*>          A(OFFSET+1:M,1:N) below the diagonal, together with the 
+*>          array TAU, represent the orthogonal matrix Q as a product of
+*>          elementary reflectors. Block A(1:OFFSET,1:N) has been
+*>          accordingly pivoted, but no factorized.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] JPVT
+*> \verbatim
+*>          JPVT is INTEGER array, dimension (N)
+*>          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
+*>          to the front of A*P (a leading column); if JPVT(i) = 0,
+*>          the i-th column of A is a free column.
+*>          On exit, if JPVT(i) = k, then the i-th column of A*P
+*>          was the k-th column of A.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (min(M,N))
+*>          The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*>          VN1 is REAL array, dimension (N)
+*>          The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*>          VN2 is REAL array, dimension (N)
+*>          The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (N)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+*>    X. Sun, Computer Science Dept., Duke University, USA
+*> \n
+*>  Partial column norm updating strategy modified on April 2011
+*>    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+*>    University of Zagreb, Croatia.
+*
+*> \par References:
+*  ================
+*>
+*> LAPACK Working Note 176
+*
+*> \htmlonly
+*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a> 
+*> \endhtmlonly 
+*
+*  =====================================================================
+      SUBROUTINE SLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2,
+     $                   WORK )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            LDA, M, N, OFFSET
+*     ..
+*     .. Array Arguments ..
+      INTEGER            JPVT( * )
+      REAL               A( LDA, * ), TAU( * ), VN1( * ), VN2( * ),
+     $                   WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, ITEMP, J, MN, OFFPI, PVT
+      REAL               AII, TEMP, TEMP2, TOL3Z
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARF, SLARFG, SSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, SQRT
+*     ..
+*     .. External Functions ..
+      INTEGER            ISAMAX
+      REAL               SLAMCH, SNRM2
+      EXTERNAL           ISAMAX, SLAMCH, SNRM2
+*     ..
+*     .. Executable Statements ..
+*
+      MN = MIN( M-OFFSET, N )
+      TOL3Z = SQRT(SLAMCH('Epsilon'))
+*
+*     Compute factorization.
+*
+      DO 20 I = 1, MN
+*
+         OFFPI = OFFSET + I
+*
+*        Determine ith pivot column and swap if necessary.
+*
+         PVT = ( I-1 ) + ISAMAX( N-I+1, VN1( I ), 1 )
+*
+         IF( PVT.NE.I ) THEN
+            CALL SSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 )
+            ITEMP = JPVT( PVT )
+            JPVT( PVT ) = JPVT( I )
+            JPVT( I ) = ITEMP
+            VN1( PVT ) = VN1( I )
+            VN2( PVT ) = VN2( I )
+         END IF
+*
+*        Generate elementary reflector H(i).
+*
+         IF( OFFPI.LT.M ) THEN
+            CALL SLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1,
+     $                   TAU( I ) )
+         ELSE
+            CALL SLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) )
+         END IF
+*
+         IF( I.LT.N ) THEN
+*
+*           Apply H(i)**T to A(offset+i:m,i+1:n) from the left.
+*
+            AII = A( OFFPI, I )
+            A( OFFPI, I ) = ONE
+            CALL SLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1,
+     $                  TAU( I ), A( OFFPI, I+1 ), LDA, WORK( 1 ) )
+            A( OFFPI, I ) = AII
+         END IF
+*
+*        Update partial column norms.
+*
+         DO 10 J = I + 1, N
+            IF( VN1( J ).NE.ZERO ) THEN
+*
+*              NOTE: The following 4 lines follow from the analysis in
+*              Lapack Working Note 176.
+*
+               TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2
+               TEMP = MAX( TEMP, ZERO )
+               TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+               IF( TEMP2 .LE. TOL3Z ) THEN
+                  IF( OFFPI.LT.M ) THEN
+                     VN1( J ) = SNRM2( M-OFFPI, A( OFFPI+1, J ), 1 )
+                     VN2( J ) = VN1( J )
+                  ELSE
+                     VN1( J ) = ZERO
+                     VN2( J ) = ZERO
+                  END IF
+               ELSE
+                  VN1( J ) = VN1( J )*SQRT( TEMP )
+               END IF
+            END IF
+   10    CONTINUE
+*
+   20 CONTINUE
+*
+      RETURN
+*
+*     End of SLAQP2
+*
+      END
Index: trunk/SOURCES/BLAS/slaqps.f
===================================================================
--- trunk/SOURCES/BLAS/slaqps.f	(revision 22)
+++ trunk/SOURCES/BLAS/slaqps.f	(revision 22)
@@ -0,0 +1,359 @@
+*> \brief \b SLAQPS
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLAQPS + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaqps.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaqps.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaqps.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
+*                          VN2, AUXV, F, LDF )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            KB, LDA, LDF, M, N, NB, OFFSET
+*       ..
+*       .. Array Arguments ..
+*       INTEGER            JPVT( * )
+*       REAL               A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+*      $                   VN1( * ), VN2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLAQPS computes a step of QR factorization with column pivoting
+*> of a real M-by-N matrix A by using Blas-3.  It tries to factorize
+*> NB columns from A starting from the row OFFSET+1, and updates all
+*> of the matrix with Blas-3 xGEMM.
+*>
+*> In some cases, due to catastrophic cancellations, it cannot
+*> factorize NB columns.  Hence, the actual number of factorized
+*> columns is returned in KB.
+*>
+*> Block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A. N >= 0
+*> \endverbatim
+*>
+*> \param[in] OFFSET
+*> \verbatim
+*>          OFFSET is INTEGER
+*>          The number of rows of A that have been factorized in
+*>          previous steps.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The number of columns to factorize.
+*> \endverbatim
+*>
+*> \param[out] KB
+*> \verbatim
+*>          KB is INTEGER
+*>          The number of columns actually factorized.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, block A(OFFSET+1:M,1:KB) is the triangular
+*>          factor obtained and block A(1:OFFSET,1:N) has been
+*>          accordingly pivoted, but no factorized.
+*>          The rest of the matrix, block A(OFFSET+1:M,KB+1:N) has
+*>          been updated.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] JPVT
+*> \verbatim
+*>          JPVT is INTEGER array, dimension (N)
+*>          JPVT(I) = K <==> Column K of the full matrix A has been
+*>          permuted into position I in AP.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (KB)
+*>          The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in,out] VN1
+*> \verbatim
+*>          VN1 is REAL array, dimension (N)
+*>          The vector with the partial column norms.
+*> \endverbatim
+*>
+*> \param[in,out] VN2
+*> \verbatim
+*>          VN2 is REAL array, dimension (N)
+*>          The vector with the exact column norms.
+*> \endverbatim
+*>
+*> \param[in,out] AUXV
+*> \verbatim
+*>          AUXV is REAL array, dimension (NB)
+*>          Auxiliar vector.
+*> \endverbatim
+*>
+*> \param[in,out] F
+*> \verbatim
+*>          F is REAL array, dimension (LDF,NB)
+*>          Matrix F**T = L*Y**T*A.
+*> \endverbatim
+*>
+*> \param[in] LDF
+*> \verbatim
+*>          LDF is INTEGER
+*>          The leading dimension of the array F. LDF >= max(1,N).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain
+*>    X. Sun, Computer Science Dept., Duke University, USA
+*>
+*> \n
+*>  Partial column norm updating strategy modified on April 2011
+*>    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
+*>    University of Zagreb, Croatia.
+*
+*> \par References:
+*  ================
+*>
+*> LAPACK Working Note 176
+*
+*> \htmlonly
+*> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a> 
+*> \endhtmlonly 
+*
+*  =====================================================================
+      SUBROUTINE SLAQPS( M, N, OFFSET, NB, KB, A, LDA, JPVT, TAU, VN1,
+     $                   VN2, AUXV, F, LDF )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            KB, LDA, LDF, M, N, NB, OFFSET
+*     ..
+*     .. Array Arguments ..
+      INTEGER            JPVT( * )
+      REAL               A( LDA, * ), AUXV( * ), F( LDF, * ), TAU( * ),
+     $                   VN1( * ), VN2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            ITEMP, J, K, LASTRK, LSTICC, PVT, RK
+      REAL               AKK, TEMP, TEMP2, TOL3Z
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMM, SGEMV, SLARFG, SSWAP
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN, NINT, REAL, SQRT
+*     ..
+*     .. External Functions ..
+      INTEGER            ISAMAX
+      REAL               SLAMCH, SNRM2
+      EXTERNAL           ISAMAX, SLAMCH, SNRM2
+*     ..
+*     .. Executable Statements ..
+*
+      LASTRK = MIN( M, N+OFFSET )
+      LSTICC = 0
+      K = 0
+      TOL3Z = SQRT(SLAMCH('Epsilon'))
+*
+*     Beginning of while loop.
+*
+   10 CONTINUE
+      IF( ( K.LT.NB ) .AND. ( LSTICC.EQ.0 ) ) THEN
+         K = K + 1
+         RK = OFFSET + K
+*
+*        Determine ith pivot column and swap if necessary
+*
+         PVT = ( K-1 ) + ISAMAX( N-K+1, VN1( K ), 1 )
+         IF( PVT.NE.K ) THEN
+            CALL SSWAP( M, A( 1, PVT ), 1, A( 1, K ), 1 )
+            CALL SSWAP( K-1, F( PVT, 1 ), LDF, F( K, 1 ), LDF )
+            ITEMP = JPVT( PVT )
+            JPVT( PVT ) = JPVT( K )
+            JPVT( K ) = ITEMP
+            VN1( PVT ) = VN1( K )
+            VN2( PVT ) = VN2( K )
+         END IF
+*
+*        Apply previous Householder reflectors to column K:
+*        A(RK:M,K) := A(RK:M,K) - A(RK:M,1:K-1)*F(K,1:K-1)**T.
+*
+         IF( K.GT.1 ) THEN
+            CALL SGEMV( 'No transpose', M-RK+1, K-1, -ONE, A( RK, 1 ),
+     $                  LDA, F( K, 1 ), LDF, ONE, A( RK, K ), 1 )
+         END IF
+*
+*        Generate elementary reflector H(k).
+*
+         IF( RK.LT.M ) THEN
+            CALL SLARFG( M-RK+1, A( RK, K ), A( RK+1, K ), 1, TAU( K ) )
+         ELSE
+            CALL SLARFG( 1, A( RK, K ), A( RK, K ), 1, TAU( K ) )
+         END IF
+*
+         AKK = A( RK, K )
+         A( RK, K ) = ONE
+*
+*        Compute Kth column of F:
+*
+*        Compute  F(K+1:N,K) := tau(K)*A(RK:M,K+1:N)**T*A(RK:M,K).
+*
+         IF( K.LT.N ) THEN
+            CALL SGEMV( 'Transpose', M-RK+1, N-K, TAU( K ),
+     $                  A( RK, K+1 ), LDA, A( RK, K ), 1, ZERO,
+     $                  F( K+1, K ), 1 )
+         END IF
+*
+*        Padding F(1:K,K) with zeros.
+*
+         DO 20 J = 1, K
+            F( J, K ) = ZERO
+   20    CONTINUE
+*
+*        Incremental updating of F:
+*        F(1:N,K) := F(1:N,K) - tau(K)*F(1:N,1:K-1)*A(RK:M,1:K-1)**T
+*                    *A(RK:M,K).
+*
+         IF( K.GT.1 ) THEN
+            CALL SGEMV( 'Transpose', M-RK+1, K-1, -TAU( K ), A( RK, 1 ),
+     $                  LDA, A( RK, K ), 1, ZERO, AUXV( 1 ), 1 )
+*
+            CALL SGEMV( 'No transpose', N, K-1, ONE, F( 1, 1 ), LDF,
+     $                  AUXV( 1 ), 1, ONE, F( 1, K ), 1 )
+         END IF
+*
+*        Update the current row of A:
+*        A(RK,K+1:N) := A(RK,K+1:N) - A(RK,1:K)*F(K+1:N,1:K)**T.
+*
+         IF( K.LT.N ) THEN
+            CALL SGEMV( 'No transpose', N-K, K, -ONE, F( K+1, 1 ), LDF,
+     $                  A( RK, 1 ), LDA, ONE, A( RK, K+1 ), LDA )
+         END IF
+*
+*        Update partial column norms.
+*
+         IF( RK.LT.LASTRK ) THEN
+            DO 30 J = K + 1, N
+               IF( VN1( J ).NE.ZERO ) THEN
+*
+*                 NOTE: The following 4 lines follow from the analysis in
+*                 Lapack Working Note 176.
+*
+                  TEMP = ABS( A( RK, J ) ) / VN1( J )
+                  TEMP = MAX( ZERO, ( ONE+TEMP )*( ONE-TEMP ) )
+                  TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2
+                  IF( TEMP2 .LE. TOL3Z ) THEN
+                     VN2( J ) = REAL( LSTICC )
+                     LSTICC = J
+                  ELSE
+                     VN1( J ) = VN1( J )*SQRT( TEMP )
+                  END IF
+               END IF
+   30       CONTINUE
+         END IF
+*
+         A( RK, K ) = AKK
+*
+*        End of while loop.
+*
+         GO TO 10
+      END IF
+      KB = K
+      RK = OFFSET + KB
+*
+*     Apply the block reflector to the rest of the matrix:
+*     A(OFFSET+KB+1:M,KB+1:N) := A(OFFSET+KB+1:M,KB+1:N) -
+*                         A(OFFSET+KB+1:M,1:KB)*F(KB+1:N,1:KB)**T.
+*
+      IF( KB.LT.MIN( N, M-OFFSET ) ) THEN
+         CALL SGEMM( 'No transpose', 'Transpose', M-RK, N-KB, KB, -ONE,
+     $               A( RK+1, 1 ), LDA, F( KB+1, 1 ), LDF, ONE,
+     $               A( RK+1, KB+1 ), LDA )
+      END IF
+*
+*     Recomputation of difficult columns.
+*
+   40 CONTINUE
+      IF( LSTICC.GT.0 ) THEN
+         ITEMP = NINT( VN2( LSTICC ) )
+         VN1( LSTICC ) = SNRM2( M-RK, A( RK+1, LSTICC ), 1 )
+*
+*        NOTE: The computation of VN1( LSTICC ) relies on the fact that 
+*        SNRM2 does not fail on vectors with norm below the value of
+*        SQRT(DLAMCH('S')) 
+*
+         VN2( LSTICC ) = VN1( LSTICC )
+         LSTICC = ITEMP
+         GO TO 40
+      END IF
+*
+      RETURN
+*
+*     End of SLAQPS
+*
+      END
Index: trunk/SOURCES/BLAS/slarf.f
===================================================================
--- trunk/SOURCES/BLAS/slarf.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarf.f	(revision 22)
@@ -0,0 +1,227 @@
+*> \brief \b SLARF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARF + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarf.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarf.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarf.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE
+*       INTEGER            INCV, LDC, M, N
+*       REAL               TAU
+*       ..
+*       .. Array Arguments ..
+*       REAL               C( LDC, * ), V( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARF applies a real elementary reflector H to a real m by n matrix
+*> C, from either the left or the right. H is represented in the form
+*>
+*>       H = I - tau * v * v**T
+*>
+*> where tau is a real scalar and v is a real vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': form  H * C
+*>          = 'R': form  C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension
+*>                     (1 + (M-1)*abs(INCV)) if SIDE = 'L'
+*>                  or (1 + (N-1)*abs(INCV)) if SIDE = 'R'
+*>          The vector v in the representation of H. V is not used if
+*>          TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL
+*>          The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the m by n matrix C.
+*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*>          or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension
+*>                         (N) if SIDE = 'L'
+*>                      or (M) if SIDE = 'R'
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLARF( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE
+      INTEGER            INCV, LDC, M, N
+      REAL               TAU
+*     ..
+*     .. Array Arguments ..
+      REAL               C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            APPLYLEFT
+      INTEGER            I, LASTV, LASTC
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMV, SGER
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILASLR, ILASLC
+      EXTERNAL           LSAME, ILASLR, ILASLC
+*     ..
+*     .. Executable Statements ..
+*
+      APPLYLEFT = LSAME( SIDE, 'L' )
+      LASTV = 0
+      LASTC = 0
+      IF( TAU.NE.ZERO ) THEN
+!     Set up variables for scanning V.  LASTV begins pointing to the end
+!     of V.
+         IF( APPLYLEFT ) THEN
+            LASTV = M
+         ELSE
+            LASTV = N
+         END IF
+         IF( INCV.GT.0 ) THEN
+            I = 1 + (LASTV-1) * INCV
+         ELSE
+            I = 1
+         END IF
+!     Look for the last non-zero row in V.
+         DO WHILE( LASTV.GT.0 .AND. V( I ).EQ.ZERO )
+            LASTV = LASTV - 1
+            I = I - INCV
+         END DO
+         IF( APPLYLEFT ) THEN
+!     Scan for the last non-zero column in C(1:lastv,:).
+            LASTC = ILASLC(LASTV, N, C, LDC)
+         ELSE
+!     Scan for the last non-zero row in C(:,1:lastv).
+            LASTC = ILASLR(M, LASTV, C, LDC)
+         END IF
+      END IF
+!     Note that lastc.eq.0 renders the BLAS operations null; no special
+!     case is needed at this level.
+      IF( APPLYLEFT ) THEN
+*
+*        Form  H * C
+*
+         IF( LASTV.GT.0 ) THEN
+*
+*           w(1:lastc,1) := C(1:lastv,1:lastc)**T * v(1:lastv,1)
+*
+            CALL SGEMV( 'Transpose', LASTV, LASTC, ONE, C, LDC, V, INCV,
+     $           ZERO, WORK, 1 )
+*
+*           C(1:lastv,1:lastc) := C(...) - v(1:lastv,1) * w(1:lastc,1)**T
+*
+            CALL SGER( LASTV, LASTC, -TAU, V, INCV, WORK, 1, C, LDC )
+         END IF
+      ELSE
+*
+*        Form  C * H
+*
+         IF( LASTV.GT.0 ) THEN
+*
+*           w(1:lastc,1) := C(1:lastc,1:lastv) * v(1:lastv,1)
+*
+            CALL SGEMV( 'No transpose', LASTC, LASTV, ONE, C, LDC,
+     $           V, INCV, ZERO, WORK, 1 )
+*
+*           C(1:lastc,1:lastv) := C(...) - w(1:lastc,1) * v(1:lastv,1)**T
+*
+            CALL SGER( LASTC, LASTV, -TAU, WORK, 1, V, INCV, C, LDC )
+         END IF
+      END IF
+      RETURN
+*
+*     End of SLARF
+*
+      END
Index: trunk/SOURCES/BLAS/slarfb.f
===================================================================
--- trunk/SOURCES/BLAS/slarfb.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarfb.f	(revision 22)
@@ -0,0 +1,763 @@
+*> \brief \b SLARFB
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARFB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfb.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfb.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfb.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+*                          T, LDT, C, LDC, WORK, LDWORK )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          DIRECT, SIDE, STOREV, TRANS
+*       INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               C( LDC, * ), T( LDT, * ), V( LDV, * ),
+*      $                   WORK( LDWORK, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARFB applies a real block reflector H or its transpose H**T to a
+*> real m by n matrix C, from either the left or the right.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply H or H**T from the Left
+*>          = 'R': apply H or H**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': apply H (No transpose)
+*>          = 'T': apply H**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*>          DIRECT is CHARACTER*1
+*>          Indicates how H is formed from a product of elementary
+*>          reflectors
+*>          = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*>          STOREV is CHARACTER*1
+*>          Indicates how the vectors which define the elementary
+*>          reflectors are stored:
+*>          = 'C': Columnwise
+*>          = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The order of the matrix T (= the number of elementary
+*>          reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension
+*>                                (LDV,K) if STOREV = 'C'
+*>                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
+*>                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
+*>          The matrix V. See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
+*>          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
+*>          if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The triangular k by k matrix T in the representation of the
+*>          block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the m by n matrix C.
+*>          On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*>          LDWORK is INTEGER
+*>          The leading dimension of the array WORK.
+*>          If SIDE = 'L', LDWORK >= max(1,N);
+*>          if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The shape of the matrix V and the storage of the vectors which define
+*>  the H(i) is best illustrated by the following example with n = 5 and
+*>  k = 3. The elements equal to 1 are not stored; the corresponding
+*>  array elements are modified but restored on exit. The rest of the
+*>  array is not used.
+*>
+*>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
+*>
+*>               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
+*>                   ( v1  1    )                     (     1 v2 v2 v2 )
+*>                   ( v1 v2  1 )                     (        1 v3 v3 )
+*>                   ( v1 v2 v3 )
+*>                   ( v1 v2 v3 )
+*>
+*>  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
+*>
+*>               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
+*>                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
+*>                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
+*>                   (     1 v3 )
+*>                   (        1 )
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
+     $                   T, LDT, C, LDC, WORK, LDWORK )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          DIRECT, SIDE, STOREV, TRANS
+      INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               C( LDC, * ), T( LDT, * ), V( LDV, * ),
+     $                   WORK( LDWORK, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      CHARACTER          TRANST
+      INTEGER            I, J, LASTV, LASTC
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILASLR, ILASLC
+      EXTERNAL           LSAME, ILASLR, ILASLC
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SGEMM, STRMM
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick return if possible
+*
+      IF( M.LE.0 .OR. N.LE.0 )
+     $   RETURN
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+         TRANST = 'T'
+      ELSE
+         TRANST = 'N'
+      END IF
+*
+      IF( LSAME( STOREV, 'C' ) ) THEN
+*
+         IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+*           Let  V =  ( V1 )    (first K rows)
+*                     ( V2 )
+*           where  V1  is unit lower triangular.
+*
+            IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*              Form  H * C  or  H**T * C  where  C = ( C1 )
+*                                                    ( C2 )
+*
+               LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
+               LASTC = ILASLC( LASTV, N, C, LDC )
+*
+*              W := C**T * V  =  (C1**T * V1 + C2**T * V2)  (stored in WORK)
+*
+*              W := C1**T
+*
+               DO 10 J = 1, K
+                  CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+   10          CONTINUE
+*
+*              W := W * V1
+*
+               CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C2**T *V2
+*
+                  CALL SGEMM( 'Transpose', 'No transpose',
+     $                 LASTC, K, LASTV-K,
+     $                 ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T**T  or  W * T
+*
+               CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - V * W**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C2 := C2 - V2 * W**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTV-K, LASTC, K,
+     $                 -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
+     $                 C( K+1, 1 ), LDC )
+               END IF
+*
+*              W := W * V1**T
+*
+               CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+*              C1 := C1 - W**T
+*
+               DO 30 J = 1, K
+                  DO 20 I = 1, LASTC
+                     C( J, I ) = C( J, I ) - WORK( I, J )
+   20             CONTINUE
+   30          CONTINUE
+*
+            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+*              Form  C * H  or  C * H**T  where  C = ( C1  C2 )
+*
+               LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
+               LASTC = ILASLR( M, LASTV, C, LDC )
+*
+*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
+*
+*              W := C1
+*
+               DO 40 J = 1, K
+                  CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+   40          CONTINUE
+*
+*              W := W * V1
+*
+               CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C2 * V2
+*
+                  CALL SGEMM( 'No transpose', 'No transpose',
+     $                 LASTC, K, LASTV-K,
+     $                 ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T  or  W * T**T
+*
+               CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - W * V**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C2 := C2 - W * V2**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTC, LASTV-K, K,
+     $                 -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
+     $                 C( 1, K+1 ), LDC )
+               END IF
+*
+*              W := W * V1**T
+*
+               CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+*              C1 := C1 - W
+*
+               DO 60 J = 1, K
+                  DO 50 I = 1, LASTC
+                     C( I, J ) = C( I, J ) - WORK( I, J )
+   50             CONTINUE
+   60          CONTINUE
+            END IF
+*
+         ELSE
+*
+*           Let  V =  ( V1 )
+*                     ( V2 )    (last K rows)
+*           where  V2  is unit upper triangular.
+*
+            IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*              Form  H * C  or  H**T * C  where  C = ( C1 )
+*                                                    ( C2 )
+*
+               LASTV = MAX( K, ILASLR( M, K, V, LDV ) )
+               LASTC = ILASLC( LASTV, N, C, LDC )
+*
+*              W := C**T * V  =  (C1**T * V1 + C2**T * V2)  (stored in WORK)
+*
+*              W := C2**T
+*
+               DO 70 J = 1, K
+                  CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+     $                 WORK( 1, J ), 1 )
+   70          CONTINUE
+*
+*              W := W * V2
+*
+               CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+     $              WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C1**T*V1
+*
+                  CALL SGEMM( 'Transpose', 'No transpose',
+     $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T**T  or  W * T
+*
+               CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - V * W**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C1 := C1 - V1 * W**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+     $                 ONE, C, LDC )
+               END IF
+*
+*              W := W * V2**T
+*
+               CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+     $              WORK, LDWORK )
+*
+*              C2 := C2 - W**T
+*
+               DO 90 J = 1, K
+                  DO 80 I = 1, LASTC
+                     C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+   80             CONTINUE
+   90          CONTINUE
+*
+            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+*              Form  C * H  or  C * H**T  where  C = ( C1  C2 )
+*
+               LASTV = MAX( K, ILASLR( N, K, V, LDV ) )
+               LASTC = ILASLR( M, LASTV, C, LDC )
+*
+*              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
+*
+*              W := C2
+*
+               DO 100 J = 1, K
+                  CALL SCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
+  100          CONTINUE
+*
+*              W := W * V2
+*
+               CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+     $              WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C1 * V1
+*
+                  CALL SGEMM( 'No transpose', 'No transpose',
+     $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T  or  W * T**T
+*
+               CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - W * V**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C1 := C1 - W * V1**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+     $                 ONE, C, LDC )
+               END IF
+*
+*              W := W * V2**T
+*
+               CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV,
+     $              WORK, LDWORK )
+*
+*              C2 := C2 - W
+*
+               DO 120 J = 1, K
+                  DO 110 I = 1, LASTC
+                     C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J)
+  110             CONTINUE
+  120          CONTINUE
+            END IF
+         END IF
+*
+      ELSE IF( LSAME( STOREV, 'R' ) ) THEN
+*
+         IF( LSAME( DIRECT, 'F' ) ) THEN
+*
+*           Let  V =  ( V1  V2 )    (V1: first K columns)
+*           where  V1  is unit upper triangular.
+*
+            IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*              Form  H * C  or  H**T * C  where  C = ( C1 )
+*                                                    ( C2 )
+*
+               LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
+               LASTC = ILASLC( LASTV, N, C, LDC )
+*
+*              W := C**T * V**T  =  (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+*              W := C1**T
+*
+               DO 130 J = 1, K
+                  CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+  130          CONTINUE
+*
+*              W := W * V1**T
+*
+               CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C2**T*V2**T
+*
+                  CALL SGEMM( 'Transpose', 'Transpose',
+     $                 LASTC, K, LASTV-K,
+     $                 ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T**T  or  W * T
+*
+               CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - V**T * W**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C2 := C2 - V2**T * W**T
+*
+                  CALL SGEMM( 'Transpose', 'Transpose',
+     $                 LASTV-K, LASTC, K,
+     $                 -ONE, V( 1, K+1 ), LDV, WORK, LDWORK,
+     $                 ONE, C( K+1, 1 ), LDC )
+               END IF
+*
+*              W := W * V1
+*
+               CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+*              C1 := C1 - W**T
+*
+               DO 150 J = 1, K
+                  DO 140 I = 1, LASTC
+                     C( J, I ) = C( J, I ) - WORK( I, J )
+  140             CONTINUE
+  150          CONTINUE
+*
+            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+*              Form  C * H  or  C * H**T  where  C = ( C1  C2 )
+*
+               LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
+               LASTC = ILASLR( M, LASTV, C, LDC )
+*
+*              W := C * V**T  =  (C1*V1**T + C2*V2**T)  (stored in WORK)
+*
+*              W := C1
+*
+               DO 160 J = 1, K
+                  CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 )
+  160          CONTINUE
+*
+*              W := W * V1**T
+*
+               CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C2 * V2**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTC, K, LASTV-K,
+     $                 ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T  or  W * T**T
+*
+               CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - W * V
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C2 := C2 - W * V2
+*
+                  CALL SGEMM( 'No transpose', 'No transpose',
+     $                 LASTC, LASTV-K, K,
+     $                 -ONE, WORK, LDWORK, V( 1, K+1 ), LDV,
+     $                 ONE, C( 1, K+1 ), LDC )
+               END IF
+*
+*              W := W * V1
+*
+               CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V, LDV, WORK, LDWORK )
+*
+*              C1 := C1 - W
+*
+               DO 180 J = 1, K
+                  DO 170 I = 1, LASTC
+                     C( I, J ) = C( I, J ) - WORK( I, J )
+  170             CONTINUE
+  180          CONTINUE
+*
+            END IF
+*
+         ELSE
+*
+*           Let  V =  ( V1  V2 )    (V2: last K columns)
+*           where  V2  is unit lower triangular.
+*
+            IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*              Form  H * C  or  H**T * C  where  C = ( C1 )
+*                                                    ( C2 )
+*
+               LASTV = MAX( K, ILASLC( K, M, V, LDV ) )
+               LASTC = ILASLC( LASTV, N, C, LDC )
+*
+*              W := C**T * V**T  =  (C1**T * V1**T + C2**T * V2**T) (stored in WORK)
+*
+*              W := C2**T
+*
+               DO 190 J = 1, K
+                  CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC,
+     $                 WORK( 1, J ), 1 )
+  190          CONTINUE
+*
+*              W := W * V2**T
+*
+               CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+     $              WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C1**T * V1**T
+*
+                  CALL SGEMM( 'Transpose', 'Transpose',
+     $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T**T  or  W * T
+*
+               CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - V**T * W**T
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C1 := C1 - V1**T * W**T
+*
+                  CALL SGEMM( 'Transpose', 'Transpose',
+     $                 LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK,
+     $                 ONE, C, LDC )
+               END IF
+*
+*              W := W * V2
+*
+               CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+     $              WORK, LDWORK )
+*
+*              C2 := C2 - W**T
+*
+               DO 210 J = 1, K
+                  DO 200 I = 1, LASTC
+                     C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J)
+  200             CONTINUE
+  210          CONTINUE
+*
+            ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+*              Form  C * H  or  C * H**T  where  C = ( C1  C2 )
+*
+               LASTV = MAX( K, ILASLC( K, N, V, LDV ) )
+               LASTC = ILASLR( M, LASTV, C, LDC )
+*
+*              W := C * V**T  =  (C1*V1**T + C2*V2**T)  (stored in WORK)
+*
+*              W := C2
+*
+               DO 220 J = 1, K
+                  CALL SCOPY( LASTC, C( 1, LASTV-K+J ), 1,
+     $                 WORK( 1, J ), 1 )
+  220          CONTINUE
+*
+*              W := W * V2**T
+*
+               CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit',
+     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+     $              WORK, LDWORK )
+               IF( LASTV.GT.K ) THEN
+*
+*                 W := W + C1 * V1**T
+*
+                  CALL SGEMM( 'No transpose', 'Transpose',
+     $                 LASTC, K, LASTV-K, ONE, C, LDC, V, LDV,
+     $                 ONE, WORK, LDWORK )
+               END IF
+*
+*              W := W * T  or  W * T**T
+*
+               CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit',
+     $              LASTC, K, ONE, T, LDT, WORK, LDWORK )
+*
+*              C := C - W * V
+*
+               IF( LASTV.GT.K ) THEN
+*
+*                 C1 := C1 - W * V1
+*
+                  CALL SGEMM( 'No transpose', 'No transpose',
+     $                 LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV,
+     $                 ONE, C, LDC )
+               END IF
+*
+*              W := W * V2
+*
+               CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit',
+     $              LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV,
+     $              WORK, LDWORK )
+*
+*              C1 := C1 - W
+*
+               DO 240 J = 1, K
+                  DO 230 I = 1, LASTC
+                     C( I, LASTV-K+J ) = C( I, LASTV-K+J )
+     $                    - WORK( I, J )
+  230             CONTINUE
+  240          CONTINUE
+*
+            END IF
+*
+         END IF
+      END IF
+*
+      RETURN
+*
+*     End of SLARFB
+*
+      END
Index: trunk/SOURCES/BLAS/slarfg.f
===================================================================
--- trunk/SOURCES/BLAS/slarfg.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarfg.f	(revision 22)
@@ -0,0 +1,196 @@
+*> \brief \b SLARFG
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARFG + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfg.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfg.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfg.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INCX, N
+*       REAL               ALPHA, TAU
+*       ..
+*       .. Array Arguments ..
+*       REAL               X( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARFG generates a real elementary reflector H of order n, such
+*> that
+*>
+*>       H * ( alpha ) = ( beta ),   H**T * H = I.
+*>           (   x   )   (   0  )
+*>
+*> where alpha and beta are scalars, and x is an (n-1)-element real
+*> vector. H is represented in the form
+*>
+*>       H = I - tau * ( 1 ) * ( 1 v**T ) ,
+*>                     ( v )
+*>
+*> where tau is a real scalar and v is a real (n-1)-element
+*> vector.
+*>
+*> If the elements of x are all zero, then tau = 0 and H is taken to be
+*> the unit matrix.
+*>
+*> Otherwise  1 <= tau <= 2.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the elementary reflector.
+*> \endverbatim
+*>
+*> \param[in,out] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>          On entry, the value alpha.
+*>          On exit, it is overwritten with the value beta.
+*> \endverbatim
+*>
+*> \param[in,out] X
+*> \verbatim
+*>          X is REAL array, dimension
+*>                         (1+(N-2)*abs(INCX))
+*>          On entry, the vector x.
+*>          On exit, it is overwritten with the vector v.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>          The increment between elements of X. INCX > 0.
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL
+*>          The value tau.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLARFG( N, ALPHA, X, INCX, TAU )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      REAL               ALPHA, TAU
+*     ..
+*     .. Array Arguments ..
+      REAL               X( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            J, KNT
+      REAL               BETA, RSAFMN, SAFMIN, XNORM
+*     ..
+*     .. External Functions ..
+      REAL               SLAMCH, SLAPY2, SNRM2
+      EXTERNAL           SLAMCH, SLAPY2, SNRM2
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, SIGN
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SSCAL
+*     ..
+*     .. Executable Statements ..
+*
+      IF( N.LE.1 ) THEN
+         TAU = ZERO
+         RETURN
+      END IF
+*
+      XNORM = SNRM2( N-1, X, INCX )
+*
+      IF( XNORM.EQ.ZERO ) THEN
+*
+*        H  =  I
+*
+         TAU = ZERO
+      ELSE
+*
+*        general case
+*
+         BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+         SAFMIN = SLAMCH( 'S' ) / SLAMCH( 'E' )
+         KNT = 0
+         IF( ABS( BETA ).LT.SAFMIN ) THEN
+*
+*           XNORM, BETA may be inaccurate; scale X and recompute them
+*
+            RSAFMN = ONE / SAFMIN
+   10       CONTINUE
+            KNT = KNT + 1
+            CALL SSCAL( N-1, RSAFMN, X, INCX )
+            BETA = BETA*RSAFMN
+            ALPHA = ALPHA*RSAFMN
+            IF( ABS( BETA ).LT.SAFMIN )
+     $         GO TO 10
+*
+*           New BETA is at most 1, at least SAFMIN
+*
+            XNORM = SNRM2( N-1, X, INCX )
+            BETA = -SIGN( SLAPY2( ALPHA, XNORM ), ALPHA )
+         END IF
+         TAU = ( BETA-ALPHA ) / BETA
+         CALL SSCAL( N-1, ONE / ( ALPHA-BETA ), X, INCX )
+*
+*        If ALPHA is subnormal, it may lose relative accuracy
+*
+         DO 20 J = 1, KNT
+            BETA = BETA*SAFMIN
+ 20      CONTINUE
+         ALPHA = BETA
+      END IF
+*
+      RETURN
+*
+*     End of SLARFG
+*
+      END
Index: trunk/SOURCES/BLAS/slarft.f
===================================================================
--- trunk/SOURCES/BLAS/slarft.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarft.f	(revision 22)
@@ -0,0 +1,328 @@
+*> \brief \b SLARFT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARFT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarft.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarft.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarft.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          DIRECT, STOREV
+*       INTEGER            K, LDT, LDV, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               T( LDT, * ), TAU( * ), V( LDV, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARFT forms the triangular factor T of a real block reflector H
+*> of order n, which is defined as a product of k elementary reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*>    H  =  I - V * T * V**T
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*>    H  =  I - V**T * T * V
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*>          DIRECT is CHARACTER*1
+*>          Specifies the order in which the elementary reflectors are
+*>          multiplied to form the block reflector:
+*>          = 'F': H = H(1) H(2) . . . H(k) (Forward)
+*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*>          STOREV is CHARACTER*1
+*>          Specifies how the vectors which define the elementary
+*>          reflectors are stored (see also Further Details):
+*>          = 'C': columnwise
+*>          = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The order of the triangular factor T (= the number of
+*>          elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] V
+*> \verbatim
+*>          V is REAL array, dimension
+*>                               (LDV,K) if STOREV = 'C'
+*>                               (LDV,N) if STOREV = 'R'
+*>          The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The k by k triangular factor T of the block reflector.
+*>          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*>          lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERauxiliary
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The shape of the matrix V and the storage of the vectors which define
+*>  the H(i) is best illustrated by the following example with n = 5 and
+*>  k = 3. The elements equal to 1 are not stored; the corresponding
+*>  array elements are modified but restored on exit. The rest of the
+*>  array is not used.
+*>
+*>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
+*>
+*>               V = (  1       )                 V = (  1 v1 v1 v1 v1 )
+*>                   ( v1  1    )                     (     1 v2 v2 v2 )
+*>                   ( v1 v2  1 )                     (        1 v3 v3 )
+*>                   ( v1 v2 v3 )
+*>                   ( v1 v2 v3 )
+*>
+*>  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
+*>
+*>               V = ( v1 v2 v3 )                 V = ( v1 v1  1       )
+*>                   ( v1 v2 v3 )                     ( v2 v2 v2  1    )
+*>                   (  1 v2 v3 )                     ( v3 v3 v3 v3  1 )
+*>                   (     1 v3 )
+*>                   (        1 )
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          DIRECT, STOREV
+      INTEGER            K, LDT, LDV, N
+*     ..
+*     .. Array Arguments ..
+      REAL               T( LDT, * ), TAU( * ), V( LDV, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, J, PREVLASTV, LASTV
+      REAL               VII
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMV, STRMV
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 )
+     $   RETURN
+*
+      IF( LSAME( DIRECT, 'F' ) ) THEN
+         PREVLASTV = N
+         DO 20 I = 1, K
+            PREVLASTV = MAX( I, PREVLASTV )
+            IF( TAU( I ).EQ.ZERO ) THEN
+*
+*              H(i)  =  I
+*
+               DO 10 J = 1, I
+                  T( J, I ) = ZERO
+   10          CONTINUE
+            ELSE
+*
+*              general case
+*
+               VII = V( I, I )
+               V( I, I ) = ONE
+               IF( LSAME( STOREV, 'C' ) ) THEN
+!                 Skip any trailing zeros.
+                  DO LASTV = N, I+1, -1
+                     IF( V( LASTV, I ).NE.ZERO ) EXIT
+                  END DO
+                  J = MIN( LASTV, PREVLASTV )
+*
+*                 T(1:i-1,i) := - tau(i) * V(i:j,1:i-1)**T * V(i:j,i)
+*
+                  CALL SGEMV( 'Transpose', J-I+1, I-1, -TAU( I ),
+     $                        V( I, 1 ), LDV, V( I, I ), 1, ZERO,
+     $                        T( 1, I ), 1 )
+               ELSE
+!                 Skip any trailing zeros.
+                  DO LASTV = N, I+1, -1
+                     IF( V( I, LASTV ).NE.ZERO ) EXIT
+                  END DO
+                  J = MIN( LASTV, PREVLASTV )
+*
+*                 T(1:i-1,i) := - tau(i) * V(1:i-1,i:j) * V(i,i:j)**T
+*
+                  CALL SGEMV( 'No transpose', I-1, J-I+1, -TAU( I ),
+     $                        V( 1, I ), LDV, V( I, I ), LDV, ZERO,
+     $                        T( 1, I ), 1 )
+               END IF
+               V( I, I ) = VII
+*
+*              T(1:i-1,i) := T(1:i-1,1:i-1) * T(1:i-1,i)
+*
+               CALL STRMV( 'Upper', 'No transpose', 'Non-unit', I-1, T,
+     $                     LDT, T( 1, I ), 1 )
+               T( I, I ) = TAU( I )
+               IF( I.GT.1 ) THEN
+                  PREVLASTV = MAX( PREVLASTV, LASTV )
+               ELSE
+                  PREVLASTV = LASTV
+               END IF
+            END IF
+   20    CONTINUE
+      ELSE
+         PREVLASTV = 1
+         DO 40 I = K, 1, -1
+            IF( TAU( I ).EQ.ZERO ) THEN
+*
+*              H(i)  =  I
+*
+               DO 30 J = I, K
+                  T( J, I ) = ZERO
+   30          CONTINUE
+            ELSE
+*
+*              general case
+*
+               IF( I.LT.K ) THEN
+                  IF( LSAME( STOREV, 'C' ) ) THEN
+                     VII = V( N-K+I, I )
+                     V( N-K+I, I ) = ONE
+!                    Skip any leading zeros.
+                     DO LASTV = 1, I-1
+                        IF( V( LASTV, I ).NE.ZERO ) EXIT
+                     END DO
+                     J = MAX( LASTV, PREVLASTV )
+*
+*                    T(i+1:k,i) :=
+*                            - tau(i) * V(j:n-k+i,i+1:k)**T * V(j:n-k+i,i)
+*
+                     CALL SGEMV( 'Transpose', N-K+I-J+1, K-I, -TAU( I ),
+     $                           V( J, I+1 ), LDV, V( J, I ), 1, ZERO,
+     $                           T( I+1, I ), 1 )
+                     V( N-K+I, I ) = VII
+                  ELSE
+                     VII = V( I, N-K+I )
+                     V( I, N-K+I ) = ONE
+!                    Skip any leading zeros.
+                     DO LASTV = 1, I-1
+                        IF( V( I, LASTV ).NE.ZERO ) EXIT
+                     END DO
+                     J = MAX( LASTV, PREVLASTV )
+*
+*                    T(i+1:k,i) :=
+*                            - tau(i) * V(i+1:k,j:n-k+i) * V(i,j:n-k+i)**T
+*
+                     CALL SGEMV( 'No transpose', K-I, N-K+I-J+1,
+     $                    -TAU( I ), V( I+1, J ), LDV, V( I, J ), LDV,
+     $                    ZERO, T( I+1, I ), 1 )
+                     V( I, N-K+I ) = VII
+                  END IF
+*
+*                 T(i+1:k,i) := T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+                  CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+     $                        T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+                  IF( I.GT.1 ) THEN
+                     PREVLASTV = MIN( PREVLASTV, LASTV )
+                  ELSE
+                     PREVLASTV = LASTV
+                  END IF
+               END IF
+               T( I, I ) = TAU( I )
+            END IF
+   40    CONTINUE
+      END IF
+      RETURN
+*
+*     End of SLARFT
+*
+      END
Index: trunk/SOURCES/BLAS/slarz.f
===================================================================
--- trunk/SOURCES/BLAS/slarz.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarz.f	(revision 22)
@@ -0,0 +1,236 @@
+*> \brief \b SLARZ
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARZ + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarz.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarz.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarz.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE
+*       INTEGER            INCV, L, LDC, M, N
+*       REAL               TAU
+*       ..
+*       .. Array Arguments ..
+*       REAL               C( LDC, * ), V( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARZ applies a real elementary reflector H to a real M-by-N
+*> matrix C, from either the left or the right. H is represented in the
+*> form
+*>
+*>       H = I - tau * v * v**T
+*>
+*> where tau is a real scalar and v is a real vector.
+*>
+*> If tau = 0, then H is taken to be the unit matrix.
+*>
+*>
+*> H is a product of k elementary reflectors as returned by STZRZF.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': form  H * C
+*>          = 'R': form  C * H
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of entries of the vector V containing
+*>          the meaningful part of the Householder vectors.
+*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension (1+(L-1)*abs(INCV))
+*>          The vector v in the representation of H as returned by
+*>          STZRZF. V is not used if TAU = 0.
+*> \endverbatim
+*>
+*> \param[in] INCV
+*> \verbatim
+*>          INCV is INTEGER
+*>          The increment between elements of v. INCV <> 0.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL
+*>          The value tau in the representation of H.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by the matrix H * C if SIDE = 'L',
+*>          or C * H if SIDE = 'R'.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension
+*>                         (N) if SIDE = 'L'
+*>                      or (M) if SIDE = 'R'
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLARZ( SIDE, M, N, L, V, INCV, TAU, C, LDC, WORK )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE
+      INTEGER            INCV, L, LDC, M, N
+      REAL               TAU
+*     ..
+*     .. Array Arguments ..
+      REAL               C( LDC, * ), V( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE, ZERO
+      PARAMETER          ( ONE = 1.0E+0, ZERO = 0.0E+0 )
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SAXPY, SCOPY, SGEMV, SGER
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Executable Statements ..
+*
+      IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*        Form  H * C
+*
+         IF( TAU.NE.ZERO ) THEN
+*
+*           w( 1:n ) = C( 1, 1:n )
+*
+            CALL SCOPY( N, C, LDC, WORK, 1 )
+*
+*           w( 1:n ) = w( 1:n ) + C( m-l+1:m, 1:n )**T * v( 1:l )
+*
+            CALL SGEMV( 'Transpose', L, N, ONE, C( M-L+1, 1 ), LDC, V,
+     $                  INCV, ONE, WORK, 1 )
+*
+*           C( 1, 1:n ) = C( 1, 1:n ) - tau * w( 1:n )
+*
+            CALL SAXPY( N, -TAU, WORK, 1, C, LDC )
+*
+*           C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
+*                               tau * v( 1:l ) * w( 1:n )**T
+*
+            CALL SGER( L, N, -TAU, V, INCV, WORK, 1, C( M-L+1, 1 ),
+     $                 LDC )
+         END IF
+*
+      ELSE
+*
+*        Form  C * H
+*
+         IF( TAU.NE.ZERO ) THEN
+*
+*           w( 1:m ) = C( 1:m, 1 )
+*
+            CALL SCOPY( M, C, 1, WORK, 1 )
+*
+*           w( 1:m ) = w( 1:m ) + C( 1:m, n-l+1:n, 1:n ) * v( 1:l )
+*
+            CALL SGEMV( 'No transpose', M, L, ONE, C( 1, N-L+1 ), LDC,
+     $                  V, INCV, ONE, WORK, 1 )
+*
+*           C( 1:m, 1 ) = C( 1:m, 1 ) - tau * w( 1:m )
+*
+            CALL SAXPY( M, -TAU, WORK, 1, C, 1 )
+*
+*           C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
+*                               tau * w( 1:m ) * v( 1:l )**T
+*
+            CALL SGER( M, L, -TAU, WORK, 1, V, INCV, C( 1, N-L+1 ),
+     $                 LDC )
+*
+         END IF
+*
+      END IF
+*
+      RETURN
+*
+*     End of SLARZ
+*
+      END
Index: trunk/SOURCES/BLAS/slarzb.f
===================================================================
--- trunk/SOURCES/BLAS/slarzb.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarzb.f	(revision 22)
@@ -0,0 +1,323 @@
+*> \brief \b SLARZB
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARZB + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarzb.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarzb.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarzb.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
+*                          LDV, T, LDT, C, LDC, WORK, LDWORK )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          DIRECT, SIDE, STOREV, TRANS
+*       INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               C( LDC, * ), T( LDT, * ), V( LDV, * ),
+*      $                   WORK( LDWORK, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARZB applies a real block reflector H or its transpose H**T to
+*> a real distributed M-by-N  C from the left or the right.
+*>
+*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply H or H**T from the Left
+*>          = 'R': apply H or H**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': apply H (No transpose)
+*>          = 'C': apply H**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] DIRECT
+*> \verbatim
+*>          DIRECT is CHARACTER*1
+*>          Indicates how H is formed from a product of elementary
+*>          reflectors
+*>          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*>          STOREV is CHARACTER*1
+*>          Indicates how the vectors which define the elementary
+*>          reflectors are stored:
+*>          = 'C': Columnwise                        (not supported yet)
+*>          = 'R': Rowwise
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The order of the matrix T (= the number of elementary
+*>          reflectors whose product defines the block reflector).
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of columns of the matrix V containing the
+*>          meaningful part of the Householder reflectors.
+*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension (LDV,NV).
+*>          If STOREV = 'C', NV = K; if STOREV = 'R', NV = L.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If STOREV = 'C', LDV >= L; if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The triangular K-by-K matrix T in the representation of the
+*>          block reflector.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (LDWORK,K)
+*> \endverbatim
+*>
+*> \param[in] LDWORK
+*> \verbatim
+*>          LDWORK is INTEGER
+*>          The leading dimension of the array WORK.
+*>          If SIDE = 'L', LDWORK >= max(1,N);
+*>          if SIDE = 'R', LDWORK >= max(1,M).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLARZB( SIDE, TRANS, DIRECT, STOREV, M, N, K, L, V,
+     $                   LDV, T, LDT, C, LDC, WORK, LDWORK )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          DIRECT, SIDE, STOREV, TRANS
+      INTEGER            K, L, LDC, LDT, LDV, LDWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               C( LDC, * ), T( LDT, * ), V( LDV, * ),
+     $                   WORK( LDWORK, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      CHARACTER          TRANST
+      INTEGER            I, INFO, J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SCOPY, SGEMM, STRMM, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Quick return if possible
+*
+      IF( M.LE.0 .OR. N.LE.0 )
+     $   RETURN
+*
+*     Check for currently supported options
+*
+      INFO = 0
+      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
+         INFO = -3
+      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
+         INFO = -4
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SLARZB', -INFO )
+         RETURN
+      END IF
+*
+      IF( LSAME( TRANS, 'N' ) ) THEN
+         TRANST = 'T'
+      ELSE
+         TRANST = 'N'
+      END IF
+*
+      IF( LSAME( SIDE, 'L' ) ) THEN
+*
+*        Form  H * C  or  H**T * C
+*
+*        W( 1:n, 1:k ) = C( 1:k, 1:n )**T
+*
+         DO 10 J = 1, K
+            CALL SCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
+   10    CONTINUE
+*
+*        W( 1:n, 1:k ) = W( 1:n, 1:k ) + ...
+*                        C( m-l+1:m, 1:n )**T * V( 1:k, 1:l )**T
+*
+         IF( L.GT.0 )
+     $      CALL SGEMM( 'Transpose', 'Transpose', N, K, L, ONE,
+     $                  C( M-L+1, 1 ), LDC, V, LDV, ONE, WORK, LDWORK )
+*
+*        W( 1:n, 1:k ) = W( 1:n, 1:k ) * T**T  or  W( 1:m, 1:k ) * T
+*
+         CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K, ONE, T,
+     $               LDT, WORK, LDWORK )
+*
+*        C( 1:k, 1:n ) = C( 1:k, 1:n ) - W( 1:n, 1:k )**T
+*
+         DO 30 J = 1, N
+            DO 20 I = 1, K
+               C( I, J ) = C( I, J ) - WORK( J, I )
+   20       CONTINUE
+   30    CONTINUE
+*
+*        C( m-l+1:m, 1:n ) = C( m-l+1:m, 1:n ) - ...
+*                            V( 1:k, 1:l )**T * W( 1:n, 1:k )**T
+*
+         IF( L.GT.0 )
+     $      CALL SGEMM( 'Transpose', 'Transpose', L, N, K, -ONE, V, LDV,
+     $                  WORK, LDWORK, ONE, C( M-L+1, 1 ), LDC )
+*
+      ELSE IF( LSAME( SIDE, 'R' ) ) THEN
+*
+*        Form  C * H  or  C * H**T
+*
+*        W( 1:m, 1:k ) = C( 1:m, 1:k )
+*
+         DO 40 J = 1, K
+            CALL SCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
+   40    CONTINUE
+*
+*        W( 1:m, 1:k ) = W( 1:m, 1:k ) + ...
+*                        C( 1:m, n-l+1:n ) * V( 1:k, 1:l )**T
+*
+         IF( L.GT.0 )
+     $      CALL SGEMM( 'No transpose', 'Transpose', M, K, L, ONE,
+     $                  C( 1, N-L+1 ), LDC, V, LDV, ONE, WORK, LDWORK )
+*
+*        W( 1:m, 1:k ) = W( 1:m, 1:k ) * T  or  W( 1:m, 1:k ) * T**T
+*
+         CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K, ONE, T,
+     $               LDT, WORK, LDWORK )
+*
+*        C( 1:m, 1:k ) = C( 1:m, 1:k ) - W( 1:m, 1:k )
+*
+         DO 60 J = 1, K
+            DO 50 I = 1, M
+               C( I, J ) = C( I, J ) - WORK( I, J )
+   50       CONTINUE
+   60    CONTINUE
+*
+*        C( 1:m, n-l+1:n ) = C( 1:m, n-l+1:n ) - ...
+*                            W( 1:m, 1:k ) * V( 1:k, 1:l )
+*
+         IF( L.GT.0 )
+     $      CALL SGEMM( 'No transpose', 'No transpose', M, L, K, -ONE,
+     $                  WORK, LDWORK, V, LDV, ONE, C( 1, N-L+1 ), LDC )
+*
+      END IF
+*
+      RETURN
+*
+*     End of SLARZB
+*
+      END
Index: trunk/SOURCES/BLAS/slarzt.f
===================================================================
--- trunk/SOURCES/BLAS/slarzt.f	(revision 22)
+++ trunk/SOURCES/BLAS/slarzt.f	(revision 22)
@@ -0,0 +1,264 @@
+*> \brief \b SLARZT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLARZT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarzt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarzt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarzt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          DIRECT, STOREV
+*       INTEGER            K, LDT, LDV, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               T( LDT, * ), TAU( * ), V( LDV, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLARZT forms the triangular factor T of a real block reflector
+*> H of order > n, which is defined as a product of k elementary
+*> reflectors.
+*>
+*> If DIRECT = 'F', H = H(1) H(2) . . . H(k) and T is upper triangular;
+*>
+*> If DIRECT = 'B', H = H(k) . . . H(2) H(1) and T is lower triangular.
+*>
+*> If STOREV = 'C', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th column of the array V, and
+*>
+*>    H  =  I - V * T * V**T
+*>
+*> If STOREV = 'R', the vector which defines the elementary reflector
+*> H(i) is stored in the i-th row of the array V, and
+*>
+*>    H  =  I - V**T * T * V
+*>
+*> Currently, only STOREV = 'R' and DIRECT = 'B' are supported.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] DIRECT
+*> \verbatim
+*>          DIRECT is CHARACTER*1
+*>          Specifies the order in which the elementary reflectors are
+*>          multiplied to form the block reflector:
+*>          = 'F': H = H(1) H(2) . . . H(k) (Forward, not supported yet)
+*>          = 'B': H = H(k) . . . H(2) H(1) (Backward)
+*> \endverbatim
+*>
+*> \param[in] STOREV
+*> \verbatim
+*>          STOREV is CHARACTER*1
+*>          Specifies how the vectors which define the elementary
+*>          reflectors are stored (see also Further Details):
+*>          = 'C': columnwise                        (not supported yet)
+*>          = 'R': rowwise
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The order of the block reflector H. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The order of the triangular factor T (= the number of
+*>          elementary reflectors). K >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] V
+*> \verbatim
+*>          V is REAL array, dimension
+*>                               (LDV,K) if STOREV = 'C'
+*>                               (LDV,N) if STOREV = 'R'
+*>          The matrix V. See further details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If STOREV = 'C', LDV >= max(1,N); if STOREV = 'R', LDV >= K.
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The k by k triangular factor T of the block reflector.
+*>          If DIRECT = 'F', T is upper triangular; if DIRECT = 'B', T is
+*>          lower triangular. The rest of the array is not used.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T. LDT >= K.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The shape of the matrix V and the storage of the vectors which define
+*>  the H(i) is best illustrated by the following example with n = 5 and
+*>  k = 3. The elements equal to 1 are not stored; the corresponding
+*>  array elements are modified but restored on exit. The rest of the
+*>  array is not used.
+*>
+*>  DIRECT = 'F' and STOREV = 'C':         DIRECT = 'F' and STOREV = 'R':
+*>
+*>                                              ______V_____
+*>         ( v1 v2 v3 )                        /            \
+*>         ( v1 v2 v3 )                      ( v1 v1 v1 v1 v1 . . . . 1 )
+*>     V = ( v1 v2 v3 )                      ( v2 v2 v2 v2 v2 . . . 1   )
+*>         ( v1 v2 v3 )                      ( v3 v3 v3 v3 v3 . . 1     )
+*>         ( v1 v2 v3 )
+*>            .  .  .
+*>            .  .  .
+*>            1  .  .
+*>               1  .
+*>                  1
+*>
+*>  DIRECT = 'B' and STOREV = 'C':         DIRECT = 'B' and STOREV = 'R':
+*>
+*>                                                        ______V_____
+*>            1                                          /            \
+*>            .  1                           ( 1 . . . . v1 v1 v1 v1 v1 )
+*>            .  .  1                        ( . 1 . . . v2 v2 v2 v2 v2 )
+*>            .  .  .                        ( . . 1 . . v3 v3 v3 v3 v3 )
+*>            .  .  .
+*>         ( v1 v2 v3 )
+*>         ( v1 v2 v3 )
+*>     V = ( v1 v2 v3 )
+*>         ( v1 v2 v3 )
+*>         ( v1 v2 v3 )
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLARZT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          DIRECT, STOREV
+      INTEGER            K, LDT, LDV, N
+*     ..
+*     .. Array Arguments ..
+      REAL               T( LDT, * ), TAU( * ), V( LDV, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I, INFO, J
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEMV, STRMV, XERBLA
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Executable Statements ..
+*
+*     Check for currently supported options
+*
+      INFO = 0
+      IF( .NOT.LSAME( DIRECT, 'B' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.LSAME( STOREV, 'R' ) ) THEN
+         INFO = -2
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SLARZT', -INFO )
+         RETURN
+      END IF
+*
+      DO 20 I = K, 1, -1
+         IF( TAU( I ).EQ.ZERO ) THEN
+*
+*           H(i)  =  I
+*
+            DO 10 J = I, K
+               T( J, I ) = ZERO
+   10       CONTINUE
+         ELSE
+*
+*           general case
+*
+            IF( I.LT.K ) THEN
+*
+*              T(i+1:k,i) = - tau(i) * V(i+1:k,1:n) * V(i,1:n)**T
+*
+               CALL SGEMV( 'No transpose', K-I, N, -TAU( I ),
+     $                     V( I+1, 1 ), LDV, V( I, 1 ), LDV, ZERO,
+     $                     T( I+1, I ), 1 )
+*
+*              T(i+1:k,i) = T(i+1:k,i+1:k) * T(i+1:k,i)
+*
+               CALL STRMV( 'Lower', 'No transpose', 'Non-unit', K-I,
+     $                     T( I+1, I+1 ), LDT, T( I+1, I ), 1 )
+            END IF
+            T( I, I ) = TAU( I )
+         END IF
+   20 CONTINUE
+      RETURN
+*
+*     End of SLARZT
+*
+      END
Index: trunk/SOURCES/BLAS/slascl.f
===================================================================
--- trunk/SOURCES/BLAS/slascl.f	(revision 22)
+++ trunk/SOURCES/BLAS/slascl.f	(revision 22)
@@ -0,0 +1,364 @@
+*> \brief \b SLASCL
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLASCL + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slascl.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slascl.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slascl.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          TYPE
+*       INTEGER            INFO, KL, KU, LDA, M, N
+*       REAL               CFROM, CTO
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLASCL multiplies the M by N real matrix A by the real scalar
+*> CTO/CFROM.  This is done without over/underflow as long as the final
+*> result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
+*> A may be full, upper triangular, lower triangular, upper Hessenberg,
+*> or banded.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TYPE
+*> \verbatim
+*>          TYPE is CHARACTER*1
+*>          TYPE indices the storage type of the input matrix.
+*>          = 'G':  A is a full matrix.
+*>          = 'L':  A is a lower triangular matrix.
+*>          = 'U':  A is an upper triangular matrix.
+*>          = 'H':  A is an upper Hessenberg matrix.
+*>          = 'B':  A is a symmetric band matrix with lower bandwidth KL
+*>                  and upper bandwidth KU and with the only the lower
+*>                  half stored.
+*>          = 'Q':  A is a symmetric band matrix with lower bandwidth KL
+*>                  and upper bandwidth KU and with the only the upper
+*>                  half stored.
+*>          = 'Z':  A is a band matrix with lower bandwidth KL and upper
+*>                  bandwidth KU. See SGBTRF for storage details.
+*> \endverbatim
+*>
+*> \param[in] KL
+*> \verbatim
+*>          KL is INTEGER
+*>          The lower bandwidth of A.  Referenced only if TYPE = 'B',
+*>          'Q' or 'Z'.
+*> \endverbatim
+*>
+*> \param[in] KU
+*> \verbatim
+*>          KU is INTEGER
+*>          The upper bandwidth of A.  Referenced only if TYPE = 'B',
+*>          'Q' or 'Z'.
+*> \endverbatim
+*>
+*> \param[in] CFROM
+*> \verbatim
+*>          CFROM is REAL
+*> \endverbatim
+*>
+*> \param[in] CTO
+*> \verbatim
+*>          CTO is REAL
+*>
+*>          The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
+*>          without over/underflow if the final result CTO*A(I,J)/CFROM
+*>          can be represented without over/underflow.  CFROM must be
+*>          nonzero.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          The matrix to be multiplied by CTO/CFROM.  See TYPE for the
+*>          storage type.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          0  - successful exit
+*>          <0 - if INFO = -i, the i-th argument had an illegal value.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          TYPE
+      INTEGER            INFO, KL, KU, LDA, M, N
+      REAL               CFROM, CTO
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            DONE
+      INTEGER            I, ITYPE, J, K1, K2, K3, K4
+      REAL               BIGNUM, CFROM1, CFROMC, CTO1, CTOC, MUL, SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME, SISNAN
+      REAL               SLAMCH
+      EXTERNAL           LSAME, SLAMCH, SISNAN
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS, MAX, MIN
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+*
+      IF( LSAME( TYPE, 'G' ) ) THEN
+         ITYPE = 0
+      ELSE IF( LSAME( TYPE, 'L' ) ) THEN
+         ITYPE = 1
+      ELSE IF( LSAME( TYPE, 'U' ) ) THEN
+         ITYPE = 2
+      ELSE IF( LSAME( TYPE, 'H' ) ) THEN
+         ITYPE = 3
+      ELSE IF( LSAME( TYPE, 'B' ) ) THEN
+         ITYPE = 4
+      ELSE IF( LSAME( TYPE, 'Q' ) ) THEN
+         ITYPE = 5
+      ELSE IF( LSAME( TYPE, 'Z' ) ) THEN
+         ITYPE = 6
+      ELSE
+         ITYPE = -1
+      END IF
+*
+      IF( ITYPE.EQ.-1 ) THEN
+         INFO = -1
+      ELSE IF( CFROM.EQ.ZERO .OR. SISNAN(CFROM) ) THEN
+         INFO = -4
+      ELSE IF( SISNAN(CTO) ) THEN
+         INFO = -5
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -6
+      ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.4 .AND. N.NE.M ) .OR.
+     $         ( ITYPE.EQ.5 .AND. N.NE.M ) ) THEN
+         INFO = -7
+      ELSE IF( ITYPE.LE.3 .AND. LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -9
+      ELSE IF( ITYPE.GE.4 ) THEN
+         IF( KL.LT.0 .OR. KL.GT.MAX( M-1, 0 ) ) THEN
+            INFO = -2
+         ELSE IF( KU.LT.0 .OR. KU.GT.MAX( N-1, 0 ) .OR.
+     $            ( ( ITYPE.EQ.4 .OR. ITYPE.EQ.5 ) .AND. KL.NE.KU ) )
+     $             THEN
+            INFO = -3
+         ELSE IF( ( ITYPE.EQ.4 .AND. LDA.LT.KL+1 ) .OR.
+     $            ( ITYPE.EQ.5 .AND. LDA.LT.KU+1 ) .OR.
+     $            ( ITYPE.EQ.6 .AND. LDA.LT.2*KL+KU+1 ) ) THEN
+            INFO = -9
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SLASCL', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. M.EQ.0 )
+     $   RETURN
+*
+*     Get machine parameters
+*
+      SMLNUM = SLAMCH( 'S' )
+      BIGNUM = ONE / SMLNUM
+*
+      CFROMC = CFROM
+      CTOC = CTO
+*
+   10 CONTINUE
+      CFROM1 = CFROMC*SMLNUM
+      IF( CFROM1.EQ.CFROMC ) THEN
+!        CFROMC is an inf.  Multiply by a correctly signed zero for
+!        finite CTOC, or a NaN if CTOC is infinite.
+         MUL = CTOC / CFROMC
+         DONE = .TRUE.
+         CTO1 = CTOC
+      ELSE
+         CTO1 = CTOC / BIGNUM
+         IF( CTO1.EQ.CTOC ) THEN
+!           CTOC is either 0 or an inf.  In both cases, CTOC itself
+!           serves as the correct multiplication factor.
+            MUL = CTOC
+            DONE = .TRUE.
+            CFROMC = ONE
+         ELSE IF( ABS( CFROM1 ).GT.ABS( CTOC ) .AND. CTOC.NE.ZERO ) THEN
+            MUL = SMLNUM
+            DONE = .FALSE.
+            CFROMC = CFROM1
+         ELSE IF( ABS( CTO1 ).GT.ABS( CFROMC ) ) THEN
+            MUL = BIGNUM
+            DONE = .FALSE.
+            CTOC = CTO1
+         ELSE
+            MUL = CTOC / CFROMC
+            DONE = .TRUE.
+         END IF
+      END IF
+*
+      IF( ITYPE.EQ.0 ) THEN
+*
+*        Full matrix
+*
+         DO 30 J = 1, N
+            DO 20 I = 1, M
+               A( I, J ) = A( I, J )*MUL
+   20       CONTINUE
+   30    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.1 ) THEN
+*
+*        Lower triangular matrix
+*
+         DO 50 J = 1, N
+            DO 40 I = J, M
+               A( I, J ) = A( I, J )*MUL
+   40       CONTINUE
+   50    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.2 ) THEN
+*
+*        Upper triangular matrix
+*
+         DO 70 J = 1, N
+            DO 60 I = 1, MIN( J, M )
+               A( I, J ) = A( I, J )*MUL
+   60       CONTINUE
+   70    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.3 ) THEN
+*
+*        Upper Hessenberg matrix
+*
+         DO 90 J = 1, N
+            DO 80 I = 1, MIN( J+1, M )
+               A( I, J ) = A( I, J )*MUL
+   80       CONTINUE
+   90    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.4 ) THEN
+*
+*        Lower half of a symmetric band matrix
+*
+         K3 = KL + 1
+         K4 = N + 1
+         DO 110 J = 1, N
+            DO 100 I = 1, MIN( K3, K4-J )
+               A( I, J ) = A( I, J )*MUL
+  100       CONTINUE
+  110    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.5 ) THEN
+*
+*        Upper half of a symmetric band matrix
+*
+         K1 = KU + 2
+         K3 = KU + 1
+         DO 130 J = 1, N
+            DO 120 I = MAX( K1-J, 1 ), K3
+               A( I, J ) = A( I, J )*MUL
+  120       CONTINUE
+  130    CONTINUE
+*
+      ELSE IF( ITYPE.EQ.6 ) THEN
+*
+*        Band matrix
+*
+         K1 = KL + KU + 2
+         K2 = KL + 1
+         K3 = 2*KL + KU + 1
+         K4 = KL + KU + 1 + M
+         DO 150 J = 1, N
+            DO 140 I = MAX( K1-J, K2 ), MIN( K3, K4-J )
+               A( I, J ) = A( I, J )*MUL
+  140       CONTINUE
+  150    CONTINUE
+*
+      END IF
+*
+      IF( .NOT.DONE )
+     $   GO TO 10
+*
+      RETURN
+*
+*     End of SLASCL
+*
+      END
Index: trunk/SOURCES/BLAS/slaset.f
===================================================================
--- trunk/SOURCES/BLAS/slaset.f	(revision 22)
+++ trunk/SOURCES/BLAS/slaset.f	(revision 22)
@@ -0,0 +1,184 @@
+*> \brief \b SLASET
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLASET + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slaset.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slaset.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slaset.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          UPLO
+*       INTEGER            LDA, M, N
+*       REAL               ALPHA, BETA
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLASET initializes an m-by-n matrix A to BETA on the diagonal and
+*> ALPHA on the offdiagonals.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] UPLO
+*> \verbatim
+*>          UPLO is CHARACTER*1
+*>          Specifies the part of the matrix A to be set.
+*>          = 'U':      Upper triangular part is set; the strictly lower
+*>                      triangular part of A is not changed.
+*>          = 'L':      Lower triangular part is set; the strictly upper
+*>                      triangular part of A is not changed.
+*>          Otherwise:  All of the matrix A is set.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] ALPHA
+*> \verbatim
+*>          ALPHA is REAL
+*>          The constant to which the offdiagonal elements are to be set.
+*> \endverbatim
+*>
+*> \param[in] BETA
+*> \verbatim
+*>          BETA is REAL
+*>          The constant to which the diagonal elements are to be set.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On exit, the leading m-by-n submatrix of A is set as follows:
+*>
+*>          if UPLO = 'U', A(i,j) = ALPHA, 1<=i<=j-1, 1<=j<=n,
+*>          if UPLO = 'L', A(i,j) = ALPHA, j+1<=i<=m, 1<=j<=n,
+*>          otherwise,     A(i,j) = ALPHA, 1<=i<=m, 1<=j<=n, i.ne.j,
+*>
+*>          and, for all UPLO, A(i,i) = BETA, 1<=i<=min(m,n).
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLASET( UPLO, M, N, ALPHA, BETA, A, LDA )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          UPLO
+      INTEGER            LDA, M, N
+      REAL               ALPHA, BETA
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Local Scalars ..
+      INTEGER            I, J
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MIN
+*     ..
+*     .. Executable Statements ..
+*
+      IF( LSAME( UPLO, 'U' ) ) THEN
+*
+*        Set the strictly upper triangular or trapezoidal part of the
+*        array to ALPHA.
+*
+         DO 20 J = 2, N
+            DO 10 I = 1, MIN( J-1, M )
+               A( I, J ) = ALPHA
+   10       CONTINUE
+   20    CONTINUE
+*
+      ELSE IF( LSAME( UPLO, 'L' ) ) THEN
+*
+*        Set the strictly lower triangular or trapezoidal part of the
+*        array to ALPHA.
+*
+         DO 40 J = 1, MIN( M, N )
+            DO 30 I = J + 1, M
+               A( I, J ) = ALPHA
+   30       CONTINUE
+   40    CONTINUE
+*
+      ELSE
+*
+*        Set the leading m-by-n submatrix to ALPHA.
+*
+         DO 60 J = 1, N
+            DO 50 I = 1, M
+               A( I, J ) = ALPHA
+   50       CONTINUE
+   60    CONTINUE
+      END IF
+*
+*     Set the first min(M,N) diagonal elements to BETA.
+*
+      DO 70 I = 1, MIN( M, N )
+         A( I, I ) = BETA
+   70 CONTINUE
+*
+      RETURN
+*
+*     End of SLASET
+*
+      END
Index: trunk/SOURCES/BLAS/slassq.f
===================================================================
--- trunk/SOURCES/BLAS/slassq.f	(revision 22)
+++ trunk/SOURCES/BLAS/slassq.f	(revision 22)
@@ -0,0 +1,151 @@
+*> \brief \b SLASSQ
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLASSQ + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slassq.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slassq.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slassq.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INCX, N
+*       REAL               SCALE, SUMSQ
+*       ..
+*       .. Array Arguments ..
+*       REAL               X( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLASSQ  returns the values  scl  and  smsq  such that
+*>
+*>    ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
+*>
+*> where  x( i ) = X( 1 + ( i - 1 )*INCX ). The value of  sumsq  is
+*> assumed to be non-negative and  scl  returns the value
+*>
+*>    scl = max( scale, abs( x( i ) ) ).
+*>
+*> scale and sumsq must be supplied in SCALE and SUMSQ and
+*> scl and smsq are overwritten on SCALE and SUMSQ respectively.
+*>
+*> The routine makes only one pass through the vector x.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of elements to be used from the vector X.
+*> \endverbatim
+*>
+*> \param[in] X
+*> \verbatim
+*>          X is REAL array, dimension (N)
+*>          The vector for which a scaled sum of squares is computed.
+*>             x( i )  = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
+*> \endverbatim
+*>
+*> \param[in] INCX
+*> \verbatim
+*>          INCX is INTEGER
+*>          The increment between successive values of the vector X.
+*>          INCX > 0.
+*> \endverbatim
+*>
+*> \param[in,out] SCALE
+*> \verbatim
+*>          SCALE is REAL
+*>          On entry, the value  scale  in the equation above.
+*>          On exit, SCALE is overwritten with  scl , the scaling factor
+*>          for the sum of squares.
+*> \endverbatim
+*>
+*> \param[in,out] SUMSQ
+*> \verbatim
+*>          SUMSQ is REAL
+*>          On entry, the value  sumsq  in the equation above.
+*>          On exit, SUMSQ is overwritten with  smsq , the basic sum of
+*>          squares from which  scl  has been factored out.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup auxOTHERauxiliary
+*
+*  =====================================================================
+      SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
+*
+*  -- LAPACK auxiliary routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INCX, N
+      REAL               SCALE, SUMSQ
+*     ..
+*     .. Array Arguments ..
+      REAL               X( * )
+*     ..
+*
+* =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            IX
+      REAL               ABSXI
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          ABS
+*     ..
+*     .. Executable Statements ..
+*
+      IF( N.GT.0 ) THEN
+         DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
+            IF( X( IX ).NE.ZERO ) THEN
+               ABSXI = ABS( X( IX ) )
+               IF( SCALE.LT.ABSXI ) THEN
+                  SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
+                  SCALE = ABSXI
+               ELSE
+                  SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
+               END IF
+            END IF
+   10    CONTINUE
+      END IF
+      RETURN
+*
+*     End of SLASSQ
+*
+      END
Index: trunk/SOURCES/BLAS/slatrz.f
===================================================================
--- trunk/SOURCES/BLAS/slatrz.f	(revision 22)
+++ trunk/SOURCES/BLAS/slatrz.f	(revision 22)
@@ -0,0 +1,200 @@
+*> \brief \b SLATRZ
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SLATRZ + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slatrz.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slatrz.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slatrz.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLATRZ( M, N, L, A, LDA, TAU, WORK )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            L, LDA, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SLATRZ factors the M-by-(M+L) real upper trapezoidal matrix
+*> [ A1 A2 ] = [ A(1:M,1:M) A(1:M,N-L+1:N) ] as ( R  0 ) * Z, by means
+*> of orthogonal transformations.  Z is an (M+L)-by-(M+L) orthogonal
+*> matrix and, R and A1 are M-by-M upper triangular matrices.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of columns of the matrix A containing the
+*>          meaningful part of the Householder vectors. N-M >= L >= 0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the leading M-by-N upper trapezoidal part of the
+*>          array A must contain the matrix to be factorized.
+*>          On exit, the leading M-by-M upper triangular part of A
+*>          contains the upper triangular matrix R, and elements N-L+1 to
+*>          N of the first M rows of A, with the array TAU, represent the
+*>          orthogonal matrix Z as a product of M elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (M)
+*>          The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (M)
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The factorization is obtained by Householder's method.  The kth
+*>  transformation matrix, Z( k ), which is used to introduce zeros into
+*>  the ( m - k + 1 )th row of A, is given in the form
+*>
+*>     Z( k ) = ( I     0   ),
+*>              ( 0  T( k ) )
+*>
+*>  where
+*>
+*>     T( k ) = I - tau*u( k )*u( k )**T,   u( k ) = (   1    ),
+*>                                                 (   0    )
+*>                                                 ( z( k ) )
+*>
+*>  tau is a scalar and z( k ) is an l element vector. tau and z( k )
+*>  are chosen to annihilate the elements of the kth row of A2.
+*>
+*>  The scalar tau is returned in the kth element of TAU and the vector
+*>  u( k ) in the kth row of A2, such that the elements of z( k ) are
+*>  in  a( k, l + 1 ), ..., a( k, n ). The elements of R are returned in
+*>  the upper triangular part of A1.
+*>
+*>  Z is given by
+*>
+*>     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLATRZ( M, N, L, A, LDA, TAU, WORK )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            L, LDA, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER            I
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARFG, SLARZ
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 ) THEN
+         RETURN
+      ELSE IF( M.EQ.N ) THEN
+         DO 10 I = 1, N
+            TAU( I ) = ZERO
+   10    CONTINUE
+         RETURN
+      END IF
+*
+      DO 20 I = M, 1, -1
+*
+*        Generate elementary reflector H(i) to annihilate
+*        [ A(i,i) A(i,n-l+1:n) ]
+*
+         CALL SLARFG( L+1, A( I, I ), A( I, N-L+1 ), LDA, TAU( I ) )
+*
+*        Apply H(i) to A(1:i-1,i:n) from the right
+*
+         CALL SLARZ( 'Right', I-1, N-I+1, L, A( I, N-L+1 ), LDA,
+     $               TAU( I ), A( 1, I ), LDA, WORK )
+*
+   20 CONTINUE
+*
+      RETURN
+*
+*     End of SLATRZ
+*
+      END
Index: trunk/SOURCES/BLAS/snrm2.f
===================================================================
--- trunk/SOURCES/BLAS/snrm2.f	(revision 22)
+++ trunk/SOURCES/BLAS/snrm2.f	(revision 22)
@@ -0,0 +1,67 @@
+      REAL FUNCTION SNRM2(N,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,N
+*     ..
+*     .. Array Arguments ..
+      REAL X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  SNRM2 returns the euclidean norm of a vector via the function
+*  name, so that
+*
+*     SNRM2 := sqrt( x'*x ).
+*
+*  Further Details
+*  ===============
+*
+*  -- This version written on 25-October-1982.
+*     Modified on 14-October-1993 to inline the call to SLASSQ.
+*     Sven Hammarling, Nag Ltd.
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL ABSXI,NORM,SCALE,SSQ
+      INTEGER IX
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC ABS,SQRT
+*     ..
+      IF (N.LT.1 .OR. INCX.LT.1) THEN
+          NORM = ZERO
+      ELSE IF (N.EQ.1) THEN
+          NORM = ABS(X(1))
+      ELSE
+          SCALE = ZERO
+          SSQ = ONE
+*        The following loop is equivalent to this call to the LAPACK
+*        auxiliary routine:
+*        CALL SLASSQ( N, X, INCX, SCALE, SSQ )
+*
+          DO 10 IX = 1,1 + (N-1)*INCX,INCX
+              IF (X(IX).NE.ZERO) THEN
+                  ABSXI = ABS(X(IX))
+                  IF (SCALE.LT.ABSXI) THEN
+                      SSQ = ONE + SSQ* (SCALE/ABSXI)**2
+                      SCALE = ABSXI
+                  ELSE
+                      SSQ = SSQ + (ABSXI/SCALE)**2
+                  END IF
+              END IF
+   10     CONTINUE
+          NORM = SCALE*SQRT(SSQ)
+      END IF
+*
+      SNRM2 = NORM
+      RETURN
+*
+*     End of SNRM2.
+*
+      END
Index: trunk/SOURCES/BLAS/sorm2r.f
===================================================================
--- trunk/SOURCES/BLAS/sorm2r.f	(revision 22)
+++ trunk/SOURCES/BLAS/sorm2r.f	(revision 22)
@@ -0,0 +1,282 @@
+*> \brief \b SORM2R
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SORM2R + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sorm2r.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sorm2r.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sorm2r.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+*                          WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE, TRANS
+*       INTEGER            INFO, K, LDA, LDC, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SORM2R overwrites the general real m by n matrix C with
+*>
+*>       Q * C  if SIDE = 'L' and TRANS = 'N', or
+*>
+*>       Q**T* C  if SIDE = 'L' and TRANS = 'T', or
+*>
+*>       C * Q  if SIDE = 'R' and TRANS = 'N', or
+*>
+*>       C * Q**T if SIDE = 'R' and TRANS = 'T',
+*>
+*> where Q is a real orthogonal matrix defined as the product of k
+*> elementary reflectors
+*>
+*>       Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by SGEQRF. Q is of order m if SIDE = 'L' and of order n
+*> if SIDE = 'R'.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left
+*>          = 'R': apply Q or Q**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': apply Q  (No transpose)
+*>          = 'T': apply Q**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          If SIDE = 'L', M >= K >= 0;
+*>          if SIDE = 'R', N >= K >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          SGEQRF in the first k columns of its array argument A.
+*>          A is modified by the routine but restored on exit.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i), as returned by SGEQRF.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the m by n matrix C.
+*>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension
+*>                                   (N) if SIDE = 'L',
+*>                                   (M) if SIDE = 'R'
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*  =====================================================================
+      SUBROUTINE SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+     $                   WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE, TRANS
+      INTEGER            INFO, K, LDA, LDC, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ONE
+      PARAMETER          ( ONE = 1.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, NOTRAN
+      INTEGER            I, I1, I2, I3, IC, JC, MI, NI, NQ
+      REAL               AII
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARF, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      LEFT = LSAME( SIDE, 'L' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*
+*     NQ is the order of Q
+*
+      IF( LEFT ) THEN
+         NQ = M
+      ELSE
+         NQ = N
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
+         INFO = -7
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SORM2R', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+     $   RETURN
+*
+      IF( ( LEFT .AND. .NOT.NOTRAN ) .OR. ( .NOT.LEFT .AND. NOTRAN ) )
+     $     THEN
+         I1 = 1
+         I2 = K
+         I3 = 1
+      ELSE
+         I1 = K
+         I2 = 1
+         I3 = -1
+      END IF
+*
+      IF( LEFT ) THEN
+         NI = N
+         JC = 1
+      ELSE
+         MI = M
+         IC = 1
+      END IF
+*
+      DO 10 I = I1, I2, I3
+         IF( LEFT ) THEN
+*
+*           H(i) is applied to C(i:m,1:n)
+*
+            MI = M - I + 1
+            IC = I
+         ELSE
+*
+*           H(i) is applied to C(1:m,i:n)
+*
+            NI = N - I + 1
+            JC = I
+         END IF
+*
+*        Apply H(i)
+*
+         AII = A( I, I )
+         A( I, I ) = ONE
+         CALL SLARF( SIDE, MI, NI, A( I, I ), 1, TAU( I ), C( IC, JC ),
+     $               LDC, WORK )
+         A( I, I ) = AII
+   10 CONTINUE
+      RETURN
+*
+*     End of SORM2R
+*
+      END
Index: trunk/SOURCES/BLAS/sormqr.f
===================================================================
--- trunk/SOURCES/BLAS/sormqr.f	(revision 22)
+++ trunk/SOURCES/BLAS/sormqr.f	(revision 22)
@@ -0,0 +1,350 @@
+*> \brief \b SORMQR
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SORMQR + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormqr.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormqr.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormqr.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+*                          WORK, LWORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE, TRANS
+*       INTEGER            INFO, K, LDA, LDC, LWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), C( LDC, * ), TAU( * ),
+*      $                   WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SORMQR overwrites the general real M-by-N matrix C with
+*>
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q * C          C * Q
+*> TRANS = 'T':      Q**T * C       C * Q**T
+*>
+*> where Q is a real orthogonal matrix defined as the product of k
+*> elementary reflectors
+*>
+*>       Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by SGEQRF. Q is of order M if SIDE = 'L' and of order N
+*> if SIDE = 'R'.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          If SIDE = 'L', M >= K >= 0;
+*>          if SIDE = 'R', N >= K >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          SGEQRF in the first k columns of its array argument A.
+*>          A is modified by the routine but restored on exit.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i), as returned by SGEQRF.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,N);
+*>          if SIDE = 'R', LWORK >= max(1,M).
+*>          For optimum performance LWORK >= N*NB if SIDE = 'L', and
+*>          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+*>          blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*  =====================================================================
+      SUBROUTINE SORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
+     $                   WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE, TRANS
+      INTEGER            INFO, K, LDA, LDC, LWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), C( LDC, * ), TAU( * ),
+     $                   WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER            NBMAX, LDT
+      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, LQUERY, NOTRAN
+      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JC, LDWORK,
+     $                   LWKOPT, MI, NB, NBMIN, NI, NQ, NW
+*     ..
+*     .. Local Arrays ..
+      REAL               T( LDT, NBMAX )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARFB, SLARFT, SORM2R, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      LEFT = LSAME( SIDE, 'L' )
+      NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     NQ is the order of Q and NW is the minimum dimension of WORK
+*
+      IF( LEFT ) THEN
+         NQ = M
+         NW = N
+      ELSE
+         NQ = N
+         NW = M
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+         INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN
+         INFO = -7
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -10
+      ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+*
+*        Determine the block size.  NB may be at most NBMAX, where NBMAX
+*        is used to define the local array T.
+*
+         NB = MIN( NBMAX, ILAENV( 1, 'SORMQR', SIDE // TRANS, M, N, K,
+     $        -1 ) )
+         LWKOPT = MAX( 1, NW )*NB
+         WORK( 1 ) = LWKOPT
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SORMQR', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) THEN
+         WORK( 1 ) = 1
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = NW
+      IF( NB.GT.1 .AND. NB.LT.K ) THEN
+         IWS = NW*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = LWORK / LDWORK
+            NBMIN = MAX( 2, ILAENV( 2, 'SORMQR', SIDE // TRANS, M, N, K,
+     $              -1 ) )
+         END IF
+      ELSE
+         IWS = NW
+      END IF
+*
+      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
+*        Use unblocked code
+*
+         CALL SORM2R( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK,
+     $                IINFO )
+      ELSE
+*
+*        Use blocked code
+*
+         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
+     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
+            I1 = 1
+            I2 = K
+            I3 = NB
+         ELSE
+            I1 = ( ( K-1 ) / NB )*NB + 1
+            I2 = 1
+            I3 = -NB
+         END IF
+*
+         IF( LEFT ) THEN
+            NI = N
+            JC = 1
+         ELSE
+            MI = M
+            IC = 1
+         END IF
+*
+         DO 10 I = I1, I2, I3
+            IB = MIN( NB, K-I+1 )
+*
+*           Form the triangular factor of the block reflector
+*           H = H(i) H(i+1) . . . H(i+ib-1)
+*
+            CALL SLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I, I ),
+     $                   LDA, TAU( I ), T, LDT )
+            IF( LEFT ) THEN
+*
+*              H or H**T is applied to C(i:m,1:n)
+*
+               MI = M - I + 1
+               IC = I
+            ELSE
+*
+*              H or H**T is applied to C(1:m,i:n)
+*
+               NI = N - I + 1
+               JC = I
+            END IF
+*
+*           Apply H or H**T
+*
+            CALL SLARFB( SIDE, TRANS, 'Forward', 'Columnwise', MI, NI,
+     $                   IB, A( I, I ), LDA, T, LDT, C( IC, JC ), LDC,
+     $                   WORK, LDWORK )
+   10    CONTINUE
+      END IF
+      WORK( 1 ) = LWKOPT
+      RETURN
+*
+*     End of SORMQR
+*
+      END
Index: trunk/SOURCES/BLAS/sormr3.f
===================================================================
--- trunk/SOURCES/BLAS/sormr3.f	(revision 22)
+++ trunk/SOURCES/BLAS/sormr3.f	(revision 22)
@@ -0,0 +1,299 @@
+*> \brief \b SORMR3
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SORMR3 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormr3.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormr3.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormr3.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
+*                          WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE, TRANS
+*       INTEGER            INFO, K, L, LDA, LDC, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SORMR3 overwrites the general real m by n matrix C with
+*>
+*>       Q * C  if SIDE = 'L' and TRANS = 'N', or
+*>
+*>       Q**T* C  if SIDE = 'L' and TRANS = 'C', or
+*>
+*>       C * Q  if SIDE = 'R' and TRANS = 'N', or
+*>
+*>       C * Q**T if SIDE = 'R' and TRANS = 'C',
+*>
+*> where Q is a real orthogonal matrix defined as the product of k
+*> elementary reflectors
+*>
+*>       Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by STZRZF. Q is of order m if SIDE = 'L' and of order n
+*> if SIDE = 'R'.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left
+*>          = 'R': apply Q or Q**T from the Right
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': apply Q  (No transpose)
+*>          = 'T': apply Q**T (Transpose)
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          If SIDE = 'L', M >= K >= 0;
+*>          if SIDE = 'R', N >= K >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of columns of the matrix A containing
+*>          the meaningful part of the Householder reflectors.
+*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension
+*>                               (LDA,M) if SIDE = 'L',
+*>                               (LDA,N) if SIDE = 'R'
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          STZRZF in the last k rows of its array argument A.
+*>          A is modified by the routine but restored on exit.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,K).
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i), as returned by STZRZF.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the m-by-n matrix C.
+*>          On exit, C is overwritten by Q*C or Q**T*C or C*Q**T or C*Q.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension
+*>                                   (N) if SIDE = 'L',
+*>                                   (M) if SIDE = 'R'
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0: successful exit
+*>          < 0: if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
+     $                   WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE, TRANS
+      INTEGER            INFO, K, L, LDA, LDC, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Local Scalars ..
+      LOGICAL            LEFT, NOTRAN
+      INTEGER            I, I1, I2, I3, IC, JA, JC, MI, NI, NQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARZ, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      LEFT = LSAME( SIDE, 'L' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*
+*     NQ is the order of Q
+*
+      IF( LEFT ) THEN
+         NQ = M
+      ELSE
+         NQ = N
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
+     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
+         INFO = -6
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+         INFO = -8
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SORMR3', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 )
+     $   RETURN
+*
+      IF( ( LEFT .AND. .NOT.NOTRAN .OR. .NOT.LEFT .AND. NOTRAN ) ) THEN
+         I1 = 1
+         I2 = K
+         I3 = 1
+      ELSE
+         I1 = K
+         I2 = 1
+         I3 = -1
+      END IF
+*
+      IF( LEFT ) THEN
+         NI = N
+         JA = M - L + 1
+         JC = 1
+      ELSE
+         MI = M
+         JA = N - L + 1
+         IC = 1
+      END IF
+*
+      DO 10 I = I1, I2, I3
+         IF( LEFT ) THEN
+*
+*           H(i) or H(i)**T is applied to C(i:m,1:n)
+*
+            MI = M - I + 1
+            IC = I
+         ELSE
+*
+*           H(i) or H(i)**T is applied to C(1:m,i:n)
+*
+            NI = N - I + 1
+            JC = I
+         END IF
+*
+*        Apply H(i) or H(i)**T
+*
+         CALL SLARZ( SIDE, MI, NI, L, A( I, JA ), LDA, TAU( I ),
+     $               C( IC, JC ), LDC, WORK )
+*
+   10 CONTINUE
+*
+      RETURN
+*
+*     End of SORMR3
+*
+      END
Index: trunk/SOURCES/BLAS/sormrz.f
===================================================================
--- trunk/SOURCES/BLAS/sormrz.f	(revision 22)
+++ trunk/SOURCES/BLAS/sormrz.f	(revision 22)
@@ -0,0 +1,388 @@
+*> \brief \b SORMRZ
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download SORMRZ + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sormrz.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sormrz.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sormrz.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
+*                          WORK, LWORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          SIDE, TRANS
+*       INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SORMRZ overwrites the general real M-by-N matrix C with
+*>
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q * C          C * Q
+*> TRANS = 'T':      Q**T * C       C * Q**T
+*>
+*> where Q is a real orthogonal matrix defined as the product of k
+*> elementary reflectors
+*>
+*>       Q = H(1) H(2) . . . H(k)
+*>
+*> as returned by STZRZF. Q is of order M if SIDE = 'L' and of order N
+*> if SIDE = 'R'.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix C. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix C. N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          If SIDE = 'L', M >= K >= 0;
+*>          if SIDE = 'R', N >= K >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of columns of the matrix A containing
+*>          the meaningful part of the Householder reflectors.
+*>          If SIDE = 'L', M >= L >= 0, if SIDE = 'R', N >= L >= 0.
+*> \endverbatim
+*>
+*> \param[in] A
+*> \verbatim
+*>          A is REAL array, dimension
+*>                               (LDA,M) if SIDE = 'L',
+*>                               (LDA,N) if SIDE = 'R'
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          STZRZF in the last k rows of its array argument A.
+*>          A is modified by the routine but restored on exit.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. LDA >= max(1,K).
+*> \endverbatim
+*>
+*> \param[in] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (K)
+*>          TAU(i) must contain the scalar factor of the elementary
+*>          reflector H(i), as returned by STZRZF.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is REAL array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q.
+*> \endverbatim
+*>
+*> \param[in] LDC
+*> \verbatim
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,N);
+*>          if SIDE = 'R', LWORK >= max(1,M).
+*>          For optimum performance LWORK >= N*NB if SIDE = 'L', and
+*>          LWORK >= M*NB if SIDE = 'R', where NB is the optimal
+*>          blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SORMRZ( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
+     $                   WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      CHARACTER          SIDE, TRANS
+      INTEGER            INFO, K, L, LDA, LDC, LWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), C( LDC, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      INTEGER            NBMAX, LDT
+      PARAMETER          ( NBMAX = 64, LDT = NBMAX+1 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, LQUERY, NOTRAN
+      CHARACTER          TRANST
+      INTEGER            I, I1, I2, I3, IB, IC, IINFO, IWS, JA, JC,
+     $                   LDWORK, LWKOPT, MI, NB, NBMIN, NI, NQ, NW
+*     ..
+*     .. Local Arrays ..
+      REAL               T( LDT, NBMAX )
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      EXTERNAL           LSAME, ILAENV
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SLARZB, SLARZT, SORMR3, XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      LEFT = LSAME( SIDE, 'L' )
+      NOTRAN = LSAME( TRANS, 'N' )
+      LQUERY = ( LWORK.EQ.-1 )
+*
+*     NQ is the order of Q and NW is the minimum dimension of WORK
+*
+      IF( LEFT ) THEN
+         NQ = M
+         NW = MAX( 1, N )
+      ELSE
+         NQ = N
+         NW = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN
+         INFO = -1
+      ELSE IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 .OR. K.GT.NQ ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. ( LEFT .AND. ( L.GT.M ) ) .OR.
+     $         ( .NOT.LEFT .AND. ( L.GT.N ) ) ) THEN
+         INFO = -6
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+         INFO = -8
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( M.EQ.0 .OR. N.EQ.0 ) THEN
+            LWKOPT = 1
+         ELSE
+*
+*           Determine the block size.  NB may be at most NBMAX, where
+*           NBMAX is used to define the local array T.
+*
+            NB = MIN( NBMAX, ILAENV( 1, 'SORMRQ', SIDE // TRANS, M, N,
+     $                               K, -1 ) )
+            LWKOPT = NW*NB
+         END IF
+         WORK( 1 ) = LWKOPT
+*
+         IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN
+            INFO = -13
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SORMRZ', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 ) THEN
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      LDWORK = NW
+      IF( NB.GT.1 .AND. NB.LT.K ) THEN
+         IWS = NW*NB
+         IF( LWORK.LT.IWS ) THEN
+            NB = LWORK / LDWORK
+            NBMIN = MAX( 2, ILAENV( 2, 'SORMRQ', SIDE // TRANS, M, N, K,
+     $              -1 ) )
+         END IF
+      ELSE
+         IWS = NW
+      END IF
+*
+      IF( NB.LT.NBMIN .OR. NB.GE.K ) THEN
+*
+*        Use unblocked code
+*
+         CALL SORMR3( SIDE, TRANS, M, N, K, L, A, LDA, TAU, C, LDC,
+     $                WORK, IINFO )
+      ELSE
+*
+*        Use blocked code
+*
+         IF( ( LEFT .AND. .NOT.NOTRAN ) .OR.
+     $       ( .NOT.LEFT .AND. NOTRAN ) ) THEN
+            I1 = 1
+            I2 = K
+            I3 = NB
+         ELSE
+            I1 = ( ( K-1 ) / NB )*NB + 1
+            I2 = 1
+            I3 = -NB
+         END IF
+*
+         IF( LEFT ) THEN
+            NI = N
+            JC = 1
+            JA = M - L + 1
+         ELSE
+            MI = M
+            IC = 1
+            JA = N - L + 1
+         END IF
+*
+         IF( NOTRAN ) THEN
+            TRANST = 'T'
+         ELSE
+            TRANST = 'N'
+         END IF
+*
+         DO 10 I = I1, I2, I3
+            IB = MIN( NB, K-I+1 )
+*
+*           Form the triangular factor of the block reflector
+*           H = H(i+ib-1) . . . H(i+1) H(i)
+*
+            CALL SLARZT( 'Backward', 'Rowwise', L, IB, A( I, JA ), LDA,
+     $                   TAU( I ), T, LDT )
+*
+            IF( LEFT ) THEN
+*
+*              H or H**T is applied to C(i:m,1:n)
+*
+               MI = M - I + 1
+               IC = I
+            ELSE
+*
+*              H or H**T is applied to C(1:m,i:n)
+*
+               NI = N - I + 1
+               JC = I
+            END IF
+*
+*           Apply H or H**T
+*
+            CALL SLARZB( SIDE, TRANST, 'Backward', 'Rowwise', MI, NI,
+     $                   IB, L, A( I, JA ), LDA, T, LDT, C( IC, JC ),
+     $                   LDC, WORK, LDWORK )
+   10    CONTINUE
+*
+      END IF
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of SORMRZ
+*
+      END
Index: trunk/SOURCES/BLAS/strmm.f
===================================================================
--- trunk/SOURCES/BLAS/strmm.f	(revision 22)
+++ trunk/SOURCES/BLAS/strmm.f	(revision 22)
@@ -0,0 +1,349 @@
+      SUBROUTINE STRMM(SIDE,UPLO,TRANSA,DIAG,M,N,ALPHA,A,LDA,B,LDB)
+*     .. Scalar Arguments ..
+      REAL ALPHA
+      INTEGER LDA,LDB,M,N
+      CHARACTER DIAG,SIDE,TRANSA,UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),B(LDB,*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  STRMM  performs one of the matrix-matrix operations
+*
+*     B := alpha*op( A )*B,   or   B := alpha*B*op( A ),
+*
+*  where  alpha  is a scalar,  B  is an m by n matrix,  A  is a unit, or
+*  non-unit,  upper or lower triangular matrix  and  op( A )  is one  of
+*
+*     op( A ) = A   or   op( A ) = A**T.
+*
+*  Arguments
+*  ==========
+*
+*  SIDE   - CHARACTER*1.
+*           On entry,  SIDE specifies whether  op( A ) multiplies B from
+*           the left or right as follows:
+*
+*              SIDE = 'L' or 'l'   B := alpha*op( A )*B.
+*
+*              SIDE = 'R' or 'r'   B := alpha*B*op( A ).
+*
+*           Unchanged on exit.
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix A is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANSA - CHARACTER*1.
+*           On entry, TRANSA specifies the form of op( A ) to be used in
+*           the matrix multiplication as follows:
+*
+*              TRANSA = 'N' or 'n'   op( A ) = A.
+*
+*              TRANSA = 'T' or 't'   op( A ) = A**T.
+*
+*              TRANSA = 'C' or 'c'   op( A ) = A**T.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit triangular
+*           as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  M      - INTEGER.
+*           On entry, M specifies the number of rows of B. M must be at
+*           least zero.
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the number of columns of B.  N must be
+*           at least zero.
+*           Unchanged on exit.
+*
+*  ALPHA  - REAL            .
+*           On entry,  ALPHA specifies the scalar  alpha. When  alpha is
+*           zero then  A is not referenced and  B need not be set before
+*           entry.
+*           Unchanged on exit.
+*
+*  A      - REAL             array of DIMENSION ( LDA, k ), where k is m
+*           when  SIDE = 'L' or 'l'  and is  n  when  SIDE = 'R' or 'r'.
+*           Before entry  with  UPLO = 'U' or 'u',  the  leading  k by k
+*           upper triangular part of the array  A must contain the upper
+*           triangular matrix  and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry  with  UPLO = 'L' or 'l',  the  leading  k by k
+*           lower triangular part of the array  A must contain the lower
+*           triangular matrix  and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u',  the diagonal elements of
+*           A  are not referenced either,  but are assumed to be  unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program.  When  SIDE = 'L' or 'l'  then
+*           LDA  must be at least  max( 1, m ),  when  SIDE = 'R' or 'r'
+*           then LDA must be at least max( 1, n ).
+*           Unchanged on exit.
+*
+*  B      - REAL             array of DIMENSION ( LDB, n ).
+*           Before entry,  the leading  m by n part of the array  B must
+*           contain the matrix  B,  and  on exit  is overwritten  by the
+*           transformed matrix.
+*
+*  LDB    - INTEGER.
+*           On entry, LDB specifies the first dimension of B as declared
+*           in  the  calling  (sub)  program.   LDB  must  be  at  least
+*           max( 1, m ).
+*           Unchanged on exit.
+*
+*  Further Details
+*  ===============
+*
+*  Level 3 Blas routine.
+*
+*  -- Written on 8-February-1989.
+*     Jack Dongarra, Argonne National Laboratory.
+*     Iain Duff, AERE Harwell.
+*     Jeremy Du Croz, Numerical Algorithms Group Ltd.
+*     Sven Hammarling, Numerical Algorithms Group Ltd.
+*
+*  =====================================================================
+*
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,J,K,NROWA
+      LOGICAL LSIDE,NOUNIT,UPPER
+*     ..
+*     .. Parameters ..
+      REAL ONE,ZERO
+      PARAMETER (ONE=1.0E+0,ZERO=0.0E+0)
+*     ..
+*
+*     Test the input parameters.
+*
+      LSIDE = LSAME(SIDE,'L')
+      IF (LSIDE) THEN
+          NROWA = M
+      ELSE
+          NROWA = N
+      END IF
+      NOUNIT = LSAME(DIAG,'N')
+      UPPER = LSAME(UPLO,'U')
+*
+      INFO = 0
+      IF ((.NOT.LSIDE) .AND. (.NOT.LSAME(SIDE,'R'))) THEN
+          INFO = 1
+      ELSE IF ((.NOT.UPPER) .AND. (.NOT.LSAME(UPLO,'L'))) THEN
+          INFO = 2
+      ELSE IF ((.NOT.LSAME(TRANSA,'N')) .AND.
+     +         (.NOT.LSAME(TRANSA,'T')) .AND.
+     +         (.NOT.LSAME(TRANSA,'C'))) THEN
+          INFO = 3
+      ELSE IF ((.NOT.LSAME(DIAG,'U')) .AND. (.NOT.LSAME(DIAG,'N'))) THEN
+          INFO = 4
+      ELSE IF (M.LT.0) THEN
+          INFO = 5
+      ELSE IF (N.LT.0) THEN
+          INFO = 6
+      ELSE IF (LDA.LT.MAX(1,NROWA)) THEN
+          INFO = 9
+      ELSE IF (LDB.LT.MAX(1,M)) THEN
+          INFO = 11
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('STRMM ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (M.EQ.0 .OR. N.EQ.0) RETURN
+*
+*     And when  alpha.eq.zero.
+*
+      IF (ALPHA.EQ.ZERO) THEN
+          DO 20 J = 1,N
+              DO 10 I = 1,M
+                  B(I,J) = ZERO
+   10         CONTINUE
+   20     CONTINUE
+          RETURN
+      END IF
+*
+*     Start the operations.
+*
+      IF (LSIDE) THEN
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*A*B.
+*
+              IF (UPPER) THEN
+                  DO 50 J = 1,N
+                      DO 40 K = 1,M
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              DO 30 I = 1,K - 1
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   30                         CONTINUE
+                              IF (NOUNIT) TEMP = TEMP*A(K,K)
+                              B(K,J) = TEMP
+                          END IF
+   40                 CONTINUE
+   50             CONTINUE
+              ELSE
+                  DO 80 J = 1,N
+                      DO 70 K = M,1,-1
+                          IF (B(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*B(K,J)
+                              B(K,J) = TEMP
+                              IF (NOUNIT) B(K,J) = B(K,J)*A(K,K)
+                              DO 60 I = K + 1,M
+                                  B(I,J) = B(I,J) + TEMP*A(I,K)
+   60                         CONTINUE
+                          END IF
+   70                 CONTINUE
+   80             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*A**T*B.
+*
+              IF (UPPER) THEN
+                  DO 110 J = 1,N
+                      DO 100 I = M,1,-1
+                          TEMP = B(I,J)
+                          IF (NOUNIT) TEMP = TEMP*A(I,I)
+                          DO 90 K = 1,I - 1
+                              TEMP = TEMP + A(K,I)*B(K,J)
+   90                     CONTINUE
+                          B(I,J) = ALPHA*TEMP
+  100                 CONTINUE
+  110             CONTINUE
+              ELSE
+                  DO 140 J = 1,N
+                      DO 130 I = 1,M
+                          TEMP = B(I,J)
+                          IF (NOUNIT) TEMP = TEMP*A(I,I)
+                          DO 120 K = I + 1,M
+                              TEMP = TEMP + A(K,I)*B(K,J)
+  120                     CONTINUE
+                          B(I,J) = ALPHA*TEMP
+  130                 CONTINUE
+  140             CONTINUE
+              END IF
+          END IF
+      ELSE
+          IF (LSAME(TRANSA,'N')) THEN
+*
+*           Form  B := alpha*B*A.
+*
+              IF (UPPER) THEN
+                  DO 180 J = N,1,-1
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 150 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  150                 CONTINUE
+                      DO 170 K = 1,J - 1
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 160 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  160                         CONTINUE
+                          END IF
+  170                 CONTINUE
+  180             CONTINUE
+              ELSE
+                  DO 220 J = 1,N
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 190 I = 1,M
+                          B(I,J) = TEMP*B(I,J)
+  190                 CONTINUE
+                      DO 210 K = J + 1,N
+                          IF (A(K,J).NE.ZERO) THEN
+                              TEMP = ALPHA*A(K,J)
+                              DO 200 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  200                         CONTINUE
+                          END IF
+  210                 CONTINUE
+  220             CONTINUE
+              END IF
+          ELSE
+*
+*           Form  B := alpha*B*A**T.
+*
+              IF (UPPER) THEN
+                  DO 260 K = 1,N
+                      DO 240 J = 1,K - 1
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = ALPHA*A(J,K)
+                              DO 230 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  230                         CONTINUE
+                          END IF
+  240                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(K,K)
+                      IF (TEMP.NE.ONE) THEN
+                          DO 250 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  250                     CONTINUE
+                      END IF
+  260             CONTINUE
+              ELSE
+                  DO 300 K = N,1,-1
+                      DO 280 J = K + 1,N
+                          IF (A(J,K).NE.ZERO) THEN
+                              TEMP = ALPHA*A(J,K)
+                              DO 270 I = 1,M
+                                  B(I,J) = B(I,J) + TEMP*B(I,K)
+  270                         CONTINUE
+                          END IF
+  280                 CONTINUE
+                      TEMP = ALPHA
+                      IF (NOUNIT) TEMP = TEMP*A(K,K)
+                      IF (TEMP.NE.ONE) THEN
+                          DO 290 I = 1,M
+                              B(I,K) = TEMP*B(I,K)
+  290                     CONTINUE
+                      END IF
+  300             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of STRMM .
+*
+      END
Index: trunk/SOURCES/BLAS/strmv.f
===================================================================
--- trunk/SOURCES/BLAS/strmv.f	(revision 22)
+++ trunk/SOURCES/BLAS/strmv.f	(revision 22)
@@ -0,0 +1,282 @@
+      SUBROUTINE STRMV(UPLO,TRANS,DIAG,N,A,LDA,X,INCX)
+*     .. Scalar Arguments ..
+      INTEGER INCX,LDA,N
+      CHARACTER DIAG,TRANS,UPLO
+*     ..
+*     .. Array Arguments ..
+      REAL A(LDA,*),X(*)
+*     ..
+*
+*  Purpose
+*  =======
+*
+*  STRMV  performs one of the matrix-vector operations
+*
+*     x := A*x,   or   x := A**T*x,
+*
+*  where x is an n element vector and  A is an n by n unit, or non-unit,
+*  upper or lower triangular matrix.
+*
+*  Arguments
+*  ==========
+*
+*  UPLO   - CHARACTER*1.
+*           On entry, UPLO specifies whether the matrix is an upper or
+*           lower triangular matrix as follows:
+*
+*              UPLO = 'U' or 'u'   A is an upper triangular matrix.
+*
+*              UPLO = 'L' or 'l'   A is a lower triangular matrix.
+*
+*           Unchanged on exit.
+*
+*  TRANS  - CHARACTER*1.
+*           On entry, TRANS specifies the operation to be performed as
+*           follows:
+*
+*              TRANS = 'N' or 'n'   x := A*x.
+*
+*              TRANS = 'T' or 't'   x := A**T*x.
+*
+*              TRANS = 'C' or 'c'   x := A**T*x.
+*
+*           Unchanged on exit.
+*
+*  DIAG   - CHARACTER*1.
+*           On entry, DIAG specifies whether or not A is unit
+*           triangular as follows:
+*
+*              DIAG = 'U' or 'u'   A is assumed to be unit triangular.
+*
+*              DIAG = 'N' or 'n'   A is not assumed to be unit
+*                                  triangular.
+*
+*           Unchanged on exit.
+*
+*  N      - INTEGER.
+*           On entry, N specifies the order of the matrix A.
+*           N must be at least zero.
+*           Unchanged on exit.
+*
+*  A      - REAL             array of DIMENSION ( LDA, n ).
+*           Before entry with  UPLO = 'U' or 'u', the leading n by n
+*           upper triangular part of the array A must contain the upper
+*           triangular matrix and the strictly lower triangular part of
+*           A is not referenced.
+*           Before entry with UPLO = 'L' or 'l', the leading n by n
+*           lower triangular part of the array A must contain the lower
+*           triangular matrix and the strictly upper triangular part of
+*           A is not referenced.
+*           Note that when  DIAG = 'U' or 'u', the diagonal elements of
+*           A are not referenced either, but are assumed to be unity.
+*           Unchanged on exit.
+*
+*  LDA    - INTEGER.
+*           On entry, LDA specifies the first dimension of A as declared
+*           in the calling (sub) program. LDA must be at least
+*           max( 1, n ).
+*           Unchanged on exit.
+*
+*  X      - REAL             array of dimension at least
+*           ( 1 + ( n - 1 )*abs( INCX ) ).
+*           Before entry, the incremented array X must contain the n
+*           element vector x. On exit, X is overwritten with the
+*           tranformed vector x.
+*
+*  INCX   - INTEGER.
+*           On entry, INCX specifies the increment for the elements of
+*           X. INCX must not be zero.
+*           Unchanged on exit.
+*
+*  Further Details
+*  ===============
+*
+*  Level 2 Blas routine.
+*  The vector and matrix arguments are not referenced when N = 0, or M = 0
+*
+*  -- Written on 22-October-1986.
+*     Jack Dongarra, Argonne National Lab.
+*     Jeremy Du Croz, Nag Central Office.
+*     Sven Hammarling, Nag Central Office.
+*     Richard Hanson, Sandia National Labs.
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL ZERO
+      PARAMETER (ZERO=0.0E+0)
+*     ..
+*     .. Local Scalars ..
+      REAL TEMP
+      INTEGER I,INFO,IX,J,JX,KX
+      LOGICAL NOUNIT
+*     ..
+*     .. External Functions ..
+      LOGICAL LSAME
+      EXTERNAL LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL XERBLA
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC MAX
+*     ..
+*
+*     Test the input parameters.
+*
+      INFO = 0
+      IF (.NOT.LSAME(UPLO,'U') .AND. .NOT.LSAME(UPLO,'L')) THEN
+          INFO = 1
+      ELSE IF (.NOT.LSAME(TRANS,'N') .AND. .NOT.LSAME(TRANS,'T') .AND.
+     +         .NOT.LSAME(TRANS,'C')) THEN
+          INFO = 2
+      ELSE IF (.NOT.LSAME(DIAG,'U') .AND. .NOT.LSAME(DIAG,'N')) THEN
+          INFO = 3
+      ELSE IF (N.LT.0) THEN
+          INFO = 4
+      ELSE IF (LDA.LT.MAX(1,N)) THEN
+          INFO = 6
+      ELSE IF (INCX.EQ.0) THEN
+          INFO = 8
+      END IF
+      IF (INFO.NE.0) THEN
+          CALL XERBLA('STRMV ',INFO)
+          RETURN
+      END IF
+*
+*     Quick return if possible.
+*
+      IF (N.EQ.0) RETURN
+*
+      NOUNIT = LSAME(DIAG,'N')
+*
+*     Set up the start point in X if the increment is not unity. This
+*     will be  ( N - 1 )*INCX  too small for descending loops.
+*
+      IF (INCX.LE.0) THEN
+          KX = 1 - (N-1)*INCX
+      ELSE IF (INCX.NE.1) THEN
+          KX = 1
+      END IF
+*
+*     Start the operations. In this version the elements of A are
+*     accessed sequentially with one pass through A.
+*
+      IF (LSAME(TRANS,'N')) THEN
+*
+*        Form  x := A*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 20 J = 1,N
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 10 I = 1,J - 1
+                              X(I) = X(I) + TEMP*A(I,J)
+   10                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   20             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 40 J = 1,N
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 30 I = 1,J - 1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX + INCX
+   30                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX + INCX
+   40             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 60 J = N,1,-1
+                      IF (X(J).NE.ZERO) THEN
+                          TEMP = X(J)
+                          DO 50 I = N,J + 1,-1
+                              X(I) = X(I) + TEMP*A(I,J)
+   50                     CONTINUE
+                          IF (NOUNIT) X(J) = X(J)*A(J,J)
+                      END IF
+   60             CONTINUE
+              ELSE
+                  KX = KX + (N-1)*INCX
+                  JX = KX
+                  DO 80 J = N,1,-1
+                      IF (X(JX).NE.ZERO) THEN
+                          TEMP = X(JX)
+                          IX = KX
+                          DO 70 I = N,J + 1,-1
+                              X(IX) = X(IX) + TEMP*A(I,J)
+                              IX = IX - INCX
+   70                     CONTINUE
+                          IF (NOUNIT) X(JX) = X(JX)*A(J,J)
+                      END IF
+                      JX = JX - INCX
+   80             CONTINUE
+              END IF
+          END IF
+      ELSE
+*
+*        Form  x := A**T*x.
+*
+          IF (LSAME(UPLO,'U')) THEN
+              IF (INCX.EQ.1) THEN
+                  DO 100 J = N,1,-1
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 90 I = J - 1,1,-1
+                          TEMP = TEMP + A(I,J)*X(I)
+   90                 CONTINUE
+                      X(J) = TEMP
+  100             CONTINUE
+              ELSE
+                  JX = KX + (N-1)*INCX
+                  DO 120 J = N,1,-1
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 110 I = J - 1,1,-1
+                          IX = IX - INCX
+                          TEMP = TEMP + A(I,J)*X(IX)
+  110                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX - INCX
+  120             CONTINUE
+              END IF
+          ELSE
+              IF (INCX.EQ.1) THEN
+                  DO 140 J = 1,N
+                      TEMP = X(J)
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 130 I = J + 1,N
+                          TEMP = TEMP + A(I,J)*X(I)
+  130                 CONTINUE
+                      X(J) = TEMP
+  140             CONTINUE
+              ELSE
+                  JX = KX
+                  DO 160 J = 1,N
+                      TEMP = X(JX)
+                      IX = JX
+                      IF (NOUNIT) TEMP = TEMP*A(J,J)
+                      DO 150 I = J + 1,N
+                          IX = IX + INCX
+                          TEMP = TEMP + A(I,J)*X(IX)
+  150                 CONTINUE
+                      X(JX) = TEMP
+                      JX = JX + INCX
+  160             CONTINUE
+              END IF
+          END IF
+      END IF
+*
+      RETURN
+*
+*     End of STRMV .
+*
+      END
Index: trunk/SOURCES/BLAS/stzrzf.f
===================================================================
--- trunk/SOURCES/BLAS/stzrzf.f	(revision 22)
+++ trunk/SOURCES/BLAS/stzrzf.f	(revision 22)
@@ -0,0 +1,322 @@
+*> \brief \b STZRZF
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download STZRZF + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stzrzf.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stzrzf.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stzrzf.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE STZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER            INFO, LDA, LWORK, M, N
+*       ..
+*       .. Array Arguments ..
+*       REAL               A( LDA, * ), TAU( * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> STZRZF reduces the M-by-N ( M<=N ) real upper trapezoidal matrix A
+*> to upper triangular form by means of orthogonal transformations.
+*>
+*> The upper trapezoidal matrix A is factored as
+*>
+*>    A = ( R  0 ) * Z,
+*>
+*> where Z is an N-by-N orthogonal matrix and R is an M-by-M upper
+*> triangular matrix.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix A.  N >= M.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the leading M-by-N upper trapezoidal part of the
+*>          array A must contain the matrix to be factorized.
+*>          On exit, the leading M-by-M upper triangular part of A
+*>          contains the upper triangular matrix R, and elements M+1 to
+*>          N of the first M rows of A, with the array TAU, represent the
+*>          orthogonal matrix Z as a product of M elementary reflectors.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] TAU
+*> \verbatim
+*>          TAU is REAL array, dimension (M)
+*>          The scalar factors of the elementary reflectors.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.  LWORK >= max(1,M).
+*>          For optimum performance LWORK >= M*NB, where NB is
+*>          the optimal blocksize.
+*>
+*>          If LWORK = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK array, returns
+*>          this value as the first entry of the WORK array, and no error
+*>          message related to LWORK is issued by XERBLA.
+*> \endverbatim
+*>
+*> \param[out] INFO
+*> \verbatim
+*>          INFO is INTEGER
+*>          = 0:  successful exit
+*>          < 0:  if INFO = -i, the i-th argument had an illegal value
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup realOTHERcomputational
+*
+*> \par Contributors:
+*  ==================
+*>
+*>    A. Petitet, Computer Science Dept., Univ. of Tenn., Knoxville, USA
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The factorization is obtained by Householder's method.  The kth
+*>  transformation matrix, Z( k ), which is used to introduce zeros into
+*>  the ( m - k + 1 )th row of A, is given in the form
+*>
+*>     Z( k ) = ( I     0   ),
+*>              ( 0  T( k ) )
+*>
+*>  where
+*>
+*>     T( k ) = I - tau*u( k )*u( k )**T,   u( k ) = (   1    ),
+*>                                                 (   0    )
+*>                                                 ( z( k ) )
+*>
+*>  tau is a scalar and z( k ) is an ( n - m ) element vector.
+*>  tau and z( k ) are chosen to annihilate the elements of the kth row
+*>  of X.
+*>
+*>  The scalar tau is returned in the kth element of TAU and the vector
+*>  u( k ) in the kth row of A, such that the elements of z( k ) are
+*>  in  a( k, m + 1 ), ..., a( k, n ). The elements of R are returned in
+*>  the upper triangular part of A.
+*>
+*>  Z is given by
+*>
+*>     Z =  Z( 1 ) * Z( 2 ) * ... * Z( m ).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE STZRZF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2011
+*
+*     .. Scalar Arguments ..
+      INTEGER            INFO, LDA, LWORK, M, N
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), TAU( * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO
+      PARAMETER          ( ZERO = 0.0E+0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY
+      INTEGER            I, IB, IWS, KI, KK, LDWORK, LWKMIN, LWKOPT,
+     $                   M1, MU, NB, NBMIN, NX
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, SLARZB, SLARZT, SLATRZ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. External Functions ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      INFO = 0
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( M.LT.0 ) THEN
+         INFO = -1
+      ELSE IF( N.LT.M ) THEN
+         INFO = -2
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -4
+      END IF
+*
+      IF( INFO.EQ.0 ) THEN
+         IF( M.EQ.0 .OR. M.EQ.N ) THEN
+            LWKOPT = 1
+            LWKMIN = 1
+         ELSE
+*
+*           Determine the block size.
+*
+            NB = ILAENV( 1, 'SGERQF', ' ', M, N, -1, -1 )
+            LWKOPT = M*NB
+            LWKMIN = MAX( 1, M )
+         END IF
+         WORK( 1 ) = LWKOPT
+*
+         IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY ) THEN
+            INFO = -7
+         END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'STZRZF', -INFO )
+         RETURN
+      ELSE IF( LQUERY ) THEN
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 ) THEN
+         RETURN
+      ELSE IF( M.EQ.N ) THEN
+         DO 10 I = 1, N
+            TAU( I ) = ZERO
+   10    CONTINUE
+         RETURN
+      END IF
+*
+      NBMIN = 2
+      NX = 1
+      IWS = M
+      IF( NB.GT.1 .AND. NB.LT.M ) THEN
+*
+*        Determine when to cross over from blocked to unblocked code.
+*
+         NX = MAX( 0, ILAENV( 3, 'SGERQF', ' ', M, N, -1, -1 ) )
+         IF( NX.LT.M ) THEN
+*
+*           Determine if workspace is large enough for blocked code.
+*
+            LDWORK = M
+            IWS = LDWORK*NB
+            IF( LWORK.LT.IWS ) THEN
+*
+*              Not enough workspace to use optimal NB:  reduce NB and
+*              determine the minimum value of NB.
+*
+               NB = LWORK / LDWORK
+               NBMIN = MAX( 2, ILAENV( 2, 'SGERQF', ' ', M, N, -1,
+     $                 -1 ) )
+            END IF
+         END IF
+      END IF
+*
+      IF( NB.GE.NBMIN .AND. NB.LT.M .AND. NX.LT.M ) THEN
+*
+*        Use blocked code initially.
+*        The last kk rows are handled by the block method.
+*
+         M1 = MIN( M+1, N )
+         KI = ( ( M-NX-1 ) / NB )*NB
+         KK = MIN( M, KI+NB )
+*
+         DO 20 I = M - KK + KI + 1, M - KK + 1, -NB
+            IB = MIN( M-I+1, NB )
+*
+*           Compute the TZ factorization of the current block
+*           A(i:i+ib-1,i:n)
+*
+            CALL SLATRZ( IB, N-I+1, N-M, A( I, I ), LDA, TAU( I ),
+     $                   WORK )
+            IF( I.GT.1 ) THEN
+*
+*              Form the triangular factor of the block reflector
+*              H = H(i+ib-1) . . . H(i+1) H(i)
+*
+               CALL SLARZT( 'Backward', 'Rowwise', N-M, IB, A( I, M1 ),
+     $                      LDA, TAU( I ), WORK, LDWORK )
+*
+*              Apply H to A(1:i-1,i:n) from the right
+*
+               CALL SLARZB( 'Right', 'No transpose', 'Backward',
+     $                      'Rowwise', I-1, N-I+1, IB, N-M, A( I, M1 ),
+     $                      LDA, WORK, LDWORK, A( 1, I ), LDA,
+     $                      WORK( IB+1 ), LDWORK )
+            END IF
+   20    CONTINUE
+         MU = I + NB - 1
+      ELSE
+         MU = M
+      END IF
+*
+*     Use unblocked code to factor the last or only block
+*
+      IF( MU.GT.0 )
+     $   CALL SLATRZ( MU, N, N-M, A, LDA, TAU, WORK )
+*
+      WORK( 1 ) = LWKOPT
+*
+      RETURN
+*
+*     End of STZRZF
+*
+      END
Index: trunk/SOURCES/Fichiers-parametres/Makefile.dmr-lsce3027.inc
===================================================================
--- trunk/SOURCES/Fichiers-parametres/Makefile.dmr-lsce3027.inc	(revision 22)
+++ trunk/SOURCES/Fichiers-parametres/Makefile.dmr-lsce3027.inc	(revision 22)
@@ -0,0 +1,50 @@
+# Makefile de GRISLI - compilo et options pour Cat (pc-226)
+# FT options de compilation
+# LK options de link
+
+# Rappel de quelques options interessantes
+#-------------------------------------------
+# faire imperativement attention a l'arithmetique
+# -fpe0 s'arrete sur les floating point exception (sauf underflow)
+# -CB  Performs run-time checking on array subscript and character substring expressions
+# -g pour debug 
+# -pg pour le profiling
+# -traceback permet de connaitre la ligne qui plante
+
+# faire man ifort pour plus d'infos
+
+# le directory dans lequel sont les compilateurs et MKL
+# DIRLOCAL=/usr/local variable d'environnement a definir dans .bash_profile
+
+debug ?= 0
+
+# lit le nom du fichier param pour lancer sur r2d2 par une commande :   echo jobparam | LBQ....
+
+JOB = 'job'
+
+LIBSYS = /usr/lib
+INCSYS = /usr/include
+
+# librairies
+
+NCDF_INC  = $(INCSYS)
+NCDF_LIB  = -L$(LIBSYS) -lnetcdff -lnetcdf
+
+IFORT= gfortran
+
+ARITHMi    = -O2 -ffree-line-length-none -mtune=native -mfpmath=sse
+
+ifeq ($(debug), 1)
+    ARITHM  = $(ARITHMi) -g -pg -Wall -fno-align-commons -p -ggdb -ffpe-trap=invalid,zero,overflow,underflow -fbacktrace -fcheck=all
+else
+    ARITHM = $(ARITHMi)
+endif
+
+
+# debug : -g -CB -fp-stack-check -check all
+FT        = $(IFORT) $(ARITHM) -c
+LK        = $(IFORT) $(ARITHM)
+F_NETCDF  = $(IFORT) $(ARITHM) -c -I$(NCDF_INC)
+F_90      =
+
+# The End of All Things (op. cit.)
Index: trunk/SOURCES/Fichiers-parametres/Makefile.tof-lsce3130.inc
===================================================================
--- trunk/SOURCES/Fichiers-parametres/Makefile.tof-lsce3130.inc	(revision 21)
+++ trunk/SOURCES/Fichiers-parametres/Makefile.tof-lsce3130.inc	(revision 22)
@@ -20,5 +20,5 @@
 # lit le nom du fichier param pour lancer sur r2d2 par une commande :   echo jobparam | LBQ....
 
-JOB = 'job' 
+JOB = 'job'
 
 
@@ -31,6 +31,9 @@
 #MKL_LIB   = -L$(DIRLOCAL)/intel/mkl9/lib/32 -lmkl_lapack -lmkl_ia32 -lguide -lpthread
 #MKL_LIB  = -L$(DIRLOCAL)/intel/mkl10/lib/32  -lmkl -lguide -lpthread #  -lmklapack
-MKL_LIB = -L$MKLROOT/lib/em64t -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread
-export $MKL_LIB
+
+ifeq ($(mkl_c), 1)
+    MKL_LIB = -L$MKLROOT/lib/em64t -lmkl_intel_lp64 -lmkl_intel_thread -lmkl_core -liomp5 -lpthread
+    export $MKL_LIB
+endif
 
 IFORT= ifort
@@ -47,4 +50,5 @@
 F_NETCDF  = $(IFORT) $(ARITHM) -c  -I$(NCDF_INC) # -traceback  -CB   #-g #-pg -ipo # -g
 FT        = $(IFORT) $(ARITHM) -c  -I$(NCDF_INC) # -traceback  -CB  #-g #-pg -ipo # -g
+F_90      = -w90
 
 
Index: trunk/SOURCES/GrIce2sea_files/climat_GrIce2sea_years_mod.f90
===================================================================
--- trunk/SOURCES/GrIce2sea_files/climat_GrIce2sea_years_mod.f90	(revision 21)
+++ trunk/SOURCES/GrIce2sea_files/climat_GrIce2sea_years_mod.f90	(revision 22)
@@ -87,4 +87,8 @@
   namelist/clim_smb_T_gen/smb_file,coef_smb_unit,temp_annual_file
 
+! dmr moved up since namelist declaration should be in the header
+
+  namelist/clim_snap/nb_snap,time_depart_snaps,ecart_snap,file_smb_snap,massb_time
+
 428 format(A)
   rewind(num_param)                     ! pour revenir au debut du fichier param_list.dat
@@ -145,5 +149,4 @@
 !lecture namelist 
 
-  namelist/clim_snap/nb_snap,time_depart_snaps,ecart_snap,file_smb_snap,massb_time
 
   rewind(num_param)        ! pour revenir au debut du fichier param_list.dat
Index: trunk/SOURCES/Makefile
===================================================================
--- trunk/SOURCES/Makefile	(revision 21)
+++ trunk/SOURCES/Makefile	(revision 22)
@@ -5,10 +5,27 @@
 #-------------------------------------------
 
-include Fichiers-parametres/Makefile.tof-lsce3130.inc
-#include Fichiers-parametres/Makefile.catritz-pc226.inc
-# include Fichiers-parametres/Makefile.pc246.inc
+#-------------------------------------------
+# dmr: Added options for a more flexible Makefile with the two compilers inbedded
+#-------------------------------------------
 
+# Choice for compiler (ifort = 1, gfortran = 0)
+ifort ?= 0
+
+# Choice for librairies (mkl_c = 1 = MKL,  = 0 = BLAS)
+#Â NOTA: mkl_c = 1 with ifort = 0 ignores the MKL and uses BLAS anyhow
+mkl_c ?= 1
+
+ifeq ($(ifort),1)
+  include Fichiers-parametres/Makefile.tof-lsce3130.inc
+else
+  include Fichiers-parametres/Makefile.dmr-lsce3027.inc
+endif
 
 #     Compilation (le corps du Makefile)
 #-------------------------------------------
-include Makefile.grisli.inc
+
+ifeq ($(ifort),1)
+  include Makefile.grisli.inc
+else
+  include Makefile.grisli-gfortran.inc
+endif
Index: trunk/SOURCES/Makefile.grisli-gfortran.inc
===================================================================
--- trunk/SOURCES/Makefile.grisli-gfortran.inc	(revision 22)
+++ trunk/SOURCES/Makefile.grisli-gfortran.inc	(revision 22)
@@ -0,0 +1,1997 @@
+# Makefile de la version avec le new remplimat
+# Les options de complilations sont dans les fichiers specifiques, adaptes aux diverses machines utilisees 
+# FT options de compilation
+# LK options de link
+# F_NETCDF options de compilation + librairies NETCDF
+
+# pour lancer des jobs avec lecture d'un fichier namelist
+# nojob pour lancer avec fichier param dans repertoire resultat
+JOB = 'nojob'
+# job pour lancer avec fichier param nom quelconque dans SOURCES/Fichiers-parametres 
+#JOB = 'job'
+
+# pour lancer
+# sur pc: nohup `echo job-test | LBqAntar-15` &    ou echo job-test | LBqAntar-15
+# sur r2d2 le mettre dans job*sh
+
+#-------------------------------------------
+# listes pour la resolution equation elliptique
+#------------------------------------------------
+
+# nouvelle version de remplimat
+#----------------------------------
+
+mod_ell             = remplimat_declar_tabTu_mod.o eq_ellipt_sgbsv_mod-0.2.o
+routine_elliptiques = remplimat-shelves-tabTu.o graphique_L2.o graph-sgbsv.o
+diagnoshelf         = diagno-L2_mod.o
+#diagnoshelf         = fake_diagno_mod.o
+
+
+# liste de modules communs a toutes geographies/experiences
+#-----------------------------------------------------------
+
+# modules servant aux declarations globales
+mod_dim_communs = runparam_mod.o param_phy_mod.o \
+	3D-physique-gen_mod.o io_netcdf_GRISLI.o 
+
+
+
+# modules climats : doivent etre compatibles avec les modules choix
+# il faut choisir un des deux ou un specifique a une geometrie.
+
+# module de forcage climatique C. Dumas
+mod_clim_tof = climat_forcage_mois_mod.o climat-forcage-insolation_mod_oneway.o \
+	climat-forcage-insolation_mod.o climat_GrIce2sea_years_mod.o \
+	ablation_mod.o no_ablation_mod.o 
+
+# methode forcage basee sur des snapshots climats
+mod_clim_forcage = climat-forcage_mod-0.4.o \
+	declare-month_mod.o \
+	declare-month_lapsecouche_mod.o  \
+	ablation_ann_july_mod.o \
+	ablation_month.o accum_month.o no_ablation_mod.o \
+	massb-ant_forcage-0.4.o	accum7.o \
+	ablation_month_lapsecouche.o accum_month_lapsecouche.o 
+
+# methode perturbation des champs actuels
+mod_clim_perturb = climat-perturb_mod-0.4.o climat-perturb-mois_mod.o \
+	climat-perturb-mois_lapsecouche_mod.o \
+	declare-month_mod.o \
+	declare-month_lapsecouche_mod.o  \
+	ablation_ann_july_mod.o \
+	ablation_month.o accum_month.o no_ablation_mod.o \
+	ablation_month_lapsecouche.o accum_month_lapsecouche.o \
+	massb_perturb_mois.o massb_perturb_mois_lapsecouche.o 
+
+mod_communs =   util_recovery.o \
+	geom_type.o temperature_type.o ice_flow_type.o mask_flgz_type.o \
+	interface_input.o deformation_type.o autre_pr_temp_type.o  \
+	iso_declar_mod-0.3.o isostasie_mod-0.3.o noisostasie_mod-0.3.o \
+        deformation_mod_2lois.o deformation_mod_2lois_isotherme.o     \
+        sliding_Bindshadler_mod.o no_sliding.o			    \
+	dragging_hwatermax_0.2_mod.o dragging_calc_beta_mod.o  \
+	dragging_hwat-contigu_mod.o dragging_hwat_contmaj_mod.o \
+	dragging_hwat_sedim_mod.o  prop-thermiques_mod.o  \
+	calving_frange.o no_calving.o no_lakes.o \
+	out_profile_mod.o printtable_mod.o mix-SIA-L1_mod.o \
+	relaxation_mod-0.3.o relaxation_water_mod-0.4.o relaxation_water_diffusion.o \
+	prescribe-H-i2s_mod.o  \
+	resol_adv_diff_2D-sept2009.o  \
+	conserv-mass-adv-diff_sept2009_mod.o  \
+	eaubasale-0.5_mod.o spinup_mod.o no_spinup_mod.o \
+	tridiag_mod-0.3.o out_horiz_mod.o bmelt-seuil-profondeur_mod.o 
+
+mod_communs_RGL =   util_recovery.o \
+        geom_type.o temperature_type.o ice_flow_type.o mask_flgz_type.o \
+        interface_input.o deformation_type.o autre_pr_temp_type.o  \
+        iso_declar_mod-0.3.o isostasie_mod-0.3.o noisostasie_mod-0.3.o \
+        deformation_mod_2lois.o deformation_mod_2lois_isotherme.o      \
+        sliding_Bindshadler_mod.o no_sliding.o                      \
+        dragging_hwatermax_0.2_mod.o dragging_calc_beta_mod.o  \
+        dragging_hwat-contigu_mod.o dragging_hwat_contmaj_mod.o \
+        prop-thermiques_mod.o  \
+        calving_frange.o no_calving.o no_lakes.o \
+        out_profile_mod.o printtable_mod.o mix-SIA-L1_mod.o \
+        relaxation_mod-0.3.o relaxation_water_mod-0.4.o relaxation_water_diffusion.o \
+        prescribe-H-i2s_mod.o   \
+        resol_adv_diff_2D-sept2009.o  \
+        conserv-mass-adv-diff_sept2009_mod.o  \
+        eaubasale-0.5_mod.o spinup_mod.o no_spinup_mod.o \
+        tridiag_mod-0.3.o out_horiz_mod.o bmelt-seuil-profondeur_mod.o
+
+
+
+# Modules communs Post geographiques 
+
+mod_post_geo = step_temp_type.o
+
+
+#	prescribe-H_mod.o ou prescribe-H-i2s_mod.o sont dans modules_dim \
+
+# attention les tracers reclament le climat_perturb
+mod_tracers = tracer_vars_mod.o tracer_mod.o notracer_mod.o \
+	interpolate_tracer.o celltest_tracer.o 	
+# no_tracer a part pour eviter pb avec climat_perturb => voir avec Cat
+mod_no_tracers = tracer_vars_mod.o notracer_mod.o
+
+
+Proto_recul = proto_declar_3D_grisli_mod.o \
+	declar_io_ncdf_proto_mod.o\
+	declar_proto_recul.o \
+	proto_recul_mod.o \
+
+# Toy est la version juin 2012 avec Schooffing
+
+toy_recul = toy_declar_3D_grisli_mod.o \
+	declar_io_ncdf_toy_mod_fake.o\
+	declar_toy_retreat.o \
+	toy_retreat_mod.o \
+
+
+
+# liste de routines communes
+# enleve  : flow_general-0.3.o flowlaw-0.3.o  Cat 23 mars 2012
+
+routines_communes = tracebug.o ablation_bord.o allocate_types.o \
+	icetemp_declar-0.5_mod.o bmelt-grounded.o calceps2-0.2.o  \
+	diffusiv-polyn-0.6.o \
+	flottab-rescue-1.o flottab2-0.7.o   \
+	interface_advec_icetemp.o \
+	interface_prop_th_icetemp.o \
+	interface_Qprod_icetemp.o \
+	interface_temp_col.o \
+	interface_icetempmod.o \
+	initial-0.3.o initial-phy-2.o initial2-0.4.o \
+	lastoutput-0.2.o lect-eis.o  readinput.o lect_datfile.o write_datfile.o \
+	out_cptr_mod.o lineartemp-0.2.o  litho-0.4.o main3D-0.4-40km.o masque.o \
+	minmax-format.o moy_mxmy.o neffect-0.4.o new-flot-0.3.o  next-time.o \
+	no-icethick.o  printdebug.o  \
+	sealevel-out.o slope_surf.o \
+	snaptime.o sortie-hz-multivar.o strain_rate.o \
+	tab-litho-0.3.o taubed-0.3.o \
+	velocities-polyn-0.3.o \
+	vtoutput-0.2.o  courbures.o 
+#	vtoutput-0.2.o steps_time_loop.o courbures.o 
+
+
+
+# listes dependant de la geographie
+#_____________________________________
+
+# Liste_mismip_3D_5
+Liste_mismip_3D_5 =  no_ablation_mod.o climat-mismip3d_mod.o  \
+	output_global_mod.o dragging_mismip3d_mod.o \
+	fake-routines-mismip3d_mod.o \
+	tracer_vars_mod.o notracer_mod.o 
+
+# Liste_mismip_post_ncdf
+Liste_mismip_post_ncdf = lect-mismip3d_mod.o  module_choix_mismip3d.o
+
+
+# Liste_GrIce2sea
+Liste_GrIce2sea =  lect_GrIce2sea_gen_nc.o  \
+        output_Grice2sea_mod.o  fake-routines_Grice2sea_mod.o \
+	dragging_prescr_beta_mod.o beta_iter_vitbil_mod.o module_choix_GrIce2sea.o 
+#       massb-ant_forcage-0.4
+
+Liste_heminord = paradim-nord40_mod.o  output_nord_mod-0.4.o \
+	lect-clim-act-nord40_mod.o lect-nord40_mod.o  \
+	bmelt-nor-regions_mod.o bmelt-nor-depth_mod.o module_choix-heminord-0.4.o \
+        fake-routines-nord_mod.o 
+
+
+Liste_ANT15-LBq = lect-Ant_clim_Acc-T_gen_dat.o output_anta_mod-0.4.o \
+	dragging-vit_bil_LBq_gen_mod.o dragging_LGM_mod.o dragging_plastic_LGM_mod.o \
+	dragging_prescr_beta_mod.o dragging_prescr_beta_buoyency_mod.o dragging_prescr_beta_nolin_mod.o \
+	fake-routines-ant_mod.o beta_iter_vitbil_mod.o \
+	lect-Ant_gen2010_dat.o module_choix_antar15_LBq.o \
+	massb-ant_perturb_Tparam.o track_ant40_mod.o 
+
+
+
+Liste_hudson = sedim_declar_hudson_mod.o climat-hudson_mod.o \
+       lect-hudson_mod.o eaubasale-0.5_hudson_mod.o \
+       fake-routines-hudson_mod.o detect-assym.o  \
+       prop-therm-hudson_mod.o dragging_hudson_jorge_mod.o \
+       sliding-hudson_mod.o fake-dragging-hudson_mod.o \
+       dragging-hudson_mod.o dragging_hwatermax_hudson_mod.o \
+       output_hudson_mod.o bmelt_hudson_mod.o initial-hudson-phy.o  \
+       module_choix-hudson-0.4.o track_hudson_mod.o
+
+Liste_hemin40 = output_hemin40_mod.o \
+        lect-hemin40_mod.o  \
+        bmelt-hemin40-regions_mod.o bmelt-hemin40-depth_mod.o \
+        fake-routines-hemin40_mod.o  module_choix-hemin40-0.4.o \
+        track_hemin40_mod.o
+
+Liste_hemin15 = output_hemin40_mod.o \
+        lect-hemin15_mod.o  \
+        bmelt-hemin40-depth_mod.o \
+        fake-routines-hemin15_mod.o  module_choix-hemin15.o \
+        track_hemin15_mod.o
+
+Liste_greeneem15 = output_greeneem_mod-0.4.o \
+	lect-greeneem_mod.o \
+	dragging_neem_mod.o \
+	fake-routines-greeneem_mod.o \
+	module_choix-greeneem.o \
+	track_greeneem_mod.o 
+
+Liste_eura40 = output_eurasie40_mod-0.1.o \
+        lect-eurasie_mod.o lakes-prescribed_mod-0.1.o \
+        climat-forcage-mois_mod-0.2.o \
+        ablation_month.o accum_month.o  bmelt-eurasie-depth-lake_mod.o \
+        fake-routines-eurasie_mod.o module_choix-eurasie-0.4.o \
+        track_eurasie_mod.o
+
+Liste_greenmint40 = output_green_mod-0.4.o lect-clim-act-greenmint_mod.o \
+        lect-greenmint_mod.o massb_perturb_Tparam_green.o \
+	fake-routines-greenmint_mod.o massb-ant_forcage-0.4.o \
+	module_choix-greenmint-40.o track_greenmint_mod.o \
+
+Liste_greeneem45 = output_greeneem_mod-0.4.o lect-clim-act-greeneem_mod.o \
+	lect-clim-act-greeneem_mar_mod.o \
+	dragging_neem_mod.o \
+        lect-clim-act-greeneem_mois_lapsecouche_mod.o \
+        lect-clim-act-greeneem_mois_mod.o lect-greeneem_mod.o \
+	massb_perturb_Tparam_greeneem.o \
+	fake-routines-greeneem_mod.o massb-ant_forcage-0.4.o \
+	module_choix-greeneem.o track_greeneem_mod.o 
+
+Liste_greeneem05 = output_greeneem_mod-0.4.o lect-clim-act-greeneem_mod.o \
+	lect-clim-act-greeneem_mar_mod.o \
+	dragging_neem_mod.o \
+        lect-clim-act-greeneem_mois_lapsecouche_mod.o \
+        lect-clim-act-greeneem_mois_mod.o lect-greeneem_mod.o \
+	massb_perturb_Tparam_greeneem.o \
+	fake-routines-greeneem_mod.o massb-ant_forcage-0.4.o \
+	module_choix-greeneem.o track_greeneem_mod.o 
+
+Liste_gsearise15 = output_gsearise_mod-0.4.o lect-clim-act-gsearise_mod.o \
+	dragging_neem_mod.o \
+        lect-clim-act-gsearise_mois_mod.o lect-gsearise_mod.o \
+	massb_perturb_Tparam_gsearise.o \
+	fake-routines-gsearise_mod.o massb-ant_forcage-0.4.o \
+	module_choix-gsearise.o track_gsearise_mod.o 
+
+Liste_gsearise05 = output_gsearise_mod-0.4.o lect-clim-act-gsearise_mod.o \
+	dragging_neem_mod.o \
+        lect-clim-act-gsearise_mois_mod.o lect-gsearise_mod.o \
+	massb_perturb_Tparam_gsearise.o \
+	fake-routines-gsearise_mod.o massb-ant_forcage-0.4.o \
+	module_choix-gsearise.o track_gsearise_mod.o 
+
+# listes de dimensionnement (dependent de la geographie)
+#-----------------------------
+
+Dim_Mismip_3D_5 = paradim_mismip3D_5km_mod.o geography-Mismip3d.o
+
+Dim_GrIce2sea = paradim-GrIce2sea-cut_Tamsin.o geography-GrIce2sea.o
+
+Dim_ANT15-LBq    = paradim-ant15_LBq_mod.o geography-Ant15_LBq.o   
+
+Dim_hudson = paradim-hudson_mod.o geography-hudson_mod.o
+
+Dim_hemin40 = paradim-hemin40_mod.o geography-hemin40_mod.o
+
+Dim_hemin15 = paradim-hemin15_mod.o geography-hemin15_mod.o
+
+Dim_eura40 = paradim-euras40_mod.o geography-euras40_mod.o
+
+Dim_greenmint40 = paradim-greenmint40_mod.o geography-greenmint40_mod.o
+
+Dim_greeneem45 = paradim-greeneem45_mod.o geography-greeneem45_mod.o
+
+Dim_greeneem15 = paradim-greeneem15_mod.o geography-greeneem15_mod.o
+
+Dim_greeneem05 = paradim-greeneem05_mod.o geography-greeneem05_mod.o
+
+Dim_gsearise15 = paradim-gsearise15_mod.o geography-gsearise15_mod.o
+
+Dim_gsearise05 = paradim-gsearise05_mod.o geography-gsearise05_mod.o
+
+
+# Liste_BLAS = band.o reduc.o \
+# 	BLAS/isamax.o BLAS/lsame.o BLAS/scopy.o BLAS/sgbmv.o BLAS/sgemm.o \
+# 	BLAS/sgemv.o  BLAS/sger.o BLAS/sscal.o BLAS/sswap.o BLAS/stbsv.o \
+# 	BLAS/strsm.o BLAS/xerbla.o
+
+Liste_BLAS = band.o reduc.o \
+	BLAS/isamax.o BLAS/lsame.o BLAS/scopy.o \
+	BLAS/slamch.o BLAS/slabad.o BLAS/slange.o \
+	BLAS/slassq.o BLAS/sgeqrf.o BLAS/sormqr.o \
+	BLAS/strmv.o BLAS/slarft.o \
+	BLAS/ilaslr.o BLAS/ilaslc.o BLAS/strmm.o \
+	BLAS/slarfb.o BLAS/slapy2.o BLAS/slarfg.o BLAS/slarf.o \
+	BLAS/sgeqr2.o BLAS/sorm2r.o BLAS/snrm2.o \
+	BLAS/slaqps.o BLAS/slaqp2.o BLAS/sgeqp3.o \
+	BLAS/slaset.o BLAS/slaisnan.o BLAS/sisnan.o \
+	BLAS/slascl.o BLAS/sdot.o BLAS/slaic1.o \
+	BLAS/slarzb.o BLAS/slarzt.o \
+	BLAS/saxpy.o BLAS/slarz.o BLAS/sormr3.o \
+	BLAS/sormrz.o BLAS/slatrz.o BLAS/stzrzf.o BLAS/sgelsy.o \
+	BLAS/sgbmv.o BLAS/sgemm.o BLAS/sgemv.o  BLAS/sger.o \
+	BLAS/sscal.o BLAS/sswap.o BLAS/stbsv.o \
+	BLAS/strsm.o BLAS/xerbla.o
+
+
+
+# ancienne methode
+#Liste_Netcdf = io_netcdf.o  sortie_netcdf_GRISLI_mod.0.2.o
+
+# pour fonctionner avec code Hassine
+# sortie_netcdf_GRISLI_mod.0.2-hassine.o 
+Liste_Netcdf =   sortie_netcdf_GRISLI_mod.0.2-hassine.o 
+
+
+# Pour changer la methode de lecture du fichier param
+#----------------------------------------------------------------------------------
+initial-phy-2.o : 
+	echo 'methode', $(JOB)
+
+ifeq ($(JOB),'job')
+	echo 'entree fichier parametre par commande echo job'
+
+	 $(FT) initial-phy-2-job.f90 -o initial-phy-2.o
+else	
+	echo ' fichier parametre defini par runname'
+	 $(FT) initial-phy-2.f90 -o initial-phy-2.o
+endif
+
+# routines et modules qui dependent de la machine (defini dans le makefile machine)
+#----------------------------------------------------------------------------------
+# quelques ligne de difference dans la creation des netcdf
+
+
+#sortie_netcdf_GRISLI_mod.0.2-hassine.o :
+#ifeq ($(machine),'r2d2')	
+#	$(F_NETCDF) Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine-r2d2.f90 -o sortie_netcdf_GRISLI_mod.0.2-hassine.o
+#else	
+#	$(F_NETCDF) Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90	
+#endif
+
+#out_cptr_mod.o : 
+#ifeq ($(machine),'r2d2')
+#	$(F_NETCDF) out_cptr_mod-r2d2.f90 -o out_cptr_mod.o	
+#else
+#	$(F_NETCDF) out_cptr_mod.f90
+#endif
+
+# Compilation Modules
+#---------------------------------
+paradim-ant40_mod.o : Ant40_files/paradim-ant40_mod.f90
+	$(FT) Ant40_files/paradim-ant40_mod.f90
+
+paradim-ant15_LBq_mod.o : ANT15-LBq_files/paradim-ant15_LBq_mod.f90
+	$(FT) ANT15-LBq_files/paradim-ant15_LBq_mod.f90
+
+paradim-ant15_CISM_mod.o : Ant15_CISM_files/paradim-ant15_CISM_mod.f90
+	$(FT) Ant15_CISM_files/paradim-ant15_CISM_mod.f90
+
+paradim-ant20_CISM_mod.o : Ant20_CISM_files/paradim-ant20_CISM_mod.f90
+	$(FT) Ant20_CISM_files/paradim-ant20_CISM_mod.f90
+
+paradim-ant25_CISM_mod.o : Ant25_CISM_files/paradim-ant25_CISM_mod.f90
+	$(FT) Ant25_CISM_files/paradim-ant25_CISM_mod.f90
+
+paradim-ant45_CISM_mod.o : Ant45_CISM_files/paradim-ant45_CISM_mod.f90
+	$(FT) Ant45_CISM_files/paradim-ant45_CISM_mod.f90
+
+paradim-nord40_mod.o : Heminord_files/paradim-nord40_mod.f90
+	$(FT)  Heminord_files/paradim-nord40_mod.f90
+
+paradim-euras40_mod.o : Eurasie40_files/paradim-euras40_mod.f90
+	$(FT)  Eurasie40_files/paradim-euras40_mod.f90
+
+paradim-eura20_mod.o : paradim-eura20_mod.f90
+	$(FT)  paradim-eura20_mod.f90
+
+paradim-eura10_mod.o : paradim-eura10_mod.f90
+	$(FT)  paradim-eura10_mod.f90
+
+paradim-greenmint40_mod.o : Greenmint40_files/paradim-greenmint40_mod.f90
+	$(FT) Greenmint40_files/paradim-greenmint40_mod.f90
+
+paradim-greeneem45_mod.o : Greeneem_files/Greeneem45_files/paradim-greeneem45_mod.f90
+	$(FT) Greeneem_files/Greeneem45_files/paradim-greeneem45_mod.f90
+
+paradim-greeneem15_mod.o : Greeneem_files/Greeneem15_files/paradim-greeneem15_mod.f90
+	$(FT) Greeneem_files/Greeneem15_files/paradim-greeneem15_mod.f90
+
+paradim-greeneem05_mod.o : Greeneem_files/Greeneem05_files/paradim-greeneem05_mod.f90
+	$(FT) Greeneem_files/Greeneem05_files/paradim-greeneem05_mod.f90
+
+paradim-gsearise15_mod.o : Gsearise_files/Gsearise15_files/paradim-gsearise15_mod.f90
+	$(FT) Gsearise_files/Gsearise15_files/paradim-gsearise15_mod.f90
+
+paradim-gsearise05_mod.o : Gsearise_files/Gsearise05_files/paradim-gsearise05_mod.f90
+	$(FT) Gsearise_files/Gsearise05_files/paradim-gsearise05_mod.f90
+
+paradim-GrIce2sea-cut_Tamsin.o : GrIce2sea_files/paradim-GrIce2sea-cut_Tamsin.f90
+	$(FT)  GrIce2sea_files/paradim-GrIce2sea-cut_Tamsin.f90
+
+paradim-Heino_mod.o : Heino_files/paradim-Heino_mod.f90
+	$(FT) Heino_files/paradim-Heino_mod.f90
+
+geography-ant40_mod.o : Ant40_files/geography-ant40_mod.f90
+	$(FT) Ant40_files/geography-ant40_mod.f90
+
+geography-Ant15_LBq.o : ANT15-LBq_files/geography-Ant15_LBq.f90
+	$(FT)  ANT15-LBq_files/geography-Ant15_LBq.f90
+
+geography-Ant15CISM.o : Ant15_CISM_files/geography-Ant15CISM.f90
+	$(FT) Ant15_CISM_files/geography-Ant15CISM.f90
+
+geography-Ant20CISM.o : Ant20_CISM_files/geography-Ant20CISM.f90
+	$(FT) Ant20_CISM_files/geography-Ant20CISM.f90
+
+geography-Ant25CISM.o : Ant25_CISM_files/geography-Ant25CISM.f90
+	$(FT) Ant25_CISM_files/geography-Ant25CISM.f90
+
+geography-Ant45CISM.o : Ant45_CISM_files/geography-Ant45CISM.f90
+	$(FT) Ant45_CISM_files/geography-Ant45CISM.f90
+
+geography-heino_mod.o : Heino_files/geography-heino_mod.f90
+	$(FT) Heino_files/geography-heino_mod.f90
+
+geography-heminord_mod.o : Heminord_files/geography-heminord_mod.f90
+	$(FT)  Heminord_files/geography-heminord_mod.f90
+
+geography-euras40_mod.o : Eurasie40_files/geography-euras40_mod.f90
+	$(FT) Eurasie40_files/geography-euras40_mod.f90
+
+geography-greenmint40_mod.o : Greenmint40_files/geography-greenmint40_mod.f90
+	$(FT) Greenmint40_files/geography-greenmint40_mod.f90
+
+geography-greeneem45_mod.o : Greeneem_files/Greeneem45_files/geography-greeneem45_mod.f90
+	$(FT) Greeneem_files/Greeneem45_files/geography-greeneem45_mod.f90
+
+geography-greeneem15_mod.o : Greeneem_files/Greeneem15_files/geography-greeneem15_mod.f90
+	$(FT) Greeneem_files/Greeneem15_files/geography-greeneem15_mod.f90
+
+geography-greeneem05_mod.o : Greeneem_files/Greeneem05_files/geography-greeneem05_mod.f90
+	$(FT) Greeneem_files/Greeneem05_files/geography-greeneem05_mod.f90
+
+geography-gsearise15_mod.o : Gsearise_files/Gsearise15_files/geography-gsearise15_mod.f90
+	$(FT) Gsearise_files/Gsearise15_files/geography-gsearise15_mod.f90
+
+geography-gsearise05_mod.o : Gsearise_files/Gsearise05_files/geography-gsearise05_mod.f90
+	$(FT) Gsearise_files/Gsearise05_files/geography-gsearise05_mod.f90
+
+geography-GrIce2sea.o : GrIce2sea_files/geography-GrIce2sea.f90
+	$(FT) GrIce2sea_files/geography-GrIce2sea.f90
+
+
+# Physique et topography
+# ---------------------------
+
+runparam_mod.o : runparam_mod.f90
+	$(FT) runparam_mod.f90
+
+3D-physique-gen_mod.o : 3D-physique-gen_mod.f90
+	$(FT) 3D-physique-gen_mod.f90
+
+# types Hassine
+param_phy_mod.o: param_phy_mod.f90
+	$(FT) param_phy_mod.f90
+
+geom_type.o: Types/geom_type.f90
+	$(FT) Types/geom_type.f90
+
+temperature_type.o: Types/temperature_type.f90
+	$(FT) Types/temperature_type.f90
+
+ice_flow_type.o: Types/ice_flow_type.f90
+	$(FT) Types/ice_flow_type.f90
+
+mask_flgz_type.o: Types/mask_flgz_type.f90
+	$(FT) Types/mask_flgz_type.f90
+
+deformation_type.o: Types/deformation_type.f90
+	$(FT) Types/deformation_type.f90
+
+autre_pr_temp_type.o: Types/autre_pr_temp_type.f90
+	$(FT) Types/autre_pr_temp_type.f90
+
+step_temp_type.o: Types/step_temp_type.f90
+	$(FT) Types/step_temp_type.f90
+
+allocate_types.o:  Types/allocate_types.f90
+	$(FT) Types/allocate_types.f90
+
+# fin types Hassine
+
+lect-anteis_mod.o : Ant40_files/lect-anteis_mod.f90
+	$(FT) Ant40_files/lect-anteis_mod.f90
+
+lect-Ant_CISM_gen_dat.o : Antarctique_general_files/lect-Ant_CISM_gen_dat.f90
+	$(FT) Antarctique_general_files/lect-Ant_CISM_gen_dat.f90
+
+lect-Ant_gen2010_dat.o : Antarctique_general_files/lect-Ant_gen2010_dat.f90
+	$(FT) Antarctique_general_files/lect-Ant_gen2010_dat.f90
+
+lect-Ant_CISM_15_dat.o : Ant15_CISM_files/lect-Ant_CISM_15_dat.f90
+	$(FT) Ant15_CISM_files/lect-Ant_CISM_15_dat.f90
+
+lect-Ant_CISM_45_dat.o : Ant45_CISM_files/lect-Ant_CISM_45_dat.f90
+	$(FT) Ant45_CISM_files/lect-Ant_CISM_45_dat.f90
+
+lect-nord40_mod.o : Heminord_files/lect-nord40_mod.f90
+	$(FT) Heminord_files/lect-nord40_mod.f90
+
+lect-eurasie_mod.o : Eurasie40_files/lect-eurasie_mod.f90
+	$(FT) Eurasie40_files/lect-eurasie_mod.f90
+
+lect-greenmint_mod.o : Greenmint40_files/lect-greenmint_mod.f90
+	$(FT) Greenmint40_files/lect-greenmint_mod.f90
+
+lect-greeneem_mod.o : Greeneem_files/lect-greeneem_mod.f90
+	$(FT) Greeneem_files/lect-greeneem_mod.f90
+
+lect-gsearise_mod.o : Gsearise_files/lect-gsearise_mod.f90
+	$(FT) Gsearise_files/lect-gsearise_mod.f90
+
+lect-Heino_mod.o : Heino_files/lect-Heino_mod.f90
+	$(FT) Heino_files/lect-Heino_mod.f90
+
+lect_GrIce2sea_gen_nc.o : GrIce2sea_files/lect_GrIce2sea_gen_nc.f90
+	$(FT)  GrIce2sea_files/lect_GrIce2sea_gen_nc.f90
+
+bmelt-ant-regions_declar_mod.o : Ant40_files/bmelt-ant-regions_declar_mod.f90
+	$(FT) Ant40_files/bmelt-ant-regions_declar_mod.f90
+
+bmelt-ant-regions_mod.o : Ant40_files/bmelt-ant-regions_mod.f90
+	$(FT)  Ant40_files/bmelt-ant-regions_mod.f90
+
+bmelt-nor-regions_mod.o : Heminord_files/bmelt-nor-regions_mod.f90
+	$(FT) Heminord_files/bmelt-nor-regions_mod.f90
+
+bmelt-nor-depth_mod.o : Heminord_files/bmelt-nor-depth_mod.f90
+	$(FT) Heminord_files/bmelt-nor-depth_mod.f90
+
+bmelt-eurasie-depth-lake_mod.o : Eurasie40_files/bmelt-eurasie-depth-lake_mod.f90
+	$(FT) Eurasie40_files/bmelt-eurasie-depth-lake_mod.f90
+
+bmelt-seuil-profondeur_mod.o : bmelt-seuil-profondeur_mod.f90
+	$(FT) bmelt-seuil-profondeur_mod.f90
+
+lakes-prescribed_mod-0.1.o : Eurasie40_files/lakes-prescribed_mod-0.1.f90
+	$(FT) Eurasie40_files/lakes-prescribed_mod-0.1.f90
+
+no_lakes.o : no_lakes.f90
+	$(FT) no_lakes.f90
+
+iso_declar_mod-0.3.o : iso_declar_mod-0.3.f90
+	$(FT) iso_declar_mod-0.3.f90
+
+noisostasie_mod-0.3.o : noisostasie_mod-0.3.f90
+	$(FT) noisostasie_mod-0.3.f90
+
+isostasie_mod-0.3.o : isostasie_mod-0.3.f90 
+	$(FT) isostasie_mod-0.3.f90
+
+eq_elliptique_mod-0.4.o : eq_elliptique_mod-0.4.f90
+	$(FT) eq_elliptique_mod-0.4.f90
+
+
+#------------ Traceurs isotopiques
+
+tracer_mod.o : tracer_mod.f90 
+	$(FT) tracer_mod.f90
+
+notracer_mod.o : notracer_mod.f90 
+	$(FT) notracer_mod.f90
+
+tracer_vars_mod.o : tracer_vars_mod.f90 
+	$(FT) tracer_vars_mod.f90
+
+interpolate_tracer.o : interpolate_tracer.f90 
+	$(FT) interpolate_tracer.f90
+
+celltest_tracer.o : celltest_tracer.f90 
+	$(FT) celltest_tracer.f90
+
+
+#-------------lecture des fichiers Climat
+
+lect-Ant_clim_Acc-T_gen_dat.o : Antarctique_general_files/lect-Ant_clim_Acc-T_gen_dat.f90
+	$(FT)  Antarctique_general_files/lect-Ant_clim_Acc-T_gen_dat.f90
+
+
+lect-clim-act-greenmint_mod.o : Greenmint40_files/lect-clim-act-greenmint_mod.f90
+	$(FT) Greenmint40_files/lect-clim-act-greenmint_mod.f90
+
+lect-clim-act-greeneem_mod.o : Greeneem_files/lect-clim-act-greeneem_mod.f90
+	$(FT) Greeneem_files/lect-clim-act-greeneem_mod.f90
+
+lect-clim-act-gsearise_mod.o : Gsearise_files/lect-clim-act-gsearise_mod.f90
+	$(FT) Gsearise_files/lect-clim-act-gsearise_mod.f90
+
+lect-clim-act-greeneem_mar_mod.o : Greeneem_files/lect-clim-act-greeneem_mar_mod.f90
+	$(FT) Greeneem_files/lect-clim-act-greeneem_mar_mod.f90
+
+lect-clim-act-greeneem_mois_lapsecouche_mod.o :	Greeneem_files/lect-clim-act-greeneem_mois_lapsecouche_mod.f90
+	$(FT) Greeneem_files/lect-clim-act-greeneem_mois_lapsecouche_mod.f90
+
+lect-clim-act-greeneem_mois_mod.o : Greeneem_files/lect-clim-act-greeneem_mois_mod.f90
+	$(FT) Greeneem_files/lect-clim-act-greeneem_mois_mod.f90
+
+lect-clim-act-gsearise_mois_mod.o : Gsearise_files/lect-clim-act-gsearise_mois_mod.f90
+	$(FT) Gsearise_files/lect-clim-act-gsearise_mois_mod.f90
+
+lect-clim-act-nord40_mod.o : Heminord_files/lect-clim-act-nord40_mod.f90
+	$(FT) Heminord_files/lect-clim-act-nord40_mod.f90
+
+lect_climat_ref_Ice2sea_mod.o : GrIce2sea_files/lect_climat_ref_Ice2sea_mod.f90
+	$(FT) GrIce2sea_files/lect_climat_ref_Ice2sea_mod.f90
+
+
+# modules de climat
+# ---------------------------
+# nouveaux modules climat C. Dumas Fev 2015
+climat_forcage_mois_mod.o : climat_forcage_mois_mod.f90
+	$(F_NETCDF) climat_forcage_mois_mod.f90
+
+climat-forcage-insolation_mod_oneway.o : climat-forcage-insolation_mod_oneway.f90
+	$(F_NETCDF) climat-forcage-insolation_mod_oneway.f90
+
+climat-forcage-insolation_mod.o : climat-forcage-insolation_mod.f90
+	$(F_NETCDF) climat-forcage-insolation_mod.f90
+
+ablation_mod.o : ablation_mod.f90
+	$(FT) ablation_mod.f90
+
+
+##### anciens modules
+climat-forcage_mod-0.4.o : climat-forcage_mod-0.4.f90 
+	$(FT) climat-forcage_mod-0.4.f90
+
+climat_GrIce2sea_mod.o : GrIce2sea_files/climat_GrIce2sea_mod.f90
+	$(FT) GrIce2sea_files/climat_GrIce2sea_mod.f90
+
+climat_GrIce2sea_years_mod.o : GrIce2sea_files/climat_GrIce2sea_years_mod.f90
+	$(F_NETCDF) GrIce2sea_files/climat_GrIce2sea_years_mod.f90
+
+climat-forcage-stat-mois_mod-0.1.o : climat-forcage-stat-mois_mod-0.1.f90
+	$(FT)  climat-forcage-stat-mois_mod-0.1.f90
+
+declare-month_mod.o : declare-month_mod.f90
+	$(FT) declare-month_mod.f90
+
+declare-month_lapsecouche_mod.o : declare-month_lapsecouche_mod.f90
+	$(FT) declare-month_lapsecouche_mod.f90
+
+climat-forcage-mois_mod-0.2.o : climat-forcage-mois_mod-0.2.f90
+	$(FT) climat-forcage-mois_mod-0.2.f90
+
+ablation_month.o : ablation_month.f90
+	$(FT) ablation_month.f90
+
+ablation_month_lapsecouche.o : ablation_month_lapsecouche.f90
+	$(FT) ablation_month_lapsecouche.f90
+
+ablation_ann_july_mod.o : ablation_ann_july_mod.f90
+	$(FT) ablation_ann_july_mod.f90
+
+no_ablation_mod.o : no_ablation_mod.f90
+	$(FT) no_ablation_mod.f90
+
+accum_month.o : accum_month.f90
+	$(FT) accum_month.f90
+
+accum_month_lapsecouche.o : accum_month_lapsecouche.f90
+	$(FT) accum_month_lapsecouche.f90
+
+climat-perturb_mod-0.4.o : climat-perturb_mod-0.4.f90
+	$(FT) climat-perturb_mod-0.4.f90
+
+climat-perturb-mois_mod.o : climat-perturb-mois_mod.f90
+	$(FT) climat-perturb-mois_mod.f90
+
+climat-perturb-mois_lapsecouche_mod.o : climat-perturb-mois_lapsecouche_mod.F90
+	$(FT) climat-perturb-mois_lapsecouche_mod.F90
+
+clim-synthes_mod-o : climat-synthes_mod-0.4.f90
+	$(FT)  climat-synthes_mod-0.4.f90
+
+climat-heino_mod.o : Heino_files/climat-heino_mod.f90
+	$(FT) Heino_files/climat-heino_mod.f90
+
+deformation_mod_2lois.o : deformation_mod_2lois.f90
+	$(FT) deformation_mod_2lois.f90
+
+deformation_mod_2lois_isotherme.o : deformation_mod_2lois_isotherme.f90
+	$(FT) deformation_mod_2lois_isotherme.f90
+
+deformation_mod-0.3.o : deformation_mod-0.3.f90
+	$(FT) deformation_mod-0.3.f90
+
+sliding-Heino_mod.o : Heino_files/sliding-Heino_mod.f90
+	$(FT) Heino_files/sliding-Heino_mod.f90
+
+sliding_Bindshadler_mod.o : sliding_Bindshadler_mod.f90
+	$(FT) sliding_Bindshadler_mod.f90
+
+no_sliding.o : no_sliding.f90
+	$(FT) no_sliding.f90
+
+dragging_hwatermax_0.2_mod.o : dragging_hwatermax_0.2_mod.f90
+	$(FT) dragging_hwatermax_0.2_mod.f90
+
+dragging_hwat-contigu_mod.o : dragging_hwat-contigu_mod.f90
+	$(FT) dragging_hwat-contigu_mod.f90
+
+dragging_hwat_contmaj_mod.o : dragging_hwat_contmaj_mod.f90
+	$(FT) dragging_hwat_contmaj_mod.f90
+
+dragging_hwat_sedim_mod.o : dragging_hwat_sedim_mod.f90
+	$(FT) dragging_hwat_sedim_mod.f90
+
+dragging_calc_beta_mod.o : Antarctique_general_files/dragging_calc_beta_mod.f90
+	$(FT) Antarctique_general_files/dragging_calc_beta_mod.f90
+
+dragging_LGM_mod.o : Antarctique_general_files/dragging_LGM_mod.f90
+	$(FT) Antarctique_general_files/dragging_LGM_mod.f90
+
+dragging_plastic_LGM_mod.o : Antarctique_general_files/dragging_plastic_LGM_mod.f90
+	$(FT) Antarctique_general_files/dragging_plastic_LGM_mod.f90
+
+dragging_prescr_beta_mod.o : Draggings_modules/dragging_prescr_beta_mod.f90
+	$(FT)  Draggings_modules/dragging_prescr_beta_mod.f90
+
+dragging_prescr_beta_buoyency_mod.o : Draggings_modules/dragging_prescr_beta_buoyency_mod.f90
+	$(FT)  Draggings_modules/dragging_prescr_beta_buoyency_mod.f90
+
+dragging_prescr_beta_nolin_mod.o : Draggings_modules/dragging_prescr_beta_nolin_mod.f90
+	$(FT)  Draggings_modules/dragging_prescr_beta_nolin_mod.f90 
+
+beta_iter_vitbil_mod.o : Draggings_modules/beta_iter_vitbil_mod.f90
+	$(FT)  Draggings_modules/beta_iter_vitbil_mod.f90
+
+dragging_stream_impose_vitbil_mod.o : Ant40_files/dragging_stream_impose_vitbil_mod.f90
+	$(FT) Ant40_files/dragging_stream_impose_vitbil_mod.f90
+
+dragging-vit_bil_LBq_gen_mod.o  : Antarctique_general_files/dragging-vit_bil_LBq_gen_mod.f90
+	$(FT)  Antarctique_general_files/dragging-vit_bil_LBq_gen_mod.f90
+
+dragging-vit_bil_CISM_gen_mod.o : Antarctique_general_files/dragging-vit_bil_CISM_gen_mod.f90
+	$(FT) Antarctique_general_files/dragging-vit_bil_CISM_gen_mod.f90
+
+dragging_neem_mod.o : Greeneem_files/dragging_neem_mod.f90
+	$(FT) Greeneem_files/dragging_neem_mod.f90
+
+dragging-vit_bil_CISM_15_mod.o : Ant15_CISM_files/dragging-vit_bil_CISM_15_mod.f90
+	$(FT) Ant15_CISM_files/dragging-vit_bil_CISM_15_mod.f90
+
+dragging-vit_bil_CISM_45_mod.o : Ant45_CISM_files/dragging-vit_bil_CISM_45_mod.f90
+	$(FT) Ant45_CISM_files/dragging-vit_bil_CISM_45_mod.f90
+
+prop-therm-Heino_mod.o : Heino_files/prop-therm-Heino_mod.f90
+	$(FT) Heino_files/prop-therm-Heino_mod.f90
+
+prop-thermiques_mod.o : prop-thermiques_mod.f90
+	$(FT) prop-thermiques_mod.f90
+
+calving_frange.o : calving_frange.f90
+	$(FT) calving_frange.f90 
+
+no_calving.o : no_calving.f90
+	$(FT) no_calving.f90
+
+track_heino_mod.o : Heino_files/track_heino_mod.f90
+	$(FT) Heino_files/track_heino_mod.f90
+
+track_ant40_mod.o : Ant40_files/track_ant40_mod.f90
+	$(FT) Ant40_files/track_ant40_mod.f90
+
+track_greenmint_mod.o : Greenmint40_files/track_greenmint_mod.f90
+	$(FT) Greenmint40_files/track_greenmint_mod.f90
+
+track_greeneem_mod.o : Greeneem_files/track_greeneem_mod.f90
+	$(FT) Greeneem_files/track_greeneem_mod.f90
+
+track_gsearise_mod.o : Gsearise_files/track_gsearise_mod.f90
+	$(FT) Gsearise_files/track_gsearise_mod.f90
+
+
+#------- modules de resolution equations
+
+relaxation_mod-0.3.o : relaxation_mod-0.3.f90
+	$(FT) relaxation_mod-0.3.f90
+
+relaxation_water_mod-0.4.o : relaxation_water_mod-0.4.f90
+	$(FT) relaxation_water_mod-0.4.f90
+
+relaxation_water_diffusion.o : relaxation_water_diffusion.f90
+	$(FT) relaxation_water_diffusion.f90
+
+tridiag_mod-0.3.o : tridiag_mod-0.3.f90
+	$(FT) tridiag_mod-0.3.f90
+
+resol_adv_diff_2D.o : resol_adv_diff_2D.f90
+	$(FT) resol_adv_diff_2D.f90
+
+resol_adv_diff_2D-juin2009.o : resol_adv_diff_2D-juin2009.f90
+	$(FT) resol_adv_diff_2D-juin2009.f90
+
+resol_adv_diff_2D-sept2009.o : resol_adv_diff_2D-sept2009.f90
+	$(FT) resol_adv_diff_2D-sept2009.f90
+
+#conserv-mass-adv-diff_mod.o : conserv-mass-adv-diff_mod.f90
+#	$(FT) conserv-mass-adv-diff_mod.f90
+
+#precribe-H_mod.o : precribe-H_mod.f90   old version + mauvais nom
+#	$(FT)  precribe-H_mod.f90
+
+prescribe-H_mod.o : prescribe-H_mod.f90
+	$(FT)  prescribe-H_mod.f90
+
+prescribe-H-i2s_mod.o : prescribe-H-i2s_mod.f90
+	$(FT) prescribe-H-i2s_mod.f90
+
+#conserv-mass-adv-diff_juin2009_mod.o : conserv-mass-adv-diff_juin2009_mod.f90
+#	$(FT) conserv-mass-adv-diff_juin2009_mod.f90
+
+conserv-mass-adv-diff_sept2009_mod.o : conserv-mass-adv-diff_sept2009_mod.f90
+	$(FT) conserv-mass-adv-diff_sept2009_mod.f90
+
+# ---------  spinup
+spinup_mod.o : spinup_mod.f90
+	$(FT) spinup_mod.f90
+
+no_spinup_mod.o : no_spinup_mod.f90
+	$(FT) no_spinup_mod.f90
+
+
+
+#-------------Output
+out_horiz_mod.o : out_horiz_mod.f90
+	$(FT) out_horiz_mod.f90
+
+out_profile_mod.o : out_profile_mod.f90
+	$(FT) out_profile_mod.f90
+
+output_anta_mod-0.4.o : Antarctique_general_files/output_anta_mod-0.4.f90
+	$(FT) Antarctique_general_files/output_anta_mod-0.4.f90
+
+output_global_mod.o :output_global_mod.f90
+	$(FT) output_global_mod.f90 
+
+output_green_mod-0.4.o : Greenmint40_files/output_green_mod-0.4.f90
+	$(FT) Greenmint40_files/output_green_mod-0.4.f90
+
+output_greeneem_mod-0.4.o : Greeneem_files/output_greeneem_mod-0.4.f90
+	$(FT) Greeneem_files/output_greeneem_mod-0.4.f90
+
+output_gsearise_mod-0.4.o : Gsearise_files/output_gsearise_mod-0.4.f90
+	$(FT) Gsearise_files/output_gsearise_mod-0.4.f90
+
+output_heino_mod.o : Heino_files/output_heino_mod.f90
+	$(FT) Heino_files/output_heino_mod.f90
+
+output_nord_mod-0.4.o : Heminord_files/output_nord_mod-0.4.f90
+	$(FT) Heminord_files/output_nord_mod-0.4.f90
+
+output_Grice2sea_mod.o : GrIce2sea_files/output_Grice2sea_mod.f90
+	$(FT)  GrIce2sea_files/output_Grice2sea_mod.f90
+
+out_cptr_mod.o : out_cptr_mod.f90
+	$(F_NETCDF) out_cptr_mod.f90
+
+util_recovery.o : util_recovery.f90
+	$(FT) util_recovery.f90
+
+printtable_mod.o : printtable_mod.f90	
+	$(FT) printtable_mod.f90
+
+# modules "fake" pour compatibilite
+#----------------------------------
+
+fake-routines-Heino_mod.o : Heino_files/fake-routines-Heino_mod.f90
+	$(FT) Heino_files/fake-routines-Heino_mod.f90
+
+fake-routines-ant_mod.o : Antarctique_general_files/fake-routines-ant_mod.f90
+	$(FT) Antarctique_general_files/fake-routines-ant_mod.f90
+
+fake-routines-greenmint_mod.o : Greenmint40_files/fake-routines-greenmint_mod.f90
+	$(FT) Greenmint40_files/fake-routines-greenmint_mod.f90
+
+fake-routines-greeneem_mod.o : Greeneem_files/fake-routines-greeneem_mod.f90
+	$(FT) Greeneem_files/fake-routines-greeneem_mod.f90
+
+fake-routines-gsearise_mod.o : Gsearise_files/fake-routines-gsearise_mod.f90
+	$(FT) Gsearise_files/fake-routines-gsearise_mod.f90
+
+fake-routines-nord_mod.o : Heminord_files/fake-routines-nord_mod.f90
+	$(FT) Heminord_files/fake-routines-nord_mod.f90
+
+fake-routines_Grice2sea_mod.o : GrIce2sea_files/fake-routines_Grice2sea_mod.f90
+	$(FT) GrIce2sea_files/fake-routines_Grice2sea_mod.f90
+
+# modules choix pour selectionner les modules physiques
+#--------------------------------------------------------
+
+module_choix-heino-0.4.o : Heino_files/module_choix-heino-0.4.f90
+	$(FT)  Heino_files/module_choix-heino-0.4.f90
+
+module_choix-heminord-0.4.o : Heminord_files/module_choix-heminord-0.4.f90
+	$(FT)  Heminord_files/module_choix-heminord-0.4.f90
+
+module_choix-antar40-0.4.o : Ant40_files/module_choix-antar40-0.4.f90
+	$(FT)  Ant40_files/module_choix-antar40-0.4.f90
+
+module_choix_antar15_LBq.o : ANT15-LBq_files/module_choix_antar15_LBq.f90
+	$(FT) ANT15-LBq_files/module_choix_antar15_LBq.f90
+
+module_choix_antar15CISM.o : Ant15_CISM_files/module_choix_antar15CISM.f90
+	$(FT) Ant15_CISM_files/module_choix_antar15CISM.f90
+
+module_choix_antar20CISM.o : Ant20_CISM_files/module_choix_antar20CISM.f90
+	$(FT) Ant20_CISM_files/module_choix_antar20CISM.f90
+
+module_choix_antar25CISM.o : Ant25_CISM_files/module_choix_antar25CISM.f90
+	$(FT) Ant25_CISM_files/module_choix_antar25CISM.f90
+
+module_choix_antar45CISM.o : Ant45_CISM_files/module_choix_antar45CISM.f90
+	$(FT) Ant45_CISM_files/module_choix_antar45CISM.f90
+
+module_choix-antar40-0.4_old.o : Ant40_files/module_choix-antar40-0.4_old.f90
+	$(FT)  Ant40_files/module_choix-antar40-0.4_old.f90
+
+module_choix-greenmint-40.o : Greenmint40_files/module_choix-greenmint-40.f90
+	$(FT) Greenmint40_files/module_choix-greenmint-40.f90
+
+module_choix-greeneem.o : Greeneem_files/module_choix-greeneem.f90
+	$(FT) Greeneem_files/module_choix-greeneem.f90
+
+module_choix-gsearise.o : Gsearise_files/module_choix-gsearise.f90
+	$(FT) Gsearise_files/module_choix-gsearise.f90
+
+module_choix_GrIce2sea.o : GrIce2sea_files/module_choix_GrIce2sea.f90
+	$(FT) GrIce2sea_files/module_choix_GrIce2sea.f90
+
+# Routines pour MISMIP
+#-----------------------
+
+climat-mismip3d_mod.o : MISMIP3D_files/climat-mismip3d_mod.f90
+	$(FT) MISMIP3D_files/climat-mismip3d_mod.f90
+
+dragging_mismip3d_mod.o : MISMIP3D_files/dragging_mismip3d_mod.f90
+	$(FT) MISMIP3D_files/dragging_mismip3d_mod.f90
+
+fake-routines-mismip3d_mod.o : MISMIP3D_files/fake-routines-mismip3d_mod.f90
+	$(FT) MISMIP3D_files/fake-routines-mismip3d_mod.f90
+
+lect-mismip3d_mod.o : MISMIP3D_files/lect-mismip3d_mod.f90 
+	$(F_NETCDF) MISMIP3D_files/lect-mismip3d_mod.f90
+
+geography-Mismip3d.o : MISMIP3D_files/geography-Mismip3d.f90 
+	$(FT) MISMIP3D_files/geography-Mismip3d.f90 
+
+paradim_mismip3D_5km_mod.o : MISMIP3D_files/paradim_mismip3D_5km_mod.f90
+	$(FT)  MISMIP3D_files/paradim_mismip3D_5km_mod.f90
+
+module_choix_mismip3d.o : MISMIP3D_files/module_choix_mismip3d.f90
+	$(F_NETCDF) MISMIP3D_files/module_choix_mismip3d.f90
+
+
+# Routines specifiques du programme : par ordre alphabetique
+#-----------------------------------
+
+tracebug.o : tracebug.f90
+	$(FT) tracebug.f90
+
+ablation-0.2.o : ablation-0.2.f #module3d.mod
+	$(FT) ablation-0.2.f
+
+ablation_bord.o : ablation_bord.f90
+	$(FT) ablation_bord.f90
+
+accum7.o : accum7.f
+	$(FT) accum7.f
+
+bmelt-grounded.o : bmelt-grounded.f90
+	$(FT) bmelt-grounded.f90
+
+calceps2-0.2.o : calceps2-0.2.f #module3d.mod
+	$(FT) calceps2-0.2.f
+
+courbures.o : courbures.f90
+	$(FT) courbures.f90
+
+detect-assym.o : Heino_files/detect-assym.f90
+	$(FT) Heino_files/detect-assym.f90
+
+diagno-ant-0.6_mod.o : diagno-ant-0.6_mod.f90
+	$(FT) diagno-ant-0.6_mod.f90
+
+diffusiv-polyn-0.5.o : diffusiv-polyn-0.5.f90 #module3d.mod
+	$(FT) diffusiv-polyn-0.5.f90
+
+diffusiv-polyn-0.6.o : diffusiv-polyn-0.6.f90 #module3d.mod
+	$(FT) diffusiv-polyn-0.6.f90
+
+eaubasale-0.5_mod.o : eaubasale-0.5_mod.f90
+	$(FT) eaubasale-0.5_mod.f90
+
+firstoutput-0.2.o : firstoutput-0.2.f #module3d.mod
+	$(FT) firstoutput-0.2.f
+
+#flottab2-0.6.o : flottab2-0.6.f90 #module3d.mod
+#	$(FT) flottab2-0.6.f90
+
+flottab2-0.7.o : flottab2-0.7.f90 #module3d.mod
+	$(FT) flottab2-0.7.f90
+
+#flottab2-0.5-heino.o : Heino_files/flottab2-0.5-heino.f90 #module3d.mod
+#	$(FT) Heino_files/flottab2-0.5-heino.f90
+
+flottab-rescue-1.o : flottab-rescue-1.f90 #module3d.mod
+	$(FT) flottab-rescue-1.f90
+
+flowlaw-0.3.o : flowlaw-0.3.f90 #module3d.mod
+	$(FT) flowlaw-0.3.f90
+
+flow_general-0.3.o : flow_general-0.3.f90 #module3d.mod deform_declar.mod
+	$(FT) flow_general-0.3.f90
+
+
+initial-heino-phy.o : Heino_files/initial-heino-phy.f90
+	$(FT) Heino_files/initial-heino-phy.f90
+
+no-icethick.o : no-icethick.f90  #module3d.mod 
+	$(FT) no-icethick.f90
+
+initial-0.3.o : initial-0.3.f90
+	$(F_NETCDF) initial-0.3.f90
+
+#initial-phy-2.o : initial-phy-2.f90  #module3d.mod iso_declar.mod
+#	$(FT) initial-phy-2.f90
+
+
+
+initial2-0.4.o : initial2-0.4.f90  #module3d.mod iso_declar.mod
+	$(FT) initial2-0.4.f90
+
+
+inputfile-vec-0.5.o : inputfile-vec-0.5.f90#module3d.mod
+	$(FT) inputfile-vec-0.5.f90
+
+lastoutput-0.2.o : lastoutput-0.2.f#module3d.mod
+	$(FT) lastoutput-0.2.f
+
+lect-eis.o : lect-eis.F
+	$(FT) lect-eis.F
+
+lect_datfile.o : lect_datfile.f90
+	$(FT) lect_datfile.f90
+
+write_datfile.o : write_datfile.f90
+	$(FT) write_datfile.f90
+
+limit_file.o : limit_file.f90
+	$(FT) limit_file.f90
+
+lineartemp-0.2.o : lineartemp-0.2.F#module3d.mod
+	$(FT) lineartemp-0.2.F
+
+litho-0.3.o : litho-0.3.f90#module3d.mod iso_declar.mod
+	$(FT) litho-0.3.f90
+
+litho-0.4.o : litho-0.4.f90#module3d.mod iso_declar.mod
+	$(FT) litho-0.4.f90
+
+main3D-0.4-40km.o : main3D-0.4-40km.f90 #module3d.mod iso_declar.mod
+	$(F_NETCDF) main3D-0.4-40km.f90
+
+masque-0.2.o : masque-0.2.F#module3d.mod
+	$(FT) masque-0.2.F
+
+masque.o : masque.f90
+	$(FT) masque.f90
+
+massb-grice2sea_perturb_Tparam.o : GrIce2sea_files/massb-grice2sea_perturb_Tparam.f90
+	$(FT) GrIce2sea_files/massb-grice2sea_perturb_Tparam.f90
+
+
+
+massb-ant_perturb_Tparam.o : Antarctique_general_files/massb-ant_perturb_Tparam.f90
+	$(FT) Antarctique_general_files/massb-ant_perturb_Tparam.f90
+
+massbal-anteis-0.2.o : Ant40_files/massbal-anteis-0.2.f#module3d.mod
+	$(FT) Ant40_files/massbal-anteis-0.2.f
+
+massb_perturb_Tparam_green.o : Greenmint40_files/massb_perturb_Tparam_green.f90
+	$(FT) Greenmint40_files/massb_perturb_Tparam_green.f90
+
+massb_perturb_Tparam_greeneem.o : Greeneem_files/massb_perturb_Tparam_greeneem.f90
+	$(FT) Greeneem_files/massb_perturb_Tparam_greeneem.f90
+
+massb_perturb_Tparam_gsearise.o : Gsearise_files/massb_perturb_Tparam_gsearise.f90
+	$(FT) Gsearise_files/massb_perturb_Tparam_gsearise.f90
+
+massb_perturb_mois.o : massb_perturb_mois.f90
+	$(FT) massb_perturb_mois.f90
+
+massb_perturb_mois_lapsecouche.o : massb_perturb_mois_lapsecouche.f90
+	$(FT) massb_perturb_mois_lapsecouche.f90
+
+massb-GrIce2sea_fixe.o : GrIce2sea_files/massb-GrIce2sea_fixe.f90
+	$(FT) GrIce2sea_files/massb-GrIce2sea_fixe.f90
+
+massb-GrIce2sea_RCM.o : GrIce2sea_files/massb-GrIce2sea_RCM.f90
+	$(FT) GrIce2sea_files/massb-GrIce2sea_RCM.f90
+
+minmax-format.o : minmax-format.f90
+	$(FT) minmax-format.f90
+
+mix-SIA-L1_mod.o : mix-SIA-L1_mod.f90
+	$(FT) mix-SIA-L1_mod.f90
+
+moy_mxmy_shift.o : moy_mxmy_shift.f90
+	$(FT) moy_mxmy_shift.f90
+
+moy_mxmy.o : moy_mxmy.f90
+	$(FT) moy_mxmy.f90
+
+neffect-0.3.o : neffect-0.3.f90 #module3d.mod
+	$(FT) neffect-0.3.f90
+
+neffect-0.4.o : neffect-0.4.f90 #module3d.mod
+	$(FT) neffect-0.4.f90
+
+new-flot-0.3.o : new-flot-0.3.f90#module3d.mod
+	$(FT) new-flot-0.3.f90
+
+next-time.o : next-time.f90
+	$(FT) next-time.f90
+
+#plotoutput.o : plotoutput.f#module3d.mod
+#	$(FT) plotoutput.f
+
+printdebug.o : printdebug.f90 #module3d.mod
+	$(FT) printdebug.f90
+
+remplimat-ant-0.5-40km.o : remplimat-ant-0.5-40km.f90 #module3d.mod eq_elliptique_mod.mod
+	$(FT) remplimat-ant-0.5-40km.f90
+
+sealevel-out.o : sealevel-out.f90#module3d.mod
+	$(FT) sealevel-out.f90
+
+snaptime.o : snaptime.f90
+	$(FT) snaptime.f90
+
+sortie-hz-multivar.o : sortie-hz-multivar.f90
+	$(FT) sortie-hz-multivar.f90
+
+strain_rate.o : strain_rate.f90#module3d.mod
+	$(FT) strain_rate.f90	
+
+surface-0.3.o : surface-0.3.f90#module3d.mod
+	$(FT) surface-0.3.f90
+
+slope_surf.o : slope_surf.f90
+	$(FT) slope_surf.f90
+
+tab-litho-0.3.o : tab-litho-0.3.f90#module3d.mod iso_declar.mod
+	$(FT) tab-litho-0.3.f90
+
+taubed-0.3.o : taubed-0.3.f90#module3d.mod iso_declar.mod
+	$(FT) taubed-0.3.f90
+
+#ts-output-0.2.o : ts-output-0.2.f                    
+#	$(FT) ts-output-0.2.f
+
+velocities-polyn-0.3.o : velocities-polyn-0.3.f90     #module3d.mod
+	$(FT) velocities-polyn-0.3.f90
+
+vtoutput-0.2.o : vtoutput-0.2.f#module3d.mod
+	$(FT) vtoutput-0.2.f
+
+# Routines Hudson :
+
+paradim-hudson_mod.o : Hudson_files/paradim-hudson_mod.f90
+	$(FT)  Hudson_files/paradim-hudson_mod.f90
+
+geography-hudson_mod.o : Hudson_files/geography-hudson_mod.f90
+	$(FT)  Hudson_files/geography-hudson_mod.f90
+
+sedim_declar_hudson_mod.o : Hudson_files/sedim_declar_hudson_mod.f90
+	$(FT)  Hudson_files/sedim_declar_hudson_mod.f90
+
+eaubasale-0.5_hudson_mod.o : Hudson_files/eaubasale-0.5_hudson_mod.f90
+	$(FT)  Hudson_files/eaubasale-0.5_hudson_mod.f90
+
+climat-hudson_mod.o : Hudson_files/climat-hudson_mod.f90
+	$(FT)  Hudson_files/climat-hudson_mod.f90
+
+lect-hudson_mod.o : Hudson_files/lect-hudson_mod.f90
+	$(FT)  Hudson_files/lect-hudson_mod.f90
+
+fake-routines-hudson_mod.o : Hudson_files/fake-routines-hudson_mod.f90
+	$(FT)  Hudson_files/fake-routines-hudson_mod.f90
+
+prop-therm-hudson_mod.o : Hudson_files/prop-therm-hudson_mod.f90
+	$(FT)  Hudson_files/prop-therm-hudson_mod.f90
+
+sliding-hudson_mod.o : Hudson_files/sliding-hudson_mod.f90
+	$(FT)  Hudson_files/sliding-hudson_mod.f90
+
+fake-dragging-hudson_mod.o : Hudson_files/fake-dragging-hudson_mod.f90
+	$(FT)  Hudson_files/fake-dragging-hudson_mod.f90
+
+dragging_hudson_jorge_mod.o : Hudson_files/dragging_hudson_jorge_mod.f90
+	$(FT)  Hudson_files/dragging_hudson_jorge_mod.f90
+
+dragging-hudson_mod.o : Hudson_files/dragging-hudson_mod.f90
+	$(FT)  Hudson_files/dragging-hudson_mod.f90
+
+dragging_hwatermax_hudson_mod.o : Hudson_files/dragging_hwatermax_hudson_mod.f90
+	$(FT)  Hudson_files/dragging_hwatermax_hudson_mod.f90
+
+bmelt_hudson_mod.o : Hudson_files/bmelt_hudson_mod.f90
+	$(FT)  Hudson_files/bmelt_hudson_mod.f90
+
+initial-hudson-phy.o : Hudson_files/initial-hudson-phy.f90
+	$(FT)  Hudson_files/initial-hudson-phy.f90
+
+output_hudson_mod.o : Hudson_files/output_hudson_mod.f90
+	$(FT)  Hudson_files/output_hudson_mod.f90
+
+module_choix-hudson-0.4.o : Hudson_files/module_choix-hudson-0.4.f90
+	$(FT)  Hudson_files/module_choix-hudson-0.4.f90
+
+track_hudson_mod.o : Hudson_files/track_hudson_mod.f90
+	$(FT) Hudson_files/track_hudson_mod.f90
+
+
+# Routines Hemin-40 :
+
+
+paradim-hemin40_mod.o : Hemin40_files/paradim-hemin40_mod.f90
+	$(FT) Hemin40_files/paradim-hemin40_mod.f90
+
+geography-hemin40_mod.o : Hemin40_files/geography-hemin40_mod.f90
+	$(FT) Hemin40_files/geography-hemin40_mod.f90
+
+output_hemin40_mod.o : Hemin40_files/output_hemin40_mod.f90
+	$(FT) Hemin40_files/output_hemin40_mod.f90
+
+lect-hemin40_mod.o : Hemin40_files/lect-hemin40_mod.f90
+	$(FT) Hemin40_files/lect-hemin40_mod.f90
+
+bmelt-hemin40-regions_mod.o : Hemin40_files/bmelt-hemin40-regions_mod.f90
+	$(FT) Hemin40_files/bmelt-hemin40-regions_mod.f90
+
+bmelt-hemin40-depth_mod.o : Hemin40_files/bmelt-hemin40-depth_mod.f90
+	$(FT) Hemin40_files/bmelt-hemin40-depth_mod.f90
+
+fake-routines-hemin40_mod.o : Hemin40_files/fake-routines-hemin40_mod.f90
+	$(FT) Hemin40_files/fake-routines-hemin40_mod.f90
+
+module_choix-hemin40-0.4.o : Hemin40_files/module_choix-hemin40-0.4.f90
+	$(FT) Hemin40_files/module_choix-hemin40-0.4.f90
+
+track_hemin40_mod.o : Hemin40_files/track_hemin40_mod.f90
+	$(FT) Hemin40_files/track_hemin40_mod.f90
+
+# Routines Hemin-15 :
+
+paradim-hemin15_mod.o : Hemin15_files/paradim-hemin15_mod.f90
+	$(FT) Hemin15_files/paradim-hemin15_mod.f90
+
+geography-hemin15_mod.o : Hemin15_files/geography-hemin15_mod.f90
+	$(FT) Hemin15_files/geography-hemin15_mod.f90
+
+lect-hemin15_mod.o : Hemin15_files/lect-hemin15_mod.f90
+	$(FT) Hemin15_files/lect-hemin15_mod.f90
+
+fake-routines-hemin15_mod.o : Hemin15_files/fake-routines-hemin15_mod.f90
+	$(FT) Hemin15_files/fake-routines-hemin15_mod.f90
+
+module_choix-hemin15.o : Hemin15_files/module_choix-hemin15.f90
+	$(FT) Hemin15_files/module_choix-hemin15.f90
+
+track_hemin15_mod.o : Hemin15_files/track_hemin15_mod.f90
+	$(FT) Hemin15_files/track_hemin15_mod.f90
+
+# routines Eurasie-40
+
+
+output_eurasie40_mod-0.1.o : Eurasie40_files/output_eurasie40_mod-0.1.f90
+	$(FT) Eurasie40_files/output_eurasie40_mod-0.1.f90
+
+lect-clim-act-eurasie_mod.o : Eurasie40_files/lect-clim-act-eurasie_mod.f90
+	$(FT) Eurasie40_files/lect-clim-act-eurasie_mod.f90
+
+climat-forcage-eurasie_mod-0.4.o : Eurasie40_files/climat-forcage-eurasie_mod-0.4.f90
+	$(FT) Eurasie40_files/climat-forcage-eurasie_mod-0.4.f90
+
+fake-routines-eurasie_mod.o : Eurasie40_files/fake-routines-eurasie_mod.f90
+	$(FT) Eurasie40_files/fake-routines-eurasie_mod.f90
+
+module_choix-eurasie-0.4.o : Eurasie40_files/module_choix-eurasie-0.4.f90
+	$(FT) Eurasie40_files/module_choix-eurasie-0.4.f90
+
+track_eurasie_mod.o : Eurasie40_files/track_eurasie_mod.f90
+	$(FT) Eurasie40_files/track_eurasie_mod.f90
+
+
+# routines greenmint-40
+
+
+# Routines Temperature Hassine
+
+icetemp_declar-0.5_mod.o : Temperature-routines/icetemp_declar-0.5_mod.f90
+	$(FT) Temperature-routines/icetemp_declar-0.5_mod.f90
+
+interface_advec_icetemp.o :  Temperature-routines/interface_advec_icetemp.f90
+	$(FT) Temperature-routines/interface_advec_icetemp.f90
+
+interface_icetempmod.o :  Temperature-routines/interface_icetempmod.f90
+	$(FT) Temperature-routines/interface_icetempmod.f90
+
+interface_prop_th_icetemp.o:  Temperature-routines/interface_prop_th_icetemp.f90
+	$(FT) Temperature-routines/interface_prop_th_icetemp.f90
+
+interface_Qprod_icetemp.o:  Temperature-routines/interface_Qprod_icetemp.f90
+	$(FT) Temperature-routines/interface_Qprod_icetemp.f90
+
+interface_temp_col.o :  Temperature-routines/interface_temp_col.f90
+	$(FT) Temperature-routines/interface_temp_col.f90
+
+# Routines Agrif
+
+#open_file.o : open_file.f90
+#	$(FT) open_file.f90
+
+step.o : step.f90
+	$(F_NETCDF) step.f90
+
+steps_time_loop.o : steps_time_loop.f90
+	$(F_NETCDF) steps_time_loop.f90
+
+steps_time_loop_avec_iterbeta.o : steps_time_loop_avec_iterbeta.f90
+	$(F_NETCDF) steps_time_loop_avec_iterbeta.f90
+
+# nouvelles routines resolution equation elliptique
+
+remplimat_declar_tabTu_mod.o : New-remplimat/remplimat_declar_tabTu_mod.f90
+	$(FT) New-remplimat/remplimat_declar_tabTu_mod.f90
+
+diagno-L2_mod.o : New-remplimat/diagno-L2_mod.f90
+	$(FT) New-remplimat/diagno-L2_mod.f90
+
+fake_diagno_mod.o : New-remplimat/fake_diagno_mod.f90
+	$(FT) New-remplimat/fake_diagno_mod.f90
+
+remplimat-shelves-tabTu.o : New-remplimat/remplimat-shelves-tabTu.f90
+	$(FT) New-remplimat/remplimat-shelves-tabTu.f90
+
+eq_ellipt_sgbsv_mod-0.2.o : New-remplimat/eq_ellipt_sgbsv_mod-0.2.f90
+	$(FT) New-remplimat/eq_ellipt_sgbsv_mod-0.2.f90
+
+graphique_L2.o : New-remplimat/graphique_L2.f90
+	$(FT) New-remplimat/graphique_L2.f90
+
+graph-sgbsv.o : New-remplimat/graph-sgbsv.f90
+	$(FT) New-remplimat/graph-sgbsv.f90
+
+# Routines venant de bibliotheques exterieures
+reduc.o : reduc.f#module3d.mod
+	$(FT) $(F_90) reduc.f
+
+# band vient de Lapack
+band.o: band.f
+	$(FT) $(F_90) band.f
+
+#BLAS
+isamax.o : BLAS/isamax.f
+	$(FT)  BLAS/isamax.f
+lsame.o : BLAS/lsame.f
+	$(FT) BLAS/lsame.f
+scopy.o: BLAS/scopy.f
+	$(FT) BLAS/scopy.f
+slamch.o: BLAS/slamch.f
+	$(FT) BLAS/slamch.f
+slabad.o: BLAS/slabad.f
+	$(FT) BLAS/slabad.f
+slange.o: BLAS/slange.f
+	$(FT) BLAS/slange.f
+slassq.o: BLAS/slassq.f
+	$(FT) BLAS/slassq.f
+sgeqrf.o: BLAS/sgeqrf.f
+	$(FT) BLAS/sgeqrf.f
+sormqr.o: BLAS/sormqr.f
+	$(FT) BLAS/sormqr.f
+strmv.o: BLAS/strmv.f
+	$(FT) BLAS/strmv.f
+slarft.o: BLAS/slarft.f
+	$(FT) BLAS/slarft.f
+ilaslr.o: BLAS/ilaslr.f
+	$(FT) BLAS/ilaslr.f
+ilaslc.o: BLAS/ilaslc.f
+	$(FT) BLAS/ilaslc.f
+strmm.o: BLAS/strmm.f
+	$(FT) BLAS/strmm.f
+slarfb.o: BLAS/slarfb.f
+	$(FT) BLAS/slarfb.f
+slapy2.o: BLAS/slapy2.f
+	$(FT) BLAS/slapy2.f
+slarfg.o: BLAS/slarfg.f
+	$(FT) BLAS/slarfg.f
+slarf.o: BLAS/slarf.f
+	$(FT) BLAS/slarf.f
+sgeqr2.o: BLAS/sgeqr2.f
+	$(FT) BLAS/sgeqr2.f
+saxpy.o: BLAS/saxpy.f
+	$(FT) BLAS/saxpy.f
+slarz.o: BLAS/slarz.f
+	$(FT) BLAS/slarz.f
+sorm2r.o: BLAS/sorm2r.f
+	$(FT) BLAS/sorm2r.f
+snrm2.o: BLAS/snrm2.f
+	$(FT) BLAS/snrm2.f
+slaqps.o: BLAS/slaqps.f
+	$(FT) BLAS/slaqps.f
+slaqp2.o: BLAS/slaqp2.f
+	$(FT) BLAS/slaqp2.f
+sgeqp3.o: BLAS/sgeqp3.f
+	$(FT) BLAS/sgeqp3.f
+slaset.o: BLAS/slaset.f
+	$(FT) BLAS/slaset.f
+slaisnan.o: BLAS/slaisnan.f
+	$(FT) BLAS/slaisnan.f
+sisnan.o: BLAS/sisnan.f
+	$(FT) BLAS/sisnan.f
+slascl.o: BLAS/slascl.f
+	$(FT) BLAS/slascl.f
+sdot.o: BLAS/sdot.f
+	$(FT) BLAS/sdot.f
+slaic1.o: BLAS/slaic1.f
+	$(FT) BLAS/slaic1.f
+slarzb.o: BLAS/slarzb.f
+	$(FT) BLAS/slarzb.f
+slarzt.o: BLAS/slarzt.f
+	$(FT) BLAs/slarzt.f
+sormr3.o: BLAS/sormr3.f
+	$(FT) BLAS/sormr3.f
+sormrz.o: BLAS/sormrz.f
+	$(FT) BLAS/sormrz.f
+slatrz.o: BLAS/slatrz.f
+	$(FT) BLAS/slatrz.f
+stzrzf.o: BLAS/stzrzf.f
+	$(FT) BLAS/stzrzf.f
+sgelsy.o: BLAS/sgelsy.f
+	$(FT) BLAS/sgelsy.f
+sgbmv.o: BLAS/sgbmv.f
+	$(FT) BLAS/sgbmv.f
+sgemm.o: BLAS/sgemm.f
+	$(FT) BLAS/sgemm.f
+sgemv.o: BLAS/sgemv.f
+	$(FT) BLAS/sgemv.f
+sger.o: BLAS/sger.f
+	$(FT) BLAS/sger.f
+sscal.o: BLAS/sscal.f
+	$(FT) BLAS/sscal.f
+sswap.o: BLAS/sswap.f
+	$(FT) BLAS/sswap.f
+stbsv.o: BLAS/stbsv.f
+	$(FT) BLAS/stbsv.f
+strsm.o: BLAS/strsm.f
+	$(FT) BLAS/strsm.f
+xerbla.o: BLAS/xerbla.f
+	$(FT) BLAS/xerbla.f
+
+# routines netcdf
+
+
+
+io_netcdf.o: Netcdf-routines/io_netcdf.f90 
+	$(F_NETCDF) Netcdf-routines/io_netcdf.f90 
+
+sortie_netcdf_GRISLI_mod.0.2.o : Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2.f90
+	$(F_NETCDF) Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2.f90
+
+# Hassine
+io_netcdf_GRISLI.o: Netcdf-routines/io_netcdf_GRISLI.f90 
+	$(F_NETCDF) Netcdf-routines/io_netcdf_GRISLI.f90 
+
+sortie_netcdf_GRISLI_mod.0.2-hassine.o : Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90
+	$(F_NETCDF) Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90
+
+readinput.o: readinput.f90 
+	$(F_NETCDF) readinput.f90 
+
+interface_input.o: interface_input.f90
+	$(FT) interface_input.f90
+
+
+# routines et modules recul de ligne d'echouage ice2sea
+
+proto_declar_3D_grisli_mod.o : Recul_force_grounding_line/proto_declar_3D_grisli_mod.f90
+	$(FT) Recul_force_grounding_line/proto_declar_3D_grisli_mod.f90
+
+declar_proto_recul.o : Recul_force_grounding_line/declar_proto_recul.f90
+	$(FT) Recul_force_grounding_line/declar_proto_recul.f90
+
+proto_recul_mod.o : Recul_force_grounding_line/proto_recul_mod.f90
+	$(FT) Recul_force_grounding_line/proto_recul_mod.f90
+
+declar_io_ncdf_proto_mod.o : Recul_force_grounding_line/declar_io_ncdf_proto_mod.f90
+	$(FT) Recul_force_grounding_line/declar_io_ncdf_proto_mod.f90
+
+#	$(FT) -I$(NDC_INC) Netcdf-routines/sortie_netcdf_GRISLI_mod.f90
+
+
+# routines et modules recul de ligne d'echouage ice2sea version toy (finale)
+
+toy_declar_3D_grisli_mod.o : Recul_force_grounding_line/toy_declar_3D_grisli_mod.f90
+	$(FT) Recul_force_grounding_line/toy_declar_3D_grisli_mod.f90
+
+declar_io_ncdf_toy_mod_fake.o : Recul_force_grounding_line/declar_io_ncdf_toy_mod_fake.f90
+	$(FT) Recul_force_grounding_line/declar_io_ncdf_toy_mod_fake.f90
+
+declar_toy_retreat.o : Recul_force_grounding_line/declar_toy_retreat.f90
+	$(FT) Recul_force_grounding_line/declar_toy_retreat.f90
+
+toy_retreat_mod.o  : Recul_force_grounding_line/toy_retreat_mod.f90
+	$(F_NETCDF) Recul_force_grounding_line/toy_retreat_mod.f90
+
+
+
+
+# Liens et Construction des executables
+#---------------------------------------
+#       $(mod_clim_forcage) \ a mettre a la place de mod_clim_perturb eventuellement
+
+
+LBqAntar15 : $(Dim_ANT15-LBq) $(mod_dim_communs)  \
+	$(Proto_recul)  \
+	$(mod_communs) \
+	$(Proto_recul)  \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_ANT15-LBq) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) 
+
+	$(LK) -o ../bin/LBqAntar-15  $(Dim_ANT15-LBq) $(mod_dim_communs) \
+	$(Proto_recul)  \
+	$(mod_communs) \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) \
+	$(Liste_ANT15-LBq) \
+	$(mod_post_geo) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Recul_ice2sea : $(Dim_ANT15-LBq) $(mod_dim_communs)  \
+	$(toy_recul) \
+	$(mod_communs_RGL) \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_ANT15-LBq) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes)steps_time_loop.o  $(routine_elliptiques) 
+
+	$(LK) -o ../bin/recul_gl  $(Dim_ANT15-LBq) $(mod_dim_communs) \
+	$(toy_recul) \
+	$(mod_communs_RGL) \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) \
+	$(Liste_ANT15-LBq) \
+	$(mod_post_geo) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+
+Mismip3D_5 : $(Dim_Mismip_3D_5)	 $(mod_dim_communs)  $(mod_communs) \
+	$(mod_ell) $(Liste_mismip_3D_5) \
+	$(Liste_Netcdf) $(Liste_mismip_post_ncdf) \
+	$(diagnoshelf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) 
+
+	$(LK) -o ../bin/mismip3D  $(Dim_Mismip_3D_5)  \
+	$(mod_dim_communs) fake-routines-mismip3d_mod.o $(mod_communs) \
+	$(mod_ell)  $(Liste_mismip_3D_5) \
+	$(Liste_Netcdf) $(Liste_mismip_post_ncdf) $(diagnoshelf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Grice2sea : $(Dim_GrIce2sea) $(mod_dim_communs)   \
+	$(toy_recul)  \
+	$(mod_communs_RGL) \
+	$(mod_clim_tof)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_GrIce2sea) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Grice2sea \
+	$(Dim_GrIce2sea) $(mod_dim_communs)  \
+	$(toy_recul)  \
+	$(mod_communs_RGL) \
+	$(mod_clim_tof)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_GrIce2sea) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Grice2sea_iterbeta : $(Dim_GrIce2sea) $(mod_dim_communs)   \
+	$(toy_recul)  \
+	$(mod_communs_RGL) \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_GrIce2sea) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop_avec_iterbeta.o \
+	$(routine_elliptiques) 
+
+	$(LK) -o ../bin/Grice2sea_iterbeta \
+	$(Dim_GrIce2sea) $(mod_dim_communs)  \
+	$(toy_recul)  \
+	$(mod_communs_RGL) \
+	$(mod_clim_perturb)  \
+	$(mod_tracers) \
+	$(mod_ell) $(Liste_GrIce2sea) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop_avec_iterbeta.o \
+	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Hemin-40 : $(Dim_hemin40) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_hemin40) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) \
+	$(Liste_BLAS)
+
+	$(LK) -o  ../bin/Hemin-40 \
+	$(Dim_hemin40) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_hemin40) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) $(NCDF_LIB) $(Liste_BLAS)
+
+Hemin-15 : $(Dim_hemin15) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_hemin15) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques)
+
+	$(LK) -o  ../bin/Hemin-15 \
+	$(Dim_hemin15) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_hemin15) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Greeneem15 : $(Dim_greeneem15) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_greeneem15) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) 
+
+	$(LK) -o ../bin/Greeneem15 \
+	$(Dim_greeneem15) $(mod_dim_communs) \
+	$(toy_recul)  \
+	$(mod_communs) \
+	$(mod_clim_tof) \
+	$(mod_no_tracers) \
+	$(mod_ell) $(Liste_greeneem15) \
+	$(mod_post_geo) \
+	$(diagnoshelf) \
+	$(Liste_Netcdf) \
+	$(routines_communes) steps_time_loop.o \
+	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+
+
+# attention : dans les geometries suivantes la liste module climat n'est pas donnee
+
+Hudson : $(Dim_hudson) $(mod_dim_communs) $(mod_communs)  $(mod_ell) $(Liste_hudson) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) $(routine_elliptiques)  
+	$(LK) -o ../bin/Hudson 	$(Dim_hudson) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_hudson) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB) $(MKL_LIB)
+
+#Hemin-40 : $(Dim_hemin40) $(mod_dim_communs) $(mod_communs)  $(mod_ell)  $(Liste_hemin40) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques)  
+
+#	$(LK) -o  ../bin/Hemin-40  $(Dim_hemin40) $(mod_dim_communs) $(mod_communs) \
+#	$(mod_ell)  $(Liste_hemin40) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Heminord : $(Liste_heminord) $(Liste_commune) $(Liste_BLAS)
+	$(LK) -o Heminord $(Liste_heminord) $(Liste_commune) $(Liste_BLAS)
+
+
+Eura-40 :  $(Dim_eura40) $(mod_dim_communs) $(mod_communs)  $(mod_ell)  $(Liste_eura40) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o  ../bin/Eura-40  $(Dim_eura40) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell)  $(Liste_eura40) \
+	$(diagnoshelf) $(Liste_Netcdf) \
+	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+Greenmint40 : $(Dim_greenmint40) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell) $(Liste_greenmint40) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Greenmint40 $(Dim_greenmint40) $(mod_dim_communs) $(mod_communs) \
+        $(mod_ell) $(Liste_greenmint40) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) \
+	$(NCDF_LIB)  $(MKL_LIB)
+
+Greeneem45 : $(Dim_greeneem45) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell) $(Liste_greeneem45) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Greeneem45 $(Dim_greeneem45) $(mod_dim_communs) $(mod_communs) \
+        $(mod_ell) $(Liste_greeneem45) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) \
+	$(NCDF_LIB)  $(MKL_LIB)
+
+Greeneem05 : $(Dim_greeneem05) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell) $(Liste_greeneem05) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Greeneem05 $(Dim_greeneem05) $(mod_dim_communs) $(mod_communs) \
+        $(mod_ell) $(Liste_greeneem05) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) \
+	$(NCDF_LIB)  $(MKL_LIB)
+
+
+Gsearise15 : $(Dim_gsearise15) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell) $(Liste_gsearise15) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Gsearise15 $(Dim_gsearise15) $(mod_dim_communs) $(mod_communs) \
+        $(mod_ell) $(Liste_gsearise15) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) \
+	$(NCDF_LIB)  $(MKL_LIB)
+
+
+Gsearise05 : $(Dim_gsearise05) $(mod_dim_communs) $(mod_communs) \
+	$(mod_ell) $(Liste_gsearise05) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) 
+
+	$(LK) -o ../bin/Gsearise05 $(Dim_gsearise05) $(mod_dim_communs) $(mod_communs) \
+        $(mod_ell) $(Liste_gsearise05) \
+	$(diagnoshelf) $(Liste_Netcdf) $(routines_communes) $(routine_elliptiques) \
+	$(NCDF_LIB)  $(MKL_LIB)
+
+
+
+
+clean	:
+	rm -f *.o *.mod *~  */*~ BLAS/*.o
+
+
+
+
+
+
+
+
+
+# geographies obsoletes
+
+# listes
+
+#Liste_Antar15_CISM = lect-Ant_clim_CISM_gen_dat.o output_anta_mod-0.4.o \
+#	dragging-vit_bil_CISM_gen_mod.o fake-routines-ant_mod.o \
+#	lect-Ant_CISM_gen_dat.o module_choix_antar15CISM.o \
+#	massb-ant_forcage-0.4.o massb-ant_perturb_Tparam.o track_ant40_mod.o 
+
+#Liste_Antar20_CISM = lect-Ant_clim_CISM_gen_dat.o output_anta_mod-0.4.o \
+#	dragging-vit_bil_CISM_gen_mod.o fake-routines-ant_mod.o \
+#	lect-Ant_CISM_gen_dat.o module_choix_antar20CISM.o \
+#	massb-ant_forcage-0.4.o massb-ant_perturb_Tparam.o track_ant40_mod.o 
+
+#Liste_Antar25_CISM = lect-Ant_clim_CISM_gen_dat.o output_anta_mod-0.4.o \
+#	dragging-vit_bil_CISM_gen_mod.o fake-routines-ant_mod.o \
+#	lect-Ant_CISM_gen_dat.o module_choix_antar25CISM.o \
+#	massb-ant_forcage-0.4.o massb-ant_perturb_Tparam.o track_ant40_mod.o 
+
+#Liste_Antar45_CISM = lect-Ant_clim_CISM_45_dat.o output_anta_mod-0.4.o \
+#	dragging-vit_bil_CISM_45_mod.o fake-routines-ant_mod.o \
+#	lect-Ant_CISM_45_dat.o module_choix_antar45CISM.o \
+#	massb-ant_forcage-0.4.o massb-ant_perturb_Tparam.o track_ant40_mod.o 
+
+#Liste_HEINO = climat-heino_mod.o lect-Heino_mod.o  \
+#	fake-routines-Heino_mod.o  detect-assym.o  \
+#	prop-therm-Heino_mod.o  sliding-Heino_mod.o \
+#	initial-heino-phy.o  output_heino_mod.o \
+#	module_choix-heino-0.4.o  track_heino_mod.o
+
+#Antar20 : $(Dim_Antar20_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_Antar20_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) 
+
+#	$(LK) -o ../bin/Antar-20  $(Dim_Antar20_CISM) $(mod_dim_communs) $(mod_communs) \
+#	 $(mod_ell) $(Liste_Antar20_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB) $(MKL_LIB)
+
+#Antar25 : $(Dim_Antar25_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_Antar25_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) 
+
+#	$(LK) -o ../bin/Antar-25  $(Dim_Antar25_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) \
+#	$(Liste_Antar25_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+#Antar25-181 : $(Dim_Antar25_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_Antar25_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) 
+
+#	$(LK) -o ../bin-pc181/Antar-pc181  $(Dim_Antar25_CISM) $(mod_dim_communs) $(mod_communs) \
+#	$(mod_ell) $(Liste_Antar25_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+
+#Antar45 : $(Dim_Antar45_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_Antar45_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) 
+
+#	$(LK) -o ../bin/Antar-45  $(Dim_Antar45_CISM)  $(mod_communs) $(mod_ell) $(Liste_Antar45_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+#Liste_Antar_old =  bmelt-ant-regions_mod.o \
+#	lect-clim-act-anteis_mod.o  output_anta_mod-0.4.o \
+#	dragging_stream_impose_vitbil_mod.o  \
+#	fake-routines-ant_mod.o  lect-anteis_mod.o \
+#	module_choix-antar40-0.4_old.o massb-ant_forcage-0.4.o massb-ant_perturb-0.4.o \
+#	track_ant40_mod.o
+
+#Liste_Antar40 =  bmelt-ant-regions_mod.o \
+#	lect-clim-act-anteis_mod.o  output_anta_mod-0.4.o \
+#	dragging_stream_impose_vitbil_mod.o  \
+#	fake-routines-ant_mod.o  lect-anteis_mod.o \
+#	module_choix-antar40-0.4.o massb-ant_forcage-0.4.o massb-ant_perturb_Tparam.o \
+#	track_ant40_mod.o
+
+# listes de dimensionnement obsoletes
+
+# Dim_Antar40 = paradim-ant40_mod.o geography-ant40_mod.o
+# Dim_Antar15_CISM = paradim-ant15_CISM_mod.o geography-Ant15CISM.o
+# Dim_Antar20_CISM = paradim-ant20_CISM_mod.o geography-Ant20CISM.o
+# Dim_Antar25_CISM = paradim-ant25_CISM_mod.o geography-Ant25CISM.o
+# Dim_Antar45_CISM = paradim-ant45_CISM_mod.o geography-Ant45CISM.o
+# Dim_heino = paradim-Heino_mod.o geography-heino_mod.o
+
+
+# ancienne version diagnoshelf: obsolete, il faut aussi modifier le module choix
+
+#mod_ell_old = eq_elliptique_mod-0.4.o 
+#routine_elliptiques_old =  remplimat-ant-0.5-40km.o
+#diagnoshelf_old = diagno-ant-0.6_mod.o
+
+
+# Routines obsoletes
+
+#icetemp-0.4.o : icetemp-0.4.f90   #module3d.mod tridiagmod.mod
+#	$(FT) icetemp-0.4.f90
+
+#icetemp-0.5_mod.o : icetemp-0.5_mod.f90
+#	$(FT) icetemp-0.5_mod.f90
+
+#icethick-ant-0.5.o : icethick-ant-0.5.f90  #module3d.mod relaxation_mod.mod
+#	$(FT) icethick-ant-0.5.f90
+
+#deform_declar_mod-0.3.o : deform_declar_mod-0.3.f90
+#	$(FT) deform_declar_mod-0.3.f90
+
+
+#-------------lecture des fichiers Climat obsoletes
+
+#lect-clim-act-anteis_mod.o : Ant40_files/lect-clim-act-anteis_mod.f90
+#	$(FT) Ant40_files/lect-clim-act-anteis_mod.f90
+
+#lect-Ant_clim_CISM_gen_dat.o : Antarctique_general_files/lect-Ant_clim_CISM_gen_dat.f90
+#	$(FT)  Antarctique_general_files/lect-Ant_clim_CISM_gen_dat.f90
+
+#lect-Ant_clim_CISM_15_dat.o : Ant15_CISM_files/lect-Ant_clim_CISM_15_dat.f90
+#	$(FT)  Ant15_CISM_files/lect-Ant_clim_CISM_15_dat.f90
+
+#lect-Ant_clim_CISM_45_dat.o : Ant45_CISM_files/lect-Ant_clim_CISM_45_dat.f90
+#	$(FT)  Ant45_CISM_files/lect-Ant_clim_CISM_45_dat.f90
+
+#massb-ant_forcage-0.4.o : Ant40_files/massb-ant_forcage-0.4.f
+#	$(FT) Ant40_files/massb-ant_forcage-0.4.f
+
+# ancienne methode netcdf
+#sortie_netcdf_GRISLI_mod.o : Netcdf-routines/sortie_netcdf_GRISLI_mod.f90
+#	$(FT)  Netcdf-routines/sortie_netcdf_GRISLI_mod.f90
+
+
+
+
+
+# Liens
+
+
+#Heino :	$(Dim_heino) $(mod_dim_communs) $(mod_communs)  $(Liste_HEINO) $(Liste_Netcdf) \
+#	$(routines_communes) $(Liste_BLAS)  
+# 	$(LK) -o Heino 	$(Dim_heino) $(mod_dim_communs) $(mod_communs) $(Liste_HEINO) \
+#	$(Liste_Netcdf) \
+#	$(routines_communes) $(Liste_BLAS) $(NCDF_LIB) 
+
+#Antar-40 : $(Dim_Antar40) $(mod_dim_communs) $(mod_communs) $(mod_ell)  $(Liste_Antar40) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques)  
+
+#	$(LK) -o  ../bin/Antar-40  $(Dim_Antar40) $(mod_dim_communs) $(mod_communs) $(mod_ell)  $(Liste_Antar40) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+#Antar15 : $(Dim_Antar15_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) $(Liste_Antar15_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) 
+
+#	$(LK) -o ../bin/Antar-15  $(Dim_Antar15_CISM) $(mod_dim_communs) $(mod_communs) $(mod_ell) \
+#	$(Liste_Antar15_CISM) \
+#	$(diagnoshelf) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+
+
+#Antar_old : $(Dim_Antar40) $(mod_dim_communs) $(mod_communs)  $(mod_ell_old)  \
+#	$(Liste_Antar_old) $(diagnoshelf_old) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques_old)  
+
+#	$(LK) -o  ../bin/Antar_old  $(Dim_Antar40) $(mod_dim_communs) $(mod_communs) \
+#	$(mod_ell_old)  $(Liste_Antar_old) \
+#	$(diagnoshelf_old) $(Liste_Netcdf) \
+#	$(routines_communes) $(routine_elliptiques_old) $(NCDF_LIB)  $(MKL_LIB)
Index: trunk/SOURCES/Makefile.grisli.inc
===================================================================
--- trunk/SOURCES/Makefile.grisli.inc	(revision 21)
+++ trunk/SOURCES/Makefile.grisli.inc	(revision 22)
@@ -11,5 +11,5 @@
 #JOB = 'job'
 
-# pour lancer 
+# pour lancer
 # sur pc: nohup `echo job-test | LBqAntar-15` &    ou echo job-test | LBqAntar-15
 # sur r2d2 le mettre dans job*sh
@@ -24,5 +24,5 @@
 mod_ell             = remplimat_declar_tabTu_mod.o eq_ellipt_sgbsv_mod-0.2.o
 routine_elliptiques = remplimat-shelves-tabTu.o graphique_L2.o graph-sgbsv.o
-diagnoshelf         = diagno-L2_mod.o 
+diagnoshelf         = diagno-L2_mod.o
 #diagnoshelf         = fake_diagno_mod.o
 
@@ -122,4 +122,5 @@
 
 # Toy est la version juin 2012 avec Schooffing
+
 toy_recul = toy_declar_3D_grisli_mod.o \
 	declar_io_ncdf_toy_mod_fake.o\
@@ -261,5 +262,4 @@
 	module_choix-gsearise.o track_gsearise_mod.o 
 
-
 # listes de dimensionnement (dependent de la geographie)
 #-----------------------------
@@ -291,9 +291,28 @@
 Dim_gsearise05 = paradim-gsearise05_mod.o geography-gsearise05_mod.o
 
+# Liste_BLAS = band.o reduc.o \
+#	BLAS/isamax.o BLAS/lsame.o BLAS/scopy.o BLAS/sgbmv.o BLAS/sgemm.o \
+#	BLAS/sgemv.o  BLAS/sger.o BLAS/sscal.o BLAS/sswap.o BLAS/stbsv.o \
+#	BLAS/strsm.o BLAS/xerbla.o
+ifeq ($(mkl_c), 0)
 Liste_BLAS = band.o reduc.o \
-	BLAS/isamax.o BLAS/lsame.o BLAS/scopy.o BLAS/sgbmv.o BLAS/sgemm.o \
-	BLAS/sgemv.o  BLAS/sger.o BLAS/sscal.o BLAS/sswap.o BLAS/stbsv.o \
+	BLAS/isamax.o BLAS/lsame.o BLAS/scopy.o \
+	BLAS/slamch.o BLAS/slabad.o BLAS/slange.o \
+	BLAS/slassq.o BLAS/sgeqrf.o BLAS/sormqr.o \
+	BLAS/strmv.o BLAS/slarft.o \
+	BLAS/ilaslr.o BLAS/ilaslc.o BLAS/strmm.o \
+	BLAS/slarfb.o BLAS/slapy2.o BLAS/slarfg.o BLAS/slarf.o \
+	BLAS/sgeqr2.o BLAS/sorm2r.o BLAS/snrm2.o \
+	BLAS/slaqps.o BLAS/slaqp2.o BLAS/sgeqp3.o \
+	BLAS/slaset.o BLAS/slaisnan.o BLAS/sisnan.o \
+	BLAS/slascl.o BLAS/sdot.o BLAS/slaic1.o \
+	BLAS/slarzb.o BLAS/slarzt.o \
+	BLAS/saxpy.o BLAS/slarz.o BLAS/sormr3.o \
+	BLAS/sormrz.o BLAS/slatrz.o BLAS/stzrzf.o BLAS/sgelsy.o \
+	BLAS/sgbmv.o BLAS/sgemm.o BLAS/sgemv.o  BLAS/sger.o \
+	BLAS/sscal.o BLAS/sswap.o BLAS/stbsv.o \
 	BLAS/strsm.o BLAS/xerbla.o
 
+endif
 
 # ancienne methode
@@ -611,11 +630,11 @@
 # nouveaux modules climat C. Dumas Fev 2015
 climat_forcage_mois_mod.o : climat_forcage_mois_mod.f90
-	$(FT) climat_forcage_mois_mod.f90
+	$(F_NETCDF) climat_forcage_mois_mod.f90
 
 climat-forcage-insolation_mod_oneway.o : climat-forcage-insolation_mod_oneway.f90
-	$(FT) climat-forcage-insolation_mod_oneway.f90
+	$(F_NETCDF) climat-forcage-insolation_mod_oneway.f90
 
 climat-forcage-insolation_mod.o : climat-forcage-insolation_mod.f90
-	$(FT) climat-forcage-insolation_mod.f90
+	$(F_NETCDF) climat-forcage-insolation_mod.f90
 
 ablation_mod.o : ablation_mod.f90
@@ -631,5 +650,5 @@
 
 climat_GrIce2sea_years_mod.o : GrIce2sea_files/climat_GrIce2sea_years_mod.f90
-	$(FT) GrIce2sea_files/climat_GrIce2sea_years_mod.f90
+	$(F_NETCDF) GrIce2sea_files/climat_GrIce2sea_years_mod.f90
 
 climat-forcage-stat-mois_mod-0.1.o : climat-forcage-stat-mois_mod-0.1.f90
@@ -1360,9 +1379,110 @@
 # Routines venant de bibliotheques exterieures
 reduc.o : reduc.f#module3d.mod
-	$(FT) -w90 reduc.f
+	$(FT) $(F_90) reduc.f
 
 # band vient de Lapack
 band.o: band.f
-	$(FT) -w90 band.f
+	$(FT) $(F_90) band.f
+
+ifeq ($(mkl_c), 0)
+#BLAS
+isamax.o : BLAS/isamax.f
+	$(FT)  BLAS/isamax.f
+lsame.o : BLAS/lsame.f
+	$(FT) BLAS/lsame.f
+scopy.o: BLAS/scopy.f
+	$(FT) BLAS/scopy.f
+slamch.o: BLAS/slamch.f
+	$(FT) BLAS/slamch.f
+slabad.o: BLAS/slabad.f
+	$(FT) BLAS/slabad.f
+slange.o: BLAS/slange.f
+	$(FT) BLAS/slange.f
+slassq.o: BLAS/slassq.f
+	$(FT) BLAS/slassq.f
+sgeqrf.o: BLAS/sgeqrf.f
+	$(FT) BLAS/sgeqrf.f
+sormqr.o: BLAS/sormqr.f
+	$(FT) BLAS/sormqr.f
+strmv.o: BLAS/strmv.f
+	$(FT) BLAS/strmv.f
+slarft.o: BLAS/slarft.f
+	$(FT) BLAS/slarft.f
+ilaslr.o: BLAS/ilaslr.f
+	$(FT) BLAS/ilaslr.f
+ilaslc.o: BLAS/ilaslc.f
+	$(FT) BLAS/ilaslc.f
+strmm.o: BLAS/strmm.f
+	$(FT) BLAS/strmm.f
+slarfb.o: BLAS/slarfb.f
+	$(FT) BLAS/slarfb.f
+slapy2.o: BLAS/slapy2.f
+	$(FT) BLAS/slapy2.f
+slarfg.o: BLAS/slarfg.f
+	$(FT) BLAS/slarfg.f
+slarf.o: BLAS/slarf.f
+	$(FT) BLAS/slarf.f
+sgeqr2.o: BLAS/sgeqr2.f
+	$(FT) BLAS/sgeqr2.f
+saxpy.o: BLAS/saxpy.f
+	$(FT) BLAS/saxpy.f
+slarz.o: BLAS/slarz.f
+	$(FT) BLAS/slarz.f
+sorm2r.o: BLAS/sorm2r.f
+	$(FT) BLAS/sorm2r.f
+snrm2.o: BLAS/snrm2.f
+	$(FT) BLAS/snrm2.f
+slaqps.o: BLAS/slaqps.f
+	$(FT) BLAS/slaqps.f
+slaqp2.o: BLAS/slaqp2.f
+	$(FT) BLAS/slaqp2.f
+sgeqp3.o: BLAS/sgeqp3.f
+	$(FT) BLAS/sgeqp3.f
+slaset.o: BLAS/slaset.f
+	$(FT) BLAS/slaset.f
+slaisnan.o: BLAS/slaisnan.f
+	$(FT) BLAS/slaisnan.f
+sisnan.o: BLAS/sisnan.f
+	$(FT) BLAS/sisnan.f
+slascl.o: BLAS/slascl.f
+	$(FT) BLAS/slascl.f
+sdot.o: BLAS/sdot.f
+	$(FT) BLAS/sdot.f
+slaic1.o: BLAS/slaic1.f
+	$(FT) BLAS/slaic1.f
+slarzb.o: BLAS/slarzb.f
+	$(FT) BLAS/slarzb.f
+slarzt.o: BLAS/slarzt.f
+	$(FT) BLAs/slarzt.f
+sormr3.o: BLAS/sormr3.f
+	$(FT) BLAS/sormr3.f
+sormrz.o: BLAS/sormrz.f
+	$(FT) BLAS/sormrz.f
+slatrz.o: BLAS/slatrz.f
+	$(FT) BLAS/slatrz.f
+stzrzf.o: BLAS/stzrzf.f
+	$(FT) BLAS/stzrzf.f
+sgelsy.o: BLAS/sgelsy.f
+	$(FT) BLAS/sgelsy.f
+sgbmv.o: BLAS/sgbmv.f
+	$(FT) BLAS/sgbmv.f
+sgemm.o: BLAS/sgemm.f
+	$(FT) BLAS/sgemm.f
+sgemv.o: BLAS/sgemv.f
+	$(FT) BLAS/sgemv.f
+sger.o: BLAS/sger.f
+	$(FT) BLAS/sger.f
+sscal.o: BLAS/sscal.f
+	$(FT) BLAS/sscal.f
+sswap.o: BLAS/sswap.f
+	$(FT) BLAS/sswap.f
+stbsv.o: BLAS/stbsv.f
+	$(FT) BLAS/stbsv.f
+strsm.o: BLAS/strsm.f
+	$(FT) BLAS/strsm.f
+xerbla.o: BLAS/xerbla.f
+	$(FT) BLAS/xerbla.f
+
+endif
 
 # routines netcdf
@@ -1419,5 +1539,5 @@
 
 toy_retreat_mod.o  : Recul_force_grounding_line/toy_retreat_mod.f90
-	$(FT) Recul_force_grounding_line/toy_retreat_mod.f90
+	$(F_NETCDF) Recul_force_grounding_line/toy_retreat_mod.f90
 
 
@@ -1546,5 +1666,6 @@
 	$(Liste_Netcdf) \
 	$(routines_communes) steps_time_loop.o \
-	$(routine_elliptiques)
+	$(routine_elliptiques) \
+	$(Liste_BLAS)
 
 	$(LK) -o  ../bin/Hemin-40 \
@@ -1559,5 +1680,5 @@
 	$(Liste_Netcdf) \
 	$(routines_communes) steps_time_loop.o \
-	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB)
+	$(routine_elliptiques) $(NCDF_LIB)  $(MKL_LIB) $(Liste_BLAS)
 
 Hemin-15 : $(Dim_hemin15) $(mod_dim_communs) \
@@ -1695,5 +1816,5 @@
 
 clean	:
-	rm -f *.o *.mod *~  */*~
+	rm -f *.o *.mod *~  */*~ BLAS/*.o
 
 
Index: trunk/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90
===================================================================
--- trunk/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90	(revision 21)
+++ trunk/SOURCES/Netcdf-routines/sortie_netcdf_GRISLI_mod.0.2-hassine.f90	(revision 22)
@@ -1030,5 +1030,5 @@
 ! pour les classe 3, sortir les champs 2D necessaires
 
-                   if (cvar_nc(l) .eq. 3 .and. fait .eq. .FALSE.) then    
+                   if (cvar_nc(l) .eq. 3 .and. fait .eqv. .FALSE.) then    
 
                       boucle_var2: do p=1,ntab
Index: trunk/SOURCES/Recul_force_grounding_line/toy_retreat_mod.f90
===================================================================
--- trunk/SOURCES/Recul_force_grounding_line/toy_retreat_mod.f90	(revision 21)
+++ trunk/SOURCES/Recul_force_grounding_line/toy_retreat_mod.f90	(revision 22)
@@ -809,5 +809,5 @@
 subroutine calc_eps_max  
 
-  use declar_toy_retreat
+  use declar_toy_retreat, only:
   implicit none
   real              :: gamma   !< coefficient de flottaison
Index: trunk/SOURCES/climat_forcage_mois_mod.f90
===================================================================
--- trunk/SOURCES/climat_forcage_mois_mod.f90	(revision 21)
+++ trunk/SOURCES/climat_forcage_mois_mod.f90	(revision 22)
@@ -153,4 +153,7 @@
   namelist/snap_forcage_mois/filtr_t1,filtr_p1
 
+! dmr moved up since namelist declaration should be in the header
+  namelist/lapse_month/lect_lapse
+
 ! formats pour les ecritures dans 42
 428 format(A)
@@ -166,5 +169,4 @@
 
 ! lapserate
-  namelist/lapse_month/lect_lapse
   rewind(num_param)        ! pour revenir au debut du fichier param_list.dat
   read(num_param,lapse_month)
Index: trunk/SOURCES/initial-phy-2.f90
===================================================================
--- trunk/SOURCES/initial-phy-2.f90	(revision 21)
+++ trunk/SOURCES/initial-phy-2.f90	(revision 22)
@@ -140,5 +140,5 @@
   read(num_param,timesteps)
 
-  namelist/timesteps/dtmin,dtmax,dtt,testdiag,tbegin,tend
+! dmr&aurel ##  namelist/timesteps/dtmin,dtmax,dtt,testdiag,tbegin,tend
   write(num_rep_42,428)'!___________________________________________________________'  
   write(num_rep_42,428) '&timesteps                 ! bloc time steps'
Index: trunk/SOURCES/minmax-format.f90
===================================================================
--- trunk/SOURCES/minmax-format.f90	(revision 21)
+++ trunk/SOURCES/minmax-format.f90	(revision 22)
@@ -25,4 +25,6 @@
 character(len=8) :: ff
 character(len=3) :: f1
+! dmr&aurel for gfortran compilation ...
+character(len=1) :: dumf1
 
 integer  ::  if1,if2,ipos,ipos2,n1,if3
@@ -46,5 +48,9 @@
 
 f1=ff(2:ipos-1) ! sous string contenant le premier chiffre
-if1=inum(f1)    ! valeur numerique du premier chiffre
+
+! dmr&aurel inum is not a std intrinsic
+dumf1 = f1(1:2)
+if1 = ichar(dumf1)-ichar('0')
+! dmr&aurel if1=inum(f1)    ! valeur numerique du premier chiffre
 
 print*, 'if1=',if1
@@ -52,5 +58,8 @@
 print*, 'f1= ',trim(f1)//'***' 
 f1=adjustr(f1)
-if2=inum(f1)       ! valeur numerique
+! dmr&aurel inum is not a std intrinsic
+dumf1 = f1(1:2)
+if2 = ichar(dumf1)-ichar('0')
+! if2=inum(f1)       ! valeur numerique
 print*, 'if2=',if2
 
@@ -76,5 +85,8 @@
 ipos2=index(ff,' ')
 f1=ff(2:ipos2-1) ! sous string contenant le  chiffre
-if1=inum(f1)    ! valeur numerique du premier chiffre
+! dmr&aurel inum is not a std intrinsic
+dumf1 = f1(1:2)
+if1 = ichar(dumf1)-ichar('0')
+! if1=inum(f1)    ! valeur numerique du premier chiffre
 n1=if1-1
 valmin=int(-(10**n1))+1
Index: trunk/SOURCES/spinup_mod.f90
===================================================================
--- trunk/SOURCES/spinup_mod.f90	(revision 21)
+++ trunk/SOURCES/spinup_mod.f90	(revision 22)
@@ -209,5 +209,5 @@
              coef_defmx(i,j) = 1.
              Uxbar(i,j)      = Vcol_x(i,j)
-             flgzmx(i,j)     = Vcol_x(i,j)
+             flgzmx(i,j)     = transfer(Vcol_x(i,j),flgzmx(i,j))
              uxdef(i,j)      = 0.
              Ubx(i,j)        = Vcol_x(i,j)
@@ -250,5 +250,5 @@
              coef_defmy(i,j) = 1.
              Uybar(i,j)      = Vcol_y(i,j)
-             flgzmy(i,j)     = Vcol_y(i,j)
+             flgzmy(i,j)     = transfer(Vcol_y(i,j),flgzmy(i,j))
              uydef(i,j)      = 0.
              Uby(i,j)        = Vcol_y(i,j)
