f08hqce.c

/* nag_lapackeig_zhbevd (f08hqc) Example Program.
 *
 * Copyright 2025 Numerical Algorithms Group.
 *
 * Mark 31.1, 2025.
 */
#include<nag.h>
#include<stdio.h>
intmain(void){
/* Scalars */
Integeri,j,k,kd,n,pdab,pdz,w_len;
Integerexit_status=0;
NagErrorfail;
Nag_JobTypejob;
Nag_UploTypeuplo;
Nag_OrderTypeorder;
/* Arrays */
charnag_enum_arg[40];
Complex*ab=0,*z=0;
double*w=0;
#ifdef NAG_COLUMN_MAJOR
#define AB_UPPER(I, J) ab[(J - 1) * pdab + k + I - J - 1]
#define AB_LOWER(I, J) ab[(J - 1) * pdab + I - J]
#define Z(I, J) z[(J - 1) * pdz + I - 1]
order=Nag_ColMajor;
#else
#define AB_UPPER(I, J) ab[(I - 1) * pdab + J - I]
#define AB_LOWER(I, J) ab[(I - 1) * pdab + k + J - I - 1]
#define Z(I, J) z[(I - 1) * pdz + J - 1]
order=Nag_RowMajor;
#endif
INIT_FAIL(fail);
printf("nag_lapackeig_zhbevd (f08hqc) Example Program Results\n\n");
/* Skip heading in data file */
scanf("%*[^\n] ");
scanf("%"NAG_IFMT"%"NAG_IFMT"%*[^\n] ",&n,&kd);
pdab=kd+1;
pdz=n;
w_len=n;
/* Allocate memory */
if(!(ab=NAG_ALLOC(pdab*n,Complex))||!(w=NAG_ALLOC(w_len,double))||
!(z=NAG_ALLOC(n*n,Complex))){
printf("Allocation failure\n");
exit_status=-1;
gotoEND;
}
/* Read whether Upper or Lower part of A is stored */
scanf("%39s%*[^\n] ",nag_enum_arg);
/* nag_enum_name_to_value (x04nac).
 * Converts NAG enum member name to value
 */
uplo=(Nag_UploType)nag_enum_name_to_value(nag_enum_arg);
/* Read A from data file */
k=kd+1;
if(uplo==Nag_Upper){
for(i=1;i<=n;++i){
for(j=i;j<=MIN(i+kd,n);++j){
scanf(" ( %lf , %lf )",&AB_UPPER(i,j).re,&AB_UPPER(i,j).im);
}
}
scanf("%*[^\n] ");
}else{
for(i=1;i<=n;++i){
for(j=MAX(1,i-kd);j<=i;++j){
scanf(" ( %lf , %lf )",&AB_LOWER(i,j).re,&AB_LOWER(i,j).im);
}
}
scanf("%*[^\n] ");
}
/* Read type of job to be performed */
scanf("%39s%*[^\n] ",nag_enum_arg);
job=(Nag_JobType)nag_enum_name_to_value(nag_enum_arg);
/* Calculate all the eigenvalues and eigenvectors of A */
/* nag_lapackeig_zhbevd (f08hqc).
 * All eigenvalues and optionally all eigenvectors of
 * complex Hermitian band matrix (divide-and-conquer)
 */
nag_lapackeig_zhbevd(order,job,uplo,n,kd,ab,pdab,w,z,pdz,&fail);
if(fail.code!=NE_NOERROR){
printf("Error from nag_lapackeig_zhbevd (f08hqc).\n%s\n",fail.message);
exit_status=1;
gotoEND;
}
/* Normalize the eigenvectors */
for(j=1;j<=n;j++){
for(i=n;i>=1;i--){
Z(i,j)=nag_complex_divide(Z(i,j),Z(1,j));
}
}
/* Print eigenvalues and eigenvectors */
printf(" Eigenvalues\n");
for(i=0;i<n;++i)
printf(" %5"NAG_IFMT" %8.4f\n",i+1,w[i]);
printf("\n");
/* nag_file_print_matrix_complex_gen_comp (x04dbc).
 * Print complex general matrix (comprehensive)
 */
fflush(stdout);
nag_file_print_matrix_complex_gen_comp(
order,Nag_GeneralMatrix,Nag_NonUnitDiag,n,n,z,pdz,Nag_AboveForm,
"%7.4f","Eigenvectors",Nag_IntegerLabels,0,Nag_IntegerLabels,0,80,
0,0,&fail);
if(fail.code!=NE_NOERROR){
printf("Error from nag_file_print_matrix_complex_gen_comp (x04dbc).\n%s\n",
fail.message);
exit_status=1;
gotoEND;
}
END:
NAG_FREE(ab);
NAG_FREE(w);
NAG_FREE(z);
returnexit_status;
}