2
3
4
5
6
7
8
9 INTEGER INCX, IX, JX, N
10
11
12 INTEGER DESCX( * )
13 COMPLEX*16 X( * )
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 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
112 $ LLD_, MB_, M_, NB_, N_, RSRC_
113 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
114 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
115 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
116
117
118 INTEGER I, ICOFFX, ICTXT, IIX, IOFFX, IROFFX, IXCOL,
119 $ IXROW, JJX, LDX, MYCOL, MYROW, NP, NPCOL,
120 $ NPROW, NQ
121
122
124
125
126 INTEGER NUMROC
128
129
130 INTRINSIC dconjg, mod
131
132
133
134
135
136 ictxt = descx( ctxt_ )
138
139
140
141 CALL infog2l( ix, jx, descx, nprow, npcol, myrow, mycol,
142 $ iix, jjx, ixrow, ixcol )
143
144 ldx = descx( lld_ )
145 IF( incx.EQ.descx( m_ ) ) THEN
146
147
148
149 IF( myrow.NE.ixrow )
150 $ RETURN
151 icoffx = mod( jx-1, descx( nb_ ) )
152 nq =
numroc( n+icoffx, descx( nb_ ), mycol, ixcol, npcol )
153 IF( mycol.EQ.ixcol )
154 $ nq = nq - icoffx
155
156 IF( nq.GT.0 ) THEN
157 ioffx = iix+(jjx-1)*ldx
158 DO 10 i = 1, nq
159 x( ioffx ) = dconjg( x( ioffx ) )
160 ioffx = ioffx + ldx
161 10 CONTINUE
162 END IF
163
164 ELSE IF( incx.EQ.1 ) THEN
165
166
167
168 IF( mycol.NE.ixcol )
169 $ RETURN
170 iroffx = mod( ix-1, descx( mb_ ) )
171 np =
numroc( n+iroffx, descx( mb_ ), myrow, ixrow, nprow )
172 IF( myrow.EQ.ixrow )
173 $ np = np - iroffx
174
175 IF( np.GT.0 ) THEN
176 ioffx = iix+(jjx-1)*ldx
177 DO 20 i = ioffx, ioffx+np-1
178 x( i ) = dconjg( x( i ) )
179 20 CONTINUE
180 END IF
181
182 END IF
183
184 RETURN
185
186
187
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
integer function numroc(n, nb, iproc, isrcproc, nprocs)