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