2
3
4
5
6
7
8
9 INTEGER ALPHA, BETA, IA, JA
10
11
12 INTEGER A( * ), DESCA( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
103 $ LLD_, MB_, M_, NB_, N_, RSRC_
104 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
105 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
106 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
107 INTEGER ZERO
108 parameter( zero = 0 )
109
110
111 INTEGER IACOL, IAROW, IIA, IOFFA, JJA, MYCOL, MYROW,
112 $ NPCOL, NPROW
113
114
115 EXTERNAL blacs_gridinfo,
infog2l
116
117
118
119
120
121 CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
122
123 CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, iia, jja,
124 $ iarow, iacol )
125
126 IF( myrow.EQ.iarow .AND. mycol.EQ.iacol ) THEN
127 ioffa = iia+(jja-1)*desca( lld_ )
128 alpha = a( ioffa )
129 a( ioffa ) = beta
130 ELSE
131 alpha = zero
132 END IF
133
134 RETURN
135
136
137
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)