1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
SUBROUTINE PSLAREAD( FILNAM, A, DESCA, IRREAD, ICREAD, WORK )
*
* -- ScaLAPACK tools routine (version 1.8) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
*
* written by Antoine Petitet, August 1995 (petitet@cs.utk.edu)
* adapted by Julie Langou, April 2007 (julie@cs.utk.edu)
*
* .. Scalar Arguments ..
INTEGER ICREAD, IRREAD
* ..
* .. Array Arguments ..
CHARACTER*(*) FILNAM
INTEGER DESCA( * )
REAL A( * ), WORK( * )
* ..
*
* Purpose
* =======
*
* PSLAREAD reads from a file named FILNAM a matrix and distribute
* it to the process grid.
*
* Only the process of coordinates {IRREAD, ICREAD} read the file.
*
* WORK must be of size >= MB_ = DESCA( MB_ ).
*
* =====================================================================
*
* .. Parameters ..
INTEGER NIN
PARAMETER ( NIN = 11 )
INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DT_,
$ LLD_, MB_, M_, NB_, N_, RSRC_
PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DT_ = 1,
$ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
$ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
* ..
* .. Local Scalars ..
INTEGER H, I, IB, ICTXT, ICURCOL, ICURROW, II, J, JB,
$ JJ, K, LDA, M, MYCOL, MYROW, N, NPCOL, NPROW
* ..
* .. Local Arrays ..
INTEGER IWORK( 2 )
* ..
* .. External Subroutines ..
EXTERNAL BLACS_GRIDINFO, INFOG2L, SGERV2D, SGESD2D,
$ IGEBS2D, IGEBR2D
* ..
* .. External Functions ..
INTEGER ICEIL
EXTERNAL ICEIL
* ..
* .. Intrinsic Functions ..
INTRINSIC MIN, MOD
* ..
* .. Executable Statements ..
*
* Get grid parameters
*
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
IF( MYROW.EQ.IRREAD .AND. MYCOL.EQ.ICREAD ) THEN
OPEN( NIN, FILE=FILNAM, STATUS='OLD' )
READ( NIN, FMT = * ) ( IWORK( I ), I = 1, 2 )
CALL IGEBS2D( ICTXT, 'All', ' ', 2, 1, IWORK, 2 )
ELSE
CALL IGEBR2D( ICTXT, 'All', ' ', 2, 1, IWORK, 2, IRREAD,
$ ICREAD )
END IF
M = IWORK( 1 )
N = IWORK( 2 )
*
IF( M.LE.0 .OR. N.LE.0 )
$ RETURN
*
IF( M.GT.DESCA( M_ ).OR. N.GT.DESCA( N_ ) ) THEN
IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
WRITE( *, FMT = * ) 'PSLAREAD: Matrix too big to fit in'
WRITE( *, FMT = * ) 'Abort ...'
END IF
CALL BLACS_ABORT( ICTXT, 0 )
END IF
*
II = 1
JJ = 1
ICURROW = DESCA( RSRC_ )
ICURCOL = DESCA( CSRC_ )
LDA = DESCA( LLD_ )
*
* Loop over column blocks
*
DO 50 J = 1, N, DESCA( NB_ )
JB = MIN( DESCA( NB_ ), N-J+1 )
DO 40 H = 0, JB-1
*
* Loop over block of rows
*
DO 30 I = 1, M, DESCA( MB_ )
IB = MIN( DESCA( MB_ ), M-I+1 )
IF( ICURROW.EQ.IRREAD .AND. ICURCOL.EQ.ICREAD ) THEN
IF( MYROW.EQ.IRREAD .AND. MYCOL.EQ.ICREAD ) THEN
DO 10 K = 0, IB-1
READ( NIN, FMT = * ) A( II+K+(JJ+H-1)*LDA )
10 CONTINUE
END IF
ELSE
IF( MYROW.EQ.ICURROW .AND. MYCOL.EQ.ICURCOL ) THEN
CALL SGERV2D( ICTXT, IB, 1, A( II+(JJ+H-1)*LDA ),
$ LDA, IRREAD, ICREAD )
ELSE IF( MYROW.EQ.IRREAD .AND. MYCOL.EQ.ICREAD ) THEN
DO 20 K = 1, IB
READ( NIN, FMT = * ) WORK( K )
20 CONTINUE
CALL SGESD2D( ICTXT, IB, 1, WORK, DESCA( MB_ ),
$ ICURROW, ICURCOL )
END IF
END IF
IF( MYROW.EQ.ICURROW )
$ II = II + IB
ICURROW = MOD( ICURROW+1, NPROW )
30 CONTINUE
*
II = 1
ICURROW = DESCA( RSRC_ )
40 CONTINUE
*
IF( MYCOL.EQ.ICURCOL )
$ JJ = JJ + JB
ICURCOL = MOD( ICURCOL+1, NPCOL )
*
50 CONTINUE
*
IF( MYROW.EQ.IRREAD .AND. MYCOL.EQ.ICREAD ) THEN
CLOSE( NIN )
END IF
*
RETURN
*
* End of PSLAREAD
*
END
|
