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