PROGRAM nag_lin_lsq_ex10 ! Example Program Text for nag_lin_lsq ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_lin_lsq, ONLY : nag_qr_fac, nag_lin_lsq_sol_qr_svd ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND, MIN ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, m, n, ns, rank REAL (wp) :: std_err, tol ! .. Local Arrays .. COMPLEX (wp), ALLOCATABLE :: a(:,:), b(:), tau(:), x(:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_lin_lsq_ex10' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) m, n ns = MIN(m,n) tol = 0.005_wp ALLOCATE (a(m,n),b(m),tau(ns),x(n)) ! Allocate storage READ (nag_std_in,*) (a(i,:),i=1,m) READ (nag_std_in,*) b ! Compute the QR factorization CALL nag_qr_fac(a,tau) ! Compute the minimum norm solution CALL nag_lin_lsq_sol_qr_svd(a,tau,b,x,tol=tol,rank=rank,std_err=std_err) WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Minimum norm solution' WRITE (nag_std_out,'(2X,''('',F7.4,'','',F7.4,'')'')') x WRITE (nag_std_out,*) WRITE (nag_std_out,'(2X,''tol '',F7.4)') tol WRITE (nag_std_out,'(2X,''rank '',I7)') rank WRITE (nag_std_out,'(2X,''Standard error '',F7.4)') std_err DEALLOCATE (a,b,tau,x) ! Deallocate storage END PROGRAM nag_lin_lsq_ex10