PROGRAM nag_sym_gen_eig_ex04 ! Example Program Text for nag_sym_gen_eig ! NAG fl90, Release 4. NAG Copyright 2000. ! .. Use Statements .. USE nag_examples_io, ONLY : nag_std_in, nag_std_out USE nag_write_mat, ONLY : nag_write_gen_mat USE nag_sym_gen_eig, ONLY : nag_sym_gen_eig_all ! .. Implicit None Statement .. IMPLICIT NONE ! .. Intrinsic Functions .. INTRINSIC KIND ! .. Parameters .. INTEGER, PARAMETER :: wp = KIND(1.0D0) ! .. Local Scalars .. INTEGER :: i, j, n, type CHARACTER (1) :: uplo ! .. Local Arrays .. REAL (wp), ALLOCATABLE :: lambda(:) COMPLEX (wp), ALLOCATABLE :: a(:), b(:), z(:,:) ! .. Executable Statements .. WRITE (nag_std_out,*) 'Example Program Results for nag_sym_gen_eig_ex04' READ (nag_std_in,*) ! Skip heading in data file READ (nag_std_in,*) n, type, uplo ALLOCATE (a(n*(n+1)/2),b(n*(n+1)/2),z(n,n),lambda(n)) ! Allocate storage SELECT CASE (uplo) CASE ('U','u') DO i = 1, n READ (nag_std_in,*) (a(i+j*(j-1)/2),j=i,n) END DO DO i = 1, n READ (nag_std_in,*) (b(i+j*(j-1)/2),j=i,n) END DO CASE ('L','l') DO i = 1, n READ (nag_std_in,*) (a(i+(2*n-j)*(j-1)/2),j=1,i) END DO DO i = 1, n READ (nag_std_in,*) (b(i+(2*n-j)*(j-1)/2),j=1,i) END DO END SELECT ! Compute eigenvalues and eigenvectors CALL nag_sym_gen_eig_all(uplo,a,b,lambda,type=type,z=z) WRITE (nag_std_out,*) WRITE (nag_std_out,*) 'Eigenvalues' WRITE (nag_std_out,'(12X,5(F7.3:,10X))') lambda WRITE (nag_std_out,*) CALL nag_write_gen_mat(z,format='(F7.3)',title='Eigenvectors') DEALLOCATE (a,b,lambda,z) ! Deallocate storage END PROGRAM nag_sym_gen_eig_ex04