PROGRAM g08ahfe

!      G08AHF Example Program Text

!      Mark 23 Release. NAG Copyright 2011.

!      .. Use Statements ..
       USE nag_library, ONLY : g08ahf, g08ajf, g08akf, nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER              :: nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)              :: p, pexact, u, unor
       INTEGER                         :: ifail, liwrk, lwrk, lwrk1, lwrk2,    &
                                          lwrk3, mn, n1, n2, nsum
       LOGICAL                         :: ties
       CHARACTER (1)                   :: tail
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE :: ranks(:), wrk(:), x(:), y(:)
       INTEGER, ALLOCATABLE            :: iwrk(:)
!      .. Intrinsic Functions ..
       INTRINSIC                          int, max, min
!      .. Executable Statements ..
       WRITE (nout,*) 'G08AHF Example Program Results'
       WRITE (nout,*)

!      Skip heading in data file
       READ (nin,*)

!      Read in problem size
       READ (nin,*) n1, n2, tail

!      Calculate sizes of various workspaces
       nsum = n1 + n2
       mn = min(n1,n2)

!      Workspace for G08AHF
       lwrk1 = nsum

!      Workspace for G08AJF
       lwrk2 = int(n1*n2/2) + 1

!      Workspace for G08AKF
       lwrk3 = mn + mn*(mn+1)*nsum - mn*(mn+1)*(2*mn+1)/3 + 1
       liwrk = 2*nsum + 2

       lwrk = max(lwrk1,lwrk2,lwrk3)
       ALLOCATE (x(n1),y(n2),ranks(nsum),wrk(lwrk),iwrk(liwrk))

!      Read in data
       READ (nin,*) x(1:n1)
       READ (nin,*) y(1:n2)

!      Display title
       WRITE (nout,*) 'Mann-Whitney U test'
       WRITE (nout,*)

!      Display input data
       WRITE (nout,99999) 'Sample size of group 1 = ', n1
       WRITE (nout,99999) 'Sample size of group 2 = ', n2
       WRITE (nout,*)
       WRITE (nout,*) 'Data values'
       WRITE (nout,*)
       WRITE (nout,99998) '    Group 1  ', x(1:n1)
       WRITE (nout,*)
       WRITE (nout,99998) '    Group 2  ', y(1:n2)

!      Perform test
       ifail = 0
       CALL g08ahf(n1,x,n2,y,tail,u,unor,p,ties,ranks,wrk,ifail)

!      Calculate exact probabilities
       IF ( .NOT. ties) THEN
          ifail = 0
          CALL g08ajf(n1,n2,tail,u,pexact,wrk,lwrk,ifail)

       ELSE
          ifail = 0
          CALL g08akf(n1,n2,tail,ranks,u,pexact,wrk,lwrk,iwrk,ifail)
       END IF

!      Display results
       WRITE (nout,*)
       WRITE (nout,99997) 'Test statistic           = ', u
       WRITE (nout,99997) 'Normal Statistic         = ', unor
       WRITE (nout,99997) 'Approx. tail probability = ', p
       WRITE (nout,*)
       IF (ties) THEN
          WRITE (nout,*) 'There are ties in the pooled sample'
       ELSE
          WRITE (nout,*) 'There are no ties in the pooled sample'
       END IF
       WRITE (nout,*)
       WRITE (nout,99997) 'Exact tail probability   = ', pexact

99999  FORMAT (1X,A,I5)
99998  FORMAT (1X,A,8F5.1,2(/14X,8F5.1))
99997  FORMAT (1X,A,F10.4)
    END PROGRAM g08ahfe