C A problem proposed by Paul D Hanna: Find matrices with C minimum or maximum absolute determinant with elements 1..n^2 C Start with a(1,1)=1 C Build successive nXn matrices by fixing previous (n-1)X(n-1) C matrix and adding matrix elements (n-1)^2+1..n^2 on lower and right C border of matrix. C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. C Version history: C Oct 13 2003 Calculate determinant with Linpack functions DGEFA, DGEDI C compute all terms at once C Oct 10 2003 Initial version C...+....1....+....2....+....3....+....4....+....5....+....6....+....7.. C This file: http://www.randomwalk.de/sequences/detext.txt C implicit integer (a-z) C Adjust final problem dimension nmax parameter (nmax=7,nnm=nmax*nmax,nrm=nmax+nmax-1) C dimension a(nmax,nmax), b(nmax,nmax), c(nrm), ipvt(nmax) doubleprecision d, dm doubleprecision AA(nmax,nmax), work(nmax), det(2) C C Initial 2*2 matrix a(1,1) = 1 a(2,1) = 3 a(1,2) = 4 a(2,2) = 2 C Big loop over matrix dimensions do 500 n = 3, nmax nn = n * n C Number of new matrix elements (bottom row+right column) nr = n + n - 1 C Best value of determinant found so far dm = 0.0D0 C Counter for multiple solutions mult = 0 C C Create matrix elements to be permuted l = 0 do 10 i = (n-1)*(n-1)+1, nn l = l + 1 c(l) = i 10 continue C C loop over all permutations 20 continue l = 0 C Add permuted elements to bottom and right border do 21 i = 1, n l = l + 1 a(i,n) = c(l) 21 continue do 22 i = 1, n-1 l = l + 1 a(n,i) = c(l) 22 continue C Copy to doubleprecision work array do 31 j = 1, n do 31 i = 1, n aa(i,j) = dble(a(i,j)) 31 continue C C Determinant (using Linpack subroutines) C Source: http://www.netlib.org/linpack/dgefa.f call dgefa ( aa, nmax, n, ipvt, info ) C Source: http://www.netlib.org/linpack/dgedi.f call dgedi ( aa, nmax, n, ipvt, det, work, 10 ) d = det(1) * 10.0D0**det(2) C C Check for improvement if ( abs(d) .ge. dm ) then if ( abs(d) .gt. dm ) mult = 0 mult = mult + 1 C Print improved determinant write (*,*) d, mult C Print corresponding matrix write (*,1000) ((a(j,i),j=1,n),i=1,n) 1000 format ( 25I3,:,/,25I3) C Save best solution dm = abs(d) do 40 i = 1, n b(i,n) = a(i,n) b(n,i) = a(n,i) 40 continue endif C Create next permutation C Source: http://www.randomwalk.de/sequences/lpg.txt call lpg ( nr, c, next ) C Check for end criterion if ( next .ne. 0 ) goto 20 C all permutations done, restore best solution. do 50 i = 1, n a(i,n) = b(i,n) a(n,i) = b(n,i) 50 continue C End of loop over n 500 continue end