pdscaexinfo.f

Go to the documentation of this file.

      SUBROUTINE pdscaexinfo( SUMMRY, NOUT, N, NRHS, NB, NPROW, NPCOL,
     $                        WORK, IAM, NPROCS )
*
*  -- ScaLAPACK example code --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*
*     Written by Antoine Petitet, August 1995  (petitet@cs.utk.edu)
*
*     This program solves a linear system by calling the ScaLAPACK 
*     routine PDGESV. The input matrix and right-and-sides are
*     read from a file. The solution is written to a file.
*
*     .. Scalar Arguments ..
      CHARACTER*( * )    SUMMRY
      INTEGER            IAM, N, NRHS, NB, NOUT, NPCOL, NPROCS, NPROW
*     ..
*     .. Array Arguments ..
      INTEGER            WORK( * )
*     ..
*
* ======================================================================
*
*     .. Parameters ..
      INTEGER            NIN
      parameter( nin = 11 )
*     ..
*     .. Local Scalars ..
      CHARACTER*79       USRINFO
      INTEGER            ICTXT
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_abort, blacs_get, blacs_gridexit,
     $                   blacs_gridinit, blacs_setup, igebr2d, igebs2d
*     ..
*     .. Executable Statements ..
*
*     Process 0 reads the input data, broadcasts to other processes and
*     writes needed information to NOUT
*
      IF( iam.EQ.0 ) THEN
*
*        Open file and skip data file header
*
         OPEN( nin, file='SCAEX.dat', status='OLD' )
         READ( nin, fmt = * ) summry
         summry = ' '
*
*        Read in user-supplied info about machine type, compiler, etc.
*
         READ( nin, fmt = 9999 ) usrinfo
*
*        Read name and unit number for summary output file
*
         READ( nin, fmt = * ) summry
         READ( nin, fmt = * ) nout
         IF( nout.NE.0 .AND. nout.NE.6 )
     $      OPEN( nout, file = summry, status = 'UNKNOWN' )
*
*        Read and check the parameter values for the tests.
*
*        Get matrix dimensions
*
         READ( nin, fmt = * ) n
         READ( nin, fmt = * ) nrhs
*
*        Get value of NB
*
         READ( nin, fmt = * ) nb
*
*        Get grid shape
*
         READ( nin, fmt = * ) nprow
         READ( nin, fmt = * ) npcol
*
*        Close input file
*
         CLOSE( nin )
*
*        If underlying system needs additional set up, do it now
*
         IF( nprocs.LT.1 ) THEN
            nprocs = nprow * npcol
            CALL blacs_setup( iam, nprocs )
         END IF
*
*        Temporarily define blacs grid to include all processes so
*        information can be broadcast to all processes
*
         CALL blacs_get( -1, 0, ictxt )
         CALL blacs_gridinit( ictxt, 'Row-major', 1, nprocs )
*
*        Pack information arrays and broadcast
*
         work( 1 ) = n
         work( 2 ) = nrhs
         work( 3 ) = nb
         work( 4 ) = nprow
         work( 5 ) = npcol
         CALL igebs2d( ictxt, 'All', ' ', 5, 1, work, 5 )
*
*        regurgitate input
*
         WRITE( nout, fmt = 9999 )
     $               'SCALAPACK example driver.'
         WRITE( nout, fmt = 9999 ) usrinfo
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9999 )
     $               'The matrices A and B are read from '//
     $               'a file.'
         WRITE( nout, fmt = * )
         WRITE( nout, fmt = 9999 )
     $               'An explanation of the input/output '//
     $               'parameters follows:'
*
         WRITE( nout, fmt = 9999 )
     $               'N       : The order of the matrix A.'
         WRITE( nout, fmt = 9999 )
     $               'NRHS    : The number of right and sides.'
         WRITE( nout, fmt = 9999 )
     $               'NB      : The size of the square blocks the'//
     $               ' matrices A and B are split into.'
         WRITE( nout, fmt = 9999 )
     $               'P       : The number of process rows.'
         WRITE( nout, fmt = 9999 )
     $               'q       : the number of process columns.'
         WRITE( NOUT, FMT = * )
         WRITE( NOUT, FMT = 9999 )
     $               'the following parameter values will be used:'
         WRITE( NOUT, FMT = 9998 ) 'n    ', N
         WRITE( NOUT, FMT = 9998 ) 'nrhs ', NRHS
         WRITE( NOUT, FMT = 9998 ) 'nb   ', NB
         WRITE( NOUT, FMT = 9998 ) 'p    ', NPROW
         WRITE( NOUT, FMT = 9998 ) 'q    ', NPCOL
         WRITE( NOUT, FMT = * )
*
      ELSE
*
*        If underlying system needs additional set up, do it now
*
.LT.         IF( NPROCS1 )
     $      CALL BLACS_SETUP( IAM, NPROCS )
*
*        Temporarily define blacs grid to include all processes so
*        information can be broadcast to all processes
*
         CALL BLACS_GET( -1, 0, ICTXT )
         CALL BLACS_GRIDINIT( ICTXT, 'row-major', 1, NPROCS )
*
         CALL IGEBR2D( ICTXT, 'all', ' ', 5, 1, WORK, 5, 0, 0 )
         N     = WORK( 1 )
         NRHS  = WORK( 2 )
         NB    = WORK( 3 )
         NPROW = WORK( 4 )
         NPCOL = WORK( 5 )
*
      END IF
*
      CALL BLACS_GRIDEXIT( ICTXT )
*
      RETURN
*
   20 WRITE( NOUT, FMT = 9997 )
      CLOSE( NIN )
.NE..AND..NE.      IF( NOUT6  NOUT0 )
     $   CLOSE( NOUT )
      CALL BLACS_ABORT( ICTXT, 1 )
*
      STOP
*
 9999 FORMAT( A )
 9998 FORMAT( 2X, A5, '   :        ', I6 )
 9997 FORMAT( ' illegal input in file ',40A,'.  aborting run.' )
*
*     End of PDSCAEXINFO
*
      END