Merge pull request #5721 from martin-frbg/lapack1020

Implement ?LARF1F and ?ORM2R (Reference-LAPACK PRs 1019/1020/1196)

Author: martin-frbg

cmake/lapack.cmake

@@ -71,7 +71,7 @@ set(SLASRC
    slaqr0.f slaqr1.f slaqr2.f slaqr3.f slaqr4.f slaqr5.f
    slaqtr.f slar1v.f slar2v.f ilaslr.f ilaslc.f
    slarf.f  slarfb.f slarfb_gett.f slarfg.f slarfgp.f slarft.f slarfx.f slarfy.f slargv.f
-   slarrv.f slartv.f
+   slarf1f.f slarf1l.f slarrv.f slartv.f
    slarz.f  slarzb.f slarzt.f slasy2.f
    slasyf.f slasyf_rook.f slasyf_rk.f slasyf_aa.f
    slatbs.f slatdf.f slatps.f slatrd.f slatrs.f slatrz.f
@@ -178,6 +178,7 @@ set(CLASRC
    claqz0.f claqz1.f claqz2.f claqz3.f
    claqsp.f claqsy.f clar1v.f clar2v.f ilaclr.f ilaclc.f
    clarf.f  clarfb.f clarfb_gett.f clarfg.f clarfgp.f clarft.f
+   clarf1f.f clarf1l.f
    clarfx.f clarfy.f clargv.f clarnv.f clarrv.f clartg.f90 clartv.f
    clarz.f  clarzb.f clarzt.f clascl.f claset.f clasr.f  classq.f90
    clasyf.f clasyf_rook.f clasyf_rk.f clasyf_aa.f
@@ -262,7 +263,7 @@ set(DLASRC
    dlaqr0.f dlaqr1.f dlaqr2.f dlaqr3.f dlaqr4.f dlaqr5.f
    dlaqtr.f dlar1v.f dlar2v.f iladlr.f iladlc.f
    dlarf.f  dlarfb.f dlarfb_gett.f dlarfg.f dlarfgp.f dlarft.f dlarfx.f dlarfy.f
-   dlargv.f dlarrv.f dlartv.f
+   dlarf1f.f dlarf1l.f dlargv.f dlarrv.f dlartv.f
    dlarz.f  dlarzb.f dlarzt.f dlasy2.f
    dlasyf.f dlasyf_rook.f dlasyf_rk.f dlasyf_aa.f
    dlatbs.f dlatdf.f dlatps.f dlatrd.f dlatrs.f dlatrz.f
@@ -371,7 +372,7 @@ set(ZLASRC
    zlaqr0.f zlaqr1.f zlaqr2.f zlaqr3.f zlaqr4.f zlaqr5.f
    zlaqsp.f zlaqsy.f zlar1v.f zlar2v.f ilazlr.f ilazlc.f
    zlarcm.f zlarf.f  zlarfb.f zlarfb_gett.f
-   zlarfg.f zlarfgp.f zlarft.f
+   zlarfg.f zlarfgp.f zlarft.f zlarf1f.f zlarf1l.f
    zlarfx.f zlarfy.f zlargv.f zlarnv.f zlarrv.f zlartg.f90 zlartv.f
    zlarz.f  zlarzb.f zlarzt.f zlascl.f zlaset.f zlasr.f
    zlassq.f90 zlasyf.f zlasyf_rook.f zlasyf_rk.f zlasyf_aa.f
@@ -575,7 +576,7 @@ set(SLASRC
    slaqr0.c slaqr1.c slaqr2.c slaqr3.c slaqr4.c slaqr5.c
    slaqtr.c slar1v.c slar2v.c ilaslr.c ilaslc.c
    slarf.c  slarfb.c slarfb_gett.c slarfg.c slarfgp.c slarft.c slarfx.c slarfy.c slargv.c
-   slarrv.c slartv.c
+   slarf1f.c slarf1l.c slarrv.c slartv.c
    slarz.c  slarzb.c slarzt.c slasy2.c
    slasyf.c slasyf_rook.c slasyf_rk.c slasyf_aa.c
    slatbs.c slatdf.c slatps.c slatrd.c slatrs.c slatrz.c
@@ -681,6 +682,7 @@ set(CLASRC
    claqr0.c claqr1.c claqr2.c claqr3.c claqr4.c claqr5.c
    claqsp.c claqsy.c clar1v.c clar2v.c ilaclr.c ilaclc.c
    clarf.c  clarfb.c clarfb_gett.c clarfg.c clarfgp.c clarft.c
+   clarf1f.c clarf1l.c
    clarfx.c clarfy.c clargv.c clarnv.c clarrv.c clartg.c clartv.c
    clarz.c  clarzb.c clarzt.c clascl.c claset.c clasr.c  classq.c
    clasyf.c clasyf_rook.c clasyf_rk.c clasyf_aa.c
@@ -764,7 +766,7 @@ set(DLASRC
    dlaqr0.c dlaqr1.c dlaqr2.c dlaqr3.c dlaqr4.c dlaqr5.c
    dlaqtr.c dlar1v.c dlar2v.c iladlr.c iladlc.c
    dlarf.c  dlarfb.c dlarfb_gett.c dlarfg.c dlarfgp.c dlarft.c dlarfx.c dlarfy.c
-   dlargv.c dlarrv.c dlartv.c
+   dlarf1f.c dlarf1l.c dlargv.c dlarrv.c dlartv.c
    dlarz.c  dlarzb.c dlarzt.c dlasy2.c
    dlasyf.c dlasyf_rook.c dlasyf_rk.c dlasyf_aa.c
    dlatbs.c dlatdf.c dlatps.c dlatrd.c dlatrs.c dlatrz.c
@@ -871,7 +873,7 @@ set(ZLASRC
    zlaqhb.c zlaqhe.c zlaqhp.c zlaqp2.c zlaqp2rk.c zlaqp3rk.c zlaqps.c zlaqsb.c
    zlaqr0.c zlaqr1.c zlaqr2.c zlaqr3.c zlaqr4.c zlaqr5.c
    zlaqsp.c zlaqsy.c zlar1v.c zlar2v.c ilazlr.c ilazlc.c
-   zlarcm.c zlarf.c  zlarfb.c zlarfb_gett.c
+   zlarcm.c zlarf.c  zlarfb.c zlarfb_gett.c zlarf1f.c zlarf1l.c
    zlarfg.c zlarfgp.c zlarft.c
    zlarfx.c zlarfy.c zlargv.c zlarnv.c zlarrv.c zlartg.c zlartv.c
    zlarz.c  zlarzb.c zlarzt.c zlascl.c zlaset.c zlasr.c

lapack-netlib/SRC/Makefile

@@ -155,7 +155,7 @@ SLASRC_O = \
    slaqr0.o slaqr1.o slaqr2.o slaqr3.o slaqr4.o slaqr5.o \
    slaqtr.o slar1v.o slar2v.o ilaslr.o ilaslc.o \
    slarf.o  slarfb.o slarfb_gett.o slarfg.o slarfgp.o slarft.o slarfx.o slarfy.o slargv.o \
-   slarrv.o slartv.o \
+   slarf1f.o slarf1l.o slarrv.o slartv.o \
    slarz.o  slarzb.o slarzt.o slaswp.o slasy2.o slasyf.o slasyf_rook.o \
    slasyf_rk.o \
    slatbs.o slatdf.o slatps.o slatrd.o slatrs.o slatrz.o \
@@ -271,6 +271,7 @@ CLASRC_O = \
    claqsp.o claqsy.o clar1v.o clar2v.o ilaclr.o ilaclc.o \
    claqz0.o claqz1.o claqz2.o claqz3.o \
    clarf.o  clarfb.o clarfb_gett.o clarfg.o clarft.o clarfgp.o \
+   clarf1f.o clarf1l.o \
    clarfx.o clarfy.o clargv.o clarnv.o clarrv.o clartg.o clartv.o \
    clarz.o  clarzb.o clarzt.o clascl.o claset.o clasr.o  classq.o \
    claswp.o clasyf.o clasyf_rook.o clasyf_rk.o clasyf_aa.o \
@@ -364,7 +365,7 @@ DLASRC_O = \
    dlaqr0.o dlaqr1.o dlaqr2.o dlaqr3.o dlaqr4.o dlaqr5.o \
    dlaqtr.o dlar1v.o dlar2v.o iladlr.o iladlc.o \
    dlarf.o  dlarfb.o dlarfb_gett.o dlarfg.o dlarfgp.o dlarft.o dlarfx.o dlarfy.o \
-   dlargv.o dlarrv.o dlartv.o \
+   dlarf1f.o dlarf1l.o dlargv.o dlarrv.o dlartv.o \
    dlarz.o  dlarzb.o dlarzt.o dlaswp.o dlasy2.o \
    dlasyf.o dlasyf_rook.o dlasyf_rk.o \
    dlatbs.o dlatdf.o dlatps.o dlatrd.o dlatrs.o dlatrz.o dlauu2.o \
@@ -478,7 +479,7 @@ ZLASRC_O = \
    zlaqsp.o zlaqsy.o zlar1v.o zlar2v.o ilazlr.o ilazlc.o \
    zlaqz0.o zlaqz1.o zlaqz2.o zlaqz3.o \
    zlarcm.o zlarf.o  zlarfb.o zlarfb_gett.o \
-   zlarfg.o zlarft.o zlarfgp.o \
+   zlarfg.o zlarft.o zlarfgp.o zlarf1f.o zlarf1l.o \
    zlarfx.o zlarfy.o zlargv.o zlarnv.o zlarrv.o zlartg.o zlartv.o \
    zlarz.o  zlarzb.o zlarzt.o zlascl.o zlaset.o zlasr.o \
    zlassq.o zlaswp.o zlasyf.o zlasyf_rook.o zlasyf_rk.o zlasyf_aa.o \

lapack-netlib/SRC/cgebd2.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGEBD2 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgebd2.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgebd2.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgebd2.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -132,7 +130,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup complexGEcomputational
+*> \ingroup gebd2
 * @precisions normal c -> s d z
 *
 *> \par Further Details:
@@ -187,6 +185,7 @@
 *>
 *  =====================================================================
       SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -203,16 +202,15 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
 *  =====================================================================
 *
 *     .. Parameters ..
-      COMPLEX            ZERO, ONE
-      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
-     $                   ONE = ( 1.0E+0, 0.0E+0 ) )
+      COMPLEX            ZERO
+      PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ) )
 *     ..
 *     .. Local Scalars ..
       INTEGER            I
       COMPLEX            ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           CLACGV, CLARF, CLARFG, XERBLA
+      EXTERNAL           CLACGV, CLARF1F, CLARFG, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          CONJG, MAX, MIN
@@ -246,13 +244,13 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             CALL CLARFG( M-I+1, ALPHA, A( MIN( I+1, M ), I ), 1,
      $                   TAUQ( I ) )
             D( I ) = REAL( ALPHA )
-            A( I, I ) = ONE
 *
 *           Apply H(i)**H to A(i:m,i+1:n) from the left
 *
             IF( I.LT.N )
-     $         CALL CLARF( 'Left', M-I+1, N-I, A( I, I ), 1,
-     $                     CONJG( TAUQ( I ) ), A( I, I+1 ), LDA, WORK )
+     $         CALL CLARF1F( 'Left', M-I+1, N-I, A( I, I ), 1,
+     $                       CONJG( TAUQ( I ) ), A( I, I+1 ), LDA,
+     $                       WORK )
             A( I, I ) = D( I )
 *
             IF( I.LT.N ) THEN
@@ -265,12 +263,11 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                CALL CLARFG( N-I, ALPHA, A( I, MIN( I+2, N ) ),
      $                      LDA, TAUP( I ) )
                E( I ) = REAL( ALPHA )
-               A( I, I+1 ) = ONE
 *
 *              Apply G(i) to A(i+1:m,i+1:n) from the right
 *
-               CALL CLARF( 'Right', M-I, N-I, A( I, I+1 ), LDA,
-     $                     TAUP( I ), A( I+1, I+1 ), LDA, WORK )
+               CALL CLARF1F( 'Right', M-I, N-I, A( I, I+1 ), LDA,
+     $                       TAUP( I ), A( I+1, I+1 ), LDA, WORK )
                CALL CLACGV( N-I, A( I, I+1 ), LDA )
                A( I, I+1 ) = E( I )
             ELSE
@@ -290,13 +287,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
             CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
      $                   TAUP( I ) )
             D( I ) = REAL( ALPHA )
-            A( I, I ) = ONE
 *
 *           Apply G(i) to A(i+1:m,i:n) from the right
 *
             IF( I.LT.M )
-     $         CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA,
-     $                     TAUP( I ), A( I+1, I ), LDA, WORK )
+     $         CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
+     $                       TAUP( I ), A( I+1, I ), LDA, WORK )
             CALL CLACGV( N-I+1, A( I, I ), LDA )
             A( I, I ) = D( I )
 *
@@ -309,13 +305,12 @@ SUBROUTINE CGEBD2( M, N, A, LDA, D, E, TAUQ, TAUP, WORK, INFO )
                CALL CLARFG( M-I, ALPHA, A( MIN( I+2, M ), I ), 1,
      $                      TAUQ( I ) )
                E( I ) = REAL( ALPHA )
-               A( I+1, I ) = ONE
 *
 *              Apply H(i)**H to A(i+1:m,i+1:n) from the left
 *
-               CALL CLARF( 'Left', M-I, N-I, A( I+1, I ), 1,
-     $                     CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
-     $                     WORK )
+               CALL CLARF1F( 'Left', M-I, N-I, A( I+1, I ), 1,
+     $                       CONJG( TAUQ( I ) ), A( I+1, I+1 ), LDA,
+     $                       WORK )
                A( I+1, I ) = E( I )
             ELSE
                TAUQ( I ) = ZERO

lapack-netlib/SRC/cgehd2.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGEHD2 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgehd2.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgehd2.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgehd2.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -106,7 +104,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup complexGEcomputational
+*> \ingroup gehd2
 *
 *> \par Further Details:
 *  =====================
@@ -146,6 +144,7 @@
 *>
 *  =====================================================================
       SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -160,16 +159,11 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
 *
 *  =====================================================================
 *
-*     .. Parameters ..
-      COMPLEX            ONE
-      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
-*     ..
 *     .. Local Scalars ..
       INTEGER            I
-      COMPLEX            ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           CLARF, CLARFG, XERBLA
+      EXTERNAL           CLARF1F, CLARFG, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          CONJG, MAX, MIN
@@ -197,21 +191,19 @@ SUBROUTINE CGEHD2( N, ILO, IHI, A, LDA, TAU, WORK, INFO )
 *
 *        Compute elementary reflector H(i) to annihilate A(i+2:ihi,i)
 *
-         ALPHA = A( I+1, I )
-         CALL CLARFG( IHI-I, ALPHA, A( MIN( I+2, N ), I ), 1, TAU( I ) )
-         A( I+1, I ) = ONE
+         CALL CLARFG( IHI-I, A( I+1, I ), A( MIN( I+2, N ), I ), 1,
+     $                TAU( I ) )
 *
 *        Apply H(i) to A(1:ihi,i+1:ihi) from the right
 *
-         CALL CLARF( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
-     $               A( 1, I+1 ), LDA, WORK )
+         CALL CLARF1F( 'Right', IHI, IHI-I, A( I+1, I ), 1, TAU( I ),
+     $                 A( 1, I+1 ), LDA, WORK )
 *
 *        Apply H(i)**H to A(i+1:ihi,i+1:n) from the left
 *
-         CALL CLARF( 'Left', IHI-I, N-I, A( I+1, I ), 1,
-     $               CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
+         CALL CLARF1F( 'Left', IHI-I, N-I, A( I+1, I ), 1,
+     $                 CONJG( TAU( I ) ), A( I+1, I+1 ), LDA, WORK )
 *
-         A( I+1, I ) = ALPHA
    10 CONTINUE
 *
       RETURN

lapack-netlib/SRC/cgelq2.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CGELQ2 + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cgelq2.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cgelq2.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cgelq2.f">
 *> [TXT]</a>
-*> \endhtmlonly
 *
 *  Definition:
 *  ===========
@@ -104,7 +102,7 @@
 *> \author Univ. of Colorado Denver
 *> \author NAG Ltd.
 *
-*> \ingroup complexGEcomputational
+*> \ingroup gelq2
 *
 *> \par Further Details:
 *  =====================
@@ -126,6 +124,7 @@
 *>
 *  =====================================================================
       SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
+      IMPLICIT NONE
 *
 *  -- LAPACK computational routine --
 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
@@ -140,16 +139,11 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
 *
 *  =====================================================================
 *
-*     .. Parameters ..
-      COMPLEX            ONE
-      PARAMETER          ( ONE = ( 1.0E+0, 0.0E+0 ) )
-*     ..
 *     .. Local Scalars ..
       INTEGER            I, K
-      COMPLEX            ALPHA
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           CLACGV, CLARF, CLARFG, XERBLA
+      EXTERNAL           CLACGV, CLARF1F, CLARFG, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -178,18 +172,15 @@ SUBROUTINE CGELQ2( M, N, A, LDA, TAU, WORK, INFO )
 *        Generate elementary reflector H(i) to annihilate A(i,i+1:n)
 *
          CALL CLACGV( N-I+1, A( I, I ), LDA )
-         ALPHA = A( I, I )
-         CALL CLARFG( N-I+1, ALPHA, A( I, MIN( I+1, N ) ), LDA,
+         CALL CLARFG( N-I+1, A( I, I ), A( I, MIN( I+1, N ) ), LDA,
      $                TAU( I ) )
          IF( I.LT.M ) THEN
 *
 *           Apply H(i) to A(i+1:m,i:n) from the right
 *
-            A( I, I ) = ONE
-            CALL CLARF( 'Right', M-I, N-I+1, A( I, I ), LDA, TAU( I ),
-     $                  A( I+1, I ), LDA, WORK )
+            CALL CLARF1F( 'Right', M-I, N-I+1, A( I, I ), LDA,
+     $                    TAU( I ), A( I+1, I ), LDA, WORK )
          END IF
-         A( I, I ) = ALPHA
          CALL CLACGV( N-I+1, A( I, I ), LDA )
    10 CONTINUE
       RETURN