int main(int argc, char **argv)
{
/********************* variables declaration **************************/
int info, itype, lda, ldb, lwork, order; /* variables for lapack function */
char jobz, uplo; /* variables for lapack function */
int nfreq; /* number of frequencies displayed on the screen */
int d; /* dimension of the problem - determine the size r of the partial basis*/
int shape; /* shape of the body */
int r; /* actual size of the partial basis */
int i, j; /* indices */
int ir1;
int *itab, *ltab, *mtab, *ntab; /* tabulation of indices */
int *irk;
int k;
int ns; /* symmetry of the system */
int hextype; /* type of hexagonal symmetry - VTI or HTI*/
double d1, d2, d3; /* dimension of the sample */
double rho; /* density */
double **cm;
double ****c; /* stiffness tensor */
double **e, **gamma, *work, **w; /* matrices of the eigenvalue problem */
double *wsort;
int outeigen; /* 1 if eigenvectors calculated */
char *eigenfile;
/** FILE *file; */
/********************* end variables declaration **********************/
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(1);
/* get required parameters */
if (!getparint("d", &d)) err("must specify d!\n");
if (!getpardouble("d1", &d1)) err("must specify d1!\n");
if (!getpardouble("d2", &d2)) err("must specify d2!\n");
if (!getpardouble("d3", &d3)) err("must specify d3!\n");
if (!getpardouble("rho", &rho)) err("must specify rho!\n");
if (!getparint("ns", &ns)) err("must specify ns!\n");
cm=ealloc2double(6,6);
for (i=0; i<6; ++i)
for (j=0; j<6; ++j)
cm[i][j]=0.0;
if (ns==2) {
/* isotropic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
cm[0][0]=cm[0][0]/100;
cm[3][3]=cm[3][3]/100;
cm[1][1]=cm[2][2]=cm[0][0];
cm[4][4]=cm[5][5]=cm[3][3];
cm[0][1]=cm[0][2]=cm[1][2]=cm[0][0]- 2.0*cm[3][3];
cm[1][0]=cm[2][0]=cm[2][1]=cm[0][0]- 2.0*cm[3][3];
} else if (ns==3) {
/* cubic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
cm[0][0]=cm[0][0]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[1][1]=cm[2][2]=cm[0][0];
cm[4][4]=cm[5][5]=cm[3][3];
cm[0][2]=cm[1][2]=cm[0][1];
cm[2][0]=cm[2][1]=cm[1][0]=cm[0][1];
} else if (ns==5) {
/* hexagonal */
if (!getparint("hextype", &hextype)) err("must specify hextype!\n");
if (hextype==1) {
/* VTI */
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[5][5]=cm[5][5]/100;
cm[0][0]=cm[1][1]=2.0*cm[5][5] + cm[0][1];
cm[0][2]=cm[2][0]=cm[2][1]=cm[1][2];
cm[1][0]=cm[0][1];
cm[4][4]=cm[3][3];
} else if (hextype==2) {
/* HTI */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[2][2]=cm[2][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[5][5]=cm[5][5]/100;
cm[1][2]=cm[2][1]=cm[2][2] - 2.0*cm[3][3];
cm[0][2]=cm[1][0]=cm[2][0]=cm[0][1];
cm[1][1]=cm[2][2];
cm[4][4]=cm[5][5];
}
else {
err("for hexagonal symmetry hextype must equal 1 (VTI) or 2 (HTI)!\n");
}
}
else if (ns==6){
/* tetragonal */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[3][3]=cm[3][3]/100;
cm[0][1]=cm[0][1]/100;
cm[5][5]=cm[5][5]/100;
cm[1][1]=cm[0][0];
cm[0][2]=cm[2][0]=cm[1][2];
cm[1][0]=cm[0][1];
cm[2][1]=cm[1][2];
cm[4][4]=cm[3][3];
}
else if (ns==9){/* orthorhombic */
if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n");
if (!getpardouble("c22", &cm[1][1])) err("must specify c22!\n");
if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n");
if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n");
if (!getpardouble("c13", &cm[0][2])) err("must specify c13!\n");
if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n");
if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n");
if (!getpardouble("c55", &cm[4][4])) err("must specify c55!\n");
if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n");
cm[0][0]=cm[0][0]/100;
cm[1][1]=cm[1][1]/100;
cm[2][2]=cm[2][2]/100;
cm[1][2]=cm[1][2]/100;
cm[0][2]=cm[0][2]/100;
cm[0][1]=cm[0][1]/100;
cm[3][3]=cm[3][3]/100;
cm[4][4]=cm[4][4]/100;
cm[5][5]=cm[5][5]/100;
cm[2][0]=cm[0][2];
cm[1][0]=cm[0][1];
cm[2][1]=cm[1][2];
}
else err("given elatic moduli does not fit given ns");
/* get optional parameters */
if (!getparint("outeigen", &outeigen)) outeigen=0;
if (outeigen!=0)
if (!getparstring("eigenfile", &eigenfile))
err("must specify eigenfile since outeigen>0!\n");
if (!getparint("shape", &shape)) shape=1; /* changed from zero default to 1 */
if (!getparint("nfreq", &nfreq)) nfreq=10;
/* dimension of the problem */
r= 3*(d+1)*(d+2)*(d+3)/6;
d1=d1/2.0; /* half sample dimensions are used in calculations */
d2=d2/2.0;
d3=d3/2.0;
/* alloc work space*/
itab=ealloc1int(r);
ltab=ealloc1int(r);
mtab=ealloc1int(r);
ntab=ealloc1int(r);
/* relationship between ir and l,m,n - filling tables */
irk=ealloc1int(8);
index_relationship(itab, ltab, mtab, ntab, d, irk);
/* alloc workspace to solve for eigenvalues and eigenfunctions */
e= (double **) malloc(8*sizeof(double *));
for (k=0; k<8; ++k)
e[k] = ealloc1double(irk[k]*irk[k]);
gamma= (double **) malloc(8*sizeof(double *));
for (k=0; k<8; ++k)
gamma[k] = ealloc1double(irk[k]*irk[k]);
/* filling matrix e */
for (k=0; k<8; ++k)
e_fill(e[k], itab, ltab, mtab, ntab,
r, d1, d2, d3, rho, shape, k, irk);
/* stiffness tensor calculation*/
c= (double ****) malloc(sizeof(double ***)*3);
for (i=0; i<3; ++i)
c[i]=ealloc3double(3,3,3);
stiffness (c, cm);
/* filling matrix gamma */
for (k=0; k<8; ++k)
gamma_fill(gamma[k], itab, ltab, mtab,
ntab, r, d1, d2, d3, c, shape, k, irk);
/* clean workspace */
free1int(itab);
free1int(ltab);
free1int(mtab);
free1int(ntab);
for (i=0; i<3; ++i)
free3double(c[i]);
free(c);
fprintf(stderr,"done preparing matrices\n");
/*-------------------------------------------------------------*/
/*--------- solve the generalized eigenvalue problem ----------*/
/*-------------------------------------------------------------*/
w= (double **) malloc(sizeof(double *)*8);
itype=1;
if (outeigen==0) jobz='N';
else jobz='V';
uplo='U';
for (k=0; k<8; ++k){
w[k] =ealloc1double(irk[k]);
lda=ldb=irk[k];
order=irk[k];
lwork=MAX(1, 3*order-1);
work=ealloc1double(lwork);
/* lapack routine */
dsygv_(&itype, &jobz, &uplo, &order, gamma[k],
&lda, e[k], &ldb, w[k], work, &lwork, &info);
free1double(work);
}
/*-------------------------------------------------------------*/
/*-------------------------------------------------------------*/
/*-------------------------------------------------------------*/
wsort=ealloc1double(r);
for (i=0, k=0; k<8; ++k)
for (ir1=0;ir1<irk[k];++ir1,++i)
wsort[i]=w[k][ir1];
/* sorting the eigenfrequencies */
dqksort(r,wsort);
for (i=0, ir1=0; ir1<nfreq;++i)
if ((wsort[i]>0) && ((sqrt(wsort[i])/(2.0*PI))>0.00001)){
++ir1;
/*fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI));*/
fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI));
}
/* modify output of freq values here*/
/* for (k=0;k<8;++k){
for (ir2=0;ir2<irk[k]*irk[k];++ir2){
fprintf(stderr,"gamma[%d][%d]=%f\n",k,ir2,gamma[k][ir2]);
fprintf(stderr,"e[%d][%d]=%f\n",k,ir2,e[k][ir2]);
}
}*/
/******************* write eigenvectors in files ***************/
/*if (outeigen==1){
z=ealloc2double(r,r);
for (ir1=0; ir1<r; ++ir1)
for (ir2=0; ir2<r; ++ir2)
z[ir2][ir1]=gamma[ir1][ir2*r+ir1]; */
/* change the order of the array at the same time */
/* since we go from fortran array */
/* to C array */
/* clean workspace */
/* free1double(gamma);
file = efopen(eigenfile, "w");
efwrite(&irf, sizeof(int), 1, file);
efwrite(w, sizeof(double), r, file);
efwrite(z[0], sizeof(double), r*r, file);
efclose(file);*/
/* clean workspace */
/* free2double(z); */
/* }*/
/* clean workspace */
/* free1double(w); */
/* end of main */
return EXIT_SUCCESS;
}
int main (int argc, char **argv) {
char temp[256];
int kount, nx, ny, nt;
short verbose;
double x, y, t, dv;
double dx, dy, dt;
double xmin, xmax, ymin, ymax, tmin, tmax;
double x0, x1, y0, y1;
int iloc, jloc, kloc, one, zero;
int ***num;
double value;
double ***x_array, ***y_array, ***t_array, ***dv_array;
register int i, j, k;
initargs(argc, argv);
requestdoc (0);
if (!getparshort("verbose" , &verbose)) verbose = 0;
dx = dy = 25.0;
dt = 1.0;
x0 = 511797.36;
x1 = 527792.88;
y0 = 152443.84;
y1 = 169653.51;
kount = 0;
xmin = ymin = tmin = DBL_MAX;
xmax = ymax = tmax = DBL_MIN;
while (((char *) NULL) != fgets ( temp, sizeof(temp), stdin )) {
(void) sscanf ( ((&(temp[0]))), "%lf%lf%lf%lf", &x, &y, &t, &dv );
xmin = min ( xmin, x );
ymin = min ( ymin, y );
tmin = min ( tmin, t );
xmax = max ( xmax, x );
ymax = max ( ymax, y );
tmax = max ( tmax, t );
++kount;
}
nx = nint ( ( xmax - xmin ) / dx ) + 1;
ny = nint ( ( ymax - ymin ) / dy ) + 1;
nt = nint ( ( tmax - tmin ) / dt ) + 1;
if ( verbose ) {
fprintf ( stderr, "Number of input elements = %5d, xmin = %.2f, xmax = %.2f, ymin = %.2f, ymax = %.2f, tmin = %.2f, tmax = %.2f\n", kount+1, xmin, xmax, ymin, ymax, tmin, tmax );
fprintf ( stderr, "dx = %.2f, dy = %.2f, dt = %.2f, nx = %5d, ny = %5d, nt = %5d\n", dx, dy, dt, nx, ny, nt );
}
num = ealloc3int ( nt, ny, nx );
x_array = ealloc3double ( nt, ny, nx );
y_array = ealloc3double ( nt, ny, nx );
t_array = ealloc3double ( nt, ny, nx );
dv_array = ealloc3double ( nt, ny, nx );
for ( i = 0; i < nx; ++i ) for ( j = 0; j < ny; ++j ) for ( k = 0; k < nt; ++k ) num[i][j][k] = 0;
one = 1;
zero = 0;
rewind ( stdin );
while (((char *) NULL) != fgets ( temp, sizeof(temp), stdin )) {
(void) sscanf ( ((&(temp[0]))), "%lf%lf%lf%lf", &x, &y, &t, &dv );
iloc = min ( max ( nint ( ( x - xmin ) / dx ), 0 ), nx );
jloc = min ( max ( nint ( ( y - ymin ) / dx ), 0 ), ny );
kloc = min ( max ( nint ( ( t - tmin ) / dt ), 0 ), nt );
num[iloc][jloc][kloc] += one;
x_array[iloc][jloc][kloc] += x;
y_array[iloc][jloc][kloc] += y;
t_array[iloc][jloc][kloc] += t;
dv_array[iloc][jloc][kloc] += dv;
}
for ( i = 0; i < nx; ++i ) {
for ( j = 0; j < ny; ++j ) {
for ( k = 0; k < nt; ++k ) {
if ( num[i][j][k] > zero ) {
value = num[i][j][k];
x = x_array[i][j][k] / value;
y = y_array[i][j][k] / value;
t = t_array[i][j][k] / value;
dv = dv_array[i][j][k] / value;
printf ( "%-.2f %.2f %.2f %.4f\n", x, y, t, dv );
}
}
}
}
tmin = nint ( tmin );
tmax = nint ( tmax );
printf ( "%-.2f %.2f %.2f %.4f\n", x0, y0, tmin, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x0, y1, tmin, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x1, y0, tmin, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x1, y1, tmin, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x0, y0, tmax, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x0, y1, tmax, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x1, y0, tmax, 0.0);
printf ( "%-.2f %.2f %.2f %.4f\n", x1, y1, tmax, 0.0);
free3int ( num );
free3double ( x_array );
free3double ( y_array );
free3double ( t_array );
free3double ( dv_array );
return EXIT_SUCCESS;
}
