Tall skinny and short wide routines

62 files changed, 18304 insertions, 37 deletions

diff --git a/SRC/Makefile b/SRC/Makefile
index b8d43234..8662b539 100644
--- a/SRC/Makefile
+++ b/SRC/Makefile
@@ -26,7 +26,7 @@ include ../make.inc
 #                  precision.
 #       ZLASRC  -- Double precision complex LAPACK routines
 #       ZXLASRC -- Double precision complex LAPACK routines using extra
-#                  precision.
+#                  precision.   
 #
 #	      DEPRECATED -- Deprecated routines in all precisions
 #
@@ -145,7 +145,6 @@ SLASRC = \
    ssytd2.o ssytf2.o ssytrd.o ssytrf.o ssytri.o ssytri2.o ssytri2x.o \
    ssyswapr.o ssytrs.o ssytrs2.o ssyconv.o \
    ssytf2_rook.o ssytrf_rook.o ssytrs_rook.o \
-   slasyf_aasen.o ssysv_aasen.o ssytrf_aasen.o ssytrs_aasen.o \
    ssytri_rook.o ssycon_rook.o ssysv_rook.o \
    stbcon.o \
    stbrfs.o stbtrs.o stgevc.o stgex2.o stgexc.o stgsen.o \
@@ -160,9 +159,13 @@ SLASRC = \
    sbbcsd.o slapmr.o sorbdb.o sorbdb1.o sorbdb2.o sorbdb3.o sorbdb4.o \
    sorbdb5.o sorbdb6.o sorcsd.o sorcsd2by1.o \
    sgeqrt.o sgeqrt2.o sgeqrt3.o sgemqrt.o \
-   stpqrt.o stpqrt2.o stpmqrt.o stprfb.o
+   stpqrt.o stpqrt2.o stpmqrt.o stprfb.o \
+   sgelqt.o sgelqt3.o sgemlqt.o \
+   sgetsls.o sgeqr.o slatsqr.o slamtsqr.o sgemqr.o \
+   sgelq.o slaswlq.o slamswlq.o sgemlq.o \
+   stplqt.o stplqt2.o stpmlqt.o
 
-DSLASRC = spotrs.o sgetrs.o spotrf.o sgetrf.o
+DSLASRC = spotrs.o sgetrs.o spotrf.o sgetrf.o 
 
 ifdef USEXBLAS
 SXLASRC = sgesvxx.o sgerfsx.o sla_gerfsx_extended.o sla_geamv.o		\
@@ -197,7 +200,6 @@ CLASRC = \
    chetrf.o chetri.o chetri2.o chetri2x.o cheswapr.o \
    chetrs.o chetrs2.o \
    chetf2_rook.o chetrf_rook.o chetri_rook.o chetrs_rook.o checon_rook.o chesv_rook.o \
-   chesv_aasen.o chetrf_aasen.o chetrs_aasen.o clahef_aasen.o\
    chgeqz.o chpcon.o chpev.o  chpevd.o \
    chpevx.o chpgst.o chpgv.o  chpgvd.o chpgvx.o chprfs.o chpsv.o  \
    chpsvx.o \
@@ -245,7 +247,11 @@ CLASRC = \
    cbbcsd.o clapmr.o cunbdb.o cunbdb1.o cunbdb2.o cunbdb3.o cunbdb4.o \
    cunbdb5.o cunbdb6.o cuncsd.o cuncsd2by1.o \
    cgeqrt.o cgeqrt2.o cgeqrt3.o cgemqrt.o \
-   ctpqrt.o ctpqrt2.o ctpmqrt.o ctprfb.o
+   ctpqrt.o ctpqrt2.o ctpmqrt.o ctprfb.o \
+   cgelqt.o cgelqt3.o cgemlqt.o \
+   cgetsls.o cgeqr.o clatsqr.o clamtsqr.o cgemqr.o \
+   cgelq.o claswlq.o clamswlq.o cgemlq.o \
+   ctplqt.o ctplqt2.o ctpmlqt.o
 
 ifdef USEXBLAS
 CXLASRC = cgesvxx.o cgerfsx.o cla_gerfsx_extended.o cla_geamv.o \
@@ -261,7 +267,7 @@ CXLASRC = cgesvxx.o cgerfsx.o cla_gerfsx_extended.o cla_geamv.o \
    cla_lin_berr.o clarscl2.o clascl2.o cla_wwaddw.o
 endif
 
-ZCLASRC = cpotrs.o cgetrs.o cpotrf.o cgetrf.o
+ZCLASRC = cpotrs.o cgetrs.o cpotrf.o cgetrf.o 
 
 DLASRC = \
    dpotrf2.o dgetrf2.o \
@@ -314,7 +320,6 @@ DLASRC = \
    dsytd2.o dsytf2.o dsytrd.o dsytrf.o dsytri.o dsytri2.o dsytri2x.o \
    dsyswapr.o dsytrs.o dsytrs2.o dsyconv.o \
    dsytf2_rook.o dsytrf_rook.o dsytrs_rook.o \
-   dlasyf_aasen.o dsysv_aasen.o dsytrf_aasen.o dsytrs_aasen.o \
    dsytri_rook.o dsycon_rook.o dsysv_rook.o \
    dtbcon.o dtbrfs.o dtbtrs.o dtgevc.o dtgex2.o dtgexc.o dtgsen.o \
    dtgsja.o dtgsna.o dtgsy2.o dtgsyl.o dtpcon.o dtprfs.o dtptri.o \
@@ -329,7 +334,11 @@ DLASRC = \
    dbbcsd.o dlapmr.o dorbdb.o dorbdb1.o dorbdb2.o dorbdb3.o dorbdb4.o \
    dorbdb5.o dorbdb6.o dorcsd.o dorcsd2by1.o \
    dgeqrt.o dgeqrt2.o dgeqrt3.o dgemqrt.o \
-   dtpqrt.o dtpqrt2.o dtpmqrt.o dtprfb.o
+   dtpqrt.o dtpqrt2.o dtpmqrt.o dtprfb.o \
+   dgelqt.o dgelqt3.o dgemlqt.o \
+   dgetsls.o dgeqr.o dlatsqr.o dlamtsqr.o dgemqr.o \
+   dgelq.o dlaswlq.o dlamswlq.o dgemlq.o \
+   dtplqt.o dtplqt2.o dtpmlqt.o 
 
 ifdef USEXBLAS
 DXLASRC = dgesvxx.o dgerfsx.o dla_gerfsx_extended.o dla_geamv.o		\
@@ -365,7 +374,6 @@ ZLASRC = \
    zhetrf.o zhetri.o zhetri2.o zhetri2x.o zheswapr.o \
    zhetrs.o zhetrs2.o \
    zhetf2_rook.o zhetrf_rook.o zhetri_rook.o zhetrs_rook.o zhecon_rook.o zhesv_rook.o \
-   zhesv_aasen.o zhetrf_aasen.o zhetrs_aasen.o zlahef_aasen.o \
    zhgeqz.o zhpcon.o zhpev.o  zhpevd.o \
    zhpevx.o zhpgst.o zhpgv.o  zhpgvd.o zhpgvx.o zhprfs.o zhpsv.o  \
    zhpsvx.o \
@@ -418,7 +426,12 @@ ZLASRC = \
    zbbcsd.o zlapmr.o zunbdb.o zunbdb1.o zunbdb2.o zunbdb3.o zunbdb4.o \
    zunbdb5.o zunbdb6.o zuncsd.o zuncsd2by1.o \
    zgeqrt.o zgeqrt2.o zgeqrt3.o zgemqrt.o \
-   ztpqrt.o ztpqrt2.o ztpmqrt.o ztprfb.o
+   ztpqrt.o ztpqrt2.o ztpmqrt.o ztprfb.o \
+   ztplqt.o ztplqt2.o ztpmlqt.o \
+   zgelqt.o zgelqt3.o zgemlqt.o \
+   zgetsls.o zgeqr.o zlatsqr.o zlamtsqr.o zgemqr.o \
+   zgelq.o zlaswlq.o zlamswlq.o zgemlq.o \
+   ztplqt.o ztplqt2.o ztpmlqt.o  
 
 ifdef USEXBLAS
 ZXLASRC = zgesvxx.o zgerfsx.o zla_gerfsx_extended.o zla_geamv.o		\
@@ -504,7 +517,7 @@ FRC:
 clean:
 	rm -f *.o DEPRECATED/*.o
 
-.f.o:
+.f.o: 
 	$(FORTRAN) $(OPTS) -c $< -o $@
 
 slaruv.o: slaruv.f ; $(FORTRAN) $(NOOPT) -c $< -o $@
diff --git a/SRC/cgelq.f b/SRC/cgelq.f
new file mode 100644
index 00000000..e6e2b129
--- /dev/null
+++ b/SRC/cgelq.f
@@ -0,0 +1,267 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+*                          INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX              A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> CGELQ computes an LQ factorization of an M-by-N matrix A, 
+*> using CLASWLQ when A is short and wide 
+*> (N sufficiently greater than M), and otherwise CGELQT:          
+*> A = L * Q .
+*> \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 COMPLEX array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array 
+*>          contain the M-by-min(M,N) lower trapezoidal matrix L 
+*>          (L is lower triangular if M <= N);
+*>          the elements above the diagonal are the rows of 
+*>          blocked V representing Q (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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    CLASWLQ or CGELQT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): horizontal block size
+*>          WORK1(5): vertical block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           CLASWLQ or CGELQT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2),  and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           CGELQT, CLASWLQ, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'CGELQ ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'CGELQ ', ' ', M, N, 2, -1)
+      ELSE
+        MB = 1
+        NB = N
+      END IF
+      IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
+      IF( NB.GT.N.OR.NB.LE.M) NB = N
+      MINLW1 = M + 5
+      IF ((NB.GT.M).AND.(N.GT.M)) THEN
+        IF(MOD(N-M, NB-M).EQ.0) THEN
+          NBLCKS = (N-M)/(NB-M)
+        ELSE
+          NBLCKS = (N-M)/(NB-M) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.      
+      IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
+     $    .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = N 
+        END IF
+        IF (LWORK2.LT.MB*M) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) 
+     $   .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
+     $   .AND.(.NOT.LMINWS) ) THEN
+        INFO = -8 
+      END IF    
+*
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = MB*M*NBLCKS+5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = MB * M
+        WORK2(2) = M
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CGELQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+      IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL CGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+      ELSE 
+         CALL CLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of CGELQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/cgelqt.f b/SRC/cgelqt.f
new file mode 100644
index 00000000..70abe1af
--- /dev/null
+++ b/SRC/cgelqt.f
@@ -0,0 +1,194 @@
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INFO, LDA, LDT, M, N, MB
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGELQT computes a blocked LQ factorization of a complex M-by-N matrix A
+*> using the compact WY representation of Q.  
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  MIN(M,N) >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the M-by-MIN(M,N) lower trapezoidal matrix L (L is
+*>          lower triangular if M <= N); the elements above the diagonal
+*>          are the rows of V.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,MIN(M,N))
+*>          The upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MB*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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (         1 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  
+*>  Let K=MIN(M,N).  The number of blocks is B = ceiling(K/NB), where each
+*>  block is of order NB except for the last block, which is of order 
+*>  IB = K - (B-1)*NB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The NB-by-NB (and IB-by-IB 
+*>  for the last block) T's are stored in the NB-by-N matrix T as
+*>
+*>               T = (T1 T2 ... TB).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDT, M, N, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX A( LDA, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, IINFO, K
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   CGELQT3, CLARFB, XERBLA
+*     ..
+*     .. 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( MB.LT.1 .OR. (MB.GT.MIN(M,N) .AND. MIN(M,N).GT.0 ))THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CGELQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      K = MIN( M, N )
+      IF( K.EQ.0 ) RETURN
+*
+*     Blocked loop of length K
+*
+      DO I = 1, K,  MB
+         IB = MIN( K-I+1, MB )
+*     
+*     Compute the LQ factorization of the current block A(I:M,I:I+IB-1)
+*       
+         CALL CGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO )
+         IF( I+IB.LE.M ) THEN
+*
+*     Update by applying H**T to A(I:M,I+IB:N) from the right
+*
+         CALL CLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB,
+     $                   A( I, I ), LDA, T( 1, I ), LDT, 
+     $                   A( I+IB, I ), LDA, WORK , M-I-IB+1 )
+         END IF
+      END DO
+      RETURN
+*     
+*     End of CGELQT
+*
+      END
diff --git a/SRC/cgelqt3.f b/SRC/cgelqt3.f
new file mode 100644
index 00000000..98dbfc63
--- /dev/null
+++ b/SRC/cgelqt3.f
@@ -0,0 +1,244 @@
+*  Definition:
+*  ===========
+*
+*       RECURSIVE SUBROUTINE CGELQT3( M, N, A, LDA, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, M, N, LDT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX   A( LDA, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGELQT3 recursively computes a LQ factorization of a complex M-by-N 
+*> matrix A, using the compact WY representation of Q. 
+*>
+*> Based on the algorithm of Elmroth and Gustavson, 
+*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M =< N.
+*> \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 COMPLEX array, dimension (LDA,N)
+*>          On entry, the real M-by-N matrix A.  On exit, the elements on and
+*>          below the diagonal contain the N-by-N lower triangular matrix L; the
+*>          elements above the diagonal are the rows of V.  See below for
+*>          further details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,N)
+*>          The N-by-N upper triangular factor of the block reflector.
+*>          The elements on and above the diagonal contain the block
+*>          reflector T; the elements below the diagonal are not used.
+*>          See below for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date September 2012
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (     1  v3 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  The
+*>  block reflector H is then given by
+*>
+*>               H = I - V * T * V**T
+*>
+*>  where V**T is the transpose of V.
+*>
+*>  For details of the algorithm, see Elmroth and Gustavson (cited above).
+*> \endverbatim
+*>
+*  =====================================================================
+      RECURSIVE SUBROUTINE CGELQT3( M, N, A, LDA, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, M, N, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX   A( LDA, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX   ONE, ZERO
+      PARAMETER ( ONE = (1.0E+00,0.0E+00) )
+      PARAMETER ( ZERO = (0.0E+00,0.0E+00))
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, I1, J, J1, N1, N2, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  CLARFG, CTRMM, CGEMM, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      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
+      ELSE IF( LDT .LT. MAX( 1, M ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CGELQT3', -INFO )
+         RETURN
+      END IF
+*
+      IF( M.EQ.1 ) THEN
+*
+*        Compute Householder transform when N=1
+*
+         CALL CLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
+         T(1,1)=CONJG(T(1,1))
+*         
+      ELSE
+*
+*        Otherwise, split A into blocks...
+*
+         M1 = M/2
+         M2 = M-M1
+         I1 = MIN( M1+1, M )
+         J1 = MIN( M+1, N )
+*
+*        Compute A(1:M1,1:N) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
+*
+         CALL CGELQT3( M1, N, A, LDA, T, LDT, IINFO )
+*
+*        Compute A(J1:M,1:N) =  A(J1:M,1:N) Q1^H [workspace: T(1:N1,J1:N)]
+*
+         DO I=1,M2
+            DO J=1,M1
+               T(  I+M1, J ) = A( I+M1, J )
+            END DO
+         END DO
+         CALL CTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE, 
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         CALL CGEMM( 'N', 'C', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
+     &               A( 1, I1 ), LDA, ONE, T( I1, 1 ), LDT)
+*
+         CALL CTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
+     &               T, LDT, T( I1, 1 ), LDT )
+*
+         CALL CGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,  
+     &                A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
+*
+         CALL CTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         DO I=1,M2
+            DO J=1,M1
+               A(  I+M1, J ) = A( I+M1, J ) - T( I+M1, J )
+               T( I+M1, J )= ZERO
+            END DO
+         END DO
+*
+*        Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
+*
+         CALL CGELQT3( M2, N-M1, A( I1, I1 ), LDA, 
+     &                T( I1, I1 ), LDT, IINFO )
+*
+*        Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
+*
+         DO I=1,M2
+            DO J=1,M1
+               T( J, I+M1  ) = (A( J, I+M1 ))
+            END DO
+         END DO
+*
+         CALL CTRMM( 'R', 'U', 'C', 'U', M1, M2, ONE,
+     &               A( I1, I1 ), LDA, T( 1, I1 ), LDT )
+*
+         CALL CGEMM( 'N', 'C', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
+     &               A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
+*
+         CALL CTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, 
+     &               T( 1, I1 ), LDT )
+*
+         CALL CTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE, 
+     &               T( I1, I1 ), LDT, T( 1, I1 ), LDT )
+*
+*         
+*
+*        Y = (Y1,Y2); L = [ L1            0  ];  T = [T1 T3]
+*                         [ A(1:N1,J1:N)  L2 ]       [ 0 T2]
+*
+      END IF
+*
+      RETURN
+*
+*     End of CGELQT3
+*
+      END
diff --git a/SRC/cgemlq.f b/SRC/cgemlq.f
new file mode 100644
index 00000000..bd7823df
--- /dev/null
+++ b/SRC/cgemlq.f
@@ -0,0 +1,261 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, 
+*     $                LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX        A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>     CGEMLQ 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 complex orthogonal matrix defined as the product 
+*>    of blocked elementary reflectors computed by short wide LQ 
+*>    factorization (DGELQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) is
+*>          returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,  
+     $      C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, MB, NB, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           CLAMSWLQ, CGEMLQT, XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF (LEFT) THEN
+        LW = N * MB
+        MN = M
+      ELSE
+        LW = M * MB
+        MN = N
+      END IF
+      IF ((NB.GT.K).AND.(MN.GT.K)) THEN
+        IF(MOD(MN-K, NB-K).EQ.0) THEN
+          NBLCKS = (MN-K)/(NB-K)
+        ELSE
+          NBLCKS = (MN-K)/(NB-K) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+        WORK2(1) = LW
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CGEMLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
+     $   (NB.GE.MAX(M,N,K))) THEN
+        CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        WORK1(6), MB, C, LDC, WORK2, INFO)  
+      ELSE
+        CALL CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $        MB, C, LDC, WORK2, LWORK2, INFO )
+      END IF
+*
+      WORK2(1) = LW
+      RETURN
+*
+*     End of CGEMLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/cgemlqt.f b/SRC/cgemlqt.f
new file mode 100644
index 00000000..04f44e41
--- /dev/null
+++ b/SRC/cgemlqt.f
@@ -0,0 +1,272 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+*                          C, LDC, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGEMQRT overwrites the general real M-by-N matrix C with
+*>
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q C            C Q
+*> TRANS = 'C':   Q**C C            C Q**C
+*>
+*> where Q is a complex orthogonal matrix defined as the product of K
+*> elementary reflectors:
+*>
+*>       Q = H(1) H(2) . . . H(K) = I - V C V**C
+*>
+*> generated using the compact WY representation as returned by CGELQT. 
+*>
+*> 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**C from the Left;
+*>          = 'R': apply Q or Q**C from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Transpose, apply Q**C.
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DGELQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX array, dimension (LDV,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DGELQT in the first K rows of its array argument A.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DGELQT, stored as a MB-by-M matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by Q C, Q**C C, C Q**C 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 COMPLEX array. The dimension of
+*>          WORK is N*MB if SIDE = 'L', or  M*MB 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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*  =====================================================================
+      SUBROUTINE CGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+     $                   C, LDC, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX   V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, LDWORK, KF, Q
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'C' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF( LEFT ) THEN
+         LDWORK = MAX( 1, N )
+      ELSE IF ( RIGHT ) THEN
+         LDWORK = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0) THEN
+         INFO = -5
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN
+         INFO = -6
+      ELSE IF( LDV.LT.MAX( 1, K ) ) THEN
+          INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CGEMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL CLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL CLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL CLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL CLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of CGEMLQT
+*
+      END
diff --git a/SRC/cgemqr.f b/SRC/cgemqr.f
new file mode 100644
index 00000000..de2965ee
--- /dev/null
+++ b/SRC/cgemqr.f
@@ -0,0 +1,268 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,  
+*     $                     LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX        A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      CGEMQR 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 complex orthogonal matrix defined as the product 
+*>      of blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (CGEQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DGETSQR in the first k columns of 
+*>          its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX array, dimension (MAX(1,LWORK1)) as
+*>          it is returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX 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.
+*>
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, 
+     $        C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK1( * ), C(LDC, * ),
+     $               WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    MB, NB, I, II, KK, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           CGEMQRT, CLAMTSQR, XERBLA 
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF(LEFT) THEN
+        LW = N * NB
+        MN = M
+      ELSE IF(RIGHT) THEN
+        LW = MB * NB
+        MN = N
+      END IF 
+*
+      IF ((MB.GT.K).AND.(MN.GT.K)) THEN
+          IF(MOD(MN-K, MB-K).EQ.0) THEN
+             NBLCKS = (MN-K)/(MB-K)
+          ELSE
+             NBLCKS = (MN-K)/(MB-K) + 1
+          END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+          WORK2(1) = LW
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CGEMQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
+     $   (MB.GE.MAX(M,N,K))) THEN
+        CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        WORK1(6), NB, C, LDC, WORK2, INFO)   
+      ELSE
+        CALL CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $      NB, C, LDC, WORK2, LWORK2, INFO )
+      END IF       
+*
+      WORK2(1) = LW
+      RETURN
+*
+*     End of CGEMQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f
new file mode 100644
index 00000000..c5151408
--- /dev/null
+++ b/SRC/cgeqr.f
@@ -0,0 +1,268 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
+*                        INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX           A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> CGEQR computes a QR factorization of an M-by-N matrix A, 
+*> using CLATSQR when A is tall and skinny 
+*> (M sufficiently greater than N), and otherwise CGEQRT:          
+*> 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 COMPLEX 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 represent Q (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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    CLATSQR or CGEQRT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): row block size
+*>          WORK1(5): column block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           CLATSQR or CGEQRT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2), and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK2))      
+*> \endverbatim
+*>
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           CLATSQR, CGEQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'CGEQR ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'CGEQR ', ' ', M, N, 2, -1)
+      ELSE
+        MB = M
+        NB = 1
+      END IF
+      IF( MB.GT.M.OR.MB.LE.N) MB = M
+      IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
+      MINLW1 = N + 5
+      IF ((MB.GT.N).AND.(M.GT.N)) THEN
+        IF(MOD(M-N, MB-N).EQ.0) THEN
+          NBLCKS = (M-N)/(MB-N)
+        ELSE
+          NBLCKS = (M-N)/(MB-N) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) 
+     $    .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) 
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = M 
+        END IF
+        IF (LWORK2.LT.NB*N) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) 
+     $   .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) 
+     $   .AND.(.NOT.LMINWS)) THEN
+        INFO = -8 
+      END IF    
+*
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = NB * N * NBLCKS + 5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = NB * N
+        WORK2(2) = N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CGEQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+      IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL CGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+         RETURN
+      ELSE 
+         CALL CLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of CGEQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/cgetsls.f b/SRC/cgetsls.f
new file mode 100644
index 00000000..438aced8
--- /dev/null
+++ b/SRC/cgetsls.f
@@ -0,0 +1,490 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+*     $                   , WORK, LWORK, INFO )
+
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          TRANS
+*       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX   A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CGETSLS solves overdetermined or underdetermined real linear systems
+*> involving an M-by-N matrix A, or its transpose, using a tall skinny 
+*> QR or short wide LQfactorization of A.  It is assumed that A has 
+*> full rank.
+*>
+*> The following options are provided:
+*>
+*> 1. If TRANS = 'N' and m >= n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A*X ||.
+*>
+*> 2. If TRANS = 'N' and m < n:  find the minimum norm solution of
+*>    an underdetermined system A * X = B.
+*>
+*> 3. If TRANS = 'C' and m >= n:  find the minimum norm solution of
+*>    an undetermined system A**T * X = B.
+*>
+*> 4. If TRANS = 'C' and m < n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A**T * X ||.
+*>
+*> 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.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': the linear system involves A;
+*>          = 'C': the linear system involves A**C.
+*> \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] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of
+*>          columns of the matrices B and X. NRHS >=0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit,
+*>            if M >= N, A is overwritten by details of its QR
+*>                       factorization as returned by DGEQRF;
+*>            if M <  N, A is overwritten by details of its LQ
+*>                       factorization as returned by DGELQF.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,NRHS)
+*>          On entry, the matrix B of right hand side vectors, stored
+*>          columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+*>          if TRANS = 'T'.
+*>          On exit, if INFO = 0, B is overwritten by the solution
+*>          vectors, stored columnwise:
+*>          if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+*>          squares solution vectors; the residual sum of squares for the
+*>          solution in each column is given by the sum of squares of
+*>          elements N+1 to M in that column;
+*>          if TRANS = 'N' and m < n, rows 1 to N of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m < n, rows 1 to M of B contain the
+*>          least squares solution vectors; the residual sum of squares
+*>          for the solution in each column is given by the sum of
+*>          squares of elements M+1 to N in that column.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. LDB >= MAX(1,M,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX 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, MN + max( MN, NRHS ) ).
+*>          For optimal performance,
+*>          LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+*>          where MN = min(M,N) and NB is the optimum block size.
+*>
+*>          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
+*>          > 0:  if INFO =  i, the i-th diagonal element of the
+*>                triangular factor of A is zero, so that A does not have
+*>                full rank; the least squares solution could not be
+*>                computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*  =====================================================================
+      SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+     $                   , WORK, LWORK, 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 ..
+      CHARACTER          TRANS
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            A( LDA, * ), B( LDB, * ), WORK( * )
+*
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL              ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+      COMPLEX           CZERO
+      PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, TRAN
+      INTEGER            I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
+     $                   SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+      REAL               ANRM, BIGNUM, BNRM, SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, CLANGE
+      EXTERNAL           LSAME, ILAENV, SLABAD, SLAMCH, CLANGE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           CGEQR, CGEMQR, CLASCL, CLASET, 
+     $                   CTRTRS, XERBLA, CGELQ, CGEMLQ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments.
+*
+      INFO=0
+      MINMN = MIN( M, N )
+      MAXMN = MAX( M, N )
+      MNK   = MAX(MINMN,NRHS)
+      TRAN  = LSAME( TRANS, 'C' )
+*
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. 
+     $    LSAME( TRANS, 'C' ) ) ) THEN
+         INFO = -1
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size and minimum LWORK
+*       
+      IF ( M.GE.N ) THEN
+        CALL CGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL CGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+      ELSE 
+        CALL CGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+      END IF
+*
+       IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
+          INFO=-10
+       END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGETSLS', -INFO )
+        WORK( 1 ) = REAL( WSIZEO )
+        WORK( 2 ) = REAL( WSIZEM )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK( 1 ) = REAL( WSIZEO )
+        WORK( 2 ) = REAL( WSIZEM )
+        RETURN
+      END IF
+      IF(LWORK.LT.WSIZEO) THEN
+        LW1=INT(WORK(3))
+        LW2=MAX(LW,INT(WORK(6)))
+      ELSE
+        LW1=INT(WORK(2))
+        LW2=MAX(LW,INT(WORK(6)))
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
+           CALL CLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO, 
+     $       B, LDB )
+           RETURN
+      END IF
+*
+*     Get machine parameters
+*
+       SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
+       BIGNUM = ONE / SMLNUM
+       CALL SLABAD( SMLNUM, BIGNUM )
+*
+*     Scale A, B if max element outside range [SMLNUM,BIGNUM]
+*
+      ANRM = CLANGE( 'M', M, N, A, LDA, RWORK )
+      IASCL = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL CLASCL( '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 CLASCL( '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 CLASET( 'F', MAXMN, NRHS, CZERO, CZERO, B, LDB )
+         GO TO 50
+      END IF
+*
+      BROW = M
+      IF ( TRAN ) THEN
+        BROW = N
+      END IF
+      BNRM = CLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+      IBSCL = 0
+      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL CLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 1
+      ELSE IF( BNRM.GT.BIGNUM ) THEN
+*
+*        Scale matrix norm down to BIGNUM
+*
+         CALL CLASCL( 'G', 0, 0, BNRM, BIGNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 2
+      END IF
+*
+      IF ( M.GE.N) THEN
+*
+*        compute QR factorization of A
+*
+        CALL CGEQR( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+        IF (.NOT.TRAN) THEN
+*
+*           Least-Squares Problem min || A * X - B ||
+*
+*           B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
+*
+          CALL CGEMQR( 'L' , 'C', M, NRHS, N, A, LDA, 
+     $         WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+*
+*           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
+*
+          CALL CTRTRS( 'U', 'N', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+          IF(INFO.GT.0) THEN
+            RETURN
+          END IF
+          SCLLEN = N
+        ELSE
+*
+*           Overdetermined system of equations A**T * X = B
+*
+*           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
+*
+            CALL CTRTRS( 'U', 'C', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(N+1:M,1:NRHS) = CZERO
+*
+            DO 20 J = 1, NRHS
+               DO 10 I = N + 1, M
+                  B( I, J ) = CZERO
+   10          CONTINUE
+   20       CONTINUE
+*
+*           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
+*
+            CALL CGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )       
+*
+            SCLLEN = M
+*
+         END IF
+*
+      ELSE
+*
+*        Compute LQ factorization of A
+*
+        CALL CGELQ( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+*
+*        workspace at least M, optimally M*NB.
+*
+         IF( .NOT.TRAN ) THEN
+*
+*           underdetermined system of equations A * X = B
+*
+*           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
+*
+            CALL CTRTRS( 'L', 'N', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(M+1:N,1:NRHS) = 0
+*
+            DO 40 J = 1, NRHS
+               DO 30 I = M + 1, N
+                  B( I, J ) = CZERO
+   30          CONTINUE
+   40       CONTINUE
+*
+*           B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
+*
+            CALL CGEMLQ( 'L', 'C', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+            SCLLEN = N
+*
+         ELSE
+*
+*           overdetermined system min || A**T * X - B ||
+*
+*           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
+*
+            CALL CGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+*           B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
+*
+            CALL CTRTRS( 'L', 'C', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+            SCLLEN = M
+*
+         END IF
+*
+      END IF
+*
+*     Undo scaling
+*
+      IF( IASCL.EQ.1 ) THEN
+        CALL CLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IASCL.EQ.2 ) THEN
+        CALL CLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+      IF( IBSCL.EQ.1 ) THEN
+         CALL CLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IBSCL.EQ.2 ) THEN
+         CALL CLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+*
+   50 CONTINUE
+       WORK( 1 ) = REAL( WSIZEO )
+       WORK( 2 ) = REAL( WSIZEM )
+      RETURN
+*
+*     End of CGETSLS
+*
+      END
\ No newline at end of file
diff --git a/SRC/clamswlq.f b/SRC/clamswlq.f
new file mode 100644
index 00000000..3b640b84
--- /dev/null
+++ b/SRC/clamswlq.f
@@ -0,0 +1,405 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+*     $                LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>    CLAMQRTS 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 blocked
+*>    elementary reflectors computed by short wide LQ 
+*>    factorization (CLASWLQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>                MB > M.
+*>         
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is COMPLEX array, dimension 
+*>          ( M * Number of blocks(CEIL(N-K/NB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,NB) * MB;
+*>          if SIDE = 'R', LWORK >= max(1,M) * MB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+     $    LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK( * ), C(LDC, * ),
+     $      T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW , CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL    CTPMLQT, CGEMLQT, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * MB
+      ELSE
+        LW = M * MB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, MB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CLAMSWLQ', -INFO )
+        WORK(1) = LW
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK(1) = LW
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN
+        CALL CGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)  
+        RETURN
+      END IF
+*
+      IF(LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((M-K),(NB-K))
+          CTR = (M-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=M-KK+1
+            CALL CTPMLQT('L','C',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+          ELSE
+            II=M+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+NB)
+*
+            CTR = CTR - 1
+            CALL CTPMLQT('L','C',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $          T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $          C(I,1), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:NB)
+*
+          CALL CGEMLQT('L','C',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK  = MOD((M-K),(NB-K))
+         II  = M-KK+1
+         CTR = 1
+         CALL CGEMLQT('L','N',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (I:I+NB,1:N)
+*
+          CALL CTPMLQT('L','N',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $         T(1, CTR *K+1), LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL CTPMLQT('L','N',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1, CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(NB-K))
+          CTR = (N-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL CTPMLQT('R','N',M , KK, K, 0, MB, A(1, II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+              CTR = CTR - 1
+              CALL CTPMLQT('R','N', M, NB-K, K, 0, MB, A(1, I), LDA,
+     $            T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $            C(1,I), LDC, WORK, INFO )
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL CGEMLQT('R','N',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.TRAN) THEN
+*
+*       Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(NB-K))
+         II=N-KK+1
+         CTR = 1
+         CALL CGEMLQT('R','C',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL CTPMLQT('R','C',M , NB-K, K, 0,MB, A(1,I), LDA,
+     $       T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $       C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*       Multiply Q to the last block of C
+*  
+          CALL CTPMLQT('R','C',M , KK, K, 0,MB, A(1,II), LDA,
+     $      T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $      C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW
+      RETURN
+*
+*     End of CLAMSWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/clamtsqr.f b/SRC/clamtsqr.f
new file mode 100644
index 00000000..0f9ac57b
--- /dev/null
+++ b/SRC/clamtsqr.f
@@ -0,0 +1,409 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+*     $                     LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      CLAMTSQR overwrites the general complex M-by-N matrix C with
+*>
+*>                     
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q * C          C * Q
+*> TRANS = 'C':      Q**C * C       C * Q**C
+*>      where Q is a real orthogonal matrix defined as the product 
+*>      of blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (CLATSQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Conjugate Transpose, apply Q**C.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>          MB > N. (must be the same as DLATSQR)
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DLATSQR in the first k columns of 
+*>          its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is COMPLEX array, dimension 
+*>          ( N * Number of blocks(CEIL(M-K/MB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          
+*>          If SIDE = 'L', LWORK >= max(1,N)*NB;
+*>          if SIDE = 'R', LWORK >= max(1,MB)*NB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+     $        LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX        A( LDA, * ), WORK( * ), C(LDC, * ),
+     $                T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW, CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL   CGEMQRT, CTPMQRT, XERBLA 
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * NB
+      ELSE
+        LW = M * NB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+          WORK(1) = LW  
+      END IF
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CLAMTSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
+        CALL CGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)   
+        RETURN
+       END IF       
+*
+      IF(LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+         KK = MOD((M-K),(MB-K))
+         CTR = (M-K)/(MB-K)
+         IF (KK.GT.0) THEN
+           II=M-KK+1
+           CALL CTPMQRT('L','N',KK , N, K, 0, NB, A(II,1), LDA,
+     $       T(1, CTR*K+1),LDT , C(1,1), LDC,
+     $       C(II,1), LDC, WORK, INFO )
+         ELSE
+           II=M+1
+         END IF
+*
+         DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+           CTR = CTR - 1
+           CALL CTPMQRT('L','N',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $         T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+
+         END DO
+*
+*         Multiply Q to the first block of C (1:MB,1:N)
+*
+         CALL CGEMQRT('L','N',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(MB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL CGEMQRT('L','C',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+          CALL CTPMQRT('L','C',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $       T(1, CTR*K+1),LDT, C(1,1), LDC,
+     $       C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*  
+          CALL CTPMQRT('L','C',KK , N, K, 0,NB, A(II,1), LDA,
+     $      T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $      C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(MB-K))
+          CTR = (N-K)/(MB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL CTPMQRT('R','C',M , KK, K, 0, NB, A(II,1), LDA,
+     $        T(1, CTR*K+1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+              CTR = CTR - 1
+              CALL CTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
+     $               T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $               C(1,I), LDC, WORK, INFO )
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL CGEMQRT('R','C',M , MB, K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(MB-K))
+         II=N-KK+1
+         CTR = 1
+         CALL CGEMQRT('R','N', M, MB , K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL CTPMQRT('R','N', M, MB-K, K, 0,NB, A(I,1), LDA,
+     $         T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $         C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL CTPMQRT('R','N', M, KK , K, 0,NB, A(II,1), LDA,
+     $        T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      IF(LEFT) THEN
+        WORK(1)= N * NB
+      ELSE IF(RIGHT) THEN
+        WORK(1)= MB * NB
+      END IF  
+      RETURN
+*
+*     End of CLAMTSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/claswlq.f b/SRC/claswlq.f
new file mode 100644
index 00000000..91db14c9
--- /dev/null
+++ b/SRC/claswlq.f
@@ -0,0 +1,262 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK,
+*                            LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX           A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>          CLASWLQ computes a blocked Short-Wide LQ factorization of a 
+*>          M-by-N matrix A, where N >= M:
+*>          A = L * Q
+*> \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 >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and bleow the diagonal 
+*>          of the array contain the N-by-N lower triangular matrix L; 
+*>          the elements above the diagonal represent Q by the rows 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is COMPLEX array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((N-M)/(NB-M))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= MB*M.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, 
+     $                  INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LWORK, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK( * ), T( LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           CGELQT, CTPLQT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. 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.0 .OR. N.LT.M ) THEN
+        INFO = -2
+      ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
+        INFO = -3  
+      ELSE IF( NB.LE.M ) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+        INFO = -8
+      ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN   
+      WORK(1) = MB*M
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CLASWLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+       IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL CGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
+        RETURN
+       END IF 
+* 
+       KK = MOD((N-M),(NB-M))
+       II=N-KK+1   
+*
+*      Compute the LQ factorization of the first block A(1:M,1:NB)
+*
+       CALL CGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
+       CTR = 1
+*
+       DO I = NB+1, II-NB+M , (NB-M)
+*     
+*      Compute the QR factorization of the current block A(1:M,I:I+NB-M)
+*
+         CALL CTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
+     $                  LDA, T(1,CTR*M+1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*     Compute the QR factorization of the last block A(1:M,II:N)
+*
+       IF (II.LE.N) THEN
+        CALL CTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
+     $                  LDA, T(1,CTR*M+1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      WORK( 1 ) = M * MB
+      RETURN
+*     
+*     End of CLASWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/clatsqr.f b/SRC/clatsqr.f
new file mode 100644
index 00000000..e462ab77
--- /dev/null
+++ b/SRC/clatsqr.f
@@ -0,0 +1,255 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+*                           LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX           A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> SLATSQR computes a blocked Tall-Skinny QR factorization of  
+*> an M-by-N matrix A, where M >= N:
+*> 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. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          MB > N.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX 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 N-by-N upper triangular matrix R; 
+*>          the elements below the diagonal represent Q by the columns 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is COMPLEX array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((M-N)/(MB-N))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX array, dimension (MAX(1,LWORK))       
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= NB*N.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+     $                    LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*     ..
+*     .. Array Arguments ..
+      COMPLEX           A( LDA, * ), WORK( * ), T(LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL    CGEQRT, CTPQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
+        INFO = -2
+      ELSE IF( MB.LE.N ) THEN
+        INFO = -3  
+      ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.NB ) THEN
+        INFO = -8
+      ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN
+        WORK(1) = NB*N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'CLATSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+       IF ((MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL CGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
+         RETURN
+       END IF  
+       KK = MOD((M-N),(MB-N))
+       II=M-KK+1   
+*
+*      Compute the QR factorization of the first block A(1:MB,1:N)
+*
+       CALL CGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
+       CTR = 1
+*
+       DO I = MB+1, II-MB+N ,  (MB-N)
+*     
+*      Compute the QR factorization of the current block A(I:I+MB-N,1:N)
+*
+         CALL CTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
+     $                 T(1,CTR * N + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*      Compute the QR factorization of the last block A(II:M,1:N)
+*
+       IF (II.LE.M) THEN
+         CALL CTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
+     $                 T(1, CTR * N + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      work( 1 ) = N*NB
+      RETURN
+*     
+*     End of CLATSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/ctplqt.f b/SRC/ctplqt.f
new file mode 100644
index 00000000..4de86153
--- /dev/null
+++ b/SRC/ctplqt.f
@@ -0,0 +1,253 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+*                          INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER         INFO, LDA, LDB, LDT, N, M, L, MB
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX      A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTPLQT computes a blocked LQ factorization of a complex 
+*> "triangular-pentagonal" matrix C, which is composed of a 
+*> triangular block A and pentagonal block B, using the compact 
+*> WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B, and the order of the
+*>          triangular matrix A.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  M >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the lower triangular N-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,N)
+*>          The lower triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See Further Details.
+*> \endverbatim
+*>          
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array, dimension (MB*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 2013
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ] [ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>          [ B ] = [ B1 ] [ B2 ] 
+*>                   [ B1 ]  <- M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L upper trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>            [ C ] = [ A ] [ B ] 
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>            [ W ] = [ I ] [ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>            [ V ] = [ V1 ] [ V2 ] 
+*>                   [ V1 ] <- M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>
+*>  The number of blocks is B = ceiling(M/MB), where each
+*>  block is of order MB except for the last block, which is of order 
+*>  IB = M - (M-1)*MB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The MB-by-MB (and IB-by-IB 
+*>  for the last block) T's are stored in the MB-by-N matrix T as
+*>
+*>               T = [T1 T2 ... TB].
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+     $                   INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER     INFO, LDA, LDB, LDT, N, M, L, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX     A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, LB, NB, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   CTPLQT2, CTPRFB, XERBLA
+*     ..
+*     .. 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( L.LT.0 .OR. (L.GT.MIN(M,N) .AND. MIN(M,N).GE.0)) THEN
+         INFO = -3
+      ELSE IF( MB.LT.1 .OR. (MB.GT.M .AND. M.GT.0)) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CTPLQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
+*
+      DO I = 1, M, MB
+*     
+*     Compute the QR factorization of the current block
+*
+         IB = MIN( M-I+1, MB )
+         NB = MIN( N-L+I+IB-1, N )
+         IF( I.GE.L ) THEN
+            LB = 0
+         ELSE
+            LB = NB-N+L-I+1
+         END IF
+*
+         CALL CTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, 
+     $                 T(1, I ), LDT, IINFO )
+*
+*     Update by applying H**T to B(I+IB:M,:) from the right
+*
+         IF( I+IB.LE.M ) THEN
+            CALL CTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB,
+     $                    B( I, 1 ), LDB, T( 1, I ), LDT, 
+     $                    A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, 
+     $                    WORK, M-I-IB+1)
+         END IF
+      END DO
+      RETURN
+*     
+*     End of CTPLQT
+*
+      END
diff --git a/SRC/ctplqt2.f b/SRC/ctplqt2.f
new file mode 100644
index 00000000..74979369
--- /dev/null
+++ b/SRC/ctplqt2.f
@@ -0,0 +1,316 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal"
+*> matrix C, which is composed of a triangular block A and pentagonal block B, 
+*> using the compact WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of rows of the matrix B.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B, and the order of
+*>          the triangular matrix A.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.  
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension (LDA,N)
+*>          On entry, the lower triangular M-by-M matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,M)
+*>          The N-by-N upper triangular factor T of the block reflector.
+*>          See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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 September 2012
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ][ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>
+*>               B = [ B1 ][ B2 ]
+*>                   [ B1 ]  <-     M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L lower trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>
+*>               C = [ A ][ B ]
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>
+*>               W = [ I ][ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>
+*>               W = [ V1 ][ V2 ]               
+*>                   [ V1 ] <-     M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>  The (M+N)-by-(M+N) block reflector H is then given by
+*>
+*>               H = I - W**T * T * W
+*>
+*>  where W^H is the conjugate transpose of W and T is the upper triangular
+*>  factor of the block reflector.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER        INFO, LDA, LDB, LDT, N, M, L
+*     ..
+*     .. Array Arguments ..
+      COMPLEX     A( LDA, * ), B( LDB, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX  ONE, ZERO
+      PARAMETER( ZERO = ( 0.0E+0, 0.0E+0 ),ONE  = ( 1.0E+0, 0.0E+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, J, P, MP, NP
+      COMPLEX   ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  CLARFG, CGEMV, CGERC, CTRMV, 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( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -7
+      ELSE IF( LDT.LT.MAX( 1, M ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CTPLQT2', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
+*      
+      DO I = 1, M
+*
+*        Generate elementary reflector H(I) to annihilate B(I,:)
+*
+         P = N-L+MIN( L, I )
+         CALL CLARFG( P+1, A( I, I ), B( I, 1 ), LDB, T( 1, I ) )
+         T(1,I)=CONJG(T(1,I))
+         IF( I.LT.M ) THEN
+            DO J = 1, P
+               B( I, J ) = CONJG(B(I,J))
+            END DO
+*
+*           W(M-I:1) := C(I+1:M,I:N) * C(I,I:N) [use W = T(M,:)]
+*
+            DO J = 1, M-I
+               T( M, J ) = (A( I+J, I ))
+            END DO
+            CALL CGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, 
+     $                  B( I, 1 ), LDB, ONE, T( M, 1 ), LDT )
+*
+*           C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H
+*
+            ALPHA = -(T( 1, I ))
+            DO J = 1, M-I
+               A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J ))
+            END DO
+            CALL CGERC( M-I, P, (ALPHA),  T( M, 1 ), LDT,
+     $          B( I, 1 ), LDB, B( I+1, 1 ), LDB )
+            DO J = 1, P
+               B( I, J ) = CONJG(B(I,J))
+            END DO
+         END IF
+      END DO
+*
+      DO I = 2, M
+*
+*        T(I,1:I-1) := C(I:I-1,1:N)**H * (alpha * C(I,I:N))
+*
+         ALPHA = -(T( 1, I ))
+         DO J = 1, I-1
+            T( I, J ) = ZERO
+         END DO
+         P = MIN( I-1, L )
+         NP = MIN( N-L+1, N )
+         MP = MIN( P+1, M )
+         DO J = 1, N-L+P
+           B(I,J)=CONJG(B(I,J))
+         END DO
+*
+*        Triangular part of B2
+*
+         DO J = 1, P
+            T( I, J ) = (ALPHA*B( I, N-L+J ))
+         END DO
+         CALL CTRMV( 'L', 'N', 'N', P, B( 1, NP ), LDB,
+     $               T( I, 1 ), LDT )
+*
+*        Rectangular part of B2
+*
+         CALL CGEMV( 'N', I-1-P, L,  ALPHA, B( MP, NP ), LDB, 
+     $               B( I, NP ), LDB, ZERO, T( I,MP ), LDT )
+*
+*        B1
+
+*
+         CALL CGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, 
+     $               ONE, T( I, 1 ), LDT )   
+*
+   
+*
+*        T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1)
+*
+         DO J = 1, I-1
+            T(I,J)=CONJG(T(I,J))
+         END DO
+         CALL CTRMV( 'L', 'C', 'N', I-1, T, LDT, T( I, 1 ), LDT )
+         DO J = 1, I-1
+            T(I,J)=CONJG(T(I,J))
+         END DO
+         DO J = 1, N-L+P
+            B(I,J)=CONJG(B(I,J))
+         END DO   
+*
+*        T(I,I) = tau(I)
+*
+         T( I, I ) = T( 1, I )
+         T( 1, I ) = ZERO
+      END DO
+      DO I=1,M
+         DO J= I+1,M
+            T(I,J)=(T(J,I))
+            T(J,I)=ZERO
+         END DO
+      END DO
+   
+*
+*     End of CTPLQT2
+*
+      END
diff --git a/SRC/ctpmlqt.f b/SRC/ctpmlqt.f
new file mode 100644
index 00000000..411ef72d
--- /dev/null
+++ b/SRC/ctpmlqt.f
@@ -0,0 +1,349 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+*                           A, LDA, B, LDB, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX            V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+*      $                   T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> CTPMQRT applies a complex orthogonal matrix Q obtained from a 
+*> "triangular-pentagonal" real block reflector H to a general
+*> real matrix C, which consists of two blocks A and B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**C from the Left;
+*>          = 'R': apply Q or Q**C from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Transpose, apply Q**C.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B. N >= 0.
+*> \endverbatim
+*> 
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The order of the trapezoidal part of V.  
+*>          K >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DTPLQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DTPLQT in B.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDV >= max(1,M);
+*>          if SIDE = 'R', LDV >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is COMPLEX array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DTPLQT, stored as a MB-by-K matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX array, dimension
+*>          (LDA,N) if SIDE = 'L' or 
+*>          (LDA,K) if SIDE = 'R'
+*>          On entry, the K-by-N or M-by-K matrix A.
+*>          On exit, A is overwritten by the corresponding block of 
+*>          Q*C or Q**C*C or C*Q or C*Q**C.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. 
+*>          If SIDE = 'L', LDC >= max(1,K);
+*>          If SIDE = 'R', LDC >= max(1,M). 
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX array, dimension (LDB,N)
+*>          On entry, the M-by-N matrix B.
+*>          On exit, B is overwritten by the corresponding block of
+*>          Q*C or Q**C*C or C*Q or C*Q**C.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. 
+*>          LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX array. The dimension of WORK is
+*>           N*MB if SIDE = 'L', or  M*MB 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 2015
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The columns of the pentagonal matrix V contain the elementary reflectors
+*>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a 
+*>  trapezoidal block V2:
+*>
+*>        V = [V1] [V2].
+*>            
+*>
+*>  The size of the trapezoidal block V2 is determined by the parameter L, 
+*>  where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
+*>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is lower triangular;
+*>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
+*>
+*>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is K-by-M. 
+*>                      [B]   
+*>  
+*>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is K-by-N.
+*>
+*>  The real orthogonal matrix Q is formed from V and T.
+*>
+*>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
+*>
+*>  If TRANS='C' and SIDE='L', C is on exit replaced with Q**C * C.
+*>
+*>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
+*>
+*>  If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**C.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE CTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+     $                    A, LDA, B, LDB, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX            V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+     $                   T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, NB, LB, KF, LDAQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, CTPRFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'C' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF ( LEFT ) THEN
+         LDAQ = MAX( 1, K )
+      ELSE IF ( RIGHT ) THEN
+         LDAQ = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
+         INFO = -6         
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
+         INFO = -7
+      ELSE IF( LDV.LT.K ) THEN
+         INFO = -9
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -11
+      ELSE IF( LDA.LT.LDAQ ) THEN
+         INFO = -13
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'CTPMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF
+            CALL CTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL CTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )  
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF                   
+            CALL CTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL CTPRFB( 'R', 'C', 'F', 'R', M, NB, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of CTPMLQT
+*
+      END
diff --git a/SRC/dgelq.f b/SRC/dgelq.f
new file mode 100644
index 00000000..4086cd36
--- /dev/null
+++ b/SRC/dgelq.f
@@ -0,0 +1,269 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+*                          INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION  A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> DGELQ computes an LQ factorization of an M-by-N matrix A, 
+*> using DLASWLQ when A is short and wide 
+*> (N sufficiently greater than M), and otherwise DGELQT:          
+*> A = L * Q .
+*> \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 DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array 
+*>          contain the M-by-min(M,N) lower trapezoidal matrix L 
+*>          (L is lower triangular if M <= N);
+*>          the elements above the diagonal are the rows of 
+*>          blocked V representing Q (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] WORK1
+*> \verbatim
+*>          WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    DLASWLQ or DGELQT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): horizontal block size
+*>          WORK1(5): vertical block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           DLASWLQ or DGELQT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2),  and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*>
+*  =====================================================================
+      SUBROUTINE DGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION  A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           DGELQT, DLASWLQ, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'DGELQ ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'DGELQ ', ' ', M, N, 2, -1)
+      ELSE
+        MB = 1
+        NB = N
+      END IF
+      IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
+      IF( NB.GT.N.OR.NB.LE.M) NB = N
+      MINLW1 = M + 5
+      IF ((NB.GT.M).AND.(N.GT.M)) THEN
+        IF(MOD(N-M, NB-M).EQ.0) THEN
+          NBLCKS = (N-M)/(NB-M)
+        ELSE
+          NBLCKS = (N-M)/(NB-M) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
+     $    .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = N 
+        END IF
+        IF (LWORK2.LT.MB*M) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) 
+     $   .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
+     $   .AND.(.NOT.LMINWS) ) THEN
+        INFO = -8 
+      END IF    
+*
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = MB*M*NBLCKS+5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = MB * M
+        WORK2(2) = M
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGELQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+      IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL DGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+      ELSE 
+        CALL DLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of DGELQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/dgelqt.f b/SRC/dgelqt.f
new file mode 100644
index 00000000..0f301699
--- /dev/null
+++ b/SRC/dgelqt.f
@@ -0,0 +1,210 @@
+*> \brief \b DGELQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INFO, LDA, LDT, M, N, MB
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A
+*> using the compact WY representation of Q.  
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  MIN(M,N) >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the M-by-MIN(M,N) lower trapezoidal matrix L (L is
+*>          lower triangular if M <= N); the elements above the diagonal
+*>          are the rows of V.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,MIN(M,N))
+*>          The upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MB*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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (         1 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  
+*>  Let K=MIN(M,N).  The number of blocks is B = ceiling(K/NB), where each
+*>  block is of order NB except for the last block, which is of order 
+*>  IB = K - (B-1)*NB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The NB-by-NB (and IB-by-IB 
+*>  for the last block) T's are stored in the NB-by-N matrix T as
+*>
+*>               T = (T1 T2 ... TB).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDT, M, N, MB
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, IINFO, K
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   DGEQRT2, DGEQRT3, DLARFB, XERBLA
+*     ..
+*     .. 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( MB.LT.1 .OR. ( MB.GT.MIN(M,N) .AND. MIN(M,N).GT.0 ) )THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DGELQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      K = MIN( M, N )
+      IF( K.EQ.0 ) RETURN
+*
+*     Blocked loop of length K
+*
+      DO I = 1, K,  MB
+         IB = MIN( K-I+1, MB )
+*     
+*     Compute the LQ factorization of the current block A(I:M,I:I+IB-1)
+*       
+         CALL DGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO )
+         IF( I+IB.LE.M ) THEN
+*
+*     Update by applying H**T to A(I:M,I+IB:N) from the right
+*
+         CALL DLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB,
+     $                   A( I, I ), LDA, T( 1, I ), LDT, 
+     $                   A( I+IB, I ), LDA, WORK , M-I-IB+1 )
+         END IF
+      END DO
+      RETURN
+*     
+*     End of DGELQT
+*
+      END
diff --git a/SRC/dgelqt3.f b/SRC/dgelqt3.f
new file mode 100644
index 00000000..11c040c2
--- /dev/null
+++ b/SRC/dgelqt3.f
@@ -0,0 +1,259 @@
+*> \brief \b DGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEQRT3 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgelqt3.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgelqt3.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgelqt3.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       RECURSIVE SUBROUTINE DGELQT3( M, N, A, LDA, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, M, N, LDT
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGELQT3 recursively computes a LQ factorization of a real M-by-N 
+*> matrix A, using the compact WY representation of Q. 
+*>
+*> Based on the algorithm of Elmroth and Gustavson, 
+*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M =< N.
+*> \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 DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the real M-by-N matrix A.  On exit, the elements on and
+*>          below the diagonal contain the N-by-N lower triangular matrix L; the
+*>          elements above the diagonal are the rows of V.  See below for
+*>          further details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,N)
+*>          The N-by-N upper triangular factor of the block reflector.
+*>          The elements on and above the diagonal contain the block
+*>          reflector T; the elements below the diagonal are not used.
+*>          See below for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date September 2012
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (     1  v3 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  The
+*>  block reflector H is then given by
+*>
+*>               H = I - V * T * V**T
+*>
+*>  where V**T is the transpose of V.
+*>
+*>  For details of the algorithm, see Elmroth and Gustavson (cited above).
+*> \endverbatim
+*>
+*  =====================================================================
+      RECURSIVE SUBROUTINE DGELQT3( M, N, A, LDA, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, M, N, LDT
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ONE
+      PARAMETER ( ONE = 1.0D+00 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, I1, J, J1, N1, N2, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  DLARFG, DTRMM, DGEMM, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      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
+      ELSE IF( LDT .LT. MAX( 1, M ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DGELQT3', -INFO )
+         RETURN
+      END IF
+*
+      IF( M.EQ.1 ) THEN
+*
+*        Compute Householder transform when N=1
+*
+         CALL DLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
+*         
+      ELSE
+*
+*        Otherwise, split A into blocks...
+*
+         M1 = M/2
+         M2 = M-M1
+         I1 = MIN( M1+1, M )
+         J1 = MIN( M+1, N )
+*
+*        Compute A(1:M1,1:N) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
+*
+         CALL DGELQT3( M1, N, A, LDA, T, LDT, IINFO )
+*
+*        Compute A(J1:M,1:N) = Q1^H A(J1:M,1:N) [workspace: T(1:N1,J1:N)]
+*
+         DO I=1,M2
+            DO J=1,M1
+               T(  I+M1, J ) = A( I+M1, J )
+            END DO
+         END DO
+         CALL DTRMM( 'R', 'U', 'T', 'U', M2, M1, ONE, 
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         CALL DGEMM( 'N', 'T', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
+     &               A( 1, I1 ), LDA, ONE, T( I1, 1 ), LDT)
+*
+         CALL DTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
+     &               T, LDT, T( I1, 1 ), LDT )
+*
+         CALL DGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,  
+     &                A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
+*
+         CALL DTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         DO I=1,M2
+            DO J=1,M1
+               A(  I+M1, J ) = A( I+M1, J ) - T( I+M1, J )
+               T( I+M1, J )=0
+            END DO
+         END DO
+*
+*        Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
+*
+         CALL DGELQT3( M2, N-M1, A( I1, I1 ), LDA, 
+     &                T( I1, I1 ), LDT, IINFO )
+*
+*        Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
+*
+         DO I=1,M2
+            DO J=1,M1
+               T( J, I+M1  ) = (A( J, I+M1 ))
+            END DO
+         END DO
+*
+         CALL DTRMM( 'R', 'U', 'T', 'U', M1, M2, ONE,
+     &               A( I1, I1 ), LDA, T( 1, I1 ), LDT )
+*
+         CALL DGEMM( 'N', 'T', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
+     &               A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
+*
+         CALL DTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, 
+     &               T( 1, I1 ), LDT )
+*
+         CALL DTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE, 
+     &               T( I1, I1 ), LDT, T( 1, I1 ), LDT )
+*
+*         
+*
+*        Y = (Y1,Y2); L = [ L1            0  ];  T = [T1 T3]
+*                         [ A(1:N1,J1:N)  L2 ]       [ 0 T2]
+*
+      END IF
+*
+      RETURN
+*
+*     End of DGELQT3
+*
+      END
diff --git a/SRC/dgemlq.f b/SRC/dgemlq.f
new file mode 100644
index 00000000..8cf911b3
--- /dev/null
+++ b/SRC/dgemlq.f
@@ -0,0 +1,262 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, 
+*     $                LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE        A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>     DGEMLQ 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 blocked elementary reflectors computed by short wide LQ 
+*>    factorization (DGELQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) is
+*>          returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is DOUBLE PRECISION 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,  
+     $      C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, MB, NB, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           DTPMLQT, DGEMLQT, XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = (LWORK2.LT.0)
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF (LEFT) THEN
+        LW = N * MB
+        MN = M
+      ELSE
+        LW = M * MB
+        MN = N
+      END IF
+      IF ((NB.GT.K).AND.(MN.GT.K)) THEN
+        IF(MOD(MN-K, NB-K).EQ.0) THEN
+          NBLCKS = (MN-K)/(NB-K)
+        ELSE
+          NBLCKS = (MN-K)/(NB-K) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+        WORK2(1) = LW
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGEMLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
+     $   (NB.GE.MAX(M,N,K))) THEN
+        CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        WORK1(6), MB, C, LDC, WORK2, INFO)  
+      ELSE
+        CALL DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $    MB, C, LDC, WORK2, LWORK2, INFO )
+      END IF
+*
+      WORK2(1) = LW
+*
+      RETURN
+*
+*     End of DGEMLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/dgemlqt.f b/SRC/dgemlqt.f
new file mode 100644
index 00000000..ebf3e476
--- /dev/null
+++ b/SRC/dgemlqt.f
@@ -0,0 +1,289 @@
+*> \brief \b DGEMLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEMQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dgemlqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dgemlqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dgemlqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+*                          C, LDC, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGEMQRT 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) = I - V T V**T
+*>
+*> generated using the compact WY representation as returned by DGELQT. 
+*>
+*> 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;
+*>          = 'C':  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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DGELQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is DOUBLE PRECISION array, dimension (LDV,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DGELQT in the first K rows of its array argument A.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DGELQT, stored as a MB-by-M matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is DOUBLE PRECISION array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by Q C, Q**T C, 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 DOUBLE PRECISION array. The dimension of
+*>          WORK is N*MB if SIDE = 'L', or  M*MB 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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*  =====================================================================
+      SUBROUTINE DGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+     $                   C, LDC, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, LDWORK, KF, Q
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'T' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF( LEFT ) THEN
+         LDWORK = MAX( 1, N )
+      ELSE IF ( RIGHT ) THEN
+         LDWORK = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0) THEN
+         INFO = -5
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN
+         INFO = -6
+      ELSE IF( LDV.LT.MAX( 1, K ) ) THEN
+          INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DGEMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL DLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL DLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL DLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL DLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of DGEMLQT
+*
+      END
diff --git a/SRC/dgemqr.f b/SRC/dgemqr.f
new file mode 100644
index 00000000..73c84bf6
--- /dev/null
+++ b/SRC/dgemqr.f
@@ -0,0 +1,272 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,  
+*     $                     LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE PRECISION  A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      SGEMQR 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 blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (DGEQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DGETSQR in the first k columns of 
+*>          its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1)) as
+*>          it is returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is DOUBLE PRECISION 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.
+*>
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, 
+     $        C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), WORK1( * ), C(LDC, * ),
+     $               WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    MB, NB, I, II, KK, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           DGEMQRT, DTPMQRT, XERBLA 
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF(LEFT) THEN
+        LW = N * NB
+        MN = M
+      ELSE IF(RIGHT) THEN
+        LW = MB * NB
+        MN = N
+      END IF 
+*
+      IF ((MB.GT.K).AND.(MN.GT.K)) THEN
+          IF(MOD(MN-K, MB-K).EQ.0) THEN
+             NBLCKS = (MN-K)/(MB-K)
+          ELSE
+             NBLCKS = (MN-K)/(MB-K) + 1
+          END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ).AND.MIN(M,N,K).NE.0 ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+         WORK2(1) = LW  
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGEMQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
+     $   (MB.GE.MAX(M,N,K))) THEN
+        CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        WORK1(6), NB, C, LDC, WORK2, INFO)   
+      ELSE
+        CALL DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $      NB, C, LDC, WORK2, LWORK2, INFO )
+      END IF       
+*
+      WORK2(1) = LW
+*  
+      RETURN
+*
+*     End of DGEMQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/dgeqr.f b/SRC/dgeqr.f
new file mode 100644
index 00000000..e0c6d75b
--- /dev/null
+++ b/SRC/dgeqr.f
@@ -0,0 +1,267 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
+*                        INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION  A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> DGEQR computes a QR factorization of an M-by-N matrix A, 
+*> using DLATSQR when A is tall and skinny 
+*> (M sufficiently greater than N), and otherwise DGEQRT:          
+*> 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 DOUBLE PRECISION 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 represent Q (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] WORK1
+*> \verbatim
+*>          WORK1 is DOUBLE PRECISION array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    DLATSQR or DGEQRT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): row block size
+*>          WORK1(5): column block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           DLATSQR or DGEQRT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2), and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK2))      
+*> \endverbatim
+*>
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION  A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           DLATSQR, DGEQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'DGEQR ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'DGEQR ', ' ', M, N, 2, -1)
+      ELSE
+        MB = M
+        NB = 1
+      END IF
+      IF( MB.GT.M.OR.MB.LE.N) MB = M
+      IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
+      MINLW1 = N + 5
+      IF ((MB.GT.N).AND.(M.GT.N)) THEN
+        IF(MOD(M-N, MB-N).EQ.0) THEN
+          NBLCKS = (M-N)/(MB-N)
+        ELSE
+          NBLCKS = (M-N)/(MB-N) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) 
+     $    .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) 
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = M 
+        END IF
+        IF (LWORK2.LT.NB*N) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) 
+     $   .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) 
+     $   .AND.(.NOT.LMINWS)) THEN
+        INFO = -8 
+      END IF    
+
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = NB * N * NBLCKS + 5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = NB * N
+        WORK2(2) = N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGEQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+      IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL DGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+      ELSE 
+         CALL DLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of DGEQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/dgetsls.f b/SRC/dgetsls.f
new file mode 100644
index 00000000..cda63bd1
--- /dev/null
+++ b/SRC/dgetsls.f
@@ -0,0 +1,475 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+*     $                   , WORK, LWORK, INFO )
+
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          TRANS
+*       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGETSLS solves overdetermined or underdetermined real linear systems
+*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ 
+*> factorization of A.  It is assumed that A has full rank.
+*>
+*> 
+*>
+*> The following options are provided:
+*>
+*> 1. If TRANS = 'N' and m >= n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A*X ||.
+
+*> 2. If TRANS = 'N' and m < n:  find the minimum norm solution of
+*>    an underdetermined system A * X = B.
+
+*> 3. If TRANS = 'T' and m >= n:  find the minimum norm solution of
+*>    an undetermined system A**T * X = B.
+
+*> 4. If TRANS = 'T' and m < n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A**T * X ||.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': the linear system involves A;
+*>          = 'T': the linear system involves A**T.
+*> \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] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of
+*>          columns of the matrices B and X. NRHS >=0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit,
+*>          A is overwritten by details of its QR or LQ
+*>          factorization as returned by DGETSQR.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,NRHS)
+*>          On entry, the matrix B of right hand side vectors, stored
+*>          columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+*>          if TRANS = 'T'.
+*>          On exit, if INFO = 0, B is overwritten by the solution
+*>          vectors, stored columnwise:
+*>          if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+*>          squares solution vectors.
+*>          if TRANS = 'N' and m < n, rows 1 to N of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m < n, rows 1 to M of B contain the
+*>          least squares solution vectors.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. LDB >= MAX(1,M,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK,
+*>          and WORK(2) returns the minimum LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          IF LWORK=-1, workspace query is assumed, and 
+*>          WORK(1) returns the optimal LWORK,
+*>          and WORK(2) returns the minimum LWORK.
+*> \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, the i-th diagonal element of the
+*>                triangular factor of A is zero, so that A does not have
+*>                full rank; the least squares solution could not be
+*>                computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup doubleGEsolve
+*
+*  =====================================================================
+      SUBROUTINE DGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+     $                   , WORK, LWORK, 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 ..
+      CHARACTER          TRANS
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), WORK( * )
+*
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, TRAN
+      INTEGER            I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
+     $                   SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, DLANGE
+      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           DGEQR, DGEMQR, DLASCL, DLASET, 
+     $                   DTRTRS, XERBLA, DGELQ, DGEMLQ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments.
+*
+      INFO=0
+      MINMN = MIN( M, N )
+      MAXMN = MAX( M, N )
+      MNK   = MAX(MINMN,NRHS)
+      TRAN  = LSAME( TRANS, 'T' )
+*
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. 
+     $    LSAME( TRANS, 'T' ) ) ) THEN
+         INFO = -1
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size and minimum LWORK
+*       
+       IF ( M.GE.N ) THEN
+        CALL DGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL DGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+       ELSE 
+        CALL DGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+       END IF
+*
+       IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
+          INFO=-10
+       END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DGETSLS', -INFO )
+        WORK( 1 ) = DBLE( WSIZEO )
+        WORK( 2 ) = DBLE( WSIZEM )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK( 1 ) = DBLE( WSIZEO )
+        WORK( 2 ) = DBLE( WSIZEM )
+        RETURN
+      END IF
+      IF(LWORK.LT.WSIZEO) THEN
+        LW1=INT(WORK(3))
+        LW2=MAX(LW,INT(WORK(6)))
+      ELSE
+        LW1=INT(WORK(2))
+        LW2=MAX(LW,INT(WORK(6)))
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
+           CALL DLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO, 
+     $       B, LDB )
+           RETURN
+      END IF
+*
+*     Get machine parameters
+*
+       SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
+       BIGNUM = ONE / SMLNUM
+       CALL DLABAD( SMLNUM, BIGNUM )
+*
+*     Scale A, B if max element outside range [SMLNUM,BIGNUM]
+*
+      ANRM = DLANGE( 'M', M, N, A, LDA, RWORK )
+      IASCL = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL DLASCL( '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 DLASCL( '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 DLASET( 'F', MAXMN, NRHS, ZERO, ZERO, B, LDB )
+         GO TO 50
+      END IF
+*
+      BROW = M
+      IF ( TRAN ) THEN
+        BROW = N
+      END IF
+      BNRM = DLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+      IBSCL = 0
+      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL DLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 1
+      ELSE IF( BNRM.GT.BIGNUM ) THEN
+*
+*        Scale matrix norm down to BIGNUM
+*
+         CALL DLASCL( 'G', 0, 0, BNRM, BIGNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 2
+      END IF
+*
+      IF ( M.GE.N) THEN
+*
+*        compute QR factorization of A
+*
+        CALL DGEQR( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+        IF (.NOT.TRAN) THEN
+*
+*           Least-Squares Problem min || A * X - B ||
+*
+*           B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
+*
+          CALL DGEMQR( 'L' , 'T', M, NRHS, N, A, LDA, 
+     $         WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+*
+*           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
+*
+          CALL DTRTRS( 'U', 'N', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+          IF(INFO.GT.0) THEN
+            RETURN
+          END IF
+          SCLLEN = N
+        ELSE
+*
+*           Overdetermined system of equations A**T * X = B
+*
+*           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
+*
+            CALL DTRTRS( 'U', 'T', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(N+1:M,1:NRHS) = ZERO
+*
+            DO 20 J = 1, NRHS
+               DO 10 I = N + 1, M
+                  B( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+*
+*           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
+*
+            CALL DGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )       
+*
+            SCLLEN = M
+*
+         END IF
+*
+      ELSE
+*
+*        Compute LQ factorization of A
+*
+        CALL DGELQ( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+*
+*        workspace at least M, optimally M*NB.
+*
+         IF( .NOT.TRAN ) THEN
+*
+*           underdetermined system of equations A * X = B
+*
+*           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
+*
+            CALL DTRTRS( 'L', 'N', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(M+1:N,1:NRHS) = 0
+*
+            DO 40 J = 1, NRHS
+               DO 30 I = M + 1, N
+                  B( I, J ) = ZERO
+   30          CONTINUE
+   40       CONTINUE
+*
+*           B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
+*
+            CALL DGEMLQ( 'L', 'T', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+            SCLLEN = N
+*
+         ELSE
+*
+*           overdetermined system min || A**T * X - B ||
+*
+*           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
+*
+            CALL DGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+*           B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
+*
+            CALL DTRTRS( 'Lower', 'Transpose', 'Non-unit', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+            SCLLEN = M
+*
+         END IF
+*
+      END IF
+*
+*     Undo scaling
+*
+      IF( IASCL.EQ.1 ) THEN
+        CALL DLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IASCL.EQ.2 ) THEN
+        CALL DLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+      IF( IBSCL.EQ.1 ) THEN
+         CALL DLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IBSCL.EQ.2 ) THEN
+         CALL DLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+*
+   50 CONTINUE
+       WORK( 1 ) = DBLE( WSIZEO )
+       WORK( 2 ) = DBLE( WSIZEM )
+      RETURN
+*
+*     End of DGETSLS
+*
+      END
\ No newline at end of file
diff --git a/SRC/dlamswlq.f b/SRC/dlamswlq.f
new file mode 100644
index 00000000..6230e65f
--- /dev/null
+++ b/SRC/dlamswlq.f
@@ -0,0 +1,406 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+*     $                LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>    DLAMQRTS 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 blocked
+*>    elementary reflectors computed by short wide LQ 
+*>    factorization (DLASWLQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>                MB > M.
+*>         
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension 
+*>          ( M * Number of blocks(CEIL(N-K/NB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is DOUBLE PRECISION 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,NB) * MB;
+*>          if SIDE = 'R', LWORK >= max(1,M) * MB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+     $    LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ),
+     $      T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, CTR, LW
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           DTPMLQT, DGEMLQT, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * MB
+      ELSE
+        LW = M * MB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, MB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DLAMSWLQ', -INFO )
+        WORK(1) = LW
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK(1) = LW
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN
+        CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)  
+        RETURN
+      END IF
+*
+      IF(LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((M-K),(NB-K))
+          CTR = (M-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=M-KK+1
+            CALL DTPMLQT('L','T',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+          ELSE
+            II=M+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+NB)
+*
+            CTR = CTR - 1
+            CALL DTPMLQT('L','T',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $          T(1, CTR*K+1),LDT, C(1,1), LDC,
+     $          C(I,1), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:NB)
+*
+          CALL DGEMLQT('L','T',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(NB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL DGEMLQT('L','N',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (I:I+NB,1:N)
+*
+          CALL DTPMLQT('L','N',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $         T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL DTPMLQT('L','N',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(NB-K))
+          CTR = (N-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL DTPMLQT('R','N',M , KK, K, 0, MB, A(1, II), LDA,
+     $        T(1,CTR *K+1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+             CTR = CTR - 1   
+             CALL DTPMLQT('R','N', M, NB-K, K, 0, MB, A(1, I), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(1,I), LDC, WORK, INFO )
+*
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL DGEMLQT('R','N',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.TRAN) THEN
+*
+*       Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(NB-K))
+         CTR = 1
+         II=N-KK+1
+         CALL DGEMLQT('R','T',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL DTPMLQT('R','T',M , NB-K, K, 0,MB, A(1,I), LDA,
+     $       T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $       C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*       Multiply Q to the last block of C
+*  
+          CALL DTPMLQT('R','T',M , KK, K, 0,MB, A(1,II), LDA,
+     $      T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $      C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW
+      RETURN
+*
+*     End of DLAMSWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/dlamtsqr.f b/SRC/dlamtsqr.f
new file mode 100644
index 00000000..2cb9f96a
--- /dev/null
+++ b/SRC/dlamtsqr.f
@@ -0,0 +1,404 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+*     $                     LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      DLAMTSQR 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 blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (DLATSQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>          MB > N. (must be the same as DLATSQR)
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DLATSQR in the first k columns of 
+*>          its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension 
+*>          ( N * Number of blocks(CEIL(M-K/MB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is DOUBLE PRECISION 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          
+*>          If SIDE = 'L', LWORK >= max(1,N)*NB;
+*>          if SIDE = 'R', LWORK >= max(1,MB)*NB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+     $        LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), WORK( * ), C(LDC, * ),
+     $                T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW, CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           DGEMQRT, DTPMQRT, XERBLA 
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * NB
+      ELSE
+        LW = MB * NB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+          WORK(1) = LW
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DLAMTSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
+        CALL DGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)   
+        RETURN
+       END IF       
+*
+      IF(LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+         KK = MOD((M-K),(MB-K))
+         CTR = (M-K)/(MB-K)
+         IF (KK.GT.0) THEN
+           II=M-KK+1
+           CALL DTPMQRT('L','N',KK , N, K, 0, NB, A(II,1), LDA,
+     $       T(1,CTR*K+1),LDT , C(1,1), LDC,
+     $       C(II,1), LDC, WORK, INFO )
+         ELSE
+           II=M+1
+         END IF
+*
+         DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+           CTR = CTR - 1
+           CALL DTPMQRT('L','N',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $         T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+*
+         END DO
+*
+*         Multiply Q to the first block of C (1:MB,1:N)
+*
+         CALL DGEMQRT('L','N',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(MB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL DGEMQRT('L','T',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+          CALL DTPMQRT('L','T',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $       T(1,CTR * K + 1),LDT, C(1,1), LDC,
+     $       C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*  
+          CALL DTPMQRT('L','T',KK , N, K, 0,NB, A(II,1), LDA,
+     $      T(1,CTR * K + 1), LDT, C(1,1), LDC,
+     $      C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(MB-K))
+          CTR = (N-K)/(MB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL DTPMQRT('R','T',M , KK, K, 0, NB, A(II,1), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+             CTR = CTR - 1
+             CALL DTPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
+     $          T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $          C(1,I), LDC, WORK, INFO )
+*
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL DGEMQRT('R','T',M , MB, K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(MB-K))
+         II=N-KK+1
+         CTR = 1
+         CALL DGEMQRT('R','N', M, MB , K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL DTPMQRT('R','N', M, MB-K, K, 0,NB, A(I,1), LDA,
+     $         T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $         C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL DTPMQRT('R','N', M, KK , K, 0,NB, A(II,1), LDA,
+     $        T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW  
+      RETURN
+*
+*     End of DLAMTSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/dlaswlq.f b/SRC/dlaswlq.f
new file mode 100644
index 00000000..e9be802c
--- /dev/null
+++ b/SRC/dlaswlq.f
@@ -0,0 +1,258 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK,
+*                            LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION  A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>          DLASWLQ computes a blocked Short-Wide LQ factorization of a 
+*>          M-by-N matrix A, where N >= M:
+*>          A = L * Q
+*> \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 >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and bleow the diagonal 
+*>          of the array contain the N-by-N lower triangular matrix L; 
+*>          the elements above the diagonal represent Q by the rows 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((N-M)/(NB-M))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= MB*M.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, 
+     $                  INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LWORK, LDT
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION  A( LDA, * ), WORK( * ), T( LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           DGELQT, DTPLQT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
+        INFO = -2
+      ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
+        INFO = -3  
+      ELSE IF( NB.LE.M ) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+        INFO = -8
+      ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN   
+      WORK(1) = MB*M
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DLASWLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+       IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL DGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
+        RETURN
+       END IF 
+* 
+       KK = MOD((N-M),(NB-M))
+       II=N-KK+1   
+*
+*      Compute the LQ factorization of the first block A(1:M,1:NB)
+*
+       CALL DGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
+       CTR = 1
+*
+       DO I = NB+1, II-NB+M , (NB-M)
+*     
+*      Compute the QR factorization of the current block A(1:M,I:I+NB-M)
+*
+         CALL DTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
+     $                  LDA, T(1, CTR * M + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*     Compute the QR factorization of the last block A(1:M,II:N)
+*
+       IF (II.LE.N) THEN
+        CALL DTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
+     $                  LDA, T(1, CTR * M + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      WORK( 1 ) = M * MB
+      RETURN
+*     
+*     End of DLASWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/dlatsqr.f b/SRC/dlatsqr.f
new file mode 100644
index 00000000..4b9a787a
--- /dev/null
+++ b/SRC/dlatsqr.f
@@ -0,0 +1,256 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+*                           LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION  A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> DLATSQR computes a blocked Tall-Skinny QR factorization of  
+*> an M-by-N matrix A, where M >= N:
+*> 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. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          MB > N.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION 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 N-by-N upper triangular matrix R; 
+*>          the elements below the diagonal represent Q by the columns 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((M-N)/(MB-N))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) DOUBLE PRECISION array, dimension (MAX(1,LWORK))       
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= NB*N.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+     $                    LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION  A( LDA, * ), WORK( * ), T(LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           DGEQRT, DTPQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
+        INFO = -2
+      ELSE IF( MB.LE.N ) THEN
+        INFO = -3  
+      ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.NB ) THEN
+        INFO = -8
+      ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN
+        WORK(1) = NB*N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'DLATSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+       IF ((MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL DGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
+         RETURN
+       END IF  
+*
+       KK = MOD((M-N),(MB-N))
+       II=M-KK+1   
+*
+*      Compute the QR factorization of the first block A(1:MB,1:N)
+*
+       CALL DGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
+*
+       CTR = 1
+       DO I = MB+1, II-MB+N ,  (MB-N)
+*     
+*      Compute the QR factorization of the current block A(I:I+MB-N,1:N)
+*
+         CALL DTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
+     $                 T(1, CTR * N + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*      Compute the QR factorization of the last block A(II:M,1:N)
+*
+       IF (II.LE.M) THEN
+         CALL DTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
+     $                 T(1, CTR * N + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      WORK( 1 ) = N*NB
+      RETURN
+*     
+*     End of DLATSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/dtplqt.f b/SRC/dtplqt.f
new file mode 100644
index 00000000..eea37b82
--- /dev/null
+++ b/SRC/dtplqt.f
@@ -0,0 +1,270 @@
+*> \brief \b DTPLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+*                          INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, LDB, LDT, N, M, L, MB
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION  A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPLQT computes a blocked LQ factorization of a real 
+*> "triangular-pentagonal" matrix C, which is composed of a 
+*> triangular block A and pentagonal block B, using the compact 
+*> WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B, and the order of the
+*>          triangular matrix A.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  M >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the lower triangular N-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,N)
+*>          The lower triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See Further Details.
+*> \endverbatim
+*>          
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array, dimension (MB*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 2013
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ] [ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>          [ B ] = [ B1 ] [ B2 ] 
+*>                   [ B1 ]  <- M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L upper trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>            [ C ] = [ A ] [ B ] 
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>            [ W ] = [ I ] [ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>            [ V ] = [ V1 ] [ V2 ] 
+*>                   [ V1 ] <- M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>
+*>  The number of blocks is B = ceiling(M/MB), where each
+*>  block is of order MB except for the last block, which is of order 
+*>  IB = M - (M-1)*MB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The MB-by-MB (and IB-by-IB 
+*>  for the last block) T's are stored in the MB-by-N matrix T as
+*>
+*>               T = [T1 T2 ... TB].
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+     $                   INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, LB, NB, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   DTPLQT2, DTPRFB, XERBLA
+*     ..
+*     .. 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( L.LT.0 .OR. (L.GT.MIN(M,N) .AND. MIN(M,N).GE.0)) THEN
+         INFO = -3
+      ELSE IF( MB.LT.1 .OR. (MB.GT.M .AND. M.GT.0)) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DTPLQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
+*
+      DO I = 1, M, MB
+*     
+*     Compute the QR factorization of the current block
+*
+         IB = MIN( M-I+1, MB )
+         NB = MIN( N-L+I+IB-1, N )
+         IF( I.GE.L ) THEN
+            LB = 0
+         ELSE
+            LB = NB-N+L-I+1
+         END IF
+*
+         CALL DTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, 
+     $                 T(1, I ), LDT, IINFO )
+*
+*     Update by applying H**T to B(I+IB:M,:) from the right
+*
+         IF( I+IB.LE.M ) THEN
+            CALL DTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB,
+     $                    B( I, 1 ), LDB, T( 1, I ), LDT, 
+     $                    A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, 
+     $                    WORK, M-I-IB+1)
+         END IF
+      END DO
+      RETURN
+*     
+*     End of DTPLQT
+*
+      END
diff --git a/SRC/dtplqt2.f b/SRC/dtplqt2.f
new file mode 100644
index 00000000..9ed7c6ae
--- /dev/null
+++ b/SRC/dtplqt2.f
@@ -0,0 +1,312 @@
+*> \brief \b DTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPLQT2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPLQT2 computes a LQ a factorization of a real "triangular-pentagonal"
+*> matrix C, which is composed of a triangular block A and pentagonal block B, 
+*> using the compact WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of rows of the matrix B.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B, and the order of
+*>          the triangular matrix A.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.  
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension (LDA,N)
+*>          On entry, the lower triangular M-by-M matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,M)
+*>          The N-by-N upper triangular factor T of the block reflector.
+*>          See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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 September 2012
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ][ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>
+*>               B = [ B1 ][ B2 ]
+*>                   [ B1 ]  <-     M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L lower trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>
+*>               C = [ A ][ B ]
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>
+*>               W = [ I ][ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>
+*>               W = [ V1 ][ V2 ]               
+*>                   [ V1 ] <-     M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>  The (M+N)-by-(M+N) block reflector H is then given by
+*>
+*>               H = I - W**T * T * W
+*>
+*>  where W^H is the conjugate transpose of W and T is the upper triangular
+*>  factor of the block reflector.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION  ONE, ZERO
+      PARAMETER( ONE = 1.0, ZERO = 0.0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, J, P, MP, NP
+      DOUBLE PRECISION   ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  DLARFG, DGEMV, DGER, DTRMV, 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( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -7
+      ELSE IF( LDT.LT.MAX( 1, M ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DTPLQT2', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
+*      
+      DO I = 1, M
+*
+*        Generate elementary reflector H(I) to annihilate B(I,:)
+*
+         P = N-L+MIN( L, I )
+         CALL DLARFG( P+1, A( I, I ), B( I, 1 ), LDB, T( 1, I ) )
+         IF( I.LT.M ) THEN
+*
+*           W(M-I:1) := C(I+1:M,I:N) * C(I,I:N) [use W = T(M,:)]
+*
+            DO J = 1, M-I
+               T( M, J ) = (A( I+J, I ))
+            END DO
+            CALL DGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, 
+     $                  B( I, 1 ), LDB, ONE, T( M, 1 ), LDT )
+*
+*           C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H
+*
+            ALPHA = -(T( 1, I ))            
+            DO J = 1, M-I
+               A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J ))
+            END DO
+            CALL DGER( M-I, P, ALPHA,  T( M, 1 ), LDT,
+     $          B( I, 1 ), LDB, B( I+1, 1 ), LDB )
+         END IF
+      END DO
+*
+      DO I = 2, M
+*
+*        T(I,1:I-1) := C(I:I-1,1:N) * (alpha * C(I,I:N)^H)
+*
+         ALPHA = -T( 1, I )
+
+         DO J = 1, I-1
+            T( I, J ) = ZERO
+         END DO
+         P = MIN( I-1, L )
+         NP = MIN( N-L+1, N )
+         MP = MIN( P+1, M )
+*
+*        Triangular part of B2
+*
+         DO J = 1, P
+            T( I, J ) = ALPHA*B( I, N-L+J )
+         END DO
+         CALL DTRMV( 'L', 'N', 'N', P, B( 1, NP ), LDB,
+     $               T( I, 1 ), LDT )
+*
+*        Rectangular part of B2
+*
+         CALL DGEMV( 'N', I-1-P, L,  ALPHA, B( MP, NP ), LDB, 
+     $               B( I, NP ), LDB, ZERO, T( I,MP ), LDT )
+*
+*        B1
+*
+         CALL DGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, 
+     $               ONE, T( I, 1 ), LDT )         
+*
+*        T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1)
+*
+        CALL DTRMV( 'L', 'T', 'N', I-1, T, LDT, T( I, 1 ), LDT )
+*
+*        T(I,I) = tau(I)
+*
+         T( I, I ) = T( 1, I )
+         T( 1, I ) = ZERO
+      END DO
+      DO I=1,M
+         DO J= I+1,M
+            T(I,J)=T(J,I)
+            T(J,I)= ZERO
+         END DO
+      END DO
+   
+*
+*     End of DTPLQT2
+*
+      END
diff --git a/SRC/dtpmlqt.f b/SRC/dtpmlqt.f
new file mode 100644
index 00000000..d1193391
--- /dev/null
+++ b/SRC/dtpmlqt.f
@@ -0,0 +1,366 @@
+*> \brief \b DTPMLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPMQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtpmlqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtpmlqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtpmlqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+*                           A, LDA, B, LDB, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+*      $                   T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPMQRT applies a real orthogonal matrix Q obtained from a 
+*> "triangular-pentagonal" real block reflector H to a general
+*> real matrix C, which consists of two blocks A and B.
+*> \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 B. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B. N >= 0.
+*> \endverbatim
+*> 
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The order of the trapezoidal part of V.  
+*>          K >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DTPLQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is DOUBLE PRECISION array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DTPLQT in B.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDV >= max(1,M);
+*>          if SIDE = 'R', LDV >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is DOUBLE PRECISION array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DTPLQT, stored as a MB-by-K matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is DOUBLE PRECISION array, dimension
+*>          (LDA,N) if SIDE = 'L' or 
+*>          (LDA,K) if SIDE = 'R'
+*>          On entry, the K-by-N or M-by-K matrix A.
+*>          On exit, A is overwritten by the corresponding block of 
+*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. 
+*>          If SIDE = 'L', LDC >= max(1,K);
+*>          If SIDE = 'R', LDC >= max(1,M). 
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is DOUBLE PRECISION array, dimension (LDB,N)
+*>          On entry, the M-by-N matrix B.
+*>          On exit, B is overwritten by the corresponding block of
+*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. 
+*>          LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is DOUBLE PRECISION array. The dimension of WORK is
+*>           N*MB if SIDE = 'L', or  M*MB 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 2015
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The columns of the pentagonal matrix V contain the elementary reflectors
+*>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a 
+*>  trapezoidal block V2:
+*>
+*>        V = [V1] [V2].
+*>            
+*>
+*>  The size of the trapezoidal block V2 is determined by the parameter L, 
+*>  where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
+*>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is lower triangular;
+*>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
+*>
+*>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is K-by-M. 
+*>                      [B]   
+*>  
+*>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is K-by-N.
+*>
+*>  The real orthogonal matrix Q is formed from V and T.
+*>
+*>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
+*>
+*>  If TRANS='T' and SIDE='L', C is on exit replaced with Q**T * C.
+*>
+*>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
+*>
+*>  If TRANS='T' and SIDE='R', C is on exit replaced with C * Q**T.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE DTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+     $                    A, LDA, B, LDB, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      DOUBLE PRECISION   V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+     $                   T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, NB, LB, KF, LDAQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'T' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF ( LEFT ) THEN
+         LDAQ = MAX( 1, K )
+      ELSE IF ( RIGHT ) THEN
+         LDAQ = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
+         INFO = -6         
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
+         INFO = -7
+      ELSE IF( LDV.LT.K ) THEN
+         INFO = -9
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -11
+      ELSE IF( LDA.LT.LDAQ ) THEN
+         INFO = -13
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'DTPMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF
+            CALL DTPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL DTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )  
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF                   
+            CALL DTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL DTPRFB( 'R', 'T', 'F', 'R', M, NB, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of DTPMLQT
+*
+      END
diff --git a/SRC/ilaenv.f b/SRC/ilaenv.f
index d8217a3c..e81446cb 100644
--- a/SRC/ilaenv.f
+++ b/SRC/ilaenv.f
@@ -2,29 +2,29 @@
 *
 *  =========== DOCUMENTATION ===========
 *
-* Online html documentation available at
-*            http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
 *
 *> \htmlonly
-*> Download ILAENV + dependencies
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaenv.f">
-*> [TGZ]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaenv.f">
-*> [ZIP]</a>
-*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaenv.f">
+*> Download ILAENV + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ilaenv.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ilaenv.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ilaenv.f"> 
 *> [TXT]</a>
-*> \endhtmlonly
+*> \endhtmlonly 
 *
 *  Definition:
 *  ===========
 *
 *       INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
-*
+* 
 *       .. Scalar Arguments ..
 *       CHARACTER*( * )    NAME, OPTS
 *       INTEGER            ISPEC, N1, N2, N3, N4
 *       ..
-*
+*  
 *
 *> \par Purpose:
 *  =============
@@ -127,14 +127,14 @@
 *  Authors:
 *  ========
 *
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
 *
-*> \date June 2016
+*> \date November 2015
 *
-*> \ingroup OTHERauxiliary
+*> \ingroup auxOTHERauxiliary
 *
 *> \par Further Details:
 *  =====================
@@ -162,10 +162,10 @@
 *  =====================================================================
       INTEGER FUNCTION ILAENV( ISPEC, NAME, OPTS, N1, N2, N3, N4 )
 *
-*  -- LAPACK auxiliary routine (version 3.6.1) --
+*  -- LAPACK auxiliary routine (version 3.6.0) --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-*     June 2016
+*     November 2015
 *
 *     .. Scalar Arguments ..
       CHARACTER*( * )    NAME, OPTS
@@ -283,6 +283,50 @@
             ELSE
                NB = 32
             END IF
+         ELSE IF( C3.EQ.'QR ') THEN
+            IF( N3 .EQ. 1) THEN
+               IF( SNAME ) THEN
+                  IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+                     NB = N1
+                  ELSE
+                     NB = 32768/N2
+                  END IF
+               ELSE
+                  IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+                     NB = N1
+                  ELSE
+                     NB = 32768/N2
+                  END IF  
+               END IF
+            ELSE
+               IF( SNAME ) THEN
+                  NB = 1
+               ELSE
+                  NB = 1
+               END IF
+            END IF
+         ELSE IF( C3.EQ.'LQ ') THEN
+            IF( N3 .EQ. 2) THEN
+               IF( SNAME ) THEN
+                  IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+                     NB = N1
+                  ELSE
+                     NB = 32768/N2
+                  END IF
+               ELSE
+                  IF ((M*N.LE.131072).OR.(M.LE.8192)) THEN
+                     NB = N1
+                  ELSE
+                     NB = 32768/N2
+                  END IF  
+               END IF
+            ELSE
+               IF( SNAME ) THEN
+                  NB = 1
+               ELSE
+                  NB = 1
+               END IF
+            END IF
          ELSE IF( C3.EQ.'HRD' ) THEN
             IF( SNAME ) THEN
                NB = 32
@@ -397,12 +441,6 @@
             ELSE
                NB = 64
             END IF
-         ELSE IF ( C3.EQ.'EVC' ) THEN
-            IF( SNAME ) THEN
-               NB = 64
-            ELSE
-               NB = 64
-            END IF
          END IF
       ELSE IF( C2.EQ.'LA' ) THEN
          IF( C3.EQ.'UUM' ) THEN
diff --git a/SRC/sgelq.f b/SRC/sgelq.f
new file mode 100644
index 00000000..4e5a3500
--- /dev/null
+++ b/SRC/sgelq.f
@@ -0,0 +1,269 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+*                          INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       REAL              A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> SGELQ computes an LQ factorization of an M-by-N matrix A, 
+*> using SLASWLQ when A is short and wide 
+*> (N sufficiently greater than M), and otherwise SGELQT:          
+*> A = L * Q .
+*> \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 below the diagonal of the array 
+*>          contain the M-by-min(M,N) lower trapezoidal matrix L 
+*>          (L is lower triangular if M <= N);
+*>          the elements above the diagonal are the rows of 
+*>          blocked V representing Q (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] WORK1
+*> \verbatim
+*>          WORK1 is REAL array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    SLASWLQ or SGELQT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): horizontal block size
+*>          WORK1(5): vertical block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           SLASWLQ or SGELQT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2),  and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*>
+*  =====================================================================
+      SUBROUTINE SGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           SGELQT, SLASWLQ, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'SGELQ ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'SGELQ ', ' ', M, N, 2, -1)
+      ELSE
+        MB = 1
+        NB = N
+      END IF
+      IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
+      IF( NB.GT.N.OR.NB.LE.M) NB = N
+      MINLW1 = M + 5
+      IF ((NB.GT.M).AND.(N.GT.M)) THEN
+        IF(MOD(N-M, NB-M).EQ.0) THEN
+          NBLCKS = (N-M)/(NB-M)
+        ELSE
+          NBLCKS = (N-M)/(NB-M) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
+     $    .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = N 
+        END IF
+        IF (LWORK2.LT.MB*M) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) 
+     $   .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
+     $   .AND.(.NOT.LMINWS) ) THEN
+        INFO = -8 
+      END IF    
+*
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = MB*M*NBLCKS+5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = MB * M
+        WORK2(2) = M
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SGELQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+      IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL SGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+      ELSE 
+         CALL SLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of SGELQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/sgelqt.f b/SRC/sgelqt.f
new file mode 100644
index 00000000..6b037811
--- /dev/null
+++ b/SRC/sgelqt.f
@@ -0,0 +1,193 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, LDT, M, N, MB
+*       ..
+*       .. Array Arguments ..
+*       REAL      A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGELQT computes a blocked LQ factorization of a real M-by-N matrix A
+*> using the compact WY representation of Q.  
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  MIN(M,N) >= MB >= 1.
+*> \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 below the diagonal of the array
+*>          contain the M-by-MIN(M,N) lower trapezoidal matrix L (L is
+*>          lower triangular if M <= N); the elements above the diagonal
+*>          are the rows of V.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,MIN(M,N))
+*>          The upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MB*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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (         1 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  
+*>  Let K=MIN(M,N).  The number of blocks is B = ceiling(K/NB), where each
+*>  block is of order NB except for the last block, which is of order 
+*>  IB = K - (B-1)*NB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The NB-by-NB (and IB-by-IB 
+*>  for the last block) T's are stored in the NB-by-N matrix T as
+*>
+*>               T = (T1 T2 ... TB).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDT, M, N, MB
+*     ..
+*     .. Array Arguments ..
+      REAL     A( LDA, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, IINFO, K
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   SGEQRT2, SGEQRT3, SLARFB, XERBLA
+*     ..
+*     .. 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( MB.LT.1 .OR. ( MB.GT.MIN(M,N) .AND. MIN(M,N).GT.0 ) )THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGELQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      K = MIN( M, N )
+      IF( K.EQ.0 ) RETURN
+*
+*     Blocked loop of length K
+*
+      DO I = 1, K,  MB
+         IB = MIN( K-I+1, MB )
+*     
+*     Compute the LQ factorization of the current block A(I:M,I:I+IB-1)
+*       
+         CALL SGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO )
+         IF( I+IB.LE.M ) THEN
+*
+*     Update by applying H**T to A(I:M,I+IB:N) from the right
+*
+         CALL SLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB,
+     $                   A( I, I ), LDA, T( 1, I ), LDT, 
+     $                   A( I+IB, I ), LDA, WORK , M-I-IB+1 )
+         END IF
+      END DO
+      RETURN
+*     
+*     End of SGELQT
+*
+      END
diff --git a/SRC/sgelqt3.f b/SRC/sgelqt3.f
new file mode 100644
index 00000000..94784feb
--- /dev/null
+++ b/SRC/sgelqt3.f
@@ -0,0 +1,242 @@
+*  Definition:
+*  ===========
+*
+*       RECURSIVE SUBROUTINE SGELQT3( M, N, A, LDA, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, M, N, LDT
+*       ..
+*       .. Array Arguments ..
+*       REAL   A( LDA, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGELQT3 recursively computes a LQ factorization of a real M-by-N 
+*> matrix A, using the compact WY representation of Q. 
+*>
+*> Based on the algorithm of Elmroth and Gustavson, 
+*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M =< N.
+*> \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 real M-by-N matrix A.  On exit, the elements on and
+*>          below the diagonal contain the N-by-N lower triangular matrix L; the
+*>          elements above the diagonal are the rows of V.  See below for
+*>          further details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,N)
+*>          The N-by-N upper triangular factor of the block reflector.
+*>          The elements on and above the diagonal contain the block
+*>          reflector T; the elements below the diagonal are not used.
+*>          See below for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date September 2012
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (     1  v3 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  The
+*>  block reflector H is then given by
+*>
+*>               H = I - V * T * V**T
+*>
+*>  where V**T is the transpose of V.
+*>
+*>  For details of the algorithm, see Elmroth and Gustavson (cited above).
+*> \endverbatim
+*>
+*  =====================================================================
+      RECURSIVE SUBROUTINE SGELQT3( M, N, A, LDA, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, M, N, LDT
+*     ..
+*     .. Array Arguments ..
+      REAL      A( LDA, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL   ONE
+      PARAMETER ( ONE = 1.0D+00 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, I1, J, J1, N1, N2, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  DLARFG, DTRMM, DGEMM, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      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
+      ELSE IF( LDT .LT. MAX( 1, M ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGELQT3', -INFO )
+         RETURN
+      END IF
+*
+      IF( M.EQ.1 ) THEN
+*
+*        Compute Householder transform when N=1
+*
+         CALL SLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
+*         
+      ELSE
+*
+*        Otherwise, split A into blocks...
+*
+         M1 = M/2
+         M2 = M-M1
+         I1 = MIN( M1+1, M )
+         J1 = MIN( M+1, N )
+*
+*        Compute A(1:M1,1:N) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
+*
+         CALL SGELQT3( M1, N, A, LDA, T, LDT, IINFO )
+*
+*        Compute A(J1:M,1:N) = Q1^H A(J1:M,1:N) [workspace: T(1:N1,J1:N)]
+*
+         DO I=1,M2
+            DO J=1,M1
+               T(  I+M1, J ) = A( I+M1, J )
+            END DO
+         END DO
+         CALL STRMM( 'R', 'U', 'T', 'U', M2, M1, ONE, 
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         CALL SGEMM( 'N', 'T', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
+     &               A( 1, I1 ), LDA, ONE, T( I1, 1 ), LDT)
+*
+         CALL STRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
+     &               T, LDT, T( I1, 1 ), LDT )
+*
+         CALL SGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,  
+     &                A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
+*
+         CALL STRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         DO I=1,M2
+            DO J=1,M1
+               A(  I+M1, J ) = A( I+M1, J ) - T( I+M1, J )
+               T( I+M1, J )=0
+            END DO
+         END DO
+*
+*        Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
+*
+         CALL SGELQT3( M2, N-M1, A( I1, I1 ), LDA, 
+     &                T( I1, I1 ), LDT, IINFO )
+*
+*        Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
+*
+         DO I=1,M2
+            DO J=1,M1
+               T( J, I+M1  ) = (A( J, I+M1 ))
+            END DO
+         END DO
+*
+         CALL STRMM( 'R', 'U', 'T', 'U', M1, M2, ONE,
+     &               A( I1, I1 ), LDA, T( 1, I1 ), LDT )
+*
+         CALL SGEMM( 'N', 'T', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
+     &               A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
+*
+         CALL STRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, 
+     &               T( 1, I1 ), LDT )
+*
+         CALL STRMM( 'R', 'U', 'N', 'N', M1, M2, ONE, 
+     &               T( I1, I1 ), LDT, T( 1, I1 ), LDT )
+*
+*         
+*
+*        Y = (Y1,Y2); L = [ L1            0  ];  T = [T1 T3]
+*                         [ A(1:N1,J1:N)  L2 ]       [ 0 T2]
+*
+      END IF
+*
+      RETURN
+*
+*     End of SGELQT3
+*
+      END
diff --git a/SRC/sgemlq.f b/SRC/sgemlq.f
new file mode 100644
index 00000000..37a9fb9b
--- /dev/null
+++ b/SRC/sgemlq.f
@@ -0,0 +1,261 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, 
+*     $                LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      REAL              A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>     DGEMLQ 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 blocked elementary reflectors computed by short wide LQ 
+*>    factorization (DGELQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is REAL array, dimension (MAX(1,LWORK1)) is
+*>          returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,  
+     $      C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, MB, NB, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           STPMLQT, SGEMLQT, XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF (LEFT) THEN
+        LW = N * MB
+        MN = M
+      ELSE
+        LW = M * MB
+        MN = N
+      END IF
+      IF ((NB.GT.K).AND.(MN.GT.K)) THEN
+        IF(MOD(MN-K, NB-K).EQ.0) THEN
+          NBLCKS = (MN-K)/(NB-K)
+        ELSE
+          NBLCKS = (MN-K)/(NB-K) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+        WORK2(1) = LW
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SGEMLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
+     $   (NB.GE.MAX(M,N,K))) THEN
+        CALL SGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        WORK1(6), MB, C, LDC, WORK2, INFO)  
+      ELSE
+        CALL SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $    MB, C, LDC, WORK2, LWORK2, INFO )
+      END IF
+*
+      WORK2(1) = LW
+      RETURN
+*
+*     End of SGEMLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/sgemlqt.f b/SRC/sgemlqt.f
new file mode 100644
index 00000000..7e0dfff7
--- /dev/null
+++ b/SRC/sgemlqt.f
@@ -0,0 +1,272 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+*                          C, LDC, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       REAL      V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGEMQRT 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) = I - V T V**T
+*>
+*> generated using the compact WY representation as returned by DGELQT. 
+*>
+*> 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;
+*>          = 'C':  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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DGELQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension (LDV,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DGELQT in the first K rows of its array argument A.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DGELQT, stored as a MB-by-M matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \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, Q**T C, 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. The dimension of
+*>          WORK is N*MB if SIDE = 'L', or  M*MB 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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*  =====================================================================
+      SUBROUTINE SGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+     $                   C, LDC, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      REAL      V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, LDWORK, KF, Q
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, DLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'T' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF( LEFT ) THEN
+         LDWORK = MAX( 1, N )
+      ELSE IF ( RIGHT ) THEN
+         LDWORK = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0) THEN
+         INFO = -5
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN
+         INFO = -6
+      ELSE IF( LDV.LT.MAX( 1, K ) ) THEN
+          INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'SGEMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL SLARFB( 'L', 'T', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL SLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL SLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL SLARFB( 'R', 'T', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of SGEMLQT
+*
+      END
diff --git a/SRC/sgemqr.f b/SRC/sgemqr.f
new file mode 100644
index 00000000..8e3deacb
--- /dev/null
+++ b/SRC/sgemqr.f
@@ -0,0 +1,269 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,  
+*     $                     LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      REAL              A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      SGEMQR 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 blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (DGEQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DGETSQR in the first k columns of 
+*>          its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is REAL array, dimension (MAX(1,LWORK1)) as
+*>          it is returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          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.
+*>
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, 
+     $        C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK1( * ), C(LDC, * ),
+     $               WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    MB, NB, I, II, KK, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           SGEMQRT, STPMQRT, XERBLA 
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF(LEFT) THEN
+        LW = N * NB
+        MN = M
+      ELSE IF(RIGHT) THEN
+        LW = MB * NB
+        MN = N
+      END IF 
+*
+      IF ((MB.GT.K).AND.(MN.GT.K)) THEN
+          IF(MOD(MN-K, MB-K).EQ.0) THEN
+             NBLCKS = (MN-K)/(MB-K)
+          ELSE
+             NBLCKS = (MN-K)/(MB-K) + 1
+          END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ).AND.MIN(M,N,K).NE.0 ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+        WORK2(1) = LW  
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SGEMQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
+     $   (MB.GE.MAX(M,N,K))) THEN
+        CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        WORK1(6), NB, C, LDC, WORK2, INFO)   
+      ELSE
+        CALL SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $      NB, C, LDC, WORK2, LWORK2, INFO )
+      END IF       
+*
+      WORK2(1) = LW
+*  
+      RETURN
+*
+*     End of SGEMQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/sgeqr.f b/SRC/sgeqr.f
new file mode 100644
index 00000000..c984404c
--- /dev/null
+++ b/SRC/sgeqr.f
@@ -0,0 +1,267 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
+*                        INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       REAL              A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> SGEQR computes a QR factorization of an M-by-N matrix A, 
+*> using SLATSQR when A is tall and skinny 
+*> (M sufficiently greater than N), and otherwise SGEQRT:          
+*> 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 represent Q (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] WORK1
+*> \verbatim
+*>          WORK1 is REAL array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    DLATSQR or DGEQRT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): row block size
+*>          WORK1(5): column block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           SLATSQR or SGEQRT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2), and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK2))      
+*> \endverbatim
+*>
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           SLATSQR, SGEQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'SGEQR ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'SGEQR ', ' ', M, N, 2, -1)
+      ELSE
+        MB = M
+        NB = 1
+      END IF
+      IF( MB.GT.M.OR.MB.LE.N) MB = M
+      IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
+      MINLW1 = N + 5
+      IF ((MB.GT.N).AND.(M.GT.N)) THEN
+        IF(MOD(M-N, MB-N).EQ.0) THEN
+          NBLCKS = (M-N)/(MB-N)
+        ELSE
+          NBLCKS = (M-N)/(MB-N) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) 
+     $    .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) 
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = M 
+        END IF
+        IF (LWORK2.LT.NB*N) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) 
+     $   .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) 
+     $   .AND.(.NOT.LMINWS)) THEN
+        INFO = -8 
+      END IF    
+
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = NB * N * NBLCKS + 5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = NB * N
+        WORK2(2) = N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SGEQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+      IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL SGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+      ELSE 
+         CALL SLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of SGEQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/sgetsls.f b/SRC/sgetsls.f
new file mode 100644
index 00000000..73496a89
--- /dev/null
+++ b/SRC/sgetsls.f
@@ -0,0 +1,475 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+*     $                   , WORK, LWORK, INFO )
+
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          TRANS
+*       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       REAL   A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> SGETSLS solves overdetermined or underdetermined real linear systems
+*> involving an M-by-N matrix A, using a tall skinny QR or short wide LQ 
+*> factorization of A.  It is assumed that A has full rank.
+*>
+*> 
+*>
+*> The following options are provided:
+*>
+*> 1. If TRANS = 'N' and m >= n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A*X ||.
+
+*> 2. If TRANS = 'N' and m < n:  find the minimum norm solution of
+*>    an underdetermined system A * X = B.
+
+*> 3. If TRANS = 'T' and m >= n:  find the minimum norm solution of
+*>    an undetermined system A**T * X = B.
+
+*> 4. If TRANS = 'T' and m < n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A**T * X ||.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': the linear system involves A;
+*>          = 'T': the linear system involves A**T.
+*> \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] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of
+*>          columns of the matrices B and X. NRHS >=0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit,
+*>          A is overwritten by details of its QR or LQ
+*>          factorization as returned by DGETSQR.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,NRHS)
+*>          On entry, the matrix B of right hand side vectors, stored
+*>          columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+*>          if TRANS = 'T'.
+*>          On exit, if INFO = 0, B is overwritten by the solution
+*>          vectors, stored columnwise:
+*>          if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+*>          squares solution vectors.
+*>          if TRANS = 'N' and m < n, rows 1 to N of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m < n, rows 1 to M of B contain the
+*>          least squares solution vectors.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. LDB >= MAX(1,M,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MAX(1,LWORK))
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK,
+*>          and WORK(2) returns the minimum LWORK.
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          IF LWORK=-1, workspace query is assumed, and 
+*>          WORK(1) returns the optimal LWORK,
+*>          and WORK(2) returns the minimum LWORK.
+*> \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, the i-th diagonal element of the
+*>                triangular factor of A is zero, so that A does not have
+*>                full rank; the least squares solution could not be
+*>                computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*> \ingroup doubleGEsolve
+*
+*  =====================================================================
+      SUBROUTINE SGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+     $                   , WORK, LWORK, 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 ..
+      CHARACTER          TRANS
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+*     ..
+*     .. Array Arguments ..
+      REAL               A( LDA, * ), B( LDB, * ), WORK( * )
+*
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL               ZERO, ONE
+      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, TRAN
+      INTEGER            I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
+     $                   SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+      REAL               ANRM, BIGNUM, BNRM, SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      REAL               SLAMCH, SLANGE
+      EXTERNAL           LSAME, ILAENV, SLABAD, SLAMCH, SLANGE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           SGEQR, SGEMQR, SLASCL, SLASET, 
+     $                   STRTRS, XERBLA, SGELQ, SGEMLQ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          REAL, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments.
+*
+      INFO=0
+      MINMN = MIN( M, N )
+      MAXMN = MAX( M, N )
+      MNK   = MAX(MINMN,NRHS)
+      TRAN  = LSAME( TRANS, 'T' )
+*
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. 
+     $    LSAME( TRANS, 'T' ) ) ) THEN
+         INFO = -1
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size and minimum LWORK
+*       
+       IF ( M.GE.N ) THEN
+        CALL SGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL SGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+       ELSE 
+        CALL SGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+       END IF
+*
+       IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
+          INFO=-10
+       END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SGETSLS', -INFO )
+        WORK( 1 ) = REAL( WSIZEO )
+        WORK( 2 ) = REAL( WSIZEM )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK( 1 ) = REAL( WSIZEO )
+        WORK( 2 ) = REAL( WSIZEM )
+        RETURN
+      END IF
+      IF(LWORK.LT.WSIZEO) THEN
+        LW1=INT(WORK(3))
+        LW2=MAX(LW,INT(WORK(6)))
+      ELSE
+        LW1=INT(WORK(2))
+        LW2=MAX(LW,INT(WORK(6)))
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
+           CALL SLASET( 'FULL', MAX( M, N ), NRHS, ZERO, ZERO, 
+     $       B, LDB )
+           RETURN
+      END IF
+*
+*     Get machine parameters
+*
+       SMLNUM = SLAMCH( 'S' ) / SLAMCH( 'P' )
+       BIGNUM = ONE / SMLNUM
+       CALL SLABAD( SMLNUM, BIGNUM )
+*
+*     Scale A, B if max element outside range [SMLNUM,BIGNUM]
+*
+      ANRM = SLANGE( 'M', M, N, A, LDA, RWORK )
+      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', MAXMN, NRHS, ZERO, ZERO, B, LDB )
+         GO TO 50
+      END IF
+*
+      BROW = M
+      IF ( TRAN ) THEN
+        BROW = N
+      END IF
+      BNRM = SLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+      IBSCL = 0
+      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL SLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, 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, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 2
+      END IF
+*
+      IF ( M.GE.N) THEN
+*
+*        compute QR factorization of A
+*
+        CALL SGEQR( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+        IF (.NOT.TRAN) THEN
+*
+*           Least-Squares Problem min || A * X - B ||
+*
+*           B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
+*
+          CALL SGEMQR( 'L' , 'T', M, NRHS, N, A, LDA, 
+     $         WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+*
+*           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
+*
+          CALL STRTRS( 'U', 'N', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+          IF(INFO.GT.0) THEN
+            RETURN
+          END IF
+          SCLLEN = N
+        ELSE
+*
+*           Overdetermined system of equations A**T * X = B
+*
+*           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
+*
+            CALL STRTRS( 'U', 'T', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(N+1:M,1:NRHS) = ZERO
+*
+            DO 20 J = 1, NRHS
+               DO 10 I = N + 1, M
+                  B( I, J ) = ZERO
+   10          CONTINUE
+   20       CONTINUE
+*
+*           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
+*
+            CALL SGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )       
+*
+            SCLLEN = M
+*
+         END IF
+*
+      ELSE
+*
+*        Compute LQ factorization of A
+*
+        CALL SGELQ( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+*
+*        workspace at least M, optimally M*NB.
+*
+         IF( .NOT.TRAN ) THEN
+*
+*           underdetermined system of equations A * X = B
+*
+*           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
+*
+            CALL STRTRS( 'L', 'N', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(M+1:N,1:NRHS) = 0
+*
+            DO 40 J = 1, NRHS
+               DO 30 I = M + 1, N
+                  B( I, J ) = ZERO
+   30          CONTINUE
+   40       CONTINUE
+*
+*           B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
+*
+            CALL SGEMLQ( 'L', 'T', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+            SCLLEN = N
+*
+         ELSE
+*
+*           overdetermined system min || A**T * X - B ||
+*
+*           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
+*
+            CALL SGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+*           B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
+*
+            CALL STRTRS( 'Lower', 'Transpose', 'Non-unit', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+            SCLLEN = M
+*
+         END IF
+*
+      END IF
+*
+*     Undo scaling
+*
+      IF( IASCL.EQ.1 ) THEN
+        CALL SLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IASCL.EQ.2 ) THEN
+        CALL SLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+      IF( IBSCL.EQ.1 ) THEN
+         CALL SLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IBSCL.EQ.2 ) THEN
+         CALL SLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+*
+   50 CONTINUE
+       WORK( 1 ) = REAL( WSIZEO )
+       WORK( 2 ) = REAL( WSIZEM )
+      RETURN
+*
+*     End of SGETSLS
+*
+      END
\ No newline at end of file
diff --git a/SRC/slamswlq.f b/SRC/slamswlq.f
new file mode 100644
index 00000000..c636c70c
--- /dev/null
+++ b/SRC/slamswlq.f
@@ -0,0 +1,406 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+*     $                LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>    DLAMQRTS 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 blocked
+*>    elementary reflectors computed by short wide LQ 
+*>    factorization (DLASWLQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>                MB > M.
+*>         
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is REAL array, dimension 
+*>          ( M * Number of blocks(CEIL(N-K/NB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,NB) * MB;
+*>          if SIDE = 'R', LWORK >= max(1,M) * MB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+     $    LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK( * ), C(LDC, * ),
+     $      T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW, CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           STPMLQT, SGEMLQT, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * MB
+      ELSE
+        LW = M * MB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, MB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SLAMSWLQ', -INFO )
+        WORK(1) = LW
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK(1) = LW
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN
+        CALL DGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)  
+        RETURN
+      END IF
+*
+      IF(LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((M-K),(NB-K))
+          CTR = (M-K)/(NB-K)
+*
+          IF (KK.GT.0) THEN
+            II=M-KK+1
+            CALL STPMLQT('L','T',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+          ELSE
+            II=M+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+NB)
+*
+            CTR = CTR - 1
+            CALL STPMLQT('L','T',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $          T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $          C(I,1), LDC, WORK, INFO )
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:NB)
+*
+          CALL SGEMLQT('L','T',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(NB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL SGEMLQT('L','N',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (I:I+NB,1:N)
+*
+          CALL STPMLQT('L','N',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $         T(1,CTR * K+1), LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL STPMLQT('L','N',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(NB-K))
+          CTR = (N-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL STPMLQT('R','N',M , KK, K, 0, MB, A(1, II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+             CTR = CTR - 1
+             CALL STPMLQT('R','N', M, NB-K, K, 0, MB, A(1, I), LDA,
+     $            T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $            C(1,I), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL SGEMLQT('R','N',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.TRAN) THEN
+*
+*       Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(NB-K))
+         II=N-KK+1
+         CTR = 1
+         CALL SGEMLQT('R','T',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL STPMLQT('R','T',M , NB-K, K, 0,MB, A(1,I), LDA,
+     $       T(1, CTR*K+1), LDT, C(1,1), LDC,
+     $       C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*       Multiply Q to the last block of C
+*  
+          CALL STPMLQT('R','T',M , KK, K, 0,MB, A(1,II), LDA,
+     $      T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $      C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW
+      RETURN
+*
+*     End of SLAMSWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/slamtsqr.f b/SRC/slamtsqr.f
new file mode 100644
index 00000000..3618db08
--- /dev/null
+++ b/SRC/slamtsqr.f
@@ -0,0 +1,405 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+*     $                     LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      DOUBLE        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      SLAMTSQR 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 blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (DLATSQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>          MB > N. (must be the same as DLATSQR)
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DLATSQR in the first k columns of 
+*>          its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is REAL array, dimension 
+*>          ( N * Number of blocks(CEIL(M-K/MB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          
+*>          If SIDE = 'L', LWORK >= max(1,N)*NB;
+*>          if SIDE = 'R', LWORK >= max(1,MB)*NB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+     $        LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK( * ), C(LDC, * ),
+     $                T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW, CTR 
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           SGEMQRT, STPMQRT, XERBLA 
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'T' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * NB
+      ELSE
+        LW = MB * NB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+          WORK(1) = LW
+      END IF
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SLAMTSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
+        CALL SGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)   
+        RETURN
+       END IF       
+*
+      IF(LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+         KK = MOD((M-K),(MB-K))
+         CTR = (M-K)/(MB-K)
+         IF (KK.GT.0) THEN
+           II=M-KK+1
+           CALL STPMQRT('L','N',KK , N, K, 0, NB, A(II,1), LDA,
+     $       T(1,CTR*K+1),LDT , C(1,1), LDC,
+     $       C(II,1), LDC, WORK, INFO )
+         ELSE
+           II=M+1
+         END IF
+*
+         DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+           CTR = CTR - 1
+           CALL STPMQRT('L','N',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $         T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+*          
+         END DO
+*
+*         Multiply Q to the first block of C (1:MB,1:N)
+*
+         CALL SGEMQRT('L','N',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(MB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL SGEMQRT('L','T',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+          CALL STPMQRT('L','T',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $       T(1,CTR * K + 1),LDT, C(1,1), LDC,
+     $       C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*  
+          CALL STPMQRT('L','T',KK , N, K, 0,NB, A(II,1), LDA,
+     $      T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $      C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(MB-K))
+          CTR = (N-K)/(MB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL STPMQRT('R','T',M , KK, K, 0, NB, A(II,1), LDA,
+     $        T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+              CTR = CTR - 1
+              CALL STPMQRT('R','T',M , MB-K, K, 0,NB, A(I,1), LDA,
+     $          T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $          C(1,I), LDC, WORK, INFO )
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL SGEMQRT('R','T',M , MB, K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(MB-K))
+         II=N-KK+1
+         CTR = 1
+         CALL SGEMQRT('R','N', M, MB , K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL STPMQRT('R','N', M, MB-K, K, 0,NB, A(I,1), LDA,
+     $         T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $         C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL STPMQRT('R','N', M, KK , K, 0,NB, A(II,1), LDA,
+     $        T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW 
+      RETURN
+*
+*     End of SLAMTSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/slaswlq.f b/SRC/slaswlq.f
new file mode 100644
index 00000000..acd9170d
--- /dev/null
+++ b/SRC/slaswlq.f
@@ -0,0 +1,258 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK,
+*                            LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       REAL              A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>          SLASWLQ computes a blocked Short-Wide LQ factorization of a 
+*>          M-by-N matrix A, where N >= M:
+*>          A = L * Q
+*> \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 >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \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 bleow the diagonal 
+*>          of the array contain the N-by-N lower triangular matrix L; 
+*>          the elements above the diagonal represent Q by the rows 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is REAL array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((N-M)/(NB-M))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= MB * M.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, 
+     $                  INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LWORK, LDT
+*     ..
+*     .. Array Arguments ..
+      REAL              A( LDA, * ), WORK( * ), T( LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           SGEQRT, STPQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
+        INFO = -2
+      ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
+        INFO = -3  
+      ELSE IF( NB.LE.M ) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+        INFO = -8
+      ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN   
+      WORK(1) = MB*M
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SLASWLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+       IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL SGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
+        RETURN
+       END IF 
+* 
+       KK = MOD((N-M),(NB-M))
+       II=N-KK+1   
+*
+*      Compute the LQ factorization of the first block A(1:M,1:NB)
+*
+       CALL SGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
+       CTR = 1
+*
+       DO I = NB+1, II-NB+M , (NB-M)
+*     
+*      Compute the QR factorization of the current block A(1:M,I:I+NB-M)
+*
+         CALL STPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
+     $                  LDA, T(1, CTR * M + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*     Compute the QR factorization of the last block A(1:M,II:N)
+*
+       IF (II.LE.N) THEN
+        CALL STPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
+     $                  LDA, T(1, CTR * M + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      WORK( 1 ) = M * MB
+      RETURN
+*     
+*     End of SLASWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/slatsqr.f b/SRC/slatsqr.f
new file mode 100644
index 00000000..3fbf8b88
--- /dev/null
+++ b/SRC/slatsqr.f
@@ -0,0 +1,255 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+*                           LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       REAL              A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> SLATSQR computes a blocked Tall-Skinny QR factorization of  
+*> an M-by-N matrix A, where M >= N:
+*> 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. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          MB > N.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \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 N-by-N upper triangular matrix R; 
+*>          the elements below the diagonal represent Q by the columns 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is REAL array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((M-N)/(MB-N))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) REAL array, dimension (MAX(1,LWORK))       
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= NB*N.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE SLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+     $                    LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*     ..
+*     .. Array Arguments ..
+      REAL  A( LDA, * ), WORK( * ), T(LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           SGEQRT, STPQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
+        INFO = -2
+      ELSE IF( MB.LE.N ) THEN
+        INFO = -3  
+      ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.NB ) THEN
+        INFO = -8
+      ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN
+        WORK(1) = NB*N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'SLATSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+       IF ((MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL SGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
+         RETURN
+       END IF  
+       KK = MOD((M-N),(MB-N))
+       II=M-KK+1   
+*
+*      Compute the QR factorization of the first block A(1:MB,1:N)
+*
+       CALL SGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
+*
+       CTR = 1
+       DO I = MB+1, II-MB+N ,  (MB-N)
+*     
+*      Compute the QR factorization of the current block A(I:I+MB-N,1:N)
+*
+         CALL STPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
+     $                 T(1, CTR * N + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*      Compute the QR factorization of the last block A(II:M,1:N)
+*
+       IF (II.LE.M) THEN
+         CALL STPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
+     $                 T(1, CTR * N + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      work( 1 ) = N*NB
+      RETURN
+*     
+*     End of SLATSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/stplqt.f b/SRC/stplqt.f
new file mode 100644
index 00000000..56d19d71
--- /dev/null
+++ b/SRC/stplqt.f
@@ -0,0 +1,270 @@
+*> \brief \b STPLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE STPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+*                          INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, LDB, LDT, N, M, L, MB
+*       ..
+*       .. Array Arguments ..
+*       REAL  A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPLQT computes a blocked LQ factorization of a real 
+*> "triangular-pentagonal" matrix C, which is composed of a 
+*> triangular block A and pentagonal block B, using the compact 
+*> WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B, and the order of the
+*>          triangular matrix A.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  M >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the lower triangular N-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,N)
+*>          The lower triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See Further Details.
+*> \endverbatim
+*>          
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array, dimension (MB*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 2013
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ] [ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>          [ B ] = [ B1 ] [ B2 ] 
+*>                   [ B1 ]  <- M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L upper trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>            [ C ] = [ A ] [ B ] 
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>            [ W ] = [ I ] [ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>            [ V ] = [ V1 ] [ V2 ] 
+*>                   [ V1 ] <- M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>
+*>  The number of blocks is B = ceiling(M/MB), where each
+*>  block is of order MB except for the last block, which is of order 
+*>  IB = M - (M-1)*MB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The MB-by-MB (and IB-by-IB 
+*>  for the last block) T's are stored in the MB-by-N matrix T as
+*>
+*>               T = [T1 T2 ... TB].
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE STPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+     $                   INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDB, LDT, N, M, L, MB
+*     ..
+*     .. Array Arguments ..
+      REAL    A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, LB, NB, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   STPLQT2, STPRFB, XERBLA
+*     ..
+*     .. 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( L.LT.0 .OR. (L.GT.MIN(M,N) .AND. MIN(M,N).GE.0)) THEN
+         INFO = -3
+      ELSE IF( MB.LT.1 .OR. (MB.GT.M .AND. M.GT.0)) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'STPLQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
+*
+      DO I = 1, M, MB
+*     
+*     Compute the QR factorization of the current block
+*
+         IB = MIN( M-I+1, MB )
+         NB = MIN( N-L+I+IB-1, N )
+         IF( I.GE.L ) THEN
+            LB = 0
+         ELSE
+            LB = NB-N+L-I+1
+         END IF
+*
+         CALL STPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, 
+     $                 T(1, I ), LDT, IINFO )
+*
+*     Update by applying H**T to B(I+IB:M,:) from the right
+*
+         IF( I+IB.LE.M ) THEN
+            CALL STPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB,
+     $                    B( I, 1 ), LDB, T( 1, I ), LDT, 
+     $                    A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, 
+     $                    WORK, M-I-IB+1)
+         END IF
+      END DO
+      RETURN
+*     
+*     End of STPLQT
+*
+      END
diff --git a/SRC/stplqt2.f b/SRC/stplqt2.f
new file mode 100644
index 00000000..e8b9f19d
--- /dev/null
+++ b/SRC/stplqt2.f
@@ -0,0 +1,312 @@
+*> \brief \b STPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download STPLQT2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stplqt2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stplqt2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stplqt2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE STPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*       ..
+*       .. Array Arguments ..
+*       REAL   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> STPLQT2 computes a LQ a factorization of a real "triangular-pentagonal"
+*> matrix C, which is composed of a triangular block A and pentagonal block B, 
+*> using the compact WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of rows of the matrix B.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B, and the order of
+*>          the triangular matrix A.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.  
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension (LDA,N)
+*>          On entry, the lower triangular M-by-M matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,M)
+*>          The N-by-N upper triangular factor T of the block reflector.
+*>          See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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 September 2012
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ][ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>
+*>               B = [ B1 ][ B2 ]
+*>                   [ B1 ]  <-     M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L lower trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>
+*>               C = [ A ][ B ]
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>
+*>               W = [ I ][ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>
+*>               W = [ V1 ][ V2 ]               
+*>                   [ V1 ] <-     M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>  The (M+N)-by-(M+N) block reflector H is then given by
+*>
+*>               H = I - W**T * T * W
+*>
+*>  where W^H is the conjugate transpose of W and T is the upper triangular
+*>  factor of the block reflector.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE STPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*     ..
+*     .. Array Arguments ..
+      REAL   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      REAL  ONE, ZERO
+      PARAMETER( ONE = 1.0, ZERO = 0.0 )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, J, P, MP, NP
+      REAL   ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  SLARFG, SGEMV, SGER, STRMV, 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( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -7
+      ELSE IF( LDT.LT.MAX( 1, M ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'STPLQT2', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
+*      
+      DO I = 1, M
+*
+*        Generate elementary reflector H(I) to annihilate B(I,:)
+*
+         P = N-L+MIN( L, I )
+         CALL SLARFG( P+1, A( I, I ), B( I, 1 ), LDB, T( 1, I ) )
+         IF( I.LT.M ) THEN
+*
+*           W(M-I:1) := C(I+1:M,I:N) * C(I,I:N) [use W = T(M,:)]
+*
+            DO J = 1, M-I
+               T( M, J ) = (A( I+J, I ))
+            END DO
+            CALL SGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, 
+     $                  B( I, 1 ), LDB, ONE, T( M, 1 ), LDT )
+*
+*           C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H
+*
+            ALPHA = -(T( 1, I ))            
+            DO J = 1, M-I
+               A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J ))
+            END DO
+            CALL SGER( M-I, P, ALPHA,  T( M, 1 ), LDT,
+     $          B( I, 1 ), LDB, B( I+1, 1 ), LDB )
+         END IF
+      END DO
+*
+      DO I = 2, M
+*
+*        T(I,1:I-1) := C(I:I-1,1:N) * (alpha * C(I,I:N)^H)
+*
+         ALPHA = -T( 1, I )
+
+         DO J = 1, I-1
+            T( I, J ) = ZERO
+         END DO
+         P = MIN( I-1, L )
+         NP = MIN( N-L+1, N )
+         MP = MIN( P+1, M )
+*
+*        Triangular part of B2
+*
+         DO J = 1, P
+            T( I, J ) = ALPHA*B( I, N-L+J )
+         END DO
+         CALL STRMV( 'L', 'N', 'N', P, B( 1, NP ), LDB,
+     $               T( I, 1 ), LDT )
+*
+*        Rectangular part of B2
+*
+         CALL SGEMV( 'N', I-1-P, L,  ALPHA, B( MP, NP ), LDB, 
+     $               B( I, NP ), LDB, ZERO, T( I,MP ), LDT )
+*
+*        B1
+*
+         CALL SGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, 
+     $               ONE, T( I, 1 ), LDT )         
+*
+*        T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1)
+*
+        CALL STRMV( 'L', 'T', 'N', I-1, T, LDT, T( I, 1 ), LDT )
+*
+*        T(I,I) = tau(I)
+*
+         T( I, I ) = T( 1, I )
+         T( 1, I ) = ZERO
+      END DO
+      DO I=1,M
+         DO J= I+1,M
+            T(I,J)=T(J,I)
+            T(J,I)= ZERO
+         END DO
+      END DO
+   
+*
+*     End of STPLQT2
+*
+      END
diff --git a/SRC/stpmlqt.f b/SRC/stpmlqt.f
new file mode 100644
index 00000000..2dcdb0d1
--- /dev/null
+++ b/SRC/stpmlqt.f
@@ -0,0 +1,366 @@
+*> \brief \b DTPMLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPMQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/stpmlqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/stpmlqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/stpmlqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+*                           A, LDA, B, LDB, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       REAL               V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+*      $                   T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPMQRT applies a real orthogonal matrix Q obtained from a 
+*> "triangular-pentagonal" real block reflector H to a general
+*> real matrix C, which consists of two blocks A and B.
+*> \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 B. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B. N >= 0.
+*> \endverbatim
+*> 
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The order of the trapezoidal part of V.  
+*>          K >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DTPLQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is REAL array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DTPLQT in B.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDV >= max(1,M);
+*>          if SIDE = 'R', LDV >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is REAL array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DTPLQT, stored as a MB-by-K matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is REAL array, dimension
+*>          (LDA,N) if SIDE = 'L' or 
+*>          (LDA,K) if SIDE = 'R'
+*>          On entry, the K-by-N or M-by-K matrix A.
+*>          On exit, A is overwritten by the corresponding block of 
+*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. 
+*>          If SIDE = 'L', LDC >= max(1,K);
+*>          If SIDE = 'R', LDC >= max(1,M). 
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is REAL array, dimension (LDB,N)
+*>          On entry, the M-by-N matrix B.
+*>          On exit, B is overwritten by the corresponding block of
+*>          Q*C or Q**T*C or C*Q or C*Q**T.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. 
+*>          LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is REAL array. The dimension of WORK is
+*>           N*MB if SIDE = 'L', or  M*MB 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 2015
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The columns of the pentagonal matrix V contain the elementary reflectors
+*>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a 
+*>  trapezoidal block V2:
+*>
+*>        V = [V1] [V2].
+*>            
+*>
+*>  The size of the trapezoidal block V2 is determined by the parameter L, 
+*>  where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
+*>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is lower triangular;
+*>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
+*>
+*>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is K-by-M. 
+*>                      [B]   
+*>  
+*>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is K-by-N.
+*>
+*>  The real orthogonal matrix Q is formed from V and T.
+*>
+*>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
+*>
+*>  If TRANS='T' and SIDE='L', C is on exit replaced with Q**T * C.
+*>
+*>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
+*>
+*>  If TRANS='T' and SIDE='R', C is on exit replaced with C * Q**T.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE STPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+     $                    A, LDA, B, LDB, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      REAL   V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+     $                   T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, NB, LB, KF, LDAQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, SLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'T' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF ( LEFT ) THEN
+         LDAQ = MAX( 1, K )
+      ELSE IF ( RIGHT ) THEN
+         LDAQ = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
+         INFO = -6         
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
+         INFO = -7
+      ELSE IF( LDV.LT.K ) THEN
+         INFO = -9
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -11
+      ELSE IF( LDA.LT.LDAQ ) THEN
+         INFO = -13
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'STPMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF
+            CALL STPRFB( 'L', 'T', 'F', 'R', NB, N, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL STPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )  
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF                   
+            CALL STPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL STPRFB( 'R', 'T', 'F', 'R', M, NB, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of STPMLQT
+*
+      END
diff --git a/SRC/zgelq.f b/SRC/zgelq.f
new file mode 100644
index 00000000..2e188df9
--- /dev/null
+++ b/SRC/zgelq.f
@@ -0,0 +1,268 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE CGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+*                          INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16        A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> ZGELQ computes an LQ factorization of an M-by-N matrix A, 
+*> using ZLASWLQ when A is short and wide 
+*> (N sufficiently greater than M), and otherwise ZGELQT:          
+*> A = L * Q .
+*> \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 COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array 
+*>          contain the M-by-min(M,N) lower trapezoidal matrix L 
+*>          (L is lower triangular if M <= N);
+*>          the elements above the diagonal are the rows of 
+*>          blocked V representing Q (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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    ZLASWLQ or ZGELQT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): horizontal block size
+*>          WORK1(5): vertical block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           ZLASWLQ or ZGELQT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2),  and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZGELQ( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16  A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           ZGELQT, ZLASWLQ, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'ZGELQ ', ' ', M, N, 2, -1)
+      ELSE
+        MB = 1
+        NB = N
+      END IF
+      IF( MB.GT.MIN(M,N).OR.MB.LT.1) MB = 1
+      IF( NB.GT.N.OR.NB.LE.M) NB = N
+      MINLW1 = M + 5
+      IF ((NB.GT.M).AND.(N.GT.M)) THEN
+        IF(MOD(N-M, NB-M).EQ.0) THEN
+          NBLCKS = (N-M)/(NB-M)
+        ELSE
+          NBLCKS = (N-M)/(NB-M) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.      
+      IF((LWORK1.LT.MAX(1,MB*M*NBLCKS+5)
+     $    .OR.(LWORK2.LT.MB*M)).AND.(LWORK2.GE.M).AND.(LWORK1.GE.M+5)
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1,MB*M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1,M*NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = N 
+        END IF
+        IF (LWORK2.LT.MB*M) THEN
+            LMINWS = .TRUE.
+            MB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, MB*M*NBLCKS+5 ) 
+     $   .AND.(.NOT.LQUERY).AND. (.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,M*MB)).AND.(.NOT.LQUERY)
+     $   .AND.(.NOT.LMINWS) ) THEN
+        INFO = -8 
+      END IF    
+*
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = MB*M*NBLCKS+5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = MB * M
+        WORK2(2) = M
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZGELQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+      IF((N.LE.M).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL ZGELQT( M, N, MB, A, LDA, WORK1(6), MB, WORK2, INFO)
+      ELSE 
+         CALL ZLASWLQ( M, N, MB, NB, A, LDA, WORK1(6), MB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of ZGELQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/zgelqt.f b/SRC/zgelqt.f
new file mode 100644
index 00000000..d726db78
--- /dev/null
+++ b/SRC/zgelqt.f
@@ -0,0 +1,210 @@
+*> \brief \b ZGELQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER INFO, LDA, LDT, M, N, MB
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZGELQT computes a blocked LQ factorization of a complex M-by-N matrix A
+*> using the compact WY representation of Q.  
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  MIN(M,N) >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the M-by-MIN(M,N) lower trapezoidal matrix L (L is
+*>          lower triangular if M <= N); the elements above the diagonal
+*>          are the rows of V.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,MIN(M,N))
+*>          The upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MB*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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (         1 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  
+*>  Let K=MIN(M,N).  The number of blocks is B = ceiling(K/NB), where each
+*>  block is of order NB except for the last block, which is of order 
+*>  IB = K - (B-1)*NB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The NB-by-NB (and IB-by-IB 
+*>  for the last block) T's are stored in the NB-by-N matrix T as
+*>
+*>               T = (T1 T2 ... TB).
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER INFO, LDA, LDT, M, N, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16 A( LDA, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, IINFO, K
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   ZGELQT3, ZLARFB, XERBLA
+*     ..
+*     .. 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( MB.LT.1 .OR. (MB.GT.MIN(M,N) .AND. MIN(M,N).GT.0 ))THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -7
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZGELQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      K = MIN( M, N )
+      IF( K.EQ.0 ) RETURN
+*
+*     Blocked loop of length K
+*
+      DO I = 1, K,  MB
+         IB = MIN( K-I+1, MB )
+*     
+*     Compute the LQ factorization of the current block A(I:M,I:I+IB-1)
+*       
+         CALL ZGELQT3( IB, N-I+1, A(I,I), LDA, T(1,I), LDT, IINFO )
+         IF( I+IB.LE.M ) THEN
+*
+*     Update by applying H**T to A(I:M,I+IB:N) from the right
+*
+         CALL ZLARFB( 'R', 'N', 'F', 'R', M-I-IB+1, N-I+1, IB,
+     $                   A( I, I ), LDA, T( 1, I ), LDT, 
+     $                   A( I+IB, I ), LDA, WORK , M-I-IB+1 )
+         END IF
+      END DO
+      RETURN
+*     
+*     End of ZGELQT
+*
+      END
diff --git a/SRC/zgelqt3.f b/SRC/zgelqt3.f
new file mode 100644
index 00000000..93e8cf31
--- /dev/null
+++ b/SRC/zgelqt3.f
@@ -0,0 +1,261 @@
+*> \brief \b ZGELQT3 recursively computes a LQ factorization of a general real or complex matrix using the compact WY representation of Q.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEQRT3 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgelqt3.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgelqt3.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgelqt3.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, M, N, LDT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16   A( LDA, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DGELQT3 recursively computes a LQ factorization of a complex M-by-N 
+*> matrix A, using the compact WY representation of Q. 
+*>
+*> Based on the algorithm of Elmroth and Gustavson, 
+*> IBM J. Res. Develop. Vol 44 No. 4 July 2000.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix A.  M =< N.
+*> \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 COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the real M-by-N matrix A.  On exit, the elements on and
+*>          below the diagonal contain the N-by-N lower triangular matrix L; the
+*>          elements above the diagonal are the rows of V.  See below for
+*>          further details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,N)
+*>          The N-by-N upper triangular factor of the block reflector.
+*>          The elements on and above the diagonal contain the block
+*>          reflector T; the elements below the diagonal are not used.
+*>          See below for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date September 2012
+*
+*> \ingroup doubleGEcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The matrix V stores the elementary reflectors H(i) in the i-th column
+*>  below the diagonal. For example, if M=5 and N=3, the matrix V is
+*>
+*>               V = (  1  v1 v1 v1 v1 )
+*>                   (     1  v2 v2 v2 )
+*>                   (     1  v3 v3 v3 )
+*>                   
+*>
+*>  where the vi's represent the vectors which define H(i), which are returned
+*>  in the matrix A.  The 1's along the diagonal of V are not stored in A.  The
+*>  block reflector H is then given by
+*>
+*>               H = I - V * T * V**T
+*>
+*>  where V**T is the transpose of V.
+*>
+*>  For details of the algorithm, see Elmroth and Gustavson (cited above).
+*> \endverbatim
+*>
+*  =====================================================================
+      RECURSIVE SUBROUTINE ZGELQT3( M, N, A, LDA, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER   INFO, LDA, M, N, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16   A( LDA, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16   ONE, ZERO
+      PARAMETER ( ONE = (1.0D+00,0.0D+00) )
+      PARAMETER ( ZERO = (0.0D+00,0.0D+00))
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, I1, J, J1, N1, N2, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  ZLARFG, ZTRMM, ZGEMM, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+      INFO = 0
+      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
+      ELSE IF( LDT .LT. MAX( 1, M ) ) THEN
+         INFO = -6
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZGELQT3', -INFO )
+         RETURN
+      END IF
+*
+      IF( M.EQ.1 ) THEN
+*
+*        Compute Householder transform when N=1
+*
+         CALL ZLARFG( N, A, A( 1, MIN( 2, N ) ), LDA, T )
+         T(1,1)=CONJG(T(1,1))
+*         
+      ELSE
+*
+*        Otherwise, split A into blocks...
+*
+         M1 = M/2
+         M2 = M-M1
+         I1 = MIN( M1+1, M )
+         J1 = MIN( M+1, N )
+*
+*        Compute A(1:M1,1:N) <- (Y1,R1,T1), where Q1 = I - Y1 T1 Y1^H
+*
+         CALL ZGELQT3( M1, N, A, LDA, T, LDT, IINFO )
+*
+*        Compute A(J1:M,1:N) =  A(J1:M,1:N) Q1^H [workspace: T(1:N1,J1:N)]
+*
+         DO I=1,M2
+            DO J=1,M1
+               T(  I+M1, J ) = A( I+M1, J )
+            END DO
+         END DO
+         CALL ZTRMM( 'R', 'U', 'C', 'U', M2, M1, ONE, 
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         CALL ZGEMM( 'N', 'C', M2, M1, N-M1, ONE, A( I1, I1 ), LDA,
+     &               A( 1, I1 ), LDA, ONE, T( I1, 1 ), LDT)
+*
+         CALL ZTRMM( 'R', 'U', 'N', 'N', M2, M1, ONE,
+     &               T, LDT, T( I1, 1 ), LDT )
+*
+         CALL ZGEMM( 'N', 'N', M2, N-M1, M1, -ONE, T( I1, 1 ), LDT,  
+     &                A( 1, I1 ), LDA, ONE, A( I1, I1 ), LDA )
+*
+         CALL ZTRMM( 'R', 'U', 'N', 'U', M2, M1 , ONE,
+     &               A, LDA, T( I1, 1 ), LDT )
+*
+         DO I=1,M2
+            DO J=1,M1
+               A(  I+M1, J ) = A( I+M1, J ) - T( I+M1, J )
+               T( I+M1, J )= ZERO
+            END DO
+         END DO
+*
+*        Compute A(J1:M,J1:N) <- (Y2,R2,T2) where Q2 = I - Y2 T2 Y2^H
+*
+         CALL ZGELQT3( M2, N-M1, A( I1, I1 ), LDA, 
+     &                T( I1, I1 ), LDT, IINFO )
+*
+*        Compute T3 = T(J1:N1,1:N) = -T1 Y1^H Y2 T2
+*
+         DO I=1,M2
+            DO J=1,M1
+               T( J, I+M1  ) = (A( J, I+M1 ))
+            END DO
+         END DO
+*
+         CALL ZTRMM( 'R', 'U', 'C', 'U', M1, M2, ONE,
+     &               A( I1, I1 ), LDA, T( 1, I1 ), LDT )
+*
+         CALL ZGEMM( 'N', 'C', M1, M2, N-M, ONE, A( 1, J1 ), LDA,
+     &               A( I1, J1 ), LDA, ONE, T( 1, I1 ), LDT )
+*
+         CALL ZTRMM( 'L', 'U', 'N', 'N', M1, M2, -ONE, T, LDT, 
+     &               T( 1, I1 ), LDT )
+*
+         CALL ZTRMM( 'R', 'U', 'N', 'N', M1, M2, ONE, 
+     &               T( I1, I1 ), LDT, T( 1, I1 ), LDT )
+*
+*         
+*
+*        Y = (Y1,Y2); L = [ L1            0  ];  T = [T1 T3]
+*                         [ A(1:N1,J1:N)  L2 ]       [ 0 T2]
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZGELQT3
+*
+      END
diff --git a/SRC/zgemlq.f b/SRC/zgemlq.f
new file mode 100644
index 00000000..f71b6fd8
--- /dev/null
+++ b/SRC/zgemlq.f
@@ -0,0 +1,261 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, 
+*     $                LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX*16        A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>     ZGEMLQ 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 complex orthogonal matrix defined as the product 
+*>    of blocked elementary reflectors computed by short wide LQ 
+*>    factorization (DGELQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) is
+*>          returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX*16 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GELQ will use either
+*>  LASWLQ(if the matrix is short-and-wide) or GELQT to compute
+*>  the LQ decomposition. 
+*>  The output of LASWLQ or GELQT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB, NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LASWLQ or GELQT was used is the same as used below in
+*>  GELQ. For a detailed description of A and WORK1(6:LWORK1), see 
+*>  Further Details in LASWLQ or GELQT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZGEMLQ( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1,  
+     $      C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16     A( LDA, * ), C( LDC, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, MB, NB, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           ZLAMSWLQ, ZGEMLQT, XERBLA
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF (LEFT) THEN
+        LW = N * MB
+        MN = M
+      ELSE
+        LW = M * MB
+        MN = N
+      END IF
+      IF ((NB.GT.K).AND.(MN.GT.K)) THEN
+        IF(MOD(MN-K, NB-K).EQ.0) THEN
+          NBLCKS = (MN-K)/(NB-K)
+        ELSE
+          NBLCKS = (MN-K)/(NB-K) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, MB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+        WORK2(1) = LW
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZGEMLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(NB.LE.K).OR.
+     $   (NB.GE.MAX(M,N,K))) THEN
+        CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        WORK1(6), MB, C, LDC, WORK2, INFO)  
+      ELSE
+        CALL ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $    MB, C, LDC, WORK2, LWORK2, INFO )
+      END IF
+*
+      WORK2(1) = LW
+      RETURN
+*
+*     End of ZGEMLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/zgemlqt.f b/SRC/zgemlqt.f
new file mode 100644
index 00000000..6060f9ef
--- /dev/null
+++ b/SRC/zgemlqt.f
@@ -0,0 +1,289 @@
+*> \brief \b ZGEMLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DGEMQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgemlqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgemlqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgemlqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+*                          C, LDC, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       DOUBLE PRECISION V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZGEMQRT overwrites the general real M-by-N matrix C with
+*>
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q C            C Q
+*> TRANS = 'C':   Q**C C            C Q**C
+*>
+*> where Q is a complex orthogonal matrix defined as the product of K
+*> elementary reflectors:
+*>
+*>       Q = H(1) H(2) . . . H(K) = I - V C V**C
+*>
+*> generated using the compact WY representation as returned by ZGELQT. 
+*>
+*> 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**C from the Left;
+*>          = 'R': apply Q or Q**C from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Transpose, apply Q**C.
+*> \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] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DGELQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX*16 array, dimension (LDV,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DGELQT in the first K rows of its array argument A.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDA >= max(1,M);
+*>          if SIDE = 'R', LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DGELQT, stored as a MB-by-M matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*> \verbatim
+*>          C is COMPLEX*16 array, dimension (LDC,N)
+*>          On entry, the M-by-N matrix C.
+*>          On exit, C is overwritten by Q C, Q**C C, C Q**C 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 COMPLEX*16 array. The dimension of
+*>          WORK is N*MB if SIDE = 'L', or  M*MB 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 2013
+*
+*> \ingroup doubleGEcomputational
+*
+*  =====================================================================
+      SUBROUTINE ZGEMLQT( SIDE, TRANS, M, N, K, MB, V, LDV, T, LDT, 
+     $                   C, LDC, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDC, M, N, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16 V( LDV, * ), C( LDC, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, LDWORK, KF, Q
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZLARFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'C' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF( LEFT ) THEN
+         LDWORK = MAX( 1, N )
+      ELSE IF ( RIGHT ) THEN
+         LDWORK = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0) THEN
+         INFO = -5
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0)) THEN
+         INFO = -6
+      ELSE IF( LDV.LT.MAX( 1, K ) ) THEN
+          INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -12
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZGEMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL ZLARFB( 'L', 'C', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            CALL ZLARFB( 'R', 'N', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL ZLARFB( 'L', 'N', 'F', 'R', M-I+1, N, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( I, 1 ), LDC, WORK, LDWORK )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            CALL ZLARFB( 'R', 'C', 'F', 'R', M, N-I+1, IB, 
+     $                   V( I, I ), LDV, T( 1, I ), LDT, 
+     $                   C( 1, I ), LDC, WORK, LDWORK )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZGEMLQT
+*
+      END
diff --git a/SRC/zgemqr.f b/SRC/zgemqr.f
new file mode 100644
index 00000000..c78fe4d0
--- /dev/null
+++ b/SRC/zgemqr.f
@@ -0,0 +1,268 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1,  
+*     $                     LWORK1, C, LDC, WORK2, LWORK2, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, LDT, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX*16        A( LDA, * ), WORK1( * ), C(LDC, * ),
+*     $                  WORK2( * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      ZGEMQR 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 complex orthogonal matrix defined as the product 
+*>      of blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (ZGEQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DGETSQR in the first k columns of 
+*>          its array argument A.
+*> \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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1)) as
+*>          it is returned by GEQR.
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX*16 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.
+*>
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))
+*>        
+*> \endverbatim
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2. 
+*>          If LWORK2 = -1, then a workspace query is assumed; the routine
+*>          only calculates the optimal size of the WORK2 array, returns
+*>          this value as the third entry of the WORK2 array (WORK2(1)), 
+*>          and no error message related to LWORK2 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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZGEMQR( SIDE, TRANS, M, N, K, A, LDA, WORK1, LWORK1, 
+     $        C, LDC, WORK2, LWORK2, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, LWORK1, LWORK2, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16        A( LDA, * ), WORK1( * ), C(LDC, * ),
+     $               WORK2( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    MB, NB, I, II, KK, LW, NBLCKS, MN
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL           ZGEMQRT, ZLAMTSQR, XERBLA 
+*     .. Intrinsic Functions ..
+      INTRINSIC          INT, MAX, MIN, MOD
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK2.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+*
+      MB = INT(WORK1(4))
+      NB = INT(WORK1(5))
+      IF(LEFT) THEN
+        LW = N * NB
+        MN = M
+      ELSE IF(RIGHT) THEN
+        LW = MB * NB
+        MN = N
+      END IF 
+*
+      IF ((MB.GT.K).AND.(MN.GT.K)) THEN
+          IF(MOD(MN-K, MB-K).EQ.0) THEN
+             NBLCKS = (MN-K)/(MB-K)
+          ELSE
+             NBLCKS = (MN-K)/(MB-K) + 1
+          END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -7
+      ELSE IF( LWORK1.LT.MAX( 1, NB*K*NBLCKS+5 )) THEN
+        INFO = -9
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -11
+      ELSE IF(( LWORK2.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -13
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+         WORK2(1) = LW  
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZGEMQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((LEFT.AND.M.LE.K).OR.(RIGHT.AND.N.LE.K).OR.(MB.LE.K).OR.
+     $   (MB.GE.MAX(M,N,K))) THEN
+        CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        WORK1(6), NB, C, LDC, WORK2, INFO)   
+      ELSE
+        CALL ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, WORK1(6),
+     $      NB, C, LDC, WORK2, LWORK2, INFO )
+      END IF       
+*
+      WORK2(1) = LW 
+      RETURN
+*
+*     End of DGEMQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f
new file mode 100644
index 00000000..18a7f100
--- /dev/null
+++ b/SRC/zgeqr.f
@@ -0,0 +1,267 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2,
+*                        INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16        A( LDA, * ), WORK1( * ), WORK2( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> ZGEQR computes a QR factorization of an M-by-N matrix A, 
+*> using ZLATSQR when A is tall and skinny 
+*> (M sufficiently greater than N), and otherwise ZGEQRT:          
+*> 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 COMPLEX*16 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 represent Q (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] WORK1
+*> \verbatim
+*>          WORK1 is COMPLEX*16 array, dimension (MAX(1,LWORK1))
+*>          WORK1 contains part of the data structure used to store Q.
+*>          WORK1(1): algorithm type = 1, to indicate output from 
+*>                    ZLATSQR or ZGEQRT
+*>          WORK1(2): optimum size of WORK1
+*>          WORK1(3): minimum size of WORK1
+*>          WORK1(4): row block size
+*>          WORK1(5): column block size
+*>          WORK1(6:LWORK1): data structure needed for Q, computed by 
+*>                           CLATSQR or CGEQRT
+*> \endverbatim
+*>
+*> \param[in] LWORK1
+*> \verbatim
+*>          LWORK1 is INTEGER
+*>          The dimension of the array WORK1.
+*>          If LWORK1 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK1 and
+*>          returns this value in WORK1(2), and calculates the minimum 
+*>          size of WORK1 and returns this value in WORK1(3). 
+*>          No error message related to LWORK1 is issued by XERBLA when 
+*>          LWORK1 = -1.
+*> \endverbatim
+*>
+*> \param[out] WORK2
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK2))      
+*> \endverbatim
+*>
+*> \param[in] LWORK2
+*> \verbatim
+*>          LWORK2 is INTEGER
+*>          The dimension of the array WORK2.
+*>          If LWORK2 = -1, then a query is assumed. In this case the 
+*>          routine calculates the optimal size of WORK2 and 
+*>          returns this value in WORK2(1), and calculates the minimum
+*>          size of WORK2 and returns this value in WORK2(2).
+*>          No error message related to LWORK2 is issued by XERBLA when
+*>          LWORK2 = -1.
+*> \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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>  Depending on the matrix dimensions M and N, and row and column
+*>  block sizes MB and NB returned by ILAENV, GEQR will use either
+*>  LATSQR (if the matrix is tall-and-skinny) or GEQRT to compute
+*>  the QR decomposition. 
+*>  The output of LATSQR or GEQRT representing Q is stored in A and in
+*>  array WORK1(6:LWORK1) for later use. 
+*>  WORK1(2:5) contains the matrix dimensions M,N and block sizes MB,NB 
+*>  which are needed to interpret A and WORK1(6:LWORK1) for later use. 
+*>  WORK1(1)=1 indicates that the code needed to take WORK1(2:5) and 
+*>  decide whether LATSQR or GEQRT was used is the same as used below in 
+*>  GEQR. For a detailed description of A and WORK1(6:LWORK1), see
+*>  Further Details in LATSQR or GEQRT.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZGEQR( M, N, A, LDA, WORK1, LWORK1, WORK2, LWORK2, 
+     $   INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, LWORK1, LWORK2
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16      A( LDA, * ), WORK1( * ), WORK2( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY, LMINWS
+      INTEGER    MB, NB, I, II, KK, MINLW1, NBLCKS
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL    ZLATSQR, ZGEQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      INTEGER            ILAENV
+      EXTERNAL           ILAENV
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK1.EQ.-1 .OR. LWORK2.EQ.-1 )
+*
+*     Determine the block size 
+*    
+      IF ( MIN(M,N).GT.0 ) THEN
+        MB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 1, -1)
+        NB = ILAENV( 1, 'ZGEQR ', ' ', M, N, 2, -1)
+      ELSE
+        MB = M
+        NB = 1
+      END IF
+      IF( MB.GT.M.OR.MB.LE.N) MB = M
+      IF( NB.GT.MIN(M,N).OR.NB.LT.1) NB = 1
+      MINLW1 = N + 5
+      IF ((MB.GT.N).AND.(M.GT.N)) THEN
+        IF(MOD(M-N, MB-N).EQ.0) THEN
+          NBLCKS = (M-N)/(MB-N)
+        ELSE
+          NBLCKS = (M-N)/(MB-N) + 1
+        END IF
+      ELSE
+        NBLCKS = 1
+      END IF
+*
+*     Determine if the workspace size satisfies minimum size
+*  
+      LMINWS = .FALSE.
+      IF((LWORK1.LT.MAX(1, NB*N*NBLCKS+5) 
+     $    .OR.(LWORK2.LT.NB*N)).AND.(LWORK2.GE.N).AND.(LWORK1.GT.N+5) 
+     $    .AND.(.NOT.LQUERY)) THEN
+        IF (LWORK1.LT.MAX(1, NB * N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF  
+        IF (LWORK1.LT.MAX(1, N * NBLCKS+5)) THEN
+            LMINWS = .TRUE.
+            MB = M 
+        END IF
+        IF (LWORK2.LT.NB*N) THEN
+            LMINWS = .TRUE.
+            NB = 1
+        END IF
+      END IF
+*
+      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( LWORK1.LT.MAX( 1, NB * N * NBLCKS + 5 ) 
+     $   .AND.(.NOT.LQUERY).AND.(.NOT.LMINWS)) THEN
+        INFO = -6
+      ELSE IF( (LWORK2.LT.MAX(1,N*NB)).AND.(.NOT.LQUERY) 
+     $   .AND.(.NOT.LMINWS)) THEN
+        INFO = -8 
+      END IF    
+
+      IF( INFO.EQ.0)  THEN
+        WORK1(1) = 1
+        WORK1(2) = NB * N * NBLCKS + 5
+        WORK1(3) = MINLW1
+        WORK1(4) = MB
+        WORK1(5) = NB
+        WORK2(1) = NB * N
+        WORK2(2) = N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZGEQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+      IF((M.LE.N).OR.(MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL ZGEQRT( M, N, NB, A, LDA, WORK1(6), NB, WORK2, INFO)
+      ELSE 
+         CALL ZLATSQR( M, N, MB, NB, A, LDA, WORK1(6), NB, WORK2, 
+     $                    LWORK2, INFO)
+      END IF
+      RETURN
+*     
+*     End of ZGEQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/zgetsls.f b/SRC/zgetsls.f
new file mode 100644
index 00000000..dc523431
--- /dev/null
+++ b/SRC/zgetsls.f
@@ -0,0 +1,490 @@
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+*     $                   , WORK, LWORK, INFO )
+
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER          TRANS
+*       INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZGETSLS solves overdetermined or underdetermined real linear systems
+*> involving an M-by-N matrix A, or its transpose, using a tall skinny 
+*> QR or short wide LQfactorization of A.  It is assumed that A has 
+*> full rank.
+*>
+*> The following options are provided:
+*>
+*> 1. If TRANS = 'N' and m >= n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A*X ||.
+*>
+*> 2. If TRANS = 'N' and m < n:  find the minimum norm solution of
+*>    an underdetermined system A * X = B.
+*>
+*> 3. If TRANS = 'C' and m >= n:  find the minimum norm solution of
+*>    an undetermined system A**T * X = B.
+*>
+*> 4. If TRANS = 'C' and m < n:  find the least squares solution of
+*>    an overdetermined system, i.e., solve the least squares problem
+*>                 minimize || B - A**T * X ||.
+*>
+*> 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.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N': the linear system involves A;
+*>          = 'C': the linear system involves A**C.
+*> \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] NRHS
+*> \verbatim
+*>          NRHS is INTEGER
+*>          The number of right hand sides, i.e., the number of
+*>          columns of the matrices B and X. NRHS >=0.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit,
+*>            if M >= N, A is overwritten by details of its QR
+*>                       factorization as returned by DGEQRF;
+*>            if M <  N, A is overwritten by details of its LQ
+*>                       factorization as returned by DGELQF.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,M).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,NRHS)
+*>          On entry, the matrix B of right hand side vectors, stored
+*>          columnwise; B is M-by-NRHS if TRANS = 'N', or N-by-NRHS
+*>          if TRANS = 'T'.
+*>          On exit, if INFO = 0, B is overwritten by the solution
+*>          vectors, stored columnwise:
+*>          if TRANS = 'N' and m >= n, rows 1 to n of B contain the least
+*>          squares solution vectors; the residual sum of squares for the
+*>          solution in each column is given by the sum of squares of
+*>          elements N+1 to M in that column;
+*>          if TRANS = 'N' and m < n, rows 1 to N of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m >= n, rows 1 to M of B contain the
+*>          minimum norm solution vectors;
+*>          if TRANS = 'T' and m < n, rows 1 to M of B contain the
+*>          least squares solution vectors; the residual sum of squares
+*>          for the solution in each column is given by the sum of
+*>          squares of elements M+1 to N in that column.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. LDB >= MAX(1,M,N).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 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, MN + max( MN, NRHS ) ).
+*>          For optimal performance,
+*>          LWORK >= max( 1, MN + max( MN, NRHS )*NB ).
+*>          where MN = min(M,N) and NB is the optimum block size.
+*>
+*>          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
+*>          > 0:  if INFO =  i, the i-th diagonal element of the
+*>                triangular factor of A is zero, so that A does not have
+*>                full rank; the least squares solution could not be
+*>                computed.
+*> \endverbatim
+*
+*  Authors:
+*  ========
+*
+*> \author Univ. of Tennessee 
+*> \author Univ. of California Berkeley 
+*> \author Univ. of Colorado Denver 
+*> \author NAG Ltd. 
+*
+*> \date November 2011
+*
+*  =====================================================================
+      SUBROUTINE ZGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB
+     $                   , WORK, LWORK, 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 ..
+      CHARACTER          TRANS
+      INTEGER            INFO, LDA, LDB, LWORK, M, N, NRHS, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16   A( LDA, * ), B( LDB, * ), WORK( * )
+*
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      DOUBLE PRECISION   ZERO, ONE
+      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
+      COMPLEX*16         CZERO
+      PARAMETER          ( CZERO = ( 0.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LQUERY, TRAN
+      INTEGER            I, IASCL, IBSCL, J, MINMN, MAXMN, BROW, LW,
+     $                   SCLLEN, MNK, WSIZEO, WSIZEM, LW1, LW2, INFO2
+      DOUBLE PRECISION   ANRM, BIGNUM, BNRM, SMLNUM
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      INTEGER            ILAENV
+      DOUBLE PRECISION   DLAMCH, ZLANGE
+      EXTERNAL           LSAME, ILAENV, DLABAD, DLAMCH, DLANGE
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           ZGEQR, ZGEMQR, ZLASCL, ZLASET, 
+     $                   ZTRTRS, XERBLA, ZGELQ, ZGEMLQ
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          DBLE, MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments.
+*
+      INFO=0
+      MINMN = MIN( M, N )
+      MAXMN = MAX( M, N )
+      MNK   = MAX(MINMN,NRHS)
+      TRAN  = LSAME( TRANS, 'C' )
+*
+      LQUERY = ( LWORK.EQ.-1 )
+      IF( .NOT.( LSAME( TRANS, 'N' ) .OR. 
+     $    LSAME( TRANS, 'C' ) ) ) THEN
+         INFO = -1
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -2
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( NRHS.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M, N ) ) THEN
+         INFO = -8
+      END IF
+*
+      IF( INFO.EQ.0)  THEN
+*
+*     Determine the block size and minimum LWORK
+*       
+      IF ( M.GE.N ) THEN
+        CALL ZGEQR( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL ZGEMQR( 'L', TRANS, M, NRHS, N, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+      ELSE 
+        CALL ZGELQ( M, N, A, LDA, WORK(1), -1, WORK(6), -1, 
+     $   INFO2)
+        MB = INT(WORK(4))
+        NB = INT(WORK(5))
+        LW = INT(WORK(6))
+        CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, WORK(1),
+     $        INT(WORK(2)), B, LDB, WORK(6), -1 , INFO2 )
+        WSIZEO = INT(WORK(2))+MAX(LW,INT(WORK(6)))
+        WSIZEM = INT(WORK(3))+MAX(LW,INT(WORK(6)))
+      END IF
+*
+       IF((LWORK.LT.WSIZEO).AND.(.NOT.LQUERY)) THEN
+          INFO=-10
+       END IF
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZGETSLS', -INFO )
+        WORK( 1 ) = DBLE( WSIZEO )
+        WORK( 2 ) = DBLE( WSIZEM )
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK( 1 ) = DBLE( WSIZEO )
+        WORK( 2 ) = DBLE( WSIZEM )
+        RETURN
+      END IF
+      IF(LWORK.LT.WSIZEO) THEN
+        LW1=INT(WORK(3))
+        LW2=MAX(LW,INT(WORK(6)))
+      ELSE
+        LW1=INT(WORK(2))
+        LW2=MAX(LW,INT(WORK(6)))
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN( M, N, NRHS ).EQ.0 ) THEN
+           CALL ZLASET( 'FULL', MAX( M, N ), NRHS, CZERO, CZERO, 
+     $       B, LDB )
+           RETURN
+      END IF
+*
+*     Get machine parameters
+*
+       SMLNUM = DLAMCH( 'S' ) / DLAMCH( 'P' )
+       BIGNUM = ONE / SMLNUM
+       CALL DLABAD( SMLNUM, BIGNUM )
+*
+*     Scale A, B if max element outside range [SMLNUM,BIGNUM]
+*
+      ANRM = ZLANGE( 'M', M, N, A, LDA, RWORK )
+      IASCL = 0
+      IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL ZLASCL( '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 ZLASCL( '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 ZLASET( 'F', MAXMN, NRHS, CZERO, CZERO, B, LDB )
+         GO TO 50
+      END IF
+*
+      BROW = M
+      IF ( TRAN ) THEN
+        BROW = N
+      END IF
+      BNRM = ZLANGE( 'M', BROW, NRHS, B, LDB, RWORK )
+      IBSCL = 0
+      IF( BNRM.GT.ZERO .AND. BNRM.LT.SMLNUM ) THEN
+*
+*        Scale matrix norm up to SMLNUM
+*
+         CALL ZLASCL( 'G', 0, 0, BNRM, SMLNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 1
+      ELSE IF( BNRM.GT.BIGNUM ) THEN
+*
+*        Scale matrix norm down to BIGNUM
+*
+         CALL ZLASCL( 'G', 0, 0, BNRM, BIGNUM, BROW, NRHS, B, LDB,
+     $                INFO )
+         IBSCL = 2
+      END IF
+*
+      IF ( M.GE.N) THEN
+*
+*        compute QR factorization of A
+*
+        CALL ZGEQR( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+        IF (.NOT.TRAN) THEN
+*
+*           Least-Squares Problem min || A * X - B ||
+*
+*           B(1:M,1:NRHS) := Q**T * B(1:M,1:NRHS)
+*
+          CALL ZGEMQR( 'L' , 'C', M, NRHS, N, A, LDA, 
+     $         WORK(LW2+1), LW1, B, LDB, WORK(1), LW2, INFO )
+*
+*           B(1:N,1:NRHS) := inv(R) * B(1:N,1:NRHS)
+*
+          CALL ZTRTRS( 'U', 'N', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+          IF(INFO.GT.0) THEN
+            RETURN
+          END IF
+          SCLLEN = N
+        ELSE
+*
+*           Overdetermined system of equations A**T * X = B
+*
+*           B(1:N,1:NRHS) := inv(R**T) * B(1:N,1:NRHS)
+*
+            CALL ZTRTRS( 'U', 'C', 'N', N, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(N+1:M,1:NRHS) = CZERO
+*
+            DO 20 J = 1, NRHS
+               DO 10 I = N + 1, M
+                  B( I, J ) = CZERO
+   10          CONTINUE
+   20       CONTINUE
+*
+*           B(1:M,1:NRHS) := Q(1:N,:) * B(1:N,1:NRHS)
+*
+            CALL ZGEMQR( 'L', 'N', M, NRHS, N, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )       
+*
+            SCLLEN = M
+*
+         END IF
+*
+      ELSE
+*
+*        Compute LQ factorization of A
+*
+        CALL ZGELQ( M, N, A, LDA, WORK(LW2+1), LW1
+     $    , WORK(1), LW2, INFO )
+*
+*        workspace at least M, optimally M*NB.
+*
+         IF( .NOT.TRAN ) THEN
+*
+*           underdetermined system of equations A * X = B
+*
+*           B(1:M,1:NRHS) := inv(L) * B(1:M,1:NRHS)
+*
+            CALL ZTRTRS( 'L', 'N', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+*           B(M+1:N,1:NRHS) = 0
+*
+            DO 40 J = 1, NRHS
+               DO 30 I = M + 1, N
+                  B( I, J ) = CZERO
+   30          CONTINUE
+   40       CONTINUE
+*
+*           B(1:N,1:NRHS) := Q(1:N,:)**T * B(1:M,1:NRHS)
+*
+            CALL ZGEMLQ( 'L', 'C', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+            SCLLEN = N
+*
+         ELSE
+*
+*           overdetermined system min || A**T * X - B ||
+*
+*           B(1:N,1:NRHS) := Q * B(1:N,1:NRHS)
+*
+            CALL ZGEMLQ( 'L', 'N', N, NRHS, M, A, LDA,
+     $                   WORK( LW2+1), LW1, B, LDB, WORK( 1 ), LW2,
+     $                   INFO )
+*
+*           workspace at least NRHS, optimally NRHS*NB
+*
+*           B(1:M,1:NRHS) := inv(L**T) * B(1:M,1:NRHS)
+*
+            CALL ZTRTRS( 'L', 'C', 'N', M, NRHS,
+     $                   A, LDA, B, LDB, INFO )
+*
+            IF( INFO.GT.0 ) THEN
+               RETURN
+            END IF
+*
+            SCLLEN = M
+*
+         END IF
+*
+      END IF
+*
+*     Undo scaling
+*
+      IF( IASCL.EQ.1 ) THEN
+        CALL ZLASCL( 'G', 0, 0, ANRM, SMLNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IASCL.EQ.2 ) THEN
+        CALL ZLASCL( 'G', 0, 0, ANRM, BIGNUM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+      IF( IBSCL.EQ.1 ) THEN
+         CALL ZLASCL( 'G', 0, 0, SMLNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      ELSE IF( IBSCL.EQ.2 ) THEN
+         CALL ZLASCL( 'G', 0, 0, BIGNUM, BNRM, SCLLEN, NRHS, B, LDB,
+     $                INFO )
+      END IF
+*
+   50 CONTINUE
+       WORK( 1 ) = DBLE( WSIZEO )
+       WORK( 2 ) = DBLE( WSIZEM )
+      RETURN
+*
+*     End of ZGETSLS
+*
+      END
\ No newline at end of file
diff --git a/SRC/zlamswlq.f b/SRC/zlamswlq.f
new file mode 100644
index 00000000..af0c62ef
--- /dev/null
+++ b/SRC/zlamswlq.f
@@ -0,0 +1,407 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+*     $                LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX*16        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>    ZLAMQRTS 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 blocked
+*>    elementary reflectors computed by short wide LQ 
+*>    factorization (ZLASWLQ)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'T':  Transpose, apply Q**T.
+*> \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 C. N >= M.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          M >= K >= 0;
+*>          
+*> \endverbatim
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>                MB > M.
+*>         
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the blocked
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DLASWLQ in the first k rows of its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension 
+*>          ( M * Number of blocks(CEIL(N-K/NB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX*16 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          If SIDE = 'L', LWORK >= max(1,NB) * MB;
+*>          if SIDE = 'R', LWORK >= max(1,M) * MB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZLAMSWLQ( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+     $    LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC, LW
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16        A( LDA, * ), WORK( * ), C(LDC, * ),
+     $      T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL    ZTPMLQT, ZGEMLQT, XERBLA
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * MB
+      ELSE
+        LW = M * MB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, MB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZLAMSWLQ', -INFO )
+        WORK(1) = LW
+        RETURN
+      ELSE IF (LQUERY) THEN
+        WORK(1) = LW
+        RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF 
+*
+      IF((NB.LE.K).OR.(NB.GE.MAX(M,N,K))) THEN
+        CALL ZGEMLQT( SIDE, TRANS, M, N, K, MB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)  
+        RETURN
+      END IF
+*
+      IF(LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((M-K),(NB-K))
+          CTR = (M-K)/(NB-K)
+*
+          IF (KK.GT.0) THEN
+            II=M-KK+1
+            CALL ZTPMLQT('L','C',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1,CTR*K+1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+          ELSE
+            II=M+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+NB)
+*
+            CTR = CTR - 1
+            CALL ZTPMLQT('L','C',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $          T(1,CTR*K+1),LDT, C(1,1), LDC,
+     $          C(I,1), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:NB)
+*
+          CALL ZGEMLQT('L','C',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(NB-K))
+         II=M-KK+1
+         CTR = 1
+         CALL ZGEMLQT('L','N',NB , N, K, MB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (I:I+NB,1:N)
+*
+          CALL ZTPMLQT('L','N',NB-K , N, K, 0,MB, A(1,I), LDA,
+     $         T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL ZTPMLQT('L','N',KK , N, K, 0, MB, A(1,II), LDA,
+     $        T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $        C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(NB-K))
+          CTR = (N-K)/(NB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL ZTPMLQT('R','N',M , KK, K, 0, MB, A(1, II), LDA,
+     $        T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(NB-K),NB+1,-(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CTR = CTR - 1
+          CALL ZTPMLQT('R','N', M, NB-K, K, 0, MB, A(1, I), LDA,
+     $        T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $        C(1,I), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL ZGEMLQT('R','N',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.TRAN) THEN
+*
+*       Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(NB-K))
+         II=N-KK+1
+         CALL ZGEMLQT('R','C',M , NB, K, MB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+         CTR = 1
+*
+         DO I=NB+1,II-NB+K,(NB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL ZTPMLQT('R','C',M , NB-K, K, 0,MB, A(1,I), LDA,
+     $       T(1,CTR *K+1), LDT, C(1,1), LDC,
+     $       C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*       Multiply Q to the last block of C
+*  
+          CALL ZTPMLQT('R','C',M , KK, K, 0,MB, A(1,II), LDA,
+     $      T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $      C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW
+      RETURN
+*
+*     End of ZLAMSWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/zlamtsqr.f b/SRC/zlamtsqr.f
new file mode 100644
index 00000000..21513027
--- /dev/null
+++ b/SRC/zlamtsqr.f
@@ -0,0 +1,405 @@
+* 
+*  Definition:
+*  ===========
+*
+*      SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T,  
+*     $                     LDT, C, LDC, WORK, LWORK, INFO )
+*
+*
+*     .. Scalar Arguments ..
+*      CHARACTER         SIDE, TRANS
+*      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+*      COMPLEX*16        A( LDA, * ), WORK( * ), C(LDC, * ),
+*     $                  T( LDT, * )
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>      ZLAMTSQR overwrites the general complex M-by-N matrix C with
+*>
+*>                     
+*>                 SIDE = 'L'     SIDE = 'R'
+*> TRANS = 'N':      Q * C          C * Q
+*> TRANS = 'C':      Q**C * C       C * Q**C
+*>      where Q is a real orthogonal matrix defined as the product 
+*>      of blocked elementary reflectors computed by tall skinny 
+*>      QR factorization (ZLATSQR)
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**T from the Left;
+*>          = 'R': apply Q or Q**T from the Right.
+*>
+*> \param[in] TRANS
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Conjugate Transpose, apply Q**C.
+*> \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 C. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*>          N >= K >= 0;
+*>          
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  
+*>          MB > N. (must be the same as DLATSQR)
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,K)
+*>          The i-th column must contain the vector which defines the 
+*>          blockedelementary reflector H(i), for i = 1,2,...,k, as 
+*>          returned by DLATSQR in the first k columns of 
+*>          its array argument A.
+*> \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] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension 
+*>          ( N * Number of blocks(CEIL(M-K/MB-K)),
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See below
+*>          for further details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[in,out] C
+*>          C is COMPLEX*16 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.
+*> \param[in] LDC
+*>          LDC is INTEGER
+*>          The leading dimension of the array C. LDC >= max(1,M).
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          LWORK is INTEGER
+*>          The dimension of the array WORK.
+*>          
+*>          If SIDE = 'L', LWORK >= max(1,N)*NB;
+*>          if SIDE = 'R', LWORK >= max(1,MB)*NB.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZLAMTSQR( SIDE, TRANS, M, N, K, MB, NB, A, LDA, T, 
+     $        LDT, C, LDC, WORK, LWORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      CHARACTER         SIDE, TRANS
+      INTEGER           INFO, LDA, M, N, K, MB, NB, LDT, LWORK, LDC
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16        A( LDA, * ), WORK( * ), C(LDC, * ),
+     $                T( LDT, * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LEFT, RIGHT, TRAN, NOTRAN, LQUERY
+      INTEGER    I, II, KK, LW, CTR
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. External Subroutines ..
+      EXTERNAL   ZGEMQRT, ZTPMQRT, XERBLA 
+*     ..
+*     .. Executable Statements ..
+*
+*     Test the input arguments
+*
+      LQUERY  = LWORK.LT.0
+      NOTRAN  = LSAME( TRANS, 'N' )
+      TRAN    = LSAME( TRANS, 'C' )
+      LEFT    = LSAME( SIDE, 'L' )
+      RIGHT   = LSAME( SIDE, 'R' )
+      IF (LEFT) THEN
+        LW = N * NB
+      ELSE
+        LW = M * NB
+      END IF
+*
+      INFO = 0
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+        INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+        INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+        INFO = -5
+      ELSE IF( LDA.LT.MAX( 1, K ) ) THEN
+        INFO = -9
+      ELSE IF( LDT.LT.MAX( 1, NB) ) THEN
+        INFO = -11
+      ELSE IF( LDC.LT.MAX( 1, M ) ) THEN
+         INFO = -13
+      ELSE IF(( LWORK.LT.MAX(1,LW)).AND.(.NOT.LQUERY)) THEN
+        INFO = -15
+      END IF
+*
+*     Determine the block size if it is tall skinny or short and wide
+*    
+      IF( INFO.EQ.0)  THEN
+          WORK(1) = LW
+      END IF
+*    
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZLAMTSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N,K).EQ.0 ) THEN
+        RETURN
+      END IF
+*
+      IF((MB.LE.K).OR.(MB.GE.MAX(M,N,K))) THEN
+        CALL ZGEMQRT( SIDE, TRANS, M, N, K, NB, A, LDA, 
+     $        T, LDT, C, LDC, WORK, INFO)   
+        RETURN
+       END IF       
+*
+      IF(LEFT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+         KK = MOD((M-K),(MB-K))
+         CTR = (M-K)/(MB-K)
+         IF (KK.GT.0) THEN
+           II=M-KK+1
+           CALL ZTPMQRT('L','N',KK , N, K, 0, NB, A(II,1), LDA,
+     $       T(1, CTR * K + 1),LDT , C(1,1), LDC,
+     $       C(II,1), LDC, WORK, INFO )
+         ELSE
+           II=M+1
+         END IF
+*
+         DO I=II-(MB-K),MB+1,-(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+           CTR = CTR - 1
+           CALL ZTPMQRT('L','N',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $         T(1,CTR * K + 1),LDT, C(1,1), LDC,
+     $         C(I,1), LDC, WORK, INFO )
+
+         END DO
+*
+*         Multiply Q to the first block of C (1:MB,1:N)
+*
+         CALL ZGEMQRT('L','N',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (LEFT.AND.TRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((M-K),(MB-K))
+         II=M-KK+1
+         CALL ZGEMQRT('L','C',MB , N, K, NB, A(1,1), LDA, T
+     $            ,LDT ,C(1,1), LDC, WORK, INFO )
+         CTR = 1
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (I:I+MB,1:N)
+*
+          CALL ZTPMQRT('L','C',MB-K , N, K, 0,NB, A(I,1), LDA,
+     $       T(1,CTR * K + 1),LDT, C(1,1), LDC,
+     $       C(I,1), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.M) THEN
+*
+*         Multiply Q to the last block of C
+*  
+          CALL ZTPMQRT('L','C',KK , N, K, 0,NB, A(II,1), LDA,
+     $      T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $      C(II,1), LDC, WORK, INFO )
+*
+         END IF
+*
+      ELSE IF(RIGHT.AND.TRAN) THEN
+*
+*         Multiply Q to the last block of C
+*
+          KK = MOD((N-K),(MB-K))
+          CTR = (N-K)/(MB-K)
+          IF (KK.GT.0) THEN
+            II=N-KK+1
+            CALL ZTPMQRT('R','C',M , KK, K, 0, NB, A(II,1), LDA,
+     $        T(1,CTR * K + 1), LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+          ELSE
+            II=N+1
+          END IF
+*
+          DO I=II-(MB-K),MB+1,-(MB-K)
+            CTR = CTR - 1
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL ZTPMQRT('R','C',M , MB-K, K, 0,NB, A(I,1), LDA,
+     $          T(1, CTR * K + 1), LDT, C(1,1), LDC,
+     $          C(1,I), LDC, WORK, INFO )
+
+          END DO
+*
+*         Multiply Q to the first block of C (1:M,1:MB)
+*
+          CALL ZGEMQRT('R','C',M , MB, K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+*
+      ELSE IF (RIGHT.AND.NOTRAN) THEN
+*
+*         Multiply Q to the first block of C
+*
+         KK = MOD((N-K),(MB-K))
+         II=N-KK+1
+         CALL ZGEMQRT('R','N', M, MB , K, NB, A(1,1), LDA, T
+     $              ,LDT ,C(1,1), LDC, WORK, INFO )
+         CTR = 1
+*
+         DO I=MB+1,II-MB+K,(MB-K)
+*
+*         Multiply Q to the current block of C (1:M,I:I+MB)
+*
+          CALL ZTPMQRT('R','N', M, MB-K, K, 0,NB, A(I,1), LDA,
+     $         T(1, CTR * K + 1),LDT, C(1,1), LDC,
+     $         C(1,I), LDC, WORK, INFO )
+          CTR = CTR + 1
+*
+         END DO
+         IF(II.LE.N) THEN
+*
+*         Multiply Q to the last block of C
+*
+          CALL ZTPMQRT('R','N', M, KK , K, 0,NB, A(II,1), LDA,
+     $        T(1,CTR * K + 1),LDT, C(1,1), LDC,
+     $        C(1,II), LDC, WORK, INFO )
+*
+         END IF
+*
+      END IF
+*
+      WORK(1) = LW   
+      RETURN
+*
+*     End of ZLAMTSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/zlaswlq.f b/SRC/zlaswlq.f
new file mode 100644
index 00000000..67178c29
--- /dev/null
+++ b/SRC/zlaswlq.f
@@ -0,0 +1,258 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK,
+*                            LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16        A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*>          ZLASWLQ computes a blocked Short-Wide LQ factorization of a 
+*>          M-by-N matrix A, where N >= M:
+*>          A = L * Q
+*> \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 >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          M >= MB >= 1 
+*> \endverbatim
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          NB > M.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the M-by-N matrix A.
+*>          On exit, the elements on and bleow the diagonal 
+*>          of the array contain the N-by-N lower triangular matrix L; 
+*>          the elements above the diagonal represent Q by the rows 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is COMPLEX*16 array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((N-M)/(NB-M))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))
+*>        
+*> \endverbatim
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= MB*M.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Short-Wide LQ (SWLQ) performs LQ by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out upper diagonal entries of a block of NB rows of A:
+*>   Q(1) zeros out the upper diagonal entries of rows 1:NB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:M,NB+1:2*NB-M] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:M,2*NB-M+1:3*NB-2*M] of A
+*>   . . .
+*>
+*> Q(1) is computed by GELQT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GELQT.
+*>
+*> Q(i) for i>1 is computed by TPLQT, which represents Q(i) by Householder vectors
+*> stored in columns [(i-1)*(NB-M)+M+1:i*(NB-M)+M] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*M+1:i*M).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZLASWLQ( M, N, MB, NB, A, LDA, T, LDT, WORK, LWORK, 
+     $                  INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LWORK, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16        A( LDA, * ), WORK( * ), T( LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL           ZGELQT, ZTPLQT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. N.LT.M ) THEN
+        INFO = -2
+      ELSE IF( MB.LT.1 .OR. ( MB.GT.M .AND. M.GT.0 )) THEN
+        INFO = -3  
+      ELSE IF( NB.LE.M ) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.MB ) THEN
+        INFO = -8
+      ELSE IF( ( LWORK.LT.M*MB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN   
+      WORK(1) = MB*M
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZLASWLQ', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The LQ Decomposition
+*
+       IF((M.GE.N).OR.(NB.LE.M).OR.(NB.GE.N)) THEN
+        CALL ZGELQT( M, N, MB, A, LDA, T, LDT, WORK, INFO)
+        RETURN
+       END IF 
+* 
+       KK = MOD((N-M),(NB-M))
+       II=N-KK+1   
+*
+*      Compute the LQ factorization of the first block A(1:M,1:NB)
+*
+       CALL ZGELQT( M, NB, MB, A(1,1), LDA, T, LDT, WORK, INFO)
+       CTR = 1
+*
+       DO I = NB+1, II-NB+M , (NB-M)
+*     
+*      Compute the QR factorization of the current block A(1:M,I:I+NB-M)
+*
+         CALL ZTPLQT( M, NB-M, 0, MB, A(1,1), LDA, A( 1, I ),
+     $                  LDA, T(1, CTR * M + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*     Compute the QR factorization of the last block A(1:M,II:N)
+*
+       IF (II.LE.N) THEN
+        CALL ZTPLQT( M, KK, 0, MB, A(1,1), LDA, A( 1, II ),
+     $                  LDA, T(1, CTR * M + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      WORK( 1 ) = M * MB
+      RETURN
+*     
+*     End of ZLASWLQ
+*
+      END
\ No newline at end of file
diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f
new file mode 100644
index 00000000..aa2cdef9
--- /dev/null
+++ b/SRC/zlatsqr.f
@@ -0,0 +1,255 @@
+* 
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+*                           LWORK, INFO)
+* 
+*       .. Scalar Arguments ..
+*       INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16        A( LDA, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*> 
+*> SLATSQR computes a blocked Tall-Skinny QR factorization of  
+*> an M-by-N matrix A, where M >= N:
+*> 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. M >= N >= 0.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The row block size to be used in the blocked QR.  
+*>          MB > N.
+*> \endverbatim
+*>
+*> \param[in] NB
+*> \verbatim
+*>          NB is INTEGER
+*>          The column block size to be used in the blocked QR.  
+*>          N >= NB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 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 N-by-N upper triangular matrix R; 
+*>          the elements below the diagonal represent Q by the columns 
+*>          of blocked V (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] T
+*> \verbatim
+*>          T is COMPLEX*16 array, 
+*>          dimension (LDT, N * Number_of_row_blocks) 
+*>          where Number_of_row_blocks = CEIL((M-N)/(MB-N))
+*>          The blocked upper triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  
+*>          See Further Details below.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= NB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>         (workspace) COMPLEX*16 array, dimension (MAX(1,LWORK))       
+*> \endverbatim
+*>
+*> \param[in] LWORK
+*> \verbatim
+*>          The dimension of the array WORK.  LWORK >= NB*N.
+*>          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.
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*> Tall-Skinny QR (TSQR) performs QR by a sequence of orthogonal transformations,
+*> representing Q as a product of other orthogonal matrices
+*>   Q = Q(1) * Q(2) * . . . * Q(k)
+*> where each Q(i) zeros out subdiagonal entries of a block of MB rows of A:
+*>   Q(1) zeros out the subdiagonal entries of rows 1:MB of A
+*>   Q(2) zeros out the bottom MB-N rows of rows [1:N,MB+1:2*MB-N] of A
+*>   Q(3) zeros out the bottom MB-N rows of rows [1:N,2*MB-N+1:3*MB-2*N] of A
+*>   . . .
+*>
+*> Q(1) is computed by GEQRT, which represents Q(1) by Householder vectors
+*> stored under the diagonal of rows 1:MB of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,1:N).
+*> For more information see Further Details in GEQRT.
+*>
+*> Q(i) for i>1 is computed by TPQRT, which represents Q(i) by Householder vectors
+*> stored in rows [(i-1)*(MB-N)+N+1:i*(MB-N)+N] of A, and by upper triangular
+*> block reflectors, stored in array T(1:LDT,(i-1)*N+1:i*N).
+*> The last Q(k) may use fewer rows.
+*> For more information see Further Details in TPQRT.
+*> 
+*> For more details of the overall algorithm, see the description of
+*> Sequential TSQR in Section 2.2 of [1].
+*>
+*> [1] “Communication-Optimal Parallel and Sequential QR and LU Factorizations,”
+*>     J. Demmel, L. Grigori, M. Hoemmen, J. Langou,
+*>     SIAM J. Sci. Comput, vol. 34, no. 1, 2012
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK, 
+     $                    LWORK, INFO)
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd. --
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER           INFO, LDA, M, N, MB, NB, LDT, LWORK
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16        A( LDA, * ), WORK( * ), T(LDT, *)
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL    LQUERY
+      INTEGER    I, II, KK, CTR
+*     ..
+*     .. EXTERNAL FUNCTIONS ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     .. EXTERNAL SUBROUTINES ..
+      EXTERNAL    ZGEQRT, ZTPQRT, XERBLA
+*     .. INTRINSIC FUNCTIONS ..
+      INTRINSIC          MAX, MIN, MOD
+*     ..
+*     .. EXECUTABLE STATEMENTS ..
+*
+*     TEST THE INPUT ARGUMENTS
+*
+      INFO = 0
+*
+      LQUERY = ( LWORK.EQ.-1 )
+*
+      IF( M.LT.0 ) THEN
+        INFO = -1
+      ELSE IF( N.LT.0 .OR. M.LT.N ) THEN
+        INFO = -2
+      ELSE IF( MB.LE.N ) THEN
+        INFO = -3  
+      ELSE IF( NB.LT.1 .OR. ( NB.GT.N .AND. N.GT.0 )) THEN
+        INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+        INFO = -5
+      ELSE IF( LDT.LT.NB ) THEN
+        INFO = -8
+      ELSE IF( LWORK.LT.(N*NB) .AND. (.NOT.LQUERY) ) THEN
+        INFO = -10 
+      END IF    
+      IF( INFO.EQ.0)  THEN
+        WORK(1) = NB*N
+      END IF
+      IF( INFO.NE.0 ) THEN
+        CALL XERBLA( 'ZLATSQR', -INFO )
+        RETURN
+      ELSE IF (LQUERY) THEN
+       RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( MIN(M,N).EQ.0 ) THEN
+          RETURN
+      END IF
+*
+*     The QR Decomposition
+*
+       IF ((MB.LE.N).OR.(MB.GE.M)) THEN
+         CALL ZGEQRT( M, N, NB, A, LDA, T, LDT, WORK, INFO)
+         RETURN
+       END IF  
+       KK = MOD((M-N),(MB-N))
+       II=M-KK+1   
+*
+*      Compute the QR factorization of the first block A(1:MB,1:N)
+*
+       CALL ZGEQRT( MB, N, NB, A(1,1), LDA, T, LDT, WORK, INFO )
+       CTR = 1
+*
+       DO I = MB+1, II-MB+N ,  (MB-N)
+*     
+*      Compute the QR factorization of the current block A(I:I+MB-N,1:N)
+*
+         CALL ZTPQRT( MB-N, N, 0, NB, A(1,1), LDA, A( I, 1 ), LDA,
+     $                 T(1, CTR * N + 1),
+     $                  LDT, WORK, INFO )
+         CTR = CTR + 1
+       END DO
+*
+*      Compute the QR factorization of the last block A(II:M,1:N)
+*
+       IF (II.LE.M) THEN
+         CALL ZTPQRT( KK, N, 0, NB, A(1,1), LDA, A( II, 1 ), LDA,
+     $                 T(1,CTR * N + 1), LDT,
+     $                  WORK, INFO )
+       END IF  
+*
+      work( 1 ) = N*NB
+      RETURN
+*     
+*     End of ZLATSQR
+*
+      END
\ No newline at end of file
diff --git a/SRC/ztplqt.f b/SRC/ztplqt.f
new file mode 100644
index 00000000..2d75d76e
--- /dev/null
+++ b/SRC/ztplqt.f
@@ -0,0 +1,270 @@
+*> \brief \b ZTPLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dtplqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+*                          INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER         INFO, LDA, LDB, LDT, N, M, L, MB
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16      A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> DTPLQT computes a blocked LQ factorization of a complex 
+*> "triangular-pentagonal" matrix C, which is composed of a 
+*> triangular block A and pentagonal block B, using the compact 
+*> WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B, and the order of the
+*>          triangular matrix A.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size to be used in the blocked QR.  M >= MB >= 1.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the lower triangular N-by-N matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,N)
+*>          The lower triangular block reflectors stored in compact form
+*>          as a sequence of upper triangular blocks.  See Further Details.
+*> \endverbatim
+*>          
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array, dimension (MB*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 2013
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ] [ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 on left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>          [ B ] = [ B1 ] [ B2 ] 
+*>                   [ B1 ]  <- M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L upper trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>            [ C ] = [ A ] [ B ] 
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>            [ W ] = [ I ] [ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>            [ V ] = [ V1 ] [ V2 ] 
+*>                   [ V1 ] <- M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>
+*>  The number of blocks is B = ceiling(M/MB), where each
+*>  block is of order MB except for the last block, which is of order 
+*>  IB = M - (M-1)*MB.  For each of the B blocks, a upper triangular block
+*>  reflector factor is computed: T1, T2, ..., TB.  The MB-by-MB (and IB-by-IB 
+*>  for the last block) T's are stored in the MB-by-N matrix T as
+*>
+*>               T = [T1 T2 ... TB].
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZTPLQT( M, N, L, MB, A, LDA, B, LDB, T, LDT, WORK,
+     $                   INFO )
+*
+*  -- LAPACK computational routine (version 3.5.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2013
+*
+*     .. Scalar Arguments ..
+      INTEGER     INFO, LDA, LDB, LDT, N, M, L, MB
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16  A( LDA, * ), B( LDB, * ), T( LDT, * ), WORK( * )
+*     ..
+*
+* =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      INTEGER    I, IB, LB, NB, IINFO
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL   ZTPLQT2, ZTPRFB, XERBLA
+*     ..
+*     .. 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( L.LT.0 .OR. (L.GT.MIN(M,N) .AND. MIN(M,N).GE.0)) THEN
+         INFO = -3
+      ELSE IF( MB.LT.1 .OR. (MB.GT.M .AND. M.GT.0)) THEN
+         INFO = -4
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -6
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -8
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -10
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZTPLQT', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( M.EQ.0 .OR. N.EQ.0 ) RETURN
+*
+      DO I = 1, M, MB
+*     
+*     Compute the QR factorization of the current block
+*
+         IB = MIN( M-I+1, MB )
+         NB = MIN( N-L+I+IB-1, N )
+         IF( I.GE.L ) THEN
+            LB = 0
+         ELSE
+            LB = NB-N+L-I+1
+         END IF
+*
+         CALL ZTPLQT2( IB, NB, LB, A(I,I), LDA, B( I, 1 ), LDB, 
+     $                 T(1, I ), LDT, IINFO )
+*
+*     Update by applying H**T to B(I+IB:M,:) from the right
+*
+         IF( I+IB.LE.M ) THEN
+            CALL ZTPRFB( 'R', 'N', 'F', 'R', M-I-IB+1, NB, IB, LB,
+     $                    B( I, 1 ), LDB, T( 1, I ), LDT, 
+     $                    A( I+IB, I ), LDA, B( I+IB, 1 ), LDB, 
+     $                    WORK, M-I-IB+1)
+         END IF
+      END DO
+      RETURN
+*     
+*     End of ZTPLQT
+*
+      END
diff --git a/SRC/ztplqt2.f b/SRC/ztplqt2.f
new file mode 100644
index 00000000..7ad75719
--- /dev/null
+++ b/SRC/ztplqt2.f
@@ -0,0 +1,333 @@
+*> \brief \b ZTPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download ZTPLQT2 + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztplqt2.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztplqt2.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztplqt2.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+* 
+*       .. Scalar Arguments ..
+*       INTEGER   INFO, LDA, LDB, LDT, N, M, L
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16   A( LDA, * ), B( LDB, * ), T( LDT, * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZTPLQT2 computes a LQ a factorization of a complex "triangular-pentagonal"
+*> matrix C, which is composed of a triangular block A and pentagonal block B, 
+*> using the compact WY representation for Q.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The total number of rows of the matrix B.  
+*>          M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B, and the order of
+*>          the triangular matrix A.
+*>          N >= 0.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The number of rows of the lower trapezoidal part of B.  
+*>          MIN(M,N) >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension (LDA,N)
+*>          On entry, the lower triangular M-by-M matrix A.
+*>          On exit, the elements on and below the diagonal of the array
+*>          contain the lower triangular matrix L.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A.  LDA >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,N)
+*>          On entry, the pentagonal M-by-N matrix B.  The first N-L columns 
+*>          are rectangular, and the last L columns are lower trapezoidal.
+*>          On exit, B contains the pentagonal matrix V.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B.  LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,M)
+*>          The N-by-N upper triangular factor T of the block reflector.
+*>          See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= 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 September 2012
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The input matrix C is a M-by-(M+N) matrix  
+*>
+*>               C = [ A ][ B ]
+*>                           
+*>
+*>  where A is an lower triangular N-by-N matrix, and B is M-by-N pentagonal
+*>  matrix consisting of a M-by-(N-L) rectangular matrix B1 left of a M-by-L
+*>  upper trapezoidal matrix B2:
+*>
+*>               B = [ B1 ][ B2 ]
+*>                   [ B1 ]  <-     M-by-(N-L) rectangular
+*>                   [ B2 ]  <-     M-by-L lower trapezoidal.
+*>
+*>  The lower trapezoidal matrix B2 consists of the first L columns of a
+*>  N-by-N lower triangular matrix, where 0 <= L <= MIN(M,N).  If L=0, 
+*>  B is rectangular M-by-N; if M=L=N, B is lower triangular.  
+*>
+*>  The matrix W stores the elementary reflectors H(i) in the i-th row
+*>  above the diagonal (of A) in the M-by-(M+N) input matrix C
+*>
+*>               C = [ A ][ B ]
+*>                   [ A ]  <- lower triangular N-by-N
+*>                   [ B ]  <- M-by-N pentagonal
+*>
+*>  so that W can be represented as
+*>
+*>               W = [ I ][ V ] 
+*>                   [ I ]  <- identity, N-by-N
+*>                   [ V ]  <- M-by-N, same form as B.
+*>
+*>  Thus, all of information needed for W is contained on exit in B, which
+*>  we call V above.  Note that V has the same form as B; that is, 
+*>
+*>               W = [ V1 ][ V2 ]               
+*>                   [ V1 ] <-     M-by-(N-L) rectangular
+*>                   [ V2 ] <-     M-by-L lower trapezoidal.
+*>
+*>  The rows of V represent the vectors which define the H(i)'s.  
+*>  The (M+N)-by-(M+N) block reflector H is then given by
+*>
+*>               H = I - W**T * T * W
+*>
+*>  where W^H is the conjugate transpose of W and T is the upper triangular
+*>  factor of the block reflector.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZTPLQT2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
+*
+*  -- LAPACK computational routine (version 3.4.2) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     September 2012
+*
+*     .. Scalar Arguments ..
+      INTEGER        INFO, LDA, LDB, LDT, N, M, L
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16     A( LDA, * ), B( LDB, * ), T( LDT, * )
+*     ..
+*
+*  =====================================================================
+*
+*     .. Parameters ..
+      COMPLEX*16  ONE, ZERO
+      PARAMETER( ZERO = ( 0.0D+0, 0.0D+0 ),ONE  = ( 1.0D+0, 0.0D+0 ) )
+*     ..
+*     .. Local Scalars ..
+      INTEGER   I, J, P, MP, NP
+      COMPLEX*16   ALPHA
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL  ZLARFG, ZGEMV, ZGERC, ZTRMV, 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( L.LT.0 .OR. L.GT.MIN(M,N) ) THEN
+         INFO = -3
+      ELSE IF( LDA.LT.MAX( 1, M ) ) THEN
+         INFO = -5
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -7
+      ELSE IF( LDT.LT.MAX( 1, M ) ) THEN
+         INFO = -9
+      END IF
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZTPLQT2', -INFO )
+         RETURN
+      END IF
+*
+*     Quick return if possible
+*
+      IF( N.EQ.0 .OR. M.EQ.0 ) RETURN
+*      
+      DO I = 1, M
+*
+*        Generate elementary reflector H(I) to annihilate B(I,:)
+*
+         P = N-L+MIN( L, I )
+         CALL ZLARFG( P+1, A( I, I ), B( I, 1 ), LDB, T( 1, I ) )
+         T(1,I)=CONJG(T(1,I))
+         IF( I.LT.M ) THEN
+            DO J = 1, P
+               B( I, J ) = CONJG(B(I,J))
+            END DO
+*
+*           W(M-I:1) := C(I+1:M,I:N) * C(I,I:N) [use W = T(M,:)]
+*
+            DO J = 1, M-I
+               T( M, J ) = (A( I+J, I ))
+            END DO
+            CALL ZGEMV( 'N', M-I, P, ONE, B( I+1, 1 ), LDB, 
+     $                  B( I, 1 ), LDB, ONE, T( M, 1 ), LDT )
+*
+*           C(I+1:M,I:N) = C(I+1:M,I:N) + alpha * C(I,I:N)*W(M-1:1)^H
+*
+            ALPHA = -(T( 1, I ))
+            DO J = 1, M-I
+               A( I+J, I ) = A( I+J, I ) + ALPHA*(T( M, J ))
+            END DO
+            CALL ZGERC( M-I, P, (ALPHA),  T( M, 1 ), LDT,
+     $          B( I, 1 ), LDB, B( I+1, 1 ), LDB )
+            DO J = 1, P
+               B( I, J ) = CONJG(B(I,J))
+            END DO
+         END IF
+      END DO
+*
+      DO I = 2, M
+*
+*        T(I,1:I-1) := C(I:I-1,1:N)**H * (alpha * C(I,I:N))
+*
+         ALPHA = -(T( 1, I ))
+         DO J = 1, I-1
+            T( I, J ) = ZERO
+         END DO
+         P = MIN( I-1, L )
+         NP = MIN( N-L+1, N )
+         MP = MIN( P+1, M )
+         DO J = 1, N-L+P
+           B(I,J)=CONJG(B(I,J))
+         END DO
+*
+*        Triangular part of B2
+*
+         DO J = 1, P
+            T( I, J ) = (ALPHA*B( I, N-L+J ))
+         END DO
+         CALL ZTRMV( 'L', 'N', 'N', P, B( 1, NP ), LDB,
+     $               T( I, 1 ), LDT )
+*
+*        Rectangular part of B2
+*
+         CALL ZGEMV( 'N', I-1-P, L,  ALPHA, B( MP, NP ), LDB, 
+     $               B( I, NP ), LDB, ZERO, T( I,MP ), LDT )
+*
+*        B1
+
+*
+         CALL ZGEMV( 'N', I-1, N-L, ALPHA, B, LDB, B( I, 1 ), LDB, 
+     $               ONE, T( I, 1 ), LDT )   
+*
+   
+*
+*        T(1:I-1,I) := T(1:I-1,1:I-1) * T(I,1:I-1)
+*
+         DO J = 1, I-1
+            T(I,J)=CONJG(T(I,J))
+         END DO
+         CALL ZTRMV( 'L', 'C', 'N', I-1, T, LDT, T( I, 1 ), LDT )
+         DO J = 1, I-1
+            T(I,J)=CONJG(T(I,J))
+         END DO
+         DO J = 1, N-L+P
+            B(I,J)=CONJG(B(I,J))
+         END DO   
+*
+*        T(I,I) = tau(I)
+*
+         T( I, I ) = T( 1, I )
+         T( 1, I ) = ZERO
+      END DO
+      DO I=1,M
+         DO J= I+1,M
+            T(I,J)=(T(J,I))
+            T(J,I)=ZERO
+         END DO
+      END DO
+   
+*
+*     End of ZTPLQT2
+*
+      END
diff --git a/SRC/ztpmlqt.f b/SRC/ztpmlqt.f
new file mode 100644
index 00000000..ebdefee5
--- /dev/null
+++ b/SRC/ztpmlqt.f
@@ -0,0 +1,366 @@
+*> \brief \b ZTPMLQT
+*
+*  =========== DOCUMENTATION ===========
+*
+* Online html documentation available at 
+*            http://www.netlib.org/lapack/explore-html/ 
+*
+*> \htmlonly
+*> Download DTPMQRT + dependencies 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztpmlqt.f"> 
+*> [TGZ]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztpmlqt.f"> 
+*> [ZIP]</a> 
+*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztpmlqt.f"> 
+*> [TXT]</a>
+*> \endhtmlonly 
+*
+*  Definition:
+*  ===========
+*
+*       SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+*                           A, LDA, B, LDB, WORK, INFO )
+* 
+*       .. Scalar Arguments ..
+*       CHARACTER SIDE, TRANS
+*       INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*       ..
+*       .. Array Arguments ..
+*       COMPLEX*16         V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+*      $                   T( LDT, * ), WORK( * )
+*       ..
+*  
+*
+*> \par Purpose:
+*  =============
+*>
+*> \verbatim
+*>
+*> ZTPMQRT applies a complex orthogonal matrix Q obtained from a 
+*> "triangular-pentagonal" real block reflector H to a general
+*> real matrix C, which consists of two blocks A and B.
+*> \endverbatim
+*
+*  Arguments:
+*  ==========
+*
+*> \param[in] SIDE
+*> \verbatim
+*>          SIDE is CHARACTER*1
+*>          = 'L': apply Q or Q**C from the Left;
+*>          = 'R': apply Q or Q**C from the Right.
+*> \endverbatim
+*>
+*> \param[in] TRANS
+*> \verbatim
+*>          TRANS is CHARACTER*1
+*>          = 'N':  No transpose, apply Q;
+*>          = 'C':  Transpose, apply Q**C.
+*> \endverbatim
+*>
+*> \param[in] M
+*> \verbatim
+*>          M is INTEGER
+*>          The number of rows of the matrix B. M >= 0.
+*> \endverbatim
+*>
+*> \param[in] N
+*> \verbatim
+*>          N is INTEGER
+*>          The number of columns of the matrix B. N >= 0.
+*> \endverbatim
+*> 
+*> \param[in] K
+*> \verbatim
+*>          K is INTEGER
+*>          The number of elementary reflectors whose product defines
+*>          the matrix Q.
+*> \endverbatim
+*>
+*> \param[in] L
+*> \verbatim
+*>          L is INTEGER
+*>          The order of the trapezoidal part of V.  
+*>          K >= L >= 0.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] MB
+*> \verbatim
+*>          MB is INTEGER
+*>          The block size used for the storage of T.  K >= MB >= 1.
+*>          This must be the same value of MB used to generate T
+*>          in DTPLQT.
+*> \endverbatim
+*>
+*> \param[in] V
+*> \verbatim
+*>          V is COMPLEX*16 array, dimension (LDA,K)
+*>          The i-th row must contain the vector which defines the
+*>          elementary reflector H(i), for i = 1,2,...,k, as returned by
+*>          DTPLQT in B.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDV
+*> \verbatim
+*>          LDV is INTEGER
+*>          The leading dimension of the array V.
+*>          If SIDE = 'L', LDV >= max(1,M);
+*>          if SIDE = 'R', LDV >= max(1,N).
+*> \endverbatim
+*>
+*> \param[in] T
+*> \verbatim
+*>          T is COMPLEX*16 array, dimension (LDT,K)
+*>          The upper triangular factors of the block reflectors
+*>          as returned by DTPLQT, stored as a MB-by-K matrix.
+*> \endverbatim
+*>
+*> \param[in] LDT
+*> \verbatim
+*>          LDT is INTEGER
+*>          The leading dimension of the array T.  LDT >= MB.
+*> \endverbatim
+*>
+*> \param[in,out] A
+*> \verbatim
+*>          A is COMPLEX*16 array, dimension
+*>          (LDA,N) if SIDE = 'L' or 
+*>          (LDA,K) if SIDE = 'R'
+*>          On entry, the K-by-N or M-by-K matrix A.
+*>          On exit, A is overwritten by the corresponding block of 
+*>          Q*C or Q**C*C or C*Q or C*Q**C.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDA
+*> \verbatim
+*>          LDA is INTEGER
+*>          The leading dimension of the array A. 
+*>          If SIDE = 'L', LDC >= max(1,K);
+*>          If SIDE = 'R', LDC >= max(1,M). 
+*> \endverbatim
+*>
+*> \param[in,out] B
+*> \verbatim
+*>          B is COMPLEX*16 array, dimension (LDB,N)
+*>          On entry, the M-by-N matrix B.
+*>          On exit, B is overwritten by the corresponding block of
+*>          Q*C or Q**C*C or C*Q or C*Q**C.  See Further Details.
+*> \endverbatim
+*>
+*> \param[in] LDB
+*> \verbatim
+*>          LDB is INTEGER
+*>          The leading dimension of the array B. 
+*>          LDB >= max(1,M).
+*> \endverbatim
+*>
+*> \param[out] WORK
+*> \verbatim
+*>          WORK is COMPLEX*16 array. The dimension of WORK is
+*>           N*MB if SIDE = 'L', or  M*MB 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 2015
+*
+*> \ingroup doubleOTHERcomputational
+*
+*> \par Further Details:
+*  =====================
+*>
+*> \verbatim
+*>
+*>  The columns of the pentagonal matrix V contain the elementary reflectors
+*>  H(1), H(2), ..., H(K); V is composed of a rectangular block V1 and a 
+*>  trapezoidal block V2:
+*>
+*>        V = [V1] [V2].
+*>            
+*>
+*>  The size of the trapezoidal block V2 is determined by the parameter L, 
+*>  where 0 <= L <= K; V2 is lower trapezoidal, consisting of the first L
+*>  rows of a K-by-K upper triangular matrix.  If L=K, V2 is lower triangular;
+*>  if L=0, there is no trapezoidal block, hence V = V1 is rectangular.
+*>
+*>  If SIDE = 'L':  C = [A]  where A is K-by-N,  B is M-by-N and V is K-by-M. 
+*>                      [B]   
+*>  
+*>  If SIDE = 'R':  C = [A B]  where A is M-by-K, B is M-by-N and V is K-by-N.
+*>
+*>  The real orthogonal matrix Q is formed from V and T.
+*>
+*>  If TRANS='N' and SIDE='L', C is on exit replaced with Q * C.
+*>
+*>  If TRANS='C' and SIDE='L', C is on exit replaced with Q**C * C.
+*>
+*>  If TRANS='N' and SIDE='R', C is on exit replaced with C * Q.
+*>
+*>  If TRANS='C' and SIDE='R', C is on exit replaced with C * Q**C.
+*> \endverbatim
+*>
+*  =====================================================================
+      SUBROUTINE ZTPMLQT( SIDE, TRANS, M, N, K, L, MB, V, LDV, T, LDT,
+     $                    A, LDA, B, LDB, WORK, INFO )
+*
+*  -- LAPACK computational routine (version 3.6.0) --
+*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
+*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
+*     November 2015
+*
+*     .. Scalar Arguments ..
+      CHARACTER SIDE, TRANS
+      INTEGER   INFO, K, LDV, LDA, LDB, M, N, L, MB, LDT
+*     ..
+*     .. Array Arguments ..
+      COMPLEX*16         V( LDV, * ), A( LDA, * ), B( LDB, * ), 
+     $                   T( LDT, * ), WORK( * )
+*     ..
+*
+*  =====================================================================
+*
+*     ..
+*     .. Local Scalars ..
+      LOGICAL            LEFT, RIGHT, TRAN, NOTRAN
+      INTEGER            I, IB, NB, LB, KF, LDAQ
+*     ..
+*     .. External Functions ..
+      LOGICAL            LSAME
+      EXTERNAL           LSAME
+*     ..
+*     .. External Subroutines ..
+      EXTERNAL           XERBLA, ZTPRFB
+*     ..
+*     .. Intrinsic Functions ..
+      INTRINSIC          MAX, MIN
+*     ..
+*     .. Executable Statements ..
+*
+*     .. Test the input arguments ..
+*
+      INFO   = 0
+      LEFT   = LSAME( SIDE,  'L' )
+      RIGHT  = LSAME( SIDE,  'R' )
+      TRAN   = LSAME( TRANS, 'C' )
+      NOTRAN = LSAME( TRANS, 'N' )
+*      
+      IF ( LEFT ) THEN
+         LDAQ = MAX( 1, K )
+      ELSE IF ( RIGHT ) THEN
+         LDAQ = MAX( 1, M )
+      END IF
+      IF( .NOT.LEFT .AND. .NOT.RIGHT ) THEN
+         INFO = -1
+      ELSE IF( .NOT.TRAN .AND. .NOT.NOTRAN ) THEN
+         INFO = -2
+      ELSE IF( M.LT.0 ) THEN
+         INFO = -3
+      ELSE IF( N.LT.0 ) THEN
+         INFO = -4
+      ELSE IF( K.LT.0 ) THEN
+         INFO = -5
+      ELSE IF( L.LT.0 .OR. L.GT.K ) THEN
+         INFO = -6         
+      ELSE IF( MB.LT.1 .OR. (MB.GT.K .AND. K.GT.0) ) THEN
+         INFO = -7
+      ELSE IF( LDV.LT.K ) THEN
+         INFO = -9
+      ELSE IF( LDT.LT.MB ) THEN
+         INFO = -11
+      ELSE IF( LDA.LT.LDAQ ) THEN
+         INFO = -13
+      ELSE IF( LDB.LT.MAX( 1, M ) ) THEN
+         INFO = -15
+      END IF
+*
+      IF( INFO.NE.0 ) THEN
+         CALL XERBLA( 'ZTPMLQT', -INFO )
+         RETURN
+      END IF
+*
+*     .. Quick return if possible ..
+*
+      IF( M.EQ.0 .OR. N.EQ.0 .OR. K.EQ.0 ) RETURN
+*
+      IF( LEFT .AND. NOTRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF
+            CALL ZTPRFB( 'L', 'C', 'F', 'R', NB, N, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*         
+      ELSE IF( RIGHT .AND. TRAN ) THEN
+*
+         DO I = 1, K, MB
+            IB = MIN( MB, K-I+1 )
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL ZTPRFB( 'R', 'N', 'F', 'R', M, NB, IB, LB, 
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      ELSE IF( LEFT .AND. TRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )  
+            NB = MIN( M-L+I+IB-1, M )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = 0
+            END IF                   
+            CALL ZTPRFB( 'L', 'N', 'F', 'R', NB, N, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( I, 1 ), LDA, B, LDB, WORK, IB )
+         END DO
+*
+      ELSE IF( RIGHT .AND. NOTRAN ) THEN
+*
+         KF = ((K-1)/MB)*MB+1
+         DO I = KF, 1, -MB
+            IB = MIN( MB, K-I+1 )         
+            NB = MIN( N-L+I+IB-1, N )
+            IF( I.GE.L ) THEN
+               LB = 0
+            ELSE
+               LB = NB-N+L-I+1
+            END IF
+            CALL ZTPRFB( 'R', 'C', 'F', 'R', M, NB, IB, LB,
+     $                   V( I, 1 ), LDV, T( 1, I ), LDT, 
+     $                   A( 1, I ), LDA, B, LDB, WORK, M )
+         END DO
+*
+      END IF
+*
+      RETURN
+*
+*     End of ZTPMLQT
+*
+      END