1      SUBROUTINE CPEVL(N,M,A,Z,C,B,KBD)
2C***BEGIN PROLOGUE  CPEVL
3C***REFER TO  CPZERO
4C
5C        Evaluate a complex polynomial and its derivatives.
6C        Optionally compute error bounds for these values.
7C
8C   INPUT...
9C        N = Degree of the polynomial
10C        M = Number of derivatives to be calculated,
11C            M=0 evaluates only the function
12C            M=1 evaluates the function and first derivative, etc.
13C             if M .GT. N+1 function and all N derivatives will be
14C                calculated.
15C       A = Complex vector containing the N+1 coefficients of polynomial
16C               A(I)= coefficient of Z**(N+1-I)
17C        Z = Complex point at which the evaluation is to take place.
18C        C = Array of 2(M+1) words into which values are placed.
19C        B = Array of 2(M+1) words only needed if bounds are to be
20C              calculated.  It is not used otherwise.
21C        KBD = A logical variable, e.g. .TRUE. or .FALSE. which is
22C              to be set .TRUE. if bounds are to be computed.
23C
24C  OUTPUT...
25C        C =  C(I+1) contains the complex value of the I-th
26C              derivative at Z, I=0,...,M
27C        B =  B(I) contains the bounds on the real and imaginary parts
28C              of C(I) if they were requested.
29C***ROUTINES CALLED  I1MACH
30C***REVISION HISTORY  (YYMMDD)
31C   000330  Modified array declarations.  (JEC)
32C
33C***END PROLOGUE  CPEVL
34C
35      COMPLEX A(*),C(*),Z,CI,CIM1,B(*),BI,BIM1,T,ZA,Q
36      LOGICAL KBD
37      DATA NBITS /0/
38      ZA(Q)=CMPLX(ABS(REAL(Q)),ABS(AIMAG(Q)))
39C***FIRST EXECUTABLE STATEMENT  CPEVL
40      IF ( NBITS .EQ. 0 ) NBITS = I1MACH (11)
41      D1=2.**(1-NBITS)
42      NP1=N+1
43      DO 1 J=1,NP1
44         CI=0.0
45         CIM1=A(J)
46         BI=0.0
47         BIM1=0.0
48         MINI=MIN0(M+1,N+2-J)
49            DO 1 I=1,MINI
50               IF(J .NE. 1) CI=C(I)
51               IF(I .NE. 1) CIM1=C(I-1)
52               C(I)=CIM1+Z*CI
53               IF(.NOT. KBD) GO TO 1
54               IF(J .NE. 1) BI=B(I)
55               IF(I .NE. 1) BIM1=B(I-1)
56               T=BI+(3.*D1+4.*D1*D1)*ZA(CI)
57               R=REAL(ZA(Z)*CMPLX(REAL(T),-AIMAG(T)))
58               S=AIMAG(ZA(Z)*T)
59               B(I)=(1.+8.*D1)*(BIM1+D1*ZA(CIM1)+CMPLX(R,S))
60               IF(J .EQ. 1) B(I)=0.0
61    1 CONTINUE
62      RETURN
63      END
64