1SUBROUTINE LA_TEST_ZHPEV( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, RWORK, INFO ) 2! 3! -- LAPACK95 interface driver routine (version 1.1) -- 4! UNI-C, Denmark; 5! May 25, 1999 6! 7! .. Use Statements .. 8 USE LA_PRECISION, ONLY: WP => DP 9 USE F95_LAPACK, ONLY: LA_HPEV 10! .. Implicit Statement .. 11 IMPLICIT NONE 12! .. Scalar Arguments .. 13 INTEGER, INTENT(IN) :: N, LDZ 14 INTEGER, INTENT(INOUT) :: INFO 15 CHARACTER*1, INTENT(IN) :: JOBZ, UPLO 16! .. Array Arguments .. 17 COMPLEX(WP), INTENT(INOUT) :: AP(1:N*(N+1)/2) 18 COMPLEX(WP), INTENT(OUT) :: WORK(1:MAX(1, 2*N-1)), Z(1:LDZ, 1:N) 19 REAL(WP), INTENT(OUT) :: W(1:N) 20 REAL(WP) :: RWORK(1: MAX(1, 3*N-2)) 21! .. Parameters .. 22 CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_HPEV ' 23 CHARACTER(LEN=14), PARAMETER :: SRNAMT = 'LA_TEST_ZHPEV ' 24! .. Common blocks .. 25 INTEGER :: INFOTC 26 COMMON /LINFO95/ INFOTC 27! .. Local Scalars .. 28 INTEGER :: I, J, IAP, IW, IZ1, IZ2 29 CHARACTER*1 :: IUPLO, IJOBZ 30! .. Local Arrays .. 31 INTEGER, SAVE, POINTER :: IWORK(:) 32 LOGICAL, SAVE :: CTEST = .TRUE., ETEST = .TRUE. 33 LOGICAL LSAME 34! .. Executable Statements .. 35 IAP = N*(N+1)/2; IUPLO = UPLO; IJOBZ = JOBZ; IW = N 36 IZ1 = MAX(1,N); IZ2 = N 37 I = INFO / 100; J = INFO - I*100 38 SELECT CASE(I) 39 CASE (1) 40 IAP = IAP - 1 41 CASE (2) 42 IW = IW - 1 43 CASE (3) 44 IUPLO = 'T' 45 CASE(4) 46 IJOBZ = 'V' 47 IZ2 = IZ2 - 1 48 CASE(:-1,5:) 49 CALL UESTOP(SRNAMT) 50 END SELECT 51 IF ( LSAME (IJOBZ,'V')) THEN 52 CALL LA_HPEV( AP(1: IAP), W(1:IW), IUPLO, Z(1:IZ1, 1: IZ2), INFO) 53 ELSE 54 CALL LA_HPEV( AP(1: IAP), W(1:IW), IUPLO, INFO = INFO) 55 ENDIF 56 57 CALL LA_AUX_AA01( I, CTEST, ETEST, SRNAMT ) 58END SUBROUTINE LA_TEST_ZHPEV 59