int hudsonstiff(int fill,double vp,double vs,double rho,double cdens,
double aspect,Stiff2D *spar1)
{
/* Note: routine is not written for speed */
double mu,muf=0.,lambda,lambdaf=0.;
double kf,K,M,U11,U33,scal;
double q,x;
int i,j;
double **C0,**C1,**C2,**D,**T;
C0=alloc2double(6,6);
C1=alloc2double(6,6);
C2=alloc2double(6,6);
T=alloc2double(6,6);
D=alloc2double(6,6);
/* initialize matrices */
for(i=0;i<6;i++)
for(j=0;j<6;j++){
C0[j][i]=0.0;
C1[j][i]=0.0;
C2[j][i]=0.0;
}
/* gas or water */
if(fill==0) {
lambdaf=0.0;
muf=0.0;
}
else if (fill==1){
lambdaf=2.25;
muf=0.0;
}
/* compute Lame constants of matrix */
mu=vs*vs*rho;
lambda=vp*vp* rho - 2.* mu;
if(mu <= FLT_EPSILON || lambda <= FLT_EPSILON)
err(" wrong matrix parameters \n");
/* compute diagonal matix D */
kf=lambdaf+2./3.*muf;
K=( (kf + 4./3.*muf)/(PI*aspect*mu) )* (
(lambda + 2.*mu)/(lambda + mu) );
M=( 4.* muf / (PI*aspect*mu) )* ( (lambda + 2.*mu) /
(3.*lambda + 4.* mu) );
U11 = (4./3.)*( lambda + 2.*mu )/ (lambda + mu) / (1.+ K );
U33 = (16./3.)*(lambda + 2.*mu) / (3.*lambda + 4.*mu) /(1.+ M);
/* zero order stiffness */
spar1->a1111 = rho*vp*vp;
spar1->a2323 = rho*vs*vs;
spar1->a1133 = spar1->a1111 - 2.*spar1->a2323;
C0[0][0]=C0[1][1]=C0[2][2]=spar1->a1111;
C0[3][3]=C0[4][4]=C0[5][5]=spar1->a2323;
C0[0][1]=C0[0][2]=C0[1][2]=spar1->a1133;
C0[1][0]=C0[2][0]=C0[2][1]=spar1->a1133;
/* writemat(C0); */
/* first order stiffness */
scal= - cdens/mu;
spar1->a1111 = scal*(lambda + 2.*mu)*(lambda + 2.*mu) ;
spar1->a3333 = scal* lambda *lambda;
spar1->a1313 = scal*mu*mu;
spar1->a1133 = scal*lambda*(lambda + 2.*mu);
T[0][0]=spar1->a1111;
T[0][1]=T[1][0]=T[0][2]=T[2][0]=spar1->a1133;
T[1][1]=T[2][2]=T[1][2]=T[2][1]=spar1->a3333;
T[4][4]=T[5][5]=spar1->a1313;
D[0][0]=D[1][1]=D[2][2]=U11;
D[4][4]=D[5][5]=U33;
matmatmul(T,D,C1);
/* writemat(C1); */
matmatmul(D,D,T);
matmatmov(T,D);
/* second order stiffness */
scal=cdens*cdens/15.;
q=15.*(lambda/mu)*(lambda/mu) + 28.*lambda/mu+28.;
x=2.*mu*(3.*lambda+8.*mu)/(lambda + 2.*mu);
spar1->a1111 = scal*(lambda + 2.*mu)*q;
spar1->a3333 = scal*lambda*lambda*q/(lambda + 2.*mu);
spar1->a1313 = scal*x;
spar1->a1133 = scal*lambda*q;
T[0][0]=spar1->a1111;
T[0][1]=T[1][0]=T[0][2]=T[2][0]=spar1->a1133;
T[1][1]=T[2][2]=T[1][2]=T[2][1]=spar1->a3333;
T[4][4]=T[5][5]=spar1->a1313;
matmatmul(T,D,C2);
/* writemat(C2); */
matmatadd(C0,C1,T);
matmatadd(T,C2,C0);
/* writemat(C0); */
spar1->a1111 = C0[0][0];
spar1->a3333 = C0[2][2];
spar1->a2323 = C0[3][3];
spar1->a1313 = C0[5][5];
spar1->a1133 = C0[0][2];
/* check for HTI symmetry */
if( ABS(C0[2][2]-2.*C0[3][3]-C0[1][2])>FLT_EPSILON)
return -1;
else
return 1;
}
/* the main program */
int main (int argc, char **argv)
{
double vp1,vp2,vs1,vs2,rho1,rho2;
double eps1,eps2,delta1,delta2;
double gamma1,gamma2,azimuth;
float fangle,langle,dangle,angle;
double *coeff,p=0;
double sangle,cangle,sazi,cazi;
float anglef,dummy;
FILE *outparfp=NULL, *coeffp=NULL;
int ibin,modei,modet,rort,iangle,iscale,index;
char *outparfile=NULL,*coeffile=NULL;
Stiff2D *spar1, *spar2;
double **a,*rcond,*z;
int *ipvt;
/* allocate space for stiffness elements */
spar1=(Stiff2D*)emalloc(sizeof(Stiff2D));
spar2=(Stiff2D*)emalloc(sizeof(Stiff2D));
/* allocate space for matrix system */
a = alloc2double(6,6);
coeff = alloc1double(6);
ipvt=alloc1int(6);
z = alloc1double(6);
rcond=alloc1double(6);
/* hook up getpar to handle the parameters */
initargs(argc,argv);
requestdoc(0);
if (!getparint("ibin",&ibin)) ibin = 1;
if (!getparint("modei",&modei)) modei = 0;
if (!getparint("modet",&modet)) modet = 0;
if (!getparint("rort",&rort)) rort = 1;
if (!getparint("iscale",&iscale)) iscale = 0;
if (!getparint("test",&test)) test = 1;
if (!getparint("info",&info)) info = 0;
if(modei != 0 && modei !=1 && modei !=2){
fprintf(stderr," \n ERROR wrong incidence mode \n");
return (-1); /* wrong mode */
}
if(modet != 0 && modet !=1 && modet !=2){
fprintf(stderr," \n ERROR wrong scattering mode \n");
return (-1); /* wrong mode */
}
if(rort != 0 && rort !=1){
fprintf(stderr," ERROR wrong rort parameter \n");
return (-1); /* wrong mode */
}
if(iscale != 0 && iscale !=1 && iscale !=2 && iscale!=3 ){
fprintf(stderr," ERROR wrong iscale parameter \n");
return (-1); /* wrong mode */
}
if (!getparfloat("fangle",&fangle)) fangle = 0.0;
if (!getparfloat("langle",&langle)) langle = 45.0;
if (!getparfloat("dangle",&dangle)) dangle = 1.0;
if (!getpardouble("azimuth",&azimuth)) azimuth = 0.;
if (!getpardouble("vp1",&vp1)) vp1 = 2.0;
if (!getpardouble("vp2",&vp2)) vp2 = 2.0;
if (!getpardouble("vs1",&vs1)) vs1 = 1.0;
if (!getpardouble("vs2",&vs2)) vs2 = 1.0;
if (!getpardouble("rho1",&rho1)) rho1 = 2.7;
if (!getpardouble("rho2",&rho2)) rho2 = 2.7;
if (!getpardouble("eps1",&eps1)) eps1 = 0.;
if (!getpardouble("eps2",&eps2)) eps2 = 0.;
if (!getpardouble("delta1",&delta1)) delta1 = 0.;
if (!getpardouble("delta2",&delta2)) delta2 = 0.;
if (!getpardouble("gamma1",&gamma1)) gamma1 = 0.;
if (!getpardouble("gamma2",&gamma2)) gamma2 = 0.;
if (getparstring("outparfile",&outparfile)) {
outparfp = efopen(outparfile,"w");
} else {
outparfp = efopen("outpar","w");
}
if (getparstring("coeffile",&coeffile)) {
coeffp = efopen(coeffile,"w");
} else {
coeffp = efopen("coeff.data","w");
}
/****** some debugging information ******************/
if(info){
ddprint(azimuth);
ddprint(vp1); ddprint(vs1); ddprint(rho1);
ddprint(eps1); ddprint(delta1); ddprint(gamma1);
ddprint(vp2); ddprint(vs2); ddprint(rho2);
ddprint(eps2); ddprint(delta2); ddprint(gamma2);
}
/* convert into rad */
azimuth=azimuth*PI /180.;
sazi=sin(azimuth);
cazi=cos(azimuth);
/****** convertion into cij's ************************/
if (!thom2stiffTI(vp1,vs1,eps1,delta1,gamma1,PI/2.,spar1,1) ){
fprintf(stderr," \n ERROR in thom2stiffTI (1) \n");
return (-1);
}
if (!thom2stiffTI(vp2,vs2,eps2,delta2,gamma2,PI/2.,spar2,1) ){
fprintf(stderr,"\n ERROR in thom2stiffTI (2) \n");
return (-1);
}
/***** more debugging output ************************/
if(info){
diprint(modei);
diprint(modet);
diprint(rort);
ddprint(spar1->a1111);
ddprint(spar1->a3333);
ddprint(spar1->a1133);
ddprint(spar1->a1313);
ddprint(spar1->a2323);
ddprint(spar1->a1212);
ddprint(spar2->a1111);
ddprint(spar2->a3333);
ddprint(spar2->a1133);
ddprint(spar2->a1313);
ddprint(spar2->a2323);
ddprint(spar2->a1212);
}
/******** find generated wave type-index ************/
/* reflect_P (0) reflect_S (1) transm_P (2) transm_S (3) */
if(modet == 0 && rort==1)
index = 0;
else if(modet == 1 && rort==1)
index = 1;
else if(modet == 2 && rort==1)
index = 2;
else if(modet == 0 && rort==0)
index = 3;
else if(modet == 1 && rort==0)
index = 4;
else if(modet == 2 && rort==0)
index = 5;
else {
fprintf(stderr,"\n ERROR wrong (index) \n ");
return (-1);
}
/***************** LOOP OVER ANGLES ************************/
for(angle=fangle,iangle=0;angle<=langle;angle+=dangle){
if(info) ddprint(angle);
sangle=(double) angle*PI/180;
cangle=cos(sangle);
sangle=sin(sangle);
/* get horizontal slowness */
if(p_hor3DTIH(spar1,modei,sangle,cangle,sazi,cazi,&p)!=1){
fprintf(stderr,"\n ERROR in p_hor3DTIH \n ");
return (-1);
}
/* compute reflection/transmission coefficient */
if(graebner3D(spar1,spar2,rho1,rho2,modei,modet,rort,
sazi,cazi,p,coeff,a,ipvt,z,rcond)!=1){
fprintf(stderr,"\n ERROR in p_hor3DTIH \n ");
return (-1);
}
++iangle;
if(iscale==0)
anglef=(float) angle;
else if(iscale==1)
anglef=(float) angle*PI/180.;
else if(iscale==2)
anglef=(float) p;
else if(iscale==3)
anglef=(float) sangle*sangle;
dummy= (float)coeff[index];
/* Binary output for x_t */
if(ibin==1){
fwrite(&anglef,sizeof(float),1,coeffp);
fwrite(&dummy,sizeof(float),1,coeffp);
/* ASCII output */
} else if(ibin==0){
fprintf(coeffp,"%f %f\n",anglef,dummy);
}
}
/********* No of output pairs for plotting ********/
if(ibin) fprintf(outparfp,"%i\n",iangle);
return 1;
}
main (int argc, char **argv)
{
/*
declaration of variables
*/
int master; /* master_id */
int ncpu; /* size of population & # of cities */
int pop_city; /* number of members / city */
int i,j,icity,ibegin,iend,iw;/* counters */ int ievolution;
int random_gnr; /* read or not trial models from a file */
float auxf; /* """""""" """"" */
float wallcpu; /* wall clock time */
/*
Variables related to the execution of the GAs
*/
int population, ncities; /* pop. size and # of processors */
int genes; /* # of genes */
int numevol; /* # of evolutions */
int Seed; /* Seed for # generation */
int IS_CONVERGING_FLAG = 0; /* flag for convergence */
int icritical; /* next vars are related to convergence */
int other_city;
int ihistory;
int max_stat_evol;
int verbose;
double mmin, mmax; /* max & min value of a gene */
char extension[40]; /* extension of the GENESIS files */
char workdir[50]; /* working directory */
char msg[80]; /* message purposes */
double *vector; /* store parameters of trial solution */
double *Best_perf; /* for the best performance @ city */
double **best_guys; /* best_guy of each processor */
double *dist_current; /* for convergence */
double offset; /* """ """"""""""" */
FILE *fp; /* for reading models */
/*
DEBUG
*/
int vdebug, jdebug;
/*
getting parameters
At this point the setup files for the execution of the GAs will be done.
Note that the same file is used by all cities that are part of the
optimization
*/
setup(argc,argv,extension,workdir,&population,&ncities,&genes,&mmin,&mmax,&Seed,&numevol,&offset,&max_stat_evol,&random_gnr,&verbose);
sranuni(Seed); /* initializing # generator */
population *= ncities; /* that's the total population */
if (verbose)
{
printf("\n");
printf("%d members will be spread among %d populations\n",population,ncities);
}
/*
used for floating representation of chromosomes
*/
vector = (double *) calloc((unsigned) genes, sizeof(double));
/*
used in convergence analysis
*/
dist_current = alloc1double(ncities);
Best_perf = alloc1double(ncities);
/*
just to be safe safe safe
*/
for (icity = 0; icity < ncities; icity++)
dist_current[icity] = 0.;
best_guys = alloc2double(genes,ncities);
/*
Starting now the PVM protocol. The aim is to distribute evenly the
members of the population among the cities
*/
if (verbose)
printf("Starting communication with PVM\n");
master = pvmEnroll(CMASTER);
/*
Create ncities instances of cities
*/
for (icity = 0; icity < ncities; icity++)
{
if (pvmInitiate(CITIES,NULL)<0)
{
printf("Cannot initiate city %d\n",iw);
pvmLeave();
exit(-1);
}
else
{
if (verbose)
printf("Process %d started ok\n", icity);
}
}
/*
Sending master instance to all cities
*/
pvmBeginMessage();
pvmPutNInt(1,&master);
pvmSend(MASTER,CITIES,-1);
/*
Sending for each city the suffix of the data file
*/
pvmBeginMessage();
pvmPutString(extension);
pvmSend(INPUT_FILE,CITIES,-1);
/*
Sending for each city the working directory
*/
pvmBeginMessage();
pvmPutString(workdir);
pvmSend(DIRECTORY,CITIES,-1);
/*
Sending # of processors used in the evolution
*/
pvmBeginMessage();
pvmPutNInt(1,&ncities);
pvmSend(NCITIES,CITIES,-1);
/*
Sending # of evolutions that will be performed
*/
pvmBeginMessage();
pvmPutNInt(1,&numevol);
pvmSend(EVOLVE,CITIES,-1);
/*
Starting sending members to different cities. Maybe it were better to
shuffle them first. Information about members should be sent parameter
by parameter due to limitation of PVM
*/
if (!random_gnr)
{
if ((fp = fopen("models", "r")) == NULL)
{
sprintf(msg, "Cannot open the file MODELS !!!");
Error(msg);
}
printf("Reading %d trial models from file MODELS\n",population);
}
else
{
if (verbose)
printf("Random generation of %d trial models\n",population);
}
ncpu = ncities;
while(ncpu > 0) {
/*
Cities are requesting members
*/
pvmReceive(SEND_MEMBERS);
pvmMessageInfo(NULL,NULL,NULL,&icity);
/*
Limits of the population to be allocated to the city
*/
ibegin = (ncpu - 1) * population / ncities;
iend = ncpu * population / ncities;
for (i = ibegin; i < iend; i++) {
/*
Will send current member to that city
*/
for(j = 0; j < genes; j++)
{
if (!random_gnr)
{
fscanf(fp,"%f\n",&auxf);
vector[j] = (double) auxf;
}
else
vector[j] = Randdouble(mmin,mmax);
}
pvmBeginMessage();
pvmPutNDouble(genes, vector);
/*
Performance and Need_evaluation don't have to be sent
*/
pvmSend(MEMBER,CITIES,icity);
}
ncpu--;
}
/*
Checking convergence of the algorithm. The whole process can be
stopped here if the convergence is not satisfactory
but 1st ...wall clock time
*/
wallcpu = wallsec();
if (verbose)
{
printf("\nMaster will begin convergence analysis:\n");
printf("%d low variance evolutions in a row are allowed\n",max_stat_evol);
printf("This analysis just applies to distributed runs. If only one\n");
printf("subpopulation is effective the stopping criterion is\n");
printf("the number of evolutions.\n\n");
}
ievolution = 0;
do
{
ncpu = ncities;
while(ncpu > 0) {
pvmReceive(IS_IT_CONVERGING);
pvmMessageInfo(NULL,NULL,NULL,&icity);
pvmGetNDouble(genes,&best_guys[icity][0]);
pvmGetNDouble(1,&Best_perf[icity]);
ncpu--;
}
/*
Checking the change of distance in the model space of the best
individuals within each sub-population. This distance is just measured
for adjacent processors
*/
icritical = 0;
/*
icritical is used to store the # of processors that have their
best member without appreciable change since the next generation
*/
for (icity = 0; icity < ncities; icity++)
{
dist_current[icity] = 0.;
other_city = (icity + 1) % ncities;
for (j = 0; j < genes; j++)
{
/*
Calculating the average offset between icity and other_city for this
generation
*/
dist_current[icity] += ABS(best_guys[icity][j] - best_guys[other_city][j]);
}
dist_current[icity] /= (double) genes;
if (dist_current[icity] < offset)
icritical++;
if (verbose)
printf("Best stacking power at subpopulation %d is %.3f at evolution %d\n", icity, ABS(Best_perf[icity]), ievolution+1);
/*
dist_current[icity] refers to the average offset to a neighbour processor
in this generation. if this quantity is smaller than the user-specified
offset, icritical will be incremented
*/
}
if (icritical > NINT(ncities/2)) ihistory ++;
else ihistory = 0;
if (ncities == 1) ihistory = 0;
if (verbose)
printf("%d evolutions with low variance at evolution %d\n",ihistory,ievolution+1);
/*
last statement means that if more than half of the precessors have
the best member without modifications from the last evolution, ihistory
will be incremented
*/
if (ihistory > max_stat_evol) IS_CONVERGING_FLAG = 0;
else IS_CONVERGING_FLAG = 1;
/*
max_stat_evol states the tolerable # of evolutions where the half of
the # of processors can present lack of change in their best members
*/
/*
broadcasting this information to all processors
*/
pvmBeginMessage();
pvmPutNInt(1,&IS_CONVERGING_FLAG);
pvmSend(ABOUT_THE_CONVERGENCE,CITIES,-1);
ievolution ++; /* increm. # of evol */
if (!IS_CONVERGING_FLAG)
printf("ATTENTION ! Low variance populations. Convergenge assumed\n");
}
while(IS_CONVERGING_FLAG && ievolution < numevol);
/*
Waiting end of GLOBAL evolution
*/
ncpu = ncities;
while(ncpu > 0) {
pvmReceive(END_GLOBAL_EVOLUTION);
ncpu--;
}
pvmLeave(); /* Leaving PVM */
printf("\nEnd of SUDGAST.... I hope you got accurate residual statics...\n");
wallcpu = wallsec() - wallcpu;
if (verbose)
fprintf(stderr, "Wall clock time = %f\n", wallcpu);
}
