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

◆ pb_clagen()

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

Definition at line 10422 of file pcblastst.f.

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