DO NOT MERGE: demonstrating changes work

jprhyne · jprhyne · commit 212270836bd5 · 2024-10-14T11:16:34.000-06:00
diff --git a/SRC/Makefile b/SRC/Makefile
@@ -340,6 +340,7 @@ DLASRC = \
    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 dlarf1f.o dlarf1l.o\
+   my_dlarft_rec.o \
    dlargv.o dlarmm.o dlarrv.o dlartv.o \
    dlarz.o  dlarzb.o dlarzt.o dlaswp.o dlasy2.o \
    dlasyf.o dlasyf_rook.o dlasyf_rk.o \
diff --git a/SRC/dgelqf.f b/SRC/dgelqf.f
@@ -161,7 +161,7 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
      $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGELQ2, DLARFB, DLARFT, XERBLA
+      EXTERNAL           DGELQ2, DLARFB, MY_DLARFT_REC, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -251,8 +251,8 @@ SUBROUTINE DGELQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
 *
-               CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I,
-     $                      I ),
+               CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB,
+     $                      A( I, I ),
      $                      LDA, TAU( I ), WORK, LDWORK )
 *
 *              Apply H to A(i+ib:m,i:n) from the right
diff --git a/SRC/dgeqlf.f b/SRC/dgeqlf.f
@@ -156,7 +156,7 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
      $                   MU, NB, NBMIN, NU, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEQL2, DLARFB, DLARFT, XERBLA
+      EXTERNAL           DGEQL2, DLARFB, MY_DLARFT_REC, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -256,8 +256,9 @@ SUBROUTINE DGEQLF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i+ib-1) . . . H(i+1) H(i)
 *
-               CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
-     $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
+               CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1,
+     $                      IB, A( 1, N-K+I ), LDA, TAU( I ), WORK,
+     $                      LDWORK )
 *
 *              Apply H**T to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
 *
diff --git a/SRC/dgeqrf.f b/SRC/dgeqrf.f
@@ -163,7 +163,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
      $                   NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEQR2, DLARFB, DLARFT, XERBLA
+      EXTERNAL           DGEQR2, DLARFB, MY_DLARFT_REC, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -253,7 +253,7 @@ SUBROUTINE DGEQRF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
 *
-               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+               CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB,
      $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
 *
 *              Apply H**T to A(i:m,i+ib:n) from the left
diff --git a/SRC/dgeqrfp.f b/SRC/dgeqrfp.f
@@ -167,7 +167,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
      $                   NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGEQR2P, DLARFB, DLARFT, XERBLA
+      EXTERNAL           DGEQR2P, DLARFB, MY_DLARFT_REC, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -259,7 +259,7 @@ SUBROUTINE DGEQRFP( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
 *
-               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+               CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB,
      $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
 *
 *              Apply H**T to A(i:m,i+ib:n) from the left
diff --git a/SRC/dgerqf.f b/SRC/dgerqf.f
@@ -156,7 +156,7 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
      $                   MU, NB, NBMIN, NU, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DGERQ2, DLARFB, DLARFT, XERBLA
+      EXTERNAL           DGERQ2, DLARFB, MY_DLARFT_REC, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -256,8 +256,9 @@ SUBROUTINE DGERQF( M, N, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i+ib-1) . . . H(i+1) H(i)
 *
-               CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
-     $                      A( M-K+I, 1 ), LDA, TAU( I ), WORK, LDWORK )
+               CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1,
+     $                      IB, A( M-K+I, 1 ), LDA, TAU( I ), WORK,
+     $                      LDWORK )
 *
 *              Apply H to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
 *
diff --git a/SRC/dlarft.f b/SRC/dlarft.f
@@ -196,6 +196,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
       IF( N.EQ.0 )
      $   RETURN
 *
+      WRITE(*,*) "in dlarft, n = ", N, " k = ", K, "flags: ", DIRECT,
+     $   " ", STOREV
       IF( LSAME( DIRECT, 'F' ) ) THEN
          PREVLASTV = N
          DO I = 1, K
diff --git a/SRC/dorglq.f b/SRC/dorglq.f
@@ -148,7 +148,7 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
      $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORGL2, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORGL2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -253,8 +253,8 @@ SUBROUTINE DORGLQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
 *
-               CALL DLARFT( 'Forward', 'Rowwise', N-I+1, IB, A( I,
-     $                      I ),
+               CALL MY_DLARFT_REC( 'Forward', 'Rowwise', N-I+1, IB,
+     $                      A( I, I ),
      $                      LDA, TAU( I ), WORK, LDWORK )
 *
 *              Apply H**T to A(i+ib:m,i:n) from the right
diff --git a/SRC/dorgql.f b/SRC/dorgql.f
@@ -149,7 +149,7 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
      $                   NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORG2L, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORG2L, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -260,8 +260,9 @@ SUBROUTINE DORGQL( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i+ib-1) . . . H(i+1) H(i)
 *
-               CALL DLARFT( 'Backward', 'Columnwise', M-K+I+IB-1, IB,
-     $                      A( 1, N-K+I ), LDA, TAU( I ), WORK, LDWORK )
+               CALL MY_DLARFT_REC( 'Backward', 'Columnwise', M-K+I+IB-1,
+     $                      IB, A( 1, N-K+I ), LDA, TAU( I ), WORK, 
+     $                      LDWORK )
 *
 *              Apply H to A(1:m-k+i+ib-1,1:n-k+i-1) from the left
 *
diff --git a/SRC/dorgqr.f b/SRC/dorgqr.f
@@ -149,7 +149,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
      $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORG2R, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORG2R, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -254,7 +254,7 @@ SUBROUTINE DORGQR( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i) H(i+1) . . . H(i+ib-1)
 *
-               CALL DLARFT( 'Forward', 'Columnwise', M-I+1, IB,
+               CALL MY_DLARFT_REC( 'Forward', 'Columnwise', M-I+1, IB,
      $                      A( I, I ), LDA, TAU( I ), WORK, LDWORK )
 *
 *              Apply H to A(i:m,i+ib:n) from the left
diff --git a/SRC/dorgrq.f b/SRC/dorgrq.f
@@ -149,7 +149,7 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
      $                   LWKOPT, NB, NBMIN, NX
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORGR2, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORGR2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -261,8 +261,9 @@ SUBROUTINE DORGRQ( M, N, K, A, LDA, TAU, WORK, LWORK, INFO )
 *              Form the triangular factor of the block reflector
 *              H = H(i+ib-1) . . . H(i+1) H(i)
 *
-               CALL DLARFT( 'Backward', 'Rowwise', N-K+I+IB-1, IB,
-     $                      A( II, 1 ), LDA, TAU( I ), WORK, LDWORK )
+               CALL MY_DLARFT_REC( 'Backward', 'Rowwise', N-K+I+IB-1,
+     $                      IB, A( II, 1 ), LDA, TAU( I ), WORK,
+     $                      LDWORK)
 *
 *              Apply H**T to A(1:m-k+i-1,1:n-k+i+ib-1) from the right
 *
diff --git a/SRC/dormlq.f b/SRC/dormlq.f
@@ -196,7 +196,7 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORML2, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORML2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -316,8 +316,8 @@ SUBROUTINE DORMLQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
 *           Form the triangular factor of the block reflector
 *           H = H(i) H(i+1) . . . H(i+ib-1)
 *
-            CALL DLARFT( 'Forward', 'Rowwise', NQ-I+1, IB, A( I, I ),
-     $                   LDA, TAU( I ), WORK( IWT ), LDT )
+            CALL MY_DLARFT_REC( 'Forward', 'Rowwise', NQ-I+1, IB,
+     $                   A( I, I ), LDA, TAU( I ), WORK( IWT ), LDT )
             IF( LEFT ) THEN
 *
 *              H or H**T is applied to C(i:m,1:n)
diff --git a/SRC/dormql.f b/SRC/dormql.f
@@ -195,7 +195,7 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORM2L, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORM2L, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -310,8 +310,8 @@ SUBROUTINE DORMQL( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
 *           Form the triangular factor of the block reflector
 *           H = H(i+ib-1) . . . H(i+1) H(i)
 *
-            CALL DLARFT( 'Backward', 'Columnwise', NQ-K+I+IB-1, IB,
-     $                   A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT )
+            CALL MY_DLARFT_REC( 'Backward', 'Columnwise', NQ-K+I+IB-1,
+     $                   IB, A( 1, I ), LDA, TAU( I ), WORK( IWT ), LDT)
             IF( LEFT ) THEN
 *
 *              H or H**T is applied to C(1:m-k+i+ib-1,1:n)
diff --git a/SRC/dormqr.f b/SRC/dormqr.f
@@ -195,7 +195,7 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORM2R, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORM2R, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -309,8 +309,8 @@ SUBROUTINE DORMQR( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
 *           Form the triangular factor of the block reflector
 *           H = H(i) H(i+1) . . . H(i+ib-1)
 *
-            CALL DLARFT( 'Forward', 'Columnwise', NQ-I+1, IB, A( I,
-     $                   I ),
+            CALL MY_DLARFT_REC( 'Forward', 'Columnwise', NQ-I+1, IB,
+     $                   A(I, I ),
      $                   LDA, TAU( I ), WORK( IWT ), LDT )
             IF( LEFT ) THEN
 *
diff --git a/SRC/dormrq.f b/SRC/dormrq.f
@@ -196,7 +196,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
       EXTERNAL           LSAME, ILAENV
 *     ..
 *     .. External Subroutines ..
-      EXTERNAL           DLARFB, DLARFT, DORMR2, XERBLA
+      EXTERNAL           DLARFB, MY_DLARFT_REC, DORMR2, XERBLA
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN
@@ -317,7 +317,7 @@ SUBROUTINE DORMRQ( SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC,
 *           Form the triangular factor of the block reflector
 *           H = H(i+ib-1) . . . H(i+1) H(i)
 *
-            CALL DLARFT( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
+            CALL MY_DLARFT_REC( 'Backward', 'Rowwise', NQ-K+I+IB-1, IB,
      $                   A( I, 1 ), LDA, TAU( I ), WORK( IWT ), LDT )
             IF( LEFT ) THEN
 *
diff --git a/SRC/my_dlarft_rec.f b/SRC/my_dlarft_rec.f
diff --git a/st7lLjwJ b/st7lLjwJ

Original file line number	Diff line number	Diff line change
`@@ -196,6 +196,8 @@ SUBROUTINE DLARFT( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )`
`196`	`196`	`IF( N.EQ.0 )`
`197`	`197`	`$ RETURN`
`198`	`198`	`*`
	`199`	`+ WRITE(,) "in dlarft, n = ", N, " k = ", K, "flags: ", DIRECT,`
	`200`	`+ $ " ", STOREV`
`199`	`201`	`IF( LSAME( DIRECT, 'F' ) ) THEN`
`200`	`202`	`PREVLASTV = N`
`201`	`203`	`DO I = 1, K`