1       SUBROUTINE SLAHILB(N, NRHS, A, LDA, X, LDX, B, LDB, WORK, INFO)
  2 !
  3 !  -- LAPACK auxiliary test routine (version 3.0) --
  4 !     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
  5 !     Courant Institute, Argonne National Lab, and Rice University
  6 !     28 August, 2006
  7 !
  8 !     David Vu <dtv@cs.berkeley.edu>      
  9 !     Yozo Hida <yozo@cs.berkeley.edu>      
 10 !     Jason Riedy <ejr@cs.berkeley.edu>
 11 !     D. Halligan <dhalligan@berkeley.edu>
 12 !
 13       IMPLICIT NONE
 14 !     .. Scalar Arguments ..
 15       INTEGER N, NRHS, LDA, LDX, LDB, INFO
 16 !     .. Array Arguments ..
 17       REAL A(LDA, N), X(LDX, NRHS), B(LDB, NRHS), WORK(N)
 18 !     ..
 19 !
 20 !  Purpose
 21 !  =======
 22 !
 23 !  SLAHILB generates an N by N scaled Hilbert matrix in A along with
 24 !  NRHS right-hand sides in B and solutions in X such that A*X=B.
 25 !
 26 !  The Hilbert matrix is scaled by M = LCM(1, 2, ..., 2*N-1) so that all
 27 !  entries are integers.  The right-hand sides are the first NRHS 
 28 !  columns of M * the identity matrix, and the solutions are the 
 29 !  first NRHS columns of the inverse Hilbert matrix.
 30 !
 31 !  The condition number of the Hilbert matrix grows exponentially with
 32 !  its size, roughly as O(e ** (3.5*N)).  Additionally, the inverse
 33 !  Hilbert matrices beyond a relatively small dimension cannot be
 34 !  generated exactly without extra precision.  Precision is exhausted
 35 !  when the largest entry in the inverse Hilbert matrix is greater than
 36 !  2 to the power of the number of bits in the fraction of the data type
 37 !  used plus one, which is 24 for single precision.  
 38 !
 39 !  In single, the generated solution is exact for N <= 6 and has
 40 !  small componentwise error for 7 <= N <= 11.
 41 !
 42 !  Arguments
 43 !  =========
 44 !
 45 !  N       (input) INTEGER
 46 !          The dimension of the matrix A.
 47 !      
 48 !  NRHS    (input) NRHS
 49 !          The requested number of right-hand sides.
 50 !
 51 !  A       (output) REAL array, dimension (LDA, N)
 52 !          The generated scaled Hilbert matrix.
 53 !
 54 !  LDA     (input) INTEGER
 55 !          The leading dimension of the array A.  LDA >= N.
 56 !
 57 !  X       (output) REAL array, dimension (LDX, NRHS)
 58 !          The generated exact solutions.  Currently, the first NRHS
 59 !          columns of the inverse Hilbert matrix.
 60 !
 61 !  LDX     (input) INTEGER
 62 !          The leading dimension of the array X.  LDX >= N.
 63 !
 64 !  B       (output) REAL array, dimension (LDB, NRHS)
 65 !          The generated right-hand sides.  Currently, the first NRHS
 66 !          columns of LCM(1, 2, ..., 2*N-1) * the identity matrix.
 67 !
 68 !  LDB     (input) INTEGER
 69 !          The leading dimension of the array B.  LDB >= N.
 70 !
 71 !  WORK    (workspace) REAL array, dimension (N)
 72 !
 73 !
 74 !  INFO    (output) INTEGER
 75 !          = 0: successful exit
 76 !          = 1: N is too large; the data is still generated but may not
 77 !               be not exact.
 78 !          < 0: if INFO = -i, the i-th argument had an illegal value
 79 !
 80 !  =====================================================================
 81 
 82 !     .. Local Scalars ..
 83       INTEGER TM, TI, R
 84       INTEGER M
 85       INTEGER I, J
 86 
 87 !     .. Parameters ..
 88 !     NMAX_EXACT   the largest dimension where the generated data is
 89 !                  exact.
 90 !     NMAX_APPROX  the largest dimension where the generated data has
 91 !                  a small componentwise relative error.
 92       INTEGER NMAX_EXACT, NMAX_APPROX
 93       PARAMETER (NMAX_EXACT = 6, NMAX_APPROX = 11)
 94 
 95 !     ..
 96 !     .. External Functions
 97       EXTERNAL SLASET
 98       INTRINSIC REAL
 99 !     ..
100 !     .. Executable Statements ..
101 !
102 !     Test the input arguments
103 !
104       INFO = 0
105       IF (N .LT. 0 .OR. N .GT. NMAX_APPROX) THEN
106          INFO = -1
107       ELSE IF (NRHS .LT. 0THEN
108          INFO = -2
109       ELSE IF (LDA .LT. N) THEN
110          INFO = -4
111       ELSE IF (LDX .LT. N) THEN
112          INFO = -6
113       ELSE IF (LDB .LT. N) THEN
114          INFO = -8
115       END IF
116       IF (INFO .LT. 0THEN
117          CALL XERBLA('SLAHILB'-INFO)
118          RETURN
119       END IF
120       IF (N .GT. NMAX_EXACT) THEN
121          INFO = 1
122       END IF
123 
124 !     Compute M = the LCM of the integers [1, 2*N-1].  The largest
125 !     reasonable N is small enough that integers suffice (up to N = 11).
126       M = 1
127       DO I = 2, (2*N-1)
128          TM = M
129          TI = I
130          R = MOD(TM, TI)
131          DO WHILE (R .NE. 0)
132             TM = TI
133             TI = R
134             R = MOD(TM, TI)
135          END DO
136          M = (M / TI) * I
137       END DO
138 
139 !     Generate the scaled Hilbert matrix in A
140       DO J = 1, N
141          DO I = 1, N
142             A(I, J) = REAL(M) / (I + J - 1)
143          END DO
144       END DO
145 
146 !     Generate matrix B as simply the first NRHS columns of M * the
147 !     identity.
148       CALL SLASET('Full', N, NRHS, 0.0REAL(M), B, LDB)
149 
150 !     Generate the true solutions in X.  Because B = the first NRHS
151 !     columns of M*I, the true solutions are just the first NRHS columns
152 !     of the inverse Hilbert matrix.
153       WORK(1= N
154       DO J = 2, N
155          WORK(J) = (  ( (WORK(J-1)/(J-1)) * (J-1 - N) ) /(J-1)  )
156      $        * (N +-1)
157       END DO
158       
159       DO J = 1, NRHS
160          DO I = 1, N
161             X(I, J) = (WORK(I)*WORK(J)) / (I + J - 1)
162          END DO
163       END DO
164 
165       END
166