PROGRAM nag_sym_bnd_lin_sys_ex04 ! Example Program Text for nag_sym_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_sym_bnd_lin_sys, ONLY : nag_sym_bnd_lin_sol ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND, MAX, MIN ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, j, k, n REAL (wp) :: bwd_err, fwd_err, rcond CHARACTER (1) :: uplo ! .. Local Arrays .. COMPLEX (wp), ALLOCATABLE :: a(:,:), b(:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_sym_lin_sys_ex04' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n, k READ (nag_std_in,*) uplo ALLOCATE (a(k+1,n),b(n)) ! Allocate storage SELECT CASE (uplo) CASE ('L','l') DO i = 1, n READ (nag_std_in,*) (a(1+i-j,j),j=MAX(1,i-k),i) END DO CASE ('U','u') DO i = 1, n READ (nag_std_in,*) (a(k+1+i-j,j),j=i,MIN(n,i+k)) END DO END SELECT READ (nag_std_in,*) b ! Solve the system of equations CALL nag_sym_bnd_lin_sol(uplo,a,b,bwd_err=bwd_err,fwd_err=fwd_err, & rcond=rcond) WRITE (nag_std_out,*) WRITE (nag_std_out,'(1X,''kappa(A) (1/rcond)''/2X,ES11.2)') 1/rcond WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Solution' WRITE (nag_std_out,'(3X,''('',F7.4,'','',F7.4,'')'')') b WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Backward error bounds' WRITE (nag_std_out,'(2X,4ES11.2)') bwd_err WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Forward error bounds (estimates)' WRITE (nag_std_out,'(2X,4ES11.2)') fwd_err DEALLOCATE (a,b) ! Deallocate storage END PROGRAM nag_sym_bnd_lin_sys_ex04