*     D03NEF Example Program Text
*     Mark 20 Release. NAG Copyright 2001.
*     .. Parameters ..
      INTEGER          NIN, NOUT
      PARAMETER        (NIN=5,NOUT=6)
      INTEGER          NSMAX, NTMAX, NTDMAX, LWMAX
      PARAMETER        (NSMAX=100,NTMAX=100,NTDMAX=10,LWMAX=9*NTDMAX+24)
*     .. Local Scalars ..
      DOUBLE PRECISION DS, DT, TMAT, X
      INTEGER          I, IFAIL, IGREEK, J, KOPT, LWORK, NS, NT, NTD
*     .. Local Arrays ..
      DOUBLE PRECISION DELTA(NSMAX,NTMAX), F(NSMAX,NTMAX),
     +                 GAMMA(NSMAX,NTMAX), LAMBDA(NSMAX,NTMAX), Q(3),
     +                 RA(3), RD(NTDMAX), RHO(NSMAX,NTMAX), S(NSMAX),
     +                 SIGA(3), SIGD(NTDMAX), T(NTMAX), TD(NTDMAX),
     +                 THETA(NSMAX,NTMAX), WORK(LWMAX)
      LOGICAL          GPRNT(5), TDPAR(3)
      CHARACTER*6      GNAME(5)
*     .. External Subroutines ..
      EXTERNAL         D03NDF, D03NEF
*     .. Intrinsic Functions ..
      INTRINSIC        DBLE
*     .. Data statements ..
      DATA             GNAME/'Theta ', 'Delta ', 'Gamma ', 'Lambda',
     +                 'Rho   '/
      DATA             GPRNT/5*.TRUE./
*     .. Executable Statements ..
      WRITE (NOUT,*) 'D03NEF Example Program Results'
      WRITE (NOUT,*)
*
*     Skip heading in data file
*
      READ (NIN,*)
*
*     Read problem parameters
*
      READ (NIN,*) KOPT
      READ (NIN,*) X
      READ (NIN,*) TMAT
      READ (NIN,*) NS, NT
      READ (NIN,*) S(1), S(NS)
      READ (NIN,*) T(1), T(NT)
      READ (NIN,*) NTD
      READ (NIN,*) (TD(I),I=1,NTD)
      READ (NIN,*) (RD(I),I=1,NTD)
      READ (NIN,*) (SIGD(I),I=1,NTD)
*
      TDPAR(1) = .TRUE.
      TDPAR(2) = .FALSE.
      TDPAR(3) = .TRUE.
      Q(1) = 0.D0
      LWORK = 9*NTD + 24
*
      IF (NS.LT.2 .OR. NS.GT.NSMAX) THEN
         WRITE (NOUT,*) 'NS invalid.'
      ELSE IF (NT.LT.2 .OR. NT.GT.NTMAX) THEN
         WRITE (NOUT,*) 'NT invalid.'
      ELSE
*
         DS = (S(NS)-S(1))/DBLE(NS-1)
         DT = (T(NT)-T(1))/DBLE(NT-1)
*
*         Loop over times
*
         DO 40 J = 1, NT
*
            T(J) = T(1) + (J-1)*DT
*
*             Find average values of r and sigma
*
            IFAIL = 1
            CALL D03NEF(T(J),TMAT,NTD,TD,RD,RA,WORK,LWORK,IFAIL)
            IF (IFAIL.EQ.0) THEN
               IFAIL = 1
               CALL D03NEF(T(J),TMAT,NTD,TD,SIGD,SIGA,WORK,LWORK,IFAIL)
            END IF
            IF (IFAIL.NE.0) THEN
               WRITE (NOUT,99997) IFAIL
               GO TO 120
            END IF
*
*             Loop over stock prices
*
            DO 20 I = 1, NS
*
               S(I) = S(1) + (I-1)*DS
*
*                 Evaluate analytic solution of Black-Scholes equation
*
               IFAIL = 1
               CALL D03NDF(KOPT,X,S(I),T(J),TMAT,TDPAR,RA,Q,SIGA,F(I,J),
     +                     THETA(I,J),DELTA(I,J),GAMMA(I,J),LAMBDA(I,J),
     +                     RHO(I,J),IFAIL)
               IF (IFAIL.NE.0) THEN
                  WRITE (NOUT,99996) IFAIL
                  GO TO 120
               END IF
*
   20       CONTINUE
   40    CONTINUE
*
*         Output option values.
*
         WRITE (NOUT,*)
         WRITE (NOUT,*) 'Option Values'
         WRITE (NOUT,*) '-------------'
         WRITE (NOUT,*) '  Stock Price  |   Time to Maturity (months)'
         WRITE (NOUT,99999) '|', (12*(TMAT-T(J)),J=1,NT)
         WRITE (NOUT,'(11A)') ' -----------------',
     +     ('------------',J=1,NT)
         DO 60 I = 1, NS
            WRITE (NOUT,99998) S(I), '|', (F(I,J),J=1,NT)
   60    CONTINUE
*
         DO 100 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*(TMAT-T(J)),J=1,NT)
               WRITE (NOUT,'(11A)') ' -----------------',
     +           ('------------',J=1,NT)
               DO 80 I = 1, NS
                  IF (IGREEK.EQ.1) THEN
                     WRITE (NOUT,99998) S(I), '|', (THETA(I,J),J=1,NT)
                  ELSE IF (IGREEK.EQ.2) THEN
                     WRITE (NOUT,99998) S(I), '|', (DELTA(I,J),J=1,NT)
                  ELSE IF (IGREEK.EQ.3) THEN
                     WRITE (NOUT,99998) S(I), '|', (GAMMA(I,J),J=1,NT)
                  ELSE IF (IGREEK.EQ.4) THEN
                     WRITE (NOUT,99998) S(I), '|', (LAMBDA(I,J),J=1,NT)
                  ELSE IF (IGREEK.EQ.5) THEN
                     WRITE (NOUT,99998) S(I), '|', (RHO(I,J),J=1,NT)
                  END IF
   80          CONTINUE
            END IF
*
  100    CONTINUE
*
  120    CONTINUE
      END IF
*
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,' ** D03NEF returned with IFAIL = ',I5)
99996 FORMAT (1X,' ** D03NDF returned with IFAIL = ',I5)
      END