OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pblastst.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine pvdimchk (ictxt, nout, n, matrix, ix, jx, descx, incx, info)
subroutine pmdimchk (ictxt, nout, m, n, matrix, ia, ja, desca, info)
subroutine pvdescchk (ictxt, nout, matrix, descx, dtx, mx, nx, imbx, inbx, mbx, nbx, rsrcx, csrcx, incx, mpx, nqx, iprex, imidx, ipostx, igap, gapmul, info)
subroutine pmdescchk (ictxt, nout, matrix, desca, dta, ma, na, imba, inba, mba, nba, rsrca, csrca, mpa, nqa, iprea, imida, iposta, igap, gapmul, info)
subroutine pchkpbe (ictxt, nout, sname, infot)
real function psdiff (x, y)
double precision function pddiff (x, y)
subroutine pxerbla (ictxt, srname, info)
logical function lsame (ca, cb)
logical function lsamen (n, ca, cb)
subroutine icopy (n, sx, incx, sy, incy)
integer function pb_noabort (cinfo)
subroutine pb_infog2l (i, j, desc, nprow, npcol, myrow, mycol, ii, jj, prow, pcol)
subroutine pb_ainfog2l (m, n, i, j, desc, nprow, npcol, myrow, mycol, imb1, inb1, mp, nq, ii, jj, prow, pcol, rprow, rpcol)
integer function pb_numroc (n, i, inb, nb, proc, srcproc, nprocs)
integer function pb_fceil (num, denom)
subroutine pb_chkmat (ictxt, m, mpos0, n, npos0, ia, ja, desca, dpos0, info)
subroutine pb_desctrans (descin, descout)
subroutine pb_descset2 (desc, m, n, imb, inb, mb, nb, rsrc, csrc, ctxt, lld)
subroutine pb_descinit2 (desc, m, n, imb, inb, mb, nb, rsrc, csrc, ctxt, lld, info)
subroutine pb_binfo (offd, m, n, imb1, inb1, mb, nb, mrrow, mrcol, lcmt00, mblks, nblks, imbloc, inbloc, lmbloc, lnbloc, ilow, low, iupp, upp)
integer function pilaenv (ictxt, prec)
subroutine pb_locinfo (i, inb, nb, myroc, srcproc, nprocs, ilocblk, ilocoff, mydist)
subroutine pb_initjmp (colmaj, nvir, imbvir, inbvir, imbloc, inbloc, mb, nb, rsrc, csrc, nprow, npcol, stride, jmp)
subroutine pb_initmuladd (muladd0, jmp, imuladd)
subroutine pb_setlocran (seed, ilocblk, jlocblk, ilocoff, jlocoff, myrdist, mycdist, nprow, npcol, jmp, imuladd, iran)
subroutine pb_ladd (j, k, i)
subroutine pb_lmul (k, j, i)
subroutine pb_jump (k, muladd, irann, iranm, ima)
subroutine pb_setran (iran, iac)
subroutine pb_jumpit (muladd, irann, iranm)

Function/Subroutine Documentation

◆ icopy()

subroutine icopy ( integer n,
integer, dimension( * ) sx,
integer incx,
integer, dimension( * ) sy,
integer incy )

Definition at line 1524 of file pblastst.f.

1525*
1526* -- LAPACK auxiliary test routine (version 2.1) --
1527* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
1528* Courant Institute, Argonne National Lab, and Rice University
1529* February 29, 1992
1530*
1531* .. Scalar Arguments ..
1532 INTEGER INCX, INCY, N
1533* ..
1534* .. Array Arguments ..
1535 INTEGER SX( * ), SY( * )
1536* ..
1537*
1538* Purpose
1539* =======
1540*
1541* ICOPY copies an integer vector x to an integer vector y.
1542* Uses unrolled loops for increments equal to 1.
1543*
1544* Arguments
1545* =========
1546*
1547* N (input) INTEGER
1548* The length of the vectors SX and SY.
1549*
1550* SX (input) INTEGER array, dimension (1+(N-1)*abs(INCX))
1551* The vector X.
1552*
1553* INCX (input) INTEGER
1554* The spacing between consecutive elements of SX.
1555*
1556* SY (output) INTEGER array, dimension (1+(N-1)*abs(INCY))
1557* The vector Y.
1558*
1559* INCY (input) INTEGER
1560* The spacing between consecutive elements of SY.
1561*
1562* =====================================================================
1563*
1564* .. Local Scalars ..
1565 INTEGER I, IX, IY, M, MP1
1566* ..
1567* .. Intrinsic Functions ..
1568 INTRINSIC mod
1569* ..
1570* .. Executable Statements ..
1571*
1572 IF( n.LE.0 )
1573 $ RETURN
1574 IF( incx.EQ.1 .AND. incy.EQ.1 )
1575 $ GO TO 20
1576*
1577* Code for unequal increments or equal increments not equal to 1
1578*
1579 ix = 1
1580 iy = 1
1581 IF( incx.LT.0 )
1582 $ ix = ( -n+1 )*incx + 1
1583 IF( incy.LT.0 )
1584 $ iy = ( -n+1 )*incy + 1
1585 DO 10 i = 1, n
1586 sy( iy ) = sx( ix )
1587 ix = ix + incx
1588 iy = iy + incy
1589 10 CONTINUE
1590 RETURN
1591*
1592* Code for both increments equal to 1
1593*
1594* Clean-up loop
1595*
1596 20 CONTINUE
1597 m = mod( n, 7 )
1598 IF( m.EQ.0 )
1599 $ GO TO 40
1600 DO 30 i = 1, m
1601 sy( i ) = sx( i )
1602 30 CONTINUE
1603 IF( n.LT.7 )
1604 $ RETURN
1605 40 CONTINUE
1606 mp1 = m + 1
1607 DO 50 i = mp1, n, 7
1608 sy( i ) = sx( i )
1609 sy( i+1 ) = sx( i+1 )
1610 sy( i+2 ) = sx( i+2 )
1611 sy( i+3 ) = sx( i+3 )
1612 sy( i+4 ) = sx( i+4 )
1613 sy( i+5 ) = sx( i+5 )
1614 sy( i+6 ) = sx( i+6 )
1615 50 CONTINUE
1616 RETURN
1617*
1618* End of ICOPY
1619*

◆ lsame()

logical function lsame ( character ca,
character cb )

Definition at line 1369 of file pblastst.f.

1370*
1371* -- LAPACK auxiliary routine (version 2.1) --
1372* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
1373* Courant Institute, Argonne National Lab, and Rice University
1374* September 30, 1994
1375*
1376* .. Scalar Arguments ..
1377 CHARACTER CA, CB
1378* ..
1379*
1380* Purpose
1381* =======
1382*
1383* LSAME returns .TRUE. if CA is the same letter as CB regardless of
1384* case.
1385*
1386* Arguments
1387* =========
1388*
1389* CA (input) CHARACTER*1
1390* CB (input) CHARACTER*1
1391* CA and CB specify the single characters to be compared.
1392*
1393* =====================================================================
1394*
1395* .. Intrinsic Functions ..
1396 INTRINSIC ichar
1397* ..
1398* .. Local Scalars ..
1399 INTEGER INTA, INTB, ZCODE
1400* ..
1401* .. Executable Statements ..
1402*
1403* Test if the characters are equal
1404*
1405 lsame = ca.EQ.cb
1406 IF( lsame )
1407 $ RETURN
1408*
1409* Now test for equivalence if both characters are alphabetic.
1410*
1411 zcode = ichar( 'Z' )
1412*
1413* Use 'Z' rather than 'A' so that ASCII can be detected on Prime
1414* machines, on which ICHAR returns a value with bit 8 set.
1415* ICHAR('A') on Prime machines returns 193 which is the same as
1416* ICHAR('A') on an EBCDIC machine.
1417*
1418 inta = ichar( ca )
1419 intb = ichar( cb )
1420*
1421 IF( zcode.EQ.90 .OR. zcode.EQ.122 ) THEN
1422*
1423* ASCII is assumed - ZCODE is the ASCII code of either lower or
1424* upper case 'Z'.
1425*
1426 IF( inta.GE.97 .AND. inta.LE.122 ) inta = inta - 32
1427 IF( intb.GE.97 .AND. intb.LE.122 ) intb = intb - 32
1428*
1429 ELSE IF( zcode.EQ.233 .OR. zcode.EQ.169 ) THEN
1430*
1431* EBCDIC is assumed - ZCODE is the EBCDIC code of either lower or
1432* upper case 'Z'.
1433*
1434 IF( inta.GE.129 .AND. inta.LE.137 .OR.
1435 $ inta.GE.145 .AND. inta.LE.153 .OR.
1436 $ inta.GE.162 .AND. inta.LE.169 ) inta = inta + 64
1437 IF( intb.GE.129 .AND. intb.LE.137 .OR.
1438 $ intb.GE.145 .AND. intb.LE.153 .OR.
1439 $ intb.GE.162 .AND. intb.LE.169 ) intb = intb + 64
1440*
1441 ELSE IF( zcode.EQ.218 .OR. zcode.EQ.250 ) THEN
1442*
1443* ASCII is assumed, on Prime machines - ZCODE is the ASCII code
1444* plus 128 of either lower or upper case 'Z'.
1445*
1446 IF( inta.GE.225 .AND. inta.LE.250 ) inta = inta - 32
1447 IF( intb.GE.225 .AND. intb.LE.250 ) intb = intb - 32
1448 END IF
1449 lsame = inta.EQ.intb
1450*
1451* RETURN
1452*
1453* End of LSAME
1454*
lsame
logical function lsame(ca, cb)
Definition pblastst.f:1370

◆ lsamen()

logical function lsamen ( integer n,
character*( * ) ca,
character*( * ) cb )

Definition at line 1456 of file pblastst.f.

1457*
1458* -- LAPACK auxiliary routine (version 2.1) --
1459* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
1460* Courant Institute, Argonne National Lab, and Rice University
1461* September 30, 1994
1462*
1463* .. Scalar Arguments ..
1464 CHARACTER*( * ) CA, CB
1465 INTEGER N
1466* ..
1467*
1468* Purpose
1469* =======
1470*
1471* LSAMEN tests if the first N letters of CA are the same as the
1472* first N letters of CB, regardless of case.
1473* LSAMEN returns .TRUE. if CA and CB are equivalent except for case
1474* and .FALSE. otherwise. LSAMEN also returns .FALSE. if LEN( CA )
1475* or LEN( CB ) is less than N.
1476*
1477* Arguments
1478* =========
1479*
1480* N (input) INTEGER
1481* The number of characters in CA and CB to be compared.
1482*
1483* CA (input) CHARACTER*(*)
1484* CB (input) CHARACTER*(*)
1485* CA and CB specify two character strings of length at least N.
1486* Only the first N characters of each string will be accessed.
1487*
1488* =====================================================================
1489*
1490* .. Local Scalars ..
1491 INTEGER I
1492* ..
1493* .. External Functions ..
1494 LOGICAL LSAME
1495 EXTERNAL lsame
1496* ..
1497* .. Intrinsic Functions ..
1498 INTRINSIC len
1499* ..
1500* .. Executable Statements ..
1501*
1502 lsamen = .false.
1503 IF( len( ca ).LT.n .OR. len( cb ).LT.n )
1504 $ GO TO 20
1505*
1506* Do for each character in the two strings.
1507*
1508 DO 10 i = 1, n
1509*
1510* Test if the characters are equal using LSAME.
1511*
1512 IF( .NOT.lsame( ca( i: i ), cb( i: i ) ) )
1513 $ GO TO 20
1514*
1515 10 CONTINUE
1516 lsamen = .true.
1517*
1518 20 CONTINUE
1519 RETURN
1520*
1521* End of LSAMEN
1522*
lsamen
logical function lsamen(n, ca, cb)
Definition pblastst.f:1457

◆ pb_ainfog2l()

subroutine pb_ainfog2l ( integer m,
integer n,
integer i,
integer j,
integer, dimension( * ) desc,
integer nprow,
integer npcol,
integer myrow,
integer mycol,
integer imb1,
integer inb1,
integer mp,
integer nq,
integer ii,
integer jj,
integer prow,
integer pcol,
integer rprow,
integer rpcol )

Definition at line 2020 of file pblastst.f.

2023*
2024* -- PBLAS test routine (version 2.0) --
2025* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2026* and University of California, Berkeley.
2027* April 1, 1998
2028*
2029* .. Scalar Arguments ..
2030 INTEGER I, II, IMB1, INB1, J, JJ, M, MP, MYCOL, MYROW,
2031 $ N, NPCOL, NPROW, NQ, PCOL, PROW, RPCOL, RPROW
2032* ..
2033* .. Array Arguments ..
2034 INTEGER DESC( * )
2035* ..
2036*
2037* Purpose
2038* =======
2039*
2040* PB_AINFOG2L computes the starting local row and column indexes II,
2041* JJ corresponding to the submatrix starting globally at the entry
2042* pointed by I, J. This routine returns the coordinates in the grid of
2043* the process owning the matrix entry of global indexes I, J, namely
2044* PROW and PCOL. In addition, this routine computes the quantities MP
2045* and NQ, which are respectively the local number of rows and columns
2046* owned by the process of coordinate MYROW, MYCOL corresponding to the
2047* global submatrix A(I:I+M-1,J:J+N-1). Finally, the size of the first
2048* partial block and the relative process coordinates are also returned
2049* respectively in IMB, INB and RPROW, RPCOL.
2050*
2051* Notes
2052* =====
2053*
2054* A description vector is associated with each 2D block-cyclicly dis-
2055* tributed matrix. This vector stores the information required to
2056* establish the mapping between a matrix entry and its corresponding
2057* process and memory location.
2058*
2059* In the following comments, the character _ should be read as
2060* "of the distributed matrix". Let A be a generic term for any 2D
2061* block cyclicly distributed matrix. Its description vector is DESCA:
2062*
2063* NOTATION STORED IN EXPLANATION
2064* ---------------- --------------- ------------------------------------
2065* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
2066* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
2067* the NPROW x NPCOL BLACS process grid
2068* A is distributed over. The context
2069* itself is global, but the handle
2070* (the integer value) may vary.
2071* M_A (global) DESCA( M_ ) The number of rows in the distribu-
2072* ted matrix A, M_A >= 0.
2073* N_A (global) DESCA( N_ ) The number of columns in the distri-
2074* buted matrix A, N_A >= 0.
2075* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
2076* block of the matrix A, IMB_A > 0.
2077* INB_A (global) DESCA( INB_ ) The number of columns of the upper
2078* left block of the matrix A,
2079* INB_A > 0.
2080* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
2081* bute the last M_A-IMB_A rows of A,
2082* MB_A > 0.
2083* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
2084* bute the last N_A-INB_A columns of
2085* A, NB_A > 0.
2086* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
2087* row of the matrix A is distributed,
2088* NPROW > RSRC_A >= 0.
2089* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
2090* first column of A is distributed.
2091* NPCOL > CSRC_A >= 0.
2092* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
2093* array storing the local blocks of
2094* the distributed matrix A,
2095* IF( Lc( 1, N_A ) > 0 )
2096* LLD_A >= MAX( 1, Lr( 1, M_A ) )
2097* ELSE
2098* LLD_A >= 1.
2099*
2100* Let K be the number of rows of a matrix A starting at the global in-
2101* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
2102* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
2103* receive if these K rows were distributed over NPROW processes. If K
2104* is the number of columns of a matrix A starting at the global index
2105* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
2106* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
2107* these K columns were distributed over NPCOL processes.
2108*
2109* The values of Lr() and Lc() may be determined via a call to the func-
2110* tion PB_NUMROC:
2111* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
2112* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
2113*
2114* Arguments
2115* =========
2116*
2117* M (global input) INTEGER
2118* On entry, M specifies the global number of rows of the subma-
2119* trix. M must be at least zero.
2120*
2121* N (global input) INTEGER
2122* On entry, N specifies the global number of columns of the
2123* submatrix. N must be at least zero.
2124*
2125* I (global input) INTEGER
2126* On entry, I specifies the global starting row index of the
2127* submatrix. I must at least one.
2128*
2129* J (global input) INTEGER
2130* On entry, J specifies the global starting column index of
2131* the submatrix. J must at least one.
2132*
2133* DESC (global and local input) INTEGER array
2134* On entry, DESC is an integer array of dimension DLEN_. This
2135* is the array descriptor of the underlying matrix.
2136*
2137* NPROW (global input) INTEGER
2138* On entry, NPROW specifies the total number of process rows
2139* over which the matrix is distributed. NPROW must be at least
2140* one.
2141*
2142* NPCOL (global input) INTEGER
2143* On entry, NPCOL specifies the total number of process columns
2144* over which the matrix is distributed. NPCOL must be at least
2145* one.
2146*
2147* MYROW (local input) INTEGER
2148* On entry, MYROW specifies the row coordinate of the process
2149* whose local index II is determined. MYROW must be at least
2150* zero and strictly less than NPROW.
2151*
2152* MYCOL (local input) INTEGER
2153* On entry, MYCOL specifies the column coordinate of the pro-
2154* cess whose local index JJ is determined. MYCOL must be at
2155* least zero and strictly less than NPCOL.
2156*
2157* IMB1 (global output) INTEGER
2158* On exit, IMB1 specifies the number of rows of the upper left
2159* block of the submatrix. On exit, IMB1 is less or equal than
2160* M and greater or equal than MIN( 1, M ).
2161*
2162* INB1 (global output) INTEGER
2163* On exit, INB1 specifies the number of columns of the upper
2164* left block of the submatrix. On exit, INB1 is less or equal
2165* than N and greater or equal than MIN( 1, N ).
2166*
2167* MP (local output) INTEGER
2168* On exit, MP specifies the local number of rows of the subma-
2169* trix, that the processes of row coordinate MYROW own. MP is
2170* at least zero.
2171*
2172* NQ (local output) INTEGER
2173* On exit, NQ specifies the local number of columns of the
2174* submatrix, that the processes of column coordinate MYCOL
2175* own. NQ is at least zero.
2176*
2177* II (local output) INTEGER
2178* On exit, II specifies the local starting row index of the
2179* submatrix. On exit, II is at least one.
2180*
2181* JJ (local output) INTEGER
2182* On exit, JJ specifies the local starting column index of
2183* the submatrix. On exit, II is at least one.
2184*
2185* PROW (global output) INTEGER
2186* On exit, PROW specifies the row coordinate of the process
2187* that possesses the first row of the submatrix. On exit, PROW
2188* is -1 if DESC(RSRC_) is -1 on input, and, at least zero and
2189* strictly less than NPROW otherwise.
2190*
2191* PCOL (global output) INTEGER
2192* On exit, PCOL specifies the column coordinate of the process
2193* that possesses the first column of the submatrix. On exit,
2194* PCOL is -1 if DESC(CSRC_) is -1 on input, and, at least zero
2195* and strictly less than NPCOL otherwise.
2196*
2197* RPROW (global output) INTEGER
2198* On exit, RPROW specifies the relative row coordinate of the
2199* process that possesses the first row I of the submatrix. On
2200* exit, RPROW is -1 if DESC(RSRC_) is -1 on input, and, at
2201* least zero and strictly less than NPROW otherwise.
2202*
2203* RPCOL (global output) INTEGER
2204* On exit, RPCOL specifies the relative column coordinate of
2205* the process that possesses the first column J of the subma-
2206* trix. On exit, RPCOL is -1 if DESC(CSRC_) is -1 on input,
2207* and, at least zero and strictly less than NPCOL otherwise.
2208*
2209* -- Written on April 1, 1998 by
2210* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2211*
2212* =====================================================================
2213*
2214* .. Parameters ..
2215 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2216 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2217 $ RSRC_
2218 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2219 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2220 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2221 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2222* ..
2223* .. Local Scalars ..
2224 INTEGER CSRC, I1, ILOCBLK, J1, M1, MB, MYDIST, N1, NB,
2225 $ NBLOCKS, RSRC
2226* ..
2227* .. Local Arrays ..
2228 INTEGER DESC2( DLEN_ )
2229* ..
2230* .. External Subroutines ..
2231 EXTERNAL pb_desctrans
2232* ..
2233* .. Intrinsic Functions ..
2234 INTRINSIC min
2235* ..
2236* .. Executable Statements ..
2237*
2238* Convert descriptor
2239*
2240 CALL pb_desctrans( desc, desc2 )
2241*
2242 mb = desc2( mb_ )
2243 imb1 = desc2( imb_ )
2244 rsrc = desc2( rsrc_ )
2245*
2246 IF( ( rsrc.EQ.-1 ).OR.( nprow.EQ.1 ) ) THEN
2247*
2248 ii = i
2249 imb1 = imb1 - i + 1
2250 IF( imb1.LE.0 )
2251 $ imb1 = ( ( -imb1 ) / mb + 1 ) * mb + imb1
2252 imb1 = min( imb1, m )
2253 mp = m
2254 prow = rsrc
2255 rprow = 0
2256*
2257 ELSE
2258*
2259* Figure out PROW, II and IMB1 first
2260*
2261 IF( i.LE.imb1 ) THEN
2262*
2263 prow = rsrc
2264*
2265 IF( myrow.EQ.prow ) THEN
2266 ii = i
2267 ELSE
2268 ii = 1
2269 END IF
2270*
2271 imb1 = imb1 - i + 1
2272*
2273 ELSE
2274*
2275 i1 = i - imb1 - 1
2276 nblocks = i1 / mb + 1
2277 prow = rsrc + nblocks
2278 prow = prow - ( prow / nprow ) * nprow
2279*
2280 IF( myrow.EQ.rsrc ) THEN
2281*
2282 ilocblk = nblocks / nprow
2283*
2284 IF( ilocblk.GT.0 ) THEN
2285 IF( ( ilocblk*nprow ).GE.nblocks ) THEN
2286 IF( myrow.EQ.prow ) THEN
2287 ii = i + ( ilocblk - nblocks ) * mb
2288 ELSE
2289 ii = imb1 + ( ilocblk - 1 ) * mb + 1
2290 END IF
2291 ELSE
2292 ii = imb1 + ilocblk * mb + 1
2293 END IF
2294 ELSE
2295 ii = imb1 + 1
2296 END IF
2297*
2298 ELSE
2299*
2300 mydist = myrow - rsrc
2301 IF( mydist.LT.0 )
2302 $ mydist = mydist + nprow
2303*
2304 ilocblk = nblocks / nprow
2305*
2306 IF( ilocblk.GT.0 ) THEN
2307 mydist = mydist - nblocks + ilocblk * nprow
2308 IF( mydist.LT.0 ) THEN
2309 ii = ( ilocblk + 1 ) * mb + 1
2310 ELSE IF( myrow.EQ.prow ) THEN
2311 ii = i1 + ( ilocblk - nblocks + 1 ) * mb + 1
2312 ELSE
2313 ii = ilocblk * mb + 1
2314 END IF
2315 ELSE
2316 mydist = mydist - nblocks
2317 IF( mydist.LT.0 ) THEN
2318 ii = mb + 1
2319 ELSE IF( myrow.EQ.prow ) THEN
2320 ii = i1 + ( 1 - nblocks ) * mb + 1
2321 ELSE
2322 ii = 1
2323 END IF
2324 END IF
2325 END IF
2326*
2327 imb1 = nblocks * mb - i1
2328*
2329 END IF
2330*
2331* Figure out MP
2332*
2333 IF( m.LE.imb1 ) THEN
2334*
2335 IF( myrow.EQ.prow ) THEN
2336 mp = m
2337 ELSE
2338 mp = 0
2339 END IF
2340*
2341 ELSE
2342*
2343 m1 = m - imb1
2344 nblocks = m1 / mb + 1
2345*
2346 IF( myrow.EQ.prow ) THEN
2347 ilocblk = nblocks / nprow
2348 IF( ilocblk.GT.0 ) THEN
2349 IF( ( nblocks - ilocblk * nprow ).GT.0 ) THEN
2350 mp = imb1 + ilocblk * mb
2351 ELSE
2352 mp = m + mb * ( ilocblk - nblocks )
2353 END IF
2354 ELSE
2355 mp = imb1
2356 END IF
2357 ELSE
2358 mydist = myrow - prow
2359 IF( mydist.LT.0 )
2360 $ mydist = mydist + nprow
2361 ilocblk = nblocks / nprow
2362 IF( ilocblk.GT.0 ) THEN
2363 mydist = mydist - nblocks + ilocblk * nprow
2364 IF( mydist.LT.0 ) THEN
2365 mp = ( ilocblk + 1 ) * mb
2366 ELSE IF( mydist.GT.0 ) THEN
2367 mp = ilocblk * mb
2368 ELSE
2369 mp = m1 + mb * ( ilocblk - nblocks + 1 )
2370 END IF
2371 ELSE
2372 mydist = mydist - nblocks
2373 IF( mydist.LT.0 ) THEN
2374 mp = mb
2375 ELSE IF( mydist.GT.0 ) THEN
2376 mp = 0
2377 ELSE
2378 mp = m1 + mb * ( 1 - nblocks )
2379 END IF
2380 END IF
2381 END IF
2382*
2383 END IF
2384*
2385 imb1 = min( imb1, m )
2386 rprow = myrow - prow
2387 IF( rprow.LT.0 )
2388 $ rprow = rprow + nprow
2389*
2390 END IF
2391*
2392 nb = desc2( nb_ )
2393 inb1 = desc2( inb_ )
2394 csrc = desc2( csrc_ )
2395*
2396 IF( ( csrc.EQ.-1 ).OR.( npcol.EQ.1 ) ) THEN
2397*
2398 jj = j
2399 inb1 = inb1 - i + 1
2400 IF( inb1.LE.0 )
2401 $ inb1 = ( ( -inb1 ) / nb + 1 ) * nb + inb1
2402 inb1 = min( inb1, n )
2403 nq = n
2404 pcol = csrc
2405 rpcol = 0
2406*
2407 ELSE
2408*
2409* Figure out PCOL, JJ and INB1 first
2410*
2411 IF( j.LE.inb1 ) THEN
2412*
2413 pcol = csrc
2414*
2415 IF( mycol.EQ.pcol ) THEN
2416 jj = j
2417 ELSE
2418 jj = 1
2419 END IF
2420*
2421 inb1 = inb1 - j + 1
2422*
2423 ELSE
2424*
2425 j1 = j - inb1 - 1
2426 nblocks = j1 / nb + 1
2427 pcol = csrc + nblocks
2428 pcol = pcol - ( pcol / npcol ) * npcol
2429*
2430 IF( mycol.EQ.csrc ) THEN
2431*
2432 ilocblk = nblocks / npcol
2433*
2434 IF( ilocblk.GT.0 ) THEN
2435 IF( ( ilocblk*npcol ).GE.nblocks ) THEN
2436 IF( mycol.EQ.pcol ) THEN
2437 jj = j + ( ilocblk - nblocks ) * nb
2438 ELSE
2439 jj = inb1 + ( ilocblk - 1 ) * nb + 1
2440 END IF
2441 ELSE
2442 jj = inb1 + ilocblk * nb + 1
2443 END IF
2444 ELSE
2445 jj = inb1 + 1
2446 END IF
2447*
2448 ELSE
2449*
2450 mydist = mycol - csrc
2451 IF( mydist.LT.0 )
2452 $ mydist = mydist + npcol
2453*
2454 ilocblk = nblocks / npcol
2455*
2456 IF( ilocblk.GT.0 ) THEN
2457 mydist = mydist - nblocks + ilocblk * npcol
2458 IF( mydist.LT.0 ) THEN
2459 jj = ( ilocblk + 1 ) * nb + 1
2460 ELSE IF( mycol.EQ.pcol ) THEN
2461 jj = j1 + ( ilocblk - nblocks + 1 ) * nb + 1
2462 ELSE
2463 jj = ilocblk * nb + 1
2464 END IF
2465 ELSE
2466 mydist = mydist - nblocks
2467 IF( mydist.LT.0 ) THEN
2468 jj = nb + 1
2469 ELSE IF( mycol.EQ.pcol ) THEN
2470 jj = j1 + ( 1 - nblocks ) * nb + 1
2471 ELSE
2472 jj = 1
2473 END IF
2474 END IF
2475 END IF
2476*
2477 inb1 = nblocks * nb - j1
2478*
2479 END IF
2480*
2481* Figure out NQ
2482*
2483 IF( n.LE.inb1 ) THEN
2484*
2485 IF( mycol.EQ.pcol ) THEN
2486 nq = n
2487 ELSE
2488 nq = 0
2489 END IF
2490*
2491 ELSE
2492*
2493 n1 = n - inb1
2494 nblocks = n1 / nb + 1
2495*
2496 IF( mycol.EQ.pcol ) THEN
2497 ilocblk = nblocks / npcol
2498 IF( ilocblk.GT.0 ) THEN
2499 IF( ( nblocks - ilocblk * npcol ).GT.0 ) THEN
2500 nq = inb1 + ilocblk * nb
2501 ELSE
2502 nq = n + nb * ( ilocblk - nblocks )
2503 END IF
2504 ELSE
2505 nq = inb1
2506 END IF
2507 ELSE
2508 mydist = mycol - pcol
2509 IF( mydist.LT.0 )
2510 $ mydist = mydist + npcol
2511 ilocblk = nblocks / npcol
2512 IF( ilocblk.GT.0 ) THEN
2513 mydist = mydist - nblocks + ilocblk * npcol
2514 IF( mydist.LT.0 ) THEN
2515 nq = ( ilocblk + 1 ) * nb
2516 ELSE IF( mydist.GT.0 ) THEN
2517 nq = ilocblk * nb
2518 ELSE
2519 nq = n1 + nb * ( ilocblk - nblocks + 1 )
2520 END IF
2521 ELSE
2522 mydist = mydist - nblocks
2523 IF( mydist.LT.0 ) THEN
2524 nq = nb
2525 ELSE IF( mydist.GT.0 ) THEN
2526 nq = 0
2527 ELSE
2528 nq = n1 + nb * ( 1 - nblocks )
2529 END IF
2530 END IF
2531 END IF
2532*
2533 END IF
2534*
2535 inb1 = min( inb1, n )
2536 rpcol = mycol - pcol
2537 IF( rpcol.LT.0 )
2538 $ rpcol = rpcol + npcol
2539*
2540 END IF
2541*
2542 RETURN
2543*
2544* End of PB_AINFOG2L
2545*
min
#define min(a, b)
Definition macros.h:20
pb_desctrans
subroutine pb_desctrans(descin, descout)
Definition pblastst.f:2964

◆ pb_binfo()

subroutine pb_binfo ( integer offd,
integer m,
integer n,
integer imb1,
integer inb1,
integer mb,
integer nb,
integer mrrow,
integer mrcol,
integer lcmt00,
integer mblks,
integer nblks,
integer imbloc,
integer inbloc,
integer lmbloc,
integer lnbloc,
integer ilow,
integer low,
integer iupp,
integer upp )

Definition at line 3574 of file pblastst.f.

3577*
3578* -- PBLAS test routine (version 2.0) --
3579* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
3580* and University of California, Berkeley.
3581* April 1, 1998
3582*
3583* .. Scalar Arguments ..
3584 INTEGER ILOW, IMB1, IMBLOC, INB1, INBLOC, IUPP, LCMT00,
3585 $ LMBLOC, LNBLOC, LOW, M, MB, MBLKS, MRCOL,
3586 $ MRROW, N, NB, NBLKS, OFFD, UPP
3587* ..
3588*
3589* Purpose
3590* =======
3591*
3592* PB_BINFO initializes the local information of an m by n local array
3593* owned by the process of relative coordinates ( MRROW, MRCOL ). Note
3594* that if m or n is less or equal than zero, there is no data, in which
3595* case this process does not need the local information computed by
3596* this routine to proceed.
3597*
3598* Arguments
3599* =========
3600*
3601* OFFD (global input) INTEGER
3602* On entry, OFFD specifies the off-diagonal of the underlying
3603* matrix of interest as follows:
3604* OFFD = 0 specifies the main diagonal,
3605* OFFD > 0 specifies lower subdiagonals, and
3606* OFFD < 0 specifies upper superdiagonals.
3607*
3608* M (local input) INTEGER
3609* On entry, M specifies the local number of rows of the under-
3610* lying matrix owned by the process of relative coordinates
3611* ( MRROW, MRCOL ). M must be at least zero.
3612*
3613* N (local input) INTEGER
3614* On entry, N specifies the local number of columns of the un-
3615* derlying matrix owned by the process of relative coordinates
3616* ( MRROW, MRCOL ). N must be at least zero.
3617*
3618* IMB1 (global input) INTEGER
3619* On input, IMB1 specifies the global true size of the first
3620* block of rows of the underlying global submatrix. IMB1 must
3621* be at least MIN( 1, M ).
3622*
3623* INB1 (global input) INTEGER
3624* On input, INB1 specifies the global true size of the first
3625* block of columns of the underlying global submatrix. INB1
3626* must be at least MIN( 1, N ).
3627*
3628* MB (global input) INTEGER
3629* On entry, MB specifies the blocking factor used to partition
3630* the rows of the matrix. MB must be at least one.
3631*
3632* NB (global input) INTEGER
3633* On entry, NB specifies the blocking factor used to partition
3634* the the columns of the matrix. NB must be at least one.
3635*
3636* MRROW (local input) INTEGER
3637* On entry, MRROW specifies the relative row coordinate of the
3638* process that possesses these M rows. MRROW must be least zero
3639* and strictly less than NPROW.
3640*
3641* MRCOL (local input) INTEGER
3642* On entry, MRCOL specifies the relative column coordinate of
3643* the process that possesses these N columns. MRCOL must be
3644* least zero and strictly less than NPCOL.
3645*
3646* LCMT00 (local output) INTEGER
3647* On exit, LCMT00 is the LCM value of the left upper block of
3648* this m by n local block owned by the process of relative co-
3649* ordinates ( MRROW, MRCOL ).
3650*
3651* MBLKS (local output) INTEGER
3652* On exit, MBLKS specifies the local number of blocks of rows
3653* corresponding to M. MBLKS must be at least zero.
3654*
3655* NBLKS (local output) INTEGER
3656* On exit, NBLKS specifies the local number of blocks of co-
3657* lumns corresponding to N. NBLKS must be at least zero.
3658*
3659* IMBLOC (local output) INTEGER
3660* On exit, IMBLOC specifies the number of rows (size) of the
3661* uppest blocks of this m by n local array owned by the process
3662* of relative coordinates ( MRROW, MRCOL ). IMBLOC is at least
3663* MIN( 1, M ).
3664*
3665* INBLOC (local output) INTEGER
3666* On exit, INBLOC specifies the number of columns (size) of
3667* the leftmost blocks of this m by n local array owned by the
3668* process of relative coordinates ( MRROW, MRCOL ). INBLOC is
3669* at least MIN( 1, N ).
3670*
3671* LMBLOC (local output) INTEGER
3672* On exit, LMBLOC specifies the number of rows (size) of the
3673* lowest blocks of this m by n local array owned by the process
3674* of relative coordinates ( MRROW, MRCOL ). LMBLOC is at least
3675* MIN( 1, M ).
3676*
3677* LNBLOC (local output) INTEGER
3678* On exit, LNBLOC specifies the number of columns (size) of the
3679* rightmost blocks of this m by n local array owned by the
3680* process of relative coordinates ( MRROW, MRCOL ). LNBLOC is
3681* at least MIN( 1, N ).
3682*
3683* ILOW (local output) INTEGER
3684* On exit, ILOW is the lower bound characterizing the first co-
3685* lumn block owning offdiagonals of this m by n array. ILOW
3686* must be less or equal than zero.
3687*
3688* LOW (global output) INTEGER
3689* On exit, LOW is the lower bound characterizing the column
3690* blocks with te exception of the first one (see ILOW) owning
3691* offdiagonals of this m by n array. LOW must be less or equal
3692* than zero.
3693*
3694* IUPP (local output) INTEGER
3695* On exit, IUPP is the upper bound characterizing the first row
3696* block owning offdiagonals of this m by n array. IUPP must be
3697* greater or equal than zero.
3698*
3699* UPP (global output) INTEGER
3700* On exit, UPP is the upper bound characterizing the row
3701* blocks with te exception of the first one (see IUPP) owning
3702* offdiagonals of this m by n array. UPP must be greater or
3703* equal than zero.
3704*
3705* -- Written on April 1, 1998 by
3706* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
3707*
3708* =====================================================================
3709*
3710* .. Local Scalars ..
3711 INTEGER TMP1
3712* ..
3713* .. Intrinsic Functions ..
3714 INTRINSIC max, min
3715* ..
3716* .. Executable Statements ..
3717*
3718* Initialize LOW, ILOW, UPP, IUPP, LMBLOC, LNBLOC, IMBLOC, INBLOC,
3719* MBLKS, NBLKS and LCMT00.
3720*
3721 low = 1 - nb
3722 upp = mb - 1
3723*
3724 lcmt00 = offd
3725*
3726 IF( m.LE.0 .OR. n.LE.0 ) THEN
3727*
3728 IF( mrrow.GT.0 ) THEN
3729 iupp = mb - 1
3730 ELSE
3731 iupp = max( 0, imb1 - 1 )
3732 END IF
3733 imbloc = 0
3734 mblks = 0
3735 lmbloc = 0
3736*
3737 IF( mrcol.GT.0 ) THEN
3738 ilow = 1 - nb
3739 ELSE
3740 ilow = min( 0, 1 - inb1 )
3741 END IF
3742 inbloc = 0
3743 nblks = 0
3744 lnbloc = 0
3745*
3746 lcmt00 = lcmt00 + ( low - ilow + mrcol * nb ) -
3747 $ ( iupp - upp + mrrow * mb )
3748*
3749 RETURN
3750*
3751 END IF
3752*
3753 IF( mrrow.GT.0 ) THEN
3754*
3755 imbloc = min( m, mb )
3756 iupp = mb - 1
3757 lcmt00 = lcmt00 - ( imb1 - mb + mrrow * mb )
3758 mblks = ( m - 1 ) / mb + 1
3759 lmbloc = m - ( m / mb ) * mb
3760 IF( lmbloc.EQ.0 )
3761 $ lmbloc = mb
3762*
3763 IF( mrcol.GT.0 ) THEN
3764*
3765 inbloc = min( n, nb )
3766 ilow = 1 - nb
3767 lcmt00 = lcmt00 + inb1 - nb + mrcol * nb
3768 nblks = ( n - 1 ) / nb + 1
3769 lnbloc = n - ( n / nb ) * nb
3770 IF( lnbloc.EQ.0 )
3771 $ lnbloc = nb
3772*
3773 ELSE
3774*
3775 inbloc = inb1
3776 ilow = 1 - inb1
3777 tmp1 = n - inb1
3778 IF( tmp1.GT.0 ) THEN
3779*
3780* more than one block
3781*
3782 nblks = ( tmp1 - 1 ) / nb + 2
3783 lnbloc = tmp1 - ( tmp1 / nb ) * nb
3784 IF( lnbloc.EQ.0 )
3785 $ lnbloc = nb
3786*
3787 ELSE
3788*
3789 nblks = 1
3790 lnbloc = inb1
3791*
3792 END IF
3793*
3794 END IF
3795*
3796 ELSE
3797*
3798 imbloc = imb1
3799 iupp = imb1 - 1
3800 tmp1 = m - imb1
3801 IF( tmp1.GT.0 ) THEN
3802*
3803* more than one block
3804*
3805 mblks = ( tmp1 - 1 ) / mb + 2
3806 lmbloc = tmp1 - ( tmp1 / mb ) * mb
3807 IF( lmbloc.EQ.0 )
3808 $ lmbloc = mb
3809*
3810 ELSE
3811*
3812 mblks = 1
3813 lmbloc = imb1
3814*
3815 END IF
3816*
3817 IF( mrcol.GT.0 ) THEN
3818*
3819 inbloc = min( n, nb )
3820 ilow = 1 - nb
3821 lcmt00 = lcmt00 + inb1 - nb + mrcol * nb
3822 nblks = ( n - 1 ) / nb + 1
3823 lnbloc = n - ( n / nb ) * nb
3824 IF( lnbloc.EQ.0 )
3825 $ lnbloc = nb
3826*
3827 ELSE
3828*
3829 inbloc = inb1
3830 ilow = 1 - inb1
3831 tmp1 = n - inb1
3832 IF( tmp1.GT.0 ) THEN
3833*
3834* more than one block
3835*
3836 nblks = ( tmp1 - 1 ) / nb + 2
3837 lnbloc = tmp1 - ( tmp1 / nb ) * nb
3838 IF( lnbloc.EQ.0 )
3839 $ lnbloc = nb
3840*
3841 ELSE
3842*
3843 nblks = 1
3844 lnbloc = inb1
3845*
3846 END IF
3847*
3848 END IF
3849*
3850 END IF
3851*
3852 RETURN
3853*
3854* End of PB_BINFO
3855*
max
#define max(a, b)
Definition macros.h:21

◆ pb_chkmat()

subroutine pb_chkmat ( integer ictxt,
integer m,
integer mpos0,
integer n,
integer npos0,
integer ia,
integer ja,
integer, dimension( * ) desca,
integer dpos0,
integer info )

Definition at line 2740 of file pblastst.f.

2742*
2743* -- PBLAS test routine (version 2.0) --
2744* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2745* and University of California, Berkeley.
2746* April 1, 1998
2747*
2748* .. Scalar Arguments ..
2749 INTEGER DPOS0, IA, ICTXT, INFO, JA, M, MPOS0, N, NPOS0
2750* ..
2751* .. Array Arguments ..
2752 INTEGER DESCA( * )
2753* ..
2754*
2755* Purpose
2756* =======
2757*
2758* PB_CHKMAT checks the validity of a descriptor vector DESCA, the re-
2759* lated global indexes IA, JA from a local view point. If an inconsis-
2760* tency is found among its parameters IA, JA and DESCA, the routine re-
2761* turns an error code in INFO.
2762*
2763* Arguments
2764* =========
2765*
2766* ICTXT (local input) INTEGER
2767* On entry, ICTXT specifies the BLACS context handle, indica-
2768* ting the global context of the operation. The context itself
2769* is global, but the value of ICTXT is local.
2770*
2771* M (global input) INTEGER
2772* On entry, M specifies the number of rows the submatrix
2773* sub( A ).
2774*
2775* MPOS0 (global input) INTEGER
2776* On entry, MPOS0 specifies the position in the calling rou-
2777* tine's parameter list where the formal parameter M appears.
2778*
2779* N (global input) INTEGER
2780* On entry, N specifies the number of columns the submatrix
2781* sub( A ).
2782*
2783* NPOS0 (global input) INTEGER
2784* On entry, NPOS0 specifies the position in the calling rou-
2785* tine's parameter list where the formal parameter N appears.
2786*
2787* IA (global input) INTEGER
2788* On entry, IA specifies A's global row index, which points to
2789* the beginning of the submatrix sub( A ).
2790*
2791* JA (global input) INTEGER
2792* On entry, JA specifies A's global column index, which points
2793* to the beginning of the submatrix sub( A ).
2794*
2795* DESCA (global and local input) INTEGER array
2796* On entry, DESCA is an integer array of dimension DLEN_. This
2797* is the array descriptor for the matrix A.
2798*
2799* DPOS0 (global input) INTEGER
2800* On entry, DPOS0 specifies the position in the calling rou-
2801* tine's parameter list where the formal parameter DESCA ap-
2802* pears. Note that it is assumed that IA and JA are respecti-
2803* vely 2 and 1 entries behind DESCA.
2804*
2805* INFO (local input/local output) INTEGER
2806* = 0: successful exit
2807* < 0: If the i-th argument is an array and the j-entry had an
2808* illegal value, then INFO = -(i*100+j), if the i-th
2809* argument is a scalar and had an illegal value, then
2810* INFO = -i.
2811*
2812* -- Written on April 1, 1998 by
2813* R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
2814*
2815* =====================================================================
2816*
2817* .. Parameters ..
2818 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
2819 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
2820 $ RSRC_
2821 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
2822 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
2823 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
2824 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
2825 INTEGER DESCMULT, BIGNUM
2826 parameter( descmult = 100, bignum = descmult*descmult )
2827* ..
2828* .. Local Scalars ..
2829 INTEGER DPOS, IAPOS, JAPOS, MP, MPOS, MYCOL, MYROW,
2830 $ NPCOL, NPOS, NPROW, NQ
2831* ..
2832* .. Local Arrays ..
2833 INTEGER DESCA2( DLEN_ )
2834* ..
2835* .. External Subroutines ..
2836 EXTERNAL blacs_gridinfo, pb_desctrans
2837* ..
2838* .. External Functions ..
2839 INTEGER PB_NUMROC
2840 EXTERNAL pb_numroc
2841* ..
2842* .. Intrinsic Functions ..
2843 INTRINSIC min, max
2844* ..
2845* .. Executable Statements ..
2846*
2847* Convert descriptor
2848*
2849 CALL pb_desctrans( desca, desca2 )
2850*
2851* Want to find errors with MIN( ), so if no error, set it to a big
2852* number. If there already is an error, multiply by the the des-
2853* criptor multiplier
2854*
2855 IF( info.GE.0 ) THEN
2856 info = bignum
2857 ELSE IF( info.LT.-descmult ) THEN
2858 info = -info
2859 ELSE
2860 info = -info * descmult
2861 END IF
2862*
2863* Figure where in parameter list each parameter was, factoring in
2864* descriptor multiplier
2865*
2866 mpos = mpos0 * descmult
2867 npos = npos0 * descmult
2868 iapos = ( dpos0 - 2 ) * descmult
2869 japos = ( dpos0 - 1 ) * descmult
2870 dpos = dpos0 * descmult
2871*
2872* Get grid parameters
2873*
2874 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
2875*
2876* Check that matrix values make sense from local viewpoint
2877*
2878 IF( m.LT.0 )
2879 $ info = min( info, mpos )
2880 IF( n.LT.0 )
2881 $ info = min( info, npos )
2882 IF( ia.LT.1 )
2883 $ info = min( info, iapos )
2884 IF( ja.LT.1 )
2885 $ info = min( info, japos )
2886 IF( desca2( dtype_ ).NE.block_cyclic_2d_inb )
2887 $ info = min( info, dpos + dtype_ )
2888 IF( desca2( imb_ ).LT.1 )
2889 $ info = min( info, dpos + imb_ )
2890 IF( desca2( inb_ ).LT.1 )
2891 $ info = min( info, dpos + inb_ )
2892 IF( desca2( mb_ ).LT.1 )
2893 $ info = min( info, dpos + mb_ )
2894 IF( desca2( nb_ ).LT.1 )
2895 $ info = min( info, dpos + nb_ )
2896 IF( desca2( rsrc_ ).LT.-1 .OR. desca2( rsrc_ ).GE.nprow )
2897 $ info = min( info, dpos + rsrc_ )
2898 IF( desca2( csrc_ ).LT.-1 .OR. desca2( csrc_ ).GE.npcol )
2899 $ info = min( info, dpos + csrc_ )
2900 IF( desca2( ctxt_ ).NE.ictxt )
2901 $ info = min( info, dpos + ctxt_ )
2902*
2903 IF( m.EQ.0 .OR. n.EQ.0 ) THEN
2904*
2905* NULL matrix, relax some checks
2906*
2907 IF( desca2( m_ ).LT.0 )
2908 $ info = min( info, dpos + m_ )
2909 IF( desca2( n_ ).LT.0 )
2910 $ info = min( info, dpos + n_ )
2911 IF( desca2( lld_ ).LT.1 )
2912 $ info = min( info, dpos + lld_ )
2913*
2914 ELSE
2915*
2916* more rigorous checks for non-degenerate matrices
2917*
2918 mp = pb_numroc( desca2( m_ ), 1, desca2( imb_ ), desca2( mb_ ),
2919 $ myrow, desca2( rsrc_ ), nprow )
2920*
2921 IF( desca2( m_ ).LT.1 )
2922 $ info = min( info, dpos + m_ )
2923 IF( desca2( n_ ).LT.1 )
2924 $ info = min( info, dpos + n_ )
2925 IF( ia.GT.desca2( m_ ) )
2926 $ info = min( info, iapos )
2927 IF( ja.GT.desca2( n_ ) )
2928 $ info = min( info, japos )
2929 IF( ia+m-1.GT.desca2( m_ ) )
2930 $ info = min( info, mpos )
2931 IF( ja+n-1.GT.desca2( n_ ) )
2932 $ info = min( info, npos )
2933*
2934 IF( desca2( lld_ ).LT.max( 1, mp ) ) THEN
2935 nq = pb_numroc( desca2( n_ ), 1, desca2( inb_ ),
2936 $ desca2( nb_ ), mycol, desca2( csrc_ ),
2937 $ npcol )
2938 IF( desca2( lld_ ).LT.1 ) THEN
2939 info = min( info, dpos + lld_ )
2940 ELSE IF( nq.GT.0 ) THEN
2941 info = min( info, dpos + lld_ )
2942 END IF
2943 END IF
2944*
2945 END IF
2946*
2947* Prepare output: set info = 0 if no error, and divide by
2948* DESCMULT if error is not in a descriptor entry
2949*
2950 IF( info.EQ.bignum ) THEN
2951 info = 0
2952 ELSE IF( mod( info, descmult ).EQ.0 ) THEN
2953 info = -( info / descmult )
2954 ELSE
2955 info = -info
2956 END IF
2957*
2958 RETURN
2959*
2960* End of PB_CHKMAT
2961*
blacs_gridinfo
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
Definition mpi.f:754
pb_numroc
integer function pb_numroc(n, i, inb, nb, proc, srcproc, nprocs)
Definition pblastst.f:2548

◆ pb_descinit2()

subroutine pb_descinit2 ( integer, dimension( * ) desc,
integer m,
integer n,
integer imb,
integer inb,
integer mb,
integer nb,
integer rsrc,
integer csrc,
integer ctxt,
integer lld,
integer info )

Definition at line 3335 of file pblastst.f.

3337*
3338* -- PBLAS test routine (version 2.0) --
3339* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
3340* and University of California, Berkeley.
3341* April 1, 1998
3342*
3343* .. Scalar Arguments ..
3344 INTEGER CSRC, CTXT, IMB, INB, INFO, LLD, M, MB, N, NB,
3345 $ RSRC
3346* ..
3347* .. Array Arguments ..
3348 INTEGER DESC( * )
3349* ..
3350*
3351* Purpose
3352* =======
3353*
3354* PB_DESCINIT2 uses its 10 input arguments M, N, IMB, INB, MB, NB,
3355* RSRC, CSRC, CTXT and LLD to initialize a descriptor vector of type
3356* BLOCK_CYCLIC_2D_INB.
3357*
3358* Notes
3359* =====
3360*
3361* A description vector is associated with each 2D block-cyclicly dis-
3362* tributed matrix. This vector stores the information required to
3363* establish the mapping between a matrix entry and its corresponding
3364* process and memory location.
3365*
3366* In the following comments, the character _ should be read as
3367* "of the distributed matrix". Let A be a generic term for any 2D
3368* block cyclicly distributed matrix. Its description vector is DESCA:
3369*
3370* NOTATION STORED IN EXPLANATION
3371* ---------------- --------------- ------------------------------------
3372* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
3373* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
3374* the NPROW x NPCOL BLACS process grid
3375* A is distributed over. The context
3376* itself is global, but the handle
3377* (the integer value) may vary.
3378* M_A (global) DESCA( M_ ) The number of rows in the distribu-
3379* ted matrix A, M_A >= 0.
3380* N_A (global) DESCA( N_ ) The number of columns in the distri-
3381* buted matrix A, N_A >= 0.
3382* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
3383* block of the matrix A, IMB_A > 0.
3384* INB_A (global) DESCA( INB_ ) The number of columns of the upper
3385* left block of the matrix A,
3386* INB_A > 0.
3387* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
3388* bute the last M_A-IMB_A rows of A,
3389* MB_A > 0.
3390* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
3391* bute the last N_A-INB_A columns of
3392* A, NB_A > 0.
3393* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
3394* row of the matrix A is distributed,
3395* NPROW > RSRC_A >= 0.
3396* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
3397* first column of A is distributed.
3398* NPCOL > CSRC_A >= 0.
3399* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
3400* array storing the local blocks of
3401* the distributed matrix A,
3402* IF( Lc( 1, N_A ) > 0 )
3403* LLD_A >= MAX( 1, Lr( 1, M_A ) )
3404* ELSE
3405* LLD_A >= 1.
3406*
3407* Let K be the number of rows of a matrix A starting at the global in-
3408* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
3409* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
3410* receive if these K rows were distributed over NPROW processes. If K
3411* is the number of columns of a matrix A starting at the global index
3412* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
3413* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
3414* these K columns were distributed over NPCOL processes.
3415*
3416* The values of Lr() and Lc() may be determined via a call to the func-
3417* tion PB_NUMROC:
3418* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
3419* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
3420*
3421* Arguments
3422* =========
3423*
3424* DESC (global and local output) INTEGER array
3425* On entry, DESC is an array of dimension DLEN_. DESC is the
3426* array descriptor to be set.
3427*
3428* M (global input) INTEGER
3429* On entry, M specifies the number of rows of the matrix.
3430* M must be at least zero.
3431*
3432* N (global input) INTEGER
3433* On entry, N specifies the number of columns of the matrix.
3434* N must be at least zero.
3435*
3436* IMB (global input) INTEGER
3437* On entry, IMB specifies the row size of the first block of
3438* the global matrix distribution. IMB must be at least one.
3439*
3440* INB (global input) INTEGER
3441* On entry, INB specifies the column size of the first block
3442* of the global matrix distribution. INB must be at least one.
3443*
3444* MB (global input) INTEGER
3445* On entry, MB specifies the row size of the blocks used to
3446* partition the matrix. MB must be at least one.
3447*
3448* NB (global input) INTEGER
3449* On entry, NB specifies the column size of the blocks used to
3450* partition the matrix. NB must be at least one.
3451*
3452* RSRC (global input) INTEGER
3453* On entry, RSRC specifies the row coordinate of the process
3454* that possesses the first row of the matrix. When RSRC = -1,
3455* the data is not distributed but replicated, otherwise RSRC
3456* must be at least zero and strictly less than NPROW.
3457*
3458* CSRC (global input) INTEGER
3459* On entry, CSRC specifies the column coordinate of the pro-
3460* cess that possesses the first column of the matrix. When
3461* CSRC = -1, the data is not distributed but replicated, other-
3462* wise CSRC must be at least zero and strictly less than NPCOL.
3463*
3464* CTXT (local input) INTEGER
3465* On entry, CTXT specifies the BLACS context handle, indicating
3466* the global communication context. The value of the context
3467* itself is local.
3468*
3469* LLD (local input) INTEGER
3470* On entry, LLD specifies the leading dimension of the local
3471* array storing the local entries of the matrix. LLD must be at
3472* least MAX( 1, Lr(1,M) ).
3473*
3474* INFO (local output) INTEGER
3475* = 0: successful exit
3476* < 0: if INFO = -i, the i-th argument had an illegal value.
3477*
3478* Notes
3479* =====
3480*
3481* If the routine can recover from an erroneous input argument, it will
3482* return an acceptable descriptor vector. For example, if LLD = 0 on
3483* input, DESC( LLD_ ) will contain the smallest leading dimension re-
3484* quired to store the specified m by n matrix, INFO will however be set
3485* to -11 on exit in that case.
3486*
3487* -- Written on April 1, 1998 by
3488* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
3489*
3490* =====================================================================
3491*
3492* .. Parameters ..
3493 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
3494 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
3495 $ RSRC_
3496 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
3497 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
3498 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
3499 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
3500* ..
3501* .. Local Scalars ..
3502 INTEGER LLDMIN, MP, MYCOL, MYROW, NPCOL, NPROW
3503* ..
3504* .. External Subroutines ..
3505 EXTERNAL blacs_gridinfo, pxerbla
3506* ..
3507* .. External Functions ..
3508 INTEGER PB_NUMROC
3509 EXTERNAL pb_numroc
3510* ..
3511* .. Intrinsic Functions ..
3512 INTRINSIC max, min
3513* ..
3514* .. Executable Statements ..
3515*
3516* Get grid parameters
3517*
3518 CALL blacs_gridinfo( ctxt, nprow, npcol, myrow, mycol )
3519*
3520 info = 0
3521 IF( m.LT.0 ) THEN
3522 info = -2
3523 ELSE IF( n.LT.0 ) THEN
3524 info = -3
3525 ELSE IF( imb.LT.1 ) THEN
3526 info = -4
3527 ELSE IF( inb.LT.1 ) THEN
3528 info = -5
3529 ELSE IF( mb.LT.1 ) THEN
3530 info = -6
3531 ELSE IF( nb.LT.1 ) THEN
3532 info = -7
3533 ELSE IF( rsrc.LT.-1 .OR. rsrc.GE.nprow ) THEN
3534 info = -8
3535 ELSE IF( csrc.LT.-1 .OR. csrc.GE.npcol ) THEN
3536 info = -9
3537 ELSE IF( nprow.EQ.-1 ) THEN
3538 info = -10
3539 END IF
3540*
3541* Compute minimum LLD if safe (to avoid division by 0)
3542*
3543 IF( info.EQ.0 ) THEN
3544 mp = pb_numroc( m, 1, imb, mb, myrow, rsrc, nprow )
3545 IF( pb_numroc( n, 1, inb, nb, mycol, csrc, npcol ).GT.0 ) THEN
3546 lldmin = max( 1, mp )
3547 ELSE
3548 lldmin = 1
3549 END IF
3550 IF( lld.LT.lldmin )
3551 $ info = -11
3552 END IF
3553*
3554 IF( info.NE.0 )
3555 $ CALL pxerbla( ctxt, 'PB_DESCINIT2', -info )
3556*
3557 desc( dtype_ ) = block_cyclic_2d_inb
3558 desc( ctxt_ ) = ctxt
3559 desc( m_ ) = max( 0, m )
3560 desc( n_ ) = max( 0, n )
3561 desc( imb_ ) = max( 1, imb )
3562 desc( inb_ ) = max( 1, inb )
3563 desc( mb_ ) = max( 1, mb )
3564 desc( nb_ ) = max( 1, nb )
3565 desc( rsrc_ ) = max( -1, min( rsrc, nprow-1 ) )
3566 desc( csrc_ ) = max( -1, min( csrc, npcol-1 ) )
3567 desc( lld_ ) = max( lld, lldmin )
3568*
3569 RETURN
3570*
3571* End of PB_DESCINIT2
3572*
pxerbla
subroutine pxerbla(ictxt, srname, info)
Definition pblastst.f:1307

◆ pb_descset2()

subroutine pb_descset2 ( integer, dimension( * ) desc,
integer m,
integer n,
integer imb,
integer inb,
integer mb,
integer nb,
integer rsrc,
integer csrc,
integer ctxt,
integer lld )

Definition at line 3170 of file pblastst.f.

3172*
3173* -- PBLAS test routine (version 2.0) --
3174* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
3175* and University of California, Berkeley.
3176* April 1, 1998
3177*
3178* .. Scalar Arguments ..
3179 INTEGER CSRC, CTXT, IMB, INB, LLD, M, MB, N, NB, RSRC
3180* ..
3181* .. Array Arguments ..
3182 INTEGER DESC( * )
3183* ..
3184*
3185* Purpose
3186* =======
3187*
3188* PB_DESCSET2 uses its 10 input arguments M, N, IMB, INB, MB, NB,
3189* RSRC, CSRC, CTXT and LLD to initialize a descriptor vector of type
3190* BLOCK_CYCLIC_2D_INB.
3191*
3192* Notes
3193* =====
3194*
3195* A description vector is associated with each 2D block-cyclicly dis-
3196* tributed matrix. This vector stores the information required to
3197* establish the mapping between a matrix entry and its corresponding
3198* process and memory location.
3199*
3200* In the following comments, the character _ should be read as
3201* "of the distributed matrix". Let A be a generic term for any 2D
3202* block cyclicly distributed matrix. Its description vector is DESCA:
3203*
3204* NOTATION STORED IN EXPLANATION
3205* ---------------- --------------- -----------------------------------
3206* DTYPE_A (global) DESCA( DTYPE1_ ) The descriptor type.
3207* CTXT_A (global) DESCA( CTXT1_ ) The BLACS context handle indicating
3208* the NPROW x NPCOL BLACS process
3209* grid A is distributed over. The
3210* context itself is global, but the
3211* handle (the integer value) may
3212* vary.
3213* M_A (global) DESCA( M1_ ) The number of rows in the distri-
3214* buted matrix A, M_A >= 0.
3215* N_A (global) DESCA( N1_ ) The number of columns in the dis-
3216* tributed matrix A, N_A >= 0.
3217* MB_A (global) DESCA( MB1_ ) The blocking factor used to distri-
3218* bute the rows of A, MB_A > 0.
3219* NB_A (global) DESCA( NB1_ ) The blocking factor used to distri-
3220* bute the columns of A, NB_A > 0.
3221* RSRC_A (global) DESCA( RSRC1_ ) The process row over which the
3222* first row of the matrix A is dis-
3223* tributed, NPROW > RSRC_A >= 0.
3224* CSRC_A (global) DESCA( CSRC1_ ) The process column over which the
3225* first column of A is distributed.
3226* NPCOL > CSRC_A >= 0.
3227* LLD_A (local) DESCA( LLD1_ ) The leading dimension of the local
3228* array storing the local blocks of
3229* the distributed matrix A,
3230* IF( Lc( 1, N_A ) > 0 )
3231* LLD_A >= MAX( 1, Lr( 1, M_A ) )
3232* ELSE
3233* LLD_A >= 1.
3234*
3235* Let K be the number of rows of a matrix A starting at the global in-
3236* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
3237* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
3238* receive if these K rows were distributed over NPROW processes. If K
3239* is the number of columns of a matrix A starting at the global index
3240* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
3241* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
3242* these K columns were distributed over NPCOL processes.
3243*
3244* The values of Lr() and Lc() may be determined via a call to the func-
3245* tion PB_NUMROC:
3246* Lr( IA, K ) = PB_NUMROC( K, IA, MB_A, MB_A, MYROW, RSRC_A, NPROW )
3247* Lc( JA, K ) = PB_NUMROC( K, JA, NB_A, NB_A, MYCOL, CSRC_A, NPCOL )
3248*
3249* Arguments
3250* =========
3251*
3252* DESC (global and local output) INTEGER array
3253* On entry, DESC is an array of dimension DLEN_. DESC is the
3254* array descriptor to be set.
3255*
3256* M (global input) INTEGER
3257* On entry, M specifies the number of rows of the matrix.
3258* M must be at least zero.
3259*
3260* N (global input) INTEGER
3261* On entry, N specifies the number of columns of the matrix.
3262* N must be at least zero.
3263*
3264* IMB (global input) INTEGER
3265* On entry, IMB specifies the row size of the first block of
3266* the global matrix distribution. IMB must be at least one.
3267*
3268* INB (global input) INTEGER
3269* On entry, INB specifies the column size of the first block
3270* of the global matrix distribution. INB must be at least one.
3271*
3272* MB (global input) INTEGER
3273* On entry, MB specifies the row size of the blocks used to
3274* partition the matrix. MB must be at least one.
3275*
3276* NB (global input) INTEGER
3277* On entry, NB specifies the column size of the blocks used to
3278* partition the matrix. NB must be at least one.
3279*
3280* RSRC (global input) INTEGER
3281* On entry, RSRC specifies the row coordinate of the process
3282* that possesses the first row of the matrix. When RSRC = -1,
3283* the data is not distributed but replicated, otherwise RSRC
3284* must be at least zero and strictly less than NPROW.
3285*
3286* CSRC (global input) INTEGER
3287* On entry, CSRC specifies the column coordinate of the pro-
3288* cess that possesses the first column of the matrix. When
3289* CSRC = -1, the data is not distributed but replicated, other-
3290* wise CSRC must be at least zero and strictly less than NPCOL.
3291*
3292* CTXT (local input) INTEGER
3293* On entry, CTXT specifies the BLACS context handle, indicating
3294* the global communication context. The value of the context
3295* itself is local.
3296*
3297* LLD (local input) INTEGER
3298* On entry, LLD specifies the leading dimension of the local
3299* array storing the local entries of the matrix. LLD must be at
3300* least MAX( 1, Lr(1,M) ).
3301*
3302* -- Written on April 1, 1998 by
3303* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
3304*
3305* =====================================================================
3306*
3307* .. Parameters ..
3308 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
3309 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
3310 $ RSRC_
3311 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
3312 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
3313 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
3314 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
3315* ..
3316* .. Executable Statements ..
3317*
3318 desc( dtype_ ) = block_cyclic_2d_inb
3319 desc( ctxt_ ) = ctxt
3320 desc( m_ ) = m
3321 desc( n_ ) = n
3322 desc( imb_ ) = imb
3323 desc( inb_ ) = inb
3324 desc( mb_ ) = mb
3325 desc( nb_ ) = nb
3326 desc( rsrc_ ) = rsrc
3327 desc( csrc_ ) = csrc
3328 desc( lld_ ) = lld
3329*
3330 RETURN
3331*
3332* End of PB_DESCSET2
3333*

◆ pb_desctrans()

subroutine pb_desctrans ( integer, dimension( * ) descin,
integer, dimension( * ) descout )

Definition at line 2963 of file pblastst.f.

2964*
2965* -- PBLAS test routine (version 2.0) --
2966* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2967* and University of California, Berkeley.
2968* April 1, 1998
2969*
2970* .. Array Arguments ..
2971 INTEGER DESCIN( * ), DESCOUT( * )
2972* ..
2973*
2974* Purpose
2975* =======
2976*
2977* PB_DESCTRANS converts a descriptor DESCIN of type BLOCK_CYCLIC_2D
2978* or BLOCK_CYCLIC_INB_2D into a descriptor DESCOUT of type
2979* BLOCK_CYCLIC_INB_2D.
2980*
2981* Notes
2982* =====
2983*
2984* A description vector is associated with each 2D block-cyclicly dis-
2985* tributed matrix. This vector stores the information required to
2986* establish the mapping between a matrix entry and its corresponding
2987* process and memory location.
2988*
2989* In the following comments, the character _ should be read as
2990* "of the distributed matrix". Let A be a generic term for any 2D
2991* block cyclicly distributed matrix. Its description vector is DESCA:
2992*
2993* NOTATION STORED IN EXPLANATION
2994* ---------------- --------------- -----------------------------------
2995* DTYPE_A (global) DESCA( DTYPE1_ ) The descriptor type.
2996* CTXT_A (global) DESCA( CTXT1_ ) The BLACS context handle indicating
2997* the NPROW x NPCOL BLACS process
2998* grid A is distributed over. The
2999* context itself is global, but the
3000* handle (the integer value) may
3001* vary.
3002* M_A (global) DESCA( M1_ ) The number of rows in the distri-
3003* buted matrix A, M_A >= 0.
3004* N_A (global) DESCA( N1_ ) The number of columns in the dis-
3005* tributed matrix A, N_A >= 0.
3006* MB_A (global) DESCA( MB1_ ) The blocking factor used to distri-
3007* bute the rows of A, MB_A > 0.
3008* NB_A (global) DESCA( NB1_ ) The blocking factor used to distri-
3009* bute the columns of A, NB_A > 0.
3010* RSRC_A (global) DESCA( RSRC1_ ) The process row over which the
3011* first row of the matrix A is dis-
3012* tributed, NPROW > RSRC_A >= 0.
3013* CSRC_A (global) DESCA( CSRC1_ ) The process column over which the
3014* first column of A is distributed.
3015* NPCOL > CSRC_A >= 0.
3016* LLD_A (local) DESCA( LLD1_ ) The leading dimension of the local
3017* array storing the local blocks of
3018* the distributed matrix A,
3019* IF( Lc( 1, N_A ) > 0 )
3020* LLD_A >= MAX( 1, Lr( 1, M_A ) )
3021* ELSE
3022* LLD_A >= 1.
3023*
3024* Let K be the number of rows of a matrix A starting at the global in-
3025* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
3026* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
3027* receive if these K rows were distributed over NPROW processes. If K
3028* is the number of columns of a matrix A starting at the global index
3029* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
3030* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
3031* these K columns were distributed over NPCOL processes.
3032*
3033* The values of Lr() and Lc() may be determined via a call to the func-
3034* tion PB_NUMROC:
3035* Lr( IA, K ) = PB_NUMROC( K, IA, MB_A, MB_A, MYROW, RSRC_A, NPROW )
3036* Lc( JA, K ) = PB_NUMROC( K, JA, NB_A, NB_A, MYCOL, CSRC_A, NPCOL )
3037*
3038* A description vector is associated with each 2D block-cyclicly dis-
3039* tributed matrix. This vector stores the information required to
3040* establish the mapping between a matrix entry and its corresponding
3041* process and memory location.
3042*
3043* In the following comments, the character _ should be read as
3044* "of the distributed matrix". Let A be a generic term for any 2D
3045* block cyclicly distributed matrix. Its description vector is DESCA:
3046*
3047* NOTATION STORED IN EXPLANATION
3048* ---------------- --------------- ------------------------------------
3049* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
3050* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
3051* the NPROW x NPCOL BLACS process grid
3052* A is distributed over. The context
3053* itself is global, but the handle
3054* (the integer value) may vary.
3055* M_A (global) DESCA( M_ ) The number of rows in the distribu-
3056* ted matrix A, M_A >= 0.
3057* N_A (global) DESCA( N_ ) The number of columns in the distri-
3058* buted matrix A, N_A >= 0.
3059* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
3060* block of the matrix A, IMB_A > 0.
3061* INB_A (global) DESCA( INB_ ) The number of columns of the upper
3062* left block of the matrix A,
3063* INB_A > 0.
3064* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
3065* bute the last M_A-IMB_A rows of A,
3066* MB_A > 0.
3067* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
3068* bute the last N_A-INB_A columns of
3069* A, NB_A > 0.
3070* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
3071* row of the matrix A is distributed,
3072* NPROW > RSRC_A >= 0.
3073* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
3074* first column of A is distributed.
3075* NPCOL > CSRC_A >= 0.
3076* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
3077* array storing the local blocks of
3078* the distributed matrix A,
3079* IF( Lc( 1, N_A ) > 0 )
3080* LLD_A >= MAX( 1, Lr( 1, M_A ) )
3081* ELSE
3082* LLD_A >= 1.
3083*
3084* Let K be the number of rows of a matrix A starting at the global in-
3085* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
3086* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
3087* receive if these K rows were distributed over NPROW processes. If K
3088* is the number of columns of a matrix A starting at the global index
3089* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
3090* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
3091* these K columns were distributed over NPCOL processes.
3092*
3093* The values of Lr() and Lc() may be determined via a call to the func-
3094* tion PB_NUMROC:
3095* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
3096* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
3097*
3098* Arguments
3099* =========
3100*
3101* DESCIN (global and local input) INTEGER array
3102* On entry, DESCIN is an array of dimension DLEN1_ or DLEN_ as
3103* specified by its first entry DESCIN( DTYPE_ ). DESCIN is the
3104* source array descriptor of type BLOCK_CYCLIC_2D or of type
3105* BLOCK_CYCLIC_2D_INB.
3106*
3107* DESCOUT (global and local output) INTEGER array
3108* On entry, DESCOUT is an array of dimension DLEN_. DESCOUT is
3109* the target array descriptor of type BLOCK_CYCLIC_2D_INB.
3110*
3111* -- Written on April 1, 1998 by
3112* R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
3113*
3114* =====================================================================
3115*
3116* .. Parameters ..
3117 INTEGER BLOCK_CYCLIC_2D, CSRC1_, CTXT1_, DLEN1_,
3118 $ DTYPE1_, LLD1_, M1_, MB1_, N1_, NB1_, RSRC1_
3119 parameter( block_cyclic_2d = 1, dlen1_ = 9, dtype1_ = 1,
3120 $ ctxt1_ = 2, m1_ = 3, n1_ = 4, mb1_ = 5,
3121 $ nb1_ = 6, rsrc1_ = 7, csrc1_ = 8, lld1_ = 9 )
3122 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
3123 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
3124 $ RSRC_
3125 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
3126 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
3127 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
3128 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
3129* ..
3130* .. Local Scalars ..
3131 INTEGER I
3132* ..
3133* .. Executable Statements ..
3134*
3135 IF( descin( dtype_ ).EQ.block_cyclic_2d ) THEN
3136 descout( dtype_ ) = block_cyclic_2d_inb
3137 descout( ctxt_ ) = descin( ctxt1_ )
3138 descout( m_ ) = descin( m1_ )
3139 descout( n_ ) = descin( n1_ )
3140 descout( imb_ ) = descin( mb1_ )
3141 descout( inb_ ) = descin( nb1_ )
3142 descout( mb_ ) = descin( mb1_ )
3143 descout( nb_ ) = descin( nb1_ )
3144 descout( rsrc_ ) = descin( rsrc1_ )
3145 descout( csrc_ ) = descin( csrc1_ )
3146 descout( lld_ ) = descin( lld1_ )
3147 ELSE IF( descin( dtype_ ).EQ.block_cyclic_2d_inb ) THEN
3148 DO 10 i = 1, dlen_
3149 descout( i ) = descin( i )
3150 10 CONTINUE
3151 ELSE
3152 descout( dtype_ ) = descin( 1 )
3153 descout( ctxt_ ) = descin( 2 )
3154 descout( m_ ) = 0
3155 descout( n_ ) = 0
3156 descout( imb_ ) = 1
3157 descout( inb_ ) = 1
3158 descout( mb_ ) = 1
3159 descout( nb_ ) = 1
3160 descout( rsrc_ ) = 0
3161 descout( csrc_ ) = 0
3162 descout( lld_ ) = 1
3163 END IF
3164*
3165 RETURN
3166*
3167* End of PB_DESCTRANS
3168*

◆ pb_fceil()

integer function pb_fceil ( real num,
real denom )

Definition at line 2695 of file pblastst.f.

2696*
2697* -- PBLAS test routine (version 2.0) --
2698* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2699* and University of California, Berkeley.
2700* April 1, 1998
2701*
2702* .. Scalar Arguments ..
2703 REAL DENOM, NUM
2704* ..
2705*
2706* Purpose
2707* =======
2708*
2709* PB_FCEIL returns the ceiling of the division of two integers. The
2710* integer operands are passed as real to avoid integer overflow.
2711*
2712* Arguments
2713* =========
2714*
2715* NUM (local input) REAL
2716* On entry, NUM specifies the numerator of the fraction to be
2717* evaluated.
2718*
2719* DENOM (local input) REAL
2720* On entry, DENOM specifies the denominator of the fraction to
2721* be evaluated.
2722*
2723* -- Written on April 1, 1998 by
2724* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2725*
2726* =====================================================================
2727*
2728* .. Intrinsic Functions ..
2729 INTRINSIC nint
2730* ..
2731* .. Executable Statements ..
2732*
2733 pb_fceil = nint( ( ( num + denom - 1.0e+0 ) / denom ) - 0.5e+0 )
2734*
2735 RETURN
2736*
2737* End of PB_FCEIL
2738*
pb_fceil
integer function pb_fceil(num, denom)
Definition pblastst.f:2696

◆ pb_infog2l()

subroutine pb_infog2l ( integer i,
integer j,
integer, dimension( * ) desc,
integer nprow,
integer npcol,
integer myrow,
integer mycol,
integer ii,
integer jj,
integer prow,
integer pcol )

Definition at line 1671 of file pblastst.f.

1673*
1674* -- PBLAS test routine (version 2.0) --
1675* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1676* and University of California, Berkeley.
1677* April 1, 1998
1678*
1679* .. Scalar Arguments ..
1680 INTEGER I, II, J, JJ, MYCOL, MYROW, NPCOL, NPROW, PCOL,
1681 $ PROW
1682* ..
1683* .. Array Arguments ..
1684 INTEGER DESC( * )
1685* ..
1686*
1687* Purpose
1688* =======
1689*
1690* PB_INFOG2L computes the starting local index II, JJ corresponding to
1691* the submatrix starting globally at the entry pointed by I, J. This
1692* routine returns the coordinates in the grid of the process owning the
1693* matrix entry of global indexes I, J, namely PROW and PCOL.
1694*
1695* Notes
1696* =====
1697*
1698* A description vector is associated with each 2D block-cyclicly dis-
1699* tributed matrix. This vector stores the information required to
1700* establish the mapping between a matrix entry and its corresponding
1701* process and memory location.
1702*
1703* In the following comments, the character _ should be read as
1704* "of the distributed matrix". Let A be a generic term for any 2D
1705* block cyclicly distributed matrix. Its description vector is DESCA:
1706*
1707* NOTATION STORED IN EXPLANATION
1708* ---------------- --------------- ------------------------------------
1709* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
1710* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
1711* the NPROW x NPCOL BLACS process grid
1712* A is distributed over. The context
1713* itself is global, but the handle
1714* (the integer value) may vary.
1715* M_A (global) DESCA( M_ ) The number of rows in the distribu-
1716* ted matrix A, M_A >= 0.
1717* N_A (global) DESCA( N_ ) The number of columns in the distri-
1718* buted matrix A, N_A >= 0.
1719* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
1720* block of the matrix A, IMB_A > 0.
1721* INB_A (global) DESCA( INB_ ) The number of columns of the upper
1722* left block of the matrix A,
1723* INB_A > 0.
1724* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
1725* bute the last M_A-IMB_A rows of A,
1726* MB_A > 0.
1727* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
1728* bute the last N_A-INB_A columns of
1729* A, NB_A > 0.
1730* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
1731* row of the matrix A is distributed,
1732* NPROW > RSRC_A >= 0.
1733* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
1734* first column of A is distributed.
1735* NPCOL > CSRC_A >= 0.
1736* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
1737* array storing the local blocks of
1738* the distributed matrix A,
1739* IF( Lc( 1, N_A ) > 0 )
1740* LLD_A >= MAX( 1, Lr( 1, M_A ) )
1741* ELSE
1742* LLD_A >= 1.
1743*
1744* Let K be the number of rows of a matrix A starting at the global in-
1745* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
1746* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
1747* receive if these K rows were distributed over NPROW processes. If K
1748* is the number of columns of a matrix A starting at the global index
1749* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
1750* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
1751* these K columns were distributed over NPCOL processes.
1752*
1753* The values of Lr() and Lc() may be determined via a call to the func-
1754* tion PB_NUMROC:
1755* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
1756* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
1757*
1758* Arguments
1759* =========
1760*
1761* I (global input) INTEGER
1762* On entry, I specifies the global starting row index of the
1763* submatrix. I must at least one.
1764*
1765* J (global input) INTEGER
1766* On entry, J specifies the global starting column index of
1767* the submatrix. J must at least one.
1768*
1769* DESC (global and local input) INTEGER array
1770* On entry, DESC is an integer array of dimension DLEN_. This
1771* is the array descriptor of the underlying matrix.
1772*
1773* NPROW (global input) INTEGER
1774* On entry, NPROW specifies the total number of process rows
1775* over which the matrix is distributed. NPROW must be at least
1776* one.
1777*
1778* NPCOL (global input) INTEGER
1779* On entry, NPCOL specifies the total number of process columns
1780* over which the matrix is distributed. NPCOL must be at least
1781* one.
1782*
1783* MYROW (local input) INTEGER
1784* On entry, MYROW specifies the row coordinate of the process
1785* whose local index II is determined. MYROW must be at least
1786* zero and strictly less than NPROW.
1787*
1788* MYCOL (local input) INTEGER
1789* On entry, MYCOL specifies the column coordinate of the pro-
1790* cess whose local index JJ is determined. MYCOL must be at
1791* least zero and strictly less than NPCOL.
1792*
1793* II (local output) INTEGER
1794* On exit, II specifies the local starting row index of the
1795* submatrix. On exit, II is at least one.
1796*
1797* JJ (local output) INTEGER
1798* On exit, JJ specifies the local starting column index of the
1799* submatrix. On exit, JJ is at least one.
1800*
1801* PROW (global output) INTEGER
1802* On exit, PROW specifies the row coordinate of the process
1803* that possesses the first row of the submatrix. On exit, PROW
1804* is -1 if DESC( RSRC_ ) is -1 on input, and, at least zero
1805* and strictly less than NPROW otherwise.
1806*
1807* PCOL (global output) INTEGER
1808* On exit, PCOL specifies the column coordinate of the process
1809* that possesses the first column of the submatrix. On exit,
1810* PCOL is -1 if DESC( CSRC_ ) is -1 on input, and, at least
1811* zero and strictly less than NPCOL otherwise.
1812*
1813* -- Written on April 1, 1998 by
1814* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1815*
1816* =====================================================================
1817*
1818* .. Parameters ..
1819 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
1820 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
1821 $ RSRC_
1822 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
1823 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
1824 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
1825 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
1826* ..
1827* .. Local Scalars ..
1828 INTEGER CSRC, I1, ILOCBLK, IMB, INB, J1, MB, MYDIST,
1829 $ NB, NBLOCKS, RSRC
1830* ..
1831* .. Local Arrays ..
1832 INTEGER DESC2( DLEN_ )
1833* ..
1834* .. External Subroutines ..
1835 EXTERNAL pb_desctrans
1836* ..
1837* .. Executable Statements ..
1838*
1839* Convert descriptor
1840*
1841 CALL pb_desctrans( desc, desc2 )
1842*
1843 imb = desc2( imb_ )
1844 prow = desc2( rsrc_ )
1845*
1846* Has every process row I ?
1847*
1848 IF( ( prow.EQ.-1 ).OR.( nprow.EQ.1 ) ) THEN
1849*
1850 ii = i
1851*
1852 ELSE IF( i.LE.imb ) THEN
1853*
1854* I is in range of first block
1855*
1856 IF( myrow.EQ.prow ) THEN
1857 ii = i
1858 ELSE
1859 ii = 1
1860 END IF
1861*
1862 ELSE
1863*
1864* I is not in first block of matrix, figure out who has it.
1865*
1866 rsrc = prow
1867 mb = desc2( mb_ )
1868*
1869 IF( myrow.EQ.rsrc ) THEN
1870*
1871 nblocks = ( i - imb - 1 ) / mb + 1
1872 prow = prow + nblocks
1873 prow = prow - ( prow / nprow ) * nprow
1874*
1875 ilocblk = nblocks / nprow
1876*
1877 IF( ilocblk.GT.0 ) THEN
1878 IF( ( ilocblk*nprow ).GE.nblocks ) THEN
1879 IF( myrow.EQ.prow ) THEN
1880 ii = i + ( ilocblk - nblocks ) * mb
1881 ELSE
1882 ii = imb + ( ilocblk - 1 ) * mb + 1
1883 END IF
1884 ELSE
1885 ii = imb + ilocblk * mb + 1
1886 END IF
1887 ELSE
1888 ii = imb + 1
1889 END IF
1890*
1891 ELSE
1892*
1893 i1 = i - imb
1894 nblocks = ( i1 - 1 ) / mb + 1
1895 prow = prow + nblocks
1896 prow = prow - ( prow / nprow ) * nprow
1897*
1898 mydist = myrow - rsrc
1899 IF( mydist.LT.0 )
1900 $ mydist = mydist + nprow
1901*
1902 ilocblk = nblocks / nprow
1903*
1904 IF( ilocblk.GT.0 ) THEN
1905 mydist = mydist - nblocks + ilocblk * nprow
1906 IF( mydist.LT.0 ) THEN
1907 ii = mb + ilocblk * mb + 1
1908 ELSE
1909 IF( myrow.EQ.prow ) THEN
1910 ii = i1 + ( ilocblk - nblocks + 1 ) * mb
1911 ELSE
1912 ii = ilocblk * mb + 1
1913 END IF
1914 END IF
1915 ELSE
1916 mydist = mydist - nblocks
1917 IF( mydist.LT.0 ) THEN
1918 ii = mb + 1
1919 ELSE IF( myrow.EQ.prow ) THEN
1920 ii = i1 + ( 1 - nblocks ) * mb
1921 ELSE
1922 ii = 1
1923 END IF
1924 END IF
1925 END IF
1926*
1927 END IF
1928*
1929 inb = desc2( inb_ )
1930 pcol = desc2( csrc_ )
1931*
1932* Has every process column J ?
1933*
1934 IF( ( pcol.EQ.-1 ).OR.( npcol.EQ.1 ) ) THEN
1935*
1936 jj = j
1937*
1938 ELSE IF( j.LE.inb ) THEN
1939*
1940* J is in range of first block
1941*
1942 IF( mycol.EQ.pcol ) THEN
1943 jj = j
1944 ELSE
1945 jj = 1
1946 END IF
1947*
1948 ELSE
1949*
1950* J is not in first block of matrix, figure out who has it.
1951*
1952 csrc = pcol
1953 nb = desc2( nb_ )
1954*
1955 IF( mycol.EQ.csrc ) THEN
1956*
1957 nblocks = ( j - inb - 1 ) / nb + 1
1958 pcol = pcol + nblocks
1959 pcol = pcol - ( pcol / npcol ) * npcol
1960*
1961 ilocblk = nblocks / npcol
1962*
1963 IF( ilocblk.GT.0 ) THEN
1964 IF( ( ilocblk*npcol ).GE.nblocks ) THEN
1965 IF( mycol.EQ.pcol ) THEN
1966 jj = j + ( ilocblk - nblocks ) * nb
1967 ELSE
1968 jj = inb + ( ilocblk - 1 ) * nb + 1
1969 END IF
1970 ELSE
1971 jj = inb + ilocblk * nb + 1
1972 END IF
1973 ELSE
1974 jj = inb + 1
1975 END IF
1976*
1977 ELSE
1978*
1979 j1 = j - inb
1980 nblocks = ( j1 - 1 ) / nb + 1
1981 pcol = pcol + nblocks
1982 pcol = pcol - ( pcol / npcol ) * npcol
1983*
1984 mydist = mycol - csrc
1985 IF( mydist.LT.0 )
1986 $ mydist = mydist + npcol
1987*
1988 ilocblk = nblocks / npcol
1989*
1990 IF( ilocblk.GT.0 ) THEN
1991 mydist = mydist - nblocks + ilocblk * npcol
1992 IF( mydist.LT.0 ) THEN
1993 jj = nb + ilocblk * nb + 1
1994 ELSE
1995 IF( mycol.EQ.pcol ) THEN
1996 jj = j1 + ( ilocblk - nblocks + 1 ) * nb
1997 ELSE
1998 jj = ilocblk * nb + 1
1999 END IF
2000 END IF
2001 ELSE
2002 mydist = mydist - nblocks
2003 IF( mydist.LT.0 ) THEN
2004 jj = nb + 1
2005 ELSE IF( mycol.EQ.pcol ) THEN
2006 jj = j1 + ( 1 - nblocks ) * nb
2007 ELSE
2008 jj = 1
2009 END IF
2010 END IF
2011 END IF
2012*
2013 END IF
2014*
2015 RETURN
2016*
2017* End of PB_INFOG2L
2018*

◆ pb_initjmp()

subroutine pb_initjmp ( logical colmaj,
integer nvir,
integer imbvir,
integer inbvir,
integer imbloc,
integer inbloc,
integer mb,
integer nb,
integer rsrc,
integer csrc,
integer nprow,
integer npcol,
integer stride,
integer, dimension( * ) jmp )

Definition at line 4042 of file pblastst.f.

4045*
4046* -- PBLAS test routine (version 2.0) --
4047* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4048* and University of California, Berkeley.
4049* April 1, 1998
4050*
4051* .. Scalar Arguments ..
4052 LOGICAL COLMAJ
4053 INTEGER CSRC, IMBLOC, IMBVIR, INBLOC, INBVIR, MB, NB,
4054 $ NPCOL, NPROW, NVIR, RSRC, STRIDE
4055* ..
4056* .. Array Arguments ..
4057 INTEGER JMP( * )
4058* ..
4059*
4060* Purpose
4061* =======
4062*
4063* PB_INITJMP initializes the jump values JMP used by the random matrix
4064* generator.
4065*
4066* Arguments
4067* =========
4068*
4069* COLMAJ (global input) LOGICAL
4070* On entry, COLMAJ specifies the ordering of the random sequen-
4071* ce. When COLMAJ is .TRUE., the random sequence will be used
4072* for a column major ordering, and otherwise a row-major orde-
4073* ring. This impacts on the computation of the jump values.
4074*
4075* NVIR (global input) INTEGER
4076* On entry, NVIR specifies the size of the underlying virtual
4077* matrix. NVIR must be at least zero.
4078*
4079* IMBVIR (local input) INTEGER
4080* On entry, IMBVIR specifies the number of virtual rows of the
4081* upper left block of the underlying virtual submatrix. IMBVIR
4082* must be at least IMBLOC.
4083*
4084* INBVIR (local input) INTEGER
4085* On entry, INBVIR specifies the number of virtual columns of
4086* the upper left block of the underlying virtual submatrix.
4087* INBVIR must be at least INBLOC.
4088*
4089* IMBLOC (local input) INTEGER
4090* On entry, IMBLOC specifies the number of rows (size) of the
4091* local uppest blocks. IMBLOC is at least zero.
4092*
4093* INBLOC (local input) INTEGER
4094* On entry, INBLOC specifies the number of columns (size) of
4095* the local leftmost blocks. INBLOC is at least zero.
4096*
4097* MB (global input) INTEGER
4098* On entry, MB specifies the size of the blocks used to parti-
4099* tion the matrix rows. MB must be at least one.
4100*
4101* NB (global input) INTEGER
4102* On entry, NB specifies the size of the blocks used to parti-
4103* tion the matrix columns. NB must be at least one.
4104*
4105* RSRC (global input) INTEGER
4106* On entry, RSRC specifies the row coordinate of the process
4107* that possesses the first row of the matrix. When RSRC = -1,
4108* the rows are not distributed but replicated, otherwise RSRC
4109* must be at least zero and strictly less than NPROW.
4110*
4111* CSRC (global input) INTEGER
4112* On entry, CSRC specifies the column coordinate of the pro-
4113* cess that possesses the first column of the matrix. When CSRC
4114* is equal to -1, the columns are not distributed but replica-
4115* ted, otherwise CSRC must be at least zero and strictly less
4116* than NPCOL.
4117*
4118* NPROW (global input) INTEGER
4119* On entry, NPROW specifies the total number of process rows
4120* over which the matrix is distributed. NPROW must be at least
4121* one.
4122*
4123* NPCOL (global input) INTEGER
4124* On entry, NPCOL specifies the total number of process co-
4125* lumns over which the matrix is distributed. NPCOL must be at
4126* least one.
4127*
4128* STRIDE (global input) INTEGER
4129* On entry, STRIDE specifies the number of random numbers to be
4130* generated to compute one matrix entry. In the real case,
4131* STRIDE is usually 1, where as in the complex case STRIDE is
4132* usually 2 in order to generate the real and imaginary parts.
4133*
4134* JMP (local output) INTEGER array
4135* On entry, JMP is an array of dimension JMP_LEN. On exit, this
4136* array contains the different jump values used by the random
4137* matrix generator.
4138*
4139* -- Written on April 1, 1998 by
4140* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4141*
4142* =====================================================================
4143*
4144* .. Parameters ..
4145 INTEGER JMP_1, JMP_COL, JMP_IMBV, JMP_INBV, JMP_LEN,
4146 $ JMP_MB, JMP_NB, JMP_NPIMBLOC, JMP_NPMB,
4147 $ JMP_NQINBLOC, JMP_NQNB, JMP_ROW
4148 parameter( jmp_1 = 1, jmp_row = 2, jmp_col = 3,
4149 $ jmp_mb = 4, jmp_imbv = 5, jmp_npmb = 6,
4150 $ jmp_npimbloc = 7, jmp_nb = 8, jmp_inbv = 9,
4151 $ jmp_nqnb = 10, jmp_nqinbloc = 11,
4152 $ jmp_len = 11 )
4153* ..
4154* .. Local Scalars ..
4155 INTEGER NPMB, NQNB
4156* ..
4157* .. Executable Statements ..
4158*
4159 IF( rsrc.LT.0 ) THEN
4160 npmb = mb
4161 ELSE
4162 npmb = nprow * mb
4163 END IF
4164 IF( csrc.LT.0 ) THEN
4165 nqnb = nb
4166 ELSE
4167 nqnb = npcol * nb
4168 END IF
4169*
4170 jmp( jmp_1 ) = 1
4171*
4172 jmp( jmp_mb ) = mb
4173 jmp( jmp_imbv ) = imbvir
4174 jmp( jmp_npmb ) = npmb
4175 jmp( jmp_npimbloc ) = imbloc + npmb - mb
4176*
4177 jmp( jmp_nb ) = nb
4178 jmp( jmp_inbv ) = inbvir
4179 jmp( jmp_nqnb ) = nqnb
4180 jmp( jmp_nqinbloc ) = inbloc + nqnb - nb
4181*
4182 IF( colmaj ) THEN
4183 jmp( jmp_row ) = stride
4184 jmp( jmp_col ) = stride * nvir
4185 ELSE
4186 jmp( jmp_row ) = stride * nvir
4187 jmp( jmp_col ) = stride
4188 END IF
4189*
4190 RETURN
4191*
4192* End of PB_INITJMP
4193*

◆ pb_initmuladd()

subroutine pb_initmuladd ( integer, dimension( * ) muladd0,
integer, dimension( * ) jmp,
integer, dimension( 4, * ) imuladd )

Definition at line 4195 of file pblastst.f.

4196*
4197* -- PBLAS test routine (version 2.0) --
4198* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4199* and University of California, Berkeley.
4200* April 1, 1998
4201*
4202* .. Array Arguments ..
4203 INTEGER IMULADD( 4, * ), JMP( * ), MULADD0( * )
4204* ..
4205*
4206* Purpose
4207* =======
4208*
4209* PB_INITMULADD initializes the constants a's and c's corresponding to
4210* the jump values (JMP) used by the matrix generator.
4211*
4212* Arguments
4213* =========
4214*
4215* MULADD0 (local input) INTEGER array
4216* On entry, MULADD0 is an array of dimension 4 containing the
4217* encoded initial constants a and c to jump from X( n ) to
4218* X( n+1 ) = a*X( n ) + c in the random sequence. MULADD0(1:2)
4219* contains respectively the 16-lower and 16-higher bits of the
4220* constant a, and MULADD0(3:4) contains the 16-lower and
4221* 16-higher bits of the constant c.
4222*
4223* JMP (local input) INTEGER array
4224* On entry, JMP is an array of dimension JMP_LEN containing the
4225* different jump values used by the matrix generator.
4226*
4227* IMULADD (local output) INTEGER array
4228* On entry, IMULADD is an array of dimension ( 4, JMP_LEN ). On
4229* exit, the jth column of this array contains the encoded ini-
4230* tial constants a_j and c_j to jump from X( n ) to X(n+JMP(j))
4231* (= a_j*X( n ) + c_j) in the random sequence. IMULADD(1:2,j)
4232* contains respectively the 16-lower and 16-higher bits of the
4233* constant a_j, and IMULADD(3:4,j) contains the 16-lower and
4234* 16-higher bits of the constant c_j.
4235*
4236* -- Written on April 1, 1998 by
4237* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4238*
4239* =====================================================================
4240*
4241* .. Parameters ..
4242 INTEGER JMP_1, JMP_COL, JMP_IMBV, JMP_INBV, JMP_LEN,
4243 $ JMP_MB, JMP_NB, JMP_NPIMBLOC, JMP_NPMB,
4244 $ JMP_NQINBLOC, JMP_NQNB, JMP_ROW
4245 parameter( jmp_1 = 1, jmp_row = 2, jmp_col = 3,
4246 $ jmp_mb = 4, jmp_imbv = 5, jmp_npmb = 6,
4247 $ jmp_npimbloc = 7, jmp_nb = 8, jmp_inbv = 9,
4248 $ jmp_nqnb = 10, jmp_nqinbloc = 11,
4249 $ jmp_len = 11 )
4250* ..
4251*
4252* .. Local Arrays ..
4253 INTEGER ITMP1( 2 ), ITMP2( 2 )
4254* ..
4255* .. External Subroutines ..
4256 EXTERNAL pb_jump
4257* ..
4258* .. Executable Statements ..
4259*
4260 itmp2( 1 ) = 100
4261 itmp2( 2 ) = 0
4262*
4263* Compute IMULADD for all JMP values
4264*
4265 CALL pb_jump( jmp( jmp_1 ), muladd0, itmp2, itmp1,
4266 $ imuladd( 1, jmp_1 ) )
4267*
4268 CALL pb_jump( jmp( jmp_row ), muladd0, itmp1, itmp2,
4269 $ imuladd( 1, jmp_row ) )
4270 CALL pb_jump( jmp( jmp_col ), muladd0, itmp1, itmp2,
4271 $ imuladd( 1, jmp_col ) )
4272*
4273* Compute constants a and c to jump JMP( * ) numbers in the
4274* sequence for column- or row-major ordering of the sequence.
4275*
4276 CALL pb_jump( jmp( jmp_imbv ), imuladd( 1, jmp_row ), itmp1,
4277 $ itmp2, imuladd( 1, jmp_imbv ) )
4278 CALL pb_jump( jmp( jmp_mb ), imuladd( 1, jmp_row ), itmp1,
4279 $ itmp2, imuladd( 1, jmp_mb ) )
4280 CALL pb_jump( jmp( jmp_npmb ), imuladd( 1, jmp_row ), itmp1,
4281 $ itmp2, imuladd( 1, jmp_npmb ) )
4282 CALL pb_jump( jmp( jmp_npimbloc ), imuladd( 1, jmp_row ), itmp1,
4283 $ itmp2, imuladd( 1, jmp_npimbloc ) )
4284*
4285 CALL pb_jump( jmp( jmp_inbv ), imuladd( 1, jmp_col ), itmp1,
4286 $ itmp2, imuladd( 1, jmp_inbv ) )
4287 CALL pb_jump( jmp( jmp_nb ), imuladd( 1, jmp_col ), itmp1,
4288 $ itmp2, imuladd( 1, jmp_nb ) )
4289 CALL pb_jump( jmp( jmp_nqnb ), imuladd( 1, jmp_col ), itmp1,
4290 $ itmp2, imuladd( 1, jmp_nqnb ) )
4291 CALL pb_jump( jmp( jmp_nqinbloc ), imuladd( 1, jmp_col ), itmp1,
4292 $ itmp2, imuladd( 1, jmp_nqinbloc ) )
4293*
4294 RETURN
4295*
4296* End of PB_INITMULADD
4297*
pb_jump
subroutine pb_jump(k, muladd, irann, iranm, ima)
Definition pblastst.f:4648

◆ pb_jump()

subroutine pb_jump ( integer k,
integer, dimension( 4 ) muladd,
integer, dimension( 2 ) irann,
integer, dimension( 2 ) iranm,
integer, dimension( 4 ) ima )

Definition at line 4647 of file pblastst.f.

4648*
4649* -- PBLAS test routine (version 2.0) --
4650* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4651* and University of California, Berkeley.
4652* April 1, 1998
4653*
4654* .. Scalar Arguments ..
4655 INTEGER K
4656* ..
4657* .. Array Arguments ..
4658 INTEGER IMA( 4 ), IRANM( 2 ), IRANN( 2 ), MULADD( 4 )
4659* ..
4660*
4661* Purpose
4662* =======
4663*
4664* PB_JUMP computes the constants A and C to jump K numbers in the ran-
4665* dom sequence:
4666*
4667* X( n+K ) = A * X( n ) + C.
4668*
4669* The constants encoded in MULADD specify how to jump from entry in the
4670* sequence to the next.
4671*
4672* Arguments
4673* =========
4674*
4675* K (local input) INTEGER
4676* On entry, K specifies the number of entries of the sequence
4677* to jump over. When K is less or equal than zero, A and C are
4678* not computed, and IRANM is set to IRANN corresponding to a
4679* jump of size zero.
4680*
4681* MULADD (local input) INTEGER array
4682* On entry, MULADD is an array of dimension 4 containing the
4683* encoded constants a and c to jump from X( n ) to X( n+1 )
4684* ( = a*X( n )+c) in the random sequence. MULADD(1:2) contains
4685* respectively the 16-lower and 16-higher bits of the constant
4686* a, and MULADD(3:4) contains the 16-lower and 16-higher bits
4687* of the constant c.
4688*
4689* IRANN (local input) INTEGER array
4690* On entry, IRANN is an array of dimension 2. This array con-
4691* tains respectively the 16-lower and 16-higher bits of the en-
4692* coding of X( n ).
4693*
4694* IRANM (local output) INTEGER array
4695* On entry, IRANM is an array of dimension 2. On exit, this
4696* array contains respectively the 16-lower and 16-higher bits
4697* of the encoding of X( n+K ).
4698*
4699* IMA (local output) INTEGER array
4700* On entry, IMA is an array of dimension 4. On exit, when K is
4701* greater than zero, this array contains the encoded constants
4702* A and C to jump from X( n ) to X( n+K ) in the random se-
4703* quence. IMA(1:2) contains respectively the 16-lower and
4704* 16-higher bits of the constant A, and IMA(3:4) contains the
4705* 16-lower and 16-higher bits of the constant C. When K is
4706* less or equal than zero, this array is not referenced.
4707*
4708* -- Written on April 1, 1998 by
4709* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4710*
4711* =====================================================================
4712*
4713* .. Local Scalars ..
4714 INTEGER I
4715* ..
4716* .. Local Arrays ..
4717 INTEGER J( 2 )
4718* ..
4719* .. External Subroutines ..
4720 EXTERNAL pb_ladd, pb_lmul
4721* ..
4722* .. Executable Statements ..
4723*
4724 IF( k.GT.0 ) THEN
4725*
4726 ima( 1 ) = muladd( 1 )
4727 ima( 2 ) = muladd( 2 )
4728 ima( 3 ) = muladd( 3 )
4729 ima( 4 ) = muladd( 4 )
4730*
4731 DO 10 i = 1, k - 1
4732*
4733 CALL pb_lmul( ima, muladd, j )
4734*
4735 ima( 1 ) = j( 1 )
4736 ima( 2 ) = j( 2 )
4737*
4738 CALL pb_lmul( ima( 3 ), muladd, j )
4739 CALL pb_ladd( muladd( 3 ), j, ima( 3 ) )
4740*
4741 10 CONTINUE
4742*
4743 CALL pb_lmul( irann, ima, j )
4744 CALL pb_ladd( j, ima( 3 ), iranm )
4745*
4746 ELSE
4747*
4748 iranm( 1 ) = irann( 1 )
4749 iranm( 2 ) = irann( 2 )
4750*
4751 END IF
4752*
4753 RETURN
4754*
4755* End of PB_JUMP
4756*
pb_ladd
subroutine pb_ladd(j, k, i)
Definition pblastst.f:4480
pb_lmul
subroutine pb_lmul(k, j, i)
Definition pblastst.f:4559

◆ pb_jumpit()

subroutine pb_jumpit ( integer, dimension( 4 ) muladd,
integer, dimension( 2 ) irann,
integer, dimension( 2 ) iranm )

Definition at line 4821 of file pblastst.f.

4822*
4823* -- PBLAS test routine (version 2.0) --
4824* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4825* and University of California, Berkeley.
4826* April 1, 1998
4827*
4828* .. Array Arguments ..
4829 INTEGER IRANM( 2 ), IRANN( 2 ), MULADD( 4 )
4830* ..
4831*
4832* Purpose
4833* =======
4834*
4835* PB_JUMPIT jumps in the random sequence from the number X( n ) enco-
4836* ded in IRANN to the number X( m ) encoded in IRANM using the cons-
4837* tants A and C encoded in MULADD:
4838*
4839* X( m ) = A * X( n ) + C.
4840*
4841* The constants A and C obviously depend on m and n, see the subroutine
4842* PB_JUMP in order to set them up.
4843*
4844* Arguments
4845* =========
4846*
4847* MULADD (local input) INTEGER array
4848* On netry, MULADD is an array of dimension 4. MULADD(1:2) con-
4849* tains respectively the 16-lower and 16-higher bits of the
4850* constant A, and MULADD(3:4) contains the 16-lower and
4851* 16-higher bits of the constant C.
4852*
4853* IRANN (local input) INTEGER array
4854* On entry, IRANN is an array of dimension 2. This array con-
4855* tains respectively the 16-lower and 16-higher bits of the en-
4856* coding of X( n ).
4857*
4858* IRANM (local output) INTEGER array
4859* On entry, IRANM is an array of dimension 2. On exit, this
4860* array contains respectively the 16-lower and 16-higher bits
4861* of the encoding of X( m ).
4862*
4863* -- Written on April 1, 1998 by
4864* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4865*
4866* =====================================================================
4867*
4868* .. Local Arrays ..
4869 INTEGER J( 2 )
4870* ..
4871* .. External Subroutines ..
4872 EXTERNAL pb_ladd, pb_lmul
4873* ..
4874* .. Common Blocks ..
4875 INTEGER IACS( 4 ), IRAND( 2 )
4876 COMMON /rancom/ irand, iacs
4877* ..
4878* .. Save Statements ..
4879 SAVE /rancom/
4880* ..
4881* .. Executable Statements ..
4882*
4883 CALL pb_lmul( irann, muladd, j )
4884 CALL pb_ladd( j, muladd( 3 ), iranm )
4885*
4886 irand( 1 ) = iranm( 1 )
4887 irand( 2 ) = iranm( 2 )
4888*
4889 RETURN
4890*
4891* End of PB_JUMPIT
4892*

◆ pb_ladd()

subroutine pb_ladd ( integer, dimension( 2 ) j,
integer, dimension( 2 ) k,
integer, dimension( 2 ) i )

Definition at line 4479 of file pblastst.f.

4480*
4481* -- PBLAS test routine (version 2.0) --
4482* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4483* and University of California, Berkeley.
4484* April 1, 1998
4485*
4486* .. Array Arguments ..
4487 INTEGER I( 2 ), J( 2 ), K( 2 )
4488* ..
4489*
4490* Purpose
4491* =======
4492*
4493* PB_LADD adds without carry two long positive integers K and J and put
4494* the result into I. The long integers I, J, K are encoded on 31 bits
4495* using an array of 2 integers. The 16-lower bits are stored in the
4496* first entry of each array, the 15-higher bits in the second entry.
4497* For efficiency purposes, the intrisic modulo function is inlined.
4498*
4499* Arguments
4500* =========
4501*
4502* J (local input) INTEGER array
4503* On entry, J is an array of dimension 2 containing the encoded
4504* long integer J.
4505*
4506* K (local input) INTEGER array
4507* On entry, K is an array of dimension 2 containing the encoded
4508* long integer K.
4509*
4510* I (local output) INTEGER array
4511* On entry, I is an array of dimension 2. On exit, this array
4512* contains the encoded long integer I.
4513*
4514* Further Details
4515* ===============
4516*
4517* K( 2 ) K( 1 )
4518* 0XXXXXXX XXXXXXXX K I( 1 ) = MOD( K( 1 ) + J( 1 ), 2**16 )
4519* + carry = ( K( 1 ) + J( 1 ) ) / 2**16
4520* J( 2 ) J( 1 )
4521* 0XXXXXXX XXXXXXXX J I( 2 ) = K( 2 ) + J( 2 ) + carry
4522* ---------------------- I( 2 ) = MOD( I( 2 ), 2**15 )
4523* I( 2 ) I( 1 )
4524* 0XXXXXXX XXXXXXXX I
4525*
4526* -- Written on April 1, 1998 by
4527* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4528*
4529* =====================================================================
4530*
4531* .. Parameters ..
4532 INTEGER IPOW15, IPOW16
4533 parameter( ipow15 = 2**15, ipow16 = 2**16 )
4534* ..
4535* .. Local Scalars ..
4536 INTEGER ITMP1, ITMP2
4537* ..
4538* .. Executable Statements ..
4539*
4540* I( 1 ) = MOD( K( 1 ) + J( 1 ), IPOW16 )
4541*
4542 itmp1 = k( 1 ) + j( 1 )
4543 itmp2 = itmp1 / ipow16
4544 i( 1 ) = itmp1 - itmp2 * ipow16
4545*
4546* I( 2 ) = MOD( ( K( 1 ) + J( 1 ) ) / IPOW16 + K( 2 ) + J( 2 ),
4547* IPOW15 )
4548*
4549 itmp1 = itmp2 + k( 2 ) + j( 2 )
4550 itmp2 = itmp1 / ipow15
4551 i( 2 ) = itmp1 - itmp2 * ipow15
4552*
4553 RETURN
4554*
4555* End of PB_LADD
4556*

◆ pb_lmul()

subroutine pb_lmul ( integer, dimension( 2 ) k,
integer, dimension( 2 ) j,
integer, dimension( 2 ) i )

Definition at line 4558 of file pblastst.f.

4559*
4560* -- PBLAS test routine (version 2.0) --
4561* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4562* and University of California, Berkeley.
4563* April 1, 1998
4564*
4565* .. Array Arguments ..
4566 INTEGER I( 2 ), J( 2 ), K( 2 )
4567* ..
4568*
4569* Purpose
4570* =======
4571*
4572* PB_LMUL multiplies without carry two long positive integers K and J
4573* and put the result into I. The long integers I, J, K are encoded on
4574* 31 bits using an array of 2 integers. The 16-lower bits are stored in
4575* the first entry of each array, the 15-higher bits in the second entry
4576* of each array. For efficiency purposes, the intrisic modulo function
4577* is inlined.
4578*
4579* Arguments
4580* =========
4581*
4582* K (local input) INTEGER array
4583* On entry, K is an array of dimension 2 containing the encoded
4584* long integer K.
4585*
4586* J (local input) INTEGER array
4587* On entry, J is an array of dimension 2 containing the encoded
4588* long integer J.
4589*
4590* I (local output) INTEGER array
4591* On entry, I is an array of dimension 2. On exit, this array
4592* contains the encoded long integer I.
4593*
4594* Further Details
4595* ===============
4596*
4597* K( 2 ) K( 1 )
4598* 0XXXXXXX XXXXXXXX K I( 1 ) = MOD( K( 1 ) + J( 1 ), 2**16 )
4599* * carry = ( K( 1 ) + J( 1 ) ) / 2**16
4600* J( 2 ) J( 1 )
4601* 0XXXXXXX XXXXXXXX J I( 2 ) = K( 2 ) + J( 2 ) + carry
4602* ---------------------- I( 2 ) = MOD( I( 2 ), 2**15 )
4603* I( 2 ) I( 1 )
4604* 0XXXXXXX XXXXXXXX I
4605*
4606* -- Written on April 1, 1998 by
4607* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4608*
4609* =====================================================================
4610*
4611* .. Parameters ..
4612 INTEGER IPOW15, IPOW16, IPOW30
4613 parameter( ipow15 = 2**15, ipow16 = 2**16,
4614 $ ipow30 = 2**30 )
4615* ..
4616* .. Local Scalars ..
4617 INTEGER ITMP1, ITMP2
4618* ..
4619* .. Executable Statements ..
4620*
4621 itmp1 = k( 1 ) * j( 1 )
4622 IF( itmp1.LT.0 )
4623 $ itmp1 = ( itmp1 + ipow30 ) + ipow30
4624*
4625* I( 1 ) = MOD( ITMP1, IPOW16 )
4626*
4627 itmp2 = itmp1 / ipow16
4628 i( 1 ) = itmp1 - itmp2 * ipow16
4629*
4630 itmp1 = k( 1 ) * j( 2 ) + k( 2 ) * j( 1 )
4631 IF( itmp1.LT.0 )
4632 $ itmp1 = ( itmp1 + ipow30 ) + ipow30
4633*
4634 itmp1 = itmp2 + itmp1
4635 IF( itmp1.LT.0 )
4636 $ itmp1 = ( itmp1 + ipow30 ) + ipow30
4637*
4638* I( 2 ) = MOD( ITMP1, IPOW15 )
4639*
4640 i( 2 ) = itmp1 - ( itmp1 / ipow15 ) * ipow15
4641*
4642 RETURN
4643*
4644* End of PB_LMUL
4645*

◆ pb_locinfo()

subroutine pb_locinfo ( integer i,
integer inb,
integer nb,
integer myroc,
integer srcproc,
integer nprocs,
integer ilocblk,
integer ilocoff,
integer mydist )

Definition at line 3908 of file pblastst.f.

3910*
3911* -- PBLAS test routine (version 2.0) --
3912* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
3913* and University of California, Berkeley.
3914* April 1, 1998
3915*
3916* .. Scalar Arguments ..
3917 INTEGER I, ILOCBLK, ILOCOFF, INB, MYDIST, MYROC, NB,
3918 $ NPROCS, SRCPROC
3919* ..
3920*
3921* Purpose
3922* =======
3923*
3924* PB_LOCINFO computes local information about the beginning of a sub-
3925* matrix starting at the global index I.
3926*
3927* Arguments
3928* =========
3929*
3930* I (global input) INTEGER
3931* On entry, I specifies the global starting index in the ma-
3932* trix. I must be at least one.
3933*
3934* INB (global input) INTEGER
3935* On entry, INB specifies the size of the first block of rows
3936* or columns of the matrix. INB must be at least one.
3937*
3938* NB (global input) INTEGER
3939* On entry, NB specifies the size of the blocks of rows or co-
3940* lumns of the matrix is partitioned into. NB must be at least
3941* one.
3942*
3943* MYROC (local input) INTEGER
3944* On entry, MYROC is the coordinate of the process whose local
3945* information is determined. MYROC is at least zero and
3946* strictly less than NPROCS.
3947*
3948* SRCPROC (global input) INTEGER
3949* On entry, SRCPROC specifies the coordinate of the process
3950* that possesses the first row or column of the matrix. When
3951* SRCPROC = -1, the data is not distributed but replicated,
3952* otherwise SRCPROC must be at least zero and strictly less
3953* than NPROCS.
3954*
3955* NPROCS (global input) INTEGER
3956* On entry, NPROCS specifies the total number of process rows
3957* or columns over which the submatrix is distributed. NPROCS
3958* must be at least one.
3959*
3960* ILOCBLK (local output) INTEGER
3961* On exit, ILOCBLK specifies the local row or column block
3962* coordinate corresponding to the row or column I of the ma-
3963* trix. ILOCBLK must be at least zero.
3964*
3965* ILOCOFF (local output) INTEGER
3966* On exit, ILOCOFF specifies the local row offset in the block
3967* of local coordinate ILOCBLK corresponding to the row or co-
3968* lumn I of the matrix. ILOCOFF must at least zero.
3969*
3970* MYDIST (local output) INTEGER
3971* On exit, MYDIST specifies the relative process coordinate of
3972* the process specified by MYROC to the process owning the row
3973* or column I. MYDIST is at least zero and strictly less than
3974* NPROCS.
3975*
3976* -- Written on April 1, 1998 by
3977* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
3978*
3979* =====================================================================
3980*
3981* .. Local Scalars ..
3982 INTEGER ITMP, NBLOCKS, PROC
3983* ..
3984* .. Executable Statements ..
3985*
3986 ilocoff = 0
3987*
3988 IF( srcproc.LT.0 ) THEN
3989*
3990 mydist = 0
3991*
3992 IF( i.LE.inb ) THEN
3993*
3994 ilocblk = 0
3995 ilocoff = i - 1
3996*
3997 ELSE
3998*
3999 itmp = i - inb
4000 nblocks = ( itmp - 1 ) / nb + 1
4001 ilocblk = nblocks
4002 ilocoff = itmp - 1 - ( nblocks - 1 ) * nb
4003*
4004 END IF
4005*
4006 ELSE
4007*
4008 proc = srcproc
4009 mydist = myroc - proc
4010 IF( mydist.LT.0 )
4011 $ mydist = mydist + nprocs
4012*
4013 IF( i.LE.inb ) THEN
4014*
4015 ilocblk = 0
4016 IF( myroc.EQ.proc )
4017 $ ilocoff = i - 1
4018*
4019 ELSE
4020*
4021 itmp = i - inb
4022 nblocks = ( itmp - 1 ) / nb + 1
4023 proc = proc + nblocks
4024 proc = proc - ( proc / nprocs ) * nprocs
4025 ilocblk = nblocks / nprocs
4026*
4027 IF( ( ilocblk*nprocs ).LT.( mydist-nblocks ) )
4028 $ ilocblk = ilocblk + 1
4029*
4030 IF( myroc.EQ.proc )
4031 $ ilocoff = itmp - 1 - ( nblocks - 1 ) * nb
4032*
4033 END IF
4034*
4035 END IF
4036*
4037 RETURN
4038*
4039* End of PB_LOCINFO
4040*

◆ pb_noabort()

integer function pb_noabort ( integer cinfo)

Definition at line 1621 of file pblastst.f.

1622*
1623* -- PBLAS test routine (version 2.0) --
1624* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1625* and University of California, Berkeley.
1626* April 1, 1998
1627*
1628* .. Scalar Arguments ..
1629 INTEGER CINFO
1630* ..
1631*
1632* Purpose
1633* =======
1634*
1635* PB_NOABORT transmits the info parameter of a PBLAS routine to the
1636* tester and tells the PBLAS error handler to avoid aborting on erro-
1637* neous input arguments.
1638*
1639* Notes
1640* =====
1641*
1642* This routine is necessary because of the CRAY C fortran interface
1643* and the fact that the usual PBLAS error handler routine has been
1644* initially written in C.
1645*
1646* -- Written on April 1, 1998 by
1647* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1648*
1649* =====================================================================
1650*
1651* .. Common Blocks ..
1652 INTEGER INFO, NBLOG, NOUT
1653 LOGICAL ABRTFLG
1654 COMMON /infoc/info, nblog
1655 COMMON /pberrorc/nout, abrtflg
1656* ..
1657* .. Executable Statements ..
1658*
1659 info = cinfo
1660 IF( abrtflg ) THEN
1661 pb_noabort = 0
1662 ELSE
1663 pb_noabort = 1
1664 END IF
1665*
1666 RETURN
1667*
1668* End of PB_NOABORT
1669*
pb_noabort
integer function pb_noabort(cinfo)
Definition pblastst.f:1622

◆ pb_numroc()

integer function pb_numroc ( integer n,
integer i,
integer inb,
integer nb,
integer proc,
integer srcproc,
integer nprocs )

Definition at line 2547 of file pblastst.f.

2548*
2549* -- PBLAS test routine (version 2.0) --
2550* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
2551* and University of California, Berkeley.
2552* April 1, 1998
2553*
2554* .. Scalar Arguments ..
2555 INTEGER I, INB, N, NB, NPROCS, PROC, SRCPROC
2556* ..
2557*
2558* Purpose
2559* =======
2560*
2561* PB_NUMROC returns the local number of matrix rows/columns process
2562* PROC will get if we give out N rows/columns starting from global in-
2563* dex I.
2564*
2565* Arguments
2566* =========
2567*
2568* N (global input) INTEGER
2569* On entry, N specifies the number of rows/columns being dealt
2570* out. N must be at least zero.
2571*
2572* I (global input) INTEGER
2573* On entry, I specifies the global index of the matrix entry.
2574* I must be at least one.
2575*
2576* INB (global input) INTEGER
2577* On entry, INB specifies the size of the first block of the
2578* global matrix. INB must be at least one.
2579*
2580* NB (global input) INTEGER
2581* On entry, NB specifies the size of the blocks used to parti-
2582* tion the matrix. NB must be at least one.
2583*
2584* PROC (local input) INTEGER
2585* On entry, PROC specifies the coordinate of the process whose
2586* local portion is determined. PROC must be at least zero and
2587* strictly less than NPROCS.
2588*
2589* SRCPROC (global input) INTEGER
2590* On entry, SRCPROC specifies the coordinate of the process
2591* that possesses the first row or column of the matrix. When
2592* SRCPROC = -1, the data is not distributed but replicated,
2593* otherwise SRCPROC must be at least zero and strictly less
2594* than NPROCS.
2595*
2596* NPROCS (global input) INTEGER
2597* On entry, NPROCS specifies the total number of process rows
2598* or columns over which the matrix is distributed. NPROCS must
2599* be at least one.
2600*
2601* -- Written on April 1, 1998 by
2602* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
2603*
2604* =====================================================================
2605*
2606* .. Local Scalars ..
2607 INTEGER I1, ILOCBLK, INB1, MYDIST, N1, NBLOCKS,
2608 $ SRCPROC1
2609* ..
2610* .. Executable Statements ..
2611*
2612 IF( ( srcproc.EQ.-1 ).OR.( nprocs.EQ.1 ) ) THEN
2613 pb_numroc = n
2614 RETURN
2615 END IF
2616*
2617* Compute coordinate of process owning I and corresponding INB
2618*
2619 IF( i.LE.inb ) THEN
2620*
2621* I is in range of first block, i.e SRCPROC owns I.
2622*
2623 srcproc1 = srcproc
2624 inb1 = inb - i + 1
2625*
2626 ELSE
2627*
2628* I is not in first block of matrix, figure out who has it
2629*
2630 i1 = i - 1 - inb
2631 nblocks = i1 / nb + 1
2632 srcproc1 = srcproc + nblocks
2633 srcproc1 = srcproc1 - ( srcproc1 / nprocs ) * nprocs
2634 inb1 = nblocks*nb - i1
2635*
2636 END IF
2637*
2638* Now everything is just like I=1. Search now who has N-1, Is N-1
2639* in the first block ?
2640*
2641 IF( n.LE.inb1 ) THEN
2642 IF( proc.EQ.srcproc1 ) THEN
2643 pb_numroc = n
2644 ELSE
2645 pb_numroc = 0
2646 END IF
2647 RETURN
2648 END IF
2649*
2650 n1 = n - inb1
2651 nblocks = n1 / nb + 1
2652*
2653 IF( proc.EQ.srcproc1 ) THEN
2654 ilocblk = nblocks / nprocs
2655 IF( ilocblk.GT.0 ) THEN
2656 IF( ( nblocks - ilocblk * nprocs ).GT.0 ) THEN
2657 pb_numroc = inb1 + ilocblk * nb
2658 ELSE
2659 pb_numroc = n + nb * ( ilocblk - nblocks )
2660 END IF
2661 ELSE
2662 pb_numroc = inb1
2663 END IF
2664 ELSE
2665 mydist = proc - srcproc1
2666 IF( mydist.LT.0 )
2667 $ mydist = mydist + nprocs
2668 ilocblk = nblocks / nprocs
2669 IF( ilocblk.GT.0 ) THEN
2670 mydist = mydist - nblocks + ilocblk * nprocs
2671 IF( mydist.LT.0 ) THEN
2672 pb_numroc = ( ilocblk + 1 ) * nb
2673 ELSE IF( mydist.GT.0 ) THEN
2674 pb_numroc = ilocblk * nb
2675 ELSE
2676 pb_numroc = n1 + nb * ( ilocblk - nblocks + 1 )
2677 END IF
2678 ELSE
2679 mydist = mydist - nblocks
2680 IF( mydist.LT.0 ) THEN
2681 pb_numroc = nb
2682 ELSE IF( mydist.GT.0 ) THEN
2683 pb_numroc = 0
2684 ELSE
2685 pb_numroc = n1 + nb * ( 1 - nblocks )
2686 END IF
2687 END IF
2688 END IF
2689*
2690 RETURN
2691*
2692* End of PB_NUMROC
2693*

◆ pb_setlocran()

subroutine pb_setlocran ( integer seed,
integer ilocblk,
integer jlocblk,
integer ilocoff,
integer jlocoff,
integer myrdist,
integer mycdist,
integer nprow,
integer npcol,
integer, dimension( * ) jmp,
integer, dimension( 4, * ) imuladd,
integer, dimension( * ) iran )

Definition at line 4299 of file pblastst.f.

4302*
4303* -- PBLAS test routine (version 2.0) --
4304* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4305* and University of California, Berkeley.
4306* April 1, 1998
4307*
4308* .. Scalar Arguments ..
4309 INTEGER ILOCBLK, ILOCOFF, JLOCBLK, JLOCOFF, MYCDIST,
4310 $ MYRDIST, NPCOL, NPROW, SEED
4311* ..
4312* .. Array Arguments ..
4313 INTEGER IMULADD( 4, * ), IRAN( * ), JMP( * )
4314* ..
4315*
4316* Purpose
4317* =======
4318*
4319* PB_SETLOCRAN locally initializes the random number generator.
4320*
4321* Arguments
4322* =========
4323*
4324* SEED (global input) INTEGER
4325* On entry, SEED specifies a positive integer used to initiali-
4326* ze the first number in the random sequence used by the matrix
4327* generator. SEED must be at least zero.
4328*
4329* ILOCBLK (local input) INTEGER
4330* On entry, ILOCBLK specifies the local row block coordinate
4331* corresponding to the first row of the submatrix of interest.
4332* ILOCBLK must be at least zero.
4333*
4334* ILOCOFF (local input) INTEGER
4335* On entry, ILOCOFF specifies the local row offset in the block
4336* of local coordinate ILOCBLK corresponding to the first row of
4337* the submatrix of interest. ILOCOFF must at least zero.
4338*
4339* JLOCBLK (local input) INTEGER
4340* On entry, JLOCBLK specifies the local column block coordinate
4341* corresponding to the first column of the submatrix of inte-
4342* rest. JLOCBLK must be at least zero.
4343*
4344* JLOCOFF (local input) INTEGER
4345* On entry, JLOCOFF specifies the local column offset in the
4346* block of local coordinate JLOCBLK corresponding to the first
4347* column of the submatrix of interest. JLOCOFF must be at least
4348* zero.
4349*
4350* MYRDIST (local input) INTEGER
4351* On entry, MYRDIST specifies the relative row process coordi-
4352* nate to the process owning the first row of the submatrix of
4353* interest. MYRDIST must be at least zero and stricly less than
4354* NPROW (see the subroutine PB_LOCINFO).
4355*
4356* MYCDIST (local input) INTEGER
4357* On entry, MYCDIST specifies the relative column process coor-
4358* dinate to the process owning the first column of the subma-
4359* trix of interest. MYCDIST must be at least zero and stricly
4360* less than NPCOL (see the subroutine PB_LOCINFO).
4361*
4362* NPROW (global input) INTEGER
4363* On entry, NPROW specifies the total number of process rows
4364* over which the matrix is distributed. NPROW must be at least
4365* one.
4366*
4367* NPCOL (global input) INTEGER
4368* On entry, NPCOL specifies the total number of process co-
4369* lumns over which the matrix is distributed. NPCOL must be at
4370* least one.
4371*
4372* JMP (local input) INTEGER array
4373* On entry, JMP is an array of dimension JMP_LEN containing the
4374* different jump values used by the matrix generator.
4375*
4376* IMULADD (local input) INTEGER array
4377* On entry, IMULADD is an array of dimension (4, JMP_LEN). The
4378* jth column of this array contains the encoded initial cons-
4379* tants a_j and c_j to jump from X( n ) to X( n + JMP( j ) )
4380* (= a_j * X( n ) + c_j) in the random sequence. IMULADD(1:2,j)
4381* contains respectively the 16-lower and 16-higher bits of the
4382* constant a_j, and IMULADD(3:4,j) contains the 16-lower and
4383* 16-higher bits of the constant c_j.
4384*
4385* IRAN (local output) INTEGER array
4386* On entry, IRAN is an array of dimension 2. On exit, IRAN con-
4387* tains respectively the 16-lower and 32-higher bits of the en-
4388* coding of the entry of the random sequence corresponding lo-
4389* cally to the first local array entry to generate.
4390*
4391* -- Written on April 1, 1998 by
4392* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4393*
4394* =====================================================================
4395*
4396* .. Parameters ..
4397 INTEGER JMP_1, JMP_COL, JMP_IMBV, JMP_INBV, JMP_LEN,
4398 $ JMP_MB, JMP_NB, JMP_NPIMBLOC, JMP_NPMB,
4399 $ JMP_NQINBLOC, JMP_NQNB, JMP_ROW
4400 parameter( jmp_1 = 1, jmp_row = 2, jmp_col = 3,
4401 $ jmp_mb = 4, jmp_imbv = 5, jmp_npmb = 6,
4402 $ jmp_npimbloc = 7, jmp_nb = 8, jmp_inbv = 9,
4403 $ jmp_nqnb = 10, jmp_nqinbloc = 11,
4404 $ jmp_len = 11 )
4405* ..
4406* .. Local Arrays ..
4407 INTEGER IMULADDTMP( 4 ), ITMP( 2 )
4408* ..
4409* .. External Subroutines ..
4410 EXTERNAL pb_jump, pb_setran
4411* ..
4412* .. Executable Statements ..
4413*
4414* Compute and set the value of IRAN corresponding to A( IA, JA )
4415*
4416 itmp( 1 ) = seed
4417 itmp( 2 ) = 0
4418*
4419 CALL pb_jump( jmp( jmp_1 ), imuladd( 1, jmp_1 ), itmp, iran,
4420 $ imuladdtmp )
4421*
4422* Jump ILOCBLK blocks of rows + ILOCOFF rows
4423*
4424 CALL pb_jump( ilocoff, imuladd( 1, jmp_row ), iran, itmp,
4425 $ imuladdtmp )
4426 IF( myrdist.GT.0 ) THEN
4427 CALL pb_jump( jmp( jmp_imbv ), imuladd( 1, jmp_row ), itmp,
4428 $ iran, imuladdtmp )
4429 CALL pb_jump( myrdist - 1, imuladd( 1, jmp_mb ), iran,
4430 $ itmp, imuladdtmp )
4431 CALL pb_jump( ilocblk, imuladd( 1, jmp_npmb ), itmp,
4432 $ iran, imuladdtmp )
4433 ELSE
4434 IF( ilocblk.GT.0 ) THEN
4435 CALL pb_jump( jmp( jmp_imbv ), imuladd( 1, jmp_row ), itmp,
4436 $ iran, imuladdtmp )
4437 CALL pb_jump( nprow - 1, imuladd( 1, jmp_mb ), iran,
4438 $ itmp, imuladdtmp )
4439 CALL pb_jump( ilocblk - 1, imuladd( 1, jmp_npmb ), itmp,
4440 $ iran, imuladdtmp )
4441 ELSE
4442 CALL pb_jump( 0, imuladd( 1, jmp_1 ), itmp,
4443 $ iran, imuladdtmp )
4444 END IF
4445 END IF
4446*
4447* Jump JLOCBLK blocks of columns + JLOCOFF columns
4448*
4449 CALL pb_jump( jlocoff, imuladd( 1, jmp_col ), iran, itmp,
4450 $ imuladdtmp )
4451 IF( mycdist.GT.0 ) THEN
4452 CALL pb_jump( jmp( jmp_inbv ), imuladd( 1, jmp_col ), itmp,
4453 $ iran, imuladdtmp )
4454 CALL pb_jump( mycdist - 1, imuladd( 1, jmp_nb ), iran,
4455 $ itmp, imuladdtmp )
4456 CALL pb_jump( jlocblk, imuladd( 1, jmp_nqnb ), itmp,
4457 $ iran, imuladdtmp )
4458 ELSE
4459 IF( jlocblk.GT.0 ) THEN
4460 CALL pb_jump( jmp( jmp_inbv ), imuladd( 1, jmp_col ), itmp,
4461 $ iran, imuladdtmp )
4462 CALL pb_jump( npcol - 1, imuladd( 1, jmp_nb ), iran,
4463 $ itmp, imuladdtmp )
4464 CALL pb_jump( jlocblk - 1, imuladd( 1, jmp_nqnb ), itmp,
4465 $ iran, imuladdtmp )
4466 ELSE
4467 CALL pb_jump( 0, imuladd( 1, jmp_1 ), itmp,
4468 $ iran, imuladdtmp )
4469 END IF
4470 END IF
4471*
4472 CALL pb_setran( iran, imuladd( 1, jmp_1 ) )
4473*
4474 RETURN
4475*
4476* End of PB_SETLOCRAN
4477*
seed
#define seed()
Definition macros.h:43
pb_setran
subroutine pb_setran(iran, iac)
Definition pblastst.f:4759

◆ pb_setran()

subroutine pb_setran ( integer, dimension( 2 ) iran,
integer, dimension( 4 ) iac )

Definition at line 4758 of file pblastst.f.

4759*
4760* -- PBLAS test routine (version 2.0) --
4761* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
4762* and University of California, Berkeley.
4763* April 1, 1998
4764*
4765* .. Array Arguments ..
4766 INTEGER IAC( 4 ), IRAN( 2 )
4767* ..
4768*
4769* Purpose
4770* =======
4771*
4772* PB_SETRAN initializes the random generator with the encoding of the
4773* first number X( 1 ) in the sequence, and the constants a and c used
4774* to compute the next element in the sequence:
4775*
4776* X( n+1 ) = a * X( n ) + c.
4777*
4778* X( 1 ), a and c are stored in the common block RANCOM for later use
4779* (see the routines PB_SRAN or PB_DRAN).
4780*
4781* Arguments
4782* =========
4783*
4784* IRAN (local input) INTEGER array
4785* On entry, IRAN is an array of dimension 2. This array con-
4786* tains respectively the 16-lower and 16-higher bits of the en-
4787* coding of X( 1 ).
4788*
4789* IAC (local input) INTEGER array
4790* On entry, IAC is an array of dimension 4. IAC(1:2) contain
4791* respectively the 16-lower and 16-higher bits of the constant
4792* a, and IAC(3:4) contain the 16-lower and 16-higher bits of
4793* the constant c.
4794*
4795* -- Written on April 1, 1998 by
4796* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
4797*
4798* =====================================================================
4799*
4800* .. Common Blocks ..
4801 INTEGER IACS( 4 ), IRAND( 2 )
4802 COMMON /rancom/ irand, iacs
4803* ..
4804* .. Save Statements ..
4805 SAVE /rancom/
4806* ..
4807* .. Executable Statements ..
4808*
4809 irand( 1 ) = iran( 1 )
4810 irand( 2 ) = iran( 2 )
4811 iacs( 1 ) = iac( 1 )
4812 iacs( 2 ) = iac( 2 )
4813 iacs( 3 ) = iac( 3 )
4814 iacs( 4 ) = iac( 4 )
4815*
4816 RETURN
4817*
4818* End of PB_SETRAN
4819*

◆ pchkpbe()

subroutine pchkpbe ( integer ictxt,
integer nout,
character*(*) sname,
integer infot )

Definition at line 1083 of file pblastst.f.

1084*
1085* -- PBLAS test routine (version 2.0) --
1086* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1087* and University of California, Berkeley.
1088* April 1, 1998
1089*
1090* .. Scalar Arguments ..
1091 INTEGER ICTXT, INFOT, NOUT
1092 CHARACTER*(*) SNAME
1093* ..
1094*
1095* Purpose
1096* =======
1097*
1098* PCHKPBE tests whether a PBLAS routine has detected an error when it
1099* should. This routine does a global operation to ensure all processes
1100* have detected this error. If an error has been detected an error
1101* message is displayed.
1102*
1103* Notes
1104* =====
1105*
1106* A description vector is associated with each 2D block-cyclicly dis-
1107* tributed matrix. This vector stores the information required to
1108* establish the mapping between a matrix entry and its corresponding
1109* process and memory location.
1110*
1111* In the following comments, the character _ should be read as
1112* "of the distributed matrix". Let A be a generic term for any 2D
1113* block cyclicly distributed matrix. Its description vector is DESCA:
1114*
1115* NOTATION STORED IN EXPLANATION
1116* ---------------- --------------- ------------------------------------
1117* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
1118* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
1119* the NPROW x NPCOL BLACS process grid
1120* A is distributed over. The context
1121* itself is global, but the handle
1122* (the integer value) may vary.
1123* M_A (global) DESCA( M_ ) The number of rows in the distribu-
1124* ted matrix A, M_A >= 0.
1125* N_A (global) DESCA( N_ ) The number of columns in the distri-
1126* buted matrix A, N_A >= 0.
1127* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
1128* block of the matrix A, IMB_A > 0.
1129* INB_A (global) DESCA( INB_ ) The number of columns of the upper
1130* left block of the matrix A,
1131* INB_A > 0.
1132* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
1133* bute the last M_A-IMB_A rows of A,
1134* MB_A > 0.
1135* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
1136* bute the last N_A-INB_A columns of
1137* A, NB_A > 0.
1138* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
1139* row of the matrix A is distributed,
1140* NPROW > RSRC_A >= 0.
1141* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
1142* first column of A is distributed.
1143* NPCOL > CSRC_A >= 0.
1144* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
1145* array storing the local blocks of
1146* the distributed matrix A,
1147* IF( Lc( 1, N_A ) > 0 )
1148* LLD_A >= MAX( 1, Lr( 1, M_A ) )
1149* ELSE
1150* LLD_A >= 1.
1151*
1152* Let K be the number of rows of a matrix A starting at the global in-
1153* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
1154* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
1155* receive if these K rows were distributed over NPROW processes. If K
1156* is the number of columns of a matrix A starting at the global index
1157* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
1158* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
1159* these K columns were distributed over NPCOL processes.
1160*
1161* The values of Lr() and Lc() may be determined via a call to the func-
1162* tion PB_NUMROC:
1163* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
1164* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
1165*
1166* Arguments
1167* =========
1168*
1169* ICTXT (local input) INTEGER
1170* On entry, ICTXT specifies the BLACS context handle, indica-
1171* ting the global context of the operation. The context itself
1172* is global, but the value of ICTXT is local.
1173*
1174* NOUT (global input) INTEGER
1175* On entry, NOUT specifies the unit number for the output file.
1176* When NOUT is 6, output to screen, when NOUT is 0, output to
1177* stderr. NOUT is only defined for process 0.
1178*
1179* SNAME (global input) CHARACTER*(*)
1180* On entry, SNAME specifies the subroutine name calling this
1181* subprogram.
1182*
1183* INFOT (global input) INTEGER
1184* On entry, INFOT specifies the position of the wrong argument.
1185* If the PBLAS error handler is called, INFO will be set to
1186* -INFOT. This routine verifies if the error was reported by
1187* all processes by doing a global sum, and assert the result to
1188* be NPROW * NPCOL.
1189*
1190* -- Written on April 1, 1998 by
1191* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1192*
1193* =====================================================================
1194*
1195* .. Local Scalars ..
1196 INTEGER GERR, MYCOL, MYROW, NPCOL, NPROW
1197* ..
1198* .. External Subroutines ..
1199 EXTERNAL blacs_gridinfo, igsum2d
1200* ..
1201* .. Common Blocks ..
1202 INTEGER INFO, NBLOG
1203 COMMON /infoc/info, nblog
1204* ..
1205* .. Executable Statements ..
1206*
1207 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1208*
1209 gerr = 0
1210 IF( info.NE.-infot )
1211 $ gerr = 1
1212*
1213 CALL igsum2d( ictxt, 'All', ' ', 1, 1, gerr, 1, -1, 0 )
1214*
1215 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
1216 IF( gerr.EQ.( nprow * npcol ) ) THEN
1217 WRITE( nout, fmt = 9999 ) sname, info, -infot
1218 END IF
1219 END IF
1220*
1221 9999 FORMAT( 1x, a7, ': *** ERROR *** ERROR CODE RETURNED = ', i6,
1222 $ ' SHOULD HAVE BEEN ', i6 )
1223*
1224 RETURN
1225*
1226* End of PCHKPBE
1227*

◆ pddiff()

double precision function pddiff ( double precision x,
double precision y )

Definition at line 1268 of file pblastst.f.

1269*
1270* -- PBLAS test routine (version 2.0) --
1271* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1272* and University of California, Berkeley.
1273* April 1, 1998
1274*
1275* .. Scalar Arguments ..
1276 DOUBLE PRECISION X, Y
1277* ..
1278*
1279* Purpose
1280* =======
1281*
1282* PDDIFF returns the scalar difference X - Y. Similarly to the
1283* BLAS tester, this routine allows for the possibility of computing a
1284* more accurate difference if necessary.
1285*
1286* Arguments
1287* =========
1288*
1289* X (input) DOUBLE PRECISION
1290* The real scalar X.
1291*
1292* Y (input) DOUBLE PRECISION
1293* The real scalar Y.
1294*
1295* =====================================================================
1296*
1297* .. Executable Statements ..
1298*
1299 pddiff = x - y
1300*
1301 RETURN
1302*
1303* End of PDDIFF
1304*
pddiff
double precision function pddiff(x, y)
Definition pblastst.f:1269

◆ pilaenv()

integer function pilaenv ( integer ictxt,
character*1 prec )

Definition at line 3857 of file pblastst.f.

3858*
3859* -- PBLAS test routine (version 2.0) --
3860* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
3861* and University of California, Berkeley.
3862* April 1, 1998
3863*
3864* .. Scalar Arguments ..
3865 INTEGER ICTXT
3866 CHARACTER*1 PREC
3867* ..
3868*
3869* Purpose
3870* =======
3871*
3872* PILAENV returns the logical computational block size to be used by
3873* the PBLAS routines during testing and timing. This is a special ver-
3874* sion to be used only as part of the testing or timing PBLAS programs
3875* for testing different values of logical computational block sizes for
3876* the PBLAS routines. It is called by the PBLAS routines to retrieve a
3877* logical computational block size value.
3878*
3879* Arguments
3880* =========
3881*
3882* ICTXT (local input) INTEGER
3883* On entry, ICTXT specifies the BLACS context handle, indica-
3884* ting the global context of the operation. The context itself
3885* is global, but the value of ICTXT is local.
3886*
3887* PREC (dummy input) CHARACTER*1
3888* On entry, PREC is a dummy argument.
3889*
3890* -- Written on April 1, 1998 by
3891* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
3892*
3893* =====================================================================
3894*
3895* .. Common Blocks ..
3896 INTEGER INFO, NBLOG
3897 COMMON /infoc/info, nblog
3898* ..
3899* .. Executable Statements ..
3900*
3901 pilaenv = nblog
3902*
3903 RETURN
3904*
3905* End of PILAENV
3906*
pilaenv
integer function pilaenv(ictxt, prec)
Definition pblastst.f:3858

◆ pmdescchk()

subroutine pmdescchk ( integer ictxt,
integer nout,
character*1 matrix,
integer, dimension( * ) desca,
integer dta,
integer ma,
integer na,
integer imba,
integer inba,
integer mba,
integer nba,
integer rsrca,
integer csrca,
integer mpa,
integer nqa,
integer iprea,
integer imida,
integer iposta,
integer igap,
integer gapmul,
integer info )

Definition at line 742 of file pblastst.f.

746*
747* -- PBLAS test routine (version 2.0) --
748* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
749* and University of California, Berkeley.
750* April 1, 1998
751*
752* .. Scalar Arguments ..
753 CHARACTER*1 MATRIX
754 INTEGER CSRCA, DTA, GAPMUL, ICTXT, IGAP, IMBA, IMIDA,
755 $ INBA, INFO, IPOSTA, IPREA, MA, MBA, MPA, NA,
756 $ NBA, NOUT, NQA, RSRCA
757* ..
758* .. Array Arguments ..
759 INTEGER DESCA( * )
760* ..
761*
762* Purpose
763* =======
764*
765* PMDESCCHK checks the validity of the input test parameters and ini-
766* tializes the descriptor DESCA and the scalar variables MPA, NQA. In
767* case of an invalid parameter, this routine displays error messages
768* and return an non-zero error code in INFO.
769*
770* Notes
771* =====
772*
773* A description vector is associated with each 2D block-cyclicly dis-
774* tributed matrix. This vector stores the information required to
775* establish the mapping between a matrix entry and its corresponding
776* process and memory location.
777*
778* In the following comments, the character _ should be read as
779* "of the distributed matrix". Let A be a generic term for any 2D
780* block cyclicly distributed matrix. Its description vector is DESCA:
781*
782* NOTATION STORED IN EXPLANATION
783* ---------------- --------------- ------------------------------------
784* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
785* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
786* the NPROW x NPCOL BLACS process grid
787* A is distributed over. The context
788* itself is global, but the handle
789* (the integer value) may vary.
790* M_A (global) DESCA( M_ ) The number of rows in the distribu-
791* ted matrix A, M_A >= 0.
792* N_A (global) DESCA( N_ ) The number of columns in the distri-
793* buted matrix A, N_A >= 0.
794* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
795* block of the matrix A, IMB_A > 0.
796* INB_A (global) DESCA( INB_ ) The number of columns of the upper
797* left block of the matrix A,
798* INB_A > 0.
799* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
800* bute the last M_A-IMB_A rows of A,
801* MB_A > 0.
802* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
803* bute the last N_A-INB_A columns of
804* A, NB_A > 0.
805* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
806* row of the matrix A is distributed,
807* NPROW > RSRC_A >= 0.
808* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
809* first column of A is distributed.
810* NPCOL > CSRC_A >= 0.
811* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
812* array storing the local blocks of
813* the distributed matrix A,
814* IF( Lc( 1, N_A ) > 0 )
815* LLD_A >= MAX( 1, Lr( 1, M_A ) )
816* ELSE
817* LLD_A >= 1.
818*
819* Let K be the number of rows of a matrix A starting at the global in-
820* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
821* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
822* receive if these K rows were distributed over NPROW processes. If K
823* is the number of columns of a matrix A starting at the global index
824* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
825* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
826* these K columns were distributed over NPCOL processes.
827*
828* The values of Lr() and Lc() may be determined via a call to the func-
829* tion PB_NUMROC:
830* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
831* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
832*
833* Arguments
834* =========
835*
836* ICTXT (local input) INTEGER
837* On entry, ICTXT specifies the BLACS context handle, indica-
838* ting the global context of the operation. The context itself
839* is global, but the value of ICTXT is local.
840*
841* NOUT (global input) INTEGER
842* On entry, NOUT specifies the unit number for the output file.
843* When NOUT is 6, output to screen, when NOUT is 0, output to
844* stderr. NOUT is only defined for process 0.
845*
846* MATRIX (global input) CHARACTER*1
847* On entry, MATRIX specifies the one character matrix identi-
848* fier.
849*
850* DESCA (global output) INTEGER array
851* On entry, DESCA is an array of dimension DLEN_. DESCA is the
852* array descriptor to be set.
853*
854* DTYPEA (global input) INTEGER
855* On entry, DTYPEA specifies the descriptor type. In this ver-
856* sion, DTYPEA must be BLOCK_CYCLIC_INB_2D.
857*
858* MA (global input) INTEGER
859* On entry, MA specifies the number of rows in the matrix. MA
860* must be at least zero.
861*
862* NA (global input) INTEGER
863* On entry, NA specifies the number of columns in the matrix.
864* NA must be at least zero.
865*
866* IMBA (global input) INTEGER
867* On entry, IMBA specifies the row blocking factor used to dis-
868* tribute the first IMBA rows of the matrix. IMBA must be at
869* least one.
870*
871* INBA (global input) INTEGER
872* On entry, INBA specifies the column blocking factor used to
873* distribute the first INBA columns of the matrix. INBA must
874* be at least one.
875*
876* MBA (global input) INTEGER
877* On entry, MBA specifies the row blocking factor used to dis-
878* tribute the rows of the matrix. MBA must be at least one.
879*
880* NBA (global input) INTEGER
881* On entry, NBA specifies the column blocking factor used to
882* distribute the columns of the matrix. NBA must be at least
883* one.
884*
885* RSRCA (global input) INTEGER
886* On entry, RSRCA specifies the process row in which the first
887* row of the matrix resides. When RSRCA is -1, the matrix is
888* row replicated, otherwise RSCRA must be at least zero and
889* strictly less than NPROW.
890*
891* CSRCA (global input) INTEGER
892* On entry, CSRCA specifies the process column in which the
893* first column of the matrix resides. When CSRCA is -1, the
894* matrix is column replicated, otherwise CSCRA must be at least
895* zero and strictly less than NPCOL.
896*
897* MPA (local output) INTEGER
898* On exit, MPA is Lr( 1, MA ).
899*
900* NQA (local output) INTEGER
901* On exit, NQA is Lc( 1, NA ).
902*
903* IPREA (local output) INTEGER
904* On exit, IPREA specifies the size of the guard zone to put
905* before the start of the local padded array.
906*
907* IMIDA (local output) INTEGER
908* On exit, IMIDA specifies the lda-gap of the guard zone to
909* put after each column of the local padded array.
910*
911* IPOSTA (local output) INTEGER
912* On exit, IPOSTA specifies the size of the guard zone to put
913* after the local padded array.
914*
915* IGAP (global input) INTEGER
916* On entry, IGAP specifies the size of the lda-gap.
917*
918* GAPMUL (global input) INTEGER
919* On entry, GAPMUL is a constant factor controlling the size
920* of the pre- and post guardzone.
921*
922* INFO (global output) INTEGER
923* On exit, when INFO is zero, no error has been detected,
924* otherwise an error has been detected.
925*
926* -- Written on April 1, 1998 by
927* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
928*
929* =====================================================================
930*
931* .. Parameters ..
932 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
933 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
934 $ RSRC_
935 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
936 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
937 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
938 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
939* ..
940* .. Local Scalars ..
941 INTEGER LLDA, MYCOL, MYROW, NPCOL, NPROW
942* ..
943* .. External Subroutines ..
944 EXTERNAL blacs_gridinfo, igsum2d, pb_descinit2
945* ..
946* .. External Functions ..
947 INTEGER PB_NUMROC
948 EXTERNAL pb_numroc
949* ..
950* .. Intrinsic Functions ..
951 INTRINSIC max
952* ..
953* .. Executable Statements ..
954*
955 info = 0
956 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
957*
958* Verify descriptor type DTYPE_
959*
960 IF( dta.NE.block_cyclic_2d_inb ) THEN
961 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
962 $ WRITE( nout, fmt = 9999 ) matrix, 'DTYPE', matrix, dta,
963 $ block_cyclic_2d_inb
964 info = 1
965 END IF
966*
967* Verify global matrix dimensions (M_,N_) are correct
968*
969 IF( ma.LT.0 ) THEN
970 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
971 $ WRITE( nout, fmt = 9998 ) matrix, 'M', matrix, ma
972 info = 1
973 ELSE IF( na.LT.0 ) THEN
974 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
975 $ WRITE( nout, fmt = 9997 ) matrix, 'N', matrix, na
976 info = 1
977 END IF
978*
979* Verify if blocking factors (IMB_, INB_) are correct
980*
981 IF( imba.LT.1 ) THEN
982 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
983 $ WRITE( nout, fmt = 9996 ) matrix, 'IMB', matrix, imba
984 info = 1
985 ELSE IF( inba.LT.1 ) THEN
986 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
987 $ WRITE( nout, fmt = 9995 ) matrix, 'INB', matrix, inba
988 info = 1
989 END IF
990*
991* Verify if blocking factors (MB_, NB_) are correct
992*
993 IF( mba.LT.1 ) THEN
994 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
995 $ WRITE( nout, fmt = 9994 ) matrix, 'MB', matrix, mba
996 info = 1
997 ELSE IF( nba.LT.1 ) THEN
998 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
999 $ WRITE( nout, fmt = 9993 ) matrix, 'NB', matrix, nba
1000 info = 1
1001 END IF
1002*
1003* Verify if origin process coordinates (RSRC_, CSRC_) are valid
1004*
1005 IF( rsrca.LT.-1 .OR. rsrca.GE.nprow ) THEN
1006 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
1007 WRITE( nout, fmt = 9992 ) matrix
1008 WRITE( nout, fmt = 9990 ) 'RSRC', matrix, rsrca, nprow
1009 END IF
1010 info = 1
1011 ELSE IF( csrca.LT.-1 .OR. csrca.GE.npcol ) THEN
1012 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
1013 WRITE( nout, fmt = 9991 ) matrix
1014 WRITE( nout, fmt = 9990 ) 'CSRC', matrix, csrca, npcol
1015 END IF
1016 info = 1
1017 END IF
1018*
1019* Check all processes for an error
1020*
1021 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
1022*
1023 IF( info.NE.0 ) THEN
1024*
1025 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
1026 WRITE( nout, fmt = 9989 ) matrix
1027 WRITE( nout, fmt = * )
1028 END IF
1029*
1030 ELSE
1031*
1032* Compute local testing leading dimension
1033*
1034 mpa = pb_numroc( ma, 1, imba, mba, myrow, rsrca, nprow )
1035 nqa = pb_numroc( na, 1, inba, nba, mycol, csrca, npcol )
1036 iprea = max( gapmul*nba, mpa )
1037 imida = igap
1038 iposta = max( gapmul*nba, nqa )
1039 llda = max( 1, mpa ) + imida
1040*
1041 CALL pb_descinit2( desca, ma, na, imba, inba, mba, nba, rsrca,
1042 $ csrca, ictxt, llda, info )
1043*
1044* Check all processes for an error
1045*
1046 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
1047*
1048 IF( info.NE.0 ) THEN
1049 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
1050 WRITE( nout, fmt = 9989 ) matrix
1051 WRITE( nout, fmt = * )
1052 END IF
1053 END IF
1054*
1055 END IF
1056*
1057 9999 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor type ', a5, a1,
1058 $ ': ', i6, ' should be ', i3, '.' )
1059 9998 FORMAT( 2x, '>> Invalid matrix ', a1, ' row dimension ', a1, a1,
1060 $ ': ', i6, ' should be at least 1.' )
1061 9997 FORMAT( 2x, '>> Invalid matrix ', a1, ' column dimension ', a1,
1062 $ a1, ': ', i6, ' should be at least 1.' )
1063 9996 FORMAT( 2x, '>> Invalid matrix ', a1, ' first row block size ',
1064 $ a3, a1, ': ', i6, ' should be at least 1.' )
1065 9995 FORMAT( 2X, '>> invalid matrix ', A1, ' first column block size ',
1066 $ A3, A1,': ', I6, ' should be at least 1.' )
1067 9994 FORMAT( 2X, '>> invalid matrix ', A1, ' row block size ', A2, A1,
1068 $ ': ', I6, ' should be at least 1.' )
1069 9993 FORMAT( 2X, '>> invalid matrix ', A1, ' column block size ', A2,
1070 $ A1,': ', I6, ' should be at least 1.' )
1071 9992 FORMAT( 2X, '>> invalid matrix ', A1, ' row process source:' )
1072 9991 FORMAT( 2X, '>> invalid matrix ', A1, ' column process source:' )
1073 9990 FORMAT( 2X, '>> ', A4, A1, '= ', I6, ' should be >= -1 and < ',
1074 $ I6, '.' )
1075 9989 FORMAT( 2X, '>> invalid matrix ', A1, ' descriptor: going on to ',
1076 $ 'next test case.' )
1077*
1078 RETURN
1079*
1080* End of PMDESCCHK
1081*
pb_descinit2
subroutine pb_descinit2(desc, m, n, imb, inb, mb, nb, rsrc, csrc, ctxt, lld, info)
Definition pblastst.f:3337

◆ pmdimchk()

subroutine pmdimchk ( integer ictxt,
integer nout,
integer m,
integer n,
character*1 matrix,
integer ia,
integer ja,
integer, dimension( * ) desca,
integer info )

Definition at line 200 of file pblastst.f.

202*
203* -- PBLAS test routine (version 2.0) --
204* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
205* and University of California, Berkeley.
206* April 1, 1998
207*
208* .. Scalar Arguments ..
209 CHARACTER*1 MATRIX
210 INTEGER ICTXT, INFO, IA, JA, M, N, NOUT
211* ..
212* .. Array Arguments ..
213 INTEGER DESCA( * )
214* ..
215*
216* Purpose
217* =======
218*
219* PMDIMCHK checks the validity of the input test dimensions. In case of
220* an invalid parameter or discrepancy between the parameters, this rou-
221* tine displays error messages and returns an non-zero error code in
222* INFO.
223*
224* Notes
225* =====
226*
227* A description vector is associated with each 2D block-cyclicly dis-
228* tributed matrix. This vector stores the information required to
229* establish the mapping between a matrix entry and its corresponding
230* process and memory location.
231*
232* In the following comments, the character _ should be read as
233* "of the distributed matrix". Let A be a generic term for any 2D
234* block cyclicly distributed matrix. Its description vector is DESCA:
235*
236* NOTATION STORED IN EXPLANATION
237* ---------------- --------------- ------------------------------------
238* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
239* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
240* the NPROW x NPCOL BLACS process grid
241* A is distributed over. The context
242* itself is global, but the handle
243* (the integer value) may vary.
244* M_A (global) DESCA( M_ ) The number of rows in the distribu-
245* ted matrix A, M_A >= 0.
246* N_A (global) DESCA( N_ ) The number of columns in the distri-
247* buted matrix A, N_A >= 0.
248* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
249* block of the matrix A, IMB_A > 0.
250* INB_A (global) DESCA( INB_ ) The number of columns of the upper
251* left block of the matrix A,
252* INB_A > 0.
253* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
254* bute the last M_A-IMB_A rows of A,
255* MB_A > 0.
256* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
257* bute the last N_A-INB_A columns of
258* A, NB_A > 0.
259* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
260* row of the matrix A is distributed,
261* NPROW > RSRC_A >= 0.
262* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
263* first column of A is distributed.
264* NPCOL > CSRC_A >= 0.
265* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
266* array storing the local blocks of
267* the distributed matrix A,
268* IF( Lc( 1, N_A ) > 0 )
269* LLD_A >= MAX( 1, Lr( 1, M_A ) )
270* ELSE
271* LLD_A >= 1.
272*
273* Let K be the number of rows of a matrix A starting at the global in-
274* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
275* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
276* receive if these K rows were distributed over NPROW processes. If K
277* is the number of columns of a matrix A starting at the global index
278* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
279* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
280* these K columns were distributed over NPCOL processes.
281*
282* The values of Lr() and Lc() may be determined via a call to the func-
283* tion PB_NUMROC:
284* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
285* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
286*
287* Arguments
288* =========
289*
290* ICTXT (local input) INTEGER
291* On entry, ICTXT specifies the BLACS context handle, indica-
292* ting the global context of the operation. The context itself
293* is global, but the value of ICTXT is local.
294*
295* NOUT (global input) INTEGER
296* On entry, NOUT specifies the unit number for the output file.
297* When NOUT is 6, output to screen, when NOUT is 0, output to
298* stderr. NOUT is only defined for process 0.
299*
300* MATRIX (global input) CHARACTER*1
301* On entry, MATRIX specifies the one character matrix identi-
302* fier.
303*
304* IA (global input) INTEGER
305* On entry, IA specifies A's global row index, which points to
306* the beginning of the submatrix sub( A ).
307*
308* JA (global input) INTEGER
309* On entry, JA specifies A's global column index, which points
310* to the beginning of the submatrix sub( A ).
311*
312* DESCA (global and local input) INTEGER array
313* On entry, DESCA is an integer array of dimension DLEN_. This
314* is the array descriptor for the matrix A.
315*
316* INFO (global output) INTEGER
317* On exit, when INFO is zero, no error has been detected,
318* otherwise an error has been detected.
319*
320* -- Written on April 1, 1998 by
321* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
322*
323* =====================================================================
324*
325* .. Parameters ..
326 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
327 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
328 $ RSRC_
329 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
330 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
331 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
332 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
333* ..
334* .. Local Scalars ..
335 INTEGER MYCOL, MYROW, NPCOL, NPROW
336* ..
337* .. External Subroutines ..
338 EXTERNAL blacs_gridinfo, igsum2d
339* ..
340* .. Executable Statements ..
341*
342 info = 0
343 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
344*
345 IF( ( m.LT.0 ).OR.( n.LT.0 ) ) THEN
346 info = 1
347 ELSE IF( ( m.EQ.0 ).OR.( n.EQ.0 ) )THEN
348 IF( desca( m_ ).LT.0 )
349 $ info = 1
350 IF( desca( n_ ).LT.0 )
351 $ info = 1
352 ELSE
353 IF( desca( m_ ).LT.( ia+m-1 ) )
354 $ info = 1
355 IF( desca( n_ ).LT.( ja+n-1 ) )
356 $ info = 1
357 END IF
358*
359* Check all processes for an error
360*
361 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
362*
363 IF( info.NE.0 ) THEN
364 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
365 WRITE( nout, fmt = 9999 ) matrix
366 WRITE( nout, fmt = 9998 ) m, n, matrix, ia, matrix, ja
367 WRITE( nout, fmt = 9997 ) matrix, desca( m_ ), matrix,
368 $ desca( n_ )
369 WRITE( nout, fmt = * )
370 END IF
371 END IF
372*
373 9999 FORMAT( 'Incompatible arguments for matrix ', a1, ':' )
374 9998 FORMAT( 'M = ', i6, ', N = ', i6, ', I', a1, ' = ', i6,
375 $ ', J', a1, ' = ', i6 )
376 9997 FORMAT( 'desc', A1, '( m_ ) = ', I6, ', desc', A1, '( n_ ) = ',
377 $ I6, '.' )
378*
379 RETURN
380*
381* End of PMDIMCHK
382*

◆ psdiff()

real function psdiff ( real x,
real y )

Definition at line 1229 of file pblastst.f.

1230*
1231* -- PBLAS test routine (version 2.0) --
1232* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1233* and University of California, Berkeley.
1234* April 1, 1998
1235*
1236* .. Scalar Arguments ..
1237 REAL X, Y
1238* ..
1239*
1240* Purpose
1241* =======
1242*
1243* PSDIFF returns the scalar difference X - Y. Similarly to the
1244* BLAS tester, this routine allows for the possibility of computing a
1245* more accurate difference if necessary.
1246*
1247* Arguments
1248* =========
1249*
1250* X (input) REAL
1251* The real scalar X.
1252*
1253* Y (input) REAL
1254* The real scalar Y.
1255*
1256* =====================================================================
1257*
1258* .. Executable Statements ..
1259*
1260 psdiff = x - y
1261*
1262 RETURN
1263*
1264* End of PSDIFF
1265*
psdiff
real function psdiff(x, y)
Definition pblastst.f:1230

◆ pvdescchk()

subroutine pvdescchk ( integer ictxt,
integer nout,
character*1 matrix,
integer, dimension( * ) descx,
integer dtx,
integer mx,
integer nx,
integer imbx,
integer inbx,
integer mbx,
integer nbx,
integer rsrcx,
integer csrcx,
integer incx,
integer mpx,
integer nqx,
integer iprex,
integer imidx,
integer ipostx,
integer igap,
integer gapmul,
integer info )

Definition at line 384 of file pblastst.f.

388*
389* -- PBLAS test routine (version 2.0) --
390* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
391* and University of California, Berkeley.
392* April 1, 1998
393*
394* .. Scalar Arguments ..
395 CHARACTER*1 MATRIX
396 INTEGER CSRCX, DTX, GAPMUL, ICTXT, IGAP, IMBX, IMIDX,
397 $ INBX, INCX, INFO, IPOSTX, IPREX, MBX, MPX, MX,
398 $ NBX, NOUT, NQX, NX, RSRCX
399* ..
400* .. Array Arguments ..
401 INTEGER DESCX( * )
402* ..
403*
404* Purpose
405* =======
406*
407* PVDESCCHK checks the validity of the input test parameters and ini-
408* tializes the descriptor DESCX and the scalar variables MPX, NQX. In
409* case of an invalid parameter, this routine displays error messages
410* and return an non-zero error code in INFO.
411*
412* Notes
413* =====
414*
415* A description vector is associated with each 2D block-cyclicly dis-
416* tributed matrix. This vector stores the information required to
417* establish the mapping between a matrix entry and its corresponding
418* process and memory location.
419*
420* In the following comments, the character _ should be read as
421* "of the distributed matrix". Let A be a generic term for any 2D
422* block cyclicly distributed matrix. Its description vector is DESCA:
423*
424* NOTATION STORED IN EXPLANATION
425* ---------------- --------------- ------------------------------------
426* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
427* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
428* the NPROW x NPCOL BLACS process grid
429* A is distributed over. The context
430* itself is global, but the handle
431* (the integer value) may vary.
432* M_A (global) DESCA( M_ ) The number of rows in the distribu-
433* ted matrix A, M_A >= 0.
434* N_A (global) DESCA( N_ ) The number of columns in the distri-
435* buted matrix A, N_A >= 0.
436* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
437* block of the matrix A, IMB_A > 0.
438* INB_A (global) DESCA( INB_ ) The number of columns of the upper
439* left block of the matrix A,
440* INB_A > 0.
441* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
442* bute the last M_A-IMB_A rows of A,
443* MB_A > 0.
444* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
445* bute the last N_A-INB_A columns of
446* A, NB_A > 0.
447* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
448* row of the matrix A is distributed,
449* NPROW > RSRC_A >= 0.
450* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
451* first column of A is distributed.
452* NPCOL > CSRC_A >= 0.
453* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
454* array storing the local blocks of
455* the distributed matrix A,
456* IF( Lc( 1, N_A ) > 0 )
457* LLD_A >= MAX( 1, Lr( 1, M_A ) )
458* ELSE
459* LLD_A >= 1.
460*
461* Let K be the number of rows of a matrix A starting at the global in-
462* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
463* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
464* receive if these K rows were distributed over NPROW processes. If K
465* is the number of columns of a matrix A starting at the global index
466* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
467* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
468* these K columns were distributed over NPCOL processes.
469*
470* The values of Lr() and Lc() may be determined via a call to the func-
471* tion PB_NUMROC:
472* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
473* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
474*
475* Arguments
476* =========
477*
478* ICTXT (local input) INTEGER
479* On entry, ICTXT specifies the BLACS context handle, indica-
480* ting the global context of the operation. The context itself
481* is global, but the value of ICTXT is local.
482*
483* NOUT (global input) INTEGER
484* On entry, NOUT specifies the unit number for the output file.
485* When NOUT is 6, output to screen, when NOUT is 0, output to
486* stderr. NOUT is only defined for process 0.
487*
488* MATRIX (global input) CHARACTER*1
489* On entry, MATRIX specifies the one character matrix identi-
490* fier.
491*
492* DESCX (global output) INTEGER array
493* On entry, DESCX is an array of dimension DLEN_. DESCX is the
494* array descriptor to be set.
495*
496* DTYPEX (global input) INTEGER
497* On entry, DTYPEX specifies the descriptor type. In this ver-
498* sion, DTYPEX must be BLOCK_CYCLIC_INB_2D.
499*
500* MX (global input) INTEGER
501* On entry, MX specifies the number of rows in the matrix. MX
502* must be at least zero.
503*
504* NX (global input) INTEGER
505* On entry, NX specifies the number of columns in the matrix.
506* NX must be at least zero.
507*
508* IMBX (global input) INTEGER
509* On entry, IMBX specifies the row blocking factor used to dis-
510* tribute the first IMBX rows of the matrix. IMBX must be at
511* least one.
512*
513* INBX (global input) INTEGER
514* On entry, INBX specifies the column blocking factor used to
515* distribute the first INBX columns of the matrix. INBX must
516* be at least one.
517*
518* MBX (global input) INTEGER
519* On entry, MBX specifies the row blocking factor used to dis-
520* tribute the rows of the matrix. MBX must be at least one.
521*
522* NBX (global input) INTEGER
523* On entry, NBX specifies the column blocking factor used to
524* distribute the columns of the matrix. NBX must be at least
525* one.
526*
527* RSRCX (global input) INTEGER
528* On entry, RSRCX specifies the process row in which the first
529* row of the matrix resides. When RSRCX is -1, the matrix is
530* row replicated, otherwise RSCRX must be at least zero and
531* strictly less than NPROW.
532*
533* CSRCX (global input) INTEGER
534* On entry, CSRCX specifies the process column in which the
535* first column of the matrix resides. When CSRCX is -1, the
536* matrix is column replicated, otherwise CSCRX must be at least
537* zero and strictly less than NPCOL.
538*
539* INCX (global input) INTEGER
540* On entry, INCX specifies the global vector increment. INCX
541* must be one or MX.
542*
543* MPX (local output) INTEGER
544* On exit, MPX is Lr( 1, MX ).
545*
546* NQX (local output) INTEGER
547* On exit, NQX is Lc( 1, NX ).
548*
549* IPREX (local output) INTEGER
550* On exit, IPREX specifies the size of the guard zone to put
551* before the start of the local padded array.
552*
553* IMIDX (local output) INTEGER
554* On exit, IMIDX specifies the ldx-gap of the guard zone to
555* put after each column of the local padded array.
556*
557* IPOSTX (local output) INTEGER
558* On exit, IPOSTX specifies the size of the guard zone to put
559* after the local padded array.
560*
561* IGAP (global input) INTEGER
562* On entry, IGAP specifies the size of the ldx-gap.
563*
564* GAPMUL (global input) INTEGER
565* On entry, GAPMUL is a constant factor controlling the size
566* of the pre- and post guardzone.
567*
568* INFO (global output) INTEGER
569* On exit, when INFO is zero, no error has been detected,
570* otherwise an error has been detected.
571*
572* -- Written on April 1, 1998 by
573* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
574*
575* =====================================================================
576*
577* .. Parameters ..
578 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
579 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
580 $ RSRC_
581 PARAMETER ( block_cyclic_2d_inb = 2, dlen_ = 11,
582 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
583 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
584 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
585* ..
586* .. Local Scalars ..
587 INTEGER LLDX, MYCOL, MYROW, NPCOL, NPROW
588* ..
589* .. External Subroutines ..
590 EXTERNAL blacs_gridinfo, igsum2d, pb_descinit2
591* ..
592* .. External Functions ..
593 INTEGER PB_NUMROC
594 EXTERNAL pb_numroc
595* ..
596* .. Intrinsic Functions ..
597 INTRINSIC max
598* ..
599* .. Executable Statements ..
600*
601 info = 0
602 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
603*
604* Verify descriptor type DTYPE_
605*
606 IF( dtx.NE.block_cyclic_2d_inb ) THEN
607 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
608 $ WRITE( nout, fmt = 9999 ) matrix, 'DTYPE', matrix, dtx,
609 $ block_cyclic_2d_inb
610 info = 1
611 END IF
612*
613* Verify global matrix dimensions (M_,N_) are correct
614*
615 IF( mx.LT.0 ) THEN
616 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
617 $ WRITE( nout, fmt = 9998 ) matrix, 'M', matrix, mx
618 info = 1
619 ELSE IF( nx.LT.0 ) THEN
620 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
621 $ WRITE( nout, fmt = 9997 ) matrix, 'N', matrix, nx
622 info = 1
623 END IF
624*
625* Verify if blocking factors (IMB_, INB_) are correct
626*
627 IF( imbx.LT.1 ) THEN
628 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
629 $ WRITE( nout, fmt = 9996 ) matrix, 'IMB', matrix, imbx
630 info = 1
631 ELSE IF( inbx.LT.1 ) THEN
632 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
633 $ WRITE( nout, fmt = 9995 ) matrix, 'INB', matrix, inbx
634 info = 1
635 END IF
636*
637* Verify if blocking factors (MB_, NB_) are correct
638*
639 IF( mbx.LT.1 ) THEN
640 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
641 $ WRITE( nout, fmt = 9994 ) matrix, 'MB', matrix, mbx
642 info = 1
643 ELSE IF( nbx.LT.1 ) THEN
644 IF( myrow.EQ.0 .AND. mycol.EQ.0 )
645 $ WRITE( nout, fmt = 9993 ) matrix, 'NB', matrix, nbx
646 info = 1
647 END IF
648*
649* Verify if origin process coordinates (RSRC_, CSRC_) are valid
650*
651 IF( rsrcx.LT.-1 .OR. rsrcx.GE.nprow ) THEN
652 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
653 WRITE( nout, fmt = 9992 ) matrix
654 WRITE( nout, fmt = 9990 ) 'RSRC', matrix, rsrcx, nprow
655 END IF
656 info = 1
657 ELSE IF( csrcx.LT.-1 .OR. csrcx.GE.npcol ) THEN
658 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
659 WRITE( nout, fmt = 9991 ) matrix
660 WRITE( nout, fmt = 9990 ) 'CSRC', matrix, csrcx, npcol
661 END IF
662 info = 1
663 END IF
664*
665* Check input increment value
666*
667 IF( incx.NE.1 .AND. incx.NE.mx ) THEN
668 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
669 WRITE( nout, fmt = 9989 ) matrix
670 WRITE( nout, fmt = 9988 ) 'INC', matrix, incx, matrix, mx
671 END IF
672 info = 1
673 END IF
674*
675* Check all processes for an error
676*
677 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
678*
679 IF( info.NE.0 ) THEN
680*
681 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
682 WRITE( nout, fmt = 9987 ) matrix
683 WRITE( nout, fmt = * )
684 END IF
685*
686 ELSE
687*
688* Compute local testing leading dimension
689*
690 mpx = pb_numroc( mx, 1, imbx, mbx, myrow, rsrcx, nprow )
691 nqx = pb_numroc( nx, 1, inbx, nbx, mycol, csrcx, npcol )
692 iprex = max( gapmul*nbx, mpx )
693 imidx = igap
694 ipostx = max( gapmul*nbx, nqx )
695 lldx = max( 1, mpx ) + imidx
696*
697 CALL pb_descinit2( descx, mx, nx, imbx, inbx, mbx, nbx, rsrcx,
698 $ csrcx, ictxt, lldx, info )
699*
700* Check all processes for an error
701*
702 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
703*
704 IF( info.NE.0 ) THEN
705 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
706 WRITE( nout, fmt = 9987 ) matrix
707 WRITE( nout, fmt = * )
708 END IF
709 END IF
710*
711 END IF
712*
713 9999 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor type ', a5, a1,
714 $ ': ', i6, ' should be ', i3, '.' )
715 9998 FORMAT( 2x, '>> Invalid matrix ', a1, ' row dimension ', a1, a1,
716 $ ': ', i6, ' should be at least 1.' )
717 9997 FORMAT( 2x, '>> Invalid matrix ', a1, ' column dimension ', a1,
718 $ a1, ': ', i6, ' should be at least 1.' )
719 9996 FORMAT( 2x, '>> Invalid matrix ', a1, ' first row block size ',
720 $ a3, a1, ': ', i6, ' should be at least 1.' )
721 9995 FORMAT( 2x, '>> Invalid matrix ', a1, ' first column block size ',
722 $ a3, a1,': ', i6, ' should be at least 1.' )
723 9994 FORMAT( 2x, '>> Invalid matrix ', a1, ' row block size ', a2, a1,
724 $ ': ', i6, ' should be at least 1.' )
725 9993 FORMAT( 2x, '>> Invalid matrix ', a1, ' column block size ', A2,
726 $ A1,': ', I6, ' should be at least 1.' )
727 9992 FORMAT( 2X, '>> invalid matrix ', A1, ' row process source:' )
728 9991 FORMAT( 2X, '>> invalid matrix ', A1, ' column process source:' )
729 9990 FORMAT( 2X, '>> ', A4, A1, '= ', I6, ' should be >= -1 and < ',
730 $ I6, '.' )
731 9989 FORMAT( 2X, '>> invalid vector ', A1, ' increment:' )
732 9988 FORMAT( 2X, '>> ', A3, A1, '= ', i6, ' should be 1 or M', a1,
733 $ ' = ', i6, '.' )
734 9987 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor: going on to ',
735 $ 'next test case.' )
736*
737 RETURN
738*
739* End of PVDESCCHK
740*

◆ pvdimchk()

subroutine pvdimchk ( integer ictxt,
integer nout,
integer n,
character*1 matrix,
integer ix,
integer jx,
integer, dimension( * ) descx,
integer incx,
integer info )

Definition at line 1 of file pblastst.f.

3*
4* -- PBLAS test routine (version 2.0) --
5* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6* and University of California, Berkeley.
7* April 1, 1998
8*
9* .. Scalar Arguments ..
10 CHARACTER*1 MATRIX
11 INTEGER ICTXT, INCX, INFO, IX, JX, N, NOUT
12* ..
13* .. Array Arguments ..
14 INTEGER DESCX( * )
15* ..
16*
17* Purpose
18* =======
19*
20* PVDIMCHK checks the validity of the input test dimensions. In case of
21* an invalid parameter or discrepancy between the parameters, this rou-
22* tine displays error messages and returns an non-zero error code in
23* INFO.
24*
25* Notes
26* =====
27*
28* A description vector is associated with each 2D block-cyclicly dis-
29* tributed matrix. This vector stores the information required to
30* establish the mapping between a matrix entry and its corresponding
31* process and memory location.
32*
33* In the following comments, the character _ should be read as
34* "of the distributed matrix". Let A be a generic term for any 2D
35* block cyclicly distributed matrix. Its description vector is DESCA:
36*
37* NOTATION STORED IN EXPLANATION
38* ---------------- --------------- ------------------------------------
39* DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
40* CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
41* the NPROW x NPCOL BLACS process grid
42* A is distributed over. The context
43* itself is global, but the handle
44* (the integer value) may vary.
45* M_A (global) DESCA( M_ ) The number of rows in the distribu-
46* ted matrix A, M_A >= 0.
47* N_A (global) DESCA( N_ ) The number of columns in the distri-
48* buted matrix A, N_A >= 0.
49* IMB_A (global) DESCA( IMB_ ) The number of rows of the upper left
50* block of the matrix A, IMB_A > 0.
51* INB_A (global) DESCA( INB_ ) The number of columns of the upper
52* left block of the matrix A,
53* INB_A > 0.
54* MB_A (global) DESCA( MB_ ) The blocking factor used to distri-
55* bute the last M_A-IMB_A rows of A,
56* MB_A > 0.
57* NB_A (global) DESCA( NB_ ) The blocking factor used to distri-
58* bute the last N_A-INB_A columns of
59* A, NB_A > 0.
60* RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
61* row of the matrix A is distributed,
62* NPROW > RSRC_A >= 0.
63* CSRC_A (global) DESCA( CSRC_ ) The process column over which the
64* first column of A is distributed.
65* NPCOL > CSRC_A >= 0.
66* LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
67* array storing the local blocks of
68* the distributed matrix A,
69* IF( Lc( 1, N_A ) > 0 )
70* LLD_A >= MAX( 1, Lr( 1, M_A ) )
71* ELSE
72* LLD_A >= 1.
73*
74* Let K be the number of rows of a matrix A starting at the global in-
75* dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
76* that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
77* receive if these K rows were distributed over NPROW processes. If K
78* is the number of columns of a matrix A starting at the global index
79* JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number of co-
80* lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would receive if
81* these K columns were distributed over NPCOL processes.
82*
83* The values of Lr() and Lc() may be determined via a call to the func-
84* tion PB_NUMROC:
85* Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
86* Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
87*
88* Arguments
89* =========
90*
91* ICTXT (local input) INTEGER
92* On entry, ICTXT specifies the BLACS context handle, indica-
93* ting the global context of the operation. The context itself
94* is global, but the value of ICTXT is local.
95*
96* NOUT (global input) INTEGER
97* On entry, NOUT specifies the unit number for the output file.
98* When NOUT is 6, output to screen, when NOUT is 0, output to
99* stderr. NOUT is only defined for process 0.
100*
101* MATRIX (global input) CHARACTER*1
102* On entry, MATRIX specifies the one character matrix identi-
103* fier.
104*
105* IX (global input) INTEGER
106* On entry, IX specifies X's global row index, which points to
107* the beginning of the submatrix sub( X ).
108*
109* JX (global input) INTEGER
110* On entry, JX specifies X's global column index, which points
111* to the beginning of the submatrix sub( X ).
112*
113* DESCX (global and local input) INTEGER array
114* On entry, DESCX is an integer array of dimension DLEN_. This
115* is the array descriptor for the matrix X.
116*
117* INCX (global input) INTEGER
118* On entry, INCX specifies the global increment for the
119* elements of X. Only two values of INCX are supported in
120* this version, namely 1 and M_X. INCX must not be zero.
121*
122* INFO (global output) INTEGER
123* On exit, when INFO is zero, no error has been detected,
124* otherwise an error has been detected.
125*
126* -- Written on April 1, 1998 by
127* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
128*
129* =====================================================================
130*
131* .. Parameters ..
132 INTEGER BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
133 $ DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
134 $ RSRC_
135 parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
136 $ dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
137 $ imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
138 $ rsrc_ = 9, csrc_ = 10, lld_ = 11 )
139* ..
140* .. Local Scalars ..
141 INTEGER MYCOL, MYROW, NPCOL, NPROW
142* ..
143* .. External Subroutines ..
144 EXTERNAL blacs_gridinfo, igsum2d
145* ..
146* .. Executable Statements ..
147*
148 info = 0
149 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
150*
151 IF( n.LT.0 ) THEN
152 info = 1
153 ELSE IF( n.EQ.0 ) THEN
154 IF( descx( m_ ).LT.0 )
155 $ info = 1
156 IF( descx( n_ ).LT.0 )
157 $ info = 1
158 ELSE
159 IF( incx.EQ.descx( m_ ) .AND.
160 $ descx( n_ ).LT.( jx+n-1 ) ) THEN
161 info = 1
162 ELSE IF( incx.EQ.1 .AND. incx.NE.descx( m_ ) .AND.
163 $ descx( m_ ).LT.( ix+n-1 ) ) THEN
164 info = 1
165 ELSE
166 IF( ix.GT.descx( m_ ) ) THEN
167 info = 1
168 ELSE IF( jx.GT.descx( n_ ) ) THEN
169 info = 1
170 END IF
171 END IF
172 END IF
173*
174* Check all processes for an error
175*
176 CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
177*
178 IF( info.NE.0 ) THEN
179 IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
180 WRITE( nout, fmt = 9999 ) matrix
181 WRITE( nout, fmt = 9998 ) n, matrix, ix, matrix, jx, matrix,
182 $ incx
183 WRITE( nout, fmt = 9997 ) matrix, descx( m_ ), matrix,
184 $ descx( n_ )
185 WRITE( nout, fmt = * )
186 END IF
187 END IF
188*
189 9999 FORMAT( 'Incompatible arguments for matrix ', a1, ':' )
190 9998 FORMAT( 'N = ', i6, ', I', a1, ' = ', i6, ', J', a1, ' = ',
191 $ i6, ',INC', a1, ' = ', i6 )
192 9997 FORMAT( 'DESC', a1, '( M_ ) = ', i6, ', DESC', a1, '( N_ ) = ',
193 $ i6, '.' )
194*
195 RETURN
196*
197* End of PVDIMCHK
198*

◆ pxerbla()

subroutine pxerbla ( integer ictxt,
character*(*) srname,
integer info )

Definition at line 1306 of file pblastst.f.

1307*
1308* -- PBLAS test routine (version 2.0) --
1309* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
1310* and University of California, Berkeley.
1311* April 1, 1998
1312*
1313* .. Scalar Arguments ..
1314 INTEGER ICTXT, INFO
1315* ..
1316* .. Array Arguments ..
1317 CHARACTER*(*) SRNAME
1318* ..
1319*
1320* Purpose
1321* =======
1322*
1323* PXERBLA is an error handler for the ScaLAPACK routines. It is called
1324* by a ScaLAPACK routine if an input parameter has an invalid value. A
1325* message is printed. Installers may consider modifying this routine in
1326* order to call system-specific exception-handling facilities.
1327*
1328* Arguments
1329* =========
1330*
1331* ICTXT (local input) INTEGER
1332* On entry, ICTXT specifies the BLACS context handle, indica-
1333* ting the global context of the operation. The context itself
1334* is global, but the value of ICTXT is local.
1335*
1336* SRNAME (global input) CHARACTER*(*)
1337* On entry, SRNAME specifies the name of the routine which cal-
1338* ling PXERBLA.
1339*
1340* INFO (global input) INTEGER
1341* On entry, INFO specifies the position of the invalid parame-
1342* ter in the parameter list of the calling routine.
1343*
1344* -- Written on April 1, 1998 by
1345* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
1346*
1347* =====================================================================
1348*
1349* .. Local Scalars ..
1350 INTEGER MYCOL, MYROW, NPCOL, NPROW
1351* ..
1352* .. External Subroutines ..
1353 EXTERNAL blacs_gridinfo
1354* ..
1355* .. Executable Statements ..
1356*
1357 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
1358*
1359 WRITE( *, fmt = 9999 ) myrow, mycol, srname, info
1360*
1361 9999 FORMAT( '{', i5, ',', i5, '}: On entry to ', a,
1362 $ ' parameter number ', i4, ' had an illegal value' )
1363*
1364 RETURN
1365*
1366* End of PXERBLA
1367*