5 * Revision 1.1.1.1 1996/04/01 15:02:28 mclareni
10 #if defined(CERNLIB_DOUBLE)
11 SUBROUTINE DCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD)
13 IMPLICIT DOUBLE PRECISION (A-H,O-Z)
15 DIMENSION A(MDIM,*),B(*),X(*)
17 PARAMETER (R0 = 0, R1 = 1, R2 = 2)
26 CALL DVSET(M,R1,A(1,N+1),A(2,N+1))
27 CALL DVSCL(M,-R1,B(1),B(2),A(1,N+2),A(2,N+2))
37 CALL DVSET(N,R0,X(1),X(2))
46 CALL DVSET(M-K+1,R1,B(1),B(2))
58 IF(K .LE. 1 .AND. D .LE. TOL) THEN
71 IF(D .GT. TOL) GOTO 330
74 IF(MODE .EQ. 1) GOTO 50
78 IF(ABS(A(I,J)) .GT. TOL) THEN
90 110 CALL DVXCH(N+3,A(IQ,1),A(IQ,2),A(K,1),A(K,2))
91 CALL DVXCH(M+1,A(1,IP),A(2,IP),A(1,NK),A(2,NK))
93 160 IF(IRK .EQ. M) GOTO 380
111 IF(A(IQ,N+2) .GE. -TOL) THEN
112 A(IQ,N+1)=2-A(IQ,N+1)
113 CALL DVSCL(N+4-NR,-R1,A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
117 IF(A(IQ,J) .GE. TOL) THEN
119 1 A(1,J),A(2,J),A(1,N+1),A(2,N+1),A(1,N+1),A(2,N+1))
120 CALL DVSCL(M,-R1,A(1,J),A(2,J),A(1,J),A(2,J))
127 230 IF(IRK+1 .EQ. M) GO TO 380
128 CALL DVXCH(IRK+3,A(IQ,1),A(IQ,2),A(M,1),A(M,2))
135 IF(A(I,N+2) .LT. D) THEN
148 IF(D .GE. -TOL) GOTO 380
150 IF(DD .LT. RELTMP) THEN
157 1 A(M,1),A(M,2),A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2))
163 IF(A(IQ,J) .GT. TOL) THEN
171 IF(D .LT. BIG) GO TO 330
176 CALL DVSCL(M,RPVT,A(1,IP),A(2,IP),A(1,IP),A(2,IP))
180 CALL DVSCA(N+3-NR,-D,
181 1 A(IQ,NR),A(IQ,NR+1),A(I,NR),A(I,NR+1),A(I,NR),A(I,NR+1))
185 CALL DVSCL(IRK+2,-RPVT,A(IQ,NR),A(IQ,NR+1),A(IQ,NR),A(IQ,NR+1))
191 GOTO (110,230,260), LEV
193 380 CALL DVSET(M,R0,B(1),B(2))
194 IF(MODE .EQ. 2) GOTO 450
196 X(INT(A(I,N+3)))=A(I,N+2)
198 IF(MODE .EQ. 3 .OR. IRK .EQ. M) GOTO 450
200 B(INT(ABS(A(M+1,J)))-N)=A(M,N+2)*SIGN(R1,A(M+1,J))
203 B(INT(ABS(A(I,N+3)))-N)=(A(M,N+2)-A(I,N+2))*SIGN(R1,A(I,N+3))
205 430 DO 440 J = NR,N+1
206 IF(ABS(A(M,J)) .LE. TOL) THEN
211 450 IF(MODE .NE. 2 .AND. MODE .NE. 3) RESMAX=A(M,N+2)
212 IF(IRK .EQ. M) RESMAX=0
213 IF(MODE .EQ. 4) RESMAX=RESMAX-D