1@extract -b incpath.inc 2@extract -b @(incd)/type.inc type=@(@type) 3@ROUT sygvd 4 @type sreal dreal 5PROGRAM LA_@(pre)SYGVD_ET_EXAMPLE 6 @type sherm dherm 7PROGRAM LA_@(pre)HEGVD_ET_EXAMPLE 8 @type ! 9 @extract -b @(incd)/header.inc -case0 10! .. USE STATEMENTS 11 USE LA_PRECISION, ONLY: WP => @(upr)P 12@type sreal dreal 13 USE F90_LAPACK, ONLY: LA_SYGVD 14@type sherm dherm 15 USE F90_LAPACK, ONLY: LA_HEGVD 16@type ! 17! .. IMPLICIT STATEMENT .. 18 IMPLICIT NONE 19! .. PARAMETERS .. 20@type sreal dreal 21 CHARACTER(LEN=*), PARAMETER :: FMT = '(8(1X,F10.3))' 22@type scplx dcplx sherm dherm 23 CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.3,1H,,F7.3,1H):))' 24@type ! 25 INTEGER, PARAMETER :: NIN=5, NOUT=6 26! .. LOCAL SCALARS .. 27 INTEGER :: I, J, INFO, N 28! .. LOCAL ARRAYS .. 29 REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:), W(:) 30 @(type)(WP), ALLOCATABLE :: A(:,:), B(:,:) 31! .. EXECUTABLE STATEMENTS .. 32@type sreal dreal 33 WRITE(NOUT,*) 'SSYGVD ET_Example Program Results.' 34 READ(NIN,*) ! SKIP HEADING IN DATA FILE 35 READ(NIN,*) N 36 ALLOCATE ( A(N,N), B(N,N), W(N), AA(N,N), BB(N,N) ) 37 DO I = 1, N 38 READ(NIN,*) (AA(I, J), J = 1, N) 39 ENDDO 40 DO I = 1, N 41 READ(NIN,*) (BB(I, J), J = 1, N) 42 ENDDO 43 A=AA; B=BB 44 WRITE(NOUT,*) 'The matrix A:' 45 DO I = 1, N 46 WRITE(NOUT,FMT) A(I,:) 47 ENDDO 48 WRITE(NOUT,*) 'The matrix B:' 49 DO I = 1, N 50 WRITE(NOUT,FMT) B(I,:) 51 ENDDO 52! 53 WRITE(NOUT,*) '---------------------------------------------------------' 54 WRITE(NOUT,*) 55 WRITE ( NOUT, * )'Details of LA_SSYGVD LAPACK Subroutine Results.' 56 WRITE(NOUT,*) 57! 58 WRITE(NOUT,*) 59 WRITE(NOUT,*) 'CALL LA_SYGVD(A, B, W, INFO=INFO)' 60 WRITE(NOUT,*) 'LA_SYGVD computes all the eigenvalues of a real' 61 WRITE(NOUT,*) 'symmetric-definite generalized eigenproblem' 62 WRITE(NOUT,*) 'A*x = lambda*B*x' 63 WRITE(NOUT,*) 'ON ENTRY: A, B' 64 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 65 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 66 WRITE(NOUT,*) 'ON EXIT: A, B, W' 67 WRITE(NOUT,*) ' A - destroyed matrix A' 68 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 69 WRITE(NOUT,*) ' factorization' 70 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 71 A=AA 72 B=BB 73 CALL LA_SYGVD(A,B,W,INFO=INFO) 74 WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGVD:' 75 WRITE(NOUT,FMT) W(:) 76 WRITE(NOUT,*) 'INFO = ',INFO 77! 78 WRITE(NOUT,*) 79 WRITE(NOUT,*) "CALL LA_SYGVD(A, B, W, JOBZ='V', INFO=INFO)" 80 WRITE(NOUT,*) 'LA_SYGVD computes all the eigenvalues and eigenvectors' 81 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 82 WRITE(NOUT,*) 'A*x = lambda*B*x' 83 WRITE(NOUT,*) 'ON ENTRY: A, B' 84 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 85 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 86 WRITE(NOUT,*) 'ON EXIT: A, B, W' 87 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 88 WRITE(NOUT,*) ' Z**T*B*Z = I' 89 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 90 WRITE(NOUT,*) ' factorization' 91 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 92 A=AA 93 B=BB 94 CALL LA_SYGVD(A,B,W,JOBZ='V',INFO=INFO) 95 WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGVD:' 96 WRITE(NOUT,FMT) W(:) 97 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGVD:' 98 DO I = 1, N 99 WRITE(NOUT,FMT) A(I,:) 100 END DO 101 WRITE(NOUT,*) 'INFO = ',INFO 102! 103 WRITE(NOUT,*) 104 WRITE(NOUT,*) "CALL LA_SYGVD(A, B, W, JOBZ='V', UPLO='L', INFO=INFO)" 105 WRITE(NOUT,*) 'LA_SYGVD computes all the eigenvalues and eigenvectors' 106 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 107 WRITE(NOUT,*) 'A*x = lambda*B*x' 108 WRITE(NOUT,*) 'ON ENTRY: A, B' 109 WRITE(NOUT,*) ' A - the original matrix (lower triangular)' 110 WRITE(NOUT,*) ' B - the original matrix (lower triangular)' 111 WRITE(NOUT,*) 'ON EXIT: A, B, W' 112 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 113 WRITE(NOUT,*) ' Z**T*B*Z = I' 114 WRITE(NOUT,*) ' B - the triangular factor L from the Cholesky' 115 WRITE(NOUT,*) ' factorization' 116 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 117 A=AA 118 B=BB 119 CALL LA_SYGVD(A,B,W,JOBZ='V',UPLO='L',INFO=INFO) 120 WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGVD:' 121 WRITE(NOUT,FMT) W(:) 122 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGVD:' 123 DO I = 1, N 124 WRITE(NOUT,FMT) A(I,:) 125 END DO 126 WRITE(NOUT,*) 'INFO = ',INFO 127! 128 WRITE(NOUT,*) 129 WRITE(NOUT,*) "CALL LA_SYGVD(A, B, W, 2, 'V', 'L', INFO)" 130 WRITE(NOUT,*) 'LA_SYGVD computes all the eigenvalues and eigenvectors' 131 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 132 WRITE(NOUT,*) 'A*B*x = lambda*x' 133 WRITE(NOUT,*) 'ON ENTRY: A, B' 134 WRITE(NOUT,*) ' A - the original matrix (lower triangular)' 135 WRITE(NOUT,*) ' B - the original matrix (lower triangular)' 136 WRITE(NOUT,*) 'ON EXIT: A, B, W' 137 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 138 WRITE(NOUT,*) ' Z**T*B*Z = I' 139 WRITE(NOUT,*) ' B - the triangular factor L from the Cholesky' 140 WRITE(NOUT,*) ' factorization' 141 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 142 A=AA 143 B=BB 144 CALL LA_SYGVD(A,B,W,2,'V','L',INFO) 145 WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGVD:' 146 WRITE(NOUT,FMT) W(:) 147 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGVD:' 148 DO I = 1, N 149 WRITE(NOUT,FMT) A(I,:) 150 END DO 151 WRITE(NOUT,*) 'INFO = ',INFO 152! 153 WRITE(NOUT,*) 154 WRITE(NOUT,*) "CALL LA_SYGVD(A, B, W, 3, 'V', INFO=INFO)" 155 WRITE(NOUT,*) 'LA_SYGVD computes all the eigenvalues and eigenvectors' 156 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 157 WRITE(NOUT,*) 'B*A*x = lambda*x' 158 WRITE(NOUT,*) 'ON ENTRY: A, B' 159 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 160 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 161 WRITE(NOUT,*) 'ON EXIT: A, B, W' 162 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 163 WRITE(NOUT,*) ' Z**T*inv(B)*Z = I' 164 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 165 WRITE(NOUT,*) ' factorization' 166 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 167 A=AA 168 B=BB 169 CALL LA_SYGVD(A,B,W,3,'V',INFO=INFO) 170 WRITE(NOUT,*) 'The eigenvalues computed by LA_SYGVD:' 171 WRITE(NOUT,FMT) W(:) 172 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_SYGVD:' 173 DO I = 1, N 174 WRITE(NOUT,FMT) A(I,:) 175 END DO 176 WRITE(NOUT,*) 'INFO = ',INFO 177! 178@type sherm dherm 179 WRITE(NOUT,*) 'CHEGVD ET_Example Program Results.' 180 READ(NIN,*) ! SKIP HEADING IN DATA FILE 181 READ(NIN,*) N 182 ALLOCATE ( A(N,N), B(N,N), W(N), AA(N,N), BB(N,N) ) 183 DO I = 1, N 184 READ(NIN,*) (AA(I, J), J = 1, N) 185 ENDDO 186 DO I = 1, N 187 READ(NIN,*) (BB(I, J), J = 1, N) 188 ENDDO 189 A=AA; B=BB 190 WRITE(NOUT,*) 'The matrix A:' 191 DO I = 1, N 192 WRITE(NOUT,FMT) A(I,:) 193 ENDDO 194 WRITE(NOUT,*) 'The matrix B:' 195 DO I = 1, N 196 WRITE(NOUT,FMT) B(I,:) 197 ENDDO 198! 199 WRITE(NOUT,*) '---------------------------------------------------------' 200 WRITE(NOUT,*) 201 WRITE ( NOUT, * )'Details of LA_CHEGVD LAPACK Subroutine Results.' 202 WRITE(NOUT,*) 203! 204 WRITE(NOUT,*) 205 WRITE(NOUT,*) 'CALL LA_HEGVD(A, B, W, INFO=INFO)' 206 WRITE(NOUT,*) 'LA_HEGVD computes all the eigenvalues of a real' 207 WRITE(NOUT,*) 'symmetric-definite generalized eigenproblem' 208 WRITE(NOUT,*) 'A*x = lambda*B*x' 209 WRITE(NOUT,*) 'ON ENTRY: A, B' 210 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 211 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 212 WRITE(NOUT,*) 'ON EXIT: A, B, W' 213 WRITE(NOUT,*) ' A - destroyed matrix A' 214 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 215 WRITE(NOUT,*) ' factorization' 216 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 217 A=AA 218 B=BB 219 CALL LA_HEGVD(A,B,W,INFO=INFO) 220 WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGVD:' 221 WRITE(NOUT,FMT) W(:) 222 WRITE(NOUT,*) 'INFO = ',INFO 223! 224 WRITE(NOUT,*) 225 WRITE(NOUT,*) "CALL LA_HEGVD(A, B, W, JOBZ='V', INFO=INFO)" 226 WRITE(NOUT,*) 'LA_HEGVD computes all the eigenvalues and eigenvectors' 227 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 228 WRITE(NOUT,*) 'A*x = lambda*B*x' 229 WRITE(NOUT,*) 'ON ENTRY: A, B' 230 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 231 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 232 WRITE(NOUT,*) 'ON EXIT: A, B, W' 233 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 234 WRITE(NOUT,*) ' Z**T*B*Z = I' 235 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 236 WRITE(NOUT,*) ' factorization' 237 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 238 A=AA 239 B=BB 240 CALL LA_HEGVD(A,B,W,JOBZ='V',INFO=INFO) 241 WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGVD:' 242 WRITE(NOUT,FMT) W(:) 243 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGVD:' 244 DO I = 1, N 245 WRITE(NOUT,FMT) A(I,:) 246 END DO 247 WRITE(NOUT,*) 'INFO = ',INFO 248! 249 WRITE(NOUT,*) 250 WRITE(NOUT,*) "CALL LA_HEGVD(A, B, W, JOBZ='V', UPLO='L', INFO=INFO)" 251 WRITE(NOUT,*) 'LA_HEGVD computes all the eigenvalues and eigenvectors' 252 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 253 WRITE(NOUT,*) 'A*x = lambda*B*x' 254 WRITE(NOUT,*) 'ON ENTRY: A, B' 255 WRITE(NOUT,*) ' A - the original matrix (lower triangular)' 256 WRITE(NOUT,*) ' B - the original matrix (lower triangular)' 257 WRITE(NOUT,*) 'ON EXIT: A, B, W' 258 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 259 WRITE(NOUT,*) ' Z**T*B*Z = I' 260 WRITE(NOUT,*) ' B - the triangular factor L from the Cholesky' 261 WRITE(NOUT,*) ' factorization' 262 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 263 A=AA 264 B=BB 265 CALL LA_HEGVD(A,B,W,JOBZ='V',UPLO='L',INFO=INFO) 266 WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGVD:' 267 WRITE(NOUT,FMT) W(:) 268 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGVD:' 269 DO I = 1, N 270 WRITE(NOUT,FMT) A(I,:) 271 END DO 272 WRITE(NOUT,*) 'INFO = ',INFO 273! 274 WRITE(NOUT,*) 275 WRITE(NOUT,*) "CALL LA_HEGVD(A, B, W, 2, 'V', 'L', INFO)" 276 WRITE(NOUT,*) 'LA_HEGVD computes all the eigenvalues and eigenvectors' 277 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 278 WRITE(NOUT,*) 'A*B*x = lambda*x' 279 WRITE(NOUT,*) 'ON ENTRY: A, B' 280 WRITE(NOUT,*) ' A - the original matrix (lower triangular)' 281 WRITE(NOUT,*) ' B - the original matrix (lower triangular)' 282 WRITE(NOUT,*) 'ON EXIT: A, B, W' 283 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 284 WRITE(NOUT,*) ' Z**T*B*Z = I' 285 WRITE(NOUT,*) ' B - the triangular factor L from the Cholesky' 286 WRITE(NOUT,*) ' factorization' 287 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 288 A=AA 289 B=BB 290 CALL LA_HEGVD(A,B,W,2,'V','L',INFO) 291 WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGVD:' 292 WRITE(NOUT,FMT) W(:) 293 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGVD:' 294 DO I = 1, N 295 WRITE(NOUT,FMT) A(I,:) 296 END DO 297 WRITE(NOUT,*) 'INFO = ',INFO 298! 299 WRITE(NOUT,*) 300 WRITE(NOUT,*) "CALL LA_HEGVD(A, B, W, 3, 'V', INFO=INFO)" 301 WRITE(NOUT,*) 'LA_HEGVD computes all the eigenvalues and eigenvectors' 302 WRITE(NOUT,*) 'of a real symmetric-definite generalized eigenproblem' 303 WRITE(NOUT,*) 'B*A*x = lambda*x' 304 WRITE(NOUT,*) 'ON ENTRY: A, B' 305 WRITE(NOUT,*) ' A - the original matrix (upper triangular)' 306 WRITE(NOUT,*) ' B - the original matrix (upper triangular)' 307 WRITE(NOUT,*) 'ON EXIT: A, B, W' 308 WRITE(NOUT,*) ' A - the eigenvectors normalized as follows:' 309 WRITE(NOUT,*) ' Z**T*inv(B)*Z = I' 310 WRITE(NOUT,*) ' B - the triangular factor U from the Cholesky' 311 WRITE(NOUT,*) ' factorization' 312 WRITE(NOUT,*) ' W - the eigenvalues in ascending order' 313 A=AA 314 B=BB 315 CALL LA_HEGVD(A,B,W,3,'V',INFO=INFO) 316 WRITE(NOUT,*) 'The eigenvalues computed by LA_HEGVD:' 317 WRITE(NOUT,FMT) W(:) 318 WRITE(NOUT,*) 'The normalized eigenvectors computed by LA_HEGVD:' 319 DO I = 1, N 320 WRITE(NOUT,FMT) A(I,:) 321 END DO 322 WRITE(NOUT,*) 'INFO = ',INFO 323! 324@type ! 325@type sreal dreal 326END PROGRAM LA_@(pre)SYGVD_ET_EXAMPLE 327@type sherm dherm 328END PROGRAM LA_@(pre)HEGVD_ET_EXAMPLE 329@type ! 330