2
3
4
5
6
7
8
9 INTEGER IX, INCX, JX, N
10 DOUBLE PRECISION SA
11
12
13 INTEGER DESCX( * )
14 COMPLEX*16 SX( * )
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
114
115
116
117
118
119
120
121
122 INTEGER , CSRC_, CTXT_, DLEN_, DTYPE_,
123 $ LLD_, MB_, M_, NB_, N_, RSRC_
124 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
125 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
126 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
127 DOUBLE PRECISION ONE, ZERO
128 parameter( one = 1.0d+0, zero = 0.0d+0 )
129
130
131 LOGICAL DONE
132 INTEGER ICTXT, MYCOL, MYROW, NPCOL, NPROW
133 DOUBLE PRECISION BIGNUM, CDEN, CDEN1, CNUM, CNUM1, MUL, SMLNUM
134
135
137
138
139 DOUBLE PRECISION PDLAMCH
141
142
143 INTRINSIC abs
144
145
146
147
148
149 ictxt = descx( ctxt_ )
151
152
153
154 IF( n.LE.0 )
155 $ RETURN
156
157
158
160 bignum = one / smlnum
161 CALL pdlabad( ictxt, smlnum, bignum )
162
163
164
165 cden = sa
166 cnum = one
167
168 10 CONTINUE
169 cden1 = cden*smlnum
170 cnum1 = cnum / bignum
171 IF( abs( cden1 ).GT.abs( cnum ) .AND. cnum.NE.zero ) THEN
172
173
174
175
176 mul = smlnum
177 done = .false.
178 cden = cden1
179 ELSE IF( abs( cnum1 ).GT.abs( cden ) ) THEN
180
181
182
183
184 mul = bignum
185 done = .false.
186 cnum = cnum1
187 ELSE
188
189
190
191 mul = cnum / cden
192 done = .true.
193 END IF
194
195
196
197 CALL pzdscal( n, mul, sx, ix, jx, descx, incx )
198
199 IF( .NOT.done )
200 $ GO TO 10
201
202 RETURN
203
204
205
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
double precision function pdlamch(ictxt, cmach)
subroutine pdlabad(ictxt, small, large)