home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / lapack / dlarfb.f < prev    next >
Text File  |  1996-09-28  |  18KB  |  589 lines
  1.       SUBROUTINE DLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV,
  2.      $                   T, LDT, C, LDC, WORK, LDWORK )
  3. *
  4. *  -- LAPACK auxiliary routine (version 2.0) --
  5. *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  6. *     Courant Institute, Argonne National Lab, and Rice University
  7. *     February 29, 1992
  8. *
  9. *     .. Scalar Arguments ..
  10.       CHARACTER          DIRECT, SIDE, STOREV, TRANS
  11.       INTEGER            K, LDC, LDT, LDV, LDWORK, M, N
  12. *     ..
  13. *     .. Array Arguments ..
  14.       DOUBLE PRECISION   C( LDC, * ), T( LDT, * ), V( LDV, * ),
  15.      $                   WORK( LDWORK, * )
  16. *     ..
  17. *
  18. *  Purpose
  19. *  =======
  20. *
  21. *  DLARFB applies a real block reflector H or its transpose H' to a
  22. *  real m by n matrix C, from either the left or the right.
  23. *
  24. *  Arguments
  25. *  =========
  26. *
  27. *  SIDE    (input) CHARACTER*1
  28. *          = 'L': apply H or H' from the Left
  29. *          = 'R': apply H or H' from the Right
  30. *
  31. *  TRANS   (input) CHARACTER*1
  32. *          = 'N': apply H (No transpose)
  33. *          = 'T': apply H' (Transpose)
  34. *
  35. *  DIRECT  (input) CHARACTER*1
  36. *          Indicates how H is formed from a product of elementary
  37. *          reflectors
  38. *          = 'F': H = H(1) H(2) . . . H(k) (Forward)
  39. *          = 'B': H = H(k) . . . H(2) H(1) (Backward)
  40. *
  41. *  STOREV  (input) CHARACTER*1
  42. *          Indicates how the vectors which define the elementary
  43. *          reflectors are stored:
  44. *          = 'C': Columnwise
  45. *          = 'R': Rowwise
  46. *
  47. *  M       (input) INTEGER
  48. *          The number of rows of the matrix C.
  49. *
  50. *  N       (input) INTEGER
  51. *          The number of columns of the matrix C.
  52. *
  53. *  K       (input) INTEGER
  54. *          The order of the matrix T (= the number of elementary
  55. *          reflectors whose product defines the block reflector).
  56. *
  57. *  V       (input) DOUBLE PRECISION array, dimension
  58. *                                (LDV,K) if STOREV = 'C'
  59. *                                (LDV,M) if STOREV = 'R' and SIDE = 'L'
  60. *                                (LDV,N) if STOREV = 'R' and SIDE = 'R'
  61. *          The matrix V. See further details.
  62. *
  63. *  LDV     (input) INTEGER
  64. *          The leading dimension of the array V.
  65. *          If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M);
  66. *          if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N);
  67. *          if STOREV = 'R', LDV >= K.
  68. *
  69. *  T       (input) DOUBLE PRECISION array, dimension (LDT,K)
  70. *          The triangular k by k matrix T in the representation of the
  71. *          block reflector.
  72. *
  73. *  LDT     (input) INTEGER
  74. *          The leading dimension of the array T. LDT >= K.
  75. *
  76. *  C       (input/output) DOUBLE PRECISION array, dimension (LDC,N)
  77. *          On entry, the m by n matrix C.
  78. *          On exit, C is overwritten by H*C or H'*C or C*H or C*H'.
  79. *
  80. *  LDC     (input) INTEGER
  81. *          The leading dimension of the array C. LDA >= max(1,M).
  82. *
  83. *  WORK    (workspace) DOUBLE PRECISION array, dimension (LDWORK,K)
  84. *
  85. *  LDWORK  (input) INTEGER
  86. *          The leading dimension of the array WORK.
  87. *          If SIDE = 'L', LDWORK >= max(1,N);
  88. *          if SIDE = 'R', LDWORK >= max(1,M).
  89. *
  90. *  =====================================================================
  91. *
  92. *     .. Parameters ..
  93.       DOUBLE PRECISION   ONE
  94.       PARAMETER          ( ONE = 1.0D+0 )
  95. *     ..
  96. *     .. Local Scalars ..
  97.       CHARACTER          TRANST
  98.       INTEGER            I, J
  99. *     ..
  100. *     .. External Functions ..
  101.       LOGICAL            LSAME
  102.       EXTERNAL           LSAME
  103. *     ..
  104. *     .. External Subroutines ..
  105.       EXTERNAL           DCOPY, DGEMM, DTRMM
  106. *     ..
  107. *     .. Executable Statements ..
  108. *
  109. *     Quick return if possible
  110. *
  111.       IF( M.LE.0 .OR. N.LE.0 )
  112.      $   RETURN
  113. *
  114.       IF( LSAME( TRANS, 'N' ) ) THEN
  115.          TRANST = 'T'
  116.       ELSE
  117.          TRANST = 'N'
  118.       END IF
  119. *
  120.       IF( LSAME( STOREV, 'C' ) ) THEN
  121. *
  122.          IF( LSAME( DIRECT, 'F' ) ) THEN
  123. *
  124. *           Let  V =  ( V1 )    (first K rows)
  125. *                     ( V2 )
  126. *           where  V1  is unit lower triangular.
  127. *
  128.             IF( LSAME( SIDE, 'L' ) ) THEN
  129. *
  130. *              Form  H * C  or  H' * C  where  C = ( C1 )
  131. *                                                  ( C2 )
  132. *
  133. *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
  134. *
  135. *              W := C1'
  136. *
  137.                DO 10 J = 1, K
  138.                   CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
  139.    10          CONTINUE
  140. *
  141. *              W := W * V1
  142. *
  143.                CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
  144.      $                     K, ONE, V, LDV, WORK, LDWORK )
  145.                IF( M.GT.K ) THEN
  146. *
  147. *                 W := W + C2'*V2
  148. *
  149.                   CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
  150.      $                        ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV,
  151.      $                        ONE, WORK, LDWORK )
  152.                END IF
  153. *
  154. *              W := W * T'  or  W * T
  155. *
  156.                CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
  157.      $                     ONE, T, LDT, WORK, LDWORK )
  158. *
  159. *              C := C - V * W'
  160. *
  161.                IF( M.GT.K ) THEN
  162. *
  163. *                 C2 := C2 - V2 * W'
  164. *
  165.                   CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
  166.      $                        -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE,
  167.      $                        C( K+1, 1 ), LDC )
  168.                END IF
  169. *
  170. *              W := W * V1'
  171. *
  172.                CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
  173.      $                     ONE, V, LDV, WORK, LDWORK )
  174. *
  175. *              C1 := C1 - W'
  176. *
  177.                DO 30 J = 1, K
  178.                   DO 20 I = 1, N
  179.                      C( J, I ) = C( J, I ) - WORK( I, J )
  180.    20             CONTINUE
  181.    30          CONTINUE
  182. *
  183.             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  184. *
  185. *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
  186. *
  187. *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
  188. *
  189. *              W := C1
  190. *
  191.                DO 40 J = 1, K
  192.                   CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
  193.    40          CONTINUE
  194. *
  195. *              W := W * V1
  196. *
  197.                CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
  198.      $                     K, ONE, V, LDV, WORK, LDWORK )
  199.                IF( N.GT.K ) THEN
  200. *
  201. *                 W := W + C2 * V2
  202. *
  203.                   CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
  204.      $                        ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV,
  205.      $                        ONE, WORK, LDWORK )
  206.                END IF
  207. *
  208. *              W := W * T  or  W * T'
  209. *
  210.                CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
  211.      $                     ONE, T, LDT, WORK, LDWORK )
  212. *
  213. *              C := C - W * V'
  214. *
  215.                IF( N.GT.K ) THEN
  216. *
  217. *                 C2 := C2 - W * V2'
  218. *
  219.                   CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
  220.      $                        -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE,
  221.      $                        C( 1, K+1 ), LDC )
  222.                END IF
  223. *
  224. *              W := W * V1'
  225. *
  226.                CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
  227.      $                     ONE, V, LDV, WORK, LDWORK )
  228. *
  229. *              C1 := C1 - W
  230. *
  231.                DO 60 J = 1, K
  232.                   DO 50 I = 1, M
  233.                      C( I, J ) = C( I, J ) - WORK( I, J )
  234.    50             CONTINUE
  235.    60          CONTINUE
  236.             END IF
  237. *
  238.          ELSE
  239. *
  240. *           Let  V =  ( V1 )
  241. *                     ( V2 )    (last K rows)
  242. *           where  V2  is unit upper triangular.
  243. *
  244.             IF( LSAME( SIDE, 'L' ) ) THEN
  245. *
  246. *              Form  H * C  or  H' * C  where  C = ( C1 )
  247. *                                                  ( C2 )
  248. *
  249. *              W := C' * V  =  (C1'*V1 + C2'*V2)  (stored in WORK)
  250. *
  251. *              W := C2'
  252. *
  253.                DO 70 J = 1, K
  254.                   CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
  255.    70          CONTINUE
  256. *
  257. *              W := W * V2
  258. *
  259.                CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
  260.      $                     K, ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
  261.                IF( M.GT.K ) THEN
  262. *
  263. *                 W := W + C1'*V1
  264. *
  265.                   CALL DGEMM( 'Transpose', 'No transpose', N, K, M-K,
  266.      $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
  267.                END IF
  268. *
  269. *              W := W * T'  or  W * T
  270. *
  271.                CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
  272.      $                     ONE, T, LDT, WORK, LDWORK )
  273. *
  274. *              C := C - V * W'
  275. *
  276.                IF( M.GT.K ) THEN
  277. *
  278. *                 C1 := C1 - V1 * W'
  279. *
  280.                   CALL DGEMM( 'No transpose', 'Transpose', M-K, N, K,
  281.      $                        -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC )
  282.                END IF
  283. *
  284. *              W := W * V2'
  285. *
  286.                CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
  287.      $                     ONE, V( M-K+1, 1 ), LDV, WORK, LDWORK )
  288. *
  289. *              C2 := C2 - W'
  290. *
  291.                DO 90 J = 1, K
  292.                   DO 80 I = 1, N
  293.                      C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
  294.    80             CONTINUE
  295.    90          CONTINUE
  296. *
  297.             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  298. *
  299. *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
  300. *
  301. *              W := C * V  =  (C1*V1 + C2*V2)  (stored in WORK)
  302. *
  303. *              W := C2
  304. *
  305.                DO 100 J = 1, K
  306.                   CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
  307.   100          CONTINUE
  308. *
  309. *              W := W * V2
  310. *
  311.                CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
  312.      $                     K, ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
  313.                IF( N.GT.K ) THEN
  314. *
  315. *                 W := W + C1 * V1
  316. *
  317.                   CALL DGEMM( 'No transpose', 'No transpose', M, K, N-K,
  318.      $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
  319.                END IF
  320. *
  321. *              W := W * T  or  W * T'
  322. *
  323.                CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
  324.      $                     ONE, T, LDT, WORK, LDWORK )
  325. *
  326. *              C := C - W * V'
  327. *
  328.                IF( N.GT.K ) THEN
  329. *
  330. *                 C1 := C1 - W * V1'
  331. *
  332.                   CALL DGEMM( 'No transpose', 'Transpose', M, N-K, K,
  333.      $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
  334.                END IF
  335. *
  336. *              W := W * V2'
  337. *
  338.                CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
  339.      $                     ONE, V( N-K+1, 1 ), LDV, WORK, LDWORK )
  340. *
  341. *              C2 := C2 - W
  342. *
  343.                DO 120 J = 1, K
  344.                   DO 110 I = 1, M
  345.                      C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
  346.   110             CONTINUE
  347.   120          CONTINUE
  348.             END IF
  349.          END IF
  350. *
  351.       ELSE IF( LSAME( STOREV, 'R' ) ) THEN
  352. *
  353.          IF( LSAME( DIRECT, 'F' ) ) THEN
  354. *
  355. *           Let  V =  ( V1  V2 )    (V1: first K columns)
  356. *           where  V1  is unit upper triangular.
  357. *
  358.             IF( LSAME( SIDE, 'L' ) ) THEN
  359. *
  360. *              Form  H * C  or  H' * C  where  C = ( C1 )
  361. *                                                  ( C2 )
  362. *
  363. *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
  364. *
  365. *              W := C1'
  366. *
  367.                DO 130 J = 1, K
  368.                   CALL DCOPY( N, C( J, 1 ), LDC, WORK( 1, J ), 1 )
  369.   130          CONTINUE
  370. *
  371. *              W := W * V1'
  372. *
  373.                CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', N, K,
  374.      $                     ONE, V, LDV, WORK, LDWORK )
  375.                IF( M.GT.K ) THEN
  376. *
  377. *                 W := W + C2'*V2'
  378. *
  379.                   CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
  380.      $                        C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, ONE,
  381.      $                        WORK, LDWORK )
  382.                END IF
  383. *
  384. *              W := W * T'  or  W * T
  385. *
  386.                CALL DTRMM( 'Right', 'Upper', TRANST, 'Non-unit', N, K,
  387.      $                     ONE, T, LDT, WORK, LDWORK )
  388. *
  389. *              C := C - V' * W'
  390. *
  391.                IF( M.GT.K ) THEN
  392. *
  393. *                 C2 := C2 - V2' * W'
  394. *
  395.                   CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
  396.      $                        V( 1, K+1 ), LDV, WORK, LDWORK, ONE,
  397.      $                        C( K+1, 1 ), LDC )
  398.                END IF
  399. *
  400. *              W := W * V1
  401. *
  402.                CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', N,
  403.      $                     K, ONE, V, LDV, WORK, LDWORK )
  404. *
  405. *              C1 := C1 - W'
  406. *
  407.                DO 150 J = 1, K
  408.                   DO 140 I = 1, N
  409.                      C( J, I ) = C( J, I ) - WORK( I, J )
  410.   140             CONTINUE
  411.   150          CONTINUE
  412. *
  413.             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  414. *
  415. *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
  416. *
  417. *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
  418. *
  419. *              W := C1
  420. *
  421.                DO 160 J = 1, K
  422.                   CALL DCOPY( M, C( 1, J ), 1, WORK( 1, J ), 1 )
  423.   160          CONTINUE
  424. *
  425. *              W := W * V1'
  426. *
  427.                CALL DTRMM( 'Right', 'Upper', 'Transpose', 'Unit', M, K,
  428.      $                     ONE, V, LDV, WORK, LDWORK )
  429.                IF( N.GT.K ) THEN
  430. *
  431. *                 W := W + C2 * V2'
  432. *
  433.                   CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
  434.      $                        ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV,
  435.      $                        ONE, WORK, LDWORK )
  436.                END IF
  437. *
  438. *              W := W * T  or  W * T'
  439. *
  440.                CALL DTRMM( 'Right', 'Upper', TRANS, 'Non-unit', M, K,
  441.      $                     ONE, T, LDT, WORK, LDWORK )
  442. *
  443. *              C := C - W * V
  444. *
  445.                IF( N.GT.K ) THEN
  446. *
  447. *                 C2 := C2 - W * V2
  448. *
  449.                   CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
  450.      $                        -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, ONE,
  451.      $                        C( 1, K+1 ), LDC )
  452.                END IF
  453. *
  454. *              W := W * V1
  455. *
  456.                CALL DTRMM( 'Right', 'Upper', 'No transpose', 'Unit', M,
  457.      $                     K, ONE, V, LDV, WORK, LDWORK )
  458. *
  459. *              C1 := C1 - W
  460. *
  461.                DO 180 J = 1, K
  462.                   DO 170 I = 1, M
  463.                      C( I, J ) = C( I, J ) - WORK( I, J )
  464.   170             CONTINUE
  465.   180          CONTINUE
  466. *
  467.             END IF
  468. *
  469.          ELSE
  470. *
  471. *           Let  V =  ( V1  V2 )    (V2: last K columns)
  472. *           where  V2  is unit lower triangular.
  473. *
  474.             IF( LSAME( SIDE, 'L' ) ) THEN
  475. *
  476. *              Form  H * C  or  H' * C  where  C = ( C1 )
  477. *                                                  ( C2 )
  478. *
  479. *              W := C' * V'  =  (C1'*V1' + C2'*V2') (stored in WORK)
  480. *
  481. *              W := C2'
  482. *
  483.                DO 190 J = 1, K
  484.                   CALL DCOPY( N, C( M-K+J, 1 ), LDC, WORK( 1, J ), 1 )
  485.   190          CONTINUE
  486. *
  487. *              W := W * V2'
  488. *
  489.                CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', N, K,
  490.      $                     ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
  491.                IF( M.GT.K ) THEN
  492. *
  493. *                 W := W + C1'*V1'
  494. *
  495.                   CALL DGEMM( 'Transpose', 'Transpose', N, K, M-K, ONE,
  496.      $                        C, LDC, V, LDV, ONE, WORK, LDWORK )
  497.                END IF
  498. *
  499. *              W := W * T'  or  W * T
  500. *
  501.                CALL DTRMM( 'Right', 'Lower', TRANST, 'Non-unit', N, K,
  502.      $                     ONE, T, LDT, WORK, LDWORK )
  503. *
  504. *              C := C - V' * W'
  505. *
  506.                IF( M.GT.K ) THEN
  507. *
  508. *                 C1 := C1 - V1' * W'
  509. *
  510.                   CALL DGEMM( 'Transpose', 'Transpose', M-K, N, K, -ONE,
  511.      $                        V, LDV, WORK, LDWORK, ONE, C, LDC )
  512.                END IF
  513. *
  514. *              W := W * V2
  515. *
  516.                CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', N,
  517.      $                     K, ONE, V( 1, M-K+1 ), LDV, WORK, LDWORK )
  518. *
  519. *              C2 := C2 - W'
  520. *
  521.                DO 210 J = 1, K
  522.                   DO 200 I = 1, N
  523.                      C( M-K+J, I ) = C( M-K+J, I ) - WORK( I, J )
  524.   200             CONTINUE
  525.   210          CONTINUE
  526. *
  527.             ELSE IF( LSAME( SIDE, 'R' ) ) THEN
  528. *
  529. *              Form  C * H  or  C * H'  where  C = ( C1  C2 )
  530. *
  531. *              W := C * V'  =  (C1*V1' + C2*V2')  (stored in WORK)
  532. *
  533. *              W := C2
  534. *
  535.                DO 220 J = 1, K
  536.                   CALL DCOPY( M, C( 1, N-K+J ), 1, WORK( 1, J ), 1 )
  537.   220          CONTINUE
  538. *
  539. *              W := W * V2'
  540. *
  541.                CALL DTRMM( 'Right', 'Lower', 'Transpose', 'Unit', M, K,
  542.      $                     ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
  543.                IF( N.GT.K ) THEN
  544. *
  545. *                 W := W + C1 * V1'
  546. *
  547.                   CALL DGEMM( 'No transpose', 'Transpose', M, K, N-K,
  548.      $                        ONE, C, LDC, V, LDV, ONE, WORK, LDWORK )
  549.                END IF
  550. *
  551. *              W := W * T  or  W * T'
  552. *
  553.                CALL DTRMM( 'Right', 'Lower', TRANS, 'Non-unit', M, K,
  554.      $                     ONE, T, LDT, WORK, LDWORK )
  555. *
  556. *              C := C - W * V
  557. *
  558.                IF( N.GT.K ) THEN
  559. *
  560. *                 C1 := C1 - W * V1
  561. *
  562.                   CALL DGEMM( 'No transpose', 'No transpose', M, N-K, K,
  563.      $                        -ONE, WORK, LDWORK, V, LDV, ONE, C, LDC )
  564.                END IF
  565. *
  566. *              W := W * V2
  567. *
  568.                CALL DTRMM( 'Right', 'Lower', 'No transpose', 'Unit', M,
  569.      $                     K, ONE, V( 1, N-K+1 ), LDV, WORK, LDWORK )
  570. *
  571. *              C1 := C1 - W
  572. *
  573.                DO 240 J = 1, K
  574.                   DO 230 I = 1, M
  575.                      C( I, N-K+J ) = C( I, N-K+J ) - WORK( I, J )
  576.   230             CONTINUE
  577.   240          CONTINUE
  578. *
  579.             END IF
  580. *
  581.          END IF
  582.       END IF
  583. *
  584.       RETURN
  585. *
  586. *     End of DLARFB
  587. *
  588.       END
  589.