d2/dc1/_l_i_n_2psmatgen_8f_source.html

00001       SUBROUTINE PSMATGEN( ICTXT, AFORM, DIAG, M, N, MB, NB, A, LDA,
00002      $                     IAROW, IACOL, ISEED, IROFF, IRNUM, ICOFF,
00003      $                     ICNUM, MYROW, MYCOL, NPROW, NPCOL )
00004 *
00005 *  -- ScaLAPACK routine (version 1.7) --
00006 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00007 *     and University of California, Berkeley.
00008 *     May 1, 1997
00009 *
00010 *     .. Scalar Arguments ..
00011       CHARACTER*1        AFORM, DIAG
00012       INTEGER            IACOL, IAROW, ICNUM, ICOFF, ICTXT, IRNUM,
00013      $                   IROFF, ISEED, LDA, M, MB, MYCOL, MYROW, N,
00014      $                   NB, NPCOL, NPROW
00015 *     ..
00016 *     .. Array Arguments ..
00017       REAL               A( LDA, * )
00018 *     ..
00019 *
00020 *  Purpose
00021 *  =======
00022 *
00023 *  PSMATGEN : Parallel Real Single precision MATrix GENerator.
00024 *  Generate (or regenerate) a distributed matrix A (or sub-matrix of A).
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  ICTXT   (global input) INTEGER
00030 *          The BLACS context handle, indicating the global context of
00031 *          the operation. The context itself is global.
00032 *
00033 *  AFORM   (global input) CHARACTER*1
00034 *          if AFORM = 'S' : A is returned is a symmetric matrix.
00035 *          if AFORM = 'H' : A is returned is a Hermitian matrix.
00036 *          if AFORM = 'T' : A is overwritten with the transpose of
00037 *                           what would normally be generated.
00038 *          if AFORM = 'C' : A is overwritten with the conjugate trans-
00039 *                           pose of what would normally be generated.
00040 *          otherwise a random matrix is generated.
00041 *
00042 *  DIAG    (global input) CHARACTER*1
00043 *          if DIAG = 'D' : A is diagonally dominant.
00044 *
00045 *  M       (global input) INTEGER
00046 *          The number of rows in the generated distributed matrix.
00047 *
00048 *  N       (global input) INTEGER
00049 *          The number of columns in the generated distributed
00050 *          matrix.
00051 *
00052 *  MB      (global input) INTEGER
00053 *          The row blocking factor of the distributed matrix A.
00054 *
00055 *  NB      (global input) INTEGER
00056 *          The column blocking factor of the distributed matrix A.
00057 *
00058 *  A       (local output) REAL, pointer into the local memory
00059 *          to an array of dimension ( LDA, * ) containing the local
00060 *          pieces of the distributed matrix.
00061 *
00062 *  LDA     (local input) INTEGER
00063 *          The leading dimension of the array containing the local
00064 *          pieces of the distributed matrix A.
00065 *
00066 *  IAROW   (global input) INTEGER
00067 *          The row processor coordinate which holds the first block
00068 *          of the distributed matrix A.
00069 *
00070 *  IACOL   (global input) INTEGER
00071 *          The column processor coordinate which holds the first
00072 *          block of the distributed matrix A.
00073 *
00074 *  ISEED   (global input) INTEGER
00075 *          The seed number to generate the distributed matrix A.
00076 *
00077 *  IROFF   (local input) INTEGER
00078 *          The number of local rows of A that have already been
00079 *          generated.  It should be a multiple of MB.
00080 *
00081 *  IRNUM   (local input) INTEGER
00082 *          The number of local rows to be generated.
00083 *
00084 *  ICOFF   (local input) INTEGER
00085 *          The number of local columns of A that have already been
00086 *          generated.  It should be a multiple of NB.
00087 *
00088 *  ICNUM   (local input) INTEGER
00089 *          The number of local columns to be generated.
00090 *
00091 *  MYROW   (local input) INTEGER
00092 *          The row process coordinate of the calling process.
00093 *
00094 *  MYCOL   (local input) INTEGER
00095 *          The column process coordinate of the calling process.
00096 *
00097 *  NPROW   (global input) INTEGER
00098 *          The number of process rows in the grid.
00099 *
00100 *  NPCOL   (global input) INTEGER
00101 *          The number of process columns in the grid.
00102 *
00103 *  Notes
00104 *  =====
00105 *
00106 *  The code is originally developed by David Walker, ORNL,
00107 *  and modified by Jaeyoung Choi, ORNL.
00108 *
00109 *  Reference: G. Fox et al.
00110 *  Section 12.3 of "Solving problems on concurrent processors Vol. I"
00111 *
00112 *  =====================================================================
00113 *
00114 *     .. Parameters ..
00115       INTEGER            MULT0, MULT1, IADD0, IADD1
00116       PARAMETER        ( MULT0=20077, MULT1=16838, IADD0=12345,
00117      $                   IADD1=0 )
00118       REAL               ONE, TWO
00119       PARAMETER          ( ONE = 1.0E+0, TWO = 2.0E+0 )
00120 *     ..
00121 *     .. Local Scalars ..
00122       LOGICAL            SYMM, HERM, TRAN
00123       INTEGER            I, IC, IK, INFO, IOFFC, IOFFR, IR, J, JK,
00124      $                   JUMP1, JUMP2, JUMP3, JUMP4, JUMP5, JUMP6,
00125      $                   JUMP7, MAXMN, MEND, MOFF, MP, MRCOL, MRROW,
00126      $                   NEND, NOFF, NPMB, NQ, NQNB
00127 *     ..
00128 *     .. Local Arrays ..
00129       INTEGER            IADD(2), IA1(2), IA2(2), IA3(2), IA4(2),
00130      $                   IA5(2), IB1(2), IB2(2), IB3(2), IC1(2), IC2(2),
00131      $                   IC3(2), IC4(2), IC5(2), IRAN1(2), IRAN2(2),
00132      $                   IRAN3(2), IRAN4(2), ITMP1(2), ITMP2(2),
00133      $                   ITMP3(2), JSEED(2), MULT(2)
00134 *     ..
00135 *     .. External Subroutines ..
00136       EXTERNAL           JUMPIT, PXERBLA, SETRAN, XJUMPM
00137 *     ..
00138 *     .. Intrinsic Functions ..
00139       INTRINSIC          ABS, MAX, MOD
00140 *     ..
00141 *     .. External Functions ..
00142       LOGICAL            LSAME
00143       INTEGER            ICEIL, NUMROC
00144       REAL               PSRAND
00145       EXTERNAL           ICEIL, NUMROC, LSAME, PSRAND
00146 *     ..
00147 *     .. Executable Statements ..
00148 *
00149 *     Test the input arguments
00150 *
00151       MP   = NUMROC( M, MB, MYROW, IAROW, NPROW )
00152       NQ   = NUMROC( N, NB, MYCOL, IACOL, NPCOL )
00153       SYMM = LSAME( AFORM, 'S' )
00154       HERM = LSAME( AFORM, 'H' )
00155       TRAN = LSAME( AFORM, 'T' )
00156 *
00157       INFO = 0
00158       IF( .NOT.LSAME( DIAG, 'D' ) .AND.
00159      $         .NOT.LSAME( DIAG, 'N' )        ) THEN
00160          INFO = 3
00161       ELSE IF( SYMM.OR.HERM ) THEN
00162          IF( M.NE.N ) THEN
00163             INFO = 5
00164          ELSE IF( MB.NE.NB ) THEN
00165             INFO = 7
00166          END IF
00167       ELSE IF( M.LT.0 ) THEN
00168          INFO = 4
00169       ELSE IF( N.LT.0 ) THEN
00170          INFO = 5
00171       ELSE IF( MB.LT.1 ) THEN
00172          INFO = 6
00173       ELSE IF( NB.LT.1 ) THEN
00174          INFO = 7
00175       ELSE IF( LDA.LT.0 ) THEN
00176          INFO = 9
00177       ELSE IF( ( IAROW.LT.0 ).OR.( IAROW.GE.NPROW ) ) THEN
00178          INFO = 10
00179       ELSE IF( ( IACOL.LT.0 ).OR.( IACOL.GE.NPCOL ) ) THEN
00180          INFO = 11
00181       ELSE IF( MOD(IROFF,MB).GT.0 ) THEN
00182          INFO = 13
00183       ELSE IF( IRNUM.GT.(MP-IROFF) ) THEN
00184          INFO = 14
00185       ELSE IF( MOD(ICOFF,NB).GT.0 ) THEN
00186          INFO = 15
00187       ELSE IF( ICNUM.GT.(NQ-ICOFF) ) THEN
00188          INFO = 16
00189       ELSE IF( ( MYROW.LT.0 ).OR.( MYROW.GE.NPROW ) ) THEN
00190          INFO = 17
00191       ELSE IF( ( MYCOL.LT.0 ).OR.( MYCOL.GE.NPCOL ) ) THEN
00192          INFO = 18
00193       END IF
00194       IF( INFO.NE.0 ) THEN
00195          CALL PXERBLA( ICTXT, 'PSMATGEN', INFO )
00196          RETURN
00197       END IF
00198 *
00199       MRROW = MOD( NPROW+MYROW-IAROW, NPROW )
00200       MRCOL = MOD( NPCOL+MYCOL-IACOL, NPCOL )
00201       NPMB  = NPROW * MB
00202       NQNB  = NPCOL * NB
00203       MOFF  = IROFF / MB
00204       NOFF  = ICOFF / NB
00205       MEND  = ICEIL(IRNUM, MB) + MOFF
00206       NEND  = ICEIL(ICNUM, NB) + NOFF
00207 *
00208       MULT(1)  = MULT0
00209       MULT(2)  = MULT1
00210       IADD(1)  = IADD0
00211       IADD(2)  = IADD1
00212       JSEED(1) = ISEED
00213       JSEED(2) = 0
00214 *
00215 *     Symmetric or Hermitian matrix will be generated.
00216 *
00217       IF( SYMM.OR.HERM ) THEN
00218 *
00219 *        First, generate the lower triangular part (with diagonal block)
00220 *
00221          JUMP1 = 1
00222          JUMP2 = NPMB
00223          JUMP3 = M
00224          JUMP4 = NQNB
00225          JUMP5 = NB
00226          JUMP6 = MRCOL
00227          JUMP7 = MB*MRROW
00228 *
00229          CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1,   IC1 )
00230          CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2,   IC2 )
00231          CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3,   IC3 )
00232          CALL XJUMPM( JUMP4, IA3,  IC3,  IRAN1, ITMP1, IA4,   IC4 )
00233          CALL XJUMPM( JUMP5, IA3,  IC3,  IRAN1, ITMP1, IA5,   IC5 )
00234          CALL XJUMPM( JUMP6, IA5,  IC5,  IRAN1, ITMP3, ITMP1, ITMP2 )
00235          CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
00236          CALL XJUMPM( NOFF,  IA4,  IC4,  IRAN1, ITMP1, ITMP2, ITMP3 )
00237          CALL XJUMPM( MOFF,  IA2,  IC2,  ITMP1, IRAN1, ITMP2, ITMP3 )
00238          CALL SETRAN( IRAN1, IA1,  IC1 )
00239 *
00240          DO 10 I = 1, 2
00241             IB1(I) = IRAN1(I)
00242             IB2(I) = IRAN1(I)
00243             IB3(I) = IRAN1(I)
00244    10    CONTINUE
00245 *
00246          JK = 1
00247          DO 80 IC = NOFF+1, NEND
00248             IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
00249             DO 70 I = 1, NB
00250                IF( JK .GT. ICNUM ) GO TO 90
00251 *
00252                IK = 1
00253                DO 50 IR = MOFF+1, MEND
00254                   IOFFR = ((IR-1)*NPROW+MRROW) * MB
00255 *
00256                   IF( IOFFR .GT. IOFFC ) THEN
00257                      DO 20 J = 1, MB
00258                         IF( IK .GT. IRNUM ) GO TO 60
00259                         A(IK,JK) = ONE - TWO*PSRAND(0)
00260                         IK = IK + 1
00261    20                CONTINUE
00262 *
00263                   ELSE IF( IOFFC .EQ. IOFFR ) THEN
00264                      IK = IK + I - 1
00265                      IF( IK .GT. IRNUM ) GO TO 60
00266                      DO 30 J = 1, I-1
00267                         A(IK,JK) = ONE - TWO*PSRAND(0)
00268    30                CONTINUE
00269                      A(IK,JK) = ONE - TWO*PSRAND(0)
00270                      DO 40 J = 1, MB-I
00271                         IF( IK+J .GT. IRNUM ) GO TO 60
00272                         A(IK+J,JK) = ONE - TWO*PSRAND(0)
00273                         A(IK,JK+J) = A(IK+J,JK)
00274    40                CONTINUE
00275                      IK = IK + MB - I + 1
00276                   ELSE
00277                      IK = IK + MB
00278                   END IF
00279 *
00280                   CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
00281                   IB1(1) = IRAN2(1)
00282                   IB1(2) = IRAN2(2)
00283    50          CONTINUE
00284 *
00285    60          CONTINUE
00286                JK = JK + 1
00287                CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
00288                IB1(1) = IRAN3(1)
00289                IB1(2) = IRAN3(2)
00290                IB2(1) = IRAN3(1)
00291                IB2(2) = IRAN3(2)
00292    70       CONTINUE
00293 *
00294             CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
00295             IB1(1) = IRAN4(1)
00296             IB1(2) = IRAN4(2)
00297             IB2(1) = IRAN4(1)
00298             IB2(2) = IRAN4(2)
00299             IB3(1) = IRAN4(1)
00300             IB3(2) = IRAN4(2)
00301    80    CONTINUE
00302 *
00303 *        Next, generate the upper triangular part.
00304 *
00305    90    CONTINUE
00306          MULT(1)  = MULT0
00307          MULT(2)  = MULT1
00308          IADD(1)  = IADD0
00309          IADD(2)  = IADD1
00310          JSEED(1) = ISEED
00311          JSEED(2) = 0
00312 *
00313          JUMP1 = 1
00314          JUMP2 = NQNB
00315          JUMP3 = N
00316          JUMP4 = NPMB
00317          JUMP5 = MB
00318          JUMP6 = MRROW
00319          JUMP7 = NB*MRCOL
00320 *
00321          CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1,   IC1 )
00322          CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2,   IC2 )
00323          CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3,   IC3 )
00324          CALL XJUMPM( JUMP4, IA3,  IC3,  IRAN1, ITMP1, IA4,   IC4 )
00325          CALL XJUMPM( JUMP5, IA3,  IC3,  IRAN1, ITMP1, IA5,   IC5 )
00326          CALL XJUMPM( JUMP6, IA5,  IC5,  IRAN1, ITMP3, ITMP1, ITMP2 )
00327          CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
00328          CALL XJUMPM( MOFF,  IA4,  IC4,  IRAN1, ITMP1, ITMP2, ITMP3 )
00329          CALL XJUMPM( NOFF,  IA2,  IC2,  ITMP1, IRAN1, ITMP2, ITMP3 )
00330          CALL SETRAN( IRAN1, IA1,  IC1 )
00331 *
00332          DO 100 I = 1, 2
00333             IB1(I) = IRAN1(I)
00334             IB2(I) = IRAN1(I)
00335             IB3(I) = IRAN1(I)
00336   100    CONTINUE
00337 *
00338          IK = 1
00339          DO 150 IR = MOFF+1, MEND
00340             IOFFR = ((IR-1)*NPROW+MRROW) * MB
00341             DO 140 J = 1, MB
00342                IF( IK .GT. IRNUM ) GO TO 160
00343                JK = 1
00344                DO 120 IC = NOFF+1, NEND
00345                   IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
00346                   IF( IOFFC .GT. IOFFR ) THEN
00347                      DO 110 I = 1, NB
00348                         IF( JK .GT. ICNUM ) GO TO 130
00349                         A(IK,JK) = ONE - TWO*PSRAND(0)
00350                         JK = JK + 1
00351   110                CONTINUE
00352                   ELSE
00353                      JK = JK + NB
00354                   END IF
00355                   CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
00356                   IB1(1) = IRAN2(1)
00357                   IB1(2) = IRAN2(2)
00358   120          CONTINUE
00359 *
00360   130          CONTINUE
00361                IK = IK + 1
00362                CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
00363                IB1(1) = IRAN3(1)
00364                IB1(2) = IRAN3(2)
00365                IB2(1) = IRAN3(1)
00366                IB2(2) = IRAN3(2)
00367   140       CONTINUE
00368 *
00369             CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
00370             IB1(1) = IRAN4(1)
00371             IB1(2) = IRAN4(2)
00372             IB2(1) = IRAN4(1)
00373             IB2(2) = IRAN4(2)
00374             IB3(1) = IRAN4(1)
00375             IB3(2) = IRAN4(2)
00376   150    CONTINUE
00377   160    CONTINUE
00378 *
00379 *     (Conjugate) Transposed matrix A will be generated.
00380 *
00381       ELSE IF( TRAN .OR. LSAME( AFORM, 'C' ) ) THEN
00382 *
00383          JUMP1 = 1
00384          JUMP2 = NQNB
00385          JUMP3 = N
00386          JUMP4 = NPMB
00387          JUMP5 = MB
00388          JUMP6 = MRROW
00389          JUMP7 = NB*MRCOL
00390 *
00391          CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1,   IC1 )
00392          CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2,   IC2 )
00393          CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3,   IC3 )
00394          CALL XJUMPM( JUMP4, IA3,  IC3,  IRAN1, ITMP1, IA4,   IC4 )
00395          CALL XJUMPM( JUMP5, IA3,  IC3,  IRAN1, ITMP1, IA5,   IC5 )
00396          CALL XJUMPM( JUMP6, IA5,  IC5,  IRAN1, ITMP3, ITMP1, ITMP2 )
00397          CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
00398          CALL XJUMPM( MOFF,  IA4,  IC4,  IRAN1, ITMP1, ITMP2, ITMP3 )
00399          CALL XJUMPM( NOFF,  IA2,  IC2,  ITMP1, IRAN1, ITMP2, ITMP3 )
00400          CALL SETRAN( IRAN1, IA1,  IC1 )
00401 *
00402          DO 170 I = 1, 2
00403             IB1(I) = IRAN1(I)
00404             IB2(I) = IRAN1(I)
00405             IB3(I) = IRAN1(I)
00406   170    CONTINUE
00407 *
00408          IK = 1
00409          DO 220 IR = MOFF+1, MEND
00410             IOFFR = ((IR-1)*NPROW+MRROW) * MB
00411             DO 210 J = 1, MB
00412                IF( IK .GT. IRNUM ) GO TO 230
00413                JK = 1
00414                DO 190 IC = NOFF+1, NEND
00415                   IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
00416                   DO 180 I = 1, NB
00417                      IF( JK .GT. ICNUM ) GO TO 200
00418                      A(IK,JK) = ONE - TWO*PSRAND(0)
00419                      JK = JK + 1
00420   180             CONTINUE
00421                   CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
00422                   IB1(1) = IRAN2(1)
00423                   IB1(2) = IRAN2(2)
00424   190          CONTINUE
00425 *
00426   200          CONTINUE
00427                IK = IK + 1
00428                CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
00429                IB1(1) = IRAN3(1)
00430                IB1(2) = IRAN3(2)
00431                IB2(1) = IRAN3(1)
00432                IB2(2) = IRAN3(2)
00433   210       CONTINUE
00434 *
00435             CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
00436             IB1(1) = IRAN4(1)
00437             IB1(2) = IRAN4(2)
00438             IB2(1) = IRAN4(1)
00439             IB2(2) = IRAN4(2)
00440             IB3(1) = IRAN4(1)
00441             IB3(2) = IRAN4(2)
00442   220    CONTINUE
00443   230    CONTINUE
00444 *
00445 *     A random matrix is generated.
00446 *
00447       ELSE
00448 *
00449          JUMP1 = 1
00450          JUMP2 = NPMB
00451          JUMP3 = M
00452          JUMP4 = NQNB
00453          JUMP5 = NB
00454          JUMP6 = MRCOL
00455          JUMP7 = MB*MRROW
00456 *
00457          CALL XJUMPM( JUMP1, MULT, IADD, JSEED, IRAN1, IA1,   IC1 )
00458          CALL XJUMPM( JUMP2, MULT, IADD, IRAN1, ITMP1, IA2,   IC2 )
00459          CALL XJUMPM( JUMP3, MULT, IADD, IRAN1, ITMP1, IA3,   IC3 )
00460          CALL XJUMPM( JUMP4, IA3,  IC3,  IRAN1, ITMP1, IA4,   IC4 )
00461          CALL XJUMPM( JUMP5, IA3,  IC3,  IRAN1, ITMP1, IA5,   IC5 )
00462          CALL XJUMPM( JUMP6, IA5,  IC5,  IRAN1, ITMP3, ITMP1, ITMP2 )
00463          CALL XJUMPM( JUMP7, MULT, IADD, ITMP3, IRAN1, ITMP1, ITMP2 )
00464          CALL XJUMPM( NOFF,  IA4,  IC4,  IRAN1, ITMP1, ITMP2, ITMP3 )
00465          CALL XJUMPM( MOFF,  IA2,  IC2,  ITMP1, IRAN1, ITMP2, ITMP3 )
00466          CALL SETRAN( IRAN1, IA1,  IC1 )
00467 *
00468          DO 240 I = 1, 2
00469             IB1(I) = IRAN1(I)
00470             IB2(I) = IRAN1(I)
00471             IB3(I) = IRAN1(I)
00472   240    CONTINUE
00473 *
00474          JK = 1
00475          DO 290 IC = NOFF+1, NEND
00476             IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
00477             DO 280 I = 1, NB
00478                IF( JK .GT. ICNUM ) GO TO 300
00479                IK = 1
00480                DO 260 IR = MOFF+1, MEND
00481                   IOFFR = ((IR-1)*NPROW+MRROW) * MB
00482                   DO 250 J = 1, MB
00483                      IF( IK .GT. IRNUM ) GO TO 270
00484                      A(IK,JK) = ONE - TWO*PSRAND(0)
00485                      IK = IK + 1
00486   250             CONTINUE
00487                   CALL JUMPIT( IA2, IC2, IB1, IRAN2 )
00488                   IB1(1) = IRAN2(1)
00489                   IB1(2) = IRAN2(2)
00490   260          CONTINUE
00491 *
00492   270          CONTINUE
00493                JK = JK + 1
00494                CALL JUMPIT( IA3, IC3, IB2, IRAN3 )
00495                IB1(1) = IRAN3(1)
00496                IB1(2) = IRAN3(2)
00497                IB2(1) = IRAN3(1)
00498                IB2(2) = IRAN3(2)
00499   280       CONTINUE
00500 *
00501             CALL JUMPIT( IA4, IC4, IB3, IRAN4 )
00502             IB1(1) = IRAN4(1)
00503             IB1(2) = IRAN4(2)
00504             IB2(1) = IRAN4(1)
00505             IB2(2) = IRAN4(2)
00506             IB3(1) = IRAN4(1)
00507             IB3(2) = IRAN4(2)
00508   290    CONTINUE
00509   300    CONTINUE
00510       END IF
00511 *
00512 *     Diagonally dominant matrix will be generated.
00513 *
00514       IF( LSAME( DIAG, 'D' ) ) THEN
00515          IF( MB.NE.NB ) THEN
00516             WRITE(*,*) 'Diagonally dominant matrices with rowNB not'//
00517      $                 ' equal colNB is not supported!'
00518             RETURN
00519          END IF
00520 *
00521          MAXMN = MAX(M, N)
00522          JK    = 1
00523          DO 340 IC = NOFF+1, NEND
00524             IOFFC = ((IC-1)*NPCOL+MRCOL) * NB
00525             IK    = 1
00526             DO 320 IR = MOFF+1, MEND
00527                IOFFR = ((IR-1)*NPROW+MRROW) * MB
00528                IF( IOFFC.EQ.IOFFR ) THEN
00529                   DO 310 J = 0, MB-1
00530                      IF( IK .GT. IRNUM ) GO TO 330
00531                      A(IK,JK+J) = ABS(A(IK,JK+J)) + MAXMN
00532                      IK = IK + 1
00533   310             CONTINUE
00534                ELSE
00535                   IK = IK + MB
00536                END IF
00537   320       CONTINUE
00538   330       CONTINUE
00539             JK = JK + NB
00540   340    CONTINUE
00541       END IF
00542 *
00543       RETURN
00544 *
00545 *     End of PSMATGEN
00546 *
00547       END