*     D03NCF Example Program Text
*     Mark 20 Release. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NSMAX, NTMAX, NTKMAX, LDF
      PARAMETER        (NSMAX=100,NTMAX=100,NTKMAX=10,LDF=NSMAX)
*     .. Local Scalars ..
      DOUBLE PRECISION ALPHA, X
      INTEGER          I, IFAIL, IGREEK, J, KOPT, NS, NT, NTKEEP
      CHARACTER        MESH
*     .. Local Arrays ..
      DOUBLE PRECISION DELTA(NSMAX,NTKMAX), F(NSMAX,NTKMAX),
     +                 GAMMA(NSMAX,NTKMAX), LAMBDA(NSMAX,NTKMAX), Q(3),
     +                 R(3), RHO(NSMAX,NTKMAX), S(NSMAX), SIGMA(3),
     +                 T(NTMAX), THETA(NSMAX,NTKMAX), WORK(4*NSMAX)
      INTEGER          IWORK(NSMAX)
      LOGICAL          GPRNT(5), TDPAR(3)
      CHARACTER*6      GNAME(5)
*     .. External Subroutines ..
      EXTERNAL         D03NCF
*     .. Data statements ..
      DATA             GNAME/'Theta ', 'Delta ', 'Gamma ', 'Lambda',
     +                 'Rho   '/
      DATA             GPRNT/5*.TRUE./
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D03NCF Example Program Results'
      WRITE (NOUT,*)
*
*     Skip heading in data file
*
      READ (NIN,*)
*
*     Read problem parameters
*
      READ (NIN,*) KOPT
      READ (NIN,*) X
      READ (NIN,*) MESH
      READ (NIN,*) NS, NT
      READ (NIN,*) S(1), S(NS)
      READ (NIN,*) T(1), T(NT)
      READ (NIN,*) ALPHA
      READ (NIN,*) NTKEEP
*
*     Check that NS, NT and NTKEEP are within range
*
      IF (NS.GT.NSMAX) THEN
         WRITE (NOUT,*) 'NS too large: increase NSMAX'
      ELSE IF (NT.GT.NTMAX) THEN
         WRITE (NOUT,*) 'NT too large: increase NTMAX'
      ELSE IF (NTKEEP.GT.NTKMAX) THEN
         WRITE (NOUT,*) 'NTKEEP too large: increase NTKMAX'
      ELSE
*
*         Set up input parameters for D03NCF
*
         TDPAR(1) = .FALSE.
         TDPAR(2) = .FALSE.
         TDPAR(3) = .FALSE.
         Q(1) = 0.D0
         R(1) = 0.10D0
         SIGMA(1) = 0.40D0
*
*         Call Black-Scholes solver
*
         IFAIL = 1
         CALL D03NCF(KOPT,X,MESH,NS,S,NT,T,TDPAR,R,Q,SIGMA,ALPHA,NTKEEP,
     +               F,THETA,DELTA,GAMMA,LAMBDA,RHO,LDF,WORK,IWORK,
     +               IFAIL)
         IF (IFAIL.NE.0) THEN
            WRITE (NOUT,99997) IFAIL
            GO TO 80
         END IF
*
*         Output option values.
*
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Option Values'
         WRITE (NOUT,*) '-------------'
         WRITE (NOUT,*) '  Stock Price  |   Time to Maturity (months)'
         WRITE (NOUT,99999) '|', (12*(T(NT)-T(I)),I=1,NTKEEP)
         WRITE (NOUT,'(11A)') ' -----------------',
     +     ('------------',I=1,NTKEEP)
         DO 20 I = 1, NS
            WRITE (NOUT,99998) S(I), '|', (F(I,J),J=1,NTKEEP)
   20    CONTINUE
*
         DO 60 IGREEK = 1, 5
*
            IF (GPRNT(IGREEK)) THEN
               WRITE (NOUT,*)
               WRITE (NOUT,*) GNAME(IGREEK)
               WRITE (NOUT,*) '------'
               WRITE (NOUT,*)
     +           '  Stock Price  |   Time to Maturity (months)'
               WRITE (NOUT,99999) '|', (12*(T(NT)-T(I)),I=1,NTKEEP)
               WRITE (NOUT,'(11A)') ' -----------------',
     +           ('------------',I=1,NTKEEP)
               DO 40 I = 1, NS
                  IF (IGREEK.EQ.1) THEN
                     WRITE (NOUT,99998) S(I), '|',
     +                 (THETA(I,J),J=1,NTKEEP)
                  ELSE IF (IGREEK.EQ.2) THEN
                     WRITE (NOUT,99998) S(I), '|',
     +                 (DELTA(I,J),J=1,NTKEEP)
                  ELSE IF (IGREEK.EQ.3) THEN
                     WRITE (NOUT,99998) S(I), '|',
     +                 (GAMMA(I,J),J=1,NTKEEP)
                  ELSE IF (IGREEK.EQ.4) THEN
                     WRITE (NOUT,99998) S(I), '|',
     +                 (LAMBDA(I,J),J=1,NTKEEP)
                  ELSE IF (IGREEK.EQ.5) THEN
                     WRITE (NOUT,99998) S(I), '|', (RHO(I,J),J=1,NTKEEP)
                  END IF
   40          CONTINUE
            END IF
*
   60    CONTINUE
*
      END IF
   80 CONTINUE
*
99999 FORMAT (16X,A,1X,12(1P,E12.4))
99998 FORMAT (1X,1P,E12.4,3X,A,1X,12(1P,E12.4))
99997 FORMAT (1X,' ** D03NCF returned with IFAIL = ',I5)
      END