ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
Go to the documentation of this file.
2 *
3 * -- ScaLAPACK tools routine (version 1.8) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 *
7 * written by Antoine Petitet, August 1995 (petitet@cs.utk.edu)
8 * adapted by Julie Langou, April 2007 (julie@cs.utk.edu)
9 *
10 * .. Scalar Arguments ..
12 * ..
13 * .. Array Arguments ..
14  CHARACTER*(*) FILNAM
15  INTEGER DESCA( * )
16  COMPLEX*16 A( * ), WORK( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * PZLAREAD reads from a file named FILNAM a matrix and distribute
23 * it to the process grid.
24 *
26 *
27 * WORK must be of size >= MB_ = DESCA( MB_ ).
28 *
29 * =====================================================================
30 *
31 * .. Parameters ..
32  INTEGER NIN
33  parameter( nin = 11 )
34  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
35  \$ LLD_, MB_, M_, NB_, N_, RSRC_
36  parameter( block_cyclic_2d = 1, dlen_ = 9, dt_ = 1,
37  \$ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
38  \$ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
39 * ..
40 * .. Local Scalars ..
41  INTEGER H, I, IB, ICTXT, ICURCOL, ICURROW, II, J, JB,
42  \$ JJ, K, LDA, M, MYCOL, MYROW, N, NPCOL, NPROW
43  DOUBLE PRECISION REAL_PART, IMAG_PART
44 * ..
45 * .. Local Arrays ..
46  INTEGER IWORK( 2 )
47 * ..
48 * .. External Subroutines ..
49  EXTERNAL blacs_gridinfo, infog2l, zgerv2d, zgesd2d,
50  \$ igebs2d, igebr2d
51 * ..
52 * .. External Functions ..
53  INTEGER ICEIL
54  EXTERNAL iceil
55 * ..
56 * .. Intrinsic Functions ..
57  INTRINSIC dcmplx, min, mod
58 * ..
59 * .. Executable Statements ..
60 *
61 * Get grid parameters
62 *
63  ictxt = desca( ctxt_ )
64  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
65 *
67  OPEN( nin, file=filnam, status='OLD' )
68  READ( nin, fmt = * ) ( iwork( i ), i = 1, 2 )
69  CALL igebs2d( ictxt, 'All', ' ', 2, 1, iwork, 2 )
70  ELSE
71  CALL igebr2d( ictxt, 'All', ' ', 2, 1, iwork, 2, irread,
73  END IF
74  m = iwork( 1 )
75  n = iwork( 2 )
76 *
77  IF( m.LE.0 .OR. n.LE.0 )
78  \$ RETURN
79 *
80  IF( m.GT.desca( m_ ).OR. n.GT.desca( n_ ) ) THEN
81  IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
82  WRITE( *, fmt = * ) 'PZLAREAD: Matrix too big to fit in'
83  WRITE( *, fmt = * ) 'Abort ...'
84  END IF
85  CALL blacs_abort( ictxt, 0 )
86  END IF
87 *
88  ii = 1
89  jj = 1
90  icurrow = desca( rsrc_ )
91  icurcol = desca( csrc_ )
92  lda = desca( lld_ )
93 *
94 * Loop over column blocks
95 *
96  DO 50 j = 1, n, desca( nb_ )
97  jb = min( desca( nb_ ), n-j+1 )
98  DO 40 h = 0, jb-1
99 *
100 * Loop over block of rows
101 *
102  DO 30 i = 1, m, desca( mb_ )
103  ib = min( desca( mb_ ), m-i+1 )
106  DO 10 k = 0, ib-1
107  READ( nin , fmt = *) real_part, imag_part
108  a( ii+k+(jj+h-1)*lda ) = dcmplx(real_part, imag_part)
109  10 CONTINUE
110  END IF
111  ELSE
112  IF( myrow.EQ.icurrow .AND. mycol.EQ.icurcol ) THEN
113  CALL zgerv2d( ictxt, ib, 1, a( ii+(jj+h-1)*lda ),
116  DO 20 k = 1, ib
117  READ( nin, fmt = * ) real_part, imag_part
118  work(k)=dcmplx(real_part,imag_part)
119  20 CONTINUE
120  CALL zgesd2d( ictxt, ib, 1, work, desca( mb_ ),
121  \$ icurrow, icurcol )
122  END IF
123  END IF
124  IF( myrow.EQ.icurrow )
125  \$ ii = ii + ib
126  icurrow = mod( icurrow+1, nprow )
127  30 CONTINUE
128 *
129  ii = 1
130  icurrow = desca( rsrc_ )
131  40 CONTINUE
132 *
133  IF( mycol.EQ.icurcol )
134  \$ jj = jj + jb
135  icurcol = mod( icurcol+1, npcol )
136 *
137  50 CONTINUE
138 *
140  CLOSE( nin )
141  END IF
142 *
143  RETURN
144 *