1PROGRAM LA_ZGGEVX_ET_EXAMPLE
2!
3!  -- LAPACK95 interface driver routine (version 3.0) --
4!     UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK
5!     September, 2000
6!
7!  .. USE STATEMENTS
8   USE LA_PRECISION, ONLY: WP => DP
9   USE F95_LAPACK, ONLY: LA_GGEVX
10!  .. IMPLICIT STATEMENT ..
11   IMPLICIT NONE
12!  .. PARAMETERS ..
13   CHARACTER(LEN=*), PARAMETER :: FMT = '(4(1X,1H(,F7.3,1H,,F7.3,1H):))'
14   INTEGER, PARAMETER :: NIN=5, NOUT=6
15!  .. LOCAL SCALARS ..
16   CHARACTER(LEN=1) :: BALANC
17   INTEGER :: I, INFO, N, ILO, IHI
18   REAL(WP) :: ABNRM, BBNRM
19!  .. LOCAL ARRAYS ..
20   REAL(WP), ALLOCATABLE :: AA(:,:), BB(:,:)
21   COMPLEX(WP), ALLOCATABLE :: A(:,:), B(:,:), VL(:,:), &
22&    VR(:,:), ALPHA(:), BETA(:), DUMMY(:,:)
23   REAL(WP), ALLOCATABLE :: RCONDE(:), RCONDV(:), LSCALE(:), RSCALE(:)
24!  .. EXECUTABLE STATEMENTS ..
25   WRITE (NOUT,*) 'ZGGEVX ET_Example Program Results.'
26   READ ( NIN, * )   ! SKIP HEADING IN DATA FILE
27   READ ( NIN, * ) N
28   PRINT *, 'N = ', N
29   ALLOCATE ( A(N,N), AA(N,N), ALPHA(N), BETA(N), &
30&    VL(N,N), VR(N,N), B(N,N), BB(N,N) )
31   ALLOCATE(RCONDE(N), RCONDV(N), LSCALE(N), RSCALE(N))
32!
33   READ (NIN, *) AA, BB
34   A=AA; B=BB
35   WRITE(NOUT,*) 'The matrix A:'
36   DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(I,:); ENDDO
37   WRITE(NOUT,*) 'The matrix B:'
38   DO I = 1, N; WRITE (NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(I,:); ENDDO
39!
40   WRITE ( NOUT, * )'---------------------------------------------------------'
41   WRITE ( NOUT, * )
42   WRITE ( NOUT, * )'Details of LA_ZGGEVX LAPACK Subroutine Results.'
43   WRITE ( NOUT, * )
44!
45   BALANC = 'N'
46   WRITE(NOUT,*)
47      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA,  BETA, VL, VR, BALANC=N, ILO, IHI, &
48     &  LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )'
49   A=AA
50   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )
51   WRITE(NOUT,*) 'INFO = ', INFO
52   WRITE(NOUT,*) ' ALPHA:'
53   WRITE(NOUT,FMT) ALPHA
54   WRITE(NOUT,*) ' Beta:'
55   WRITE(NOUT,FMT) BETA
56   WRITE(NOUT,*) 'VL:'
57   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO
58   WRITE(NOUT,*) 'VR:'
59   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO
60   WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI
61   WRITE (NOUT,*) 'ABNRM = ', ABNRM;  WRITE (NOUT,*) 'BBNRM = ', BBNRM
62   WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE
63      WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE
64      WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE
65      WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV
66!
67   BALANC = 'P'
68   WRITE(NOUT,*)
69      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=P, ILO, IHI, &
70     &  LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )'
71   A=AA
72   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )
73   WRITE(NOUT,*) 'INFO = ', INFO
74   WRITE(NOUT,*) ' ALPHA:'
75   WRITE(NOUT,FMT) ALPHA
76   WRITE(NOUT,*) ' Beta:'
77   WRITE(NOUT,FMT) BETA
78   WRITE(NOUT,*) 'VL:'
79   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO
80   WRITE(NOUT,*) 'VR:'
81   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO
82   WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI
83   WRITE (NOUT,*) 'ABNRM = ', ABNRM;  WRITE (NOUT,*) 'BBNRM = ', BBNRM
84   WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE
85      WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE
86      WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE
87      WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV
88!
89   BALANC = 'S'
90   WRITE(NOUT,*)
91      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=S, ILO, IHI, &
92     &  LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )'
93   A=AA
94   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )
95   WRITE(NOUT,*) 'INFO = ', INFO
96   WRITE(NOUT,*) ' ALPHA:'
97   WRITE(NOUT,FMT) ALPHA
98   WRITE(NOUT,*) ' Beta:'
99   WRITE(NOUT,FMT) BETA
100   WRITE(NOUT,*) 'VL:'
101   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO
102   WRITE(NOUT,*) 'VR:'
103   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO
104   WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI
105   WRITE (NOUT,*) 'ABNRM = ', ABNRM;  WRITE (NOUT,*) 'BBNRM = ', BBNRM
106   WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE
107      WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE
108      WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE
109      WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV
110!
111   BALANC = 'B'
112   WRITE(NOUT,*)
113      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR,BALANC=B,&
114     &  ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )'
115   A=AA
116   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC, ILO, IHI, LSCALE, RSCALE, ABNRM, BBNRM, RCONDE, RCONDV, INFO )
117   WRITE(NOUT,*) 'INFO = ', INFO
118   WRITE(NOUT,*) ' ALPHA:'
119   WRITE(NOUT,FMT) ALPHA
120   WRITE(NOUT,*) ' Beta:'
121   WRITE(NOUT,FMT) BETA
122   WRITE(NOUT,*) 'VL:'
123   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VL(:,I); END DO
124   WRITE(NOUT,*) 'VR:'
125   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) VR(:,I); END DO
126   WRITE(NOUT,*) 'ILO = ', ILO; WRITE(NOUT,*) 'IHI = ', IHI
127   WRITE (NOUT,*) 'ABNRM = ', ABNRM;  WRITE (NOUT,*) 'BBNRM = ', BBNRM
128   WRITE(NOUT,*) ' LSCALE :'; WRITE(NOUT,FMT) LSCALE
129      WRITE(NOUT,*) ' RSCALE :'; WRITE(NOUT,FMT) RSCALE
130      WRITE(NOUT,*) ' RCONDE :'; WRITE(NOUT,FMT) RCONDE
131      WRITE(NOUT,*) ' RCONDV :'; WRITE(NOUT,FMT) RCONDV
132!
133   WRITE(NOUT,*)
134   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, INFO=INFO )'
135   A=AA
136   CALL LA_GGEVX( A, B, ALPHA, BETA, INFO=INFO )
137   WRITE(NOUT,*) 'INFO = ', INFO
138   WRITE(NOUT,*) 'A:'
139   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) A(:,I); END DO
140   WRITE(NOUT,*) 'B:'
141   DO I = 1, N; WRITE(NOUT,*) 'I = ', I; WRITE (NOUT,FMT) B(:,I); END DO
142   WRITE(NOUT,*) ' ALPHA:'
143   WRITE(NOUT,FMT) ALPHA
144   WRITE(NOUT,*) ' Beta:'
145   WRITE(NOUT,FMT) BETA
146!STARTING THE ERROR RESULT TESTINGS
147   WRITE(NOUT,*)
148   WRITE(NOUT,*) 'CALL LA_GGEVX( DUMMY, B, ALPHA, BETA, INFO=INFO )'
149   A=AA
150   CALL LA_GGEVX( DUMMY, B, ALPHA, BETA, INFO=INFO )
151   WRITE(NOUT,*) 'INFO = ', INFO
152!
153   WRITE(NOUT,*)
154   WRITE(NOUT,*) 'CALL LA_GGEVX( A, DUMMY, ALPHA, BETA, INFO=INFO )'
155   A=AA
156   CALL LA_GGEVX( A, DUMMY, ALPHA, BETA, INFO=INFO )
157   WRITE(NOUT,*) 'INFO = ', INFO
158! ERROR 3
159   WRITE(NOUT,*)
160   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA(1:N-1), BETA, INFO=INFO )'
161   A=AA
162   CALL LA_GGEVX( A, B, ALPHA(1:N-1), BETA, INFO=INFO )
163   WRITE(NOUT,*) 'INFO = ', INFO
164!
165   WRITE(NOUT,*)
166   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA=BETA(1:N-1), INFO=INFO )'
167   A=AA
168   CALL LA_GGEVX( A, B, ALPHA, BETA=BETA(1:N-1), INFO=INFO )
169   WRITE(NOUT,*) 'INFO = ', INFO
170!ERROR 6
171   WRITE(NOUT,*)
172   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL(:,1:N-1), INFO=INFO )'
173   A=AA
174   CALL LA_GGEVX( A, B, ALPHA, BETA, VL(:,1:N-1), INFO=INFO )
175   WRITE(NOUT,*) 'INFO = ', INFO
176!
177   WRITE(NOUT,*)
178   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL(1:N-1,:), INFO=INFO )'
179   A=AA
180   CALL LA_GGEVX( A, B, ALPHA, BETA, VL(1:N-1,:), INFO=INFO )
181   WRITE(NOUT,*) 'INFO = ', INFO
182!ERROR 7
183   WRITE(NOUT,*)
184   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B,ALPHA, BETA,  VR=VR(1:N-1,:), INFO=INFO )'
185   A=AA
186   CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(1:N-1,:), INFO=INFO )
187   WRITE(NOUT,*) 'INFO = ', INFO
188!
189   WRITE(NOUT,*)
190   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(:,1:N-1), INFO = INFO )'
191   A=AA
192   CALL LA_GGEVX( A, B, ALPHA, BETA, VR=VR(:,1:N-1), INFO = INFO )
193   WRITE(NOUT,*) 'INFO = ', INFO
194!ERROR 8
195   BALANC = 'T'
196   WRITE(NOUT,*)
197   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=T, INFO = INFO)'
198   A=AA
199   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='T', INFO = INFO)
200   WRITE(NOUT,*) 'INFO = ', INFO
201! ERROR 11
202   BALANC = 'T'
203   WRITE(NOUT,*)
204   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, LSCALE=LSCALE(1:N-1), INFO = INFO)'
205   A=AA
206   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B',  LSCALE=LSCALE(1:N-1), INFO = INFO)
207   WRITE(NOUT,*) 'INFO = ', INFO
208! ERROR 12
209   BALANC = 'T'
210   WRITE(NOUT,*)
211   WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), INFO = INFO)'
212   A=AA
213   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1),INFO = INFO)
214   WRITE(NOUT,*) 'INFO = ', INFO
215! ERROR 15
216   BALANC = 'T'
217   WRITE(NOUT,*)
218      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, &
219     &  RSCALE=RSCALE(1:N-1), RCONDE=RCONDE(1:N-1), INFO = INFO)'
220   A=AA
221   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDE=RCONDE(1:N-1), INFO = INFO)
222   WRITE(NOUT,*) 'INFO = ', INFO
223! ERROR 16
224   BALANC = 'T'
225   WRITE(NOUT,*)
226      WRITE(NOUT,*) 'CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC=B, RSCALE=RSCALE(1:N-1), &
227     &  RCONDV=RCONDV(1:N-1), INFO = INFO)'
228   A=AA
229   CALL LA_GGEVX( A, B, ALPHA, BETA, VL, VR, BALANC='B', RSCALE=RSCALE(1 :N-1), RCONDV=RCONDV(1:N-1), INFO = INFO)
230   WRITE(NOUT,*) 'INFO = ', INFO
231END PROGRAM LA_ZGGEVX_ET_EXAMPLE
232