]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/04/01 15:02:24 mclareni | |
6 | * Mathlib gen | |
7 | * | |
8 | * | |
9 | #include "gen/pilot.h" | |
10 | SUBROUTINE RLSQPM(N,X,Y,M,A,SD,IFAIL) | |
11 | IMPLICIT DOUBLE PRECISION (A-H,O-Z) | |
12 | REAL X,Y,A,R0 | |
13 | ||
14 | PARAMETER (IDIM = 21, R0 = 0, D0 = 0) | |
15 | ||
16 | DIMENSION X(*),Y(*),A(0:*),B(IDIM,IDIM),D(0:IDIM),XY(0:IDIM) | |
17 | ||
18 | M1=M+1 | |
19 | IFAIL=0 | |
20 | IF(N .LE. 1 .OR. M .LT. 0 .OR. M1 .GT. IDIM .OR. M1 .GT. N) THEN | |
21 | IFAIL=1 | |
22 | ELSEIF(M .EQ. 0) THEN | |
23 | XY(0)=DVSUM(N,Y(1),Y(2)) | |
24 | D(0)=XY(0)/N | |
25 | SYY=DVMPY(N,Y(1),Y(2),Y(1),Y(2)) | |
26 | ELSE | |
27 | DO 11 J = 1,M1 | |
28 | D(J-1)=0 | |
29 | B(J,1)=0 | |
30 | B(M1,J)=0 | |
31 | 11 CONTINUE | |
32 | B(1,1)=N | |
33 | SYY=0 | |
34 | DO 4 K = 1,N | |
35 | XK=X(K) | |
36 | YK=Y(K) | |
37 | SYY=SYY+YK**2 | |
38 | P=1 | |
39 | D(0)=D(0)+YK | |
40 | DO 2 J = 2,M1 | |
41 | P=P*XK | |
42 | B(J,1)=B(J,1)+P | |
43 | D(J-1)=D(J-1)+P*YK | |
44 | 2 CONTINUE | |
45 | DO 3 J = 2,M1 | |
46 | P=P*XK | |
47 | B(M1,J)=B(M1,J)+P | |
48 | 3 CONTINUE | |
49 | 4 CONTINUE | |
50 | DO 5 I = 2,M | |
51 | DO 5 K = I,M1 | |
52 | B(K-1,I)=B(K,I-1) | |
53 | 5 CONTINUE | |
54 | DO 6 J = 0,M | |
55 | XY(J)=D(J) | |
56 | 6 CONTINUE | |
57 | CALL DSEQN(M1,B,IDIM,IFAIL,1,D) | |
58 | ENDIF | |
59 | SD=0 | |
60 | IF(IFAIL .EQ. 0) THEN | |
61 | IF(N .GT. M1) THEN | |
62 | SD=SYY | |
63 | DO 7 J = 0,M | |
64 | SD=SD-D(J)*XY(J) | |
65 | 7 CONTINUE | |
66 | SD=SQRT(MAX(D0,SD)/(N-M1)) | |
67 | ENDIF | |
68 | DO 8 J = 0,M | |
69 | A(J)=D(J) | |
70 | 8 CONTINUE | |
71 | ELSE | |
72 | CALL RVSET(M1,R0,A(0),A(1)) | |
73 | M=0 | |
74 | ENDIF | |
75 | RETURN | |
76 | END |