program main !*****************************************************************************80 ! !! MAIN is the main program for DQED_PRB5. ! ! Discussion: ! ! DQED_PRB5 demonstrates how to call the DBOLS routine directly, ! bypassing the DQED routine, if the system to be solved is simply ! a constrained linear system of equations. ! ! Modified: ! ! 03 September 2007 ! ! Author: ! ! Steve White wrote the original version of this example. ! John Burkardt made some modifications. ! ! Local Parameters: ! ! Local, integer ( kind = 4 ) IOPT(NI+1), contains a final value of '99', preceded ! by NI values indicating user options. When calling DBOLS directly, ! the option '7' must be specified. ! ! Local, integer ( kind = 4 ) MDW, the allocated row dimension of W. ! ! Local, integer ( kind = 4 ) MROWS, the number of rows in W. ! ! Local, integer ( kind = 4 ) NCOLS, the number of columns in W. ! ! Local, integer ( kind = 4 ) NI, the number of options in the IOPT array. ! implicit none integer ( kind = 4 ), parameter :: mrows = 5 integer ( kind = 4 ), parameter :: ncols = 3 integer ( kind = 4 ), parameter :: ni = 1 integer ( kind = 4 ), parameter :: nx = 0 integer ( kind = 4 ), parameter :: mdw = mrows real ( kind = 8 ),dimension ( ncols ) :: bl = (/ 0.0D+00, 0.0D+00, 0.0D+00 /) real ( kind = 8 ),dimension ( ncols ) :: bu = (/ 0.0D+00, 0.0D+00, 0.0D+00 /) integer ( kind = 4 ) col integer ( kind = 4 ), dimension ( ncols ) :: ind = (/ 1, 1, 1 /) integer ( kind = 4 ), dimension ( 1 + ni ) :: iopt = (/ 7, 99 /) integer ( kind = 4 ) iw(2*ncols) integer ( kind = 4 ) mode real ( kind = 8 ) rnorm integer ( kind = 4 ) row real ( kind = 8 ) rw(5*ncols) real ( kind = 8 ), dimension ( mdw, ncols+1 ) :: w = reshape ( (/ & 4.0D+00, 3.0D+00, -7.0D+00, 7.0D+00, -1.0D+00, & -7.0D+00, -4.0D+00, 3.0D+00, 7.0D+00, 7.0D+00, & -7.0D+00, 0.0D+00, -3.0D+00, 1.0D+00, 6.0D+00, & -22.0D+00, -6.0D+00, -2.0D+00, 34.0D+00, 13.0D+00 /), (/ mdw, ncols+1 /) ) real ( kind = 8 ), dimension ( ncols+nx) :: x call timestamp ( ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'DQED_PRB5' write ( *, '(a)' ) ' Demonstrate how to call the DBOLS routine directly' write ( *, '(a)' ) ' if the nonlinear constrained system to be solved' write ( *, '(a)' ) ' is actually simply a LINEAR constrained system.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The linear system E*X=F is stored as a single ' write ( *, '(a)' ) ' array W = [ E | F ].' write ( *, '(a)' ) ' ' write ( *, '(a,i8,a,i8,a)' ) & ' The order of E is ', mrows, ' rows by ', ncols, ' columns.' write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The E matrix:' write ( *, '(a)' ) ' ' do row = 1, mrows write ( *, '(5g12.3)' ) w(row,1:ncols) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The F right hand side:' write ( *, '(a)' ) ' ' do row = 1, mrows write ( *, '(g12.3)' ) w(row,ncols+1) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Lower bounds on the solution X:' write ( *, '(a)' ) ' ' do col = 1, ncols write ( *, '(g12.3)' ) bl(col) end do write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' Call DBOLS for least squares solution minimizing' write ( *, '(a)' ) ' the norm of the constrained linear system.' call dbols ( w, mdw, mrows, ncols, bl, bu, ind, iopt, x, rnorm, mode, rw, iw ) write ( *, '(a)' ) ' ' write ( *, '(a)' ) ' The solution X:' write ( *, '(a)' ) ' ' do col = 1, ncols write ( *, '(g12.3)' ) x(col) end do write ( *, '(a)' ) ' ' write ( *, '(a,g14.6)' ) ' The L2 norm of the residual vector E*X-F = ', rnorm write ( *, '(a)' ) ' ' write ( *, '(a,i6)' ) ' The error return flag is MODE = ', mode ! ! Terminate. ! write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'DQED_PRB5:' write ( *, '(a)' ) ' Normal end of execution.' write ( *, '(a)' ) ' ' call timestamp ( ) stop end