1      SUBROUTINE PDSCAEXINFO( SUMMRY, NOUT, N, NRHS, NB, NPROW, NPCOL,
2     $                        WORK, IAM, NPROCS )
3*
4*  -- ScaLAPACK example code --
5*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6*     and University of California, Berkeley.
7*
8*     Written by Antoine Petitet, August 1995  (petitet@cs.utk.edu)
9*
10*     This program solves a linear system by calling the ScaLAPACK
11*     routine PDGESV. The input matrix and right-and-sides are
12*     read from a file. The solution is written to a file.
13*
14*     .. Scalar Arguments ..
15      CHARACTER*( * )    SUMMRY
16      INTEGER            IAM, N, NRHS, NB, NOUT, NPCOL, NPROCS, NPROW
17*     ..
18*     .. Array Arguments ..
19      INTEGER            WORK( * )
20*     ..
21*
22* ======================================================================
23*
24*     .. Parameters ..
25      INTEGER            NIN
26      PARAMETER          ( NIN = 11 )
27*     ..
28*     .. Local Scalars ..
29      CHARACTER*79       USRINFO
30      INTEGER            ICTXT
31*     ..
32*     .. External Subroutines ..
33      EXTERNAL           BLACS_ABORT, BLACS_GET, BLACS_GRIDEXIT,
34     $                   BLACS_GRIDINIT, BLACS_SETUP, IGEBR2D, IGEBS2D
35*     ..
36*     .. Executable Statements ..
37*
38*     Process 0 reads the input data, broadcasts to other processes and
39*     writes needed information to NOUT
40*
41      IF( IAM.EQ.0 ) THEN
42*
43*        Open file and skip data file header
44*
45         OPEN( NIN, FILE='SCAEX.dat', STATUS='OLD' )
46         READ( NIN, FMT = * ) SUMMRY
47         SUMMRY = ' '
48*
49*        Read in user-supplied info about machine type, compiler, etc.
50*
51         READ( NIN, FMT = 9999 ) USRINFO
52*
53*        Read name and unit number for summary output file
54*
55         READ( NIN, FMT = * ) SUMMRY
56         READ( NIN, FMT = * ) NOUT
57         IF( NOUT.NE.0 .AND. NOUT.NE.6 )
58     $      OPEN( NOUT, FILE = SUMMRY, STATUS = 'UNKNOWN' )
59*
60*        Read and check the parameter values for the tests.
61*
62*        Get matrix dimensions
63*
64         READ( NIN, FMT = * ) N
65         READ( NIN, FMT = * ) NRHS
66*
67*        Get value of NB
68*
69         READ( NIN, FMT = * ) NB
70*
71*        Get grid shape
72*
73         READ( NIN, FMT = * ) NPROW
74         READ( NIN, FMT = * ) NPCOL
75*
76*        Close input file
77*
78         CLOSE( NIN )
79*
80*        If underlying system needs additional set up, do it now
81*
82         IF( NPROCS.LT.1 ) THEN
83            NPROCS = NPROW * NPCOL
84            CALL BLACS_SETUP( IAM, NPROCS )
85         END IF
86*
87*        Temporarily define blacs grid to include all processes so
88*        information can be broadcast to all processes
89*
90         CALL BLACS_GET( -1, 0, ICTXT )
91         CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
92*
93*        Pack information arrays and broadcast
94*
95         WORK( 1 ) = N
96         WORK( 2 ) = NRHS
97         WORK( 3 ) = NB
98         WORK( 4 ) = NPROW
99         WORK( 5 ) = NPCOL
100         CALL IGEBS2D( ICTXT, 'All', ' ', 5, 1, WORK, 5 )
101*
102*        regurgitate input
103*
104         WRITE( NOUT, FMT = 9999 )
105     $               'SCALAPACK example driver.'
106         WRITE( NOUT, FMT = 9999 ) USRINFO
107         WRITE( NOUT, FMT = * )
108         WRITE( NOUT, FMT = 9999 )
109     $               'The matrices A and B are read from '//
110     $               'a file.'
111         WRITE( NOUT, FMT = * )
112         WRITE( NOUT, FMT = 9999 )
113     $               'An explanation of the input/output '//
114     $               'parameters follows:'
115*
116         WRITE( NOUT, FMT = 9999 )
117     $               'N       : The order of the matrix A.'
118         WRITE( NOUT, FMT = 9999 )
119     $               'NRHS    : The number of right and sides.'
120         WRITE( NOUT, FMT = 9999 )
121     $               'NB      : The size of the square blocks the'//
122     $               ' matrices A and B are split into.'
123         WRITE( NOUT, FMT = 9999 )
124     $               'P       : The number of process rows.'
125         WRITE( NOUT, FMT = 9999 )
126     $               'Q       : The number of process columns.'
127         WRITE( NOUT, FMT = * )
128         WRITE( NOUT, FMT = 9999 )
129     $               'The following parameter values will be used:'
130         WRITE( NOUT, FMT = 9998 ) 'N    ', N
131         WRITE( NOUT, FMT = 9998 ) 'NRHS ', NRHS
132         WRITE( NOUT, FMT = 9998 ) 'NB   ', NB
133         WRITE( NOUT, FMT = 9998 ) 'P    ', NPROW
134         WRITE( NOUT, FMT = 9998 ) 'Q    ', NPCOL
135         WRITE( NOUT, FMT = * )
136*
137      ELSE
138*
139*        If underlying system needs additional set up, do it now
140*
141         IF( NPROCS.LT.1 )
142     $      CALL BLACS_SETUP( IAM, NPROCS )
143*
144*        Temporarily define blacs grid to include all processes so
145*        information can be broadcast to all processes
146*
147         CALL BLACS_GET( -1, 0, ICTXT )
148         CALL BLACS_GRIDINIT( ICTXT, 'Row-major', 1, NPROCS )
149*
150         CALL IGEBR2D( ICTXT, 'All', ' ', 5, 1, WORK, 5, 0, 0 )
151         N     = WORK( 1 )
152         NRHS  = WORK( 2 )
153         NB    = WORK( 3 )
154         NPROW = WORK( 4 )
155         NPCOL = WORK( 5 )
156*
157      END IF
158*
159      CALL BLACS_GRIDEXIT( ICTXT )
160*
161      RETURN
162*
163   20 WRITE( NOUT, FMT = 9997 )
164      CLOSE( NIN )
165      IF( NOUT.NE.6 .AND. NOUT.NE.0 )
166     $   CLOSE( NOUT )
167      CALL BLACS_ABORT( ICTXT, 1 )
168*
169      STOP
170*
171 9999 FORMAT( A )
172 9998 FORMAT( 2X, A5, '   :        ', I6 )
173 9997 FORMAT( ' Illegal input in file ',40A,'.  Aborting run.' )
174*
175*     End of PDSCAEXINFO
176*
177      END
178