ScaLAPACK  2.0.2
ScaLAPACK: Scalable Linear Algebra PACKage
pdsepreq.f
Go to the documentation of this file.
00001 *
00002 *
00003       SUBROUTINE PDSEPREQ( HETERO, NIN, MEM, MEMSIZE, NOUT, ISEED,
00004      $                     NTESTS, NSKIPPED, NNOCHECK, NPASSED, INFO )
00005 *
00006 *  -- ScaLAPACK routine (version 1.7) --
00007 *     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
00008 *     and University of California, Berkeley.
00009 *     May 1, 1997
00010 *
00011 *     .. Scalar Arguments ..
00012       CHARACTER          HETERO
00013       INTEGER            INFO, MEMSIZE, NIN, NNOCHECK, NOUT, NPASSED,
00014      $                   NSKIPPED, NTESTS
00015 *     ..
00016 *     .. Array Arguments ..
00017       INTEGER            ISEED( 4 )
00018       DOUBLE PRECISION   MEM( MEMSIZE )
00019 *     ..
00020 *
00021 *  Purpose
00022 *  =======
00023 *
00024 *  PDSEPREQ performs one request from the input file 'SEP.dat'
00025 *  A request is the cross product of the specifications in the
00026 *  input file.  PDSEPREQ prints one line per test.
00027 *
00028 *  Arguments
00029 *  =========
00030 *
00031 *  NIN      (local input) INTEGER
00032 *           The unit number for the input file 'SEP.dat'
00033 *
00034 *  MEM      (local input ) DOUBLE PRECISION ARRAY, dimension MEMSIZE
00035 *           Array encompassing the available single precision memory
00036 *
00037 *  MEMSIZE  (local input)  INTEGER
00038 *           Size of MEM array
00039 *
00040 *  NOUT     (local input) INTEGER
00041 *           The unit number for output file.
00042 *           NOUT = 6, output to screen,
00043 *           NOUT = 0, output to stderr.
00044 *           NOUT = 13, output to file, divide thresh by 10
00045 *           NOUT = 14, output to file, divide thresh by 20
00046 *           Only used on node 0.
00047 *           NOUT = 13, 14 allow the threshold to be tighter for our
00048 *           internal testing which means that when a user reports
00049 *           a threshold error, it is more likely to be significant.
00050 *
00051 *  ISEED    (global input/output) INTEGER array, dimension 4
00052 *           Random number generator seed
00053 *
00054 *  NTESTS   (global input/output) INTEGER
00055 *           NTESTS = NTESTS + tests requested
00056 *
00057 *  NSKIPPED (global input/output) INTEGER
00058 *           NSKIPPED = NSKIPPED + tests skipped
00059 *
00060 *  NNOCHECK (global input/output) INTEGER
00061 *           NNOCHECK = NNOCHECK + tests completed but not checked
00062 *
00063 *  NPASSED  (global input/output) INTEGER
00064 *           NPASSED = NPASSED + tests which passed all checks
00065 *
00066 *
00067 *
00068 *  INFO     (global output) INTEGER
00069 *           0 = test request ran
00070 *           -1 = end of file
00071 *           -2 = incorrect .dat file
00072 *
00073 *
00074 *     .. Parameters ..
00075 *
00076       INTEGER            BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
00077      $                   MB_, NB_, RSRC_, CSRC_, LLD_
00078       PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
00079      $                   CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
00080      $                   RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
00081       INTEGER            DBLESZ, INTGSZ
00082       PARAMETER          ( DBLESZ = 8, INTGSZ = 4 )
00083       INTEGER            MAXSETSIZE
00084       PARAMETER          ( MAXSETSIZE = 50 )
00085 *     ..
00086 *     .. Local Scalars ..
00087       CHARACTER          SUBTESTS
00088       INTEGER            CONTEXT, IAM, IMIDPAD, INITCON, IPOSTPAD,
00089      $                   IPREPAD, ISIZESUBTST, ISIZESYEVX, ISIZETST,
00090      $                   LDA, LLWORK, MATSIZE, MATTYPE, MYCOL, MYROW, N,
00091      $                   NB, NMATSIZES, NMATTYPES, NNODES, NP, NPCOL,
00092      $                   NPCONFIGS, NPROW, NQ, NUPLOS, ORDER, PCONFIG,
00093      $                   PTRA, PTRCOPYA, PTRGAP, PTRICLUS, PTRIFAIL,
00094      $                   PTRIWRK, PTRW, PTRW2, PTRWORK, PTRZ, RES,
00095      $                   SIZECHK, SIZEMQRLEFT, SIZEMQRRIGHT, SIZEQRF,
00096      $                   SIZEQTQ, SIZESUBTST, SIZESYEV, SIZESYEVX,
00097      $                   SIZETMS, SIZETST, UPLO, ISIZESYEVD, SIZESYEVD
00098 
00099       DOUBLE PRECISION   ABSTOL, THRESH
00100 *     ..
00101 *     .. Local Arrays ..
00102       CHARACTER          UPLOS( 2 )
00103       INTEGER            DESCA( DLEN_ ), MATSIZES( MAXSETSIZE ),
00104      $                   MATTYPES( MAXSETSIZE ), NBS( MAXSETSIZE ),
00105      $                   NPCOLS( MAXSETSIZE ), NPROWS( MAXSETSIZE )
00106 *     ..
00107 *     .. External Functions ..
00108       INTEGER            ICEIL, NUMROC
00109       EXTERNAL           ICEIL, NUMROC
00110 *     ..
00111 *     .. External Subroutines ..
00112       EXTERNAL           BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT, 
00113      $                   BLACS_GRIDINFO, BLACS_GRIDINIT, BLACS_PINFO, 
00114      $                   DESCINIT, PDLASIZESQP, PDSEPINFO, PDSEPTST
00115 *     ..
00116 *     .. Intrinsic Functions ..
00117       INTRINSIC          MAX
00118 *     ..
00119 *     .. Executable Statements ..
00120 *       This is just to keep ftnchek happy
00121       IF( BLOCK_CYCLIC_2D*CSRC_*CTXT_*DLEN_*DTYPE_*LLD_*MB_*M_*NB_*N_*
00122      $    RSRC_.LT.0 )RETURN
00123 *
00124       CALL BLACS_PINFO( IAM, NNODES )
00125       CALL BLACS_GET( -1, 0, INITCON )
00126       CALL BLACS_GRIDINIT( INITCON, 'R', 1, NNODES )
00127 *
00128       CALL PDSEPINFO( INITCON, IAM, NIN, NOUT, MAXSETSIZE, NMATSIZES,
00129      $                MATSIZES, NUPLOS, UPLOS, NPCONFIGS, NPROWS,
00130      $                NPCOLS, NBS, NMATTYPES, MATTYPES, 22, SUBTESTS,
00131      $                THRESH, ORDER, ABSTOL, INFO )
00132 *
00133       CALL BLACS_GRIDEXIT( INITCON )
00134 *
00135       IF( INFO.EQ.0 ) THEN
00136 *
00137 *
00138          DO 40 MATSIZE = 1, NMATSIZES
00139 *
00140             DO 30 PCONFIG = 1, NPCONFIGS
00141 *
00142                DO 20 MATTYPE = 1, NMATTYPES
00143 *
00144                   DO 10 UPLO = 1, NUPLOS
00145 *
00146                      N = MATSIZES( MATSIZE )
00147                      ORDER = N
00148 *
00149                      NPROW = NPROWS( PCONFIG )
00150                      NPCOL = NPCOLS( PCONFIG )
00151                      NB = NBS( PCONFIG )
00152 *
00153                      NP = NUMROC( N, NB, 0, 0, NPROW )
00154                      NQ = NUMROC( N, NB, 0, 0, NPCOL )
00155                      IPREPAD = MAX( NB, NP )
00156                      IMIDPAD = NB
00157                      IPOSTPAD = MAX( NB, NQ )
00158 *
00159                      LDA = MAX( NP, 1 ) + IMIDPAD
00160 *
00161                      CALL BLACS_GET( -1, 0, CONTEXT )
00162                      CALL BLACS_GRIDINIT( CONTEXT, 'R', NPROW, NPCOL )
00163                      CALL BLACS_GRIDINFO( CONTEXT, NPROW, NPCOL, MYROW,
00164      $                                    MYCOL )
00165 *
00166                      IF( MYROW.GE.0 ) THEN
00167                         CALL DESCINIT( DESCA, N, N, NB, NB, 0, 0,
00168      $                                 CONTEXT, LDA, INFO )
00169                         CALL PDLASIZESQP( DESCA, IPREPAD, IPOSTPAD,
00170      $                                    SIZEMQRLEFT, SIZEMQRRIGHT,
00171      $                                    SIZEQRF, SIZETMS, SIZEQTQ,
00172      $                                    SIZECHK, SIZESYEVX,
00173      $                                    ISIZESYEVX, SIZESYEV,
00174      $                                    SIZESYEVD, ISIZESYEVD,
00175      $                                    SIZESUBTST, ISIZESUBTST,
00176      $                                    SIZETST, ISIZETST )
00177 *
00178                         PTRA = 1
00179                         PTRZ = PTRA + LDA*NQ + IPREPAD + IPOSTPAD
00180                         PTRCOPYA = PTRZ + LDA*NQ + IPREPAD + IPOSTPAD
00181                         PTRW = PTRCOPYA + LDA*NQ + IPREPAD + IPOSTPAD
00182                         PTRW2 = PTRW + MAX( N, 1 ) + IPREPAD + IPOSTPAD
00183                         PTRGAP = PTRW2 + MAX( N, 1 ) + IPREPAD +
00184      $                           IPOSTPAD
00185                         PTRIFAIL = PTRGAP + NPROW*NPCOL + IPREPAD +
00186      $                             IPOSTPAD
00187                         PTRICLUS = PTRIFAIL + ICEIL( N+IPREPAD+IPOSTPAD,
00188      $                             DBLESZ / INTGSZ )
00189                         PTRIWRK = PTRICLUS + ICEIL( 2*NPROW*NPCOL+
00190      $                            IPREPAD+IPOSTPAD, DBLESZ / INTGSZ )
00191                         PTRWORK = PTRIWRK + ICEIL( ISIZETST+IPREPAD+
00192      $                            IPOSTPAD, DBLESZ / INTGSZ )
00193                         LLWORK = MEMSIZE - PTRWORK + 1
00194 C                       LLWORK = MEMSIZE - PTRWORK - IPREPAD -
00195 C    $                           IPOSTPAD + 1
00196                         NTESTS = NTESTS + 1
00197                         IF( LLWORK.LT.SIZETST ) THEN
00198                            NSKIPPED = NSKIPPED + 1
00199                         ELSE
00200                            CALL PDSEPTST( DESCA, UPLOS( UPLO ), N,
00201      $                                    MATTYPES( MATTYPE ), SUBTESTS,
00202      $                                    THRESH, N, ABSTOL, ISEED,
00203      $                                    MEM( PTRA ), MEM( PTRCOPYA ),
00204      $                                    MEM( PTRZ ), LDA, MEM( PTRW ),
00205      $                                    MEM( PTRW2 ), MEM( PTRIFAIL ),
00206      $                                    MEM( PTRICLUS ),
00207      $                                    MEM( PTRGAP ), IPREPAD,
00208      $                                    IPOSTPAD, MEM( PTRWORK ),
00209      $                                    LLWORK, MEM( PTRIWRK ),
00210      $                                    ISIZETST, HETERO, NOUT, RES )
00211 *
00212                            IF( RES.EQ.0 ) THEN
00213                               NPASSED = NPASSED + 1
00214                            ELSE IF( RES.EQ.2 ) THEN
00215                               NNOCHECK = NNOCHECK + 1
00216                            ELSE IF( RES.EQ.3 ) THEN
00217                               NSKIPPED = NSKIPPED + 1
00218                               WRITE( NOUT, FMT = * )' PDSEPREQ failed'
00219                               CALL BLACS_ABORT( CONTEXT, -1 )
00220                            END IF
00221                         END IF
00222                         CALL BLACS_GRIDEXIT( CONTEXT )
00223                      END IF
00224    10             CONTINUE
00225    20          CONTINUE
00226    30       CONTINUE
00227    40    CONTINUE
00228       END IF
00229 *
00230 *
00231       RETURN
00232 *
00233 *     End of PDDSEPREQ
00234 *
00235       END