17faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \brief \b SLARFB 27faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 37faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* =========== DOCUMENTATION =========== 47faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 57faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Online html documentation available at 67faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* http://www.netlib.org/lapack/explore-html/ 77faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 87faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \htmlonly 97faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> Download SLARFB + dependencies 107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarfb.f"> 117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TGZ]</a> 127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarfb.f"> 137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [ZIP]</a> 147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarfb.f"> 157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TXT]</a> 167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endhtmlonly 177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Definition: 197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* =========== 207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, 227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* T, LDT, C, LDC, WORK, LDWORK ) 237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Scalar Arguments .. 257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* CHARACTER DIRECT, SIDE, STOREV, TRANS 267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* INTEGER K, LDC, LDT, LDV, LDWORK, M, N 277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Array Arguments .. 297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* REAL C( LDC, * ), T( LDT, * ), V( LDV, * ), 307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* $ WORK( LDWORK, * ) 317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \par Purpose: 357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ============= 367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> SLARFB applies a real block reflector H or its transpose H**T to a 407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> real m by n matrix C, from either the left or the right. 417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Arguments: 447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ========== 457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] SIDE 477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> SIDE is CHARACTER*1 497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'L': apply H or H**T from the Left 507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'R': apply H or H**T from the Right 517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] TRANS 547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> TRANS is CHARACTER*1 567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'N': apply H (No transpose) 577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'T': apply H**T (Transpose) 587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] DIRECT 617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> DIRECT is CHARACTER*1 637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> Indicates how H is formed from a product of elementary 647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> reflectors 657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'F': H = H(1) H(2) . . . H(k) (Forward) 667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'B': H = H(k) . . . H(2) H(1) (Backward) 677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] STOREV 707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> STOREV is CHARACTER*1 727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> Indicates how the vectors which define the elementary 737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> reflectors are stored: 747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'C': Columnwise 757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'R': Rowwise 767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] M 797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> M is INTEGER 817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The number of rows of the matrix C. 827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] N 857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> N is INTEGER 877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The number of columns of the matrix C. 887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] K 917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> K is INTEGER 937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The order of the matrix T (= the number of elementary 947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> reflectors whose product defines the block reflector). 957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] V 987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> V is REAL array, dimension 1007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> (LDV,K) if STOREV = 'C' 1017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> (LDV,M) if STOREV = 'R' and SIDE = 'L' 1027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> (LDV,N) if STOREV = 'R' and SIDE = 'R' 1037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The matrix V. See Further Details. 1047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] LDV 1077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> LDV is INTEGER 1097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The leading dimension of the array V. 1107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> If STOREV = 'C' and SIDE = 'L', LDV >= max(1,M); 1117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> if STOREV = 'C' and SIDE = 'R', LDV >= max(1,N); 1127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> if STOREV = 'R', LDV >= K. 1137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] T 1167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> T is REAL array, dimension (LDT,K) 1187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The triangular k by k matrix T in the representation of the 1197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> block reflector. 1207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] LDT 1237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> LDT is INTEGER 1257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The leading dimension of the array T. LDT >= K. 1267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in,out] C 1297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> C is REAL array, dimension (LDC,N) 1317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On entry, the m by n matrix C. 1327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> On exit, C is overwritten by H*C or H**T*C or C*H or C*H**T. 1337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] LDC 1367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> LDC is INTEGER 1387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The leading dimension of the array C. LDC >= max(1,M). 1397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[out] WORK 1427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> WORK is REAL array, dimension (LDWORK,K) 1447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \param[in] LDWORK 1477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> LDWORK is INTEGER 1497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The leading dimension of the array WORK. 1507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> If SIDE = 'L', LDWORK >= max(1,N); 1517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> if SIDE = 'R', LDWORK >= max(1,M). 1527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Authors: 1557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ======== 1567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of Tennessee 1587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of California Berkeley 1597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author Univ. of Colorado Denver 1607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \author NAG Ltd. 1617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \date November 2011 1637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \ingroup realOTHERauxiliary 1657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \par Further Details: 1677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================== 1687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \verbatim 1707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> The shape of the matrix V and the storage of the vectors which define 1727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> the H(i) is best illustrated by the following example with n = 5 and 1737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> k = 3. The elements equal to 1 are not stored; the corresponding 1747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> array elements are modified but restored on exit. The rest of the 1757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> array is not used. 1767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> DIRECT = 'F' and STOREV = 'C': DIRECT = 'F' and STOREV = 'R': 1787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> V = ( 1 ) V = ( 1 v1 v1 v1 v1 ) 1807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v1 1 ) ( 1 v2 v2 v2 ) 1817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v1 v2 1 ) ( 1 v3 v3 ) 1827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v1 v2 v3 ) 1837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v1 v2 v3 ) 1847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> DIRECT = 'B' and STOREV = 'C': DIRECT = 'B' and STOREV = 'R': 1867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> V = ( v1 v2 v3 ) V = ( v1 v1 1 ) 1887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( v1 v2 v3 ) ( v2 v2 v2 1 ) 1897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( 1 v2 v3 ) ( v3 v3 v3 v3 1 ) 1907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( 1 v3 ) 1917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> ( 1 ) 1927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endverbatim 1937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> 1947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================================================================== 1957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez SUBROUTINE SLARFB( SIDE, TRANS, DIRECT, STOREV, M, N, K, V, LDV, 1967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ T, LDT, C, LDC, WORK, LDWORK ) 1977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 1987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- LAPACK auxiliary routine (version 3.4.0) -- 1997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- LAPACK is a software package provided by Univ. of Tennessee, -- 2007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 2017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* November 2011 2027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Scalar Arguments .. 2047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CHARACTER DIRECT, SIDE, STOREV, TRANS 2057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTEGER K, LDC, LDT, LDV, LDWORK, M, N 2067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Array Arguments .. 2087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL C( LDC, * ), T( LDT, * ), V( LDV, * ), 2097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( LDWORK, * ) 2107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================================================================== 2137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Parameters .. 2157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez REAL ONE 2167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez PARAMETER ( ONE = 1.0E+0 ) 2177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Local Scalars .. 2197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CHARACTER TRANST 2207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTEGER I, J, LASTV, LASTC 2217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. External Functions .. 2237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LOGICAL LSAME 2247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTEGER ILASLR, ILASLC 2257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL LSAME, ILASLR, ILASLC 2267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. External Subroutines .. 2287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL SCOPY, SGEMM, STRMM 2297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Executable Statements .. 2317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Quick return if possible 2337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( M.LE.0 .OR. N.LE.0 ) 2357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ RETURN 2367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( TRANS, 'N' ) ) THEN 2387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TRANST = 'T' 2397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 2407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TRANST = 'N' 2417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( STOREV, 'C' ) ) THEN 2447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( DIRECT, 'F' ) ) THEN 2467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 ) (first K rows) 2487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( V2 ) 2497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V1 is unit lower triangular. 2507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 2527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**T * C where C = ( C1 ) 2547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 2557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLR( M, K, V, LDV ) ) 2577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLC( LASTV, N, C, LDC ) 2587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) 2607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1**T 2627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 10 J = 1, K 2647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 2657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 10 CONTINUE 2667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 2687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', 2707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 2717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 2727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2**T *V2 2747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'No transpose', 2767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 2777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( K+1, 1 ), LDC, V( K+1, 1 ), LDV, 2787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 2797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**T or W * T 2827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', 2847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 2857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V * W**T 2877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 2897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - V2 * W**T 2917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 2937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, 2947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, V( K+1, 1 ), LDV, WORK, LDWORK, ONE, 2957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ C( K+1, 1 ), LDC ) 2967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**T 2997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', 3017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W**T 3047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 30 J = 1, K 3067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 20 I = 1, LASTC 3077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( J, I ) = C( J, I ) - WORK( I, J ) 3087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 20 CONTINUE 3097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 30 CONTINUE 3107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 3127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**T where C = ( C1 C2 ) 3147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLR( N, K, V, LDV ) ) 3167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLR( M, LASTV, C, LDC ) 3177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V = (C1*V1 + C2*V2) (stored in WORK) 3197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1 3217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 40 J = 1, K 3237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) 3247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 40 CONTINUE 3257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 3277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', 3297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 3317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2 * V2 3337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'No transpose', 3357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 3367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, 3377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 3387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**T 3417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit', 3437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 3447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V**T 3467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 3487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W * V2**T 3507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 3527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, 3537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, ONE, 3547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ C( 1, K+1 ), LDC ) 3557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**T 3587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', 3607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 3637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 60 J = 1, K 3657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 50 I = 1, LASTC 3667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, J ) = C( I, J ) - WORK( I, J ) 3677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 50 CONTINUE 3687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 60 CONTINUE 3697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 3727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 ) 3747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( V2 ) (last K rows) 3757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V2 is unit upper triangular. 3767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 3787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**T * C where C = ( C1 ) 3807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 3817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLR( M, K, V, LDV ) ) 3837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLC( LASTV, N, C, LDC ) 3847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**T * V = (C1**T * V1 + C2**T * V2) (stored in WORK) 3867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2**T 3887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 70 J = 1, K 3907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC, 3917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 3927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 70 CONTINUE 3937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 3957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', 3977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 3987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 3997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1**T*V1 4027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'No transpose', 4047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, 4057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 4067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**T or W * T 4097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', 4117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 4127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V * W**T 4147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - V1 * W**T 4187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 4207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK, 4217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 4227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**T 4257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', 4277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W**T 4317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 90 J = 1, K 4337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 80 I = 1, LASTC 4347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J) 4357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 80 CONTINUE 4367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 90 CONTINUE 4377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 4397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**T where C = ( C1 C2 ) 4417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLR( N, K, V, LDV ) ) 4437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLR( M, LASTV, C, LDC ) 4447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V = (C1*V1 + C2*V2) (stored in WORK) 4467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2 4487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 100 J = 1, K 4507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( 1, N-K+J ), 1, WORK( 1, J ), 1 ) 4517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 100 CONTINUE 4527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 4547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', 4567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1 * V1 4617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'No transpose', 4637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, 4647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 4657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**T 4687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', 4707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 4717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V**T 4737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W * V1**T 4777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 4797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV, 4807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 4817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**T 4847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', 4867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W 4907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 120 J = 1, K 4927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 110 I = 1, LASTC 4937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, LASTV-K+J ) = C( I, LASTV-K+J ) - WORK(I, J) 4947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 110 CONTINUE 4957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 120 CONTINUE 4967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( STOREV, 'R' ) ) THEN 5007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( DIRECT, 'F' ) ) THEN 5027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 V2 ) (V1: first K columns) 5047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V1 is unit upper triangular. 5057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 5077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**T * C where C = ( C1 ) 5097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 5107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLC( K, M, V, LDV ) ) 5127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLC( LASTV, N, C, LDC ) 5137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) 5157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1**T 5177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 130 J = 1, K 5197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 5207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 130 CONTINUE 5217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**T 5237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', 5257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2**T*V2**T 5297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'Transpose', 5317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 5327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, 5337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 5347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**T or W * T 5377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', TRANST, 'Non-unit', 5397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 5407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V**T * W**T 5427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - V2**T * W**T 5467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'Transpose', 5487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, 5497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK, 5507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( K+1, 1 ), LDC ) 5517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 5547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', 5567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W**T 5597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 150 J = 1, K 5617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 140 I = 1, LASTC 5627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( J, I ) = C( J, I ) - WORK( I, J ) 5637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 140 CONTINUE 5647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 150 CONTINUE 5657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 5677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**T where C = ( C1 C2 ) 5697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLC( K, N, V, LDV ) ) 5717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLR( M, LASTV, C, LDC ) 5727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) 5747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1 5767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 160 J = 1, K 5787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) 5797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 160 CONTINUE 5807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**T 5827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'Transpose', 'Unit', 5847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2 * V2**T 5887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 5907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 5917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC, V( 1, K+1 ), LDV, 5927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 5937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**T 5967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', TRANS, 'Non-unit', 5987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 5997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V 6017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W * V2 6057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'No transpose', 6077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, 6087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, 6097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC ) 6107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 6137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Upper', 'No transpose', 'Unit', 6157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 6167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 6187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 180 J = 1, K 6207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 170 I = 1, LASTC 6217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, J ) = C( I, J ) - WORK( I, J ) 6227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 170 CONTINUE 6237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 180 CONTINUE 6247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 6287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 V2 ) (V2: last K columns) 6307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V2 is unit lower triangular. 6317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 6337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**T * C where C = ( C1 ) 6357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 6367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLC( K, M, V, LDV ) ) 6387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLC( LASTV, N, C, LDC ) 6397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**T * V**T = (C1**T * V1**T + C2**T * V2**T) (stored in WORK) 6417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2**T 6437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 190 J = 1, K 6457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( LASTV-K+J, 1 ), LDC, 6467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 6477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 190 CONTINUE 6487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**T 6507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', 6527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 6537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 6547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1**T * V1**T 6577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'Transpose', 6597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, 6607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 6617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**T or W * T 6647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', TRANST, 'Non-unit', 6667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 6677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V**T * W**T 6697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - V1**T * W**T 6737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'Transpose', 'Transpose', 6757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK, 6767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 6777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 6807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', 6827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 6837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 6847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W**T 6867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 210 J = 1, K 6887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 200 I = 1, LASTC 6897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - WORK(I, J) 6907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 200 CONTINUE 6917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 210 CONTINUE 6927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 6947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**T where C = ( C1 C2 ) 6967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILASLC( K, N, V, LDV ) ) 6987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILASLR( M, LASTV, C, LDC ) 6997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V**T = (C1*V1**T + C2*V2**T) (stored in WORK) 7017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2 7037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 220 J = 1, K 7057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SCOPY( LASTC, C( 1, LASTV-K+J ), 1, 7067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 7077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 220 CONTINUE 7087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**T 7107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'Transpose', 'Unit', 7127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 7137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 7147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 7157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1 * V1**T 7177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'Transpose', 7197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, 7207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 7217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**T 7247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', TRANS, 'Non-unit', 7267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 7277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V 7297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 7317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W * V1 7337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL SGEMM( 'No transpose', 'No transpose', 7357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV, 7367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 7377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 7407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL STRMM( 'Right', 'Lower', 'No transpose', 'Unit', 7427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 7437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 7447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 7467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 240 J = 1, K 7487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 230 I = 1, LASTC 7497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, LASTV-K+J ) = C( I, LASTV-K+J ) 7507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ - WORK( I, J ) 7517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 230 CONTINUE 7527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 240 CONTINUE 7537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez RETURN 7607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* End of SLARFB 7627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END 764