subroutine aptperf (n, m, tol, nperm, perm, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTPERF
c
c     call aptperf (n, m, tol, nperm, perm, nerr)
c
c     Version:  aptperf  Updated    2005 September 13 14:40.
c               aptperf  Originated 2001 November 28 16:00.
c
c     Author:   Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  to find P(n,m), the number of permutations of n things taken
c               m at a time, and return the integer and floating point values
c               of P(n,m), nperm and perm, respectively.
c
c     Note:     The formula is P(n,m) = nperm = perm = n! / (n - m)!,
c               or P(n,m) = (n - m + 1) * (n - m + 2) * ... * (n - 1) * n.
c
c     Input:    n, tol.
c
c     Output:   nperm, perm, nerr.
c
c     Glossary:
c
c     perm      Output   The floating point value of n! / (n - m)!.
c                          If n < 0, returned as -1.e99, with nerr = 1.
c                          WARNING:  may overflow largest machine floating point
c                          number, if n is too large.
c
c     n         Input    Total number of things selected from.
c
c     nerr      Output   Indicates an input or result error, if not zero.
c                          -1 if nperm exceeds the largest machine integer.
c                           1 if n < 0.
c                           2 if m < 0, or m > n.
c
c     nperm     Output   The integer value of n! / (n - m)!.
c                          If n < 0, returned as -999999, with nerr = 1.
c                          If larger then the largest machine integer,
c                          returned as -999999, with nerr = -1, but perm will
c                          still be accurate, unless perm overflows the largest
c                          machine floating point number.
c
c     m         Input    The number of things selected out of n, for each
c                          permutation.
c
c     tol       Input    The precision with which nperm and perm must agree,
c                          to insure that nperm does not exceed the largest
c                          machine integer.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

      implicit none

c.... Arguments.

      integer  n                      ! Total number of things.
      integer  nerr                   ! Error indicator.
      integer  nperm                  ! Integer value of n! / (n - m)!.
      integer  m                      ! Items taken out of n, each permutation.

      real     perm                   ! Real value of n! / (n - m)!.
      real     tol                    ! Reqired precision of perm, nperm match.


c.... Local variables.

      integer  nbeg                   ! n - m + 1.
      integer  nn                     ! Index, nbeg to n.

      real     fnn                    ! Real value of nn.
      real     fnperm                 ! Real value of nperm.

cbugc***DEBUG begins.
cbug 9001 format (/ 'aptperf finding permutations of (',i20,',',i20,').' /
cbug     &  'tol = ',1pe22.14)
cbug      write ( 3, 9001) n, m, tol
cbugc***DEBUG ends.

c.... Initialize.

      nerr   = 0
      nperm  = -999999
      fnperm = -999999.0
      perm   = -1.e99

c.... Test for errors, limits.

      if (n .lt. 0) then
        nerr = 1
        go to 210
      endif

      if ((m .lt. 0)  .or. (m .gt. n)) then
        nerr = 2
        go to 210
      endif

c.... Find number of permutations of n things taken m at a time.

      nperm  = 1
      fnperm = 1.0
      perm   = 1.0

      if (m .eq. n) go to 210

      if (n .gt. 1) then

        nbeg = n - m + 1

        do 110 nn = nbeg, n
          nperm = nperm * nn
          fnn   = nn
          perm  = perm * fnn
  110   continue

        fnperm = nperm
        if (abs (fnperm - perm) .gt. tol * perm) then
          nerr = -1
          nperm = -999999
        endif

      endif                           ! Tested n.

  210 continue
cbugc***DEBUG begins.
cbug 9002 format (/ 'aptperf found # of permutations.  nerr = ',i3 /
cbug     &  'np, fnp, chk =',i20,2x,1p2e22.14)
cbug      write ( 3, 9002) nerr, nperm, perm, fnperm
cbugc***DEBUG ends.

      return

      end

UCRL-WEB-209832