program asa159_prb ! !******************************************************************************* ! !! ASA159_PRB calls a set of problems for ASA159. ! implicit none ! call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ASA159_PRB' write ( *, '(a)' ) ' A set of tests for ASA159.' call test01 write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'ASA159_PRB' write ( *, '(a)' ) ' Normal end of execution.' stop end subroutine test01 ! !******************************************************************************* ! !! TEST01 tests RCONT2. ! implicit none ! integer, parameter :: m = 5 integer, parameter :: n = 5 integer, parameter :: lda = m ! integer a(lda,n) integer, save, dimension ( n ) :: c = (/ 2, 2, 2, 2, 1 /) integer i integer ierror logical key integer, parameter :: ntest = 10 integer, save, dimension ( m ) :: r = (/ 3, 2, 2, 1, 1 /) ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'TEST01' write ( *, '(a)' ) ' RCONT2 constructs a random matrix with' write ( *, '(a)' ) ' given row and column sums.' call ivec_print ( m, r, ' The rowsum vector:' ) call ivec_print ( n, c, ' The columnsum vector: ' ) key = .false. do i = 1, ntest call rcont2 ( m, n, r, c, a, key, ierror ) if ( ierror /= 0 ) then write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' RCONT2 returned error flag IERROR = ', ierror return end if call imat_print ( lda, m, n, a, ' The rowcolsum matrix:' ) end do return end