      PROGRAM specdemo
      INTEGER choice, InptNum, ErrFlag
      REAL xx,yy,zz,ww

      choice = -1
      InptNum = -1
      choice = 1

      DO WHILE (choice .NE. 25)
        CALL DisplayOptions()
        CALL AskForOne(choice)
        IF (choice .NE. 25) THEN
          CALL NumOfInputs(choice, InptNum)
          CALL ReadReals(InptNum, xx, yy, zz, ww)
          CALL CalculateAnswer(choice, xx, yy, zz, ww, errflag)
          IF (errflag .NE. 0)  CALL DisplayErrorMessage (errflag)
          WRITE (*,*)
     +      ' Press Return to Continue                          '
          READ (*,*)
          DO i = 16, 40
   	    WRITE (*,*)
          END DO
        END IF
      END DO
      END





       SUBROUTINE AskForOne (choice)
       INTEGER choice
       choice = 0
       DO WHILE (choice .LT. 1 .OR. CHOICE .GT. 25)
        WRITE (*,5) ' ENTER SELECTION:  '
        READ *, choice
       END DO
5      FORMAT (1X, A18 \)
       END !SUBROUTINE  AskForOne



       SUBROUTINE CalculateAnswer (choice, x, y, z, w, errflag)
       REAL CalcAns, x, y, z, w
       INTEGER ErrFlag, Int1, choice
       CalcAns = 0.0
       errflag = 0
       SELECT CASE (choice)
        CASE (1)
	    CalcAns = LogGamma(x)
        CASE (2)
	    CalcAns = Gamma(x, errflag)
        CASE (3)
	    CalcAns = IncompleteGamma(x, y)
        CASE (4)
  	  CalcAns = IncompleteGammaComp(x, y)
        CASE (5)
	    CalcAns = Bessel(x, y, errflag)
        CASE (6)
	     CalcAns = Tangent(x)
        CASE (7)
	     CalcAns = CoshY(x)
        CASE (8)
	     CalcAns = SinhY(x)
        CASE (9)
	     CalcAns = Sech(x)
        CASE (10)
	     CalcAns = ArcTanh(x)
        CASE (11)
	     CalcAns = ErrFuncIter(x)
        CASE (12)
	     CalcAns = ErrFunc(x, errflag)
        CASE (13)
	     CalcAns = ErrFuncComp(x, errflag)
        CASE (14)
	     CalcAns = ErrFuncR(x, y)
        CASE (15)
	     CalcAns = ErrFuncI(x, y)
        CASE (16)
	     Int1 = NINT(x)
  	     CalcAns = Hermite(Int1, y, errflag)
        CASE (17)
	     Int1 = NINT(x)
	     CalcAns = Legend(x, y, errflag)
        CASE (18)
	     Int1 = NINT(x)
	     CalcAns = Laguerre(x, y, z, errflag)
        CASE (19)
	     CalcAns = ModBesselI(x, y, ErrFlag)
        CASE (20)
	    CalcAns = ModBesselK(x, y)
        CASE (21)
	    Int1 = INT(x)
	    CalcAns = Jacobi(Int1, y, z, w, errflag)
        CASE (22)
	    Int1 = NINT(x)
	    CalcAns = Tcheb(Int1, y, errflag)
        CASE (23)
	     CalcAns = Beta(x, y, errflag)
        CASE (24)
	     CalcAns = IncompleteBeta(x, y, z)
      END SELECT
      !!! LOCATE 22, 5
      WRITE (*,*) ' ANSWER: ', CalcAns
      END !SUBROUTINE




      SUBROUTINE DisplayOptions()

      WRITE (*,*) '                Special Functions Demo Programs'
      WRITE (*,31) '1.  Log Gamma                  ',
     +             '13. Complement Error Function  '
      WRITE (*,31) '2.  Gamma                      ',
     +             '14. Error Function (Real)      '
      WRITE (*,31) '3.  Incomplete Gamma           ',
     +             '15. Error Function (Imaginary) '
      WRITE (*,31) '4.  Incomplete Gamma Complement',
     +             '16. Hermite Polynomial         '
      WRITE (*,31) '5.  Bessel                     ',
     +             '17. Legendre Polynomial        '
      WRITE (*,31) '6.  Tangent                    ',
     +             '18. LaGuerre Polynomial        '
      WRITE (*,31) '7.  Hyperbolic Cosine          ',
     +             '19. Modified Bessel of I       '
      WRITE (*,31) '8.  Hyperbolic Sine            ',
     +             '20. Modified Bessel of K       '
      WRITE (*,31) '9.  Hyperbolic Secant          ',
     +             '21. Jacobi Polynomial          '
      WRITE (*,31) '10. Hyperbolic ArcTangent      ',
     +             '22. Tchebyshev Polynomial      '
      WRITE (*,31) '11. Error Function (Iterative) ',
     +             '23. Beta                       '
      WRITE (*,31) '12. Error Function             ',
     +             '24. Incomplete Beta            '
      WRITE (*,31) '                               ',
     +             '25. END                        '
31    FORMAT (1X, A32,A32)
      WRITE (*,*)
     + ' Refer to Special Functions Chapter for function parameters'
      END !SUBROUTINE  DisplayOptions



      SUBROUTINE NumOfInputs (choice, InptNum)
      INTEGER choice, InptNum
      SELECT CASE (choice)
       CASE (1,2, 6,7,8,9,10,11,12,13)
	 InptNum = 1
       CASE (3,4,5, 14,15,16,17, 20, 22, 23)
	 InptNum = 2
       CASE (18, 19, 24)
	 InptNum = 3
       CASE (21)
	  InptNum = 4
      END SELECT
      END !SUBROUTINE


      SUBROUTINE ReadReals (InptNum, x, y, z, w)
      INTEGER InptNum
      REAL x, y, z, w
      WRITE (*,*)
     + ' Enter arguments in the order they appear in manual.       '
      WRITE (*,*) ' ENTER VALUES FOR :'
      WRITE (*,*)
     + '                                                              '
      WRITE (*,6) ' Parameter 1: '
      READ *, x
      IF (InptNum .GT. 1) THEN
        WRITE (*,6) 'Parameter 2:'
        READ *, y
        IF (InptNum .GT. 2) THEN
          WRITE (*,6) 'Parameter 3: '
          READ *, z
          IF (InptNum .EQ. 4) THEN
            WRITE (*,6) 'Parameter 4: '
            READ *, w
          END IF
        END IF
      END IF
      WRITE (*,*)
6     FORMAT (1X, A14\ )
      END !SUBROUTINE

