This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / e / dchpws.F
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