2
3
4
5
6
7
8
9 INTEGER IA, JA, N
10
11
12 INTEGER DESCA( * )
13 COMPLEX A( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
104 $ LLD_, MB_, M_, NB_, N_, RSRC_
105 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
106 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
107 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
108 COMPLEX ZERO
109 parameter( zero = 0.0e+0 )
110
111
112 INTEGER ICURCOL, ICURROW, II, IOFFA, J, JB, JJ, JN,
113 $ LDA, LL, MYCOL, MYROW, NPCOL, NPROW
114 COMPLEX TRACE
115
116
117 EXTERNAL blacs_gridinfo, cgsum2d,
infog2l
118
119
120 INTEGER ICEIL
122
123
125
126
127
128
129
130 CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
131
132 trace = zero
133 IF( n.EQ.0 ) THEN
135 RETURN
136 END IF
137
138 CALL infog2l( ia, ja, desca, nprow, npcol, myrow, mycol, ii, jj,
139 $ icurrow, icurcol )
140
141 jn =
min(
iceil( ja, desca( nb_ ) ) * desca( nb_ ), ja+n-1 )
142 jb = jn-ja+1
143 lda = desca( lld_ )
144 ioffa = ii + ( jj - 1 ) * lda
145
146
147
148 IF( myrow.EQ.icurrow .AND. mycol.EQ.icurcol ) THEN
149 DO 10 ll = ioffa, ioffa + (jb-1)*(lda+1), lda+1
150 trace = trace + a( ll )
151 10 CONTINUE
152 END IF
153 IF( myrow.EQ.icurrow )
154 $ ioffa = ioffa + jb
155 IF( mycol.EQ.icurcol )
156 $ ioffa = ioffa + jb*lda
157 icurrow = mod( icurrow+1, nprow )
158 icurcol = mod( icurcol+1, npcol )
159
160
161
162 DO 30 j = jn+1, ja+n-1, desca( nb_ )
163 jb =
min( ja+n-j, desca( nb_ ) )
164
165 IF( myrow.EQ.icurrow .AND. mycol.EQ.icurcol ) THEN
166 DO 20 ll = ioffa, ioffa + (jb-1)*(lda+1), lda+1
167 trace = trace + a( ll )
168 20 CONTINUE
169 END IF
170 IF( myrow.EQ.icurrow )
171 $ ioffa = ioffa + jb
172 IF( mycol.EQ.icurcol )
173 $ ioffa = ioffa + jb*lda
174 icurrow = mod( icurrow+1, nprow )
175 icurcol = mod( icurcol+1, npcol )
176 30 CONTINUE
177
178 CALL cgsum2d( desca( ctxt_ ), 'All', ' ', 1, 1, trace, 1, -1,
179 $ mycol )
180
182
183 RETURN
184
185
186
integer function iceil(inum, idenom)
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)
complex function pclatra(n, a, ia, ja, desca)