@extract -b incpath.inc @extract -b @(incd)/type.inc type=@(@type) @ROUT spevx @type sreal dreal scplx dcplx PROGRAM LA_@(pre)SPEVX_ET_EXAMPLE @type sherm dherm PROGRAM LA_@(pre)HPEVX_ET_EXAMPLE @type ! @extract -b @(incd)/header.inc -case0 ! .. Use Statements USE LA_PRECISION, ONLY: WP => @(upr)P @type sreal dreal scplx dcplx USE F90_LAPACK, ONLY: LA_SPEVX @type sherm dherm USE F90_LAPACK, ONLY: LA_HPEVX @type ! ! .. Implicit Statement .. IMPLICIT NONE ! .. Parameters .. @type sreal dreal CHARACTER(LEN=*), PARAMETER :: FMT = '(8(1X,F10.3))' @type scplx dcplx sherm dherm CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.3,1H,,F7.3,1H):))' @type ! INTEGER, PARAMETER :: NIN=5, NOUT=6 ! .. Local Scalars .. INTEGER :: I, J, INFO, N, NS, M ! .. Local Arrays .. INTEGER, ALLOCATABLE :: IFAIL(:) REAL(WP), ALLOCATABLE :: AA(:), W(:) @(type)(WP), ALLOCATABLE :: A(:), Z(:,:) ! .. Executable Statements .. @type sreal dreal scplx dcplx WRITE (NOUT,*) '@(pre)SPEVX ET_Example Program Results.' @type sherm dherm WRITE (NOUT,*) '@(pre)HPEVX ET_Example Program Results.' @type ! READ ( NIN, * ) ! Skip heading in data file READ ( NIN, * ) N PRINT *, 'N = ', N NS = N*(N+1)/2 ALLOCATE ( A(NS), AA(NS), W(N), Z(N,N), IFAIL(N) ) ! READ (NIN, *) AA A=AA WRITE(NOUT,*) 'The matrix A:' DO I = 1, N WRITE (NOUT,*) 'J = ', I; WRITE (NOUT,FMT) (A(J+(I-1)*I/2),J=1,I) ENDDO ! WRITE ( NOUT, * )'---------------------------------------------------------' WRITE ( NOUT, * ) @type sreal dreal scplx dcplx WRITE ( NOUT, * )'Details of LA_@(pre)SPEVX LAPACK Subroutine Results.' WRITE ( NOUT, * ) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, INFO=INFO )' A=AA CALL LA_SPEVX( A, W, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, Z=Z, INFO=INFO )' A=AA CALL LA_SPEVX( A, W, Z=Z, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, ''U'', Z )' A=AA CALL LA_SPEVX( A, W, 'U', Z ) WRITE(NOUT,*) ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, ''L'', Z )' A=AA CALL LA_SPEVX( A, W, 'L', Z ) WRITE(NOUT,*) ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, VL=3.0_WP, M=M, INFO=INFO )' A=AA CALL LA_SPEVX( A, W, VL=3.0_WP, M=M, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,*) 'The total number of eigenvalues found is ', M WRITE(NOUT,FMT) W(1:M) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, ''U'', Z, -HUGE(1.0_WP), HUGE(1.0_WP), &' WRITE(NOUT,*) ' M=M, IFAIL=IFAIL, ABSTOL=2*EPSILON(1.0_WP), INFO=INFO )' A=AA; M=99999; IFAIL = 99999; Z = HUGE(1.0_WP); W = HUGE(1.0_WP) CALL LA_SPEVX( A, W, 'U', Z, -HUGE(1.0_WP), HUGE(1.0_WP), & M=M, IFAIL=IFAIL, ABSTOL=2*EPSILON(1.0_WP), INFO=INFO ) WRITE(NOUT,*) 'M, INFO, EIGENVALUES:', M, INFO WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO WRITE(NOUT,*) 'IFAIL:'; WRITE (NOUT,*) IFAIL ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, ''U'', Z, IL=1, IU=N, M=M, IFAIL=IFAIL, &' WRITE(NOUT,*) ' ABSTOL= 2*EPSILON(1.0_WP), INFO=INFO )' A=AA; M=99999; IFAIL = 99999; Z = HUGE(1.0_WP); W = HUGE(1.0_WP) CALL LA_SPEVX( A, W, 'U', Z, IL=1, IU=N, M=M, IFAIL=IFAIL, & ABSTOL=2*EPSILON(1.0_WP), INFO=INFO ) WRITE(NOUT,*) 'M, INFO, EIGENVALUES:', M, INFO WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO WRITE(NOUT,*) 'IFAIL:'; WRITE (NOUT,*) IFAIL ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A(1:5), W, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A(1:5), W, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W(1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W(1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, UPLO=''9'', INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, UPLO='9', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, Z=Z(1:N-1,:), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, Z=Z(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, Z=Z(:,1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, Z=Z(:,1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, VL=10.0_WP, VU=1.0_WP, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, VL=10.0_WP, VU=1.0_WP, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, VL=1.0_WP, VU=2.0_WP, IL=1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, VL=1.0_WP, VU=2.0_WP, IL=1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, IL=-1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, IL=-1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, IL=N, IU=1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, IL=N, IU=1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, IL=1, IU=N+1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, IL=1, IU=N+1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, IFAIL=IFAIL(1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, IFAIL=IFAIL(1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_SPEVX( A, W, IFAIL=IFAIL )' A=AA; Z = HUGE(1.0_WP) CALL LA_SPEVX( A, W, IFAIL=IFAIL ) ! END!PROGRAM LA_@(pre)SPEVX_ET_EXAMPLE @type sherm dherm WRITE ( NOUT, * )'Details of LA_@(pre)HPEVX LAPACK Subroutine Results.' WRITE ( NOUT, * ) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, INFO=INFO )' A=AA CALL LA_HPEVX( A, W, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,FMT) W ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, Z=Z, INFO=INFO )' A=AA CALL LA_HPEVX( A, W, Z=Z, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, ''U'', Z )' A=AA CALL LA_HPEVX( A, W, 'U', Z ) WRITE(NOUT,*) ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, ''L'', Z )' A=AA CALL LA_HPEVX( A, W, 'L', Z ) WRITE(NOUT,*) ' EIGENVALUES:' WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, VL=3.0_WP, M=M, INFO=INFO )' A=AA CALL LA_HPEVX( A, W, VL=3.0_WP, M=M, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO, ' EIGENVALUES:' WRITE(NOUT,*) 'The total number of eigenvalues found is ', M WRITE(NOUT,FMT) W(1:M) ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, ''U'', Z, -HUGE(1.0_WP), HUGE(1.0_WP), &' WRITE(NOUT,*) ' M=M, IFAIL=IFAIL, ABSTOL=2*EPSILON(1.0_WP), INFO=INFO )' A=AA; M=99999; IFAIL = 99999; Z = HUGE(1.0_WP); W = HUGE(1.0_WP) CALL LA_HPEVX( A, W, 'U', Z, -HUGE(1.0_WP), HUGE(1.0_WP), & M=M, IFAIL=IFAIL, ABSTOL=2*EPSILON(1.0_WP), INFO=INFO ) WRITE(NOUT,*) 'M, INFO, EIGENVALUES:', M, INFO WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO WRITE(NOUT,*) 'IFAIL:'; WRITE (NOUT,*) IFAIL ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, ''U'', Z, IL=1, IU=N, M=M, IFAIL=IFAIL, &' WRITE(NOUT,*) ' ABSTOL= 2*EPSILON(1.0_WP), INFO=INFO )' A=AA; M=99999; IFAIL = 99999; Z = HUGE(1.0_WP); W = HUGE(1.0_WP) CALL LA_HPEVX( A, W, 'U', Z, IL=1, IU=N, M=M, IFAIL=IFAIL, & ABSTOL=2*EPSILON(1.0_WP), INFO=INFO ) WRITE(NOUT,*) 'M, INFO, EIGENVALUES:', M, INFO WRITE(NOUT,FMT) W WRITE(NOUT,*) 'EIGENVECTORS:' DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) Z(:,I); END DO WRITE(NOUT,*) 'IFAIL:'; WRITE (NOUT,*) IFAIL ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A(1:5), W, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A(1:5), W, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W(1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W(1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, UPLO=''9'', INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, UPLO='9', INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, Z=Z(1:N-1,:), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, Z=Z(1:N-1,:), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, Z=Z(:,1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, Z=Z(:,1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, VL=10.0_WP, VU=1.0_WP, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, VL=10.0_WP, VU=1.0_WP, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, VL=1.0_WP, VU=2.0_WP, IL=1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, VL=1.0_WP, VU=2.0_WP, IL=1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, IL=-1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, IL=-1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, IL=N, IU=1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, IL=N, IU=1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, IL=1, IU=N+1, INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, IL=1, IU=N+1, INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, IFAIL=IFAIL(1:N-1), INFO=INFO )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, IFAIL=IFAIL(1:N-1), INFO=INFO ) WRITE(NOUT,*) 'INFO = ', INFO ! WRITE(NOUT,*) WRITE(NOUT,*) 'CALL LA_HPEVX( A, W, IFAIL=IFAIL )' A=AA; Z = HUGE(1.0_WP) CALL LA_HPEVX( A, W, IFAIL=IFAIL ) ! END!PROGRAM LA_@(pre)HPEVX_ET_EXAMPLE @type !