subroutine aptfact (n, tol, nfact, fact, nerr) ccbeg. cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c SUBROUTINE APTFACT c c call aptfact (n, tol, nfact, fact, nerr) c c Version: aptfact Updated 2003 August 20 18:00. c aptfact Originated 2003 August 20 18:00. c c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123. c c c Purpose: For argument n, to find the integer and floating point values c of n factorial (n!), nfact and fact, respectively. c c Input: n, tol. c c Output: nfact, fact, nerr. c c Glossary: c c fact Output The floating point value of n factorial (n!). 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 For example: 170! = 7.25741561530799+306. c c n Input Argument of factorial function, n!. c c nerr Output Indicates an input or result error, if not zero. c -1 if nfact exceeds the largest machine integer. c 1 if n < 0. c c nfact Output The integer value of n!. 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 fact will c still be accurate, unless fact overflows the largest c machine floating point number. c c tol Input The precision with which nfact and fact must agree, c to insure that nfact does not exceed the largest c machine integer. c cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc ccend. implicit none c.... Arguments. integer n ! Argument of factorial. integer nerr ! Error indicator. integer nfact ! Integer value of factorial of n. real fact ! Real value of factorial of n. real tol ! Reqired precision of fact, nfact match. c.... Local variables. integer nn ! Index, 2 to n. real fnn ! Real value of nn. real fnfact ! Real value of nfact. cbugc***DEBUG begins. cbug 9001 format (/ 'aptfact finding factorial of ',i6,'. tol = ',1pe22.14) cbug write ( 3, 9001) n, tol cbugc***DEBUG ends. c.... Initialize. nerr = 0 nfact = -999999 fnfact = -999999.0 fact = -1.e99 c.... Test for errors, limits. if (n .lt. 0) then nerr = 1 go to 210 endif c.... Find factorial of n. nfact = 1 fnfact = 1.0 fact = 1.0 if (n .gt. 1) then ! Find factorial of positive integer. do 110 nn = 2, n nfact = nfact * nn fnn = nn fact = fact * fnn 110 continue fnfact = nfact if (abs (fnfact - fact) .gt. tol * fact) then nerr = -1 nfact = -999999 endif endif ! Tested n. 210 continue cbugc***DEBUG begins. cbug 9002 format (/ 'aptfact found factorial. nerr = ',i3 / cbug & 'n!, fn!, chk =',i20,2x,1p2e22.14) cbug write ( 3, 9002) nerr, nfact, fact, fnfact cbugc***DEBUG ends. return c.... End of subroutine aptfact. (+1 line.) end UCRL-WEB-209832