[u/mrichter/AliRoot.git] / MINICERN / mathlib / gen / e / dchpws.F

*
* $Id$
*
* $Log$
* Revision 1.1.1.1  1996/04/01 15:02:29  mclareni
* Mathlib gen
*
*
#include "gen/pilot.h"
#if defined(CERNLIB_DOUBLE)
      SUBROUTINE DCHPWS(N,C,A)
#endif
#if !defined(CERNLIB_DOUBLE)
      SUBROUTINE RCHPWS(N,C,A)
#endif
#include "gen/imp64.inc"
      CHARACTER NAMECP*(*),NAMEPC*(*)
      CHARACTER*80 ERRTXT
#if defined(CERNLIB_DOUBLE)
      PARAMETER (NAMECP = 'DCHPWS', NAMEPC = 'DPWCHS')
#endif
#if !defined(CERNLIB_DOUBLE)
      PARAMETER (NAMECP = 'RCHPWS', NAMEPC = 'RPWCHS')
#endif

      DIMENSION C(0:*),A(0:*),QU(0:101),QV(0:101)

      PARAMETER (R1 = 1, HF = R1/2)

      IF(N .LT. 0 .OR. N .GT. 100) THEN
       WRITE(ERRTXT,101) N
       CALL MTLPRT(NAMECP,'E408.1',ERRTXT)
      ELSEIF(N .EQ. 0) THEN
       A(0)=C(0)
      ELSE
       QU(0)=C(N)
       QU(1)=0
       QV(0)=C(N-1)
       QV(1)=2*QU(0)
       DO 2 K = 2,N
       TT=C(N-K)-QU(0)
       QU(K)=0
       DO 1 J = 0,K-1
       T=2*QV(J)-QU(J+1)
       QU(J)=QV(J)
       QV(J)=TT
       TT=T
    1  CONTINUE
       QV(K)=TT
    2  CONTINUE
      ENDIF
      A(0)=QV(0)
      DO 3 J = 1,N
      A(J)=QV(J)-QU(J-1)
    3 CONTINUE
      RETURN

#if defined(CERNLIB_DOUBLE)
      ENTRY DPWCHS(N,A,C)
#endif
#if !defined(CERNLIB_DOUBLE)
      ENTRY RPWCHS(N,A,C)
#endif

      IF(N .LT. 0 .OR. N .GT. 100) THEN
       WRITE(ERRTXT,101) N
       CALL MTLPRT(NAMEPC,'E408.1',ERRTXT)
      ELSEIF(N .EQ. 0) THEN
       QU(0)=A(0)
      ELSE
       QU(0)=A(N-1)
       QU(1)=A(N)
       IF(N .GE. 2) QU(2)=0
       DO 4 K = 2,N
       TT=QU(0)+HF*QU(2)
       QU(0)=A(N-K)+HF*QU(1)
       DO 5 J = 2,K
       T=HF*QU(J-1)
       IF(J .LE. K-2) T=T+HF*QU(J+1)
       QU(J-1)=TT
       TT=T
    5  CONTINUE
       QU(K)=T
    4  CONTINUE
      ENDIF
      DO 6 J = 0,N
      C(J)=QU(J)
    6 CONTINUE
      RETURN
  101 FORMAT('NUMBER OF TERMS  N = ',I5,'  < 0  OR  > 100')
      END
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