2
3
4
5
6
7
8
9 CHARACTER*1 SCOPE, TOP
10 INTEGER IA, JA
11 REAL ALPHA
12
13
14 INTEGER DESCA( * )
15 REAL A( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
116 $ LLD_, MB_, M_, NB_, N_, RSRC_
117 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
118 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
119 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
120 REAL ZERO
121 parameter( zero = 0.0e+0 )
122
123
124 INTEGER IACOL, IAROW, ICTXT, IIA, IOFFA, JJA, MYCOL,
125 $ MYROW, NPCOL, NPROW
126
127
128 EXTERNAL blacs_gridinfo,
infog2l, sgebr2d, sgebs2d
129
130
131 LOGICAL LSAME
133
134
135
136
137
138 ictxt = desca( ctxt_ )
139 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
140
141 CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
142 $ iarow, iacol )
143
144 alpha = zero
145
146 IF(
lsame( scope,
'R' ) )
THEN
147 IF( myrow.EQ.iarow ) THEN
148 IF( mycol.EQ.iacol ) THEN
149 ioffa = iia+(jja-1)*desca( lld_ )
150 CALL sgebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
151 alpha = a( ioffa )
152 ELSE
153 CALL sgebr2d( ictxt, scope, top, 1, 1, alpha, 1,
154 $ iarow, iacol )
155 END IF
156 END IF
157 ELSE IF(
lsame( scope,
'C' ) )
THEN
158 IF( mycol.EQ.iacol ) THEN
159 IF( myrow.EQ.iarow ) THEN
160 ioffa = iia+(jja-1)*desca( lld_ )
161 CALL sgebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
162 alpha = a( ioffa )
163 ELSE
164 CALL sgebr2d( ictxt, scope, top, 1, 1, alpha, 1,
165 $ iarow, iacol )
166 END IF
167 END IF
168 ELSE IF(
lsame( scope,
'A' ) )
THEN
169 IF( ( myrow.EQ.iarow ).AND.( mycol.EQ.iacol ) ) THEN
170 ioffa = iia+(jja-1)*desca( lld_ )
171 CALL sgebs2d( ictxt, scope, top, 1, 1, a( ioffa ), 1 )
172 alpha = a( ioffa )
173 ELSE
174 CALL sgebr2d( ictxt, scope, top, 1, 1, alpha, 1,
175 $ iarow, iacol )
176 END IF
177 ELSE
178 IF( myrow.EQ.iarow .AND. mycol.EQ.iacol )
179 $ alpha = a( iia+(jja-1)*desca( lld_ ) )
180 END IF
181
182 RETURN
183
184
185
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)