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