subroutine aptmord (i, n, m, ir, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTMORD
c
c call aptmord (i, n, m, ir, nerr)
c
c Version: aptmord Updated 2003 September 4 17:30.
c aptmord Originated 2003 September 4 17:30.
c
c Authors: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: If the integers i and n have no common factors other than 1,
c find the order m of i modulo n, and the multiplicative inverse
c ir of i modulo n.
c
c Flag nerr indicates any input error or limited results.
c
c Input: i, n.
c
c Output: m, ir, nerr.
c
c Calls: aptpfac
c
c Glossary:
c
c i Input An integer in arithmetic modulo n.
c
c ir Output If integers i and n have no common factors other than
c 1, ir is the multiplicative inverse of i modulo n,
c that is, i * ir = 1 mod n.
c Also, ir = i^(m-1) mod n.
c If ir exists, it cannot exceed n - 1, and the
c multiplicative inverse of ir is i.
c Set to -999999999 if none exists.
c
c m Output If integers i and n have no common factors other than
c 1, m is the order of i mod n, that is, the least
c power of i such that i^m = 1 mod n.
c If m exists, it cannot exceed n - 1, and the
c multiplicative inverse ir is i^(m-1) mod n.
c Set to -999999999 if none exists.
c
c n Input The modulus for modular arithmetic. Must be > 1.
c
c nerr Output Indicates an error or no result, if not zero.
c -1 if i has no order in modulo n. m = -999999999.
c 0 if i has an order in modulo n.
c 1 if n < 2.
c 2 if error in aptpfac factoring n.
c 3 if error in aptpfac factoring i.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Declarations for arguments.
integer i ! An integer in arithmetic modulo n.
integer ir ! The multiplicative inverse of i.
integer m ! The order of i mudulo n.
integer n ! The modulus for mudular arithmetic.
integer nerr ! Error indicator, none if zero.
c.... Declarations for local variables.
integer ifacti(18) ! A prime factor of im.
integer ifactn(18) ! A prime factor of n.
integer im ! Normalized i, in range 1 to n - 1.
integer ipowi(18) ! Largest power of ifacti(n) dividing i.
integer ipown(18) ! Largest power of ifactn(n) dividing n.
integer iresi ! Unfactored residue of i.
integer iresn ! Unfactored residue of n.
integer j ! Index in arrays ifacti, ipowi.
integer k ! Index in arrays ifactn, ipown.
integer ncomm ! The number of factors im and n share.
integer nerrn ! Indicates aptpfac error, if not zero.
integer nerri ! Indicates aptpfac error, if not zero.
integer nfacti ! Number of prime factors of im found.
integer nfactn ! Number of prime factors of n found.
integer nfcomm(18) ! A factor i and n have in common.
integer npi ! Index in arrays ifacti, ipowi.
integer npn ! Index in arrays ifactn, ipown.
integer ntoti ! Euler's totient function for mod i.
integer ntotn ! Euler's totient function for mod n.
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptmord finding order and inverse of' /
cbug & ' integer',i12,' in modulus',i12 )
cbug write ( 3, 9901) i, n
cbugc***DEBUG ends.
c.... Initialize.
nerr = 0
m = -999999999
ir = -999999999
c.... Test for input errors.
if (n .lt. 2) then
nerr = 1
go to 210
endif
c.... Move i to the range from 0 to n - 1, if necessary, with new name im.
im = mod (i, n)
if (im .lt. 0) im = im + n
np = 1
imp = im
cbugcbugc***DEBUG begins.
cbugcbug 9801 format ('DEBUG. np =',i12,' imp =',i12)
cbugcbug write ( 3, 9801) np, imp
cbugcbug ntoti = -999999999
cbugcbug ntotn = -999999999
cbugcbugc***DEBUG ends.
c.... Find factors and Euler's totient function of n.
cbugcbugc***DEBUG begins.
cbugcbug 9921 format (/ 'aptpfac finding prime factors of n =',i12 )
cbugcbug write ( 3, 9921) n
cbugcbugc***DEBUG ends.
call aptpfac (n, 18, ifactn, ipown, nfactn, ntotn, iresn, nerrn)
cbugcbugc***DEBUG begins.
cbugcbug 9922 format (/ 'aptpfac found',i12,' factors. nerr =',i3,'.' )
cbugcbug 9923 format (' k =',i3,' ifactn(k) =',i22,'^',i2)
cbugcbug 9924 format (' Totient function n ',i12)
cbugcbug 9925 format (' Unfactored residue =',i12)
cbugcbug write ( 3, 9922) nfactn, nerrn
cbugcbug if (nfactn .gt. 0) then
cbugcbug write ( 3, 9923) (k, ifactn(k), ipown(k), k = 1, nfactn)
cbugcbug endif
cbugcbug write ( 3, 9924) ntotn
cbugcbug if (nerrn .eq. 3) then
cbugcbug write ( 3, 9925) iresn
cbugcbug endif
cbugcbugc***DEBUG ends.
if (nerrn .ne. 0) then
nerr = 2
go to 210
endif
c.... See if im = 0.
if (im .eq. 0) then
nerr = -1
go to 210
endif
c.... See if im = 1.
if (im .eq. 1) then
m = 1
ir = 1
go to 210
endif
c.... Find factors and Euler's totient function of i and n.
cbugcbugc***DEBUG begins.
cbugcbug 9911 format (/ 'aptpfac finding prime factors of i =',i12 )
cbugcbug write ( 3, 9911) i
cbugcbugc***DEBUG ends.
call aptpfac (i, 18, ifacti, ipowi, nfacti, ntoti, iresi, nerri)
cbugcbugc***DEBUG begins.
cbugcbug 9912 format (/ 'aptpfac found',i12,' factors. nerri =',i3,'.' )
cbugcbug 9913 format (' n =',i3,' ifacti(n) =',i22,'^',i2)
cbugcbug 9914 format (' Totient function i ',i12)
cbugcbug 9915 format (' Unfactored residue =',i12)
cbugcbug write ( 3, 9912) nfacti, nerri
cbugcbug if (nfacti .gt. 0) then
cbugcbug write ( 3, 9913) (j, ifacti(j), ipowi(j), j = 1, nfactn)
cbugcbug endif
cbugcbug write ( 3, 9914) ntoti
cbugcbug if (nerri .eq. 3) then
cbugcbug write ( 3, 9915) iresi
cbugcbug endif
cbugcbugc***DEBUG ends.
if (nerri .ne. 0) then
nerr = 3
go to 210
endif
c.... Find any common factors of n and im.
ncomm = 0
ndiff = 0
do 120 ki = 1, nfacti
do 110 kn = 1, nfactn
if (ifacti(ki) .eq. ifactn(kn)) then
ncomm = ncomm + 1
nfcomm(ncomm) = ifacti(ki)
endif
110 continue
120 continue
cbugcbugc***DEBUG begins.
cbugcbug 9331 format ('DEBUG common factors:' / (4i12))
cbugcbug if (ncomm .gt. 0) then
cbugcbug write ( 3, 9331) (nfcomm(kk), kk = 1, ncomm)
cbugcbug endif
cbugcbugc***DEBUG ends.
if (ncomm .ne. 0) then ! No order possible.
nerr = -1
go to 210
endif
c.... Find any order of im mod n.
do 150 np = 2, ntotn
implast = imp
imp = imp * im
imp = mod (imp, n)
cbugcbugc***DEBUG begins.
cbugcbug write ( 3, 9801) np, imp
cbugcbugc***DEBUG ends.
if (imp .eq. 1) then ! Found an order.
m = np
ir = implast
go to 210
endif
if (imp .eq. 0) then ! Repeating zero.
go to 210
endif
if (imp .eq. implast) then ! Repeating value not 1 or zero.
go to 210
endif
150 continue
210 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptmord results: nerr =',i3,
cbug & ' order =',i12,' inverse =',i12 )
cbug write ( 3, 9902) nerr, m, ir
cbugc***DEBUG ends.
return
c.... End of subroutine aptmord. (+1 line.)
end
UCRL-WEB-209832