SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ pb_clagen()

subroutine pb_clagen ( character*1  uplo,
character*1  aform,
complex, dimension( lda, * )  a,
integer  lda,
integer  lcmt00,
integer, dimension( * )  iran,
integer  mblks,
integer  imbloc,
integer  mb,
integer  lmbloc,
integer  nblks,
integer  inbloc,
integer  nb,
integer  lnbloc,
integer, dimension( * )  jmp,
integer, dimension( 4, * )  imuladd 
)

Definition at line 1498 of file pcblastim.f.

1501*
1502* -- PBLAS test routine (version 2.0) --
1503* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1504* and University of California, Berkeley.
1505* April 1, 1998
1506*
1507* .. Scalar Arguments ..
1508 CHARACTER*1 UPLO, AFORM
1509 INTEGER IMBLOC, INBLOC, LCMT00, LDA, LMBLOC, LNBLOC,
1510 $ MB, MBLKS, NB, NBLKS
1511* ..
1512* .. Array Arguments ..
1513 INTEGER IMULADD( 4, * ), IRAN( * ), JMP( * )
1514 COMPLEX A( LDA, * )
1515* ..
1516*
1517* Purpose
1518* =======
1519*
1520* PB_CLAGEN locally initializes an array A.
1521*
1522* Arguments
1523* =========
1524*
1525* UPLO (global input) CHARACTER*1
1526* On entry, UPLO specifies whether the lower (UPLO='L') trape-
1527* zoidal part or the upper (UPLO='U') trapezoidal part is to be
1528* generated when the matrix to be generated is symmetric or
1529* Hermitian. For all the other values of AFORM, the value of
1530* this input argument is ignored.
1531*
1532* AFORM (global input) CHARACTER*1
1533* On entry, AFORM specifies the type of submatrix to be genera-
1534* ted as follows:
1535* AFORM = 'S', sub( A ) is a symmetric matrix,
1536* AFORM = 'H', sub( A ) is a Hermitian matrix,
1537* AFORM = 'T', sub( A ) is overrwritten with the transpose
1538* of what would normally be generated,
1539* AFORM = 'C', sub( A ) is overwritten with the conjugate
1540* transpose of what would normally be genera-
1541* ted.
1542* AFORM = 'N', a random submatrix is generated.
1543*
1544* A (local output) COMPLEX array
1545* On entry, A is an array of dimension (LLD_A, *). On exit,
1546* this array contains the local entries of the randomly genera-
1547* ted submatrix sub( A ).
1548*
1549* LDA (local input) INTEGER
1550* On entry, LDA specifies the local leading dimension of the
1551* array A. LDA must be at least one.
1552*
1553* LCMT00 (global input) INTEGER
1554* On entry, LCMT00 is the LCM value specifying the off-diagonal
1555* of the underlying matrix of interest. LCMT00=0 specifies the
1556* main diagonal, LCMT00 > 0 specifies a subdiagonal, LCMT00 < 0
1557* specifies superdiagonals.
1558*
1559* IRAN (local input) INTEGER array
1560* On entry, IRAN is an array of dimension 2 containing respec-
1561* tively the 16-lower and 16-higher bits of the encoding of the
1562* entry of the random sequence corresponding locally to the
1563* first local array entry to generate. Usually, this array is
1564* computed by PB_SETLOCRAN.
1565*
1566* MBLKS (local input) INTEGER
1567* On entry, MBLKS specifies the local number of blocks of rows.
1568* MBLKS is at least zero.
1569*
1570* IMBLOC (local input) INTEGER
1571* On entry, IMBLOC specifies the number of rows (size) of the
1572* local uppest blocks. IMBLOC is at least zero.
1573*
1574* MB (global input) INTEGER
1575* On entry, MB specifies the blocking factor used to partition
1576* the rows of the matrix. MB must be at least one.
1577*
1578* LMBLOC (local input) INTEGER
1579* On entry, LMBLOC specifies the number of rows (size) of the
1580* local lowest blocks. LMBLOC is at least zero.
1581*
1582* NBLKS (local input) INTEGER
1583* On entry, NBLKS specifies the local number of blocks of co-
1584* lumns. NBLKS is at least zero.
1585*
1586* INBLOC (local input) INTEGER
1587* On entry, INBLOC specifies the number of columns (size) of
1588* the local leftmost blocks. INBLOC is at least zero.
1589*
1590* NB (global input) INTEGER
1591* On entry, NB specifies the blocking factor used to partition
1592* the the columns of the matrix. NB must be at least one.
1593*
1594* LNBLOC (local input) INTEGER
1595* On entry, LNBLOC specifies the number of columns (size) of
1596* the local rightmost blocks. LNBLOC is at least zero.
1597*
1598* JMP (local input) INTEGER array
1599* On entry, JMP is an array of dimension JMP_LEN containing the
1600* different jump values used by the random matrix generator.
1601*
1602* IMULADD (local input) INTEGER array
1603* On entry, IMULADD is an array of dimension (4, JMP_LEN). The
1604* jth column of this array contains the encoded initial cons-
1605* tants a_j and c_j to jump from X( n ) to X( n + JMP( j ) )
1606* (= a_j * X( n ) + c_j) in the random sequence. IMULADD(1:2,j)
1607* contains respectively the 16-lower and 16-higher bits of the
1608* constant a_j, and IMULADD(3:4,j) contains the 16-lower and
1609* 16-higher bits of the constant c_j.
1610*
1611* -- Written on April 1, 1998 by
1612* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1613*
1614* =====================================================================
1615*
1616* .. Parameters ..
1617 INTEGER JMP_1, JMP_COL, JMP_IMBV, JMP_INBV, JMP_LEN,
1618 $ JMP_MB, JMP_NB, JMP_NPIMBLOC, JMP_NPMB,
1619 $ JMP_NQINBLOC, JMP_NQNB, JMP_ROW
1620 parameter( jmp_1 = 1, jmp_row = 2, jmp_col = 3,
1621 $ jmp_mb = 4, jmp_imbv = 5, jmp_npmb = 6,
1622 $ jmp_npimbloc = 7, jmp_nb = 8, jmp_inbv = 9,
1623 $ jmp_nqnb = 10, jmp_nqinbloc = 11,
1624 $ jmp_len = 11 )
1625 REAL ZERO
1626 parameter( zero = 0.0e+0 )
1627* ..
1628* .. Local Scalars ..
1629 INTEGER I, IB, IBLK, II, IK, ITMP, JB, JBLK, JJ, JK,
1630 $ JTMP, LCMTC, LCMTR, LOW, MNB, UPP
1631 COMPLEX DUMMY
1632* ..
1633* .. Local Arrays ..
1634 INTEGER IB0( 2 ), IB1( 2 ), IB2( 2 ), IB3( 2 )
1635* ..
1636* .. External Subroutines ..
1637 EXTERNAL pb_jumpit
1638* ..
1639* .. External Functions ..
1640 LOGICAL LSAME
1641 REAL PB_SRAND
1642 EXTERNAL lsame, pb_srand
1643* ..
1644* .. Intrinsic Functions ..
1645 INTRINSIC cmplx, max, min, real
1646* ..
1647* .. Executable Statements ..
1648*
1649 DO 10 i = 1, 2
1650 ib1( i ) = iran( i )
1651 ib2( i ) = iran( i )
1652 ib3( i ) = iran( i )
1653 10 CONTINUE
1654*
1655 IF( lsame( aform, 'N' ) ) THEN
1656*
1657* Generate random matrix
1658*
1659 jj = 1
1660*
1661 DO 50 jblk = 1, nblks
1662*
1663 IF( jblk.EQ.1 ) THEN
1664 jb = inbloc
1665 ELSE IF( jblk.EQ.nblks ) THEN
1666 jb = lnbloc
1667 ELSE
1668 jb = nb
1669 END IF
1670*
1671 DO 40 jk = jj, jj + jb - 1
1672*
1673 ii = 1
1674*
1675 DO 30 iblk = 1, mblks
1676*
1677 IF( iblk.EQ.1 ) THEN
1678 ib = imbloc
1679 ELSE IF( iblk.EQ.mblks ) THEN
1680 ib = lmbloc
1681 ELSE
1682 ib = mb
1683 END IF
1684*
1685* Blocks are IB by JB
1686*
1687 DO 20 ik = ii, ii + ib - 1
1688 a( ik, jk ) = cmplx( pb_srand( 0 ), pb_srand( 0 ) )
1689 20 CONTINUE
1690*
1691 ii = ii + ib
1692*
1693 IF( iblk.EQ.1 ) THEN
1694*
1695* Jump IMBLOC + ( NPROW - 1 ) * MB rows
1696*
1697 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
1698 $ ib0 )
1699*
1700 ELSE
1701*
1702* Jump NPROW * MB rows
1703*
1704 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1, ib0 )
1705*
1706 END IF
1707*
1708 ib1( 1 ) = ib0( 1 )
1709 ib1( 2 ) = ib0( 2 )
1710*
1711 30 CONTINUE
1712*
1713* Jump one column
1714*
1715 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
1716*
1717 ib1( 1 ) = ib0( 1 )
1718 ib1( 2 ) = ib0( 2 )
1719 ib2( 1 ) = ib0( 1 )
1720 ib2( 2 ) = ib0( 2 )
1721*
1722 40 CONTINUE
1723*
1724 jj = jj + jb
1725*
1726 IF( jblk.EQ.1 ) THEN
1727*
1728* Jump INBLOC + ( NPCOL - 1 ) * NB columns
1729*
1730 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
1731*
1732 ELSE
1733*
1734* Jump NPCOL * NB columns
1735*
1736 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
1737*
1738 END IF
1739*
1740 ib1( 1 ) = ib0( 1 )
1741 ib1( 2 ) = ib0( 2 )
1742 ib2( 1 ) = ib0( 1 )
1743 ib2( 2 ) = ib0( 2 )
1744 ib3( 1 ) = ib0( 1 )
1745 ib3( 2 ) = ib0( 2 )
1746*
1747 50 CONTINUE
1748*
1749 ELSE IF( lsame( aform, 'T' ) ) THEN
1750*
1751* Generate the transpose of the matrix that would be normally
1752* generated.
1753*
1754 ii = 1
1755*
1756 DO 90 iblk = 1, mblks
1757*
1758 IF( iblk.EQ.1 ) THEN
1759 ib = imbloc
1760 ELSE IF( iblk.EQ.mblks ) THEN
1761 ib = lmbloc
1762 ELSE
1763 ib = mb
1764 END IF
1765*
1766 DO 80 ik = ii, ii + ib - 1
1767*
1768 jj = 1
1769*
1770 DO 70 jblk = 1, nblks
1771*
1772 IF( jblk.EQ.1 ) THEN
1773 jb = inbloc
1774 ELSE IF( jblk.EQ.nblks ) THEN
1775 jb = lnbloc
1776 ELSE
1777 jb = nb
1778 END IF
1779*
1780* Blocks are IB by JB
1781*
1782 DO 60 jk = jj, jj + jb - 1
1783 a( ik, jk ) = cmplx( pb_srand( 0 ), pb_srand( 0 ) )
1784 60 CONTINUE
1785*
1786 jj = jj + jb
1787*
1788 IF( jblk.EQ.1 ) THEN
1789*
1790* Jump INBLOC + ( NPCOL - 1 ) * NB columns
1791*
1792 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
1793 $ ib0 )
1794*
1795 ELSE
1796*
1797* Jump NPCOL * NB columns
1798*
1799 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1, ib0 )
1800*
1801 END IF
1802*
1803 ib1( 1 ) = ib0( 1 )
1804 ib1( 2 ) = ib0( 2 )
1805*
1806 70 CONTINUE
1807*
1808* Jump one row
1809*
1810 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
1811*
1812 ib1( 1 ) = ib0( 1 )
1813 ib1( 2 ) = ib0( 2 )
1814 ib2( 1 ) = ib0( 1 )
1815 ib2( 2 ) = ib0( 2 )
1816*
1817 80 CONTINUE
1818*
1819 ii = ii + ib
1820*
1821 IF( iblk.EQ.1 ) THEN
1822*
1823* Jump IMBLOC + ( NPROW - 1 ) * MB rows
1824*
1825 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
1826*
1827 ELSE
1828*
1829* Jump NPROW * MB rows
1830*
1831 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
1832*
1833 END IF
1834*
1835 ib1( 1 ) = ib0( 1 )
1836 ib1( 2 ) = ib0( 2 )
1837 ib2( 1 ) = ib0( 1 )
1838 ib2( 2 ) = ib0( 2 )
1839 ib3( 1 ) = ib0( 1 )
1840 ib3( 2 ) = ib0( 2 )
1841*
1842 90 CONTINUE
1843*
1844 ELSE IF( lsame( aform, 'S' ) ) THEN
1845*
1846* Generate a symmetric matrix
1847*
1848 IF( lsame( uplo, 'L' ) ) THEN
1849*
1850* generate lower trapezoidal part
1851*
1852 jj = 1
1853 lcmtc = lcmt00
1854*
1855 DO 170 jblk = 1, nblks
1856*
1857 IF( jblk.EQ.1 ) THEN
1858 jb = inbloc
1859 low = 1 - inbloc
1860 ELSE IF( jblk.EQ.nblks ) THEN
1861 jb = lnbloc
1862 low = 1 - nb
1863 ELSE
1864 jb = nb
1865 low = 1 - nb
1866 END IF
1867*
1868 DO 160 jk = jj, jj + jb - 1
1869*
1870 ii = 1
1871 lcmtr = lcmtc
1872*
1873 DO 150 iblk = 1, mblks
1874*
1875 IF( iblk.EQ.1 ) THEN
1876 ib = imbloc
1877 upp = imbloc - 1
1878 ELSE IF( iblk.EQ.mblks ) THEN
1879 ib = lmbloc
1880 upp = mb - 1
1881 ELSE
1882 ib = mb
1883 upp = mb - 1
1884 END IF
1885*
1886* Blocks are IB by JB
1887*
1888 IF( lcmtr.GT.upp ) THEN
1889*
1890 DO 100 ik = ii, ii + ib - 1
1891 dummy = cmplx( pb_srand( 0 ),
1892 $ pb_srand( 0 ) )
1893 100 CONTINUE
1894*
1895 ELSE IF( lcmtr.GE.low ) THEN
1896*
1897 jtmp = jk - jj + 1
1898 mnb = max( 0, -lcmtr )
1899*
1900 IF( jtmp.LE.min( mnb, jb ) ) THEN
1901*
1902 DO 110 ik = ii, ii + ib - 1
1903 a( ik, jk ) = cmplx( pb_srand( 0 ),
1904 $ pb_srand( 0 ) )
1905 110 CONTINUE
1906*
1907 ELSE IF( ( jtmp.GE.( mnb + 1 ) ) .AND.
1908 $ ( jtmp.LE.min( ib-lcmtr, jb ) ) ) THEN
1909*
1910 itmp = ii + jtmp + lcmtr - 1
1911*
1912 DO 120 ik = ii, itmp - 1
1913 dummy = cmplx( pb_srand( 0 ),
1914 $ pb_srand( 0 ) )
1915 120 CONTINUE
1916*
1917 DO 130 ik = itmp, ii + ib - 1
1918 a( ik, jk ) = cmplx( pb_srand( 0 ),
1919 $ pb_srand( 0 ) )
1920 130 CONTINUE
1921*
1922 END IF
1923*
1924 ELSE
1925*
1926 DO 140 ik = ii, ii + ib - 1
1927 a( ik, jk ) = cmplx( pb_srand( 0 ),
1928 $ pb_srand( 0 ) )
1929 140 CONTINUE
1930*
1931 END IF
1932*
1933 ii = ii + ib
1934*
1935 IF( iblk.EQ.1 ) THEN
1936*
1937* Jump IMBLOC + ( NPROW - 1 ) * MB rows
1938*
1939 lcmtr = lcmtr - jmp( jmp_npimbloc )
1940 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
1941 $ ib0 )
1942*
1943 ELSE
1944*
1945* Jump NPROW * MB rows
1946*
1947 lcmtr = lcmtr - jmp( jmp_npmb )
1948 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1,
1949 $ ib0 )
1950*
1951 END IF
1952*
1953 ib1( 1 ) = ib0( 1 )
1954 ib1( 2 ) = ib0( 2 )
1955*
1956 150 CONTINUE
1957*
1958* Jump one column
1959*
1960 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
1961*
1962 ib1( 1 ) = ib0( 1 )
1963 ib1( 2 ) = ib0( 2 )
1964 ib2( 1 ) = ib0( 1 )
1965 ib2( 2 ) = ib0( 2 )
1966*
1967 160 CONTINUE
1968*
1969 jj = jj + jb
1970*
1971 IF( jblk.EQ.1 ) THEN
1972*
1973* Jump INBLOC + ( NPCOL - 1 ) * NB columns
1974*
1975 lcmtc = lcmtc + jmp( jmp_nqinbloc )
1976 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
1977*
1978 ELSE
1979*
1980* Jump NPCOL * NB columns
1981*
1982 lcmtc = lcmtc + jmp( jmp_nqnb )
1983 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
1984*
1985 END IF
1986*
1987 ib1( 1 ) = ib0( 1 )
1988 ib1( 2 ) = ib0( 2 )
1989 ib2( 1 ) = ib0( 1 )
1990 ib2( 2 ) = ib0( 2 )
1991 ib3( 1 ) = ib0( 1 )
1992 ib3( 2 ) = ib0( 2 )
1993*
1994 170 CONTINUE
1995*
1996 ELSE
1997*
1998* generate upper trapezoidal part
1999*
2000 ii = 1
2001 lcmtr = lcmt00
2002*
2003 DO 250 iblk = 1, mblks
2004*
2005 IF( iblk.EQ.1 ) THEN
2006 ib = imbloc
2007 upp = imbloc - 1
2008 ELSE IF( iblk.EQ.mblks ) THEN
2009 ib = lmbloc
2010 upp = mb - 1
2011 ELSE
2012 ib = mb
2013 upp = mb - 1
2014 END IF
2015*
2016 DO 240 ik = ii, ii + ib - 1
2017*
2018 jj = 1
2019 lcmtc = lcmtr
2020*
2021 DO 230 jblk = 1, nblks
2022*
2023 IF( jblk.EQ.1 ) THEN
2024 jb = inbloc
2025 low = 1 - inbloc
2026 ELSE IF( jblk.EQ.nblks ) THEN
2027 jb = lnbloc
2028 low = 1 - nb
2029 ELSE
2030 jb = nb
2031 low = 1 - nb
2032 END IF
2033*
2034* Blocks are IB by JB
2035*
2036 IF( lcmtc.LT.low ) THEN
2037*
2038 DO 180 jk = jj, jj + jb - 1
2039 dummy = cmplx( pb_srand( 0 ), pb_srand( 0 ) )
2040 180 CONTINUE
2041*
2042 ELSE IF( lcmtc.LE.upp ) THEN
2043*
2044 itmp = ik - ii + 1
2045 mnb = max( 0, lcmtc )
2046*
2047 IF( itmp.LE.min( mnb, ib ) ) THEN
2048*
2049 DO 190 jk = jj, jj + jb - 1
2050 a( ik, jk ) = cmplx( pb_srand( 0 ),
2051 $ pb_srand( 0 ) )
2052 190 CONTINUE
2053*
2054 ELSE IF( ( itmp.GE.( mnb + 1 ) ) .AND.
2055 $ ( itmp.LE.min( jb+lcmtc, ib ) ) ) THEN
2056*
2057 jtmp = jj + itmp - lcmtc - 1
2058*
2059 DO 200 jk = jj, jtmp - 1
2060 dummy = cmplx( pb_srand( 0 ),
2061 $ pb_srand( 0 ) )
2062 200 CONTINUE
2063*
2064 DO 210 jk = jtmp, jj + jb - 1
2065 a( ik, jk ) = cmplx( pb_srand( 0 ),
2066 $ pb_srand( 0 ) )
2067 210 CONTINUE
2068*
2069 END IF
2070*
2071 ELSE
2072*
2073 DO 220 jk = jj, jj + jb - 1
2074 a( ik, jk ) = cmplx( pb_srand( 0 ),
2075 $ pb_srand( 0 ) )
2076 220 CONTINUE
2077*
2078 END IF
2079*
2080 jj = jj + jb
2081*
2082 IF( jblk.EQ.1 ) THEN
2083*
2084* Jump INBLOC + ( NPCOL - 1 ) * NB columns
2085*
2086 lcmtc = lcmtc + jmp( jmp_nqinbloc )
2087 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
2088 $ ib0 )
2089*
2090 ELSE
2091*
2092* Jump NPCOL * NB columns
2093*
2094 lcmtc = lcmtc + jmp( jmp_nqnb )
2095 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
2096 $ ib0 )
2097*
2098 END IF
2099*
2100 ib1( 1 ) = ib0( 1 )
2101 ib1( 2 ) = ib0( 2 )
2102*
2103 230 CONTINUE
2104*
2105* Jump one row
2106*
2107 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
2108*
2109 ib1( 1 ) = ib0( 1 )
2110 ib1( 2 ) = ib0( 2 )
2111 ib2( 1 ) = ib0( 1 )
2112 ib2( 2 ) = ib0( 2 )
2113*
2114 240 CONTINUE
2115*
2116 ii = ii + ib
2117*
2118 IF( iblk.EQ.1 ) THEN
2119*
2120* Jump IMBLOC + ( NPROW - 1 ) * MB rows
2121*
2122 lcmtr = lcmtr - jmp( jmp_npimbloc )
2123 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
2124*
2125 ELSE
2126*
2127* Jump NPROW * MB rows
2128*
2129 lcmtr = lcmtr - jmp( jmp_npmb )
2130 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
2131*
2132 END IF
2133*
2134 ib1( 1 ) = ib0( 1 )
2135 ib1( 2 ) = ib0( 2 )
2136 ib2( 1 ) = ib0( 1 )
2137 ib2( 2 ) = ib0( 2 )
2138 ib3( 1 ) = ib0( 1 )
2139 ib3( 2 ) = ib0( 2 )
2140*
2141 250 CONTINUE
2142*
2143 END IF
2144*
2145 ELSE IF( lsame( aform, 'C' ) ) THEN
2146*
2147* Generate the conjugate transpose of the matrix that would be
2148* normally generated.
2149*
2150 ii = 1
2151*
2152 DO 290 iblk = 1, mblks
2153*
2154 IF( iblk.EQ.1 ) THEN
2155 ib = imbloc
2156 ELSE IF( iblk.EQ.mblks ) THEN
2157 ib = lmbloc
2158 ELSE
2159 ib = mb
2160 END IF
2161*
2162 DO 280 ik = ii, ii + ib - 1
2163*
2164 jj = 1
2165*
2166 DO 270 jblk = 1, nblks
2167*
2168 IF( jblk.EQ.1 ) THEN
2169 jb = inbloc
2170 ELSE IF( jblk.EQ.nblks ) THEN
2171 jb = lnbloc
2172 ELSE
2173 jb = nb
2174 END IF
2175*
2176* Blocks are IB by JB
2177*
2178 DO 260 jk = jj, jj + jb - 1
2179 a( ik, jk ) = cmplx( pb_srand( 0 ),
2180 $ -pb_srand( 0 ) )
2181 260 CONTINUE
2182*
2183 jj = jj + jb
2184*
2185 IF( jblk.EQ.1 ) THEN
2186*
2187* Jump INBLOC + ( NPCOL - 1 ) * NB columns
2188*
2189 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
2190 $ ib0 )
2191*
2192 ELSE
2193*
2194* Jump NPCOL * NB columns
2195*
2196 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
2197 $ ib0 )
2198*
2199 END IF
2200*
2201 ib1( 1 ) = ib0( 1 )
2202 ib1( 2 ) = ib0( 2 )
2203*
2204 270 CONTINUE
2205*
2206* Jump one row
2207*
2208 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
2209*
2210 ib1( 1 ) = ib0( 1 )
2211 ib1( 2 ) = ib0( 2 )
2212 ib2( 1 ) = ib0( 1 )
2213 ib2( 2 ) = ib0( 2 )
2214*
2215 280 CONTINUE
2216*
2217 ii = ii + ib
2218*
2219 IF( iblk.EQ.1 ) THEN
2220*
2221* Jump IMBLOC + ( NPROW - 1 ) * MB rows
2222*
2223 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
2224*
2225 ELSE
2226*
2227* Jump NPROW * MB rows
2228*
2229 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
2230*
2231 END IF
2232*
2233 ib1( 1 ) = ib0( 1 )
2234 ib1( 2 ) = ib0( 2 )
2235 ib2( 1 ) = ib0( 1 )
2236 ib2( 2 ) = ib0( 2 )
2237 ib3( 1 ) = ib0( 1 )
2238 ib3( 2 ) = ib0( 2 )
2239*
2240 290 CONTINUE
2241*
2242 ELSE IF( lsame( aform, 'H' ) ) THEN
2243*
2244* Generate a Hermitian matrix
2245*
2246 IF( lsame( uplo, 'L' ) ) THEN
2247*
2248* generate lower trapezoidal part
2249*
2250 jj = 1
2251 lcmtc = lcmt00
2252*
2253 DO 370 jblk = 1, nblks
2254*
2255 IF( jblk.EQ.1 ) THEN
2256 jb = inbloc
2257 low = 1 - inbloc
2258 ELSE IF( jblk.EQ.nblks ) THEN
2259 jb = lnbloc
2260 low = 1 - nb
2261 ELSE
2262 jb = nb
2263 low = 1 - nb
2264 END IF
2265*
2266 DO 360 jk = jj, jj + jb - 1
2267*
2268 ii = 1
2269 lcmtr = lcmtc
2270*
2271 DO 350 iblk = 1, mblks
2272*
2273 IF( iblk.EQ.1 ) THEN
2274 ib = imbloc
2275 upp = imbloc - 1
2276 ELSE IF( iblk.EQ.mblks ) THEN
2277 ib = lmbloc
2278 upp = mb - 1
2279 ELSE
2280 ib = mb
2281 upp = mb - 1
2282 END IF
2283*
2284* Blocks are IB by JB
2285*
2286 IF( lcmtr.GT.upp ) THEN
2287*
2288 DO 300 ik = ii, ii + ib - 1
2289 dummy = cmplx( pb_srand( 0 ),
2290 $ pb_srand( 0 ) )
2291 300 CONTINUE
2292*
2293 ELSE IF( lcmtr.GE.low ) THEN
2294*
2295 jtmp = jk - jj + 1
2296 mnb = max( 0, -lcmtr )
2297*
2298 IF( jtmp.LE.min( mnb, jb ) ) THEN
2299*
2300 DO 310 ik = ii, ii + ib - 1
2301 a( ik, jk ) = cmplx( pb_srand( 0 ),
2302 $ pb_srand( 0 ) )
2303 310 CONTINUE
2304*
2305 ELSE IF( ( jtmp.GE.( mnb + 1 ) ) .AND.
2306 $ ( jtmp.LE.min( ib-lcmtr, jb ) ) ) THEN
2307*
2308 itmp = ii + jtmp + lcmtr - 1
2309*
2310 DO 320 ik = ii, itmp - 1
2311 dummy = cmplx( pb_srand( 0 ),
2312 $ pb_srand( 0 ) )
2313 320 CONTINUE
2314*
2315 IF( itmp.LE.( ii + ib - 1 ) ) THEN
2316 dummy = cmplx( pb_srand( 0 ),
2317 $ -pb_srand( 0 ) )
2318 a( itmp, jk ) = cmplx( real( dummy ),
2319 $ zero )
2320 END IF
2321*
2322 DO 330 ik = itmp + 1, ii + ib - 1
2323 a( ik, jk ) = cmplx( pb_srand( 0 ),
2324 $ pb_srand( 0 ) )
2325 330 CONTINUE
2326*
2327 END IF
2328*
2329 ELSE
2330*
2331 DO 340 ik = ii, ii + ib - 1
2332 a( ik, jk ) = cmplx( pb_srand( 0 ),
2333 $ pb_srand( 0 ) )
2334 340 CONTINUE
2335*
2336 END IF
2337*
2338 ii = ii + ib
2339*
2340 IF( iblk.EQ.1 ) THEN
2341*
2342* Jump IMBLOC + ( NPROW - 1 ) * MB rows
2343*
2344 lcmtr = lcmtr - jmp( jmp_npimbloc )
2345 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
2346 $ ib0 )
2347*
2348 ELSE
2349*
2350* Jump NPROW * MB rows
2351*
2352 lcmtr = lcmtr - jmp( jmp_npmb )
2353 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1,
2354 $ ib0 )
2355*
2356 END IF
2357*
2358 ib1( 1 ) = ib0( 1 )
2359 ib1( 2 ) = ib0( 2 )
2360*
2361 350 CONTINUE
2362*
2363* Jump one column
2364*
2365 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
2366*
2367 ib1( 1 ) = ib0( 1 )
2368 ib1( 2 ) = ib0( 2 )
2369 ib2( 1 ) = ib0( 1 )
2370 ib2( 2 ) = ib0( 2 )
2371*
2372 360 CONTINUE
2373*
2374 jj = jj + jb
2375*
2376 IF( jblk.EQ.1 ) THEN
2377*
2378* Jump INBLOC + ( NPCOL - 1 ) * NB columns
2379*
2380 lcmtc = lcmtc + jmp( jmp_nqinbloc )
2381 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
2382*
2383 ELSE
2384*
2385* Jump NPCOL * NB columns
2386*
2387 lcmtc = lcmtc + jmp( jmp_nqnb )
2388 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
2389*
2390 END IF
2391*
2392 ib1( 1 ) = ib0( 1 )
2393 ib1( 2 ) = ib0( 2 )
2394 ib2( 1 ) = ib0( 1 )
2395 ib2( 2 ) = ib0( 2 )
2396 ib3( 1 ) = ib0( 1 )
2397 ib3( 2 ) = ib0( 2 )
2398*
2399 370 CONTINUE
2400*
2401 ELSE
2402*
2403* generate upper trapezoidal part
2404*
2405 ii = 1
2406 lcmtr = lcmt00
2407*
2408 DO 450 iblk = 1, mblks
2409*
2410 IF( iblk.EQ.1 ) THEN
2411 ib = imbloc
2412 upp = imbloc - 1
2413 ELSE IF( iblk.EQ.mblks ) THEN
2414 ib = lmbloc
2415 upp = mb - 1
2416 ELSE
2417 ib = mb
2418 upp = mb - 1
2419 END IF
2420*
2421 DO 440 ik = ii, ii + ib - 1
2422*
2423 jj = 1
2424 lcmtc = lcmtr
2425*
2426 DO 430 jblk = 1, nblks
2427*
2428 IF( jblk.EQ.1 ) THEN
2429 jb = inbloc
2430 low = 1 - inbloc
2431 ELSE IF( jblk.EQ.nblks ) THEN
2432 jb = lnbloc
2433 low = 1 - nb
2434 ELSE
2435 jb = nb
2436 low = 1 - nb
2437 END IF
2438*
2439* Blocks are IB by JB
2440*
2441 IF( lcmtc.LT.low ) THEN
2442*
2443 DO 380 jk = jj, jj + jb - 1
2444 dummy = cmplx( pb_srand( 0 ),
2445 $ -pb_srand( 0 ) )
2446 380 CONTINUE
2447*
2448 ELSE IF( lcmtc.LE.upp ) THEN
2449*
2450 itmp = ik - ii + 1
2451 mnb = max( 0, lcmtc )
2452*
2453 IF( itmp.LE.min( mnb, ib ) ) THEN
2454*
2455 DO 390 jk = jj, jj + jb - 1
2456 a( ik, jk ) = cmplx( pb_srand( 0 ),
2457 $ -pb_srand( 0 ) )
2458 390 CONTINUE
2459*
2460 ELSE IF( ( itmp.GE.( mnb + 1 ) ) .AND.
2461 $ ( itmp.LE.min( jb+lcmtc, ib ) ) ) THEN
2462*
2463 jtmp = jj + itmp - lcmtc - 1
2464*
2465 DO 400 jk = jj, jtmp - 1
2466 dummy = cmplx( pb_srand( 0 ),
2467 $ -pb_srand( 0 ) )
2468 400 CONTINUE
2469*
2470 IF( jtmp.LE.( jj + jb - 1 ) ) THEN
2471 dummy = cmplx( pb_srand( 0 ),
2472 $ -pb_srand( 0 ) )
2473 a( ik, jtmp ) = cmplx( real( dummy ),
2474 $ zero )
2475 END IF
2476*
2477 DO 410 jk = jtmp + 1, jj + jb - 1
2478 a( ik, jk ) = cmplx( pb_srand( 0 ),
2479 $ -pb_srand( 0 ) )
2480 410 CONTINUE
2481*
2482 END IF
2483*
2484 ELSE
2485*
2486 DO 420 jk = jj, jj + jb - 1
2487 a( ik, jk ) = cmplx( pb_srand( 0 ),
2488 $ -pb_srand( 0 ) )
2489 420 CONTINUE
2490*
2491 END IF
2492*
2493 jj = jj + jb
2494*
2495 IF( jblk.EQ.1 ) THEN
2496*
2497* Jump INBLOC + ( NPCOL - 1 ) * NB columns
2498*
2499 lcmtc = lcmtc + jmp( jmp_nqinbloc )
2500 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
2501 $ ib0 )
2502*
2503 ELSE
2504*
2505* Jump NPCOL * NB columns
2506*
2507 lcmtc = lcmtc + jmp( jmp_nqnb )
2508 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
2509 $ ib0 )
2510*
2511 END IF
2512*
2513 ib1( 1 ) = ib0( 1 )
2514 ib1( 2 ) = ib0( 2 )
2515*
2516 430 CONTINUE
2517*
2518* Jump one row
2519*
2520 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
2521*
2522 ib1( 1 ) = ib0( 1 )
2523 ib1( 2 ) = ib0( 2 )
2524 ib2( 1 ) = ib0( 1 )
2525 ib2( 2 ) = ib0( 2 )
2526*
2527 440 CONTINUE
2528*
2529 ii = ii + ib
2530*
2531 IF( iblk.EQ.1 ) THEN
2532*
2533* Jump IMBLOC + ( NPROW - 1 ) * MB rows
2534*
2535 lcmtr = lcmtr - jmp( jmp_npimbloc )
2536 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
2537*
2538 ELSE
2539*
2540* Jump NPROW * MB rows
2541*
2542 lcmtr = lcmtr - jmp( jmp_npmb )
2543 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
2544*
2545 END IF
2546*
2547 ib1( 1 ) = ib0( 1 )
2548 ib1( 2 ) = ib0( 2 )
2549 ib2( 1 ) = ib0( 1 )
2550 ib2( 2 ) = ib0( 2 )
2551 ib3( 1 ) = ib0( 1 )
2552 ib3( 2 ) = ib0( 2 )
2553*
2554 450 CONTINUE
2555*
2556 END IF
2557*
2558 END IF
2559*
2560 RETURN
2561*
2562* End of PB_CLAGEN
2563*
cmplx
float cmplx[2]
Definition pblas.h:136
pb_jumpit
subroutine pb_jumpit(muladd, irann, iranm)
Definition pblastst.f:4822
pb_srand
real function pb_srand(idumm)
Definition pcblastst.f:11490
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the call graph for this function: