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