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