ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pclaread.f
Go to the documentation of this file.
1  SUBROUTINE pclaread( FILNAM, A, DESCA, IRREAD, ICREAD, WORK )
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 ..
11  INTEGER ICREAD, IRREAD
12 * ..
13 * .. Array Arguments ..
14  CHARACTER*(*) FILNAM
15  INTEGER DESCA( * )
16  COMPLEX A( * ), WORK( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * PCLAREAD reads from a file named FILNAM a matrix and distribute
23 * it to the process grid.
24 *
25 * Only the process of coordinates {IRREAD, ICREAD} read the file.
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  REAL REAL_PART, IMAG_PART
44 * ..
45 * .. Local Arrays ..
46  INTEGER IWORK( 2 )
47 * ..
48 * .. External Subroutines ..
49  EXTERNAL blacs_gridinfo, infog2l, cgerv2d, cgesd2d,
50  $ igebs2d, igebr2d
51 * ..
52 * .. External Functions ..
53  INTEGER ICEIL
54  EXTERNAL iceil
55 * ..
56 * .. Intrinsic Functions ..
57  INTRINSIC cmplx, 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 *
66  IF( myrow.EQ.irread .AND. mycol.EQ.icread ) THEN
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,
72  $ icread )
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 = * ) 'PCLAREAD: 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 )
104  IF( icurrow.EQ.irread .AND. icurcol.EQ.icread ) THEN
105  IF( myrow.EQ.irread .AND. mycol.EQ.icread ) THEN
106  DO 10 k = 0, ib-1
107  READ( nin , fmt = *) real_part, imag_part
108  a( ii+k+(jj+h-1)*lda ) = cmplx(real_part, imag_part)
109  10 CONTINUE
110  END IF
111  ELSE
112  IF( myrow.EQ.icurrow .AND. mycol.EQ.icurcol ) THEN
113  CALL cgerv2d( ictxt, ib, 1, a( ii+(jj+h-1)*lda ),
114  $ lda, irread, icread )
115  ELSE IF( myrow.EQ.irread .AND. mycol.EQ.icread ) THEN
116  DO 20 k = 1, ib
117  READ( nin, fmt = * ) real_part, imag_part
118  work(k)=cmplx(real_part,imag_part)
119  20 CONTINUE
120  CALL cgesd2d( 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 *
139  IF( myrow.EQ.irread .AND. mycol.EQ.icread ) THEN
140  CLOSE( nin )
141  END IF
142 *
143  RETURN
144 *
145 * End of PCLAREAD
146 *
147  END
cmplx
float cmplx[2]
Definition: pblas.h:132
infog2l
subroutine infog2l(GRINDX, GCINDX, DESC, NPROW, NPCOL, MYROW, MYCOL, LRINDX, LCINDX, RSRC, CSRC)
Definition: infog2l.f:3
pclaread
subroutine pclaread(FILNAM, A, DESCA, IRREAD, ICREAD, WORK)
Definition: pclaread.f:2
min
#define min(A, B)
Definition: pcgemr.c:181