5 * Revision 1.1.1.1 1996/04/01 15:02:27 mclareni
10 SUBROUTINE CHEB(M,N,MDIM,NDIM,A,B,TOL,RELERR,X,RANK,RESMAX,
12 C LINEAR CHEBYSHEV FIT ROUTINE FROM ACM TOMS 1, 266(1975)
13 C BY BARRODALE AND PHILLIPS
14 DIMENSION A(NDIM,MDIM), B(MDIM), X(NDIM)
15 INTEGER PROW,PCOL,RANK,RANKP1,OCODE
16 #include "e221prec.inc"
44 CALL VFILL(B(K),M-K+1,1.)
45 C DETERMINE THE VECTOR TO ENTER THE BASIS.
48 IF (B(J) .EQ. 0.) GOTO 60
50 IF (DD .LE. D) GOTO 60
55 C TEST FOR ZERO RIGHT-HAND SIDE
56 IF (D .GT. TOL) GOTO 70
60 C DETERMINE THE VECTOR TO LEAVE THE BASIS.
64 IF (DD .LE. D) GOTO 80
68 IF (D .GT. TOL) GOTO 330
69 C CHECK FOR LINEAR DEPENDENCE IN LEVEL 1.
71 IF (MODE .EQ. 1) GOTO 50
73 IF (B(J) .EQ. 0.) GOTO 100
75 IF (ABS(A(I,J)) .LE. TOL) GOTO 90
84 110 IF (PCOL .EQ. K) GOTO 130
85 C INTERCHANGE COLUMNS IN LEVEL 1.
91 130 IF (PROW .EQ. NP1MK) GOTO 150
92 C INTERCHANGE ROWS IN LEVEL 1
95 A(PROW,J) = A(NP1MK,J)
98 150 IF (K.LT.N) GOTO 30
99 160 IF (RANK.EQ.M) GOTO 380
103 C DETERMINE THE VECTOR TO ENTER THE BASIS.
107 IF (DD .LE. D) GOTO 170
111 C COMPARE CHEBYSHEV ERROR WITH TOL.
112 IF (D.GT.TOL) GOTO 180
117 180 IF (A(NP2,PCOL) .LT. -TOL) GOTO 200
118 A(NP1,PCOL) = 2. - A(NP1,PCOL)
120 IF (I.EQ.NP1) GOTO 190
121 A(I,PCOL) = -A(I,PCOL)
123 C ARRANGE FOR ALL ENTRIES IN PIVOT COL (EXC. PIVOT) TO BE NEGATIVE
124 200 DO 220 I= NP1MR, N
125 IF (A(I,PCOL) .LT. TOL) GOTO 220
127 A(NP1,J) = A(NP1,J) + 2.*A(I,J)
135 230 IF (RANKP1 .EQ. M) GOTO 380
136 IF (PCOL .EQ. M) GOTO 250
137 C INTERCHANGE COLUMNS IN LEVEL 2.
146 C DETERMINE THE VECTOR TO ENTER THE BASIS.
150 IF (A(NP2,J) .GE. D) GOTO 270
155 270 DD = VAL - A(NP2,J)
156 IF (DD .GE. D) GOTO 280
161 IF (D .GE. -TOL) GOTO 380
163 IF (DD .GE. RELTMP) GOTO 290
168 290 IF (MODE .EQ. 0) GOTO 310
170 A(I,PCOL) = 2.*A(I,M) - A(I,PCOL)
173 A(NP3,PCOL) = -A(NP3,PCOL)
174 C DETERMINE THE VECTOR TO LEAVE THE BASIS.
177 IF (A(I,PCOL) .LE. TOL) GOTO 320
178 DD = A(I,M)/A(I,PCOL)
179 IF (DD .GE. D) GOTO 320
183 IF (D .LT. BIG) GOTO 330
186 C PIVOT ON A(PROW,PCOL)
187 330 PIVOT = A(PROW,PCOL)
189 A(PROW,J) = A(PROW,J)/PIVOT
192 IF (J.EQ.PCOL) GOTO 360
195 IF (I.EQ.PROW) GOTO 350
196 A(I,J) = A(I,J) - D*A(I,PCOL)
201 A(I,PCOL) = A(I,PCOL)/TPIVOT
203 A(PROW,PCOL) = 1./PIVOT
205 A(PROW,MP1) = A(NP3,PCOL)
208 GOTO (110, 230, 260), LEV
214 IF (MODE .EQ. 2) GOTO 450
219 IF (MODE.EQ.3 .OR. RANK.EQ.M) GOTO 450
221 K = ABS(A(I,MP1)) - N
222 B(K) = A(NP2,M) * SIGN(1., A(I,MP1))
224 IF (RANKP1 .EQ. M) GOTO 430
225 DO 420 J= RANKP1, MM1
226 K = ABS(A(NP3,J)) - N
227 B(K) = (A(NP2,M)-A(NP2,J)) * SIGN(1., A(NP3,J))
229 C TEST FOR NON-UNIQUE SOLUTION
230 430 DO 440 I= NP1MR, NP1
231 IF (ABS(A(I,M)) .GT. TOL) GOTO 440
235 450 IF (MODE.NE.2 .AND. MODE.NE.3) RESMAX = A(NP2,M)
236 IF (RANK.EQ.M) RESMAX=0.
237 IF (MODE.EQ.4) RESMAX = RESMAX-D