subroutine aptcomb (nset, ncomb, ncombm, icomb, nout, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTCOMB
c
c call aptcomb (nset, ncomb, ncombm, icomb, nout, nerr)
c
c Version: aptcomb Updated 1993 April 30 13:10.
c aptcomb Originated 1993 April 30 13:10.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To generate all possible combinations of the integers from 1 to
c nset, taken ncomb at a time, storing the results in the 2-D
c array icomb, which has a first (row) dimension of ncombm.
c The number of combinations nout is given by:
c nout = nset! / ((nset - ncomb)! * ncomb!)
c Flag nerr indicates any input errors.
c
c Note: For permutations, see aptperm.
c
c Input: nset, ncomb, ncombm
c
c Output: icomb, nout, nerr.
c
c Glossary:
c
c icomb Output The nout subsets of combined integers.
c A 2-D array, icomb(ncomb,noutm), where noutm must be
c at least as large as nout.
c The first subscript is the position within the
c subset. The second subscript is the index of the
c subset. The value of each icomb is an integer
c between 1 and nset. No integer may be used more than
c once in a subset. All integers in a subset are in
c increasing order of value.
c
c nerr Output Indicates an input error, if not 0.
c 1 if nset is less than 1.
c 2 if ncomb is less than 1, or exceeds nset.
c 3 if ncombm is less than ncomb.
c
c nout Output The number of subsets of combined integers.
c Should equal nset! / ((nset - ncomb)! * ncomb!).
c
c ncomb Input The number of integers in each subset of integers.
c Each subset will be a unique combination of integers.
c The current upper limit is 13. Must not be less than
c 1, or greater than nset.
c
c nset Input Total number of integers. Must not be less than 1, or
c less than ncomb. The integer values range from 1 to
c nset.
c
c ncombm Input The row size of 2-D array icomb. Must not be less than
c ncomb.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- Subsets of combined integers.
dimension icomb (ncombm,1)
c.... Local variables.
c---- Trial integer.
common /laptcomb/ icombx(13)
c---- Position index in a subset of integers.
common /laptcomb/ n
c---- Position index in a subset of integers.
common /laptcomb/ nn
c---- Trial integer for position 1.
common /laptcomb/ n1
c---- Trial integer for position 2.
common /laptcomb/ n2
c---- Trial integer for position 3.
common /laptcomb/ n3
c---- Trial integer for position 4.
common /laptcomb/ n4
c---- Trial integer for position 5.
common /laptcomb/ n5
c---- Trial integer for position 6.
common /laptcomb/ n6
c---- Trial integer for position 7.
common /laptcomb/ n7
c---- Trial integer for position 8.
common /laptcomb/ n8
c---- Trial integer for position 9.
common /laptcomb/ n9
c---- Trial integer for position 10.
common /laptcomb/ n10
c---- Trial integer for position 11.
common /laptcomb/ n11
c---- Trial integer for position 12.
common /laptcomb/ n12
c---- Trial integer for position 13.
common /laptcomb/ n13
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptcomb finding combinations of integers' /
cbug & ' nset=',i5,' ncomb=',i4,' ncombm=',i4)
cbug write ( 3, 9901) nset, ncomb, ncombm
cbugc***DEBUG ends.
c.... initialize.
nerr = 0
nout = 0
c.... Test for input errors.
if (nset .le. 0) then
nerr = 1
go to 210
endif
if ((ncomb .le. 0) .or. (ncomb .gt. nset)) then
nerr = 2
go to 210
endif
if (ncombm .lt. ncomb) then
nerr = 3
go to 210
endif
c.... Generate all of the subsets of integers.
c.... Select object 1.
do 501 n1 = 1, nset - ncomb + 1
n = 1
icombx(n) = n1
if (n .eq. ncomb) then
nout = nout + 1
do 301 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
301 continue
go to 501
endif
c.... Select object 2.
do 502 n2 = n1 + 1, nset
n = 2
icombx(n) = n2
if (n .eq. ncomb) then
nout = nout + 1
do 302 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
302 continue
go to 502
endif
c.... Select object 3.
do 503 n3 = n2 + 1, nset
n = 3
icombx(n) = n3
if (n .eq. ncomb) then
nout = nout + 1
do 303 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
303 continue
go to 503
endif
c.... Select object 4.
do 504 n4 = n3 + 1, nset
n = 4
icombx(n) = n4
if (n .eq. ncomb) then
nout = nout + 1
do 304 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
304 continue
go to 504
endif
c.... Select object 5.
do 505 n5 = n4 + 1, nset
n = 5
icombx(n) = n5
if (n .eq. ncomb) then
nout = nout + 1
do 305 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
305 continue
go to 505
endif
c.... Select object 6.
do 506 n6 = n5 + 1, nset
n = 6
icombx(n) = n6
if (n .eq. ncomb) then
nout = nout + 1
do 306 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
306 continue
go to 506
endif
c.... Select object 7.
do 507 n7 = n6 + 1, nset
n = 7
icombx(n) = n7
if (n .eq. ncomb) then
nout = nout + 1
do 307 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
307 continue
go to 507
endif
c.... Select object 8.
do 508 n8 = n7 + 1, nset
n = 8
icombx(n) = n8
if (n .eq. ncomb) then
nout = nout + 1
do 308 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
308 continue
go to 508
endif
c.... Select object 9.
do 509 n9 = n8 + 1, nset
n = 9
icombx(n) = n9
if (n .eq. ncomb) then
nout = nout + 1
do 309 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
309 continue
go to 509
endif
c.... Select object 10.
do 510 n10 = n9 + 1, nset
n = 10
icombx(n) = n10
if (n .eq. ncomb) then
nout = nout + 1
do 310 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
310 continue
go to 510
endif
c.... Select object 11.
do 511 n11 = n10 + 1, nset
n = 11
icombx(n) = n11
if (n .eq. ncomb) then
nout = nout + 1
do 311 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
311 continue
go to 511
endif
c.... Select object 12.
do 512 n12 = n11 + 1, nset
n = 12
icombx(n) = n12
if (n .eq. ncomb) then
nout = nout + 1
do 312 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
312 continue
go to 512
endif
c.... Select object 13.
do 513 n13 = n12 + 1, nset
n = 13
icombx(n) = n13
if (n .eq. ncomb) then
nout = nout + 1
do 313 nn = 1, ncomb
icomb(nn,nout) = icombx(nn)
313 continue
go to 513
endif
513 continue
512 continue
511 continue
510 continue
509 continue
508 continue
507 continue
506 continue
505 continue
504 continue
503 continue
502 continue
501 continue
210 continue
cbugc***DEBUG begins.
cbug 9902 format (/ 'aptcomb results. nerr=',i3)
cbug 9903 format (i6,3x,13i3)
cbug write ( 3, 9902) nerr
cbug if (nerr .ne. 0) return
cbug do 710 n2 = 1, nout
cbug write ( 3, 9903) n2, (icomb(n1,n2), n1 = 1, ncomb)
cbug 710 continue
cbugc***DEBUG ends.
return
c.... End of subroutine aptcomb. (+1 line.)
end
UCRL-WEB-209832