]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/04/01 15:02:28 mclareni | |
6 | * Mathlib gen | |
7 | * | |
8 | * | |
9 | #include "gen/pilot.h" | |
10 | #if !defined(CERNLIB_DOUBLE) | |
11 | SUBROUTINE RCHEBN(M,N,A,MDIM,B,TOL,RELERR,X,RESMAX,IRK,ITER,IOCD) | |
12 | ||
13 | DIMENSION A(MDIM,*),B(*),X(*) | |
14 | ||
15 | PARAMETER (R0 = 0, R1 = 1, R2 = 2) | |
16 | ||
17 | DATA BIG /1E+37/ | |
18 | ||
19 | IRK=N | |
20 | NR=1 | |
21 | RELTMP=RELERR | |
22 | RELERR=0 | |
23 | ||
24 | CALL RVSET(M,R1,A(1,N+1),A(2,N+1)) | |
25 | CALL RVSCL(M,-R1,B(1),B(2),A(1,N+2),A(2,N+2)) | |
26 | DO 10 I = 1,M | |
27 | A(I,N+3)=N+I | |
28 | 10 CONTINUE | |
29 | DO 20 J = 1,N | |
30 | A(M+1,J)=J | |
31 | 20 CONTINUE | |
32 | A(M+1,N+1)=0 | |
33 | ITER=0 | |
34 | IOCD=1 | |
35 | CALL RVSET(N,R0,X(1),X(2)) | |
36 | ||
37 | LEV=1 | |
38 | ||
39 | K=0 | |
40 | NK=N+1 | |
41 | 30 K=K+1 | |
42 | NK=NK-1 | |
43 | MODE=0 | |
44 | CALL RVSET(M-K+1,R1,B(1),B(2)) | |
45 | ||
46 | 50 D=-BIG | |
47 | DO 60 I = K,M | |
48 | IF(B(I) .NE. 0) THEN | |
49 | DD=ABS(A(I,N+2)) | |
50 | IF(DD .GT. D) THEN | |
51 | IQ=I | |
52 | D=DD | |
53 | ENDIF | |
54 | ENDIF | |
55 | 60 CONTINUE | |
56 | IF(K .LE. 1 .AND. D .LE. TOL) THEN | |
57 | RESMAX=0 | |
58 | MODE=2 | |
59 | GOTO 380 | |
60 | ENDIF | |
61 | D=TOL | |
62 | DO 80 J = 1,NK | |
63 | DD=ABS(A(IQ,J)) | |
64 | IF(DD .GT. D) THEN | |
65 | IP=J | |
66 | D=DD | |
67 | ENDIF | |
68 | 80 CONTINUE | |
69 | IF(D .GT. TOL) GOTO 330 | |
70 | ||
71 | B(IQ)=0 | |
72 | IF(MODE .EQ. 1) GOTO 50 | |
73 | DO 100 I = K,M | |
74 | IF(B(I) .NE. 0) THEN | |
75 | DO 90 J = 1,NK | |
76 | IF(ABS(A(I,J)) .GT. TOL) THEN | |
77 | MODE=1 | |
78 | GOTO 50 | |
79 | ENDIF | |
80 | 90 CONTINUE | |
81 | ENDIF | |
82 | 100 CONTINUE | |
83 | IRK=K-1 | |
84 | NR=N+1-IRK | |
85 | IOCD=0 | |
86 | GOTO 160 | |
87 | ||
88 | 110 CALL RVXCH(N+3,A(IQ,1),A(IQ,2),A(K,1),A(K,2)) | |
89 | CALL RVXCH(M+1,A(1,IP),A(2,IP),A(1,NK),A(2,NK)) | |
90 | IF(K .LT. N) GOTO 30 | |
91 | 160 IF(IRK .EQ. M) GOTO 380 | |
92 | ||
93 | LEV=2 | |
94 | ||
95 | D=TOL | |
96 | DO 170 I = IRK+1,M | |
97 | DD=ABS(A(I,N+2)) | |
98 | IF(DD .GT. D) THEN | |
99 | IQ=I | |
100 | D=DD | |
101 | ENDIF | |
102 | 170 CONTINUE | |
103 | ||
104 | IF(D .LE. TOL) THEN | |
105 | RESMAX=0 | |
106 | MODE=3 | |
107 | GOTO 380 | |
108 | ENDIF | |
109 | IF(A(IQ,N+2) .GE. -TOL) THEN | |
110 | A(IQ,N+1)=2-A(IQ,N+1) | |
111 | CALL RVSCL(N+4-NR,-R1,A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2)) | |
112 | A(IQ,N+1)=-A(IQ,N+1) | |
113 | ENDIF | |
114 | DO 220 J = NR,N | |
115 | IF(A(IQ,J) .GE. TOL) THEN | |
116 | CALL RVSCA(M,R2, | |
117 | 1 A(1,J),A(2,J),A(1,N+1),A(2,N+1),A(1,N+1),A(2,N+1)) | |
118 | CALL RVSCL(M,-R1,A(1,J),A(2,J),A(1,J),A(2,J)) | |
119 | A(M+1,J)=-A(M+1,J) | |
120 | ENDIF | |
121 | 220 CONTINUE | |
122 | IP=N+1 | |
123 | GOTO 330 | |
124 | ||
125 | 230 IF(IRK+1 .EQ. M) GO TO 380 | |
126 | CALL RVXCH(IRK+3,A(IQ,1),A(IQ,2),A(M,1),A(M,2)) | |
127 | ||
128 | LEV=3 | |
129 | ||
130 | 260 D=-TOL | |
131 | H=2*A(M,N+2) | |
132 | DO 280 I = IRK+1,M-1 | |
133 | IF(A(I,N+2) .LT. D) THEN | |
134 | IQ=I | |
135 | D=A(I,N+2) | |
136 | MODE=0 | |
137 | ELSE | |
138 | DD=H-A(I,N+2) | |
139 | IF(DD .LT. D) THEN | |
140 | IQ=I | |
141 | D=DD | |
142 | MODE=1 | |
143 | ENDIF | |
144 | ENDIF | |
145 | 280 CONTINUE | |
146 | IF(D .GE. -TOL) GOTO 380 | |
147 | DD=-D/A(M,N+2) | |
148 | IF(DD .LT. RELTMP) THEN | |
149 | RELERR=DD | |
150 | MODE=4 | |
151 | GOTO 380 | |
152 | ENDIF | |
153 | IF(MODE .NE. 0) THEN | |
154 | CALL RVSCS(IRK+1,R2, | |
155 | 1 A(M,1),A(M,2),A(IQ,1),A(IQ,2),A(IQ,1),A(IQ,2)) | |
156 | A(IQ,N+2)=D | |
157 | A(IQ,N+3)=-A(IQ,N+3) | |
158 | ENDIF | |
159 | D=BIG | |
160 | DO 320 J = NR,N+1 | |
161 | IF(A(IQ,J) .GT. TOL) THEN | |
162 | DD=A(M,J)/A(IQ,J) | |
163 | IF(DD .LT. D) THEN | |
164 | IP=J | |
165 | D=DD | |
166 | ENDIF | |
167 | ENDIF | |
168 | 320 CONTINUE | |
169 | IF(D .LT. BIG) GO TO 330 | |
170 | IOCD=2 | |
171 | GOTO 380 | |
172 | ||
173 | 330 RPVT=1/A(IQ,IP) | |
174 | CALL RVSCL(M,RPVT,A(1,IP),A(2,IP),A(1,IP),A(2,IP)) | |
175 | DO 360 I = 1,M | |
176 | IF(I .NE. IQ) THEN | |
177 | D=A(I,IP) | |
178 | CALL RVSCA(N+3-NR,-D, | |
179 | 1 A(IQ,NR),A(IQ,NR+1),A(I,NR),A(I,NR+1),A(I,NR),A(I,NR+1)) | |
180 | A(I,IP)=D | |
181 | ENDIF | |
182 | 360 CONTINUE | |
183 | CALL RVSCL(IRK+2,-RPVT,A(IQ,NR),A(IQ,NR+1),A(IQ,NR),A(IQ,NR+1)) | |
184 | A(IQ,IP)=RPVT | |
185 | D=A(M+1,IP) | |
186 | A(M+1,IP)=A(IQ,N+3) | |
187 | A(IQ,N+3)=D | |
188 | ITER=ITER+1 | |
189 | GOTO (110,230,260), LEV | |
190 | ||
191 | 380 CALL RVSET(M,R0,B(1),B(2)) | |
192 | IF(MODE .EQ. 2) GOTO 450 | |
193 | DO 400 I = 1,IRK | |
194 | X(INT(A(I,N+3)))=A(I,N+2) | |
195 | 400 CONTINUE | |
196 | IF(MODE .EQ. 3 .OR. IRK .EQ. M) GOTO 450 | |
197 | DO 410 J = NR,N+1 | |
198 | B(INT(ABS(A(M+1,J)))-N)=A(M,N+2)*SIGN(R1,A(M+1,J)) | |
199 | 410 CONTINUE | |
200 | DO 420 I = IRK+1,M-1 | |
201 | B(INT(ABS(A(I,N+3)))-N)=(A(M,N+2)-A(I,N+2))*SIGN(R1,A(I,N+3)) | |
202 | 420 CONTINUE | |
203 | 430 DO 440 J = NR,N+1 | |
204 | IF(ABS(A(M,J)) .LE. TOL) THEN | |
205 | IOCD=0 | |
206 | GOTO 450 | |
207 | ENDIF | |
208 | 440 CONTINUE | |
209 | 450 IF(MODE .NE. 2 .AND. MODE .NE. 3) RESMAX=A(M,N+2) | |
210 | IF(IRK .EQ. M) RESMAX=0 | |
211 | IF(MODE .EQ. 4) RESMAX=RESMAX-D | |
212 | RETURN | |
213 | END | |
214 | #endif |