!*************************************************************
!*                STUDENT  T-PROBABILITY  LAW                *
!* --------------------------------------------------------- *
!* SAMPLE RUN:                                               *
!* (Calculate Student T-probability (lower tail and upper    *
!*  tail) for T=0.257).                                      *
!*                                                           *
!*  X=  0.2570000                                            *
!*  PROB1=  0.6000293                                        *
!*  ERROR=           0                                       *
!*  X=  0.2570000                                            *
!*  PROB2=  0.3999705                                        *
!*  ERROR=           0                                       *
!*  PROB1+PROB2=  0.9999999                                  *
!*                                                           *
!* --------------------------------------------------------- *
!* Ref.:"JOURNAL OF APPLIED STATISTICS (1968) VOL.17, P.189, *
!*       & VOL.19, NO.1".                                    *
!*                                                           *
!*                        F90 Release By J-P Moreau, Paris.  *
!*                               (www.jpmoreau.fr)           *
!*************************************************************
PROGRAM STUDENT

  REAL X,XNU,PROB1,PROB2
  INTEGER NU, ERROR

  X=0.257
  NU=19

  PROB1=PROBST(X,NU,ERROR)
  print *,' '
  print *,' X=', X
  print *,' PROB1=', PROB1
  print *,' ERROR=', ERROR

  X=0.257
  XNU=19.0

  PROB2=STUDNT(X,XNU,ERROR)
  print *,' X=', X
  print *,' PROB2=', PROB2
  print *,' ERROR=', ERROR

  print *,' PROB1+PROB2=', PROB1+PROB2
  print *,' '

END !of main program


      REAL FUNCTION PROBST(T, IDF, IFAULT)
! ---------------------------------------------------------------------
!        ALGORITHM AS 3  APPL. STATIST. (1968) VOL.17, P.189
!
!        STUDENT T PROBABILITY (LOWER TAIL)
! ---------------------------------------------------------------------
      REAL A, B, C, F, G1, S, FK, T, ZERO, ONE, TWO, HALF, ZSQRT, ZATAN

!        G1 IS RECIPROCAL OF PI

      DATA ZERO, ONE, TWO, HALF, G1  /0.0, 1.0, 2.0,  0.5, 0.3183098862/

      ZSQRT(A) = SQRT(A)
      ZATAN(A) = ATAN(A)

      IFAULT = 1
      PROBST = ZERO
      IF (IDF .LT. 1) RETURN
      IFAULT = 0
      F = IDF
      A = T / ZSQRT(F)
      B = F / (F + T ** 2)
      IM2 = IDF - 2
      IOE = MOD(IDF, 2)
      S = ONE
      C = ONE
      F = ONE
      KS = 2 + IOE
      FK = KS
      IF (IM2 .LT. 2) GOTO 20
      DO 10 K = KS, IM2, 2
      C = C * B * (FK - ONE) / FK
      S = S + C
      IF (S .EQ. F) GOTO 20
      F = S
      FK = FK + TWO
   10 CONTINUE
   20 IF (IOE .EQ. 1) GOTO 30
      PROBST = HALF + HALF * A * ZSQRT(B) * S
      RETURN
   30 IF (IDF .EQ. 1) S = ZERO
      PROBST = HALF + (A * B * S + ZATAN(A)) * G1
      RETURN
      END

      REAL FUNCTION STUDNT (T, DOFF, IFAULT)
! ----------------------------------------------------------------
!     ALGORITHM AS 27  APPL. STATIST. VOL.19, NO.1
!
!     Calculate the upper tail area under Student's t-distribution
!
!     Translated from Algol by Alan Miller
! ----------------------------------------------------------------
      INTEGER IFAULT
      REAL T, DOFF

!     Local variables

      REAL V, X, TT, TWO, FOUR, ONE, ZERO, HALF
      REAL A1, A2, A3, A4, A5, B1, B2,  &
           C1, C2, C3, C4, C5, D1, D2,  &
           E1, E2, E3, E4, E5, F1, F2,  &
           G1, G2, G3, G4, G5, H1, H2,  &
           I1, I2, I3, I4, I5, J1, J2
      LOGICAL POS
      DATA TWO /2.0/, FOUR /4.0/, ONE /1.0/, ZERO /0.0/, HALF /0.5/
      DATA A1, A2, A3, A4, A5 /0.09979441, -0.581821, 1.390993,      &
           -1.222452, 2.151185/, B1, B2 /5.537409, 11.42343/
      DATA C1, C2, C3, C4, C5 /0.04431742, -0.2206018, -0.03317253,  &
           5.679969, -12.96519/, D1, D2 /5.166733, 13.49862/
      DATA E1, E2, E3, E4, E5 /0.009694901, -0.1408854, 1.88993,     &
           -12.75532, 25.77532/, F1, F2 /4.233736, 14.3963/
      DATA G1, G2, G3, G4, G5 /-9.187228E-5, 0.03789901, -1.280346,  &
           9.249528, -19.08115/, H1, H2 /2.777816, 16.46132/
      DATA I1, I2, I3, I4, I5 /5.79602E-4, -0.02763334, 0.4517029,   &
           -2.657697, 5.127212/, J1, J2 /0.5657187, 21.83269/

!     Check that number of degrees of freedom > 4.

      IF (DOFF .LT. TWO) THEN
	    IFAULT = 1
	    STUDNT = - ONE
	    RETURN
      END IF

      IF (DOFF .LE. FOUR) THEN
	    IFAULT = DOFF
      ELSE
	    IFAULT = 0
      END IF

!     Evaluate series.

      V = ONE / DOFF
      POS = (T .GE. ZERO)
      TT = ABS(T)
      X = HALF * (ONE +   &
          TT * (((A1 + V * (A2 + V * (A3 + V * (A4 + V * A5)))) /  &
              (ONE - V * (B1 - V * B2))) +   &
          TT * (((C1 + V * (C2 + V * (C3 + V * (C4 + V * C5)))) /  &
              (ONE - V * (D1 - V * D2))) +   &
          TT * (((E1 + V * (E2 + V * (E3 + V * (E4 + V * E5)))) /  &
              (ONE - V * (F1 - V * F2))) +   &
          TT * (((G1 + V * (G2 + V * (G3 + V * (G4 + V * G5)))) /  &
              (ONE - V * (H1 - V * H2))) +   &
          TT * ((I1 + V * (I2 + V * (I3 + V * (I4 + V * I5)))) /   &
              (ONE - V * (J1 - V * J2))) ))))) ** (-8)
      IF (POS) THEN
	    STUDNT = X
      ELSE
	    STUDNT = ONE - X
      END IF

      RETURN
      END

!end of file Student.f90