subroutine aptcrtr (x, p, r, np, nerr)

ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c                             SUBROUTINE APTCRTR
c
c     call aptcrtr (x, p, r, np, nerr)
c
c     Version:  aptcrtr  Updated    2003 August 4 16:50.
c               aptcrtr  Originated 2003 August 4 16:50.
c
c     Authors:  Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c     Purpose:  For an integer x, divide by the first np primes p, and find
c               the remainders r, such that np is the least number of primes
c               for which x is the least integer having those remainders.
c               Flag nerr indicates any input error.
c
c     Input:    x.
c
c     Output:   p, r, np, nerr.
c
c     Calls: (none) 
c
c     Glossary:
c
c     nerr      Output   Indicates an input error or incomplete result,
c                          if not zero:
c                          1 if x is less than 2.
c                          2 if x is greater than 304250263527210.
c
c     np        Output   The smallest number of p values for which the least
c                          integer with the same remainders is x.
c                          Will be 2 or more.
c
c     p(n)      Input    The first np primes.  Size up to 13.
c
c     r(n)      Input    The remainders from dividing x by the first np
c                          primes.  Size up to 13.
c
c     x         Input    The smallest integer that has a remainder of r(n)
c                          when divided by p(n), n = 1, np, with the smallest
c                          possible np.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.

c.... Declarations for arguments.

      integer nerr                    ! Indicates an error, if not zero.
      integer np                      ! The number of divisor-remainder pairs.
      integer p(1)                    ! An array of np divisors.  Allow 13.
      integer r(1)                    ! An array of np remainders.  Allow 13.
      integer x                       ! The desired integer.

c.... Declarations for local variables.

      integer n                       ! Index of a divisor, n = 1, np.
      integer nn                      ! Index of a divisor, n = 1, np - 1.

      integer pr(13)                  ! The first 13 prime numbers, pr(n).
      integer pp(13)                  ! The product of all primes up to n.

      data pr / 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41 / 

      data pp / 2, 6, 30, 210, 2310, 30030, 510510, 9699690, 223092870, 
     &          6469693230, 200560490130, 7420738134810, 
     &          304250263527210 /

cbugc***DEBUG begins.
cbug 9901 format (/ 'aptcrtr finding remainders for the Chinese',
cbug     &  ' Remainder Theorem.' / '  x =',i19 )
cbug 9902 format ('Divisor =',i9,'  Remainder =',i9)
cbug      write ( 3, 9901) x
cbugc***DEBUG ends.

c.... Initialize.

      nerr = 0

      do 110 n = 1, 13
        p(n) = -999999
        r(n) = -999999
  110 continue

c.... Test for input errors.

      if (x .lt. 2) then
        nerr = 1
        go to 210
      endif

      if (x .gt. pp(13)) then
        nerr = 2
        go to 210
      endif

c.... Find p and r, with an np for which x is the smallest solution.

      np = 0
      do 120 n = 1, 13
        np    = np + 1
        p(np) = pr(n)
        r(np) = mod (x, p(np))
        if (pp(n) .ge. x) go to 130
  120 continue
  130 continue

  210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptcrtr done.  nerr =',i2,'  np =',i3)
cbug 9904 format ('n =',i3,'  p(n) =',i3,'  r(n) =',i3)
cbug      write ( 3, 9903) nerr, np
cbug      if (np .ge. 2) then
cbug        write ( 3, 9904) (n, p(n), r(n), n = 1, np)
cbug      endif
cbugc***DEBUG ends.
      return

c.... End of subroutine aptcrtr.      (+1 line.)
      end

UCRL-WEB-209832