17faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \brief \b CLARFB 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 CLARFB + dependencies 107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clarfb.f"> 117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TGZ]</a> 127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clarfb.f"> 137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [ZIP]</a> 147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clarfb.f"> 157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> [TXT]</a> 167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> \endhtmlonly 177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Definition: 197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* =========== 207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* SUBROUTINE CLARFB( 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* COMPLEX 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*> CLARFB applies a complex block reflector H or its transpose H**H to a 407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> complex 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**H from the Left 507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez*> = 'R': apply H or H**H 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*> = 'C': apply H**H (Conjugate 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 COMPLEX 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 COMPLEX 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 COMPLEX 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**H*C or C*H or C*H**H. 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 COMPLEX 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 complexOTHERauxiliary 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 CLARFB( 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 COMPLEX C( LDC, * ), T( LDT, * ), V( LDV, * ), 2097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( LDWORK, * ) 2107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ===================================================================== 2137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Parameters .. 2157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez COMPLEX ONE 2167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez PARAMETER ( ONE = ( 1.0E+0, 0.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 ILACLR, ILACLC 2257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL LSAME, ILACLR, ILACLC 2267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. External Subroutines .. 2287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez EXTERNAL CCOPY, CGEMM, CLACGV, CTRMM 2297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Intrinsic Functions .. 2317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez INTRINSIC CONJG 2327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. 2337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* .. Executable Statements .. 2347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Quick return if possible 2367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( M.LE.0 .OR. N.LE.0 ) 2387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ RETURN 2397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( TRANS, 'N' ) ) THEN 2417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TRANST = 'C' 2427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 2437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez TRANST = 'N' 2447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( STOREV, 'C' ) ) THEN 2477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( DIRECT, 'F' ) ) THEN 2497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 ) (first K rows) 2517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( V2 ) 2527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V1 is unit lower triangular. 2537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 2557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**H * C where C = ( C1 ) 2577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 2587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLR( M, K, V, LDV ) ) 2607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLC( LASTV, N, C, LDC ) 2617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK) 2637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1**H 2657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 10 J = 1, K 2677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 2687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CLACGV( LASTC, WORK( 1, J ), 1 ) 2697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 10 CONTINUE 2707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 2727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', 2747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 2757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 2767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2**H *V2 2787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 'No transpose', 2807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C( K+1, 1 ), LDC, 2817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ V( K+1, 1 ), LDV, ONE, WORK, LDWORK ) 2827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**H or W * T 2857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', 2877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 2887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V * W**H 2907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( M.GT.K ) THEN 2927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - V2 * W**H 2947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 2957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 2967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, -ONE, V( K+1, 1 ), LDV, 2977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK, ONE, C( K+1, 1 ), LDC ) 2987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 2997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**H 3017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose', 3037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W**H 3067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 30 J = 1, K 3087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 20 I = 1, LASTC 3097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) ) 3107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 20 CONTINUE 3117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 30 CONTINUE 3127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 3147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**H where C = ( C1 C2 ) 3167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLR( N, K, V, LDV ) ) 3187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLR( M, LASTV, C, LDC ) 3197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V = (C1*V1 + C2*V2) (stored in WORK) 3217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1 3237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 40 J = 1, K 3257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) 3267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 40 CONTINUE 3277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 3297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', 3317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 3337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2 * V2 3357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'No transpose', 3377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 3387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC, V( K+1, 1 ), LDV, 3397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 3407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**H 3437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit', 3457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 3467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V**H 3487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 3507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W * V2**H 3527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 3547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, 3557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, WORK, LDWORK, V( K+1, 1 ), LDV, 3567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC ) 3577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**H 3607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose', 3627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK ) 3637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 3657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 60 J = 1, K 3677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 50 I = 1, LASTC 3687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, J ) = C( I, J ) - WORK( I, J ) 3697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 50 CONTINUE 3707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 60 CONTINUE 3717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 3727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 3747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 ) 3767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( V2 ) (last K rows) 3777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V2 is unit upper triangular. 3787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 3807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**H * C where C = ( C1 ) 3827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 3837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLR( M, K, V, LDV ) ) 3857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLC( LASTV, N, C, LDC ) 3867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**H * V = (C1**H * V1 + C2**H * V2) (stored in WORK) 3887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2**H 3907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 70 J = 1, K 3927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC, 3937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 3947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CLACGV( LASTC, WORK( 1, J ), 1 ) 3957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 70 CONTINUE 3967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 3987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 3997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', 4007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1**H*V1 4057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 'No transpose', 4077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, 4087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 4097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**H or W * T 4127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', 4147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 4157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V * W**H 4177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - V1 * W**H 4217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 4237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTV-K, LASTC, K, -ONE, V, LDV, WORK, LDWORK, 4247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 4257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**H 4287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose', 4307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W**H 4347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 90 J = 1, K 4367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 80 I = 1, LASTC 4377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - 4387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ CONJG( WORK( I, J ) ) 4397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 80 CONTINUE 4407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 90 CONTINUE 4417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 4437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**H where C = ( C1 C2 ) 4457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLR( N, K, V, LDV ) ) 4477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLR( M, LASTV, C, LDC ) 4487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V = (C1*V1 + C2*V2) (stored in WORK) 4507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2 4527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 100 J = 1, K 4547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1, 4557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 4567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 100 CONTINUE 4577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 4597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', 4617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1 * V1 4667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'No transpose', 4687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, 4697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) 4707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**H 4737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit', 4757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 4767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V**H 4787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 4807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W * V1**H 4827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 4847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV, 4857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 4867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 4877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**H 4897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose', 4917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V( LASTV-K+1, 1 ), LDV, 4927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 4937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W 4957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 4967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 120 J = 1, K 4977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 110 I = 1, LASTC 4987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, LASTV-K+J ) = C( I, LASTV-K+J ) 4997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ - WORK( I, J ) 5007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 110 CONTINUE 5017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 120 CONTINUE 5027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( STOREV, 'R' ) ) THEN 5067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( DIRECT, 'F' ) ) THEN 5087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 V2 ) (V1: first K columns) 5107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V1 is unit upper triangular. 5117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 5137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**H * C where C = ( C1 ) 5157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 5167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLC( K, M, V, LDV ) ) 5187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLC( LASTV, N, C, LDC ) 5197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK) 5217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1**H 5237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 130 J = 1, K 5257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( J, 1 ), LDC, WORK( 1, J ), 1 ) 5267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CLACGV( LASTC, WORK( 1, J ), 1 ) 5277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 130 CONTINUE 5287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**H 5307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose', 5327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2**H*V2**H 5367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 5387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Conjugate transpose', LASTC, K, LASTV-K, 5397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( K+1, 1 ), LDC, V( 1, K+1 ), LDV, 5407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, WORK, LDWORK ) 5417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**H or W * T 5447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', TRANST, 'Non-unit', 5467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 5477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V**H * W**H 5497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - V2**H * W**H 5537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 5557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Conjugate transpose', LASTV-K, LASTC, K, 5567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, V( 1, K+1 ), LDV, WORK, LDWORK, 5577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( K+1, 1 ), LDC ) 5587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 5597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 5617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', 5637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W**H 5667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 150 J = 1, K 5687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 140 I = 1, LASTC 5697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( J, I ) = C( J, I ) - CONJG( WORK( I, J ) ) 5707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 140 CONTINUE 5717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 150 CONTINUE 5727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 5747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**H where C = ( C1 C2 ) 5767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLC( K, N, V, LDV ) ) 5787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLR( M, LASTV, C, LDC ) 5797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK) 5817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C1 5837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 160 J = 1, K 5857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( 1, J ), 1, WORK( 1, J ), 1 ) 5867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 160 CONTINUE 5877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1**H 5897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'Conjugate transpose', 5917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V, LDV, WORK, LDWORK ) 5927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 5937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C2 * V2**H 5957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 5967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 5977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C( 1, K+1 ), LDC, 5987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ V( 1, K+1 ), LDV, ONE, WORK, LDWORK ) 5997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**H 6027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', TRANS, 'Non-unit', 6047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 6057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V 6077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W * V2 6117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'No transpose', 6137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, 6147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, WORK, LDWORK, V( 1, K+1 ), LDV, 6157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C( 1, K+1 ), LDC ) 6167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V1 6197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Upper', 'No transpose', 'Unit', 6217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V, LDV, WORK, LDWORK ) 6227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 6247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 180 J = 1, K 6267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 170 I = 1, LASTC 6277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, J ) = C( I, J ) - WORK( I, J ) 6287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 170 CONTINUE 6297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 180 CONTINUE 6307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE 6347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Let V = ( V1 V2 ) (V2: last K columns) 6367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* where V2 is unit lower triangular. 6377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LSAME( SIDE, 'L' ) ) THEN 6397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form H * C or H**H * C where C = ( C1 ) 6417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* ( C2 ) 6427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLC( K, M, V, LDV ) ) 6447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLC( LASTV, N, C, LDC ) 6457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C**H * V**H = (C1**H * V1**H + C2**H * V2**H) (stored in WORK) 6477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2**H 6497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 190 J = 1, K 6517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( LASTV-K+J, 1 ), LDC, 6527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 6537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CLACGV( LASTC, WORK( 1, J ), 1 ) 6547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 190 CONTINUE 6557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**H 6577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose', 6597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 6607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 6617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1**H * V1**H 6647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 6667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Conjugate transpose', LASTC, K, LASTV-K, 6677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC, V, LDV, ONE, WORK, LDWORK ) 6687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T**H or W * T 6717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6727faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', TRANST, 'Non-unit', 6737faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 6747faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6757faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - V**H * W**H 6767faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6777faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 6787faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6797faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - V1**H * W**H 6807faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6817faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'Conjugate transpose', 6827faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Conjugate transpose', LASTV-K, LASTC, K, 6837faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ -ONE, V, LDV, WORK, LDWORK, ONE, C, LDC ) 6847faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 6857faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6867faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 6877faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6887faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', 6897faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 6907faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 6917faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6927faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C2 := C2 - W**H 6937faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 6947faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 210 J = 1, K 6957faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 200 I = 1, LASTC 6967faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( LASTV-K+J, I ) = C( LASTV-K+J, I ) - 6977faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ CONJG( WORK( I, J ) ) 6987faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 200 CONTINUE 6997faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 210 CONTINUE 7007faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7017faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez ELSE IF( LSAME( SIDE, 'R' ) ) THEN 7027faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7037faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* Form C * H or C * H**H where C = ( C1 C2 ) 7047faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7057faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTV = MAX( K, ILACLC( K, N, V, LDV ) ) 7067faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez LASTC = ILACLR( M, LASTV, C, LDC ) 7077faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7087faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C * V**H = (C1*V1**H + C2*V2**H) (stored in WORK) 7097faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7107faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := C2 7117faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7127faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 220 J = 1, K 7137faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CCOPY( LASTC, C( 1, LASTV-K+J ), 1, 7147faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK( 1, J ), 1 ) 7157faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 220 CONTINUE 7167faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7177faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2**H 7187faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7197faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'Conjugate transpose', 7207faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ 'Unit', LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 7217faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 7227faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 7237faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7247faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W + C1 * V1**H 7257faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7267faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'Conjugate transpose', 7277faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, LASTV-K, ONE, C, LDC, V, LDV, ONE, 7287faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 7297faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7307faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7317faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * T or W * T**H 7327faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7337faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', TRANS, 'Non-unit', 7347faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, T, LDT, WORK, LDWORK ) 7357faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7367faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C := C - W * V 7377faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7387faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez IF( LASTV.GT.K ) THEN 7397faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7407faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W * V1 7417faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7427faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CGEMM( 'No transpose', 'No transpose', 7437faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, LASTV-K, K, -ONE, WORK, LDWORK, V, LDV, 7447faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ ONE, C, LDC ) 7457faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7467faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7477faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* W := W * V2 7487faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7497faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez CALL CTRMM( 'Right', 'Lower', 'No transpose', 'Unit', 7507faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ LASTC, K, ONE, V( 1, LASTV-K+1 ), LDV, 7517faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ WORK, LDWORK ) 7527faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7537faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* C1 := C1 - W 7547faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7557faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 240 J = 1, K 7567faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez DO 230 I = 1, LASTC 7577faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez C( I, LASTV-K+J ) = C( I, LASTV-K+J ) 7587faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez $ - WORK( I, J ) 7597faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 230 CONTINUE 7607faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez 240 CONTINUE 7617faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7627faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7637faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7647faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7657faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END IF 7667faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7677faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez RETURN 7687faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7697faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* End of CLARFB 7707faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez* 7717faaa9f3f0df9d23790277834d426c3d992ac3baCarlos Hernandez END 772