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
123 EXTERNAL blacs_gridinfo,
infog2l
124
125
126 INTEGER NUMROC
128
129
130 INTRINSIC dconjg, mod
131
132
133
134
135
136 ictxt = descx( ctxt_ )
137 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
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)
integer function numroc(n, nb, iproc, isrcproc, nprocs)