      MODULE global_data
      integer                               :: crtin  =  5
      integer                               :: crtout =  6
      end module global_data

      MODULE tracking
      logical                                  debug
      integer                               :: pass   =  0
      integer                               :: push   =  1
      integer                               :: pop    = -1
      contains
      SUBROUTINE tell ( what, where )
      use global_data
      character*6,              intent(in ) :: what
      integer,                  intent(in ) :: where
      integer                               :: depth
      save depth
      if ( where .ne. pop ) then
           if ( where .eq. push ) depth = depth + 1
           if ( debug ) then
                write ( crtout,100,advance="NO" )
100             format ( ' ', "TELL: " )
                do i = 2, depth, 1
                   write ( crtout,200,advance="NO" )
200                format ( 6x )
                end do
                write ( crtout,300 ) what
300             format ( a6 )
           end if
      end if
      if ( where .eq. pop ) depth = depth - 1
      end subroutine tell
      end module tracking

      MODULE compute
      private
      public  :: wtest
      contains
      SUBROUTINE wtest ( raw, njudges,    mevents, &
                         w,   chi_square, ndf      )
!
!     Rewritten from IBM SYSTEM/360 SCIENTIFIC SUBROUTINE PACKAGE
!     PROGRAMMERS MANUAL, Version 3, Program 360A-CM-03X,
!     Publication GH-20-0205-4, Page 76
!
      use global_data
      use tracking
      real                                            :: avr_rank
      real,                               intent(out) :: chi_square
      integer,                            intent(in ) :: mevents
      integer,                            intent(out) :: ndf
      integer,                            intent(in ) :: njudges
      integer                                         :: nm
      real,   dimension(njudges*mevents)              :: ranked
      real,   dimension(njudges*mevents), intent(in ) :: raw
      real                                            :: rm
      real                                            :: rn
      real                                            :: t
      real                                            :: ties
      real,                               intent(out) :: w
      real,   dimension(mevents)                      :: work
      character* 6                                    :: name
      name  = 'wtest'
      call tell ( name, push )
      nm = njudges * mevents
      rm = real(mevents)
      rn = real(njudges)
      t  = 0.0
!
!     Rank the scores on the M events for each of N judges.
      do i = 1, njudges, 1
!
!        Rank the M scores for the I-th judge.
         call rank ( raw(i:nm:njudges),    &   
                     ranked(i:nm:njudges), &
                     mevents               )
         call tell ( name, pass )
!
!        Compute correction for ties.
         call tie  ( ranked(i:nm:njudges), mevents, ties )
         call tell ( name, pass )
!
!        Keep a running count of the number of ties.
         t = t + ties
      end do
!
!     Sum the ranked scores given by each of the N judges
!     for the M events.  WORK(J) will be the total ranked
!     scores for the J-th of M events over all N judges.
!     Note that WORK is an automatic array.  It is declared
!     in this procedure and storage is automatically
!     created and discarded when this procedure exits.
      work = 0.0
      do j = 1, mevents, 1
         work(j) = sum ( ranked(1+(njudges*(j-1)):njudges*j) )
      end do
!
!     Compute the average rank assigned to events.
      avr_rank = sum ( work ) / rm
!
!     Square the difference between the sum of ranks
!     for an event and the average rank assigned to
!     events (i.e., a "sum of squared differences").
      s = dot_product ( work-avr_rank, work-avr_rank )
!
!     Complete the somputation of concordance and Chi-square
!     (from Siegal, 1956, Eqs. 9.15 and 9.17, pages 231
!     and 236, repectively).
      w   = s / ( ( ( rn*rn ) * ( rm*rm*rm - rm ) / 12.0 ) - rn*t)
      if ( mevents .gt. 7 ) then
           chi_square = rn * ( rm - 1.0 ) * w
           ndf        = mevents - 1
      else
           chi_square = 0.0
           ndf        = 0
      end if
      call tell ( name, pop )
      end subroutine wtest
      SUBROUTINE rank ( raw_scores, ranked_scores, mevents )
!
!     Rewritten from IBM SYSTEM/360 SCIENTIFIC SUBROUTINE PACKAGE
!     PROGRAMMERS MANUAL, Version 3, Program 360A-CM-03X,
!     Publication GH-20-0205-4, Page 71.
!
      use global_data
      use tracking
      integer                                   :: assigned
      integer                                   :: equal
      integer,                      intent(in ) :: mevents
      integer, dimension (1)                    :: min_location
      real                                      :: min_score
      real,    dimension (mevents), intent(out) :: ranked_scores
      real,    dimension (mevents), intent(in ) :: raw_scores
      integer                                   :: small
      real                                      :: split
      character* 6                              :: name
      name  = 'rank'
      call tell ( name, push )
!
!     Initialize the rank vector, find the smallest score,
!     and initialize the number of ranks assigned.
      ranked_scored = 0.0
      min_score     = minval ( raw_scores )
      assigned      = 0
!
!     Examine every score.  Because of ties, perhaps less than
!     MEVENTS examinations need to be made but no MORE than
!     MEVENTS examinations will ever be needed.
      do i = 1, mevents, 1
!
!        A rank is assigned to a give score in RAW_SCORES
!        based on the number of scores it beats or ties.
!        So, count the scores less than or equal to the
!        target value.
         small = count ( raw_scores .lt. min_score )
         equal = count ( raw_scores .eq. min_score )
!
!        If a score is unique, then its rank is one more
!        than the number of scores less than it.  Note that
!        MINLOC is used to find out the matrix location of
!        the smallest value.  Recall that it returns an
!        array, not a scalar value.  That's why there has
!        to be an array, MIN_LOCATION, that only holds one
!        element to receive the result of MINLOC.
         if ( equal .eq. 1 ) then
              min_location = minloc( raw_scores,            &
                             MASK = raw_scores.eq.min_score )
              ranked_scores(min_location) = small + 1
!
!        If a score is not unique (i.e., tied with one or
!        more other scores), then its rank is "split" among
!        it and the other events receiving the same score.
!        As always in Fortran, the presence of a floating-
!        point value on one side of an operator causes the
!        integer on the other side to be converted to a
!        floating point number so that the results are
!        precise.  Thus, the 0.5 causes (EQUAL+1) to be
!        converted to a real number, and then SMALL in its
!        turn is also converted to a real number.
         else
              split = small + ( ( equal + 1 ) * 0.5 )
              where ( raw_scores .eq. min_score )
                      ranked_scores = split
              end where
         end if
!
!        Determine the next larger score.
         min_score=minval(raw_scores,MASK=raw_scores.gt.min_score)
!
!        Note that the limit of the DO loop, MEVENTS, may not
!        be reached.  Due to ties, all ranks might be assigned
!        before MEVENTS evaluations are required.  That is why
!        this DO loop is terminated when all ranks have been
!        assigned rather han when MEVENTS comparisions have
!        been made.
         assigned = assigned + equal
         if ( assigned .ge. mevents ) exit
      end do
      call tell ( name, pop )
      end subroutine rank
      SUBROUTINE tie ( ranked_scores, mevents, ties )
!
!     Rewritten from IBM SYSTEM/360 SCIENTIFIC SUBROUTINE PACKAGE
!     PROGRAMMERS MANUAL, Version 3, Program 360A-CM-03X,
!     Publication GH-20-0205-4, Page 74.
!
      use global_data
      use tracking
      integer                                   :: assigned
      integer                                   :: equal_ranks
      integer,                      intent(in ) :: mevents
      real,    dimension (mevents), intent(in ) :: ranked_scores
      real,                         intent(out) :: ties
      real                                      :: min_rank
      character* 6                              :: name
      name  = 'tie'
      call tell ( name, push )
!
!     Initialize the tie correction, find the smallest rank,
!     and initialize the number of ranks examined.
      ties     = 0.0
      min_rank = minval ( ranked_scores )
      assigned = 0
!
!     Examine every rank.  Because of ties, perhaps less than
!     M examinations need to be made but no MORE than M
!     examinations will ever be needed.
      do i = 1, mevents, 1
!
!        Count the number of ranks equal to the target rank.
!        Here, the COUNT intrinsic is very handy.
         equal_ranks = count ( ranked_scores .eq. min_rank )
!
!        Compute the correction for ties.  Note that if this
!        rank is unique (i.e., EQUAL_RANKS=1), then the entire
!        term in parenthesis is zero and does not contribute to
!        the correction for ties.  The correction, TIES, has
!        these values for different values of EQUAL_RANKS:
!        TIES is 0 for EQUAL_RANKS of 1, 0.5 for EQUAL_RANKS
!        of 2, 2.0 for 3, 5.0 for 4, 17.5 for 6, 28.0 for 7, etc.
         ties = ties+(((equal_ranks*equal_ranks*equal_ranks) -   &
                                                equal_ranks)/12.0)
!
!        Find the next larger rank.
         min_rank = minval ( ranked_scores,                   &
                             MASK = ranked_scores.gt.min_rank )
!
!        Note that the limit of the DO loop, MEVENTS, may not
!        be reached.  Due to ties, all ranks might be assigned
!        before MEVENTS evaluations are required.  That is why
!        this DO loop is terminated when all ranks have been
!        assigned rather han when MEVENTS comparisions have
!        been made.
         assigned = assigned + equal_ranks
         if ( assigned .ge. mevents ) exit
      end do
      call tell ( name, pop )
      end subroutine tie
      end module compute

      MODULE program_data
      integer                                  MAXUNT
      parameter                              ( MAXUNT=10 )
      real                                     chisqr
      integer                                  degfre
      character* 6, dimension(:  ), pointer :: ename
      integer                                  events
      character*14                             ifile
      integer                                  iunit
      integer                                  io
      character* 6, dimension(:  ), pointer :: jname
      integer                                  judges
      real                                     kendal
      logical                                  mistak
      character*14                             ofile
      integer                                  ounit
      real,         dimension(:,:), pointer :: scores
      logical                                  units(MAXUNT)
      end module program_data

      MODULE program_interface
      interface
        subroutine driver
          end subroutine driver
        subroutine error
          end subroutine error
        subroutine finish
          end subroutine finish
        subroutine init
          end subroutine init
        subroutine input
          end subroutine input
        subroutine kencon
          end subroutine kencon
        subroutine limits
          end subroutine limits
        subroutine result
          end subroutine result
        subroutine start
          end subroutine
      end interface
      end module program_interface
