2 c This demonstrates a problem with g77 and pic on x86 where
3 c egcs 1.0.1 and earlier will generate bogus assembler output.
4 c unfortunately, gas accepts the bogus acssembler output and
5 c generates code that almost works.
9 C Date: Wed, 17 Dec 1997 23:20:29 +0000
10 C From: Joao Cardoso <jcardoso@inescn.pt>
11 C To: egcs-bugs@cygnus.com
12 C Subject: egcs-1.0 f77 bug on OSR5
13 C When trying to compile the Fortran file that I enclose bellow,
14 C I got an assembler error:
16 C ./g77 -B./ -fpic -O -c scaleg.f
17 C /usr/tmp/cca002D8.s:123:syntax error at (
19 C ./g77 -B./ -fpic -O0 -c scaleg.f
20 C /usr/tmp/cca002EW.s:246:invalid operand combination: leal
22 C Compiling without the -fpic flag runs OK.
24 subroutine scaleg
(n
,ma
,a
,mb
,b
,low
,igh
,cscale
,cperm
,wk
)
27 integer igh
,low
,ma
,mb
,n
28 double precision a
(ma
,n
),b
(mb
,n
),cperm
(n
),cscale
(n
),wk
(n
,6)
30 c *****local variables:
31 integer i
,ir
,it
,j
,jc
,kount
,nr
,nrp2
32 double precision alpha
,basl
,beta
,cmax
,coef
,coef2
,coef5
,cor
,
33 * ew
,ewc
,fi
,fj
,gamma
,pgamma
,sum
,t
,ta
,tb
,tc
35 c *****fortran functions:
36 double precision dabs
, dlog10
, dsign
39 c *****subroutines called:
42 c ---------------------------------------------------------------
45 c scales the matrices a and b in the generalized eigenvalue
46 c problem a*x = (lambda)*b*x such that the magnitudes of the
47 c elements of the submatrices of a and b (as specified by low
48 c and igh) are close to unity in the least squares sense.
49 c ref.: ward, r. c., balancing the generalized eigenvalue
50 c problem, siam j. sci. stat. comput., vol. 2, no. 2, june 1981,
53 c *****parameter description:
58 c row dimensions of the arrays containing matrices
59 c a and b respectively, as declared in the main calling
60 c program dimension statement;
63 c order of the matrices a and b;
66 c contains the a matrix of the generalized eigenproblem
70 c contains the b matrix of the generalized eigenproblem
74 c specifies the beginning -1 for the rows and
75 c columns of a and b to be scaled;
78 c specifies the ending -1 for the rows and columns
79 c of a and b to be scaled;
82 c work array. only locations low through igh are
83 c referenced and altered by this subroutine;
86 c work array that must contain at least 6*n locations.
87 c only locations low through igh, n+low through n+igh,
88 c ..., 5*n+low through 5*n+igh are referenced and
89 c altered by this subroutine.
93 c a,b contain the scaled a and b matrices;
96 c contains in its low through igh locations the integer
97 c exponents of 2 used for the column scaling factors.
98 c the other locations are not referenced;
100 c wk contains in its low through igh locations the integer
101 c exponents of 2 used for the row scaling factors.
103 c *****algorithm notes:
107 c written by r. c. ward.......
108 c modified 8/86 by bobby bodenheimer so that if
109 c sum = 0 (corresponding to the case where the matrix
110 c doesn't need to be scaled) the routine returns.
112 c ---------------------------------------------------------------
114 if (low
.eq
. igh
) go to 410
126 c compute right side vector in resulting linear equations
133 if (ta
.eq
. 0.0d0
) go to 220
134 ta
= dlog10
(dabs
(ta
)) / basl
136 if (tb
.eq
. 0.0d0
) go to 230
137 tb
= dlog10
(dabs
(tb
)) / basl
139 wk
(i
,5) = wk
(i
,5) - ta
- tb
140 wk
(j
,6) = wk
(j
,6) - ta
- tb
143 coef
= 1.0d0
/float
(2*nr
)
150 c start generalized conjugate gradient iteration
157 gamma
= gamma
+ wk
(i
,5)*wk
(i
,5) + wk
(i
,6)*wk
(i
,6)
161 gamma
= coef*gamma
- coef2*
(ew**2
+ ewc**2
)
162 + - coef5*
(ew
- ewc
)**2
163 if (it
.ne
. 1) beta
= gamma
/ pgamma
164 t
= coef5*
(ewc
- 3.0d0*ew
)
165 tc
= coef5*
(ew
- 3.0d0*ewc
)
167 wk
(i
,2) = beta*wk
(i
,2) + coef*wk
(i
,5) + t
168 cperm
(i
) = beta*cperm
(i
) + coef*wk
(i
,6) + tc
171 c apply matrix to vector
177 if (a
(i
,j
) .eq
. 0.0d0
) go to 280
181 if (b
(i
,j
) .eq
. 0.0d0
) go to 290
185 wk
(i
,3) = float
(kount
)*wk
(i
,2) + sum
191 if (a
(i
,j
) .eq
. 0.0d0
) go to 310
195 if (b
(i
,j
) .eq
. 0.0d0
) go to 320
199 wk
(j
,4) = float
(kount
)*cperm
(j
) + sum
203 sum
= sum
+ wk
(i
,2)*wk
(i
,3) + cperm
(i
)*wk
(i
,4)
205 if(sum
.eq
.0.0d0
) return
208 c determine correction to current iterate
212 cor
= alpha
* wk
(i
,2)
213 if (dabs
(cor
) .gt
. cmax
) cmax
= dabs
(cor
)
214 wk
(i
,1) = wk
(i
,1) + cor
215 cor
= alpha
* cperm
(i
)
216 if (dabs
(cor
) .gt
. cmax
) cmax
= dabs
(cor
)
217 cscale
(i
) = cscale
(i
) + cor
219 if (cmax
.lt
. 0.5d0
) go to 370
221 wk
(i
,5) = wk
(i
,5) - alpha*wk
(i
,3)
222 wk
(i
,6) = wk
(i
,6) - alpha*wk
(i
,4)
226 if (it
.le
. nrp2
) go to 250
228 c end generalized conjugate gradient iteration
232 ir
= wk
(i
,1) + dsign
(0.5d0
,wk
(i
,1))
234 jc
= cscale
(i
) + dsign
(0.5d0
,cscale
(i
))
243 if (i
.lt
. low
) fi
= 1.0d0
247 if (j
.le
. igh
) go to 390
248 if (i
.lt
. low
) go to 400
251 a
(i
,j
) = a
(i
,j
)*fi*fj
252 b
(i
,j
) = b
(i
,j
)*fi*fj
257 c last line of scaleg