f08qlce.c

/* nag_lapackeig_dtrsna (f08qlc) Example Program.
 *
 * Copyright 2025 Numerical Algorithms Group.
 *
 * Mark 31.1, 2025.
 */
#include<nag.h>
#include<stdio.h>
intmain(void){
/* Scalars */
Integeri,j,m,n,pdt,pdvl,pdvr;
Integers_len;
Integerexit_status=0;
doubleeps,tnorm;
NagErrorfail;
Nag_OrderTypeorder;
/* Arrays */
double*s=0,*sep=0,*t=0,*vl=0,*vr=0;
#ifdef NAG_COLUMN_MAJOR
#define T(I, J) t[(J - 1) * pdt + I - 1]
order=Nag_ColMajor;
#else
#define T(I, J) t[(I - 1) * pdt + J - 1]
order=Nag_RowMajor;
#endif
INIT_FAIL(fail);
printf("nag_lapackeig_dtrsna (f08qlc) Example Program Results\n");
/* Skip heading in data file */
scanf("%*[^\n] ");
scanf("%"NAG_IFMT"%*[^\n] ",&n);
#ifdef NAG_COLUMN_MAJOR
pdt=n;
pdvl=n;
pdvr=n;
#else
pdt=n;
pdvl=n;
pdvr=n;
#endif
s_len=n;
/* Allocate memory */
if(!(t=NAG_ALLOC(n*n,double))||!(vl=NAG_ALLOC(n*n,double))||
!(vr=NAG_ALLOC(n*n,double))||!(s=NAG_ALLOC(s_len,double))||
!(sep=NAG_ALLOC(s_len,double))){
printf("Allocation failure\n");
exit_status=-1;
gotoEND;
}
/* Read T from data file */
for(i=1;i<=n;++i){
for(j=1;j<=n;++j)
scanf("%lf",&T(i,j));
}
scanf("%*[^\n] ");
/* Calculate right and left eigrnvectors of real upper quasi-triangular
 * matrix T using nag_lapackeig_dtrevc (f08qkc).
 */
nag_lapackeig_dtrevc(order,Nag_BothSides,Nag_ComputeAll,NULL,n,t,pdt,
vl,pdvl,vr,pdvr,n,&m,&fail);
if(fail.code!=NE_NOERROR){
printf("Error from nag_lapackeig_dtrevc (f08qkc).\n%s\n",fail.message);
exit_status=1;
gotoEND;
}
/* Estimate condition numbers for all the eigenvalues and
 * right eigenvectors of real upper quasi-triangular matrix T using
 * nag_lapackeig_dtrsna (f08qlc).
 */
nag_lapackeig_dtrsna(order,Nag_DoBoth,Nag_ComputeAll,NULL,n,t,pdt,vl,
pdvl,vr,pdvr,s,sep,n,&m,&fail);
if(fail.code!=NE_NOERROR){
printf("Error from nag_lapackeig_dtrsna (f08qlc).\n%s\n",fail.message);
exit_status=1;
gotoEND;
}
/* Print condition numbers of eigenvalues and right eigenvectors */
printf("\nS\n");
for(i=0;i<n;++i)
printf("%11.1e",s[i]);
printf("\n\nSep\n");
for(i=0;i<n;++i)
printf("%11.1e",sep[i]);
printf("\n");
/* Calculate approximate error estimates which depends on the 1-norm)
 * of matrix T. The 1-norm of T is calculated using nag_blast_dge_norm
 * (f16rac).
 */
nag_blast_dge_norm(order,Nag_OneNorm,n,n,t,pdt,&tnorm,&fail);
if(fail.code!=NE_NOERROR){
printf("Error from nag_blast_dge_norm (f16rac).\n%s\n",fail.message);
exit_status=1;
gotoEND;
}
/* error estimates also depend on nag_machine_precision (x02ajc). */
eps=nag_machine_precision;
printf("\nApproximate error estimates for eigenvalues"
"of T (machine dependent)\n");
for(i=0;i<m;++i)
printf("%11.1e",eps*tnorm/s[i]);
printf("\n\nApproximate error estimates for right eigenvectors"
"of T (machine dependent)\n");
for(i=0;i<m;++i)
printf("%11.1e",eps*tnorm/sep[i]);
printf("\n");
END:
NAG_FREE(t);
NAG_FREE(s);
NAG_FREE(sep);
NAG_FREE(vl);
NAG_FREE(vr);
returnexit_status;
}