]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1996/04/01 15:02:29 mclareni | |
6 | * Mathlib gen | |
7 | * | |
8 | * | |
9 | #include "gen/pilot.h" | |
10 | #if defined(CERNLIB_DOUBLE) | |
11 | SUBROUTINE DCHPWS(N,C,A) | |
12 | #endif | |
13 | #if !defined(CERNLIB_DOUBLE) | |
14 | SUBROUTINE RCHPWS(N,C,A) | |
15 | #endif | |
16 | #include "gen/imp64.inc" | |
17 | CHARACTER NAMECP*(*),NAMEPC*(*) | |
18 | CHARACTER*80 ERRTXT | |
19 | #if defined(CERNLIB_DOUBLE) | |
20 | PARAMETER (NAMECP = 'DCHPWS', NAMEPC = 'DPWCHS') | |
21 | #endif | |
22 | #if !defined(CERNLIB_DOUBLE) | |
23 | PARAMETER (NAMECP = 'RCHPWS', NAMEPC = 'RPWCHS') | |
24 | #endif | |
25 | ||
26 | DIMENSION C(0:*),A(0:*),QU(0:101),QV(0:101) | |
27 | ||
28 | PARAMETER (R1 = 1, HF = R1/2) | |
29 | ||
30 | IF(N .LT. 0 .OR. N .GT. 100) THEN | |
31 | WRITE(ERRTXT,101) N | |
32 | CALL MTLPRT(NAMECP,'E408.1',ERRTXT) | |
33 | ELSEIF(N .EQ. 0) THEN | |
34 | A(0)=C(0) | |
35 | ELSE | |
36 | QU(0)=C(N) | |
37 | QU(1)=0 | |
38 | QV(0)=C(N-1) | |
39 | QV(1)=2*QU(0) | |
40 | DO 2 K = 2,N | |
41 | TT=C(N-K)-QU(0) | |
42 | QU(K)=0 | |
43 | DO 1 J = 0,K-1 | |
44 | T=2*QV(J)-QU(J+1) | |
45 | QU(J)=QV(J) | |
46 | QV(J)=TT | |
47 | TT=T | |
48 | 1 CONTINUE | |
49 | QV(K)=TT | |
50 | 2 CONTINUE | |
51 | ENDIF | |
52 | A(0)=QV(0) | |
53 | DO 3 J = 1,N | |
54 | A(J)=QV(J)-QU(J-1) | |
55 | 3 CONTINUE | |
56 | RETURN | |
57 | ||
58 | #if defined(CERNLIB_DOUBLE) | |
59 | ENTRY DPWCHS(N,A,C) | |
60 | #endif | |
61 | #if !defined(CERNLIB_DOUBLE) | |
62 | ENTRY RPWCHS(N,A,C) | |
63 | #endif | |
64 | ||
65 | IF(N .LT. 0 .OR. N .GT. 100) THEN | |
66 | WRITE(ERRTXT,101) N | |
67 | CALL MTLPRT(NAMEPC,'E408.1',ERRTXT) | |
68 | ELSEIF(N .EQ. 0) THEN | |
69 | QU(0)=A(0) | |
70 | ELSE | |
71 | QU(0)=A(N-1) | |
72 | QU(1)=A(N) | |
73 | IF(N .GE. 2) QU(2)=0 | |
74 | DO 4 K = 2,N | |
75 | TT=QU(0)+HF*QU(2) | |
76 | QU(0)=A(N-K)+HF*QU(1) | |
77 | DO 5 J = 2,K | |
78 | T=HF*QU(J-1) | |
79 | IF(J .LE. K-2) T=T+HF*QU(J+1) | |
80 | QU(J-1)=TT | |
81 | TT=T | |
82 | 5 CONTINUE | |
83 | QU(K)=T | |
84 | 4 CONTINUE | |
85 | ENDIF | |
86 | DO 6 J = 0,N | |
87 | C(J)=QU(J) | |
88 | 6 CONTINUE | |
89 | RETURN | |
90 | 101 FORMAT('NUMBER OF TERMS N = ',I5,' < 0 OR > 100') | |
91 | END |