PROGRAM nag_gen_bnd_lin_sys_ex06 ! Example Program Text for nag_gen_bnd_lin_sys ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_gen_bnd_lin_sys, ONLY : nag_gen_bnd_lin_sol USE nag_write_mat, ONLY : nag_write_gen_mat ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND, MAX, MIN ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, j, kl, ku, n, nrhs REAL (wp) :: rcond ! .. Local Arrays .. REAL (wp), ALLOCATABLE :: bwd_err(:), fwd_err(:) COMPLEX (wp), ALLOCATABLE :: a(:,:), b(:,:) ! .. Executable Statements .. WRITE (nag_std_out,*) & 'Example Program Results for nag_gen_bnd_lin_sys_ex06' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n, kl, ku, nrhs ALLOCATE (a(kl+ku+1,n),b(n,nrhs),bwd_err(nrhs), & fwd_err(nrhs)) ! Allocate storage DO i = 1, n READ (nag_std_in,*) (a(ku+1+i-j,j),j=MAX(1,i-kl),MIN(i+ku,n)) END DO READ (nag_std_in,*) (b(i,:),i=1,n) ! Solve the system of equations CALL nag_gen_bnd_lin_sol(ku,a,b,rcond=rcond,bwd_err=bwd_err, & fwd_err=fwd_err) WRITE (nag_std_out,*) WRITE (nag_std_out,'(1X,''kappa(A) (1/rcond)''/2X,ES11.2)') 1/rcond WRITE (nag_std_out,*) CALL nag_write_gen_mat(b,int_col_labels=.TRUE.,format='(F7.4)', & title='Solutions (one per column)') WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Backward error bounds' WRITE (nag_std_out,'(2X,4(7X,ES11.2:))') bwd_err WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Forward error bounds (estimates)' WRITE (nag_std_out,'(2X,4(7X,ES11.2:))') fwd_err DEALLOCATE (a,b,bwd_err,fwd_err) ! Deallocate storage END PROGRAM nag_gen_bnd_lin_sys_ex06