OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [980310-3.f] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
c { dg-do compile }
2
c
3
c This demonstrates a problem with g77 and pic on x86 where 
4
c egcs 1.0.1 and earlier will generate bogus assembler output.
5
c unfortunately, gas accepts the bogus acssembler output and 
6
c generates code that almost works.
7
c
8
 
9
 
10
C Date: Wed, 17 Dec 1997 23:20:29 +0000
11
C From: Joao Cardoso <jcardoso@inescn.pt>
12
C To: egcs-bugs@cygnus.com
13
C Subject: egcs-1.0 f77 bug on OSR5
14
C When trying to compile the Fortran file that I enclose bellow,
15
C I got an assembler error:
16
C 
17
C ./g77 -B./ -fpic -O -c scaleg.f
18
C /usr/tmp/cca002D8.s:123:syntax error at (
19
C 
20
C ./g77 -B./ -fpic -O0 -c scaleg.f 
21
C /usr/tmp/cca002EW.s:246:invalid operand combination: leal
22
C 
23
C Compiling without the -fpic flag runs OK.
24
 
25
      subroutine scaleg (n,ma,a,mb,b,low,igh,cscale,cperm,wk)
26
c
27
c     *****parameters:
28
      integer igh,low,ma,mb,n
29
      double precision a(ma,n),b(mb,n),cperm(n),cscale(n),wk(n,6)
30
c
31
c     *****local variables:
32
      integer i,ir,it,j,jc,kount,nr,nrp2
33
      double precision alpha,basl,beta,cmax,coef,coef2,coef5,cor,
34
     *                 ew,ewc,fi,fj,gamma,pgamma,sum,t,ta,tb,tc
35
c
36
c     *****fortran functions:
37
      double precision dabs, dlog10, dsign
38
c     float
39
c
40
c     *****subroutines called:
41
c     none
42
c
43
c     ---------------------------------------------------------------
44
c
45
c     *****purpose:
46
c     scales the matrices a and b in the generalized eigenvalue
47
c     problem a*x = (lambda)*b*x such that the magnitudes of the
48
c     elements of the submatrices of a and b (as specified by low
49
c     and igh) are close to unity in the least squares sense.
50
c     ref.:  ward, r. c., balancing the generalized eigenvalue
51
c     problem, siam j. sci. stat. comput., vol. 2, no. 2, june 1981,
52
c     141-152.
53
c
54
c     *****parameter description:
55
c
56
c     on input:
57
c
58
c       ma,mb   integer
59
c               row dimensions of the arrays containing matrices
60
c               a and b respectively, as declared in the main calling
61
c               program dimension statement;
62
c
63
c       n       integer
64
c               order of the matrices a and b;
65
c
66
c       a       real(ma,n)
67
c               contains the a matrix of the generalized eigenproblem
68
c               defined above;
69
c
70
c       b       real(mb,n)
71
c               contains the b matrix of the generalized eigenproblem
72
c               defined above;
73
c
74
c       low     integer
75
c               specifies the beginning -1 for the rows and
76
c               columns of a and b to be scaled;
77
c
78
c       igh     integer
79
c               specifies the ending -1 for the rows and columns
80
c               of a and b to be scaled;
81
c
82
c       cperm   real(n)
83
c               work array.  only locations low through igh are
84
c               referenced and altered by this subroutine;
85
c
86
c       wk      real(n,6)
87
c               work array that must contain at least 6*n locations.
88
c               only locations low through igh, n+low through n+igh,
89
c               ..., 5*n+low through 5*n+igh are referenced and
90
c               altered by this subroutine.
91
c
92
c     on output:
93
c
94
c       a,b     contain the scaled a and b matrices;
95
c
96
c       cscale  real(n)
97
c               contains in its low through igh locations the integer
98
c               exponents of 2 used for the column scaling factors.
99
c               the other locations are not referenced;
100
c
101
c       wk      contains in its low through igh locations the integer
102
c               exponents of 2 used for the row scaling factors.
103
c
104
c     *****algorithm notes:
105
c     none.
106
c
107
c     *****history:
108
c     written by r. c. ward.......
109
c     modified 8/86 by bobby bodenheimer so that if
110
c       sum = 0 (corresponding to the case where the matrix
111
c       doesn't need to be scaled) the routine returns.
112
c
113
c     ---------------------------------------------------------------
114
c
115
      if (low .eq. igh) go to 410
116
      do 210 i = low,igh
117
         wk(i,1) = 0.0d0
118
         wk(i,2) = 0.0d0
119
         wk(i,3) = 0.0d0
120
         wk(i,4) = 0.0d0
121
         wk(i,5) = 0.0d0
122
         wk(i,6) = 0.0d0
123
         cscale(i) = 0.0d0
124
         cperm(i) = 0.0d0
125
  210 continue
126
c
127
c     compute right side vector in resulting linear equations
128
c
129
      basl = dlog10(2.0d0)
130
      do 240 i = low,igh
131
         do 240 j = low,igh
132
            tb = b(i,j)
133
            ta = a(i,j)
134
            if (ta .eq. 0.0d0) go to 220
135
            ta = dlog10(dabs(ta)) / basl
136
  220       continue
137
            if (tb .eq. 0.0d0) go to 230
138
            tb = dlog10(dabs(tb)) / basl
139
  230       continue
140
            wk(i,5) = wk(i,5) - ta - tb
141
            wk(j,6) = wk(j,6) - ta - tb
142
  240 continue
143
      nr = igh-low+1
144
      coef = 1.0d0/float(2*nr)
145
      coef2 = coef*coef
146
      coef5 = 0.5d0*coef2
147
      nrp2 = nr+2
148
      beta = 0.0d0
149
      it = 1
150
c
151
c     start generalized conjugate gradient iteration
152
c
153
  250 continue
154
      ew = 0.0d0
155
      ewc = 0.0d0
156
      gamma = 0.0d0
157
      do 260 i = low,igh
158
         gamma = gamma + wk(i,5)*wk(i,5) + wk(i,6)*wk(i,6)
159
         ew = ew + wk(i,5)
160
         ewc = ewc + wk(i,6)
161
  260 continue
162
      gamma = coef*gamma - coef2*(ew**2 + ewc**2)
163
     +        - coef5*(ew - ewc)**2
164
      if (it .ne. 1) beta = gamma / pgamma
165
      t = coef5*(ewc - 3.0d0*ew)
166
      tc = coef5*(ew - 3.0d0*ewc)
167
      do 270 i = low,igh
168
         wk(i,2) = beta*wk(i,2) + coef*wk(i,5) + t
169
         cperm(i) = beta*cperm(i) + coef*wk(i,6) + tc
170
  270 continue
171
c
172
c     apply matrix to vector
173
c
174
      do 300 i = low,igh
175
         kount = 0
176
         sum = 0.0d0
177
         do 290 j = low,igh
178
            if (a(i,j) .eq. 0.0d0) go to 280
179
            kount = kount+1
180
            sum = sum + cperm(j)
181
  280       continue
182
            if (b(i,j) .eq. 0.0d0) go to 290
183
            kount = kount+1
184
            sum = sum + cperm(j)
185
  290    continue
186
         wk(i,3) = float(kount)*wk(i,2) + sum
187
  300 continue
188
      do 330 j = low,igh
189
         kount = 0
190
         sum = 0.0d0
191
         do 320 i = low,igh
192
            if (a(i,j) .eq. 0.0d0) go to 310
193
            kount = kount+1
194
            sum = sum + wk(i,2)
195
  310       continue
196
            if (b(i,j) .eq. 0.0d0) go to 320
197
            kount = kount+1
198
            sum = sum + wk(i,2)
199
  320    continue
200
         wk(j,4) = float(kount)*cperm(j) + sum
201
  330 continue
202
      sum = 0.0d0
203
      do 340 i = low,igh
204
         sum = sum + wk(i,2)*wk(i,3) + cperm(i)*wk(i,4)
205
  340 continue
206
      if(sum.eq.0.0d0) return
207
      alpha = gamma / sum
208
c
209
c     determine correction to current iterate
210
c
211
      cmax = 0.0d0
212
      do 350 i = low,igh
213
         cor = alpha * wk(i,2)
214
         if (dabs(cor) .gt. cmax) cmax = dabs(cor)
215
         wk(i,1) = wk(i,1) + cor
216
         cor = alpha * cperm(i)
217
         if (dabs(cor) .gt. cmax) cmax = dabs(cor)
218
         cscale(i) = cscale(i) + cor
219
  350 continue
220
      if (cmax .lt. 0.5d0) go to 370
221
      do 360 i = low,igh
222
         wk(i,5) = wk(i,5) - alpha*wk(i,3)
223
         wk(i,6) = wk(i,6) - alpha*wk(i,4)
224
  360 continue
225
      pgamma = gamma
226
      it = it+1
227
      if (it .le. nrp2) go to 250
228
c
229
c     end generalized conjugate gradient iteration
230
c
231
  370 continue
232
      do 380 i = low,igh
233
         ir = wk(i,1) + dsign(0.5d0,wk(i,1))
234
         wk(i,1) = ir
235
         jc = cscale(i) + dsign(0.5d0,cscale(i))
236
         cscale(i) = jc
237
  380 continue
238
c
239
c     scale a and b
240
c
241
      do 400 i = 1,igh
242
         ir = wk(i,1)
243
         fi = 2.0d0**ir
244
         if (i .lt. low) fi = 1.0d0
245
         do 400 j =low,n
246
            jc = cscale(j)
247
            fj = 2.0d0**jc
248
            if (j .le. igh) go to 390
249
            if (i .lt. low) go to 400
250
            fj = 1.0d0
251
  390       continue
252
            a(i,j) = a(i,j)*fi*fj
253
            b(i,j) = b(i,j)*fi*fj
254
  400 continue
255
  410 continue
256
      return
257
c
258
c     last line of scaleg
259
c
260
      end

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.