2
3
4
5
6
7
8
9 INTEGER IA, JA, LWORK, N
10
11
12 INTEGER ( * )
13 REAL BYALL( * ), BYROW( * ), ( LWORK )
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 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
119 $ MB_, NB_, RSRC_, CSRC_, LLD_
120 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
121 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
122 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
123
124
125 INTEGER ALLI, BUFLEN, I, II, MB, MYCOL, MYROW, NPCOL,
126 $ NPROW, PROW
127
128
129 INTEGER NUMROC
131
132
134
135
137
138
139
140 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
141 $ rsrc_.LT.0 )RETURN
142
144 mb = desc( mb_ )
145
146 DO 30 prow = 0, nprow - 1
147 buflen =
numroc( n, mb, prow, 0, nprow )
148 IF( myrow.EQ.prow ) THEN
149 CALL scopy( buflen, byrow, 1, work, 1 )
150 CALL sgebs2d( desc( ctxt_ ),
'C',
' ', buflen, 1, work,
151 $ buflen )
152 ELSE
153 CALL sgebr2d( desc( ctxt_ ),
'C',
' ', buflen, 1, work,
154 $ buflen, prow, mycol )
155 END IF
156
157 alli = prow*mb
158 DO 20 ii = 1, buflen, mb
159 DO 10 i = 1,
min( mb, buflen-ii+1 )
160 byall( alli+i ) = work( ii-1+i )
161 10 CONTINUE
162 alli = alli + mb*nprow
163 20 CONTINUE
164 30 CONTINUE
165
166 RETURN
167
168
169
subroutine scopy(n, sx, incx, sy, incy)
SCOPY
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
subroutine sgebr2d(contxt, scope, top, m, n, a, lda)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
integer function numroc(n, nb, iproc, isrcproc, nprocs)