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

◆ pb_zlagen()

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

Definition at line 10424 of file pzblastst.f.

10427*
10428* -- PBLAS test routine (version 2.0) --
10429* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
10430* and University of California, Berkeley.
10431* April 1, 1998
10432*
10433* .. Scalar Arguments ..
10434 CHARACTER*1 UPLO, AFORM
10435 INTEGER IMBLOC, INBLOC, LCMT00, LDA, LMBLOC, LNBLOC,
10436 $ MB, MBLKS, NB, NBLKS
10437* ..
10438* .. Array Arguments ..
10439 INTEGER IMULADD( 4, * ), IRAN( * ), JMP( * )
10440 COMPLEX*16 A( LDA, * )
10441* ..
10442*
10443* Purpose
10444* =======
10445*
10446* PB_ZLAGEN locally initializes an array A.
10447*
10448* Arguments
10449* =========
10450*
10451* UPLO (global input) CHARACTER*1
10452* On entry, UPLO specifies whether the lower (UPLO='L') trape-
10453* zoidal part or the upper (UPLO='U') trapezoidal part is to be
10454* generated when the matrix to be generated is symmetric or
10455* Hermitian. For all the other values of AFORM, the value of
10456* this input argument is ignored.
10457*
10458* AFORM (global input) CHARACTER*1
10459* On entry, AFORM specifies the type of submatrix to be genera-
10460* ted as follows:
10461* AFORM = 'S', sub( A ) is a symmetric matrix,
10462* AFORM = 'H', sub( A ) is a Hermitian matrix,
10463* AFORM = 'T', sub( A ) is overrwritten with the transpose
10464* of what would normally be generated,
10465* AFORM = 'C', sub( A ) is overwritten with the conjugate
10466* transpose of what would normally be genera-
10467* ted.
10468* AFORM = 'N', a random submatrix is generated.
10469*
10470* A (local output) COMPLEX*16 array
10471* On entry, A is an array of dimension (LLD_A, *). On exit,
10472* this array contains the local entries of the randomly genera-
10473* ted submatrix sub( A ).
10474*
10475* LDA (local input) INTEGER
10476* On entry, LDA specifies the local leading dimension of the
10477* array A. LDA must be at least one.
10478*
10479* LCMT00 (global input) INTEGER
10480* On entry, LCMT00 is the LCM value specifying the off-diagonal
10481* of the underlying matrix of interest. LCMT00=0 specifies the
10482* main diagonal, LCMT00 > 0 specifies a subdiagonal, LCMT00 < 0
10483* specifies superdiagonals.
10484*
10485* IRAN (local input) INTEGER array
10486* On entry, IRAN is an array of dimension 2 containing respec-
10487* tively the 16-lower and 16-higher bits of the encoding of the
10488* entry of the random sequence corresponding locally to the
10489* first local array entry to generate. Usually, this array is
10490* computed by PB_SETLOCRAN.
10491*
10492* MBLKS (local input) INTEGER
10493* On entry, MBLKS specifies the local number of blocks of rows.
10494* MBLKS is at least zero.
10495*
10496* IMBLOC (local input) INTEGER
10497* On entry, IMBLOC specifies the number of rows (size) of the
10498* local uppest blocks. IMBLOC is at least zero.
10499*
10500* MB (global input) INTEGER
10501* On entry, MB specifies the blocking factor used to partition
10502* the rows of the matrix. MB must be at least one.
10503*
10504* LMBLOC (local input) INTEGER
10505* On entry, LMBLOC specifies the number of rows (size) of the
10506* local lowest blocks. LMBLOC is at least zero.
10507*
10508* NBLKS (local input) INTEGER
10509* On entry, NBLKS specifies the local number of blocks of co-
10510* lumns. NBLKS is at least zero.
10511*
10512* INBLOC (local input) INTEGER
10513* On entry, INBLOC specifies the number of columns (size) of
10514* the local leftmost blocks. INBLOC is at least zero.
10515*
10516* NB (global input) INTEGER
10517* On entry, NB specifies the blocking factor used to partition
10518* the the columns of the matrix. NB must be at least one.
10519*
10520* LNBLOC (local input) INTEGER
10521* On entry, LNBLOC specifies the number of columns (size) of
10522* the local rightmost blocks. LNBLOC is at least zero.
10523*
10524* JMP (local input) INTEGER array
10525* On entry, JMP is an array of dimension JMP_LEN containing the
10526* different jump values used by the random matrix generator.
10527*
10528* IMULADD (local input) INTEGER array
10529* On entry, IMULADD is an array of dimension (4, JMP_LEN). The
10530* jth column of this array contains the encoded initial cons-
10531* tants a_j and c_j to jump from X( n ) to X( n + JMP( j ) )
10532* (= a_j * X( n ) + c_j) in the random sequence. IMULADD(1:2,j)
10533* contains respectively the 16-lower and 16-higher bits of the
10534* constant a_j, and IMULADD(3:4,j) contains the 16-lower and
10535* 16-higher bits of the constant c_j.
10536*
10537* -- Written on April 1, 1998 by
10538* Antoine Petitet, University of Tennessee, Knoxville 37996, USA.
10539*
10540* =====================================================================
10541*
10542* .. Parameters ..
10543 INTEGER JMP_1, JMP_COL, JMP_IMBV, JMP_INBV, JMP_LEN,
10544 $ JMP_MB, JMP_NB, JMP_NPIMBLOC, JMP_NPMB,
10545 $ JMP_NQINBLOC, JMP_NQNB, JMP_ROW
10546 parameter( jmp_1 = 1, jmp_row = 2, jmp_col = 3,
10547 $ jmp_mb = 4, jmp_imbv = 5, jmp_npmb = 6,
10548 $ jmp_npimbloc = 7, jmp_nb = 8, jmp_inbv = 9,
10549 $ jmp_nqnb = 10, jmp_nqinbloc = 11,
10550 $ jmp_len = 11 )
10551 DOUBLE PRECISION ZERO
10552 parameter( zero = 0.0d+0 )
10553* ..
10554* .. Local Scalars ..
10555 INTEGER I, IB, IBLK, II, IK, ITMP, JB, JBLK, JJ, JK,
10556 $ JTMP, LCMTC, LCMTR, LOW, MNB, UPP
10557 COMPLEX*16 DUMMY
10558* ..
10559* .. Local Arrays ..
10560 INTEGER IB0( 2 ), IB1( 2 ), IB2( 2 ), IB3( 2 )
10561* ..
10562* .. External Subroutines ..
10563 EXTERNAL pb_jumpit
10564* ..
10565* .. External Functions ..
10566 LOGICAL LSAME
10567 DOUBLE PRECISION PB_DRAND
10568 EXTERNAL lsame, pb_drand
10569* ..
10570* .. Intrinsic Functions ..
10571 INTRINSIC dble, dcmplx, max, min
10572* ..
10573* .. Executable Statements ..
10574*
10575 DO 10 i = 1, 2
10576 ib1( i ) = iran( i )
10577 ib2( i ) = iran( i )
10578 ib3( i ) = iran( i )
10579 10 CONTINUE
10580*
10581 IF( lsame( aform, 'N' ) ) THEN
10582*
10583* Generate random matrix
10584*
10585 jj = 1
10586*
10587 DO 50 jblk = 1, nblks
10588*
10589 IF( jblk.EQ.1 ) THEN
10590 jb = inbloc
10591 ELSE IF( jblk.EQ.nblks ) THEN
10592 jb = lnbloc
10593 ELSE
10594 jb = nb
10595 END IF
10596*
10597 DO 40 jk = jj, jj + jb - 1
10598*
10599 ii = 1
10600*
10601 DO 30 iblk = 1, mblks
10602*
10603 IF( iblk.EQ.1 ) THEN
10604 ib = imbloc
10605 ELSE IF( iblk.EQ.mblks ) THEN
10606 ib = lmbloc
10607 ELSE
10608 ib = mb
10609 END IF
10610*
10611* Blocks are IB by JB
10612*
10613 DO 20 ik = ii, ii + ib - 1
10614 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10615 $ pb_drand( 0 ) )
10616 20 CONTINUE
10617*
10618 ii = ii + ib
10619*
10620 IF( iblk.EQ.1 ) THEN
10621*
10622* Jump IMBLOC + ( NPROW - 1 ) * MB rows
10623*
10624 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
10625 $ ib0 )
10626*
10627 ELSE
10628*
10629* Jump NPROW * MB rows
10630*
10631 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1, ib0 )
10632*
10633 END IF
10634*
10635 ib1( 1 ) = ib0( 1 )
10636 ib1( 2 ) = ib0( 2 )
10637*
10638 30 CONTINUE
10639*
10640* Jump one column
10641*
10642 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
10643*
10644 ib1( 1 ) = ib0( 1 )
10645 ib1( 2 ) = ib0( 2 )
10646 ib2( 1 ) = ib0( 1 )
10647 ib2( 2 ) = ib0( 2 )
10648*
10649 40 CONTINUE
10650*
10651 jj = jj + jb
10652*
10653 IF( jblk.EQ.1 ) THEN
10654*
10655* Jump INBLOC + ( NPCOL - 1 ) * NB columns
10656*
10657 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
10658*
10659 ELSE
10660*
10661* Jump NPCOL * NB columns
10662*
10663 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
10664*
10665 END IF
10666*
10667 ib1( 1 ) = ib0( 1 )
10668 ib1( 2 ) = ib0( 2 )
10669 ib2( 1 ) = ib0( 1 )
10670 ib2( 2 ) = ib0( 2 )
10671 ib3( 1 ) = ib0( 1 )
10672 ib3( 2 ) = ib0( 2 )
10673*
10674 50 CONTINUE
10675*
10676 ELSE IF( lsame( aform, 'T' ) ) THEN
10677*
10678* Generate the transpose of the matrix that would be normally
10679* generated.
10680*
10681 ii = 1
10682*
10683 DO 90 iblk = 1, mblks
10684*
10685 IF( iblk.EQ.1 ) THEN
10686 ib = imbloc
10687 ELSE IF( iblk.EQ.mblks ) THEN
10688 ib = lmbloc
10689 ELSE
10690 ib = mb
10691 END IF
10692*
10693 DO 80 ik = ii, ii + ib - 1
10694*
10695 jj = 1
10696*
10697 DO 70 jblk = 1, nblks
10698*
10699 IF( jblk.EQ.1 ) THEN
10700 jb = inbloc
10701 ELSE IF( jblk.EQ.nblks ) THEN
10702 jb = lnbloc
10703 ELSE
10704 jb = nb
10705 END IF
10706*
10707* Blocks are IB by JB
10708*
10709 DO 60 jk = jj, jj + jb - 1
10710 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10711 $ pb_drand( 0 ) )
10712 60 CONTINUE
10713*
10714 jj = jj + jb
10715*
10716 IF( jblk.EQ.1 ) THEN
10717*
10718* Jump INBLOC + ( NPCOL - 1 ) * NB columns
10719*
10720 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
10721 $ ib0 )
10722*
10723 ELSE
10724*
10725* Jump NPCOL * NB columns
10726*
10727 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1, ib0 )
10728*
10729 END IF
10730*
10731 ib1( 1 ) = ib0( 1 )
10732 ib1( 2 ) = ib0( 2 )
10733*
10734 70 CONTINUE
10735*
10736* Jump one row
10737*
10738 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
10739*
10740 ib1( 1 ) = ib0( 1 )
10741 ib1( 2 ) = ib0( 2 )
10742 ib2( 1 ) = ib0( 1 )
10743 ib2( 2 ) = ib0( 2 )
10744*
10745 80 CONTINUE
10746*
10747 ii = ii + ib
10748*
10749 IF( iblk.EQ.1 ) THEN
10750*
10751* Jump IMBLOC + ( NPROW - 1 ) * MB rows
10752*
10753 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
10754*
10755 ELSE
10756*
10757* Jump NPROW * MB rows
10758*
10759 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
10760*
10761 END IF
10762*
10763 ib1( 1 ) = ib0( 1 )
10764 ib1( 2 ) = ib0( 2 )
10765 ib2( 1 ) = ib0( 1 )
10766 ib2( 2 ) = ib0( 2 )
10767 ib3( 1 ) = ib0( 1 )
10768 ib3( 2 ) = ib0( 2 )
10769*
10770 90 CONTINUE
10771*
10772 ELSE IF( lsame( aform, 'S' ) ) THEN
10773*
10774* Generate a symmetric matrix
10775*
10776 IF( lsame( uplo, 'L' ) ) THEN
10777*
10778* generate lower trapezoidal part
10779*
10780 jj = 1
10781 lcmtc = lcmt00
10782*
10783 DO 170 jblk = 1, nblks
10784*
10785 IF( jblk.EQ.1 ) THEN
10786 jb = inbloc
10787 low = 1 - inbloc
10788 ELSE IF( jblk.EQ.nblks ) THEN
10789 jb = lnbloc
10790 low = 1 - nb
10791 ELSE
10792 jb = nb
10793 low = 1 - nb
10794 END IF
10795*
10796 DO 160 jk = jj, jj + jb - 1
10797*
10798 ii = 1
10799 lcmtr = lcmtc
10800*
10801 DO 150 iblk = 1, mblks
10802*
10803 IF( iblk.EQ.1 ) THEN
10804 ib = imbloc
10805 upp = imbloc - 1
10806 ELSE IF( iblk.EQ.mblks ) THEN
10807 ib = lmbloc
10808 upp = mb - 1
10809 ELSE
10810 ib = mb
10811 upp = mb - 1
10812 END IF
10813*
10814* Blocks are IB by JB
10815*
10816 IF( lcmtr.GT.upp ) THEN
10817*
10818 DO 100 ik = ii, ii + ib - 1
10819 dummy = dcmplx( pb_drand( 0 ),
10820 $ pb_drand( 0 ) )
10821 100 CONTINUE
10822*
10823 ELSE IF( lcmtr.GE.low ) THEN
10824*
10825 jtmp = jk - jj + 1
10826 mnb = max( 0, -lcmtr )
10827*
10828 IF( jtmp.LE.min( mnb, jb ) ) THEN
10829*
10830 DO 110 ik = ii, ii + ib - 1
10831 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10832 $ pb_drand( 0 ) )
10833 110 CONTINUE
10834*
10835 ELSE IF( ( jtmp.GE.( mnb + 1 ) ) .AND.
10836 $ ( jtmp.LE.min( ib-lcmtr, jb ) ) ) THEN
10837*
10838 itmp = ii + jtmp + lcmtr - 1
10839*
10840 DO 120 ik = ii, itmp - 1
10841 dummy = dcmplx( pb_drand( 0 ),
10842 $ pb_drand( 0 ) )
10843 120 CONTINUE
10844*
10845 DO 130 ik = itmp, ii + ib - 1
10846 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10847 $ pb_drand( 0 ) )
10848 130 CONTINUE
10849*
10850 END IF
10851*
10852 ELSE
10853*
10854 DO 140 ik = ii, ii + ib - 1
10855 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10856 $ pb_drand( 0 ) )
10857 140 CONTINUE
10858*
10859 END IF
10860*
10861 ii = ii + ib
10862*
10863 IF( iblk.EQ.1 ) THEN
10864*
10865* Jump IMBLOC + ( NPROW - 1 ) * MB rows
10866*
10867 lcmtr = lcmtr - jmp( jmp_npimbloc )
10868 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
10869 $ ib0 )
10870*
10871 ELSE
10872*
10873* Jump NPROW * MB rows
10874*
10875 lcmtr = lcmtr - jmp( jmp_npmb )
10876 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1,
10877 $ ib0 )
10878*
10879 END IF
10880*
10881 ib1( 1 ) = ib0( 1 )
10882 ib1( 2 ) = ib0( 2 )
10883*
10884 150 CONTINUE
10885*
10886* Jump one column
10887*
10888 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
10889*
10890 ib1( 1 ) = ib0( 1 )
10891 ib1( 2 ) = ib0( 2 )
10892 ib2( 1 ) = ib0( 1 )
10893 ib2( 2 ) = ib0( 2 )
10894*
10895 160 CONTINUE
10896*
10897 jj = jj + jb
10898*
10899 IF( jblk.EQ.1 ) THEN
10900*
10901* Jump INBLOC + ( NPCOL - 1 ) * NB columns
10902*
10903 lcmtc = lcmtc + jmp( jmp_nqinbloc )
10904 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
10905*
10906 ELSE
10907*
10908* Jump NPCOL * NB columns
10909*
10910 lcmtc = lcmtc + jmp( jmp_nqnb )
10911 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
10912*
10913 END IF
10914*
10915 ib1( 1 ) = ib0( 1 )
10916 ib1( 2 ) = ib0( 2 )
10917 ib2( 1 ) = ib0( 1 )
10918 ib2( 2 ) = ib0( 2 )
10919 ib3( 1 ) = ib0( 1 )
10920 ib3( 2 ) = ib0( 2 )
10921*
10922 170 CONTINUE
10923*
10924 ELSE
10925*
10926* generate upper trapezoidal part
10927*
10928 ii = 1
10929 lcmtr = lcmt00
10930*
10931 DO 250 iblk = 1, mblks
10932*
10933 IF( iblk.EQ.1 ) THEN
10934 ib = imbloc
10935 upp = imbloc - 1
10936 ELSE IF( iblk.EQ.mblks ) THEN
10937 ib = lmbloc
10938 upp = mb - 1
10939 ELSE
10940 ib = mb
10941 upp = mb - 1
10942 END IF
10943*
10944 DO 240 ik = ii, ii + ib - 1
10945*
10946 jj = 1
10947 lcmtc = lcmtr
10948*
10949 DO 230 jblk = 1, nblks
10950*
10951 IF( jblk.EQ.1 ) THEN
10952 jb = inbloc
10953 low = 1 - inbloc
10954 ELSE IF( jblk.EQ.nblks ) THEN
10955 jb = lnbloc
10956 low = 1 - nb
10957 ELSE
10958 jb = nb
10959 low = 1 - nb
10960 END IF
10961*
10962* Blocks are IB by JB
10963*
10964 IF( lcmtc.LT.low ) THEN
10965*
10966 DO 180 jk = jj, jj + jb - 1
10967 dummy = dcmplx( pb_drand( 0 ),
10968 $ pb_drand( 0 ) )
10969 180 CONTINUE
10970*
10971 ELSE IF( lcmtc.LE.upp ) THEN
10972*
10973 itmp = ik - ii + 1
10974 mnb = max( 0, lcmtc )
10975*
10976 IF( itmp.LE.min( mnb, ib ) ) THEN
10977*
10978 DO 190 jk = jj, jj + jb - 1
10979 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10980 $ pb_drand( 0 ) )
10981 190 CONTINUE
10982*
10983 ELSE IF( ( itmp.GE.( mnb + 1 ) ) .AND.
10984 $ ( itmp.LE.min( jb+lcmtc, ib ) ) ) THEN
10985*
10986 jtmp = jj + itmp - lcmtc - 1
10987*
10988 DO 200 jk = jj, jtmp - 1
10989 dummy = dcmplx( pb_drand( 0 ),
10990 $ pb_drand( 0 ) )
10991 200 CONTINUE
10992*
10993 DO 210 jk = jtmp, jj + jb - 1
10994 a( ik, jk ) = dcmplx( pb_drand( 0 ),
10995 $ pb_drand( 0 ) )
10996 210 CONTINUE
10997*
10998 END IF
10999*
11000 ELSE
11001*
11002 DO 220 jk = jj, jj + jb - 1
11003 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11004 $ pb_drand( 0 ) )
11005 220 CONTINUE
11006*
11007 END IF
11008*
11009 jj = jj + jb
11010*
11011 IF( jblk.EQ.1 ) THEN
11012*
11013* Jump INBLOC + ( NPCOL - 1 ) * NB columns
11014*
11015 lcmtc = lcmtc + jmp( jmp_nqinbloc )
11016 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
11017 $ ib0 )
11018*
11019 ELSE
11020*
11021* Jump NPCOL * NB columns
11022*
11023 lcmtc = lcmtc + jmp( jmp_nqnb )
11024 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
11025 $ ib0 )
11026*
11027 END IF
11028*
11029 ib1( 1 ) = ib0( 1 )
11030 ib1( 2 ) = ib0( 2 )
11031*
11032 230 CONTINUE
11033*
11034* Jump one row
11035*
11036 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
11037*
11038 ib1( 1 ) = ib0( 1 )
11039 ib1( 2 ) = ib0( 2 )
11040 ib2( 1 ) = ib0( 1 )
11041 ib2( 2 ) = ib0( 2 )
11042*
11043 240 CONTINUE
11044*
11045 ii = ii + ib
11046*
11047 IF( iblk.EQ.1 ) THEN
11048*
11049* Jump IMBLOC + ( NPROW - 1 ) * MB rows
11050*
11051 lcmtr = lcmtr - jmp( jmp_npimbloc )
11052 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
11053*
11054 ELSE
11055*
11056* Jump NPROW * MB rows
11057*
11058 lcmtr = lcmtr - jmp( jmp_npmb )
11059 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
11060*
11061 END IF
11062*
11063 ib1( 1 ) = ib0( 1 )
11064 ib1( 2 ) = ib0( 2 )
11065 ib2( 1 ) = ib0( 1 )
11066 ib2( 2 ) = ib0( 2 )
11067 ib3( 1 ) = ib0( 1 )
11068 ib3( 2 ) = ib0( 2 )
11069*
11070 250 CONTINUE
11071*
11072 END IF
11073*
11074 ELSE IF( lsame( aform, 'C' ) ) THEN
11075*
11076* Generate the conjugate transpose of the matrix that would be
11077* normally generated.
11078*
11079 ii = 1
11080*
11081 DO 290 iblk = 1, mblks
11082*
11083 IF( iblk.EQ.1 ) THEN
11084 ib = imbloc
11085 ELSE IF( iblk.EQ.mblks ) THEN
11086 ib = lmbloc
11087 ELSE
11088 ib = mb
11089 END IF
11090*
11091 DO 280 ik = ii, ii + ib - 1
11092*
11093 jj = 1
11094*
11095 DO 270 jblk = 1, nblks
11096*
11097 IF( jblk.EQ.1 ) THEN
11098 jb = inbloc
11099 ELSE IF( jblk.EQ.nblks ) THEN
11100 jb = lnbloc
11101 ELSE
11102 jb = nb
11103 END IF
11104*
11105* Blocks are IB by JB
11106*
11107 DO 260 jk = jj, jj + jb - 1
11108 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11109 $ -pb_drand( 0 ) )
11110 260 CONTINUE
11111*
11112 jj = jj + jb
11113*
11114 IF( jblk.EQ.1 ) THEN
11115*
11116* Jump INBLOC + ( NPCOL - 1 ) * NB columns
11117*
11118 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
11119 $ ib0 )
11120*
11121 ELSE
11122*
11123* Jump NPCOL * NB columns
11124*
11125 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
11126 $ ib0 )
11127*
11128 END IF
11129*
11130 ib1( 1 ) = ib0( 1 )
11131 ib1( 2 ) = ib0( 2 )
11132*
11133 270 CONTINUE
11134*
11135* Jump one row
11136*
11137 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
11138*
11139 ib1( 1 ) = ib0( 1 )
11140 ib1( 2 ) = ib0( 2 )
11141 ib2( 1 ) = ib0( 1 )
11142 ib2( 2 ) = ib0( 2 )
11143*
11144 280 CONTINUE
11145*
11146 ii = ii + ib
11147*
11148 IF( iblk.EQ.1 ) THEN
11149*
11150* Jump IMBLOC + ( NPROW - 1 ) * MB rows
11151*
11152 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
11153*
11154 ELSE
11155*
11156* Jump NPROW * MB rows
11157*
11158 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
11159*
11160 END IF
11161*
11162 ib1( 1 ) = ib0( 1 )
11163 ib1( 2 ) = ib0( 2 )
11164 ib2( 1 ) = ib0( 1 )
11165 ib2( 2 ) = ib0( 2 )
11166 ib3( 1 ) = ib0( 1 )
11167 ib3( 2 ) = ib0( 2 )
11168*
11169 290 CONTINUE
11170*
11171 ELSE IF( lsame( aform, 'H' ) ) THEN
11172*
11173* Generate a Hermitian matrix
11174*
11175 IF( lsame( uplo, 'L' ) ) THEN
11176*
11177* generate lower trapezoidal part
11178*
11179 jj = 1
11180 lcmtc = lcmt00
11181*
11182 DO 370 jblk = 1, nblks
11183*
11184 IF( jblk.EQ.1 ) THEN
11185 jb = inbloc
11186 low = 1 - inbloc
11187 ELSE IF( jblk.EQ.nblks ) THEN
11188 jb = lnbloc
11189 low = 1 - nb
11190 ELSE
11191 jb = nb
11192 low = 1 - nb
11193 END IF
11194*
11195 DO 360 jk = jj, jj + jb - 1
11196*
11197 ii = 1
11198 lcmtr = lcmtc
11199*
11200 DO 350 iblk = 1, mblks
11201*
11202 IF( iblk.EQ.1 ) THEN
11203 ib = imbloc
11204 upp = imbloc - 1
11205 ELSE IF( iblk.EQ.mblks ) THEN
11206 ib = lmbloc
11207 upp = mb - 1
11208 ELSE
11209 ib = mb
11210 upp = mb - 1
11211 END IF
11212*
11213* Blocks are IB by JB
11214*
11215 IF( lcmtr.GT.upp ) THEN
11216*
11217 DO 300 ik = ii, ii + ib - 1
11218 dummy = dcmplx( pb_drand( 0 ),
11219 $ pb_drand( 0 ) )
11220 300 CONTINUE
11221*
11222 ELSE IF( lcmtr.GE.low ) THEN
11223*
11224 jtmp = jk - jj + 1
11225 mnb = max( 0, -lcmtr )
11226*
11227 IF( jtmp.LE.min( mnb, jb ) ) THEN
11228*
11229 DO 310 ik = ii, ii + ib - 1
11230 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11231 $ pb_drand( 0 ) )
11232 310 CONTINUE
11233*
11234 ELSE IF( ( jtmp.GE.( mnb + 1 ) ) .AND.
11235 $ ( jtmp.LE.min( ib-lcmtr, jb ) ) ) THEN
11236*
11237 itmp = ii + jtmp + lcmtr - 1
11238*
11239 DO 320 ik = ii, itmp - 1
11240 dummy = dcmplx( pb_drand( 0 ),
11241 $ pb_drand( 0 ) )
11242 320 CONTINUE
11243*
11244 IF( itmp.LE.( ii + ib - 1 ) ) THEN
11245 dummy = dcmplx( pb_drand( 0 ),
11246 $ -pb_drand( 0 ) )
11247 a( itmp, jk ) = dcmplx( dble( dummy ),
11248 $ zero )
11249 END IF
11250*
11251 DO 330 ik = itmp + 1, ii + ib - 1
11252 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11253 $ pb_drand( 0 ) )
11254 330 CONTINUE
11255*
11256 END IF
11257*
11258 ELSE
11259*
11260 DO 340 ik = ii, ii + ib - 1
11261 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11262 $ pb_drand( 0 ) )
11263 340 CONTINUE
11264*
11265 END IF
11266*
11267 ii = ii + ib
11268*
11269 IF( iblk.EQ.1 ) THEN
11270*
11271* Jump IMBLOC + ( NPROW - 1 ) * MB rows
11272*
11273 lcmtr = lcmtr - jmp( jmp_npimbloc )
11274 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib1,
11275 $ ib0 )
11276*
11277 ELSE
11278*
11279* Jump NPROW * MB rows
11280*
11281 lcmtr = lcmtr - jmp( jmp_npmb )
11282 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib1,
11283 $ ib0 )
11284*
11285 END IF
11286*
11287 ib1( 1 ) = ib0( 1 )
11288 ib1( 2 ) = ib0( 2 )
11289*
11290 350 CONTINUE
11291*
11292* Jump one column
11293*
11294 CALL pb_jumpit( imuladd( 1, jmp_col ), ib2, ib0 )
11295*
11296 ib1( 1 ) = ib0( 1 )
11297 ib1( 2 ) = ib0( 2 )
11298 ib2( 1 ) = ib0( 1 )
11299 ib2( 2 ) = ib0( 2 )
11300*
11301 360 CONTINUE
11302*
11303 jj = jj + jb
11304*
11305 IF( jblk.EQ.1 ) THEN
11306*
11307* Jump INBLOC + ( NPCOL - 1 ) * NB columns
11308*
11309 lcmtc = lcmtc + jmp( jmp_nqinbloc )
11310 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib3, ib0 )
11311*
11312 ELSE
11313*
11314* Jump NPCOL * NB columns
11315*
11316 lcmtc = lcmtc + jmp( jmp_nqnb )
11317 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib3, ib0 )
11318*
11319 END IF
11320*
11321 ib1( 1 ) = ib0( 1 )
11322 ib1( 2 ) = ib0( 2 )
11323 ib2( 1 ) = ib0( 1 )
11324 ib2( 2 ) = ib0( 2 )
11325 ib3( 1 ) = ib0( 1 )
11326 ib3( 2 ) = ib0( 2 )
11327*
11328 370 CONTINUE
11329*
11330 ELSE
11331*
11332* generate upper trapezoidal part
11333*
11334 ii = 1
11335 lcmtr = lcmt00
11336*
11337 DO 450 iblk = 1, mblks
11338*
11339 IF( iblk.EQ.1 ) THEN
11340 ib = imbloc
11341 upp = imbloc - 1
11342 ELSE IF( iblk.EQ.mblks ) THEN
11343 ib = lmbloc
11344 upp = mb - 1
11345 ELSE
11346 ib = mb
11347 upp = mb - 1
11348 END IF
11349*
11350 DO 440 ik = ii, ii + ib - 1
11351*
11352 jj = 1
11353 lcmtc = lcmtr
11354*
11355 DO 430 jblk = 1, nblks
11356*
11357 IF( jblk.EQ.1 ) THEN
11358 jb = inbloc
11359 low = 1 - inbloc
11360 ELSE IF( jblk.EQ.nblks ) THEN
11361 jb = lnbloc
11362 low = 1 - nb
11363 ELSE
11364 jb = nb
11365 low = 1 - nb
11366 END IF
11367*
11368* Blocks are IB by JB
11369*
11370 IF( lcmtc.LT.low ) THEN
11371*
11372 DO 380 jk = jj, jj + jb - 1
11373 dummy = dcmplx( pb_drand( 0 ),
11374 $ -pb_drand( 0 ) )
11375 380 CONTINUE
11376*
11377 ELSE IF( lcmtc.LE.upp ) THEN
11378*
11379 itmp = ik - ii + 1
11380 mnb = max( 0, lcmtc )
11381*
11382 IF( itmp.LE.min( mnb, ib ) ) THEN
11383*
11384 DO 390 jk = jj, jj + jb - 1
11385 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11386 $ -pb_drand( 0 ) )
11387 390 CONTINUE
11388*
11389 ELSE IF( ( itmp.GE.( mnb + 1 ) ) .AND.
11390 $ ( itmp.LE.min( jb+lcmtc, ib ) ) ) THEN
11391*
11392 jtmp = jj + itmp - lcmtc - 1
11393*
11394 DO 400 jk = jj, jtmp - 1
11395 dummy = dcmplx( pb_drand( 0 ),
11396 $ -pb_drand( 0 ) )
11397 400 CONTINUE
11398*
11399 IF( jtmp.LE.( jj + jb - 1 ) ) THEN
11400 dummy = dcmplx( pb_drand( 0 ),
11401 $ -pb_drand( 0 ) )
11402 a( ik, jtmp ) = dcmplx( dble( dummy ),
11403 $ zero )
11404 END IF
11405*
11406 DO 410 jk = jtmp + 1, jj + jb - 1
11407 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11408 $ -pb_drand( 0 ) )
11409 410 CONTINUE
11410*
11411 END IF
11412*
11413 ELSE
11414*
11415 DO 420 jk = jj, jj + jb - 1
11416 a( ik, jk ) = dcmplx( pb_drand( 0 ),
11417 $ -pb_drand( 0 ) )
11418 420 CONTINUE
11419*
11420 END IF
11421*
11422 jj = jj + jb
11423*
11424 IF( jblk.EQ.1 ) THEN
11425*
11426* Jump INBLOC + ( NPCOL - 1 ) * NB columns
11427*
11428 lcmtc = lcmtc + jmp( jmp_nqinbloc )
11429 CALL pb_jumpit( imuladd( 1, jmp_nqinbloc ), ib1,
11430 $ ib0 )
11431*
11432 ELSE
11433*
11434* Jump NPCOL * NB columns
11435*
11436 lcmtc = lcmtc + jmp( jmp_nqnb )
11437 CALL pb_jumpit( imuladd( 1, jmp_nqnb ), ib1,
11438 $ ib0 )
11439*
11440 END IF
11441*
11442 ib1( 1 ) = ib0( 1 )
11443 ib1( 2 ) = ib0( 2 )
11444*
11445 430 CONTINUE
11446*
11447* Jump one row
11448*
11449 CALL pb_jumpit( imuladd( 1, jmp_row ), ib2, ib0 )
11450*
11451 ib1( 1 ) = ib0( 1 )
11452 ib1( 2 ) = ib0( 2 )
11453 ib2( 1 ) = ib0( 1 )
11454 ib2( 2 ) = ib0( 2 )
11455*
11456 440 CONTINUE
11457*
11458 ii = ii + ib
11459*
11460 IF( iblk.EQ.1 ) THEN
11461*
11462* Jump IMBLOC + ( NPROW - 1 ) * MB rows
11463*
11464 lcmtr = lcmtr - jmp( jmp_npimbloc )
11465 CALL pb_jumpit( imuladd( 1, jmp_npimbloc ), ib3, ib0 )
11466*
11467 ELSE
11468*
11469* Jump NPROW * MB rows
11470*
11471 lcmtr = lcmtr - jmp( jmp_npmb )
11472 CALL pb_jumpit( imuladd( 1, jmp_npmb ), ib3, ib0 )
11473*
11474 END IF
11475*
11476 ib1( 1 ) = ib0( 1 )
11477 ib1( 2 ) = ib0( 2 )
11478 ib2( 1 ) = ib0( 1 )
11479 ib2( 2 ) = ib0( 2 )
11480 ib3( 1 ) = ib0( 1 )
11481 ib3( 2 ) = ib0( 2 )
11482*
11483 450 CONTINUE
11484*
11485 END IF
11486*
11487 END IF
11488*
11489 RETURN
11490*
11491* End of PB_ZLAGEN
11492*
pb_jumpit
subroutine pb_jumpit(muladd, irann, iranm)
Definition pblastst.f:4822
max
#define max(A, B)
Definition pcgemr.c:180
min
#define min(A, B)
Definition pcgemr.c:181
pb_drand
double precision function pb_drand(idumm)
Definition pdblastst.f:10378
lsame
logical function lsame(ca, cb)
Definition tools.f:1724
Here is the caller graph for this function: