void destroy_parameters(parameters *p) {
if (strcmp(p->datafilename,"dummy"))
free_imatrix(p->genetic_data,1,1);
if (p->npopulations>1)
free_ivector(p->location,1);
p->samplesize=0;
}
/*
* ASSEMBLE_K - assemble global stiffness matrix from individual elements 23feb94
*/
void assemble_K(
double **K,
int DoF, int nE,
vec3 *xyz, float *r, double *L, double *Le,
int *N1, int *N2,
float *Ax, float *Asy, float *Asz,
float *Jx, float *Iy, float *Iz,
float *E, float *G, float *p,
int shear, int geom, double **Q, int debug
){
double **k; /* element stiffness matrix in global coord */
int **ind, /* member-structure DoF index table */
res=0,
i, j, ii, jj, l, ll;
char stiffness_fn[FILENMAX];
for (i=1; i<=DoF; i++) for (j=1; j<=DoF; j++) K[i][j] = 0.0;
k = dmatrix(1,12,1,12);
ind = imatrix(1,12,1,nE);
for ( i=1; i<= nE; i++ ) {
ind[1][i] = 6*N1[i] - 5; ind[7][i] = 6*N2[i] - 5;
ind[2][i] = ind[1][i] + 1; ind[8][i] = ind[7][i] + 1;
ind[3][i] = ind[1][i] + 2; ind[9][i] = ind[7][i] + 2;
ind[4][i] = ind[1][i] + 3; ind[10][i] = ind[7][i] + 3;
ind[5][i] = ind[1][i] + 4; ind[11][i] = ind[7][i] + 4;
ind[6][i] = ind[1][i] + 5; ind[12][i] = ind[7][i] + 5;
}
for ( i = 1; i <= nE; i++ ) {
elastic_K ( k, xyz, r, L[i], Le[i], N1[i], N2[i],
Ax[i],Asy[i],Asz[i], Jx[i],Iy[i],Iz[i], E[i],G[i], p[i], shear);
if (geom)
geometric_K( k, xyz, r, L[i], Le[i], N1[i], N2[i],
Ax[i], Asy[i],Asz[i],
Jx[i], Iy[i], Iz[i],
E[i],G[i], p[i], -Q[i][1], shear);
if (debug) {
res = sprintf(stiffness_fn,"k_%03d",i);
save_dmatrix(stiffness_fn,k,1,12,1,12,0, "w");
}
for ( l=1; l <= 12; l++ ) {
ii = ind[l][i];
for ( ll=1; ll <= 12; ll++ ) {
jj = ind[ll][i];
K[ii][jj] += k[l][ll];
}
}
}
free_dmatrix ( k,1,12,1,12);
free_imatrix(ind,1,12,1,nE);
return;
}
int free_triples_array(Triples_array * triples_array) {
free_imatrix(triples_array->hhh_array);
free_imatrix(triples_array->hhs_array);
free_imatrix(triples_array->hsh_array);
free_imatrix(triples_array->hss_array);
free_imatrix(triples_array->shh_array);
free_imatrix(triples_array->ssh_array);
free_imatrix(triples_array->shs_array);
free_imatrix(triples_array->sss_array);
return 0;
}
void free_results( RESULTS *strct )
/* free a RESULTS struct allocated with alloc_results() */
{
free_ivector(strct->res_serr);
free_ivector(strct->res_nskypix);
free_dvector(strct->res_skyperpix);
free_dvector(strct->res_skystddev);
free_imatrix(strct->res_npix);
free_dmatrix(strct->res_totalflux);
free_dmatrix(strct->res_error);
free_dvector(strct->res_radii);
free_dmatrix(strct->res_apstddev);
free_dmatrix(strct->res_fluxsec);
free_dmatrix(strct->res_mag);
free_dmatrix(strct->res_merr);
return;
}
int in_group_entropy ( Alignment * alignment, int * similar_to, double **score){
int group, col, seq, ctr, aa;
int **freq, *norm; /* ASCII == 128, ASCII size */
double p, entropy;
if ( ! (freq=intmatrix(alignment->no_groups, ASCII)) ) return 1;
if ( ! (norm=emalloc(alignment->no_groups*sizeof(int))) ) return 1;
for (col = 0; col < alignment->length; col++){
/* find frequencies */
for (group=0; group< alignment->no_groups; group++) {
memset (freq[group], 0, ASCII*sizeof(int));
norm[group] = 0;
}
for (seq=0; seq< alignment->number_of_seqs; seq++){
aa = (int) alignment->sequence[seq][col];
if ( aa == 'X' || aa == 'x' ) continue;
if (similar_to) aa=similar_to[aa];
group = alignment->belongs_to_group[seq];
freq [group][aa]++;
norm [group] ++;
}
/* find entropy */
for (group=0; group< alignment->no_groups; group++) {
entropy = 0.0;
for ( ctr=0; ctr < ASCII; ctr++) {
if ( freq[group][ctr] ) {
p = (double)freq[group][ctr]/norm[group];
entropy -= p*log(p);
}
}
score[group][col] = entropy;
}
}
free_imatrix (freq);
free (norm);
return 0;
}
int main(void)
{
int i,j,**nmbr;
float ccc,chisq,cramrv,df,prob;
char dummy[MAXSTR],fate[NDAT+1][16],mon[NMON+1][6],txt[16];
FILE *fp;
nmbr=imatrix(1,NDAT,1,NMON);
if ((fp = fopen("table1.dat","r")) == NULL)
nrerror("Data file table1.dat not found\n");
fgets(dummy,MAXSTR,fp);
fgets(dummy,MAXSTR,fp);
fscanf(fp,"%16c",txt);
txt[15]='\0';
for (i=1;i<=12;i++) fscanf(fp," %s",mon[i]);
fgets(dummy,MAXSTR,fp);
fgets(dummy,MAXSTR,fp);
for (i=1;i<=NDAT;i++) {
fscanf(fp,"%16[^0123456789]",fate[i]);
fate[i][15]='\0';
for (j=1;j<=12;j++)
fscanf(fp,"%d ",&nmbr[i][j]);
}
fclose(fp);
printf("\n%s",txt);
for (i=1;i<=12;i++) printf("%5s",mon[i]);
printf("\n\n");
for (i=1;i<=NDAT;i++) {
printf("%s",fate[i]);
for (j=1;j<=12;j++) printf("%5d",nmbr[i][j]);
printf("\n");
}
cntab1(nmbr,NDAT,NMON,&chisq,&df,&prob,&cramrv,&ccc);
printf("\n%15s chi-squared %20.2f\n"," ",chisq);
printf("%15s degrees of freedom%20.2f\n"," ",df);
printf("%15s probability %20.4f\n"," ",prob);
printf("%15s cramer-v %20.4f\n"," ",cramrv);
printf("%15s contingency coeff.%20.4f\n"," ",ccc);
free_imatrix(nmbr,1,NDAT,1,NMON);
return 0;
}
void trexR(int *threshold, // input, threshold count of rare variants
int *tablevec, // input, vector to fill 3x2 obsTable
double *chistatObs,
double *chi2sided,
double *chi1sided,
int *chistatSign,
double *fisher2sided,
double *fisher1sided,
int *fisherSign,
double *probExcluded)
{
// DECLARE OBJECTS FOR INPUT AND OUTPUT FROM PROGRAM
static int verbose=0;
// PREPARE DATA FOR TREX DRIVER
int nrow=3;
int ncol=2;
int **obsTable = imatrix(1,nrow, 1,ncol);
if(!obsTable)
errmsg("Memory allocation failure for obsTable\n");
fillTable(tablevec, obsTable, nrow, ncol);
// CALL TREX DRIVER
trexDriver(*threshold, obsTable,
chistatObs, chi2sided, chi1sided, chistatSign,
fisher2sided, fisher1sided, fisherSign,
probExcluded, verbose);
// CLEAN MEMORY AND RETURN
free_imatrix(obsTable, 1, nrow, 1, ncol);
return;
}
void delete_block_model(block_model_t *model)
{
//printf("Clean Up After Model 0!\n");
free_dvector(model->a);
//printf("Clean Up After Model 1!\n");
free_dvector(model->inva);
free_dmatrix(model->b);
free_dmatrix(model->c);
free_dvector(model->gx);
free_dvector(model->gy);
free_dvector(model->gx_int);
free_dvector(model->gy_int);
free_dvector(model->gx_sp);
//printf("Clean Up After Model 2!\n");
free_dvector(model->gy_sp);
free_dvector(model->gx_hs);
//printf("Clean Up After Model 3!\n");
free_dvector(model->gy_hs);
free_dvector(model->g_amb);
free_dvector(model->t_vector);
//printf("Clean Up After Model 4!\n");
//free_ivector(model->p);
//printf("Clean Up After Model 5!\n");
free_dmatrix(model->len);
free_dmatrix(model->g);
free_dmatrix(model->lu);
free_imatrix(model->border);
// added by me
//free_flp(model->flp, FALSE);
//model->
//printf("Clean Up After Model 5!\n");
free(model);
}
int find_best_triples_exhaustive_parallel(Representation* X_rep, Representation* Y_rep, int no_top_rmsd,
double * best_rmsd, int ** best_triple_x, int ** best_triple_y,
double **best_quat) {
// initialization of global array of values
no_top_rmsd = TOP_RMSD;
// printf("%d\n", no_top_rmsd);
// printf("proba %d %lf\n", X_rep->N_full, X_rep->cm[0][0]);
double ** best_quat_array = dmatrix(no_top_rmsd * NUM_THREADS, 4);
int ** best_triple_x_array = intmatrix(no_top_rmsd * NUM_THREADS, 3);
int ** best_triple_y_array = intmatrix(no_top_rmsd * NUM_THREADS, 3);
double * best_rmsd_array = (double *) malloc(no_top_rmsd * NUM_THREADS * sizeof (double));
int cnt;
for (cnt = 0; cnt < NUM_THREADS * no_top_rmsd; ++cnt) {
best_rmsd_array[cnt] = BAD_RMSD + 1;
best_triple_x_array[cnt][0] = -1;
}
omp_set_num_threads(NUM_THREADS);
#pragma omp parallel
{
int top_ctr, i, j, k, l, n, m;
int myid = omp_get_thread_num();
double ** best_quat_local = dmatrix(no_top_rmsd, 4);
int ** best_triple_x_local = intmatrix(no_top_rmsd, 3);
int ** best_triple_y_local = intmatrix(no_top_rmsd, 3);
double * best_rmsd_local = (double *) malloc(no_top_rmsd * sizeof (double));
double **x = X_rep->full; // no change
int * x_type = X_rep->full_type; // no change
int NX = X_rep->N_full; // no change
double **y = Y_rep->full;
int * y_type = Y_rep->full_type;
int NY = Y_rep->N_full;
int x_triple[3], y_triple[3];
int chunk;
double cutoff_rmsd = 3.0; /* <<<<<<<<<<<<<<<<< hardcoded */
double rmsd; //
double q_init[4] = {0.0}; // no change
double ** cmx = X_rep->cm; // no change
double ** cmy = Y_rep->cm; // no change
double threshold_dist = THRESHOLD;
/***************************************/
/* find reasonable triples of SSEs */
/* that correspond in type */
/* and can be mapped onto each other */
/***************************************/
for (top_ctr = 0; top_ctr < no_top_rmsd; top_ctr++) {
best_rmsd_local[top_ctr] = BAD_RMSD + 1;
best_triple_x_local[top_ctr][0] = -1;
}
/*
* Exhaustive search through a 6D space - ugly code
* Parallelization
*/
#pragma omp for
for (i = 0; i < NX; ++i) {
for (j = 0; j < NY - 2; ++j) {
if (x_type[i] != y_type[j]) continue;
for (k = 0; k < NX; ++k) {
if (k == i) continue;
if (two_point_distance(cmx[i], cmx[k]) > THRESHOLD) continue;
for (l = j + 1; l < NY - 1; ++l) {
if (x_type[k] != y_type[l]) continue;
if (two_point_distance(cmy[j], cmy[l]) > THRESHOLD) continue;
for (m = 0; m < NX; ++m) {
if (m == k || m == i) continue;
if (two_point_distance(cmx[i], cmx[m]) > THRESHOLD) continue;
if (two_point_distance(cmx[k], cmx[m]) > THRESHOLD) continue;
for (n = l + 1; n < NY; ++n) {
if (x_type[m] != y_type[n]) continue;
if (two_point_distance(cmy[j], cmy[n]) > THRESHOLD) continue;
if (two_point_distance(cmy[l], cmy[n]) > THRESHOLD) continue;
x_triple[0] = i;
y_triple[0] = j;
x_triple[1] = k;
y_triple[1] = l;
x_triple[2] = m;
y_triple[2] = n;
if (!same_hand_triple(X_rep, x_triple, Y_rep, y_triple, 3)) continue;
if (distance_of_nearest_approach(X_rep, x_triple,
Y_rep, y_triple, 3, &rmsd)) continue;
if (rmsd > cutoff_rmsd) continue;
//if (opt_quat(x, NX, x_triple, y, NY, y_triple, 3, q_init, &rmsd)) continue;
for (top_ctr = 0; top_ctr < no_top_rmsd; top_ctr++) {
// insertion of a new values in arrays keeping arrays sorted
if (rmsd <= best_rmsd_local[top_ctr]) {
chunk = no_top_rmsd - top_ctr - 1;
if (chunk) {
memmove(best_rmsd_local + top_ctr + 1,
best_rmsd_local + top_ctr, chunk * sizeof(double));
memmove(best_quat_local[top_ctr + 1],
best_quat_local[top_ctr], chunk * 4 * sizeof(double));
memmove(best_triple_x_local[top_ctr + 1],
best_triple_x_local[top_ctr], chunk * 3 * sizeof (int));
memmove(best_triple_y_local[top_ctr + 1],
best_triple_y_local[top_ctr], chunk * 3 * sizeof (int));
}
best_rmsd_local[top_ctr] = rmsd;
memcpy(best_quat_local[top_ctr], q_init, 4 * sizeof (double));
memcpy(best_triple_x_local[top_ctr], x_triple, 3 * sizeof (int));
memcpy(best_triple_y_local[top_ctr], y_triple, 3 * sizeof (int));
break;
}
}
}
}
}
}
}
// printf("%d\n", i);
// each thread copies values to global arrays in accordance with its thread id
// printf("myid: %d\n", myid);
memcpy(*(best_quat_array + myid * no_top_rmsd), *(best_quat_local), no_top_rmsd * 4 * sizeof (double));
memcpy(*(best_triple_y_array + myid * no_top_rmsd), *(best_triple_y_local), no_top_rmsd * 3 * sizeof (int));
memcpy(*(best_triple_x_array + myid * no_top_rmsd), *(best_triple_x_local), no_top_rmsd * 3 * sizeof (int));
memcpy(best_rmsd_array + myid*no_top_rmsd, best_rmsd_local, no_top_rmsd * sizeof (double));
}
free_dmatrix(best_quat_local);
free_imatrix(best_triple_x_local);
free_imatrix(best_triple_y_local);
free(best_rmsd_local);
// parallel sort of elements of arrays
sortTriplets(best_triple_x_array, best_triple_y_array, best_rmsd_array, best_quat_array, no_top_rmsd);
}
//
/*
memcpy(*best_quat, *best_quat_array, no_top_rmsd * 4 * sizeof(double));
*/
memcpy(*best_triple_y, *best_triple_y_array, no_top_rmsd * 3 * sizeof (int));
memcpy(*best_triple_x, *best_triple_x_array, no_top_rmsd * 3 * sizeof (int));
memcpy(best_rmsd, best_rmsd_array, no_top_rmsd * sizeof (double));
free_dmatrix(best_quat_array);
free_imatrix(best_triple_x_array);
free_imatrix(best_triple_y_array);
free(best_rmsd_array);
return 0;
}
void create_RC_matrices(flp_t *flp, int omit_lateral)
{
int i, j, k = 0, n = flp->n_units;
int **border;
double **len, *gx, *gy, **g, *c_ver, **t, *gx_sp, *gy_sp;
double r_sp1, r_sp2, r_hs; /* lateral resistances to spreader and heatsink */
/* NOTE: *_mid - the vertical R/C from CENTER nodes of spreader
* and heatsink. *_per - the vertical R/C from PERIPHERAL (n,s,e,w) nodes
*/
double r_sp_per, r_hs_mid, r_hs_per, c_sp_per, c_hs_mid, c_hs_per;
double gn_sp=0, gs_sp=0, ge_sp=0, gw_sp=0;
double w_chip = get_total_width (flp); /* x-axis */
double l_chip = get_total_height (flp); /* y-axis */
border = imatrix(n, 4);
len = matrix(n, n); /* len[i][j] = length of shared edge bet. i & j */
gx = vector(n); /* lumped conductances in x direction */
gy = vector(n); /* lumped conductances in y direction */
gx_sp = vector(n); /* lateral conductances in the spreader layer */
gy_sp = vector(n);
g = matrix(NL*n+EXTRA, NL*n+EXTRA); /* g[i][j] = conductance bet. nodes i & j */
c_ver = vector(NL*n+EXTRA); /* vertical capacitance */
b = matrix(NL*n+EXTRA, NL*n+EXTRA); /* B, C, INVA and INVB are (NL*n+EXTRA)x(NL*n+EXTRA) matrices */
c = matrix(NL*n+EXTRA, NL*n+EXTRA);
inva = matrix(NL*n+EXTRA, NL*n+EXTRA);
invb = matrix(NL*n+EXTRA, NL*n+EXTRA);
t = matrix (NL*n+EXTRA, NL*n+EXTRA); /* copy of B */
/* compute the silicon fitting factor - see pg 10 of the UVA CS tech report - CS-TR-2003-08 */
factor_chip = C_FACTOR * ((SPEC_HEAT_INT / SPEC_HEAT_SI) * (w_chip + 0.88 * t_interface) \
* (l_chip + 0.88 * t_interface) * t_interface / ( w_chip * l_chip * t_chip) + 1);
/* fitting factor for interface - same rationale as above */
factor_int = C_FACTOR * ((SPEC_HEAT_CU / SPEC_HEAT_INT) * (w_chip + 0.88 * t_spreader) \
* (l_chip + 0.88 * t_spreader) * t_spreader / ( w_chip * l_chip * t_interface) + 1);
/*printf("fitting factors : %lf, %lf\n", factor_chip, factor_int); */
/* gx's and gy's of blocks */
for (i = 0; i < n; i++) {
/* at the silicon layer */
if (omit_lateral) {
gx[i] = gy[i] = 0;
}
else {
gx[i] = 1.0/getr(K_SI, flp->units[i].height, flp->units[i].width, l_chip, t_chip);
gy[i] = 1.0/getr(K_SI, flp->units[i].width, flp->units[i].height, w_chip, t_chip);
}
/* at the spreader layer */
gx_sp[i] = 1.0/getr(K_CU, flp->units[i].height, flp->units[i].width, l_chip, t_spreader);
gy_sp[i] = 1.0/getr(K_CU, flp->units[i].width, flp->units[i].height, w_chip, t_spreader);
}
/* shared lengths between blocks */
for (i = 0; i < n; i++)
for (j = i; j < n; j++)
len[i][j] = len[j][i] = get_shared_len(flp, i, j);
/* lateral R's of spreader and sink */
r_sp1 = getr(K_CU, (s_spreader+3*w_chip)/4.0, (s_spreader-w_chip)/4.0, w_chip, t_spreader);
r_sp2 = getr(K_CU, (3*s_spreader+w_chip)/4.0, (s_spreader-w_chip)/4.0, (s_spreader+3*w_chip)/4.0, t_spreader);
r_hs = getr(K_CU, (s_sink+3*s_spreader)/4.0, (s_sink-s_spreader)/4.0, s_spreader, t_sink);
/* vertical R's and C's of spreader and sink */
r_sp_per = RHO_CU * t_spreader * 4.0 / (s_spreader * s_spreader - w_chip*l_chip);
c_sp_per = factor_pack * SPEC_HEAT_CU * t_spreader * (s_spreader * s_spreader - w_chip*l_chip) / 4.0;
r_hs_mid = RHO_CU * t_sink / (s_spreader*s_spreader);
c_hs_mid = factor_pack * SPEC_HEAT_CU * t_sink * (s_spreader * s_spreader);
r_hs_per = RHO_CU * t_sink * 4.0 / (s_sink * s_sink - s_spreader*s_spreader);
c_hs_per = factor_pack * SPEC_HEAT_CU * t_sink * (s_sink * s_sink - s_spreader*s_spreader) / 4.0;
/* short the R's from block centers to a particular chip edge */
for (i = 0; i < n; i++) {
if (eq(flp->units[i].bottomy + flp->units[i].height, l_chip)) {
gn_sp += gy_sp[i];
border[i][2] = 1; /* block is on northern border */
}
if (eq(flp->units[i].bottomy, 0)) {
gs_sp += gy_sp[i];
border[i][3] = 1; /* block is on southern border */
}
if (eq(flp->units[i].leftx + flp->units[i].width, w_chip)) {
ge_sp += gx_sp[i];
border[i][1] = 1; /* block is on eastern border */
}
if (eq(flp->units[i].leftx, 0)) {
gw_sp += gx_sp[i];
border[i][0] = 1; /* block is on western border */
}
}
/* overall R and C between nodes */
for (i = 0; i < n; i++) {
double area = (flp->units[i].height * flp->units[i].width);
/*
* amongst functional units in the various layers
* resistances in the interface layer are assumed
* to be infinite
*/
for (j = 0; j < n; j++) {
double part = 0, part_sp = 0;
if (is_horiz_adj(flp, i, j)) {
part = gx[i] / flp->units[i].height;
part_sp = gx_sp[i] / flp->units[i].height;
}
else if (is_vert_adj(flp, i,j)) {
part = gy[i] / flp->units[i].width;
part_sp = gy_sp[i] / flp->units[i].width;
}
g[i][j] = part * len[i][j];
g[HSP*n+i][HSP*n+j] = part_sp * len[i][j];
}
/* vertical g's in the silicon layer */
g[i][IFACE*n+i]=g[IFACE*n+i][i]=2.0/(RHO_SI * t_chip / area);
/* vertical g's in the interface layer */
g[IFACE*n+i][HSP*n+i]=g[HSP*n+i][IFACE*n+i]=2.0/(RHO_INT * t_interface / area);
/* vertical g's in the spreader layer */
g[HSP*n+i][NL*n+SP_B]=g[NL*n+SP_B][HSP*n+i]=2.0/(RHO_CU * t_spreader / area);
/* C's from functional units to ground */
c_ver[i] = factor_chip * SPEC_HEAT_SI * t_chip * area;
/* C's from interface portion of the functional units to ground */
c_ver[IFACE*n+i] = factor_int * SPEC_HEAT_INT * t_interface * area;
/* C's from spreader portion of the functional units to ground */
c_ver[HSP*n+i] = factor_pack * SPEC_HEAT_CU * t_spreader * area;
/* lateral g's from block center (spreader layer) to peripheral (n,s,e,w) spreader nodes */
g[HSP*n+i][NL*n+SP_N]=g[NL*n+SP_N][HSP*n+i]=2.0*border[i][2]/((1.0/gy_sp[i])+r_sp1*gn_sp/gy_sp[i]);
g[HSP*n+i][NL*n+SP_S]=g[NL*n+SP_S][HSP*n+i]=2.0*border[i][3]/((1.0/gy_sp[i])+r_sp1*gs_sp/gy_sp[i]);
g[HSP*n+i][NL*n+SP_E]=g[NL*n+SP_E][HSP*n+i]=2.0*border[i][1]/((1.0/gx_sp[i])+r_sp1*ge_sp/gx_sp[i]);
g[HSP*n+i][NL*n+SP_W]=g[NL*n+SP_W][HSP*n+i]=2.0*border[i][0]/((1.0/gx_sp[i])+r_sp1*gw_sp/gx_sp[i]);
}
/* max slope (max_power * max_vertical_R / vertical RC time constant) for silicon */
max_slope = MAX_PD / (factor_chip * t_chip * SPEC_HEAT_SI);
/* vertical g's and C's between central nodes */
/* between spreader bottom and sink bottom */
g[NL*n+SINK_B][NL*n+SP_B]=g[NL*n+SP_B][NL*n+SINK_B]=2.0/r_hs_mid;
/* from spreader bottom to ground */
c_ver[NL*n+SP_B]=c_hs_mid;
/* from sink bottom to ground */
c_ver[NL*n+SINK_B] = factor_pack * c_convec;
/* g's and C's from peripheral(n,s,e,w) nodes */
for (i = 1; i <= 4; i++) {
/* vertical g's between peripheral spreader nodes and spreader bottom */
g[NL*n+SP_B-i][NL*n+SP_B]=g[NL*n+SP_B][NL*n+SP_B-i]=2.0/r_sp_per;
/* lateral g's between peripheral spreader nodes and peripheral sink nodes */
g[NL*n+SP_B-i][NL*n+SINK_B-i]=g[NL*n+SINK_B-i][NL*n+SP_B-i]=2.0/(r_hs + r_sp2);
/* vertical g's between peripheral sink nodes and sink bottom */
g[NL*n+SINK_B-i][NL*n+SINK_B]=g[NL*n+SINK_B][NL*n+SINK_B-i]=2.0/r_hs_per;
/* from peripheral spreader nodes to ground */
c_ver[NL*n+SP_B-i]=c_sp_per;
/* from peripheral sink nodes to ground */
c_ver[NL*n+SINK_B-i]=c_hs_per;
}
/* calculate matrices A, B such that A(dT) + BT = POWER */
for (i = 0; i < NL*n+EXTRA; i++) {
for (j = 0; j < NL*n+EXTRA; j++) {
if (i==j) {
inva[i][j] = 1.0/c_ver[i];
if (i == NL*n+SINK_B) /* sink bottom */
b[i][j] += 1.0 / r_convec;
for (k = 0; k < NL*n+EXTRA; k++) {
if ((g[i][k]==0.0)||(g[k][i])==0.0)
continue;
else
/* here is why the 2.0 factor comes when calculating g[][] */
b[i][j] += 1.0/((1.0/g[i][k])+(1.0/g[k][i]));
}
} else {
inva[i][j]=0.0;
if ((g[i][j]==0.0)||(g[j][i])==0.0)
b[i][j]=0.0;
else
b[i][j]=-1.0/((1.0/g[i][j])+(1.0/g[j][i]));
}
}
}
/* we are always going to use the eqn dT + A^-1 * B T = A^-1 * POWER. so, store C = A^-1 * B */
matmult(c, inva, b, NL*n+EXTRA);
/* we will also be needing INVB so store it too */
copy_matrix(t, b, NL*n+EXTRA, NL*n+EXTRA);
matinv(invb, t, NL*n+EXTRA);
/* dump_vector(c_ver, NL*n+EXTRA); */
/* dump_matrix(g, NL*n+EXTRA, NL*n+EXTRA); */
/* dump_matrix(c, NL*n+EXTRA, NL*n+EXTRA); */
/* cleanup */
free_matrix(t, NL*n+EXTRA);
free_matrix(g, NL*n+EXTRA);
free_matrix(len, n);
free_imatrix(border, n);
free_vector(c_ver);
free_vector(gx);
free_vector(gy);
free_vector(gx_sp);
free_vector(gy_sp);
}
/*
* Function to be called from Python
*/
static PyObject* py_smith_waterman_context(PyObject* self, PyObject* args)
{
char *seq1 = NULL;
char *seq2 = NULL;
char retstr[100] = {'\0'};
int len1, len2;
int i, j;
int gap_opening, gap_extension;
static int ** similarity = NULL;
PyArg_ParseTuple(args, "s#s#ii", &seq1, &len1, &seq2, &len2, &gap_opening, &gap_extension);
if (!seq1 || !seq2) {
sprintf (retstr, "no seq in py_smith_waterman_context");
return Py_BuildValue("s", retstr);
}
/* passing a matrix this way is all to painful, so we'll elegantyly hardcode it: */
if ( !similarity) {
similarity = imatrix(ASCII_SIZE, ASCII_SIZE);
if (!similarity) {
sprintf (retstr, "error alloc matrix space");
return Py_BuildValue("s", retstr);
}
load_sim_matrix (similarity);
}
/**********************************************************************************/
//int gap_opening = -5; // used in 15_make_maps
//int gap_extension = -3;
//char gap_character = '-'
//int gap_opening = -3; // used in 25_db_migration/06_make_alignments
//int gap_extension = 0;
char gap_character = '#';
int endgap = 0;
int use_endgap = 0;
int far_away = -1;
int max_i = len1;
int max_j = len2;
// allocation, initialization
int **F = NULL;
char **direction = NULL;
int *map_i2j = NULL;
int *map_j2i = NULL;
if ( ! (F= imatrix (max_i+1, max_j+1)) ) {
sprintf (retstr, "error alloc matrix space");
return Py_BuildValue("s", retstr);
}
if ( ! (direction = cmatrix (max_i+1, max_j+1)) ) {
sprintf (retstr, "error alloc matrix space");
return Py_BuildValue("s", retstr);
}
if (! (map_i2j = emalloc( (max_i+1)*sizeof(int))) ) {
sprintf (retstr, "error alloc matrix space");
return Py_BuildValue("s", retstr);
}
if (! (map_j2i = emalloc( (max_j+1)*sizeof(int))) ) {
sprintf (retstr, "error alloc matrix space");
return Py_BuildValue("s", retstr);
}
for (i=0; i<=max_i; i++) map_i2j[i]=far_away;
for (j=0; j<=max_j; j++) map_j2i[j]=far_away;
int F_max = far_away;
int F_max_i = 0;
int F_max_j = 0;
int penalty = 0;
int i_sim, j_sim, diag_sim, max_sim;
int i_between_exons = 1;
int j_between_exons = 1;
//
for (i=0; i<=max_i; i++) {
if (i > 0) {
if (seq1[i-1] == 'B') {
i_between_exons = 0;
} else if ( seq1[i-1] == 'Z'){
i_between_exons = 1;
}
}
for (j=0; j<=max_j; j++) {
if (j > 0) {
if (seq2[j-1] == 'B') {
j_between_exons = 0;
} else if (seq2[j-1] == 'Z') {
j_between_exons = 1;
}
}
if ( !i && !j ){
F[0][0] = 0;
direction[i][j] = 'd';
continue;
}
if ( i && j ){
/**********************************/
penalty = 0;
if ( direction[i-1][j] == 'i' ) {
// gap extension
if (j_between_exons) {
penalty = 0;
} else {
if (use_endgap && j==max_j){
penalty = endgap;
} else {
penalty = gap_extension;
}
}
} else {
// gap opening */
if (j_between_exons) {
penalty = 0;
} else {
if (use_endgap && j==max_j){
penalty = endgap;
} else{
penalty = gap_opening;
}
}
}
i_sim = F[i-1][j] + penalty;
/**********************************/
penalty = 0;
if ( direction[i][j-1] == 'j' ) {
// gap extension
if (i_between_exons) {
penalty = 0;
} else {
if (use_endgap && i==max_i){
penalty = endgap;
} else{
penalty = gap_extension;
}
}
} else {
// gap opening */
if (i_between_exons) {
penalty = 0;
} else {
if (use_endgap && i==max_i){
penalty = endgap;
} else {
penalty = gap_opening;
}
}
}
j_sim = F[i][j-1] + penalty;
/**********************************/
diag_sim = F[i-1][j-1] + similarity [seq1[i-1]][seq2[j-1]];
/**********************************/
max_sim = diag_sim;
direction[i][j] = 'd';
if ( i_sim > max_sim ){
max_sim = i_sim;
direction[i][j] = 'i';
}
if ( j_sim > max_sim ) {
max_sim = j_sim;
direction[i][j] = 'j';
}
} else if (j) {
penalty = 0;
if (j_between_exons) {
penalty = 0;
} else {
if (use_endgap) {
penalty = endgap;
} else {
if ( direction[i][j-1] =='j' ) {
penalty = gap_extension;
} else {
penalty = gap_opening;
}
}
}
j_sim = F[i][j-1] + penalty;
max_sim = j_sim;
direction[i][j] = 'j';
} else if (i) {
penalty = 0;
if (i_between_exons) {
penalty = 0;
} else {
if ( use_endgap) {
penalty = endgap;
} else {
if ( direction[i-1][j] == 'i' ) {
penalty = gap_extension;
} else {
penalty = gap_opening;
}
}
}
i_sim = F[i-1][j] + penalty;
max_sim = i_sim;
direction[i][j] = 'i';
}
if (max_sim < 0.0 ) max_sim = 0.0;
F[i][j] = max_sim;
if ( F_max < max_sim ) {
// TODO{ tie break here */
F_max = max_sim;
F_max_i = i;
F_max_j = j;
}
}
}
i = F_max_i;
j = F_max_j;
// aln_score = F[i][j] ;
while ( i>0 || j >0 ){
if ( i<0 || j<0 ){
sprintf (retstr, "Retracing error");
return Py_BuildValue("s", retstr);
}
if (direction[i][j] == 'd'){
map_i2j [i-1] = j-1;
map_j2i [j-1] = i-1;
i-= 1;
j-= 1;
} else if (direction[i][j] == 'i') {
map_i2j [i-1] = far_away;
i-= 1 ;
} else if (direction[i][j] == 'j') {
map_j2i [j-1] = far_away;
j-= 1 ;
} else{
sprintf (retstr, "Retracing error");
return Py_BuildValue("s", retstr);
}
}
char * aligned_seq_1 = NULL;
char * aligned_seq_2 = NULL;
/* (lets hope it gets properly freed in the main program */
if (! (aligned_seq_1 = emalloc( (len1+len2)*sizeof(char))) ) {
sprintf (retstr, "error alloc array space");
return Py_BuildValue("s", retstr);
}
if (! (aligned_seq_2 = emalloc( (len1+len2)*sizeof(char))) ) {
sprintf (retstr, "error alloc array space");
return Py_BuildValue("s", retstr);
}
i = 0;
j = 0;
int done = 0;
int pos = 0;
while (!done) {
if (j>=max_j && i>=max_i){
done = 1;
} else if (j<max_j && i<max_i){
if (map_i2j[i] == j){
aligned_seq_1[pos] = seq1[i];
aligned_seq_2[pos] = seq2[j];
i += 1;
j += 1;
} else if (map_i2j[i] < 0){
aligned_seq_1[pos] = seq1[i];
aligned_seq_2[pos] = gap_character;
i += 1;
} else if (map_j2i[j] < 0){
aligned_seq_1[pos] = gap_character;
aligned_seq_2[pos] = seq2[j];
j += 1;
}
} else if (j<max_j){
aligned_seq_1[pos] = gap_character;
aligned_seq_2[pos] = seq2[j];
j += 1;
} else {
aligned_seq_1[pos] = seq1[i];
aligned_seq_2[pos] = gap_character;
i += 1;
}
pos ++;
}
free_imatrix(F);
free_cmatrix(direction);
free(map_i2j);
free(map_j2i);
return Py_BuildValue("ss", aligned_seq_1, aligned_seq_2 );
}
void spacodi(int *np, int *ns, double *sp_plot, double *distmat, int *abundtype,
int *Ndclass, double *dclass, double *Ist_out, double *Pst_out, double *Bst_out, double *PIst_out,
double *pairwiseIst_out, double *pairwisePst_out, double *pairwiseBst_out, double *pairwisePIst_out) // Modified by jme 01-12-10
{
int NP,NS,abundt,Ndivc;
int s1,s2,p1,p2,c, **sps,counter; //Modified by jme 01-12-10
double **fps, **dist, divc[102];
double phylod,maxdist,F1,F2;
float ***DivIijc,***DivPijc,***DivPIijc,***DivSijc;
double **Ist,**Pst,**Bst,**PIst;
double divIb[102],divIw[102],divPb[102],divPw[102],divBb[102],divBw[102],divPIb[102],divPIw[102],sumIb,sumIw1,sumIw2,sumPb,sumPw1,sumPw2,sumSb,sumSw1,sumSw2,sumPIb,sumPIw1,sumPIw2;
double Istc[102],Pstc[102],Bstc[102],PIstc[102];
NP=(*np); //# plots
NS=(*ns); //# species
abundt=(*abundtype); //type of abundance (0, 1 or 2)
Ndivc=(*Ndclass); //# of classes of divergence intervals
fps=dmatrix(0,NP,0,NS); //frequency per plot and species
dist=dmatrix(0,NS,0,NS);//divergence matrix between species
for(s1=1; s1<=NS; s1++)for(s2=1; s2<=NS; s2++) dist[s1][s2]=distmat[(s1-1)+NS*(s2-1)];
for(p1=1; p1<=NP; p1++)for(s1=1; s1<=NS; s1++) fps[p1][s1]=sp_plot[(s1-1)+NS*(p1-1)];
for(c=1; c<=Ndivc; c++) divc[c]=dclass[c-1];
//if dist classes are given, check if last class is larger or equal to max dist,
// otherwise add a class
maxdist=0.;
for(s1=1; s1<NS; s1++)for(s2=s1+1; s2<=NS; s2++) if(maxdist<dist[s1][s2]) maxdist=dist[s1][s2];
if(Ndivc) {
if(divc[Ndivc]<maxdist) {
Ndivc++;
divc[Ndivc]=maxdist;
//(*Ndclass)++;
//dclass[Ndivc-1]=maxdist;
}
}
else {
Ndivc=1;
divc[1]=maxdist;
}
//identify species present in each plot and attribute a new numerotation (to speed loops)
// sps[plot][0]=number of species in plot
// sps[plot][new sp number]=absolute sp number
// where 'new sp number' ranges from 1 to number of species in plot,
// and 'absolute sp number' ranges from 1 to NS
sps=imatrix(0,NP,0,NS);
for(p1=0; p1<=NP; p1++) {
sps[p1][0]=0;
for(s1=1; s1<=NS; s1++) if(fps[p1][s1]) {
sps[p1][0]++;
sps[p1][sps[p1][0]]=s1;
}
}
//transform abundances in relative frequencies per plot
//sum of abundances per plot stored in fps[plot][0]
for(p1=1; p1<=NP; p1++) {
fps[p1][0]=0.;
for(s1=1; s1<=sps[p1][0]; s1++) fps[p1][0]+=fps[p1][sps[p1][s1]];
for(s1=1; s1<=sps[p1][0]; s1++) fps[p1][sps[p1][s1]]/=fps[p1][0];
}
//create 3-dim arrays to store values per pair of plots and per divergence classes
// c=0 for pairs intra-sp, c=-1 for sums over all classes
DivIijc=f3tensor(0,NP,0,NP,-1,Ndivc); //freq of pairs of ind
DivPijc=f3tensor(0,NP,0,NP,-1,Ndivc); //mean dist between ind
DivSijc=f3tensor(0,NP,0,NP,-1,Ndivc); //freq of pairs of species
DivPIijc=f3tensor(0,NP,0,NP,-1,Ndivc); //mean dist between species
//compute diversity within and between plots
for(p1=1; p1<=NP; p1++)for(p2=p1; p2<=NP; p2++) {
for(c=-1; c<=Ndivc; c++) DivIijc[p1][p2][c]=DivPijc[p1][p2][c]=DivSijc[p1][p2][c]=DivPIijc[p1][p2][c]=0.f;
for(s1=1; s1<=sps[p1][0]; s1++) {
F1=fps[p1][sps[p1][s1]];
for(s2=1; s2<=sps[p2][0]; s2++) {
F2=fps[p2][sps[p2][s2]];
if(p1==p2 && s1==s2 && abundt==2) F2=((F2*fps[p1][0])-1.)/(fps[p1][0]-1.); //sample size correction when abundnaces are individuals counts
if(sps[p1][s1]==sps[p2][s2]) {
c=0;
phylod=0.;
}
else {
phylod=dist[sps[p1][s1]][sps[p2][s2]]; //phyletic distance between species (0 for a species with itself)
c=1;
while(divc[c]<phylod) c++;
}
DivIijc[p1][p2][c]+=(float)(F1*F2); //prob identity
DivPijc[p1][p2][c]+=(float)(F1*F2*phylod); //mean dist btw ind
DivSijc[p1][p2][c]++; //# pairs of sp
DivPIijc[p1][p2][c]+=(float)(phylod); //mean dist btw sp
} //end of loop s2
} //end loop s1
//convert into mean dist btw ind or sp per class
for(c=0; c<=Ndivc; c++) DivPijc[p1][p2][c]/=DivIijc[p1][p2][c];
for(c=1; c<=Ndivc; c++) DivPIijc[p1][p2][c]/=DivSijc[p1][p2][c];
//sums
for(c=0; c<=Ndivc; c++) DivIijc[p1][p2][-1]+=DivIijc[p1][p2][c];
for(c=1; c<=Ndivc; c++) DivSijc[p1][p2][-1]+=DivSijc[p1][p2][c];
//proportions
for(c=0; c<=Ndivc; c++) DivIijc[p1][p2][c]/=DivIijc[p1][p2][-1];
for(c=1; c<=Ndivc; c++) DivSijc[p1][p2][c]/=DivSijc[p1][p2][-1];
//mean dist btw ind or sp cumulated over classes
for(c=1; c<=Ndivc; c++) {
DivPijc[p1][p2][-1]+=DivPijc[p1][p2][c]*DivIijc[p1][p2][c];
DivPIijc[p1][p2][-1]+=DivPIijc[p1][p2][c]*DivSijc[p1][p2][c];
}
}
Ist=dmatrix(0,NP,0,NP);
Pst=dmatrix(0,NP,0,NP);
Bst=dmatrix(0,NP,0,NP);
PIst=dmatrix(0,NP,0,NP);
for(c=0; c<=Ndivc; c++) divIb[c]=divIw[c]=divPb[c]=divPw[c]=divBb[c]=divBw[c]=divPIb[c]=divPIw[c]=0.;
//pairwise Ist & cie
counter=0; //Modified by jme 01-12-10
for(p1=1; p1<=NP; p1++)for(p2=p1+1; p2<=NP; p2++) {
pairwiseIst_out[counter]=Ist[p1][p2]=Ist[p2][p1]=1.- (((1.-DivIijc[p1][p1][0])+(1.-DivIijc[p2][p2][0]))/2.) / (1.-DivIijc[p1][p2][0]); //Modified by jme 01-12-10
pairwisePst_out[counter]=Pst[p1][p2]=Pst[p2][p1]=1.- ((DivPijc[p1][p1][-1]+DivPijc[p2][p2][-1])/2.) / DivPijc[p1][p2][-1]; //Modified by jme 01-12-10
pairwiseBst_out[counter]=Bst[p1][p2]=Bst[p2][p1]=1.- ((DivPijc[p1][p1][-1]/(1.-DivIijc[p1][p1][0])+DivPijc[p2][p2][-1]/(1.-DivIijc[p2][p2][0]))/2.) / (DivPijc[p1][p2][-1]/(1.-DivIijc[p1][p2][0])); //Modified by jme 01-12-10
pairwisePIst_out[counter]=PIst[p1][p2]=PIst[p2][p1]=1.- ((DivPIijc[p1][p1][-1]+DivPIijc[p2][p2][-1])/2.) / DivPIijc[p1][p2][-1]; //Modified by jme 01-12-10
counter=counter+1; //Modified by jme 01-12-10
//sums for global stat
divIb[0]+=(1.-DivIijc[p1][p2][0]);
divIw[0]+=( (1.-DivIijc[p1][p1][0]) + (1.-DivIijc[p2][p2][0]) )/2.;
divPb[0]+=DivPijc[p1][p2][-1];
divPw[0]+=(DivPijc[p1][p1][-1]+DivPijc[p2][p2][-1])/2.;
divBb[0]+=DivPijc[p1][p2][-1]/(1.-DivIijc[p1][p2][0]);
divBw[0]+=( DivPijc[p1][p1][-1]/(1.-DivIijc[p1][p1][0]) + DivPijc[p2][p2][-1]/(1.-DivIijc[p2][p2][0]) )/2.;
divPIb[0]+=DivPIijc[p1][p2][-1];
divPIw[0]+=(DivPIijc[p1][p1][-1]+DivPIijc[p2][p2][-1])/2.;
}
Istc[0]=1.-divIw[0]/divIb[0];
Pstc[0]=1.-divPw[0]/divPb[0];
Bstc[0]=1.-divBw[0]/divBb[0];
PIstc[0]=1.-divPIw[0]/divPIb[0];
//global Ist by dist classes
for(p1=1; p1<=NP; p1++)for(p2=p1+1; p2<=NP; p2++) {
sumIb=sumIw1=sumIw2=sumPb=sumPw1=sumPw2=sumSb=sumSw1=sumSw2=sumPIb=sumPIw1=sumPIw2=0.;
for(c=1; c<=Ndivc; c++) {
sumIb+=DivIijc[p1][p2][c];
sumIw1+=DivIijc[p1][p1][c];
sumIw2+=DivIijc[p2][p2][c];
sumPb+=DivPijc[p1][p2][c]*DivIijc[p1][p2][c];
sumPw1+=DivPijc[p1][p1][c]*DivIijc[p1][p1][c];
sumPw2+=DivPijc[p2][p2][c]*DivIijc[p2][p2][c];
divBb[c]+=sumPb/sumIb;
divBw[c]+=((sumPw1/sumIw1)+(sumPw2/sumIw2))/2.;
divPb[c]+=sumPb/(sumIb+DivIijc[p1][p2][0]);
divPw[c]+=((sumPw1/(sumIw1+DivIijc[p1][p1][0]))+(sumPw2/(sumIw2+DivIijc[p2][p2][0])))/2.;
sumSb+=DivSijc[p1][p2][c];
sumSw1+=DivSijc[p1][p1][c];
sumSw2+=DivSijc[p2][p2][c];
sumPIb+=DivPIijc[p1][p2][c]*DivSijc[p1][p2][c];
sumPIw1+=DivPIijc[p1][p1][c]*DivSijc[p1][p1][c];
sumPIw2+=DivPIijc[p2][p2][c]*DivSijc[p2][p2][c];
divPIb[c]+=sumPIb/sumSb;
divPIw[c]+=((sumPIw1/sumSw1)+(sumPIw2/sumSw2))/2.;
}
}
for(c=1; c<=Ndivc; c++) {
Pstc[c]=1.-divPw[c]/divPb[c];
Bstc[c]=1.-divBw[c]/divBb[c];
PIstc[c]=1.-divPIw[c]/divPIb[c];
}
(*Ist_out)=Istc[0]; // Modified by cetp 17-08-09
(*Pst_out)=Pstc[0]; // Modified by cetp 17-08-09
(*Bst_out)=Bstc[0]; // Modified by cetp 17-08-09
(*PIst_out)=PIstc[0];// Modified by cetp 17-08-09
//free memory
free_dmatrix(fps,0,NP,0,NS);
free_dmatrix(dist,0,NS,0,NS);
free_imatrix(sps,0,NP,0,NS);
free_f3tensor(DivIijc,0,NP,0,NP,-1,Ndivc);
free_f3tensor(DivPijc,0,NP,0,NP,-1,Ndivc);
free_f3tensor(DivSijc,0,NP,0,NP,-1,Ndivc);
free_f3tensor(DivPIijc,0,NP,0,NP,-1,Ndivc);
free_dmatrix(Ist,0,NP,0,NP);
free_dmatrix(Pst,0,NP,0,NP);
free_dmatrix(Bst,0,NP,0,NP);
free_dmatrix(PIst,0,NP,0,NP);
}
void forward_shot_SH(struct waveAC *waveAC, struct PML_AC *PML_AC, struct matSH *matSH, float ** srcpos, int nshots, int ** recpos, int ntr, int nstage, int nfreq){
/* declaration of global variables */
extern int NSHOT1, NSHOT2, NONZERO, NX, NY, NXNY, NF;
extern int SNAP, SEISMO, MYID, INFO, N_STREAMER, READ_REC;
extern float DH;
extern char SNAP_FILE[STRING_SIZE];
extern FILE * FP;
/* declaration of local variables */
int ishot, status, nxsrc, nysrc, i;
double *null = (double *) NULL ;
int *Ap, *Ai;
double *Ax, *Az, *xr, *xi;
double time1, time2;
char filename[STRING_SIZE];
void *Symbolic, *Numeric;
/* Allocate memory for compressed sparse column form and solution vector */
Ap = malloc(sizeof(int)*(NXNY+1));
Ai = malloc(sizeof(int)*NONZERO);
Ax = malloc(sizeof(double)*NONZERO);
Az = malloc(sizeof(double)*NONZERO);
xr = malloc(sizeof(double)*NONZERO);
xi = malloc(sizeof(double)*NONZERO);
/* assemble acoustic impedance matrix */
init_A_SH_9p_pml(PML_AC,matSH,waveAC);
/* convert triplet to compressed sparse column format */
status = umfpack_zi_triplet_to_col(NXNY,NXNY,NONZERO,(*waveAC).irow,(*waveAC).icol,(*waveAC).Ar,(*waveAC).Ai,Ap,Ai,Ax,Az,NULL);
/* Here is something buggy (*waveAC).Ar != Ax and (*waveAC).Ai != Az.
Therefore, set Ax = (*waveAC).Ar and Az = (*waveAC).Ai */
for (i=0;i<NONZERO;i++){
Ax[i] = (*waveAC).Ar[i];
Az[i] = (*waveAC).Ai[i];
}
if((MYID==0)&&(INFO==1)){
printf("\n==================================== \n");
printf("\n ***** LU factorization ********** \n");
printf("\n==================================== \n\n");
time1=MPI_Wtime();
}
/* symbolic factorization */
status = umfpack_zi_symbolic(NXNY, NXNY, Ap, Ai, Ax, Az, &Symbolic, null, null);
/* sparse LU decomposition */
status = umfpack_zi_numeric(Ap, Ai, Ax, Az, Symbolic, &Numeric, null, null);
umfpack_zi_free_symbolic (&Symbolic);
if((MYID==0)&&(INFO==1)){
time2=MPI_Wtime();
printf("\n Finished after %4.2f s \n",time2-time1);
}
if((MYID==0)&&(INFO==1)){
printf("\n============================================================================================================= \n");
printf("\n ***** Solve elastic SH forward problem by FDFD for shot %d - %d (f = %3.2f Hz) on MPI process no. %d ********** \n",NSHOT1,NSHOT2-1,(*waveAC).freq, MYID);
printf("\n============================================================================================================= \n\n");
time1=MPI_Wtime();
}
/* loop over all shots */
for (ishot=NSHOT1;ishot<NSHOT2;ishot++){
/* read receiver positions from receiver files for each shot */
if(READ_REC==1){
acq.recpos=receiver(FP, &ntr, 1);
}
/* define source vector RHS */
RHS_source_AC(waveAC,srcpos,ishot);
/* solve forward problem by forward and back substitution */
status = umfpack_zi_solve(UMFPACK_A, Ap, Ai, Ax, Az, xr, xi, (*waveAC).RHSr, (*waveAC).RHSi, Numeric, null, null);
/* convert vector xr/xi to pr/pi */
vec2mat((*waveAC).pr,(*waveAC).pi,xr,xi);
/* write real part of pressure wavefield to file */
if(SNAP==1){
sprintf(filename,"%s_shot_%d.p",SNAP_FILE,ishot);
/* writemod(filename,(*waveAC).pr,3); */
writemod_true(filename,(*waveAC).pr,3);
}
/* write FD seismogram files */
if(SEISMO==1){
calc_seis_AC(waveAC,acq.recpos,ntr,ishot,nshots,nfreq);
}
if(READ_REC==1){
free_imatrix(acq.recpos,1,3,1,ntr);
ntr=0;
}
}
if((MYID==0)&&(INFO==1)){
time2=MPI_Wtime();
printf("\n Finished after %4.2f s \n",time2-time1);
}
/* free memory */
free(Ap); free(Ai); free(Ax); free(Az); free(xr); free(xi);
umfpack_zi_free_numeric (&Numeric);
}
/* "calc_blessian_mem" calculates the block Hessian. */
int calc_blessian_mem(PDB_File *PDB,dSparse_Matrix *PP1,int nres,int nblx,
int elm,double **HB,double cut,double gam,double scl,
double mlo,double mhi)
{
dSparse_Matrix *PP2;
double **HR,***HT;
int **CT,*BST1,*BST2;
int ii,i,j,k,p,q,q1,q2,ti,tj,bi,bj,sb,nc,out;
/* ------------------- INITIALIZE LOCAL VARIABLES ------------------- */
/* HR holde three rows (corresponding to 1 residue) of the full Hessian */
HR=zero_dmatrix(1,3*nres,1,3);
/* CT is an array of contacts between blocks */
CT=unit_imatrix(0,nblx);
/* Copy PP1 to PP2 and sort by second element */
PP2=(dSparse_Matrix *)malloc((size_t)sizeof(dSparse_Matrix));
PP2->IDX=imatrix(1,elm,1,2);
PP2->X=dvector(1,elm);
copy_dsparse(PP1,PP2,1,elm);
dsort_PP2(PP2,elm,2);
/* BST1: for all j: BST1[i]<=j<BST[i+1], PP1->IDX[j][1]=i */
/* BST2: for all j: BST2[i]<=j<BST2[i+1], PP2->IDX[j][2]=i */
BST1=ivector(1,3*nres+1);
BST2=ivector(1,6*nblx+1);
init_bst(BST1,PP1,elm,3*nres+1,1);
init_bst(BST2,PP2,elm,6*nblx+1,2);
/* ------------------- LOCAL VARIABLES INITIALIZED ------------------ */
/* ------------- FIND WHICH BLOCKS ARE IN CONTACT --------------- */
nc=find_contacts1(CT,PDB,nres,nblx,cut);
/* Allocate a tensor for the block Hessian */
HT=zero_d3tensor(1,nc,1,6,1,6);
/* Calculate each super-row of the full Hessian */
for(ii=1;ii<=nres;ii++){
if(PDB->atom[ii].model!=0){
/* ----------------- FIND SUPER-ROW OF FULL HESSIAN --------------- */
hess_superrow_mem(HR,CT,PDB,nres,ii,cut,gam,scl,mlo,mhi);
/* Update elements of block hessian */
q1=BST1[3*(ii-1)+2];
q2=BST1[3*(ii-1)+3];
/* Sum over elements of projection matrix corresponding to residue ii:
for each k in the following loop, PP1->IDX[k][1]==3*ii + 0,1,2 */
for(k=BST1[3*ii-2];k<BST1[3*ii+1];k++){
if(k<q1) q=1;
else if(k<q2) q=2;
else q=3;
i=PP1->IDX[k][2];
bi=(i-1)/6+1;
ti=i-6*(bi-1);
/* Sum over all elements of projection matrix with column j>=i */
for(p=BST2[i];p<=elm;p++){
j=PP2->IDX[p][2];
bj=(j-1)/6+1;
sb=CT[bi][bj];
if(i<=j && sb!=0){ /* the first condition should ALWAYS hold */
tj=j-6*(bj-1);
HT[sb][ti][tj]+=(PP1->X[k]*PP2->X[p]*HR[PP2->IDX[p][1]][q]);
}
}
}
}
}
/* Print the block Hessian in sparse format */
out=bless_from_tensor(HB,HT,CT,nblx);
/* Free up memory */
free_dmatrix(HR,1,3*nres,1,3);
free_d3tensor(HT,1,nc,1,6,1,6);
free_imatrix(CT,0,nblx,0,nblx);
free_ivector(BST1,1,3*nres+1);
free_ivector(BST2,1,6*nblx+1);
free_imatrix(PP2->IDX,1,elm,1,2);
free_dvector(PP2->X,1,elm);
return out;
}
int main(int argn, char** args){
if (argn !=2 ) {
printf("When running the simulation, please give a valid scenario file name!\n");
return 1;
}
//set the scenario
char *filename = NULL;
filename = args[1];
//initialize variables
double t = 0; /*time start*/
int it, n = 0; /*iteration and time step counter*/
double res; /*residual for SOR*/
/*arrays*/
double **U, **V, **P;
double **RS, **F, **G;
int **Flag; //additional data structure for arbitrary geometry
/*those to be read in from the input file*/
double Re, UI, VI, PI, GX, GY, t_end, xlength, ylength, dt, dx, dy, alpha, omg, tau, eps, dt_value;
int imax, jmax, itermax;
double presLeft, presRight, presDelta; //for pressure stuff
int wl, wr, wt, wb;
char problem[32];
double vel; //in case of a given inflow or wall velocity
//read the parameters, using problem.dat, including wl, wr, wt, wb
read_parameters(filename, &Re, &UI, &VI, &PI, &GX, &GY, &t_end, &xlength, &ylength, &dt, &dx, &dy, &imax,
&jmax, &alpha, &omg, &tau, &itermax, &eps, &dt_value, &wl, &wr, &wt, &wb, problem, &presLeft, &presRight, &presDelta, &vel);
int pics = dt_value/dt; //just a helping variable for outputing vtk
//allocate memory, including Flag
U = matrix(0, imax+1, 0, jmax+1);
V = matrix(0, imax+1, 0, jmax+1);
P = matrix(0, imax+1, 0, jmax+1);
RS = matrix(1, imax, 1, jmax);
F = matrix(0, imax, 1, jmax);
G = matrix(1, imax, 0, jmax);
Flag = imatrix(0, imax+1, 0, jmax+1); // or Flag = imatrix(1, imax, 1, jmax);
int kmax = 20; //test no slip boundary value function
double ***U3d = (double ***) malloc((size_t)((imax+1)*(jmax+1)*(kmax+1) * sizeof(double*)) ); //test no slip boundary value function
double ***V3d = (double ***) malloc((size_t)((imax+1)*(jmax+1)*(kmax+1) * sizeof(double*)) ); //test no slip boundary value function
double ***W3d = (double ***) malloc((size_t)((imax+1)*(jmax+1)*(kmax+1) * sizeof(double*)) ); //test no slip boundary value function
int ***Flag3d = (int ***) malloc((size_t)((imax+1)*(jmax+1)*(kmax+1) * sizeof(int*)) ); //test no slip boundary value function
//initialisation, including **Flag
init_flag(problem, imax, jmax, presDelta, Flag);
init_uvp(UI, VI, PI, imax, jmax, U, V, P, problem);
//going through all time steps
while(t < t_end){
//adaptive time stepping
calculate_dt(Re, tau, &dt, dx, dy, imax, jmax, U, V);
//setting bound.values
boundaryvalues(imax, jmax, U, V, P, wl, wr, wt, wb, F, G, problem, Flag, vel); //including P, wl, wr, wt, wb, F, G, problem
//test no slip boundary value function
for(int i=1; i<=imax; i++){
for(int j=1; j<=jmax; j++){
for(int k=1; k<=kmax; k++){
boundaryvalues_no_slip(i, j, k, U3d, V3d, W3d, Flag3d); //test no slip boundary value function
}
}
}
//computing F, G and right hand side of pressue eq.
calculate_fg(Re, GX, GY, alpha, dt, dx, dy, imax, jmax, U, V, F, G, Flag);
calculate_rs(dt, dx, dy, imax, jmax, F, G, RS);
//iteration counter
it = 0;
do{
//
//perform SOR iteration, at same time set bound.values for P and new residual value
sor(omg, dx, dy, imax, jmax, P, RS, &res, Flag, presLeft, presRight);
it++;
}while(it<itermax && res>eps);
/* if (it == itermax) {
printf("Warning: sor while loop exits because it reaches the itermax. res = %f, time =%f\n", res, t);
}
*/ //calculate U and V of this time step
calculate_uv(dt, dx, dy, imax, jmax, U, V, F, G, P, Flag);
//indent time and number of time steps
n++;
t += dt;
//output of pics for animation
if (n%pics==0 ){
write_vtkFile(filename, n, xlength, ylength, imax, jmax, dx, dy, U, V, P);
}
}
//output of U, V, P at the end for visualization
//write_vtkFile("DrivenCavity", n, xlength, ylength, imax, jmax, dx, dy, U, V, P);
//free memory
free_matrix(U, 0, imax+1, 0, jmax+1);
free_matrix(V, 0, imax+1, 0, jmax+1);
free_matrix(P, 0, imax+1, 0, jmax+1);
free_matrix(RS, 1, imax, 1, jmax);
free_matrix(F, 0, imax, 1, jmax);
free_matrix(G, 1, imax, 0, jmax);
free_imatrix(Flag, 0, imax+1, 0, jmax+1);
free(U3d);
free(V3d);
free(W3d);
free(Flag3d);
return -1;
}
void RTM_PSV(){
/* global variables */
/* ---------------- */
/* forward modelling */
extern int MYID, FDORDER, NX, NY, NT, L, READMOD, QUELLART, RUN_MULTIPLE_SHOTS, TIME_FILT;
extern int LOG, SEISMO, N_STREAMER, FW, NXG, NYG, IENDX, IENDY, NTDTINV, IDXI, IDYI, NXNYI, INV_STF, DTINV;
extern float FC_SPIKE_1, FC_SPIKE_2, FC, FC_START, TIME, DT;
extern char LOG_FILE[STRING_SIZE], MFILE[STRING_SIZE];
extern FILE *FP;
/* gravity modelling/inversion */
extern int GRAVITY, NZGRAV, NGRAVB, GRAV_TYPE, BACK_DENSITY;
extern char GRAV_DATA_OUT[STRING_SIZE], GRAV_DATA_IN[STRING_SIZE], GRAV_STAT_POS[STRING_SIZE], DFILE[STRING_SIZE];
extern float LAM_GRAV, GAMMA_GRAV, LAM_GRAV_GRAD, L2_GRAV_IT1;
/* full waveform inversion */
extern int GRAD_METHOD, NLBFGS, ITERMAX, IDX, IDY, INVMAT1, EPRECOND;
extern int GRAD_FORM, POS[3], QUELLTYPB, MIN_ITER, MODEL_FILTER;
extern float FC_END, PRO, C_vp, C_vs, C_rho;
extern char MISFIT_LOG_FILE[STRING_SIZE], JACOBIAN[STRING_SIZE];
extern char *FILEINP1;
/* local variables */
int ns, nseismograms=0, nt, nd, fdo3, j, i, iter, h, hin, iter_true, SHOTINC, s=0;
int buffsize, ntr=0, ntr_loc=0, ntr_glob=0, nsrc=0, nsrc_loc=0, nsrc_glob=0, ishot, nshots=0, itestshot;
float sum, eps_scale, opteps_vp, opteps_vs, opteps_rho, Vp_avg, Vs_avg, rho_avg, Vs_sum, Vp_sum, rho_sum;
char *buff_addr, ext[10], *fileinp, jac[225], source_signal_file[STRING_SIZE];
double time1, time2, time7, time8, time_av_v_update=0.0, time_av_s_update=0.0, time_av_v_exchange=0.0, time_av_s_exchange=0.0, time_av_timestep=0.0;
float L2sum, *L2t;
float ** taper_coeff, * epst1, *hc=NULL;
int * DTINV_help;
MPI_Request *req_send, *req_rec;
MPI_Status *send_statuses, *rec_statuses;
/* Variables for step length calculation */
int step1, step3=0;
float eps_true, tmp;
/* Variables for the L-BFGS method */
float * rho_LBFGS, * alpha_LBFGS, * beta_LBFGS;
float * y_LBFGS, * s_LBFGS, * q_LBFGS, * r_LBFGS;
int NLBFGS_class, LBFGS_pointer, NLBFGS_vec;
/* Variables for energy weighted gradient */
float ** Ws, **Wr, **We;
/* parameters for FWI-workflow */
int stagemax=0, nstage;
/* help variable for MIN_ITER */
int min_iter_help=0;
/* parameters for gravity inversion */
char jac_grav[STRING_SIZE];
FILE *FP_stage, *FP_GRAV;
if (MYID == 0){
time1=MPI_Wtime();
clock();
}
/* open log-file (each PE is using different file) */
/* fp=stdout; */
sprintf(ext,".%i",MYID);
strcat(LOG_FILE,ext);
if ((MYID==0) && (LOG==1)) FP=stdout;
else FP=fopen(LOG_FILE,"w");
fprintf(FP," This is the log-file generated by PE %d \n\n",MYID);
/* ----------------------- */
/* define FD grid geometry */
/* ----------------------- */
/* domain decomposition */
initproc();
NT=iround(TIME/DT); /* number of timesteps */
/* output of parameters to log-file or stdout */
if (MYID==0) write_par(FP);
/* NXG, NYG denote size of the entire (global) grid */
NXG=NX;
NYG=NY;
/* In the following, NX and NY denote size of the local grid ! */
NX = IENDX;
NY = IENDY;
NTDTINV=ceil((float)NT/(float)DTINV); /* round towards next higher integer value */
/* save every IDXI and IDYI spatial point during the forward modelling */
IDXI=1;
IDYI=1;
NXNYI=(NX/IDXI)*(NY/IDYI);
SHOTINC=1;
/* use only every DTINV time sample for the inversion */
DTINV_help=ivector(1,NT);
/* Check if RTM workflow-file is defined (stdin) */
FP_stage=fopen(FILEINP1,"r");
if(FP_stage==NULL) {
if (MYID == 0){
printf("\n==================================================================\n");
printf(" Cannot open Denise workflow input file %s \n",FILEINP1);
printf("\n==================================================================\n\n");
err(" --- ");
}
}
fclose(FP_stage);
/* define data structures for PSV problem */
struct wavePSV;
struct wavePSV_PML;
struct matPSV;
struct fwiPSV;
struct mpiPSV;
struct seisPSV;
struct seisPSVfwi;
struct acq;
nd = FDORDER/2 + 1;
fdo3 = 2*nd;
buffsize=2.0*2.0*fdo3*(NX +NY)*sizeof(MPI_FLOAT);
/* allocate buffer for buffering messages */
buff_addr=malloc(buffsize);
if (!buff_addr) err("allocation failure for buffer for MPI_Bsend !");
MPI_Buffer_attach(buff_addr,buffsize);
/* allocation for request and status arrays */
req_send=(MPI_Request *)malloc(REQUEST_COUNT*sizeof(MPI_Request));
req_rec=(MPI_Request *)malloc(REQUEST_COUNT*sizeof(MPI_Request));
send_statuses=(MPI_Status *)malloc(REQUEST_COUNT*sizeof(MPI_Status));
rec_statuses=(MPI_Status *)malloc(REQUEST_COUNT*sizeof(MPI_Status));
/* --------- add different modules here ------------------------ */
ns=NT; /* in a FWI one has to keep all samples of the forward modeled data
at the receiver positions to calculate the adjoint sources and to do
the backpropagation; look at function saveseis_glob.c to see that every
NDT sample for the forward modeled wavefield is written to su files*/
if (SEISMO){
acq.recpos=receiver(FP, &ntr, ishot);
acq.recswitch = ivector(1,ntr);
acq.recpos_loc = splitrec(acq.recpos,&ntr_loc, ntr, acq.recswitch);
ntr_glob=ntr;
ntr=ntr_loc;
if(N_STREAMER>0){
free_imatrix(acq.recpos,1,3,1,ntr_glob);
if(ntr>0) free_imatrix(acq.recpos_loc,1,3,1,ntr);
free_ivector(acq.recswitch,1,ntr_glob);
}
}
if(N_STREAMER==0){
/* Memory for seismic data */
alloc_seisPSV(ntr,ns,&seisPSV);
/* Memory for FWI seismic data */
alloc_seisPSVfwi(ntr,ntr_glob,ns,&seisPSVfwi);
}
/* Memory for full data seismograms */
alloc_seisPSVfull(&seisPSV,ntr_glob);
/* estimate memory requirement of the variables in megabytes*/
switch (SEISMO){
case 1 : /* particle velocities only */
nseismograms=2;
break;
case 2 : /* pressure only */
nseismograms=1;
break;
case 3 : /* curl and div only */
nseismograms=2;
break;
case 4 : /* everything */
nseismograms=5;
break;
}
/* calculate memory requirements for PSV forward problem */
mem_fwiPSV(nseismograms,ntr,ns,fdo3,nd,buffsize,ntr_glob);
/* Define gradient formulation */
/* GRAD_FORM = 1 - stress-displacement gradients */
/* GRAD_FORM = 2 - stress-velocity gradients for decomposed impedance matrix */
GRAD_FORM = 1;
/* allocate memory for PSV forward problem */
alloc_PSV(&wavePSV,&wavePSV_PML);
/* calculate damping coefficients for CPMLs (PSV problem)*/
if(FW>0){PML_pro(wavePSV_PML.d_x, wavePSV_PML.K_x, wavePSV_PML.alpha_prime_x, wavePSV_PML.a_x, wavePSV_PML.b_x, wavePSV_PML.d_x_half, wavePSV_PML.K_x_half, wavePSV_PML.alpha_prime_x_half, wavePSV_PML.a_x_half,
wavePSV_PML.b_x_half, wavePSV_PML.d_y, wavePSV_PML.K_y, wavePSV_PML.alpha_prime_y, wavePSV_PML.a_y, wavePSV_PML.b_y, wavePSV_PML.d_y_half, wavePSV_PML.K_y_half, wavePSV_PML.alpha_prime_y_half,
wavePSV_PML.a_y_half, wavePSV_PML.b_y_half);
}
/* allocate memory for PSV material parameters */
alloc_matPSV(&matPSV);
/* allocate memory for PSV FWI parameters */
alloc_fwiPSV(&fwiPSV);
/* allocate memory for PSV MPI variables */
alloc_mpiPSV(&mpiPSV);
taper_coeff= matrix(1,NY,1,NX);
/* memory for source position definition */
acq.srcpos1=fmatrix(1,8,1,1);
/* memory of L2 norm */
L2t = vector(1,4);
epst1 = vector(1,3);
fprintf(FP," ... memory allocation for PE %d was successfull.\n\n", MYID);
/* Holberg coefficients for FD operators*/
hc = holbergcoeff();
MPI_Barrier(MPI_COMM_WORLD);
/* Reading source positions from SOURCE_FILE */
acq.srcpos=sources(&nsrc);
nsrc_glob=nsrc;
/* create model grids */
if(L){
if (READMOD) readmod_visc_PSV(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta);
else model(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta);
} else{
if (READMOD) readmod_elastic_PSV(matPSV.prho,matPSV.ppi,matPSV.pu);
else model_elastic(matPSV.prho,matPSV.ppi,matPSV.pu);
}
/* check if the FD run will be stable and free of numerical dispersion */
if(L){
checkfd_ssg_visc(FP,matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta,hc);
} else{
checkfd_ssg_elastic(FP,matPSV.prho,matPSV.ppi,matPSV.pu,hc);
}
SHOTINC=1;
/* For RTM read only first line from FWI workflow file and set iter = 1 */
stagemax = 1;
iter_true = 1;
iter = 1;
/* Begin of FWI-workflow */
for(nstage=1;nstage<=stagemax;nstage++){
/* read workflow input file *.inp */
FP_stage=fopen(FILEINP1,"r");
read_par_inv(FP_stage,nstage,stagemax);
/*fclose(FP_stage);*/
if((EPRECOND==1)||(EPRECOND==3)){
Ws = matrix(1,NY,1,NX); /* total energy of the source wavefield */
Wr = matrix(1,NY,1,NX); /* total energy of the receiver wavefield */
We = matrix(1,NY,1,NX); /* total energy of source and receiver wavefield */
}
FC=FC_END;
if (MYID==0)
{
time2=MPI_Wtime();
fprintf(FP,"\n\n\n ------------------------------------------------------------------\n");
fprintf(FP,"\n\n\n Elastic Reverse Time Migration RTM \n");
fprintf(FP,"\n\n\n ------------------------------------------------------------------\n");
}
/* For the calculation of the material parameters between gridpoints
they have to be averaged. For this, values lying at 0 and NX+1,
for example, are required on the local grid. These are now copied from the
neighbouring grids */
if (L){
matcopy_PSV(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup);
} else{
matcopy_elastic_PSV(matPSV.prho,matPSV.ppi,matPSV.pu);
}
MPI_Barrier(MPI_COMM_WORLD);
av_mue(matPSV.pu,matPSV.puipjp,matPSV.prho);
av_rho(matPSV.prho,matPSV.prip,matPSV.prjp);
if (L) av_tau(matPSV.ptaus,matPSV.ptausipjp);
/* Preparing memory variables for update_s (viscoelastic) */
if (L) prepare_update_s_visc_PSV(matPSV.etajm,matPSV.etaip,matPSV.peta,matPSV.fipjp,matPSV.pu,matPSV.puipjp,matPSV.ppi,matPSV.prho,matPSV.ptaus,matPSV.ptaup,matPSV.ptausipjp,matPSV.f,matPSV.g,
matPSV.bip,matPSV.bjm,matPSV.cip,matPSV.cjm,matPSV.dip,matPSV.d,matPSV.e);
/* ------------------------------------- */
/* calculate average material parameters */
/* ------------------------------------- */
Vp_avg = 0.0;
Vs_avg = 0.0;
rho_avg = 0.0;
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
/* calculate average Vp, Vs */
Vp_avg+=matPSV.ppi[j][i];
Vs_avg+=matPSV.pu[j][i];
/* calculate average rho */
rho_avg+=matPSV.prho[j][i];
}
}
/* calculate average Vp, Vs and rho of all CPUs */
Vp_sum = 0.0;
MPI_Allreduce(&Vp_avg,&Vp_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
Vp_avg=Vp_sum;
Vs_sum = 0.0;
MPI_Allreduce(&Vs_avg,&Vs_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
Vs_avg=Vs_sum;
rho_sum = 0.0;
MPI_Allreduce(&rho_avg,&rho_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
rho_avg=rho_sum;
Vp_avg /=NXG*NYG;
Vs_avg /=NXG*NYG;
rho_avg /=NXG*NYG;
if(MYID==0){
printf("Vp_avg = %.0f \t Vs_avg = %.0f \t rho_avg = %.0f \n ",Vp_avg,Vs_avg,rho_avg);
}
C_vp = Vp_avg;
C_vs = Vs_avg;
C_rho = rho_avg;
/* ---------------------------------------------------------------------------------------------------- */
/* --------- Calculate RTM P- and S- wave image using the adjoint state method ------------------------ */
/* ---------------------------------------------------------------------------------------------------- */
L2sum = grad_obj_psv(&wavePSV, &wavePSV_PML, &matPSV, &fwiPSV, &mpiPSV, &seisPSV, &seisPSVfwi, &acq, hc, iter, nsrc, ns, ntr, ntr_glob,
nsrc_glob, nsrc_loc, ntr_loc, nstage, We, Ws, Wr, taper_coeff, hin, DTINV_help, req_send, req_rec);
/* Interpolate missing spatial gradient values in case IDXI > 1 || IDXY > 1 */
/* ------------------------------------------------------------------------ */
if((IDXI>1)||(IDYI>1)){
interpol(IDXI,IDYI,fwiPSV.waveconv,1);
interpol(IDXI,IDYI,fwiPSV.waveconv_u,1);
interpol(IDXI,IDYI,fwiPSV.waveconv_rho,1);
}
/* Preconditioning of gradients after shot summation */
precond_PSV(&fwiPSV,&acq,nsrc,ntr_glob,taper_coeff,FP_GRAV);
/* Output of RTM results */
RTM_PSV_out(&fwiPSV);
} /* End of RTM-workflow loop */
/* deallocate memory for PSV forward problem */
dealloc_PSV(&wavePSV,&wavePSV_PML);
/* deallocation of memory */
free_matrix(fwiPSV.Vp0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.Vs0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.Rho0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.prho_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prip,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ppi,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.ppi_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.pu,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.pu_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.puipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_lam,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(mpiPSV.bufferlef_to_rig,1,NY,1,fdo3);
free_matrix(mpiPSV.bufferrig_to_lef,1,NY,1,fdo3);
free_matrix(mpiPSV.buffertop_to_bot,1,NX,1,fdo3);
free_matrix(mpiPSV.bufferbot_to_top,1,NX,1,fdo3);
free_vector(hc,0,6);
free_matrix(fwiPSV.gradg,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradg_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho_s,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradg_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_mu,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_u_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_vector(fwiPSV.forward_prop_x,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_y,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_rho_x,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_rho_y,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_u,1,NY*NX*NT);
if (nsrc_loc>0){
free_matrix(acq.signals,1,nsrc_loc,1,NT);
free_matrix(acq.srcpos_loc,1,8,1,nsrc_loc);
free_matrix(acq.srcpos_loc_back,1,6,1,nsrc_loc);
}
/* free memory for global source positions */
free_matrix(acq.srcpos,1,8,1,nsrc);
/* free memory for source position definition */
free_matrix(acq.srcpos1,1,8,1,1);
/* free memory for abort criterion */
free_vector(L2t,1,4);
free_vector(epst1,1,3);
if(N_STREAMER==0){
if (SEISMO) free_imatrix(acq.recpos,1,3,1,ntr_glob);
if ((ntr>0) && (SEISMO)){
free_imatrix(acq.recpos_loc,1,3,1,ntr);
acq.recpos_loc = NULL;
switch (SEISMO){
case 1 : /* particle velocities only */
free_matrix(seisPSV.sectionvx,1,ntr,1,ns);
free_matrix(seisPSV.sectionvy,1,ntr,1,ns);
seisPSV.sectionvx=NULL;
seisPSV.sectionvy=NULL;
break;
case 2 : /* pressure only */
free_matrix(seisPSV.sectionp,1,ntr,1,ns);
break;
case 3 : /* curl and div only */
free_matrix(seisPSV.sectioncurl,1,ntr,1,ns);
free_matrix(seisPSV.sectiondiv,1,ntr,1,ns);
break;
case 4 : /* everything */
free_matrix(seisPSV.sectionvx,1,ntr,1,ns);
free_matrix(seisPSV.sectionvy,1,ntr,1,ns);
free_matrix(seisPSV.sectionp,1,ntr,1,ns);
free_matrix(seisPSV.sectioncurl,1,ntr,1,ns);
free_matrix(seisPSV.sectiondiv,1,ntr,1,ns);
break;
}
}
free_matrix(seisPSVfwi.sectionread,1,ntr_glob,1,ns);
free_ivector(acq.recswitch,1,ntr);
if((QUELLTYPB==1)||(QUELLTYPB==3)||(QUELLTYPB==5)||(QUELLTYPB==7)){
free_matrix(seisPSVfwi.sectionvxdata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvxdiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvxdiffold,1,ntr,1,ns);
}
if((QUELLTYPB==1)||(QUELLTYPB==2)||(QUELLTYPB==6)||(QUELLTYPB==7)){
free_matrix(seisPSVfwi.sectionvydata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvydiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvydiffold,1,ntr,1,ns);
}
if(QUELLTYPB>=4){
free_matrix(seisPSVfwi.sectionpdata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionpdiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionpdiffold,1,ntr,1,ns);
}
}
if(SEISMO){
free_matrix(seisPSV.fulldata,1,ntr_glob,1,NT);
}
if(SEISMO==1){
free_matrix(seisPSV.fulldata_vx,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_vy,1,ntr_glob,1,NT);
}
if(SEISMO==2){
free_matrix(seisPSV.fulldata_p,1,ntr_glob,1,NT);
}
if(SEISMO==3){
free_matrix(seisPSV.fulldata_curl,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_div,1,ntr_glob,1,NT);
}
if(SEISMO==4){
free_matrix(seisPSV.fulldata_vx,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_vy,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_p,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_curl,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_div,1,ntr_glob,1,NT);
}
free_ivector(DTINV_help,1,NT);
/* free memory for viscoelastic modeling variables */
if (L) {
free_matrix(matPSV.ptaus,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ptausipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ptaup,-nd+1,NY+nd,-nd+1,NX+nd);
free_vector(matPSV.peta,1,L);
free_vector(matPSV.etaip,1,L);
free_vector(matPSV.etajm,1,L);
free_vector(matPSV.bip,1,L);
free_vector(matPSV.bjm,1,L);
free_vector(matPSV.cip,1,L);
free_vector(matPSV.cjm,1,L);
free_matrix(matPSV.f,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.g,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.fipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_f3tensor(matPSV.dip,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
free_f3tensor(matPSV.d,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
free_f3tensor(matPSV.e,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
}
/* de-allocate buffer for messages */
MPI_Buffer_detach(buff_addr,&buffsize);
MPI_Barrier(MPI_COMM_WORLD);
if (MYID==0){
fprintf(FP,"\n **Info from main (written by PE %d): \n",MYID);
fprintf(FP," CPU time of program per PE: %li seconds.\n",clock()/CLOCKS_PER_SEC);
time8=MPI_Wtime();
fprintf(FP," Total real time of program: %4.2f seconds.\n",time8-time1);
time_av_v_update=time_av_v_update/(double)NT;
time_av_s_update=time_av_s_update/(double)NT;
time_av_v_exchange=time_av_v_exchange/(double)NT;
time_av_s_exchange=time_av_s_exchange/(double)NT;
time_av_timestep=time_av_timestep/(double)NT;
/* fprintf(FP," Average times for \n");
fprintf(FP," velocity update: \t %5.3f seconds \n",time_av_v_update);
fprintf(FP," stress update: \t %5.3f seconds \n",time_av_s_update);
fprintf(FP," velocity exchange: \t %5.3f seconds \n",time_av_v_exchange);
fprintf(FP," stress exchange: \t %5.3f seconds \n",time_av_s_exchange);
fprintf(FP," timestep: \t %5.3f seconds \n",time_av_timestep);*/
}
fclose(FP);
}
void initialiseFields( double *collideField, double *streamField, int *flagField, int * xlength, int *local_xlength, char *problem, char* pgmInput, int rank, int iProc, int jProc, int kProc )
{
int iCoord, jCoord, kCoord, x, y, z, i;
#ifdef _ARBITRARYGEOMETRIES_
int** pgmImage;
#endif // _ARBITRARYGEOMETRY_
computePosition(iProc, jProc, kProc, &iCoord, &jCoord, &kCoord);
#ifdef _ARBITRARYGEOMETRIES_
#pragma omp parallel private(x, y, z, i) shared(iCoord, jCoord, kCoord, collideField, flagField, streamField, xlength, problem, pgmInput, pgmImage, local_xlength, iProc, jProc, kProc)
#else
#pragma omp parallel private(x, y, z, i) shared(iCoord, jCoord, kCoord, collideField, flagField, streamField, xlength, local_xlength, iProc, jProc, kProc)
#endif // _ARBITRARYGEOMETRY_
{
#pragma omp for schedule(static)
for(x = 0; x < (local_xlength[0] + 2) * (local_xlength[1] + 2) * (local_xlength[2] + 2); x++)
{
flagField[x] = FLUID;
for(i = 0; i < PARAMQ; i++)
collideField[PARAMQ * x + i] = streamField[PARAMQ * x + i] = LATTICEWEIGHTS[i];
}
// independend of the problem first initialize all ghost cells as PARALLEL_BOUNDARY
/* top boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = PARALLEL_BOUNDARY;
/* back boundary */
#pragma omp for nowait schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[y * (local_xlength[0] + 2) + x] = PARALLEL_BOUNDARY;
/* bottom boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = PARALLEL_BOUNDARY;
/* left boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = PARALLEL_BOUNDARY;
/* right boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = PARALLEL_BOUNDARY;
/* front boundary, i.e. z = local_xlength + 1 */
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = PARALLEL_BOUNDARY;
/** initialization of different scenarios */
#ifdef _ARBITRARYGEOMETRIES_
if (!strcmp(problem, "drivenCavity"))
{
#endif // _ARBITRARYGEOMETRY_
/* front boundary, i.e. z = local_xlength + 1 */
if (kCoord == kProc - 1)
{
#pragma omp for nowait schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = NO_SLIP;
}
/* back boundary */
if (kCoord == 0)
{
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[y * (local_xlength[0] + 2) + x] = NO_SLIP;
}
/* left boundary */
if (iCoord == 0)
{
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = NO_SLIP;
}
/* right boundary */
if (iCoord == iProc - 1)
{
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = NO_SLIP;
}
/* bottom boundary */
if (jCoord == 0)
{
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
}
/* top boundary */
if (jCoord == jProc - 1)
{
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = MOVING_WALL;
}
#ifdef _ARBITRARYGEOMETRIES_
}
if (!strcmp(problem, "tiltedPlate"))
{
#pragma omp single
{
pgmImage = read_pgm(pgmInput);
}
#pragma omp for nowait schedule(static)
for (z = 1; z <= local_xlength[2]; z++)
for (y = 1; y <= local_xlength[1]; y++)
for (x = 1; x <= local_xlength[0]; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = !!pgmImage[(xlength[0] / iProc) * iCoord + x][(xlength[1] / jProc) * jCoord + y];
/* front boundary, i.e. z = local_xlength + 1 */
if (kCoord == kProc - 1)
#pragma omp for nowait schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
{
// check for obstacle in the cell in the inner part of the domain adjacent to the boundary (i.e. NO_SLIP)
// if there is an obstacle, make the boundary NO_SLIP instead of FREE_SLIP as well
if (pgmImage[(xlength[0] / iProc) * iCoord + x][(xlength[1] / jProc) * jCoord + y])
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = NO_SLIP;
else
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = FREE_SLIP;
}
/* back boundary */
if (kCoord == 0)
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
{
// check for obstacle in the cell in the inner part of the domain adjacent to the boundary
// if there is an obstacle, make the boundary NO_SLIP instead of FREE_SLIP as well
if (pgmImage[(xlength[0] / iProc) * iCoord + x][(xlength[1] / jProc) * jCoord + y])
flagField[y * (local_xlength[0] + 2) + x] = NO_SLIP;
else
flagField[y * (local_xlength[0] + 2) + x] = FREE_SLIP;
}
/* left boundary */
if (iCoord == 0)
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = INFLOW;
/* right boundary */
if (iCoord == iProc - 1)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = OUTFLOW;
/* top boundary */
if (jCoord == jProc - 1)
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = NO_SLIP;
/* bottom boundary */
if (jCoord == 0)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
// Adjust PARALLEL_BOUNDARY if the "adjacent" cell in the domain of the neighbouring process is an obstacle cell
/* top boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] == PARALLEL_BOUNDARY && pgmImage[(xlength[0] / iProc) * iCoord + x][(xlength[1] / jProc) * (jCoord + 1) + 1])
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = NO_SLIP;
/* bottom boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] == PARALLEL_BOUNDARY && pgmImage[(xlength[0] / iProc) * iCoord + x][(xlength[1] / jProc) * jCoord])
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
/* left boundary */
#pragma omp for nowait schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if (flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] == PARALLEL_BOUNDARY && pgmImage[(xlength[0] / iProc) * iCoord][(xlength[1] / jProc) * jCoord + y])
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = NO_SLIP;
/* right boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if (flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] == PARALLEL_BOUNDARY && pgmImage[(xlength[0] / iProc) * (iCoord + 1) + 1][(xlength[1] / jProc) * jCoord + y])
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = NO_SLIP;
#pragma omp single
{
free_imatrix(pgmImage, 0, xlength[0] + 2, 0, xlength[1] + 2);
}
}
if (!strcmp(problem, "flowStep"))
{
/* front boundary, i.e. z = local_xlength + 1 */
if (kCoord == kProc - 1)
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = NO_SLIP;
/* back boundary */
if (kCoord == 0)
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[y * (local_xlength[0] + 2) + x] = NO_SLIP;
/* left boundary */
if (iCoord == 0)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = INFLOW;
/* right boundary */
if (iCoord == iProc - 1)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = OUTFLOW;
/* top boundary */
if (jCoord == jProc - 1)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = NO_SLIP;
/* bottom boundary */
if (jCoord == 0)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
/* step */
// step height & width: jProc * local_xlength[1] / 2
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 1; y <= min(xlength[1] / 2 - jCoord * (xlength[1] / jProc), local_xlength[1] ) ; y++) /* integer division on purpose, half of the channel is blocked by step */
for (x = 1; x <= min(xlength[1] / 2 - iCoord * (xlength[0] / iProc), local_xlength[0] ); x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = NO_SLIP;
// adjust the PARALLEL_BOUNDARY where "adjacent" cells in the neighbouring domain are NO_SLIP
/* top boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (x <= xlength[1] / 2 - iCoord * (xlength[0] / iProc) && xlength[1] / 2 - (jCoord + 1) * (xlength[1] / jProc) >= 1 && flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] == PARALLEL_BOUNDARY)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = NO_SLIP;
/* bottom boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if( x <= xlength[1] / 2 - iCoord * (xlength[0] / iProc) && 0 <= xlength[1] / 2 - jCoord * (xlength[1] / jProc) && flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] == PARALLEL_BOUNDARY)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
/* left boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if( 0 <= xlength[1] / 2 - iCoord * (xlength[0] / iProc) && y <= xlength[1] / 2 - jCoord * (xlength[1] / jProc) && flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] == PARALLEL_BOUNDARY)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = NO_SLIP;
/* right boundary */
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if( 1 <= xlength[1] / 2 - (iCoord + 1) * (xlength[0] / iProc) && y <= xlength[1] / 2 - jCoord * (xlength[1] / jProc) && flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] == PARALLEL_BOUNDARY)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = NO_SLIP;
}
if (!strcmp(problem, "planeShearFlow"))
{
/* front boundary, i.e. z = xlength + 1 */
if (kCoord == kProc - 1)
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[(local_xlength[2] + 1) * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x] = FREE_SLIP;
/* back boundary */
if (kCoord == 0)
#pragma omp for schedule(static)
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[y * (local_xlength[0] + 2) + x] = FREE_SLIP;
/* left boundary */
if (iCoord == 0)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2)] = PRESSURE_IN;
/* right boundary */
if (iCoord == iProc - 1)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + local_xlength[0] + 1] = OUTFLOW;
/* top boundary */
if (jCoord == jProc - 1)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + (local_xlength[1] + 1) * (local_xlength[0] + 2) + x] = NO_SLIP;
/* bottom boundary */
if (jCoord == 0)
#pragma omp for schedule(static)
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
flagField[z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + x] = NO_SLIP;
}
#endif // _ARBITRARYGEOMETRY_
} // end of parallel region
/** debugging code: checking the flagField */
#ifdef DEBUG
int * exactFlagField;
exactFlagField = (int *) malloc( (size_t) sizeof( int ) * (xlength[0] + 2) * (xlength[1] + 2) * (xlength[2] + 2));
FILE *fp2 = NULL;
unsigned int line2 = 0;
int noOfReadEntries;
int error2 = 0;
char szFileName2[80];
computePosition(iProc, jProc, kProc, &iCoord, &jCoord, &kCoord);
sprintf( szFileName2, "Testdata/%s/flagField.dat", problem );
fp2 = fopen(szFileName2,"r");
if (fp2 != NULL)
{
for (line2 = 0; line2 < (xlength[0] + 2) * (xlength[1] + 2) * (xlength[2] + 2); line2++)
{
noOfReadEntries = fscanf(fp2,"%d",&exactFlagField[line2]);
if (noOfReadEntries != 1)
continue;
}
}
fclose(fp2);
for (z = 1; z <= local_xlength[2]; z++)
for (y = 1; y <= local_xlength[1]; y++)
for(x = 1; x <= local_xlength[0]; x++)
for (i = 0; i < PARAMQ; i++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
if (error2)
printf("ERROR: Process %d has a different flagField at inner nodes.\n",rank);
error2 = 0;
// Check global boundaries as well
if (iCoord == 0)
{
// Left boundary
x = 0;
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (iCoord == iProc - 1)
{
// Right boundary
x = local_xlength[0] + 1;
for (z = 0; z <= local_xlength[2] + 1; z++)
for (y = 0; y <= local_xlength[1] + 1; y++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (jCoord == 0)
{
// Bottom boundary
y = 0;
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (jCoord == jProc - 1)
{
// Top boundary
y = local_xlength[1] + 1;
for (z = 0; z <= local_xlength[2] + 1; z++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (kCoord == 0)
{
// back boundary
z = 0;
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (kCoord == kProc - 1)
{
// front boundary
z = local_xlength[2] + 1;
for (y = 0; y <= local_xlength[1] + 1; y++)
for (x = 0; x <= local_xlength[0] + 1; x++)
if (flagField[(z * (local_xlength[0] + 2) * (local_xlength[1] + 2) + y * (local_xlength[0] + 2) + x)] != exactFlagField[((z + kCoord * (xlength[2] / kProc)) * (xlength[0] + 2) * (xlength[1] + 2) + (y + jCoord * (xlength[1] / jProc)) * (xlength[0] + 2) + (x + iCoord * (xlength[0] / iProc)))])
error2 = 1;
}
if (error2)
printf("ERROR: Process %d has a different flagField at global boundary.\n",rank);
free(exactFlagField);
#endif
/** debugging code end */
}
int main(int argc,char *argv[])
{
Centroid *SYS,*ENV;
Sprngmtx *Gamma;
char *sysfile,*envfile,*massfile,*ctfile,*spgfile;
double **GG;
double *CUT,**HS,**HE,**HX,**PH,*P;
double dd,x,y;
int **CT,**PIX,nss,nen,nn,ntp,nse,r1,c1,r2,c2,i,j,k;
int ptmd,rprm,pprm;
/* Formalities */
read_command_line(argc,argv,&pprm,&rprm,&ptmd,&MSCL);
/* Read coordinate and mass data */
sysfile=get_param(argv[pprm],"syscoords");
envfile=get_param(argv[pprm],"envcoords");
massfile=get_param(argv[pprm],"massfile");
SYS=read_centroids1(sysfile,massfile,&nss);
ENV=read_centroids1(envfile,massfile,&nen);
nn=nss+nen;
fprintf(stderr,"System read from %s: %d centroids\n",sysfile,nss);
fprintf(stderr,"Environment read from %s: %d centroids\n",envfile,nen);
fprintf(stderr,"Masses read from %s\n",massfile);
CT=imatrix(1,nn,1,nn);
/* Find extent of membrane */
membounds(ENV,nen,&MHI,&MLO);
/* Print masses, if called for */
if(ptmd==2){
for(i=1;i<=nss;i++)
for(j=-2;j<=0;j++){
k=3*i+j;
printf("%8d%8d% 25.15e\n",k,k,SYS[i].mass);
}
for(i=1;i<=nen;i++)
for(j=-2;j<=0;j++){
k=3*nss+3*i+j;
printf("%8d%8d% 25.15e\n",k,k,ENV[i].mass);
}
return 0;
}
/* ---------------- Assign contacts... ----------------- */
/* From a contact file... */
if((ctfile=get_param(argv[pprm],"contactfile"))!=NULL){
read_contacts(ctfile,CT,nn);
fprintf(stderr,"Contacts read from %s\n",ctfile);
}
/* ...or from a cutoff file... */
else if((ctfile=get_param(argv[pprm],"cutfile"))!=NULL){
fprintf(stderr,"Cutoff values read from %s\n",ctfile);
CUT=read_cutfile2(ctfile,SYS,ENV,nss,nen);
radius_contact_sysenv(CT,SYS,ENV,nss,nen,CUT);
}
/* ...or from default values */
else{
CUT=dvector(1,nn);
for(i=1;i<=nn;i++) CUT[i]=DEFCUT;
fprintf(stderr,"All cutoff values set to %.3f\n",DEFCUT);
radius_contact_sysenv(CT,SYS,ENV,nss,nen,CUT);
}
fprintf(stderr,"%d clusters\n",num_clusters(CT,nn));
if(ptmd==1){
fprintf(stderr,"Printing contacts\n");
for(i=1;i<=nn;i++)
for(j=i+1;j<=nn;j++)
if(CT[i][j]!=0)
printf("%d\t%d\n",i,j);
return 0;
}
/* ------- Construct the matrix of force constants -------*/
GG=dmatrix(1,nn,1,nn);
/* Read force constants from file... */
if((spgfile=get_param(argv[pprm],"springfile"))!=NULL){
fprintf(stderr,"Reading spring constants from %s\n",spgfile);
Gamma=read_springfile_sysenv(spgfile,SYS,ENV,nss,nen,&ntp);
spring_constants_sysenv(SYS,ENV,GG,CT,Gamma,nss,nen,ntp);
}
/* ...or else assign the default value to all springs */
else
for(i=1;i<=nn;i++)
for(j=i;j<=nn;j++)
if(CT[i][j]!=0)
GG[i][j]=GG[j][i]=DEFGAM;
/* Construct the mass-weighted Hessian from
coordinates, masses, and potential matrix */
fprintf(stderr,"Calculating Hessian...\n");
HS=dmatrix(1,3*nss,1,3*nss);
HE=dmatrix(1,3*nen,1,3*nen);
HX=dmatrix(1,3*nss,1,3*nen);
mwhess_sysenv(HS,HE,HX,SYS,ENV,GG,nss,nen);
/* PRINT THE ENVIRONMENT-ENVIRONMENT SUB-HESSIAN IN SPARSE FORMAT */
if(ptmd==0 && rprm==-1){
fprintf(stderr,"\nPrinting env-env sub-hessian...\n\n");
for(i=1;i<=3*nen;i++)
for(j=i;j<=3*nen;j++)
if(fabs(HE[i][j])>1.0e-10)
printf("%8d%8d% 25.15e\n",i,j,HE[i][j]);
return 0;
}
/* PRINT THE FULL HESSIAN IN SPARSE FORMAT */
if(ptmd==3){
for(i=1;i<=3*nss;i++){
for(j=i;j<=3*nss;j++)
if(fabs(HS[i][j])>1.0e-10)
printf("%8d%8d% 20.10e\n",i,j,HS[i][j]);
for(j=1;j<=3*nen;j++)
if(fabs(HX[i][j])>1.0e-10)
printf("%8d%8d% 20.10e\n",i,j+3*nss,HX[i][j]);
}
for(i=1;i<=3*nen;i++)
for(j=i;j<=3*nen;j++)
if(fabs(HE[i][j])>1.0e-10)
printf("%8d%8d% 20.10e\n",i+3*nss,j+3*nss,HE[i][j]);
return 0;
}
/* READ INVERSE OF ENVIRONMENTAL HESSIAN, OR INVERT HE */
free_imatrix(CT,1,nn,1,nn);
free_dmatrix(GG,1,nn,1,nn);
if(rprm!=-1){
fprintf(stderr,"Reading matrix from %s...\n",argv[rprm]);
read_sparsemtx(argv[rprm],HE,3*nen,3*nen);
}
else{
fprintf(stderr,"\nWell...How did I get here?\n\n");
exit(1);}
/* ---------------- CALCULATE AND PRINT THE PSEUDOHESSIAN ---------------- */
/* COUNT THE NUMBER OF NON-ZERO TERMS IN THE PROJECTION MATRIX */
nse=0;
for(i=1;i<=3*nss;i++)
for(j=1;j<=3*nen;j++)
if(fabs(HX[i][j])>1.0e-9) nse++;
fprintf(stderr,"%d non-zero projection elements\n",nse);
P=dvector(1,nse);
PIX=imatrix(1,nse,1,2);
k=1;
for(i=1;i<=3*nss;i++)
for(j=1;j<=3*nen;j++)
if(fabs(HX[i][j])>1.0e-9){
PIX[k][1]=i;
PIX[k][2]=j;
P[k]=HX[i][j];
k++;
}
free_dmatrix(HX,1,3*nss,1,3*nen);
PH=dmatrix(1,3*nss,1,3*nss);
for(i=1;i<=3*nss;i++)
for(j=i;j<=3*nss;j++)
PH[i][j]=PH[j][i]=0.0;
for(i=1;i<=nse;i++){
r1=PIX[i][1];
c1=PIX[i][2];
x=P[i];
for(j=i;j<=nse;j++){
r2=PIX[j][1];
c2=PIX[j][2];
y=HE[c1][c2]*P[j]*x;
PH[r1][r2]+=y;
if(r1==r2 && c1!=c2)
PH[r1][r2]+=y;
}
}
for(i=1;i<=3*nss;i++)
for(j=i;j<=3*nss;j++){
dd=HS[i][j]-PH[i][j];
if(fabs(dd)>1.0e-10)
printf("%8d%8d% 25.15e\n",i,j,dd);
}
return 0;
}
char getNodeSign (uint mode, uint treeID, Node *nodePtr, uint *bmIndex, uint repMembrSize) {
int *mvNSptr;
int *fmvNSptr;
char result;
uint i,p,q,m;
result = TRUE;
switch (mode) {
case RF_PRED:
if (RF_mRecordSize > 0) {
stackMPSign(nodePtr, RF_mpIndexSize);
mvNSptr = nodePtr -> mpSign;
}
else {
mvNSptr = NULL;
}
if (RF_fmRecordSize > 0) {
stackFMPSign(nodePtr, RF_fmpIndexSize);
fmvNSptr = nodePtr -> fmpSign;
}
else {
fmvNSptr = NULL;
}
break;
default:
if (RF_mRecordSize > 0) {
stackMPSign(nodePtr, RF_mpIndexSize);
mvNSptr = nodePtr -> mpSign;
}
else {
mvNSptr = NULL;
}
fmvNSptr = NULL;
break;
}
if (mvNSptr != NULL) {
int **mvBootstrapSign = imatrix(1, RF_mpIndexSize, 1, repMembrSize);
for (p = 1; p <= RF_mpIndexSize; p++) {
for (i = 1; i <= repMembrSize; i++) {
mvBootstrapSign[p][i] = 0;
}
}
for (p = 1; p <= RF_mpIndexSize; p++) {
mvNSptr[p] = 0;
}
for (i=1; i <= repMembrSize; i++) {
m = bmIndex[i];
if (RF_mRecordMap[m] != 0) {
for (p = 1; p <= RF_mpIndexSize; p++) {
if (RF_mpIndex[p] < 0) {
mvBootstrapSign[p][i] = RF_mpSign[(uint) abs(RF_mpIndex[p])][RF_mRecordMap[m]];
}
else {
mvBootstrapSign[p][i] = RF_mpSign[RF_rSize + (uint) RF_mpIndex[p]][RF_mRecordMap[m]];
}
}
}
else {
for (p = 1; p <= RF_mpIndexSize; p++) {
mvBootstrapSign[p][i] = 0;
}
}
for (p = 1; p <= RF_mpIndexSize; p++) {
mvNSptr[p] = mvNSptr[p] + mvBootstrapSign[p][i];
}
}
m = 0;
for (p = 1; p <= RF_mpIndexSize; p++) {
if (mvNSptr[p] > 0) {
if (mvNSptr[p] == repMembrSize) {
mvNSptr[p] = -1;
}
else {
mvNSptr[p] = 1;
}
}
if(RF_mpIndex[p] < 0) {
if (mvNSptr[p] == -1) result = FALSE;
}
else {
if (mvNSptr[p] == -1) m ++;
}
}
if (m == RF_mpIndexSize) {
result = FALSE;
}
free_imatrix(mvBootstrapSign, 1, RF_mpIndexSize, 1, repMembrSize);
}
if (fmvNSptr != NULL) {
for (p = 1; p <= RF_fmpIndexSize; p++) {
fmvNSptr[p] = 1;
}
if (RF_mRecordSize > 0) {
p = q = 1;
while ((p <= RF_mpIndexSize) && (q <= RF_fmpIndexSize)) {
if (RF_mpIndex[p] == RF_fmpIndex[q]) {
if (mvNSptr[p] == -1) {
fmvNSptr[q] = -1;
}
p++;
q++;
}
else if (RF_fmpIndex[q] < 0) {
if (RF_mpIndex[p] > 0) {
q++;
}
else {
if (abs(RF_fmpIndex[q]) < abs(RF_mpIndex[p])) {
q++;
}
else {
p++;
}
}
}
else {
if (RF_fmpIndex[q] < RF_mpIndex[p]) {
q++;
}
else {
p++;
}
}
}
}
}
return result;
}
static Gdinfo *ReadGridFile(FileList *f) {
register int i,j,k;
char buf[BUFSIZ];
int nel,npt,nbnd,vid,vid1,eid,eid1,**bndpts,trip;
Gdinfo *ginfo = (Gdinfo *)malloc(sizeof(Gdinfo));
Cinfo *con,*c,*c1;
FILE *fp = f->in.fp;
/* read boundary condition file */
if(f->mesh.name) ReadBcond(f->mesh.fp,ginfo);
fgets(buf,BUFSIZ,fp);
fgets(buf,BUFSIZ,fp);
sscanf(buf,"%d%d%d%*d",&nel,&npt,&nbnd);
ginfo->nel = nel;
ginfo->npt = npt;
ginfo->nbnd = nbnd;
ginfo->elmtpts = imatrix(0,nel-1,0,2);
ginfo->x = dvector(0,npt-1);
ginfo->y = dvector(0,npt-1);
bndpts = imatrix(0,nel-1,0,2);
ginfo->elmtcon = (Cinfo**)malloc(nel*sizeof(Cinfo *));
ginfo->elmtcon[0] = (Cinfo *)calloc(3*nel,sizeof(Cinfo) );
for(k = 1; k < nel; ++k) ginfo->elmtcon[k] = ginfo->elmtcon[k-1]+3;
con = (Cinfo *)calloc(npt,sizeof(Cinfo));
/* read element vertex co-ordinate indices */
fgets(buf,BUFSIZ,fp);
for(k = 0; k < nel; ++k) {
fgets (buf,BUFSIZ,fp);
sscanf(buf,"%*d%d%d%d",ginfo->elmtpts[k],
ginfo->elmtpts[k]+1,ginfo->elmtpts[k]+2);
}
/* read co-ordinates */
fgets(buf,BUFSIZ,fp);
for(k = 0; k < npt; ++k) {
fgets (buf,BUFSIZ,fp);
sscanf(buf,"%*d%lf%lf",ginfo->x+k,ginfo->y+k);
}
/* read boundary info */
fgets(buf,BUFSIZ,fp);
for(k = 0; k < nbnd; ++k) {
fgets (buf,BUFSIZ,fp);
sscanf(buf,"%d%d%*d%d",bndpts[k],bndpts[k]+1,bndpts[k]+2);
}
/* sort out connectivity */
/* get list of all elements at a vertex */
for(k = 0; k < nel; ++k)
for(i = 0; i < 3; ++i)
addcon(con+ginfo->elmtpts[k][i]-1,k+1,i);
/* search through element list and fill out element connectivity */
for(i = 0; i < npt; ++i) {
for(c = con[i].next; c; c = c->next) {
vid = (c->vsid+1)%3;
eid = c->elmtid;
for(c1 = con[i].next; c1; c1 = c1->next) {
vid1 = (c1->vsid+2)%3;
eid1 = c1->elmtid;
if(ginfo->elmtpts[eid-1][vid] == ginfo->elmtpts[eid1-1][vid1]) {
ginfo->elmtcon[eid -1][c->vsid].type = 'E';
ginfo->elmtcon[eid -1][c->vsid].elmtid = eid1;
ginfo->elmtcon[eid -1][c->vsid].vsid = vid1;
ginfo->elmtcon[eid1-1][vid1 ].type = 'E';
ginfo->elmtcon[eid1-1][vid1 ].elmtid = eid;
ginfo->elmtcon[eid1-1][vid1 ].vsid = c->vsid;
}
}
}
}
/* check through list and match any missing element with boundary values */
for(k = 0; k < nel; ++k)
for(i = 0; i < 3; ++i)
if(!ginfo->elmtcon[k][i].elmtid) {
vid = ginfo->elmtpts[k][i];
vid1 = ginfo->elmtpts[k][(i+1)%3];
/* check to see that this side is a boundary */
for(j = 0,trip=1; j < nbnd; ++j)
if(vid == bndpts[j][0] && vid1 == bndpts[j][1]) {
/* set boundary condition from given values if present */
if(f->mesh.name) {
register int i1;
Bndinfo *b;
Curinfo *c;
for(b=ginfo->bnd; b; b = b->next)
if(b->region == bndpts[j][2]) {
ginfo->elmtcon[k][i].type = b->type;
switch(b->type) {
case 'W':
case 'O':
case 'S':
case 'B':
case 'M':
case 'I':
case 'Z':
break;
case 'V':
case 'F':
dcopy(b->nbcs,b->data.val,1,ginfo->elmtcon[k][i].f,1);
break;
case 'v':
case 'f':
case 'm':
for(i1=0; i1 < b->nbcs; ++i1)
ginfo->elmtcon[k][i].str[i1] = b->data.str[i1];
break;
}
}
for(c=ginfo->curve; c; c = c->next) {
if(c->region == bndpts[j][2]) {
/* reset co-ordinates */
switch(c->type) {
case 'C': /* arc */
{
double theta;
theta = atan2(ginfo->y[vid-1]-c->info.arc.yc,
ginfo->x[vid-1]-c->info.arc.xc);
ginfo->x[vid-1] = fabs(c->info.arc.radius)*cos(theta)
+ c->info.arc.xc;
ginfo->y[vid-1] = fabs(c->info.arc.radius)*sin(theta)
+ c->info.arc.yc;
theta = atan2(ginfo->y[vid1-1]-c->info.arc.yc,
ginfo->x[vid1-1]-c->info.arc.xc);
ginfo->x[vid1-1] = fabs(c->info.arc.radius)*cos(theta)
+ c->info.arc.xc;
ginfo->y[vid1-1] = fabs(c->info.arc.radius)*sin(theta)
+ c->info.arc.yc;
break;
}
}
/* add curved information about element to ginfo */
addcurve(ginfo,k+1,i,c->idtype);
}
}
}
else
ginfo->elmtcon[k][i].type = 'W';
trip=0;
}
if(trip)
fprintf(stderr,"side %d of element %d using coordinate indices"
" (%d,%d) is not a boundary\n",i+1,k+1,vid,vid1);
}
/* free the con list */
for(k = 0; k < npt; ++k) {
c = con[k].next;
while(c) {
c1 = c->next;
free(c);
c = c1;
}
}
free(con);
free_imatrix(bndpts,0,0);
return ginfo;
}
void laplace_fourier_res(float **sectionvy_obs, float **sectionvy, float **sectiondiff, int ntr, int ntr_glob, int ns, int ishot, int nshots, int iter, int **recpos, int **recpos_loc, float **srcpos){
/* declaration of global variables */
extern float DT, DH, OFFSETC;
extern int SEIS_FORMAT, MYID, NT, TIMEWIN;
extern char SEIS_FILE_VY[STRING_SIZE], PARA[STRING_SIZE], DATA_DIR[STRING_SIZE];
extern int TRKILL, OFFSET_MUTE, GRAD_FORM;
extern char TRKILL_FILE[STRING_SIZE];
/* declaration of variables for trace killing */
int ** kill_tmp, *kill_vector, h, j, i, Npad;
char trace_kill_file[STRING_SIZE];
FILE *ftracekill;
/* declaration of variables for offset-muting */
float offset, xr, yr, xs, ys;
/* complex variables for source wavelet estimation */
fftw_complex *D_ss, *D_ss_fd;
/* parameters for STA/LTA first arrival picking */
float *picked_times=NULL;
/* variables for data integration */
int invtime;
float **integrated_section=NULL, **integrated_sectiondata=NULL;
float EPS_NORM;
integrated_section = matrix(1,ntr,1,ns);
integrated_sectiondata = matrix(1,ntr,1,ns);
Npad = 2.0 * ns;
Npad = (int)(pow(2.0, ceil(log((double)(Npad))/log(2.0))+2.0) );
EPS_NORM=1e0;
/* Allocate memory */
D_ss = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
D_ss_fd = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
/* reverse time direction integrate data if GRAD_FORM=1 */
for(i=1;i<=ntr;i++){
invtime = ns;
for(j=1;j<=ns;j++){
if(GRAD_FORM==1){
integrated_section[i][invtime] += DT*sectionvy[i][j];
integrated_sectiondata[i][invtime] += DT*sectionvy_obs[i][j];
}
if(GRAD_FORM==2){
integrated_section[i][invtime] = sectionvy[i][j];
integrated_sectiondata[i][invtime] = sectionvy_obs[i][j];
}
invtime--;
}
}
/* pick first arrivals in the synthetic data with STA/LTA-picker and apply time window to field data before stf inversion */
/*if(TIMEWIN==3){
picked_times = vector(1,ntr);
stalta(sectionvy, ntr, ns, picked_times, ishot);
time_window_stf(sectionvy_obs, iter, ntr, ns, ishot);
}*/
TIMEWIN=2;
/* apply time damping to field and model data */
picked_times = vector(1,ntr);
time_window(integrated_sectiondata,picked_times,iter,ntr_glob,recpos_loc,ntr,ns,ishot);
time_window(integrated_section,picked_times,iter,ntr_glob,recpos_loc,ntr,ns,ishot);
/* TRKILL==1 - trace killing is applied */
if(TRKILL){
kill_tmp = imatrix(1,nshots,1,ntr);
kill_vector = ivector(1,ntr);
ftracekill=fopen(TRKILL_FILE,"r");
if (ftracekill==NULL) err(" Trace kill file could not be opened!");
for(i=1;i<=nshots;i++){
for(j=1;j<=ntr;j++){
fscanf(ftracekill,"%d",&kill_tmp[i][j]);
}
}
fclose(ftracekill);
for(i=1;i<=ntr;i++){
kill_vector[i] = kill_tmp[ishot][i];
}
for(i=1;i<=ntr;i++){
if(kill_vector[i]==1){
for(j=1;j<=ns;j++){
integrated_section[i][j]=0.0;
integrated_sectiondata[i][j]=0.0;
}
}
}
}
/* trace killing ends here */
/* apply offset mute */
if(OFFSET_MUTE){
/*printf("OFFSETC = %f \n",OFFSETC);
printf("OFFSET_MUTE = %d \n",OFFSET_MUTE); */
for (i=1;i<=ntr;i++){
/* calculate source and receiver positions */
xr = recpos[1][recpos_loc[3][i]]*DH;
xs = srcpos[1][ishot];
yr = recpos[2][recpos_loc[3][i]]*DH;
ys = srcpos[2][ishot];
/* calculate absolute offset */
offset = sqrt(((xs-xr)*(xs-xr))+((ys-yr)*(ys-yr)));
/* mute far-offset data*/
if((OFFSET_MUTE==1)&&(offset>=OFFSETC)){
for(j=1;j<=ns;j++){
integrated_section[i][j]=0.0;
integrated_sectiondata[i][j]=0.0;
}
}
/* mute near-offset data*/
if((OFFSET_MUTE==2)&&(offset<=OFFSETC)){
for(j=1;j<=ns;j++){
integrated_section[i][j]=0.0;
integrated_sectiondata[i][j]=0.0;
}
}
}
} /* end of OFFSET_MUTE */
/* FFT of each data and model trace and calculation of nominator and denominator of Wiener deconvolution */
for(i=1;i<=ntr;i++){
/* allocate memory for complex variables */
fftw_complex *in_data, *out_data, *in_model, *out_model, *res_td, *res;
fftw_plan p_data,p_model;
in_data = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
out_data = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
in_model = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
out_model = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
res_td = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
res = (fftw_complex*) fftw_malloc(sizeof(fftw_complex) * Npad);
/* define real and imaginary parts of data vectors and apply zero-padding */
for(j=0;j<Npad;j++){
if(j<ns){
in_model[j] = (integrated_section[i][j+1]) + 0.0*I;
in_data[j] = (integrated_sectiondata[i][j+1]) + 0.0*I;
}
else{
in_model[j] = 0.0 + 0.0*I;
in_data[j] = 0.0 + 0.0*I;
}
}
/* apply FFTW */
p_data = fftw_plan_dft_1d(Npad, in_data, out_data, 1, FFTW_ESTIMATE);
p_model = fftw_plan_dft_1d(Npad, in_model, out_model, 1, FFTW_ESTIMATE);
fftw_execute(p_data);
fftw_execute(p_model);
/* calculate data residuals in the Laplace-Fourier domain (Jun etal., 2014)*/
for(j=0;j<Npad;j++){
/* real parts of the nominator and denominator */
res[j] = (1.0/out_model[j]+EPS_NORM)*conj(log(out_model[j]+EPS_NORM)-log(out_data[j]+EPS_NORM));
}
/* inverse FFTW of data residuals */
fftw_plan p_stf;
p_stf = fftw_plan_dft_1d(Npad, res, res_td, -1, FFTW_ESTIMATE);
fftw_execute(p_stf);
/* extract real part and write data to sectiondiff */
/*h=1;
for(j=Npad;j>Npad-ns;j--){
sectiondiff[i][h]=creal(res_td[h])/Npad;
h=h+1;
}*/
for(j=1;j<=ns;j++){
sectiondiff[i][j] = integrated_section[i][j] - integrated_sectiondata[i][j];
}
fftw_destroy_plan(p_data);
fftw_free(in_data);
fftw_free(out_data);
fftw_destroy_plan(p_model);
fftw_destroy_plan(p_stf);
fftw_free(in_model);
fftw_free(out_model);
fftw_free(res);
fftw_free(res_td);
}
/* free memory for trace killing and FFTW */
if(TRKILL){
free_imatrix(kill_tmp,1,nshots,1,ntr);
free_ivector(kill_vector,1,ntr);
}
fftw_free(D_ss);
fftw_free(D_ss_fd);
free_vector(picked_times,1,ntr);
free_matrix(integrated_section,1,ntr,1,ns);
free_matrix(integrated_sectiondata,1,ntr,1,ns);
}
void viterbi(HMM *hmm_ptr, int T, char *O, double *pprob, int *vpath, char *signal_file1, char *signal_file2, char *out_file, char *phmm_dir1, char *out_dir1, char *hmmerv){
/*
chr *O: sequecne
int *vpath: optimal path after backtracking
int T: the length of sequence
hmm.A[][]: transition prob
hmm.B[][]: emission prob
hmm.N: the number of state
int i: index for start state, current state
int j: index for end start
int t: index for string
int t1: subindex for string
int state_end;
double state_score;
*/
int i, j, t, t1, d, ss, si;
double max_val, temp_val;
int max_state;
int **path; /* viterbi path */
double **alpha; /* viterbi array */
int *signal; /* chromosomal position for the index in X axis of array */
int *path_signal; /* 0: start of fragment, 1: end */
int temp1, temp2;
double temp3, temp4;
FILE *fp,*outfp;
int state_end;
double state_score;
int *ape, *rt;
int *start, *end;
int flag;
char state_flag[20];
int prev_state;
int final_t;
int sig_id = 0; /* index for signal of fragments */
int num_sig = 0; /* total numer of signals */
int temp_id;
double temp_prob;
int check_prob;
int debug = 0;
/*
if ((phmm_dir = (char *)malloc(50 * sizeof(char)))==NULL){
printf("ERROR: allocation of phmm_dir\n");
exit;
}
if ((out_dir = (char *)malloc(50 * sizeof(char)))==NULL){
printf("ERROR: allocation of out_dir\n");
exit;
}
memset(phmm_dir,0,50);
memset(out_dir,0,50);
*/
phmm_dir = phmm_dir1;
out_dir = out_dir1;
memset(state_flag,0,20);
/***************************************************************/
/* initialize viterbi array */
/***************************************************************/
ape = (int *)ivector(T+1);
rt = (int *)ivector(T+1);
start = (int *)ivector(hmm_ptr->N);
end = (int *)ivector(hmm_ptr->N);
/*****************************************************************/
/* mark signal */
/*****************************************************************/
for (t=0; t<T; t++){
ape[t] = 0;
rt[t] = 0;
}
fp = fopen(signal_file1, "r");
while (fscanf(fp, "%d %d %lf %lf\n", &temp1, &temp2, &temp3, &temp4) != EOF){
ape[temp1] = 1;
if (temp2 > T) {temp2 = T;}
ape[temp2] = 2;
num_sig += 2;
}
fclose(fp);
fp = fopen(signal_file2, "r");
while (fscanf(fp, "%d %d %lf %lf\n", &temp1, &temp2, &temp3, &temp4) != EOF){
rt[temp1] = 1;
if (temp2 > T) {temp2 = T;}
rt[temp2] = 2;
num_sig += 4;
}
fclose(fp);
num_sig *= 2;
/***************************************************************/
/* initialize viterbi array */
/***************************************************************/
alpha = (double **)dmatrix(hmm_ptr->N, num_sig);
path = (int **)imatrix(hmm_ptr->N, num_sig);
signal = (int *)ivector(num_sig);
path_signal = (int *)ivector(num_sig);
outfp = fopen (out_file , "w");
if (num_sig > 0){
/******************************************************************/
/* initialize the first IE state */
/******************************************************************/
start[IE]=0;
signal[sig_id] = 0;
sig_id ++;
for (i=0; i<hmm_ptr->N; i++){
alpha[i][0] = -1 * log(hmm_ptr->pi[i]);
for (t=1; t<num_sig; t++){
alpha[i][t] = DBL_MAX;
}
}
/******************************************************************/
/* do recursion to fill out rest of the columns */
/******************************************************************/
for (t = 1; t < T - 2; t++) {
if (sig_id >= num_sig) { break; }
flag=0;
/*********************/
/* state APE start */
/*********************/
if (ape[t]==1){
flag=1;
strcpy(state_flag, "APE start");
path_signal[sig_id] = 0;
alpha[IE][sig_id] = DBL_MAX;
path[IE][sig_id] = IE;
start[IE] = sig_id;
for(ss=0; ss<NO_APE; ss++){
alpha[ape_state[ss]][sig_id] = alpha[IE][sig_id-1] - log(hmm_ptr->A[IE][ape_state[ss]]);
path[ape_state[ss]][sig_id] = IE;
start[ape_state[ss]] = sig_id;
}
}
/*********************/
/* state APE end */
/*********************/
if (ape[t] == 2) {
flag=1;
strcpy(state_flag, "APE end");
path_signal[sig_id] = 1;
alpha[IE][sig_id] = DBL_MAX;
path[IE][sig_id] = IE;
for (ss=0; ss<NO_APE; ss++){
state_score = get_prob(ape_state[ss], signal[start[ape_state[ss]]], t, O, hmmerv);
if (state_score == DBL_MAX){
alpha[ape_state[ss]][sig_id] = DBL_MAX;
}else{
alpha[ape_state[ss]][sig_id] = alpha[ape_state[ss]][start[ape_state[ss]]] - state_score - log(dist_ape(t-signal[start[ape_state[ss]]]+1));
}
path[ape_state[ss]][sig_id] = ape_state[ss];
}
}
/*********************/
/* state ID/IE start */
/*********************/
if (ape[t-1] == 2){
flag=1;
strcpy(state_flag, "ID/IE start");
path_signal[sig_id] = 0;
alpha[IE][sig_id] = alpha[IE][sig_id-1];
path[IE][sig_id] = IE;
start[IE] = sig_id;
for (si=0; si<NO_APE; si++){
temp_val = alpha[ape_state[si]][sig_id-1] - log(hmm_ptr->A[ape_state[si]][IE]);
if (temp_val < alpha[IE][sig_id]){
alpha[IE][sig_id] = temp_val;
path[IE][sig_id] = ape_state[si];
}
}
for (si=0; si<NO_APE; si++){
if (alpha[ape_state[si]][sig_id-1]==DBL_MAX){
alpha[id_state[si]][sig_id] = DBL_MAX;
}else{
alpha[id_state[si]][sig_id] = alpha[ape_state[si]][sig_id-1] - log(hmm_ptr->A[ape_state[si]][id_state[si]]);
}
path[id_state[si]][sig_id] = ape_state[si];
start[id_state[si]] = sig_id;
}
}
/*********************/
/* state ID/IE end */
/*********************/
if (rt[t+1] == 1 ) {
flag=1;
strcpy(state_flag, "ID/IE end");
path_signal[sig_id] = 1;
state_score = get_prob(IE, signal[start[IE]], t, O, hmmerv);
alpha[IE][sig_id] = alpha[IE][start[IE]] - state_score - log(dist_ie(t-signal[start[IE]]+1));
path[IE][sig_id] = IE;
if (start[id_state[0]] >-1){
for (si=0; si<NO_APE; si++){
state_score = get_prob(id_state[si], signal[start[id_state[si]]], t, O, hmmerv);
if (dist_id(t-signal[start[id_state[si]]]+1)==0){
alpha[id_state[si]][sig_id] = DBL_MAX;
}else{
alpha[id_state[si]][sig_id] = alpha[id_state[si]][start[id_state[si]]] - state_score - log(dist_id(t-signal[start[id_state[si]]]+1));
}
path[id_state[si]][sig_id] = id_state[si];
start[id_state[si]]=-1;
}
}else{
for (si=0; si<NO_APE; si++){
alpha[id_state[si]][sig_id] = DBL_MAX;
path[id_state[si]][sig_id] = -1;
}
}
}
/*********************/
/* state RT1 start */
/*********************/
if (rt[t] == 1) {
flag=1;
strcpy(state_flag, "RT start");
path_signal[sig_id] = 0;
alpha[IE][sig_id] = DBL_MAX;
path[IE][sig_id] = IE;
start[IE] = sig_id;
for (si=0; si<NO_RT; si++){
alpha[rt_state[si]][sig_id] = alpha[IE][sig_id-1] - log(hmm_ptr->A[IE][rt_state[si]]);
path[rt_state[si]][sig_id] = IE;
start[rt_state[si]] = sig_id;
temp_val = alpha[id_state[si]][sig_id-1] - log(hmm_ptr->A[id_state[si]][rt_state[si]]);
if (temp_val < alpha[rt_state[si]][sig_id]){
alpha[rt_state[si]][sig_id] = temp_val;
path[rt_state[si]][sig_id] = id_state[si];
}
}
}
/*********************/
/* state RT1 end */
/*********************/
if (rt[t] == 2) {
flag=1;
strcpy(state_flag, "RT end");
path_signal[sig_id] = 1;
alpha[IE][sig_id] = DBL_MAX;
path[IE][sig_id] = IE;
for (si=0; si<NO_RT; si++) {
state_score = get_prob(rt_state[si], signal[start[rt_state[si]]], t, O, hmmerv);
if (state_score == DBL_MAX){
alpha[rt_state[si]][sig_id] = DBL_MAX;
}else{
alpha[rt_state[si]][sig_id] = alpha[rt_state[si]][start[rt_state[si]]] - state_score - log(dist_rt(t-signal[start[rt_state[si]]]+1));
}
path[rt_state[si]][sig_id] = rt_state[si];
}
}
/*********************/
/* state IE start */
/*********************/
if (rt[t-1] == 2){
flag=1;
strcpy(state_flag, "IE start");
path_signal[sig_id] = 0;
alpha[IE][sig_id] = DBL_MAX;
path[IE][sig_id] = IE;
start[IE] = sig_id;
for (si=0; si<NO_RT; si++){
temp_val = alpha[rt_state[si]][sig_id-1] - log(hmm_ptr->A[rt_state[si]][IE]);
if (temp_val < alpha[IE][sig_id]){
alpha[IE][sig_id] = temp_val;
path[IE][sig_id] = rt_state[si];
}
}
for (si=0; si<NO_APE; si++){
alpha[id_state[si]][sig_id]=DBL_MAX;
path[id_state[si]][sig_id] = -1;
}
}
/*********************/
/* state IE end */
/*********************/
if (ape[t+1] == 1 ) {
flag=1;
strcpy(state_flag, "IE end");
path_signal[sig_id] = 1;
state_score = get_prob(IE, signal[start[IE]], t, O, hmmerv);
if (dist_ie(t-signal[start[IE]]+1)==0){
alpha[IE][sig_id] = DBL_MAX;
}else{
alpha[IE][sig_id] = alpha[IE][start[IE]] - state_score - log(dist_ie(t-signal[start[IE]]+1));
}
path[IE][sig_id] = IE;
}
/************************/
/* print */
/************************/
if (flag==1){
final_t = sig_id;
signal[sig_id] = t;
if (debug==1){
printf("%d %d %s\t\t", sig_id, t, state_flag);
for (i=0; i<hmm_ptr->N; i++){
if (alpha[i][sig_id] < DBL_MAX ){
printf("%lf\t", alpha[i][sig_id]);
}else{
printf("-\t");
}
}
printf("\n\n");
printf("%d %d %s\t\t", sig_id, t, state_flag);
for (i=0; i<hmm_ptr->N; i++){
printf("%d\t", path[i][sig_id]);
}
printf("\n\n\n");
}
sig_id++;
}
}
/***********************************************************/
/* backtrack array to find the optimal path */
/***********************************************************/
*pprob = DBL_MAX;
vpath = (int *)ivector(num_sig);
for (i = 0; i < hmm_ptr->N; i++){
if (alpha[i][final_t] < *pprob && alpha[i][final_t] > 0.00001){
*pprob = alpha[i][final_t];
vpath[final_t] = i;
}
}
if (*pprob == DBL_MAX) {
vpath[final_t]=0;
}
for(sig_id=final_t-1; sig_id>=0; sig_id--){
// skip if viterbi path or array is out of range
if ( path[vpath[sig_id+1]][sig_id+1] == -1)
continue;
vpath[sig_id] = path[vpath[sig_id+1]][sig_id+1];
if (path_signal[sig_id] == 1 && alpha[vpath[sig_id]][sig_id] != DBL_MAX){
fprintf(outfp, "%d %d %lf\n", signal[sig_id], vpath[sig_id], alpha[vpath[sig_id]][sig_id]);
}
}
}
fclose(outfp);
free_ivector(ape);
free_ivector(rt);
free_ivector(start);
free_ivector(end);
free_imatrix(path, hmm_ptr->N);
free_dmatrix(alpha, hmm_ptr->N);
free_ivector(signal);
free_ivector(path_signal);
free_ivector(vpath);
}
double calc_misfit(float **sectiondata, float **section, int ntr, int ns, int LNORM, float L2, int itest, int sws, int swstestshot,int ntr_glob, int **recpos_loc, int nsrc_glob, int ishot){
/* declaration of variables */
extern float DT;
extern int MYID;
extern int TRKILL;
extern char TRKILL_FILE[STRING_SIZE];
float intseis, intseis_data, intseis_synthetics, abs_synthetics, abs_data;
int i,j;
float l2;
float L2_dummy;
int umax=0, h;
/* declaration of variables for trace killing */
int ** kill_tmp, *kill_vector;
char trace_kill_file[STRING_SIZE];
FILE *ftracekill;
if(TRKILL){
kill_tmp = imatrix(1,ntr_glob,1,nsrc_glob);
kill_vector = ivector(1,ntr);
ftracekill=fopen(TRKILL_FILE,"r");
if (ftracekill==NULL) err(" Trace kill file could not be opened!");
for(i=1;i<=ntr_glob;i++){
for(j=1;j<=nsrc_glob;j++){
fscanf(ftracekill,"%d",&kill_tmp[i][j]);
}
}
fclose(ftracekill);
h=1;
for(i=1;i<=ntr;i++){
kill_vector[h] = kill_tmp[recpos_loc[3][i]][ishot];
h++;
}
} /* end if(TRKILL)*/
/* calculate misfit */
for(i=1;i<=ntr;i++){
if((TRKILL==1)&&(kill_vector[i]==1))
continue;
intseis = 0.0;
intseis_data = 0.0;
intseis_synthetics = 0.0;
abs_data = 0.0;
abs_synthetics = 0.0;
L2_dummy=0.0;
for(j=1;j<=ns;j++){
/*printf("%d \t %d \t %e \t %e \n",i,j,sectionpdata[i][j],sectionp[i][j]);*/
/* calculate L2 residuals */
if((LNORM==2) ||(LNORM==6)){
intseis += section[i][j]-sectiondata[i][j];}
if(LNORM==5){
intseis_data += sectiondata[i][j]*DT;
intseis_synthetics += section[i][j]*DT;
abs_data += intseis_data*intseis_data;
abs_synthetics += intseis_synthetics*intseis_synthetics;
L2_dummy+=(intseis_data*intseis_synthetics);}
/* calculate norm */
/*if((sws==1)&&(swstestshot==1)){*/
if(((LNORM==2) ||(LNORM==6)) &&(swstestshot==1)){
/*L2+=sectiondiff[i][invtime]*sectiondiff[i][invtime];*/
L2+=intseis*intseis*DT*DT;
}
}
if(LNORM==5){
L2 -= L2_dummy/(sqrt(abs_data)*sqrt(abs_synthetics));}
}
l2=L2;
return l2;
/* free memory for trace killing */
if(TRKILL){
free_imatrix(kill_tmp,1,ntr_glob,1,nsrc_glob);
free_ivector(kill_vector,1,ntr);
}
}
/* creates 3 matrices: invA, B, C: dT + A^-1*BT = A^-1*Power,
* C = A^-1 * B. note that A is a diagonal matrix (no lateral
* capacitances. all capacitances are to ground). so, inva[i][i]
* (= 1/a[i][i]) is just enough.
*
* NOTE: EXTRA nodes: 1 chip bottom, 5 spreader and 5 heat sink nodes
* (north, south, east, west and bottom).
*/
void create_RC_matrices(flp_t *flp, int omit_lateral)
{
int i, j, k = 0, n = flp->n_units;
int **border;
double **len, *gx, *gy, **g, *c_ver, **t;
double r_sp1, r_sp2, r_hs; /* lateral resistances to spreader and heatsink */
/* NOTE: *_mid - the vertical R/C from center nodes of spreader
* and heatsink. *_ver - the vertical R/C from peripheral (n,s,e,w) nodes
*/
double r_sp_mid, r_sp_ver, r_hs_mid, r_hs_ver, c_sp_mid, c_sp_ver, c_hs_mid, c_hs_ver;
double gn=0, gs=0, ge=0, gw=0;
double w_chip = get_total_width (flp); /* x-axis */
double l_chip = get_total_height (flp); /* y-axis */
FILE *fp_b,*fp_c,*fp_inva,*fp_invb;
fp_b=fopen("B","w");
fp_c=fopen("C","w");
fp_invb=fopen("invB","w");
fp_inva=fopen("invA","w");
border = imatrix(n, 4);
len = matrix(n, n); /* len[i][j] = length of shared edge bet. i & j */
gx = vector(n); /* lumped conductances in x direction */
gy = vector(n); /* lumped conductances in y direction */
g = matrix(n+EXTRA, n+EXTRA); /* g[i][j] = conductance bet. nodes i & j */
c_ver = vector(n+EXTRA); /* vertical capacitance */
b = matrix(n+EXTRA, n+EXTRA); /* B, C, INVA and INVB are (n+EXTRA)x(n+EXTRA) matrices */
c = matrix(n+EXTRA, n+EXTRA);
inva = matrix(n+EXTRA, n+EXTRA);
invb = matrix(n+EXTRA, n+EXTRA);
t = matrix (n+EXTRA, n+EXTRA); /* copy of B */
/* compute the silicon fitting factor - see pg 10 of the UVA CS tech report - CS-TR-2003-08 */
factor_chip = C_FACTOR * ((SPEC_HEAT_CU / SPEC_HEAT_SI) * (w_chip + 0.88 * t_spreader) \
* (l_chip + 0.88 * t_spreader) * t_spreader / ( w_chip * l_chip * t_chip) + 1);
/* gx's and gy's of blocks */
for (i = 0; i < n; i++) {
gx[i] = 1.0/getr(K_SI, flp->units[i].height, flp->units[i].width, l_chip);
gy[i] = 1.0/getr(K_SI, flp->units[i].width, flp->units[i].height, w_chip);
}
/* shared lengths between blocks */
for (i = 0; i < n; i++)
for (j = i; j < n; j++)
len[i][j] = len[j][i] = get_shared_len(flp, i, j);
/* lateral R's of spreader and sink */
r_sp1 = getr(K_CU, (s_spreader+3*w_chip)/4.0, (s_spreader-w_chip)/4.0, w_chip);
r_sp2 = getr(K_CU, (3*s_spreader+w_chip)/4.0, (s_spreader-w_chip)/4.0, (s_spreader+3*w_chip)/4.0);
r_hs = getr(K_CU, (s_sink+3*s_spreader)/4.0, (s_sink-s_spreader)/4.0, s_spreader);
/* vertical R's and C's of spreader and sink */
r_sp_mid = RHO_CU * t_spreader / (w_chip * l_chip);
c_sp_mid = factor_pack * SPEC_HEAT_CU * t_spreader * (w_chip * l_chip);
r_sp_ver = RHO_CU * t_spreader * 4.0 / (s_spreader * s_spreader - w_chip*l_chip);
c_sp_ver = factor_pack * SPEC_HEAT_CU * t_spreader * (s_spreader * s_spreader - w_chip*l_chip) / 4.0;
r_hs_mid = RHO_CU * t_sink / (s_spreader*s_spreader);
c_hs_mid = factor_pack * SPEC_HEAT_CU * t_sink * (s_spreader * s_spreader);
r_hs_ver = RHO_CU * t_sink * 4.0 / (s_sink * s_sink - s_spreader*s_spreader);
c_hs_ver = factor_pack * SPEC_HEAT_CU * t_sink * (s_sink * s_sink - s_spreader*s_spreader) / 4.0;
/* short the R's from block centers to a particular chip edge */
for (i = 0; i < n; i++) {
if (eq(flp->units[i].bottomy + flp->units[i].height, l_chip)) {
gn += gy[i];
border[i][2] = 1; /* block is on northern border */
}
if (eq(flp->units[i].bottomy, 0)) {
gs += gy[i];
border[i][3] = 1; /* block is on southern border */
}
if (eq(flp->units[i].leftx + flp->units[i].width, w_chip)) {
ge += gx[i];
border[i][1] = 1; /* block is on eastern border */
}
if (eq(flp->units[i].leftx, 0)) {
gw += gx[i];
border[i][0] = 1; /* block is on western border */
}
}
/* overall R and C between nodes */
for (i = 0; i < n; i++) {
/* amongst functional units */
for (j = 0; j < n; j++) {
double part = 0;
if (!omit_lateral) {
if (is_horiz_adj(flp, i, j)){
part = gx[i] / flp->units[i].height;
printf("%d %d horiz adj\n",i,j);
}
else if (is_vert_adj(flp, i,j)) {
part = gy[i] / flp->units[i].width;
printf("%d %d vert adj\n",i,j);
}
}
g[i][j] = part * len[i][j];
}
/* C's from functional units to ground */
c_ver[i] = factor_chip * SPEC_HEAT_SI * t_chip * flp->units[i].height * flp->units[i].width;
/* lateral g's from block center to peripheral (n,s,e,w) spreader nodes */
g[i][n+SP_N]=g[n+SP_N][i]=2.0*border[i][2]/((1.0/gy[i])+r_sp1*gn/gy[i]);
g[i][n+SP_S]=g[n+SP_S][i]=2.0*border[i][3]/((1.0/gy[i])+r_sp1*gs/gy[i]);
g[i][n+SP_E]=g[n+SP_E][i]=2.0*border[i][1]/((1.0/gx[i])+r_sp1*ge/gx[i]);
g[i][n+SP_W]=g[n+SP_W][i]=2.0*border[i][0]/((1.0/gx[i])+r_sp1*gw/gx[i]);
/* vertical g's from block center to chip bottom */
g[i][n+CHIP_B]=g[n+CHIP_B][i]=2.0/(RHO_SI * t_chip / (flp->units[i].height * flp->units[i].width));
}
/* max slope (1/vertical RC time constant) for silicon */
max_slope = 1.0 / (factor_chip * t_chip * t_chip * RHO_SI * SPEC_HEAT_SI);
/* vertical g's and C's between central nodes */
/* between chip bottom and spreader bottom */
g[n+CHIP_B][n+SP_B]=g[n+SP_B][n+CHIP_B]=2.0/r_sp_mid;
/* from chip bottom to ground */
c_ver[n+CHIP_B]=c_sp_mid;
/* between spreader bottom and sink bottom */
g[n+SINK_B][n+SP_B]=g[n+SP_B][n+SINK_B]=2.0/r_hs_mid;
/* from spreader bottom to ground */
c_ver[n+SP_B]=c_hs_mid;
/* from sink bottom to ground */
c_ver[n+SINK_B]=c_convec;
/* g's and C's from peripheral(n,s,e,w) nodes */
for (i = 1; i <= 4; i++) {
/* vertical g's between peripheral spreader nodes and spreader bottom */
g[n+SP_B-i][n+SP_B]=g[n+SP_B][n+SP_B-i]=2.0/r_sp_ver;
/* lateral g's between peripheral spreader nodes and peripheral sink nodes */
g[n+SP_B-i][n+SINK_B-i]=g[n+SINK_B-i][n+SP_B-i]=2.0/(r_hs + r_sp2);
/* vertical g's between peripheral sink nodes and sink bottom */
g[n+SINK_B-i][n+SINK_B]=g[n+SINK_B][n+SINK_B-i]=2.0/r_hs_ver;
/* from peripheral spreader nodes to ground */
c_ver[n+SP_B-i]=c_sp_ver;
/* from peripheral sink nodes to ground */
c_ver[n+SINK_B-i]=c_hs_ver;
}
/* calculate matrices A, B such that A(dT) + BT = POWER */
for (i = 0; i < n+EXTRA; i++) {
for (j = 0; j < n+EXTRA; j++) {
if (i==j) {
inva[i][j] = 1.0/c_ver[i];
if (i == n+SINK_B) /* sink bottom */
b[i][j] += 1.0 / r_convec;
for (k = 0; k < n+EXTRA; k++) {
if ((g[i][k]==0.0)||(g[k][i])==0.0)
continue;
else
/* here is why the 2.0 factor comes when calculating g[][] */
b[i][j] += 1.0/((1.0/g[i][k])+(1.0/g[k][i]));
}
} else {
inva[i][j]=0.0;
if ((g[i][j]==0.0)||(g[j][i])==0.0)
b[i][j]=0.0;
else
b[i][j]=-1.0/((1.0/g[i][j])+(1.0/g[j][i]));
}
}
}
/* we are always going to use the eqn dT + A^-1 * B T = A^-1 * POWER. so, store C = A^-1 * B */
matmult(c, inva, b, n+EXTRA);
/* we will also be needing INVB so store it too */
copy_matrix(t, b, n+EXTRA, n+EXTRA);
matinv(invb, t, n+EXTRA);
for (i = 0; i < n+EXTRA; i++) {
for (j = 0; j < n+EXTRA; j++) {
fprintf(fp_inva,"%f ",inva[i][j]);
fprintf(fp_invb,"%f ",invb[i][j]);
fprintf(fp_c,"%f ",c[i][j]);
fprintf(fp_b,"%f ",b[i][j]);
}
fprintf(fp_inva, "\n");
fprintf(fp_invb, "\n");
fprintf(fp_c , "\n");
fprintf(fp_b, "\n");
}
fclose(fp_inva);
fclose(fp_b);
fclose(fp_c);
fclose(fp_invb);
/* dump_vector(c_ver, n+EXTRA); */
/* dump_matrix(invb, n+EXTRA, n+EXTRA); */
/* dump_matrix(c, n+EXTRA, n+EXTRA); */
/* cleanup */
free_matrix(t, n+EXTRA);
free_matrix(g, n+EXTRA);
free_matrix(len, n);
free_imatrix(border, n);
free_vector(c_ver);
free_vector(gx);
free_vector(gy);
}
int main(int argc, char** args){
double Re, UI, VI, PI, GX, GY, t_end, xlength, ylength, dt, dx, dy, alpha, omg, tau, eps, dt_value, t, res, dp, nu;
double **U, **V, **P, **F, **G, **RS;
double **K, **E; /* turbulent kinetic energy k, dissipation rate epsilon*/
double Fu, Fv; /* force integration variables */
double KI, EI, cn, ce, c1, c2; /* K and E: Initial values for k and epsilon */
int n, it, imax, jmax, itermax, pb, boundaries[4];
int fluid_cells; /* Number of fluid cells in our geometry */
int **Flag; /* Flagflield matrix */
char vtkname[200];
char pgm[200];
char problem[10]; /* Problem name */
char fname[200];
if(argc<2){
printf("No parameter file specified. Terminating...\n");
exit(1);
}
sprintf(fname, "%s%s", CONFIGS_FOLDER, args[1]);
printf("%s\n",fname);
read_parameters(fname, &Re, &UI, &VI, &PI, &GX, &GY, &t_end, &xlength, &ylength, &dt, &dx, &dy, &imax, &jmax, &alpha, &omg, &itermax, &eps, boundaries, &dp, &pb, &KI, &EI, &cn, &ce, &c1, &c2, pgm, &nu, problem);
/* Allocate Flag matrix */
Flag = imatrix( 0, imax+1, 0, jmax+1 );
U = matrix ( 0 , imax+1 , 0 , jmax+1 );
V = matrix ( 0 , imax+1 , 0 , jmax+1 );
P = matrix ( 0 , imax+1 , 0 , jmax+1 );
F = matrix ( 0 , imax , 0 , jmax );
G = matrix ( 0 , imax , 0 , jmax );
RS = matrix ( 0 , imax , 0 , jmax );
K = matrix ( 0 , imax+1 , 0 , jmax+1 );
E = matrix ( 0 , imax+1 , 0 , jmax+1 );
/* Initialize values to the Flag, u, v and p */
init_flag(CONFIGS_FOLDER,pgm, imax, jmax, &fluid_cells, Flag );
init_uvp(UI, VI, PI, KI, EI, imax, jmax, U, V, P, K, E, Flag, problem );
printf("Problem: %s\n", problem );
printf( "xlength = %f, ylength = %f\n", xlength, ylength );
printf( "imax = %d, jmax = %d\n", imax, jmax );
printf( "dt = %f, dx = %f, dy = %f\n", dt, dx, dy);
printf( "Number of fluid cells = %d\n", fluid_cells );
printf( "Reynolds number: %f\n\n", Re);
t=.0;
n=0;
while( t <= t_end ){
boundaryvalues( imax, jmax, U, V, K, E, boundaries, Flag );
/* special inflow boundaries, including k and eps */
spec_boundary_val( problem, imax, jmax, U, V, K, E, Re, dp, cn, ylength);
/* calculate new values for k and eps */
comp_KAEP(Re, nu, cn, ce, c1, c2, alpha, dt, dx, dy, imax, jmax, U, V, K, E, GX, GY, Flag);
/* calculate new values for F and G */
calculate_fg( Re, GX, GY, alpha, dt, dx, dy, imax, jmax, U, V, F, G, K, E, nu, cn, Flag );
/* calculate right hand side */
calculate_rs( dt, dx, dy, imax, jmax, F, G, RS, Flag );
it = 0;
res = 10000.0;
while( it < itermax && fabs(res) > eps ){
sor( omg, dx, dy, imax, jmax, fluid_cells, P, RS, Flag, &res, problem, dp );
it++;
}
printf("[%5d: %f] dt: %f, sor iterations: %4d \n", n, t, dt, it);
/* calculate new values for u and v */
calculate_uv( dt, dx, dy, imax, jmax, U, V, F, G, P, Flag );
t += dt;
n++;
}
sprintf(vtkname, "%s%s", VISUA_FOLDER, args[1]);
write_vtkFile( vtkname, 1, xlength, ylength, imax, jmax, dx, dy, U, V, P, K, E, Flag);
comp_surface_force( Re, dx, dy, imax, jmax, U, V, P, Flag, &Fu, &Fv);
printf( "\nProblem: %s\n", problem );
printf( "xlength = %f, ylength = %f\n", xlength, ylength );
printf( "imax = %d, jmax = %d\n", imax, jmax );
printf( "dt = %f, dx = %f, dy = %f\n", dt, dx, dy);
printf( "Number of fluid cells = %d\n", fluid_cells );
printf( "Reynolds number: %f\n", Re);
printf( "Drag force = %f Lift force = %f\n", Fu, Fv);
/* free memory */
free_matrix(U,0,imax+1,0,jmax+1);
free_matrix(V,0,imax+1,0,jmax+1);
free_matrix(P,0,imax+1,0,jmax+1);
free_matrix(K,0,imax+1,0,jmax+1);
free_matrix(E,0,imax+1,0,jmax+1);
free_matrix(F,0,imax,0,jmax);
free_matrix(G,0,imax,0,jmax);
free_matrix(RS,0,imax,0,jmax);
free_imatrix(Flag,0,imax+1,0,jmax+1);
return 0;
}
static int compute_tree_adaboost(ETree *etree,int n,int d,double *x[],int y[],
int nmodels,int stumps, int minsize)
{
int i,b;
int *samples;
double **trx;
int *try;
double *prob;
double *prob_copy;
double sumalpha;
double eps;
int *pred;
double *margin;
double sumprob;
if(nmodels<1){
fprintf(stderr,"compute_tree_adaboost: nmodels must be greater than 0\n");
return 1;
}
if(stumps != 0 && stumps != 1){
fprintf(stderr,"compute_tree_bagging: parameter stumps must be 0 or 1\n");
return 1;
}
if(minsize < 0){
fprintf(stderr,"compute_tree_bagging: parameter minsize must be >= 0\n");
return 1;
}
etree->nclasses=iunique(y,n, &(etree->classes));
if(etree->nclasses<=0){
fprintf(stderr,"compute_tree_adaboost: iunique error\n");
return 1;
}
if(etree->nclasses==1){
fprintf(stderr,"compute_tree_adaboost: only 1 class recognized\n");
return 1;
}
if(etree->nclasses==2)
if(etree->classes[0] != -1 || etree->classes[1] != 1){
fprintf(stderr,"compute_tree_adaboost: for binary classification classes must be -1,1\n");
return 1;
}
if(etree->nclasses>2){
fprintf(stderr,"compute_tree_adaboost: multiclass classification not allowed\n");
return 1;
}
if(!(etree->tree=(Tree *)calloc(nmodels,sizeof(Tree)))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(etree->weights=dvector(nmodels))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(trx=(double **)calloc(n,sizeof(double*)))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(try=ivector(n))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(prob_copy=dvector(n))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(prob=dvector(n))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
if(!(pred=ivector(n))){
fprintf(stderr,"compute_tree_adaboost: out of memory\n");
return 1;
}
for(i =0;i<n;i++)
prob[i]=1.0/(double)n;
etree->nmodels=nmodels;
sumalpha=0.0;
for(b=0;b<nmodels;b++){
for(i =0;i<n;i++)
prob_copy[i]=prob[i];
if(sample(n, prob_copy, n, &samples, TRUE,b)!=0){
fprintf(stderr,"compute_tree_adaboost: sample error\n");
return 1;
}
for(i=0;i<n;i++){
trx[i] = x[samples[i]];
try[i] = y[samples[i]];
}
if(compute_tree(&(etree->tree[b]),n,d,trx,try,stumps,minsize)!=0){
fprintf(stderr,"compute_tree_adaboost: compute_tree error\n");
return 1;
}
free_ivector(samples);
eps=0.0;
for(i=0;i<n;i++){
pred[i]=predict_tree(&(etree->tree[b]),x[i],&margin);
if(pred[i] < -1 ){
fprintf(stderr,"compute_tree_adaboost: predict_tree error\n");
return 1;
}
if(pred[i]==0 || pred[i] != y[i])
eps += prob[i];
free_dvector(margin);
}
if(eps > 0.0 && eps < 0.5){
etree->weights[b]=0.5 *log((1.0-eps)/eps);
sumalpha+=etree->weights[b];
}else{
etree->nmodels=b;
break;
}
sumprob=0.0;
for(i=0;i<n;i++){
prob[i]=prob[i]*exp(-etree->weights[b]*y[i]*pred[i]);
sumprob+=prob[i];
}
if(sumprob <=0.0){
fprintf(stderr,"compute_tree_adaboost: sumprob = 0\n");
return 1;
}
for(i=0;i<n;i++)
prob[i] /= sumprob;
}
if(etree->nmodels<=0){
fprintf(stderr,"compute_tree_adaboost: no models produced\n");
return 1;
}
if(sumalpha <=0){
fprintf(stderr,"compute_tree_adaboost: sumalpha = 0\n");
return 1;
}
for(b=0;b<etree->nmodels;b++)
etree->weights[b] /= sumalpha;
free(trx);
free_ivector(try);
free_ivector(pred);
free_dvector(prob);
free_dvector(prob_copy);
return 0;
}
static void split_node(Node *node,Node *nodeL,Node *nodeR,int classes[],
int nclasses)
{
int **indx;
double *tmpvar;
int i,j,k;
int **npL , **npR;
double **prL , **prR;
int totL,totR;
double a,b;
double *decrease_in_inpurity;
double max_decrease=0;
int splitvar;
int splitvalue;
int morenumerous;
nodeL->priors=dvector(nclasses);
nodeR->priors=dvector(nclasses);
nodeL->npoints_for_class=ivector(nclasses);
nodeR->npoints_for_class=ivector(nclasses);
indx=imatrix(node->nvar,node->npoints);
tmpvar=dvector(node->npoints);
decrease_in_inpurity=dvector(node->npoints-1);
npL=imatrix(node->npoints,nclasses);
npR=imatrix(node->npoints,nclasses);
prL=dmatrix(node->npoints,nclasses);
prR=dmatrix(node->npoints,nclasses);
splitvar=0;
splitvalue=0;
max_decrease=0;
for(i=0;i<node->nvar;i++){
for(j=0;j<node->npoints;j++)
tmpvar[j]=node->data[j][i];
for(j=0;j<node->npoints;j++)
indx[i][j]=j;
dsort(tmpvar,indx[i],node->npoints,SORT_ASCENDING);
for(k=0;k<nclasses;k++)
if(node->classes[indx[i][0]]==classes[k]){
npL[0][k] = 1;
npR[0][k] = node->npoints_for_class[k]-npL[0][k];
} else{
npL[0][k] = 0;
npR[0][k] = node->npoints_for_class[k];
}
for(j=1;j<node->npoints-1;j++)
for(k=0;k<nclasses;k++)
if(node->classes[indx[i][j]]==classes[k]){
npL[j][k] = npL[j-1][k] +1;
npR[j][k] = node->npoints_for_class[k] - npL[j][k];
}
else {
npL[j][k] = npL[j-1][k];
npR[j][k] = node->npoints_for_class[k] - npL[j][k];
}
for(j=0;j<node->npoints-1;j++){
if(node->data[indx[i][j]][i] != node->data[indx[i][j+1]][i]){
totL = totR = 0;
for(k=0;k<nclasses;k++)
totL += npL[j][k];
for(k=0;k<nclasses;k++)
prL[j][k] = (double) npL[j][k] / (double) totL;
for(k=0;k<nclasses;k++)
totR += npR[j][k];
for(k=0;k<nclasses;k++)
prR[j][k] = (double) npR[j][k] /(double) totR;
a = (double) totL / (double) node->npoints;
b = (double) totR / (double) node->npoints ;
decrease_in_inpurity[j] = gini_index(node->priors,nclasses) -
a * gini_index(prL[j],nclasses) - b * gini_index(prR[j],nclasses);
}
}
for(j=0;j<node->npoints-1;j++)
if(decrease_in_inpurity[j] > max_decrease){
max_decrease = decrease_in_inpurity[j];
splitvar=i;
splitvalue=j;
for(k=0;k<nclasses;k++){
nodeL->priors[k]=prL[splitvalue][k];
nodeR->priors[k]=prR[splitvalue][k];
nodeL->npoints_for_class[k]=npL[splitvalue][k];
nodeR->npoints_for_class[k]=npR[splitvalue][k];
}
}
}
node->var=splitvar;
node->value=(node->data[indx[splitvar][splitvalue]][node->var]+
node->data[indx[splitvar][splitvalue+1]][node->var])/2.;
nodeL->nvar=node->nvar;
nodeL->nclasses=node->nclasses;
nodeL->npoints=splitvalue+1;
nodeL->terminal=TRUE;
if(gini_index(nodeL->priors,nclasses) >0)
nodeL->terminal=FALSE;
nodeL->data=(double **) calloc(nodeL->npoints,sizeof(double *));
nodeL->classes=ivector(nodeL->npoints);
for(i=0;i<nodeL->npoints;i++){
nodeL->data[i] = node->data[indx[splitvar][i]];
nodeL->classes[i] = node->classes[indx[splitvar][i]];
}
morenumerous=0;
for(k=0;k<nclasses;k++)
if(nodeL->npoints_for_class[k] > morenumerous){
morenumerous = nodeL->npoints_for_class[k];
nodeL->node_class=classes[k];
}
nodeR->nvar=node->nvar;
nodeR->nclasses=node->nclasses;
nodeR->npoints=node->npoints-nodeL->npoints;
nodeR->terminal=TRUE;
if(gini_index(nodeR->priors,nclasses) >0)
nodeR->terminal=FALSE;
nodeR->data=(double **) calloc(nodeR->npoints,sizeof(double *));
nodeR->classes=ivector(nodeR->npoints);
for(i=0;i<nodeR->npoints;i++){
nodeR->data[i] = node->data[indx[splitvar][nodeL->npoints+i]];
nodeR->classes[i] = node->classes[indx[splitvar][nodeL->npoints+i]];
}
morenumerous=0;
for(k=0;k<nclasses;k++)
if(nodeR->npoints_for_class[k] > morenumerous){
morenumerous = nodeR->npoints_for_class[k];
nodeR->node_class=classes[k];
}
free_imatrix(indx, node->nvar,node->npoints);
free_imatrix(npL, node->npoints,nclasses);
free_imatrix(npR, node->npoints,nclasses);
free_dmatrix(prL, node->npoints,nclasses);
free_dmatrix(prR, node->npoints,nclasses);
free_dvector(tmpvar);
free_dvector(decrease_in_inpurity);
}
/* "buildhessian" constructs a block Hessian and associated projection matrix
by application of the ANM. Atomic coordinates and block definitions are
provided in 'coords' and 'blocks'; ANM parameters are provided in 'cutoff'
and 'gamma'. On successful termination, the block Hessian is stored in
'hessian', and the projection matrix between block and all-atom spaces is
in 'projection'. */
static PyObject *buildhessian(PyObject *self, PyObject *args, PyObject *kwargs) {
PDB_File PDB;
dSparse_Matrix PP,HH;
PyArrayObject *coords, *blocks, *hessian, *projection;
double *XYZ,*hess,*proj;
long *BLK;
double **HB;
double cutoff = 15., gamma = 1., scl=1., mlo=1., mhi=-1.;
int natm, nblx, bmx;
int hsize,elm,bdim,i,j;
static char *kwlist[] = {"coords", "blocks", "hessian", "projection",
"natoms", "nblocks", "maxsize", "cutoff",
"gamma", "scale", "memlo", "memhi", NULL};
if (!PyArg_ParseTupleAndKeywords(args, kwargs, "OOOOiii|ddddd", kwlist,
&coords, &blocks, &hessian, &projection,
&natm, &nblx, &bmx, &cutoff, &gamma, &scl,
&mlo, &mhi))
return NULL;
XYZ = (double *) PyArray_DATA(coords);
BLK = (long *) PyArray_DATA(blocks);
hess = (double *) PyArray_DATA(hessian);
proj = (double *) PyArray_DATA(projection);
/* First allocate a PDB_File object to hold the coordinates and block
indices of the atoms. This wastes a bit of memory, but it prevents
the need to re-write all of the RTB functions that are used in
standalone C code. */
PDB.atom=malloc((size_t)((natm+2)*sizeof(Atom_Line)));
if(!PDB.atom) return PyErr_NoMemory();
for(i=1;i<=natm;i++){
PDB.atom[i].model=BLK[i-1];
for(j=0;j<3;j++)
PDB.atom[i].X[j]=XYZ[j*natm+i-1];
}
/* Find the projection matrix */
hsize = 18*bmx*nblx > 12*natm ? 12*natm : 18*bmx*nblx;
HH.IDX=imatrix(1,hsize,1,2);
HH.X=dvector(1,hsize);
elm=dblock_projections2(&HH,&PDB,natm,nblx,bmx);
PP.IDX=imatrix(1,elm,1,2);
PP.X=dvector(1,elm);
for(i=1;i<=elm;i++){
PP.IDX[i][1]=HH.IDX[i][1];
PP.IDX[i][2]=HH.IDX[i][2];
PP.X[i]=HH.X[i];
}
free_imatrix(HH.IDX,1,hsize,1,2);
free_dvector(HH.X,1,hsize);
dsort_PP2(&PP,elm,1);
/* Calculate the block Hessian */
HB=dmatrix(1,6*nblx,1,6*nblx);
bdim=calc_blessian_mem(&PDB,&PP,natm,nblx,elm,HB,cutoff,gamma,scl,mlo,mhi);
/* Cast the block Hessian and projection matrix into 1D arrays. */
copy_prj_ofst(&PP,proj,elm,bdim);
for(i=1;i<=bdim;i++)
for(j=1;j<=bdim;j++)
hess[bdim*(i-1)+j-1]=HB[i][j];
free(PDB.atom);
free_imatrix(PP.IDX,1,elm,1,2);
free_dvector(PP.X,1,elm);
free_dmatrix(HB,1,6*nblx,1,6*nblx);
Py_RETURN_NONE;
}
void FWI_PSV(){
/* global variables */
/* ---------------- */
/* forward modelling */
extern int MYID, FDORDER, NX, NY, NT, L, READMOD, QUELLART, RUN_MULTIPLE_SHOTS, TIME_FILT;
extern int LOG, SEISMO, N_STREAMER, FW, NXG, NYG, IENDX, IENDY, NTDTINV, IDXI, IDYI, NXNYI, INV_STF, DTINV;
extern float FC_SPIKE_1, FC_SPIKE_2, FC, FC_START, TIME, DT;
extern char LOG_FILE[STRING_SIZE], MFILE[STRING_SIZE];
extern FILE *FP;
/* gravity modelling/inversion */
extern int GRAVITY, NZGRAV, NGRAVB, GRAV_TYPE, BACK_DENSITY;
extern char GRAV_DATA_OUT[STRING_SIZE], GRAV_DATA_IN[STRING_SIZE], GRAV_STAT_POS[STRING_SIZE], DFILE[STRING_SIZE];
extern float LAM_GRAV, GAMMA_GRAV, LAM_GRAV_GRAD, L2_GRAV_IT1;
/* full waveform inversion */
extern int GRAD_METHOD, NLBFGS, ITERMAX, IDX, IDY, INVMAT1, EPRECOND;
extern int GRAD_FORM, POS[3], QUELLTYPB, MIN_ITER, MODEL_FILTER;
extern float FC_END, PRO, C_vp, C_vs, C_rho;
extern char MISFIT_LOG_FILE[STRING_SIZE], JACOBIAN[STRING_SIZE];
extern char *FILEINP1;
/* local variables */
int ns, nseismograms=0, nt, nd, fdo3, j, i, iter, h, hin, iter_true, SHOTINC, s=0;
int buffsize, ntr=0, ntr_loc=0, ntr_glob=0, nsrc=0, nsrc_loc=0, nsrc_glob=0, ishot, nshots=0, itestshot;
float sum, eps_scale, opteps_vp, opteps_vs, opteps_rho, Vp_avg, Vs_avg, rho_avg, Vs_sum, Vp_sum, rho_sum;
char *buff_addr, ext[10], *fileinp, jac[225], source_signal_file[STRING_SIZE];
double time1, time2, time7, time8, time_av_v_update=0.0, time_av_s_update=0.0, time_av_v_exchange=0.0, time_av_s_exchange=0.0, time_av_timestep=0.0;
float L2sum, *L2t;
float ** taper_coeff, * epst1, *hc=NULL;
int * DTINV_help;
MPI_Request *req_send, *req_rec;
MPI_Status *send_statuses, *rec_statuses;
/* Variables for step length calculation */
int step1, step3=0;
float eps_true, tmp;
/* Variables for the L-BFGS method */
float * rho_LBFGS, * alpha_LBFGS, * beta_LBFGS;
float * y_LBFGS, * s_LBFGS, * q_LBFGS, * r_LBFGS;
int NLBFGS_class, LBFGS_pointer, NLBFGS_vec;
/* Variables for energy weighted gradient */
float ** Ws, **Wr, **We;
/* parameters for FWI-workflow */
int stagemax=0, nstage;
/*vector for abort criterion*/
float * L2_hist=NULL;
/* help variable for MIN_ITER */
int min_iter_help=0;
/* parameters for gravity inversion */
float * gz_mod, * gz_res;
float ** gravpos=NULL, ** rho_grav=NULL, ** rho_grav_ext=NULL;
float ** grad_grav=NULL;
int ngrav=0, nxgrav, nygrav;
float L2_grav, FWImax, GRAVmax, FWImax_all, GRAVmax_all ;
char jac_grav[STRING_SIZE];
FILE *FPL2, *FP_stage, *FP_GRAV, *LAMBDA;
if (MYID == 0){
time1=MPI_Wtime();
clock();
}
/* open log-file (each PE is using different file) */
/* fp=stdout; */
sprintf(ext,".%i",MYID);
strcat(LOG_FILE,ext);
if ((MYID==0) && (LOG==1)) FP=stdout;
else FP=fopen(LOG_FILE,"w");
fprintf(FP," This is the log-file generated by PE %d \n\n",MYID);
/* ----------------------- */
/* define FD grid geometry */
/* ----------------------- */
/* domain decomposition */
initproc();
NT=iround(TIME/DT); /* number of timesteps */
/* output of parameters to log-file or stdout */
if (MYID==0) write_par(FP);
/* NXG, NYG denote size of the entire (global) grid */
NXG=NX;
NYG=NY;
/* In the following, NX and NY denote size of the local grid ! */
NX = IENDX;
NY = IENDY;
NTDTINV=ceil((float)NT/(float)DTINV); /* round towards next higher integer value */
/* save every IDXI and IDYI spatial point during the forward modelling */
IDXI=1;
IDYI=1;
NXNYI=(NX/IDXI)*(NY/IDYI);
SHOTINC=1;
/* use only every DTINV time sample for the inversion */
DTINV_help=ivector(1,NT);
/* read parameters from workflow-file (stdin) */
FP_stage=fopen(FILEINP1,"r");
if(FP_stage==NULL) {
if (MYID == 0){
printf("\n==================================================================\n");
printf(" Cannot open Denise workflow input file %s \n",FILEINP1);
printf("\n==================================================================\n\n");
err(" --- ");
}
}
/* estimate number of lines in FWI-workflow */
i=0;
stagemax=0;
while ((i=fgetc(FP_stage)) != EOF)
if (i=='\n') ++stagemax;
rewind(FP_stage);
stagemax--;
fclose(FP_stage);
/* define data structures for PSV problem */
struct wavePSV;
struct wavePSV_PML;
struct matPSV;
struct fwiPSV;
struct mpiPSV;
struct seisPSV;
struct seisPSVfwi;
struct acq;
nd = FDORDER/2 + 1;
fdo3 = 2*nd;
buffsize=2.0*2.0*fdo3*(NX +NY)*sizeof(MPI_FLOAT);
/* allocate buffer for buffering messages */
buff_addr=malloc(buffsize);
if (!buff_addr) err("allocation failure for buffer for MPI_Bsend !");
MPI_Buffer_attach(buff_addr,buffsize);
/* allocation for request and status arrays */
req_send=(MPI_Request *)malloc(REQUEST_COUNT*sizeof(MPI_Request));
req_rec=(MPI_Request *)malloc(REQUEST_COUNT*sizeof(MPI_Request));
send_statuses=(MPI_Status *)malloc(REQUEST_COUNT*sizeof(MPI_Status));
rec_statuses=(MPI_Status *)malloc(REQUEST_COUNT*sizeof(MPI_Status));
/* --------- add different modules here ------------------------ */
ns=NT; /* in a FWI one has to keep all samples of the forward modeled data
at the receiver positions to calculate the adjoint sources and to do
the backpropagation; look at function saveseis_glob.c to see that every
NDT sample for the forward modeled wavefield is written to su files*/
if (SEISMO){
acq.recpos=receiver(FP, &ntr, ishot);
acq.recswitch = ivector(1,ntr);
acq.recpos_loc = splitrec(acq.recpos,&ntr_loc, ntr, acq.recswitch);
ntr_glob=ntr;
ntr=ntr_loc;
if(N_STREAMER>0){
free_imatrix(acq.recpos,1,3,1,ntr_glob);
if(ntr>0) free_imatrix(acq.recpos_loc,1,3,1,ntr);
free_ivector(acq.recswitch,1,ntr_glob);
}
}
if(N_STREAMER==0){
/* Memory for seismic data */
alloc_seisPSV(ntr,ns,&seisPSV);
/* Memory for FWI seismic data */
alloc_seisPSVfwi(ntr,ntr_glob,ns,&seisPSVfwi);
}
/* Memory for full data seismograms */
alloc_seisPSVfull(&seisPSV,ntr_glob);
/* memory allocation for abort criterion*/
L2_hist = vector(1,1000);
/* estimate memory requirement of the variables in megabytes*/
switch (SEISMO){
case 1 : /* particle velocities only */
nseismograms=2;
break;
case 2 : /* pressure only */
nseismograms=1;
break;
case 3 : /* curl and div only */
nseismograms=2;
break;
case 4 : /* everything */
nseismograms=5;
break;
}
/* calculate memory requirements for PSV forward problem */
mem_fwiPSV(nseismograms,ntr,ns,fdo3,nd,buffsize,ntr_glob);
/* Define gradient formulation */
/* GRAD_FORM = 1 - stress-displacement gradients */
/* GRAD_FORM = 2 - stress-velocity gradients for decomposed impedance matrix */
GRAD_FORM = 1;
if(GRAVITY==1 || GRAVITY==2){
if(GRAV_TYPE == 1){
sprintf(GRAV_DATA_OUT, "./gravity/grav_mod.dat"); /* output file of gravity data */
sprintf(GRAV_DATA_IN, "./gravity/grav_field.dat"); /* input file of gravity data */
}
if(GRAV_TYPE == 2){
sprintf(GRAV_DATA_OUT, "./gravity/grav_grad_mod.dat"); /* output file of gravity gradient data */
sprintf(GRAV_DATA_IN, "./gravity/grav_grad_field.dat"); /* input file of gravity gradientdata */
}
sprintf(GRAV_STAT_POS, "./gravity/grav_stat.dat"); /* file with station positions for gravity modelling */
/* size of the extended gravity model */
nxgrav = NXG + 2*NGRAVB;
nygrav = NYG + NGRAVB;
}
/* allocate memory for PSV forward problem */
alloc_PSV(&wavePSV,&wavePSV_PML);
/* calculate damping coefficients for CPMLs (PSV problem)*/
if(FW>0){PML_pro(wavePSV_PML.d_x, wavePSV_PML.K_x, wavePSV_PML.alpha_prime_x, wavePSV_PML.a_x, wavePSV_PML.b_x, wavePSV_PML.d_x_half, wavePSV_PML.K_x_half, wavePSV_PML.alpha_prime_x_half, wavePSV_PML.a_x_half,
wavePSV_PML.b_x_half, wavePSV_PML.d_y, wavePSV_PML.K_y, wavePSV_PML.alpha_prime_y, wavePSV_PML.a_y, wavePSV_PML.b_y, wavePSV_PML.d_y_half, wavePSV_PML.K_y_half, wavePSV_PML.alpha_prime_y_half,
wavePSV_PML.a_y_half, wavePSV_PML.b_y_half);
}
/* allocate memory for PSV material parameters */
alloc_matPSV(&matPSV);
/* allocate memory for PSV FWI parameters */
alloc_fwiPSV(&fwiPSV);
/* allocate memory for PSV MPI variables */
alloc_mpiPSV(&mpiPSV);
/* Variables for the l-BFGS method */
if(GRAD_METHOD==2){
NLBFGS_class = 3; /* number of parameter classes */
NLBFGS_vec = NLBFGS_class*NX*NY; /* length of one LBFGS-parameter class */
LBFGS_pointer = 1; /* initiate pointer in the cyclic LBFGS-vectors */
y_LBFGS = vector(1,NLBFGS_vec*NLBFGS);
s_LBFGS = vector(1,NLBFGS_vec*NLBFGS);
q_LBFGS = vector(1,NLBFGS_vec);
r_LBFGS = vector(1,NLBFGS_vec);
rho_LBFGS = vector(1,NLBFGS);
alpha_LBFGS = vector(1,NLBFGS);
beta_LBFGS = vector(1,NLBFGS);
}
taper_coeff= matrix(1,NY,1,NX);
/* memory for source position definition */
acq.srcpos1=fmatrix(1,8,1,1);
/* memory of L2 norm */
L2t = vector(1,4);
epst1 = vector(1,3);
fprintf(FP," ... memory allocation for PE %d was successfull.\n\n", MYID);
/* Holberg coefficients for FD operators*/
hc = holbergcoeff();
MPI_Barrier(MPI_COMM_WORLD);
/* Reading source positions from SOURCE_FILE */
acq.srcpos=sources(&nsrc);
nsrc_glob=nsrc;
/* create model grids */
if(L){
if (READMOD) readmod_visc_PSV(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta);
else model(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta);
} else{
if (READMOD) readmod_elastic_PSV(matPSV.prho,matPSV.ppi,matPSV.pu);
else model_elastic(matPSV.prho,matPSV.ppi,matPSV.pu);
}
/* check if the FD run will be stable and free of numerical dispersion */
if(L){
checkfd_ssg_visc(FP,matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup,matPSV.peta,hc);
} else{
checkfd_ssg_elastic(FP,matPSV.prho,matPSV.ppi,matPSV.pu,hc);
}
if(GRAVITY==1 || GRAVITY==2){
/* read station positions */
MPI_Barrier(MPI_COMM_WORLD);
gravpos=read_grav_pos(&ngrav);
/* define model and residual data vector for gz (z-component of the gravity field) */
gz_mod = vector(1,ngrav);
gz_res = vector(1,ngrav);
/* only forward modelling of gravity data */
if(GRAVITY==1){
/* global density model */
rho_grav = matrix(1,NYG,1,NXG);
rho_grav_ext = matrix(1,nygrav,1,nxgrav);
read_density_glob(rho_grav,1);
extend_mod(rho_grav,rho_grav_ext,nxgrav,nygrav);
grav_mod(rho_grav_ext,ngrav,gravpos,gz_mod,nxgrav,nygrav,NZGRAV);
free_matrix(rho_grav,1,NYG,1,NXG);
free_matrix(rho_grav_ext,1,nygrav,1,nxgrav);
}
if(GRAVITY==2){
grad_grav = matrix(1,NY,1,NX);
}
}
SHOTINC=1;
iter_true=1;
/* Begin of FWI-workflow */
for(nstage=1;nstage<=stagemax;nstage++){
/* read workflow input file *.inp */
FP_stage=fopen(FILEINP1,"r");
read_par_inv(FP_stage,nstage,stagemax);
/*fclose(FP_stage);*/
if((EPRECOND==1)||(EPRECOND==3)){
Ws = matrix(1,NY,1,NX); /* total energy of the source wavefield */
Wr = matrix(1,NY,1,NX); /* total energy of the receiver wavefield */
We = matrix(1,NY,1,NX); /* total energy of source and receiver wavefield */
}
FC=FC_END;
iter=1;
/* --------------------------------------
* Begin of Full Waveform iteration loop
* -------------------------------------- */
while(iter<=ITERMAX){
if(GRAD_METHOD==2){
/* increase pointer to LBFGS-vector*/
if(iter>2){
LBFGS_pointer++;
}
/* if LBFGS-pointer > NLBFGS -> set LBFGS_pointer=1 */
if(LBFGS_pointer>NLBFGS){LBFGS_pointer=1;}
}
if (MYID==0)
{
time2=MPI_Wtime();
fprintf(FP,"\n\n\n ------------------------------------------------------------------\n");
fprintf(FP,"\n\n\n TDFWI ITERATION %d \t of %d \n",iter,ITERMAX);
fprintf(FP,"\n\n\n ------------------------------------------------------------------\n");
}
/* For the calculation of the material parameters between gridpoints
they have to be averaged. For this, values lying at 0 and NX+1,
for example, are required on the local grid. These are now copied from the
neighbouring grids */
if (L){
matcopy_PSV(matPSV.prho,matPSV.ppi,matPSV.pu,matPSV.ptaus,matPSV.ptaup);
} else{
matcopy_elastic_PSV(matPSV.prho,matPSV.ppi,matPSV.pu);
}
MPI_Barrier(MPI_COMM_WORLD);
av_mue(matPSV.pu,matPSV.puipjp,matPSV.prho);
av_rho(matPSV.prho,matPSV.prip,matPSV.prjp);
if (L) av_tau(matPSV.ptaus,matPSV.ptausipjp);
/* Preparing memory variables for update_s (viscoelastic) */
if (L) prepare_update_s_visc_PSV(matPSV.etajm,matPSV.etaip,matPSV.peta,matPSV.fipjp,matPSV.pu,matPSV.puipjp,matPSV.ppi,matPSV.prho,matPSV.ptaus,matPSV.ptaup,matPSV.ptausipjp,matPSV.f,matPSV.g,
matPSV.bip,matPSV.bjm,matPSV.cip,matPSV.cjm,matPSV.dip,matPSV.d,matPSV.e);
if(iter_true==1){
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
if(INVMAT1==1){
fwiPSV.Vp0[j][i] = matPSV.ppi[j][i];
fwiPSV.Vs0[j][i] = matPSV.pu[j][i];
fwiPSV.Rho0[j][i] = matPSV.prho[j][i];
}
if(INVMAT1==2){
fwiPSV.Vp0[j][i] = sqrt((matPSV.ppi[j][i]+2.0*matPSV.pu[j][i])*matPSV.prho[j][i]);
fwiPSV.Vs0[j][i] = sqrt(matPSV.pu[j][i]*matPSV.prho[j][i]);
fwiPSV.Rho0[j][i] = matPSV.prho[j][i];
}
if(INVMAT1==3){
fwiPSV.Vp0[j][i] = matPSV.ppi[j][i];
fwiPSV.Vs0[j][i] = matPSV.pu[j][i];
fwiPSV.Rho0[j][i] = matPSV.prho[j][i];
}
}
}
/* ----------------------------- */
/* calculate Covariance matrices */
/* ----------------------------- */
Vp_avg = 0.0;
Vs_avg = 0.0;
rho_avg = 0.0;
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
/* calculate average Vp, Vs */
Vp_avg+=matPSV.ppi[j][i];
Vs_avg+=matPSV.pu[j][i];
/* calculate average rho */
rho_avg+=matPSV.prho[j][i];
}
}
/* calculate average Vp, Vs and rho of all CPUs*/
Vp_sum = 0.0;
MPI_Allreduce(&Vp_avg,&Vp_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
Vp_avg=Vp_sum;
Vs_sum = 0.0;
MPI_Allreduce(&Vs_avg,&Vs_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
Vs_avg=Vs_sum;
rho_sum = 0.0;
MPI_Allreduce(&rho_avg,&rho_sum,1,MPI_FLOAT,MPI_SUM,MPI_COMM_WORLD);
rho_avg=rho_sum;
Vp_avg /=NXG*NYG;
Vs_avg /=NXG*NYG;
rho_avg /=NXG*NYG;
if(MYID==0){
printf("Vp_avg = %.0f \t Vs_avg = %.0f \t rho_avg = %.0f \n ",Vp_avg,Vs_avg,rho_avg);
}
C_vp = Vp_avg;
C_vs = Vs_avg;
C_rho = rho_avg;
}
/* Open Log File for L2 norm */
if(MYID==0){
if(iter_true==1){
FPL2=fopen(MISFIT_LOG_FILE,"w");
}
if(iter_true>1){
FPL2=fopen(MISFIT_LOG_FILE,"a");
}
}
/* ---------------------------------------------------------------------------------------------------- */
/* --------- Calculate gradient and objective function using the adjoint state method ----------------- */
/* ---------------------------------------------------------------------------------------------------- */
L2sum = grad_obj_psv(&wavePSV, &wavePSV_PML, &matPSV, &fwiPSV, &mpiPSV, &seisPSV, &seisPSVfwi, &acq, hc, iter, nsrc, ns, ntr, ntr_glob,
nsrc_glob, nsrc_loc, ntr_loc, nstage, We, Ws, Wr, taper_coeff, hin, DTINV_help, req_send, req_rec);
L2t[1]=L2sum;
L2t[4]=L2sum;
if(GRAVITY==2){
/* save seismic L2-norm of seismic data residuals */
L2sum = L2t[1];
/* global density model */
rho_grav = matrix(1,NYG,1,NXG);
rho_grav_ext = matrix(1,nygrav,1,nxgrav);
/* model gravity data */
/* save current density model */
sprintf(jac_grav,"%s_tmp.rho.%i%i",JACOBIAN,POS[1],POS[2]);
FP_GRAV=fopen(jac_grav,"wb");
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
fwrite(&matPSV.prho[j][i],sizeof(float),1,FP_GRAV);
}
}
fclose(FP_GRAV);
MPI_Barrier(MPI_COMM_WORLD);
/* merge model file */
sprintf(jac_grav,"%s_tmp.rho",JACOBIAN);
if (MYID==0) mergemod(jac_grav,3);
MPI_Barrier(MPI_COMM_WORLD);
/* gravity forward modelling */
read_density_glob(rho_grav,2);
extend_mod(rho_grav,rho_grav_ext,nxgrav,nygrav);
grav_mod(rho_grav_ext,ngrav,gravpos,gz_mod,nxgrav,nygrav,NZGRAV);
/* calculate gravity data residuals */
L2_grav=calc_res_grav(ngrav,gz_mod,gz_res);
/* calculate lambda 1 */
if(iter==1){
LAM_GRAV = GAMMA_GRAV * (L2sum/L2_grav);
}
/* add gravity penalty term to the seismic objective function */
L2t[1]+=LAM_GRAV * L2_grav;
L2t[4]+=LAM_GRAV * L2_grav;
/* calculate gravity gradient */
for (i=1;i<=NX;i=i+IDX){
for (j=1;j<=NY;j=j+IDY){
grad_grav[j][i]=0.0;
}
}
grav_grad(ngrav,gravpos,grad_grav,gz_res);
MPI_Barrier(MPI_COMM_WORLD);
/* merge model file */
sprintf(jac,"%s_grav",JACOBIAN);
if (MYID==0) mergemod(jac,3);
/* free memory */
free_matrix(rho_grav,1,NYG,1,NXG);
free_matrix(rho_grav_ext,1,nygrav,1,nxgrav);
}
/* Interpolate missing spatial gradient values in case IDXI > 1 || IDXY > 1 */
/* ------------------------------------------------------------------------ */
if((IDXI>1)||(IDYI>1)){
interpol(IDXI,IDYI,fwiPSV.waveconv,1);
interpol(IDXI,IDYI,fwiPSV.waveconv_u,1);
interpol(IDXI,IDYI,fwiPSV.waveconv_rho,1);
}
/* Preconditioning of gradients after shot summation */
precond_PSV(&fwiPSV,&acq,nsrc,ntr_glob,taper_coeff,FP_GRAV);
/* Add gravity gradient to FWI density gradient */
/* -------------------------------------------- */
if(GRAVITY==2){
/* calculate maximum values of waveconv_rho and grad_grav */
FWImax = 0.0;
GRAVmax = 0.0;
for (i=1;i<=NX;i++){
for (j=1;j<=NY;j++){
if(fabs(fwiPSV.waveconv_rho[j][i])>FWImax){FWImax=fabs(fwiPSV.waveconv_rho[j][i]);}
if(fabs(grad_grav[j][i])>GRAVmax){GRAVmax=fabs(grad_grav[j][i]);}
}
}
MPI_Allreduce(&FWImax,&FWImax_all, 1,MPI_FLOAT,MPI_MAX,MPI_COMM_WORLD);
MPI_Allreduce(&GRAVmax,&GRAVmax_all,1,MPI_FLOAT,MPI_MAX,MPI_COMM_WORLD);
/* calculate lambda 2, normalized with respect to the maximum gradients */
if(iter==1){
LAM_GRAV_GRAD = GAMMA_GRAV * (FWImax_all/GRAVmax_all);
}
/* add gravity gradient to seismic gradient with respect to the density */
for (i=1;i<=NX;i++){
for (j=1;j<=NY;j++){
fwiPSV.waveconv_rho[j][i] += LAM_GRAV_GRAD * grad_grav[j][i];
}
}
}
/* Use preconditioned conjugate gradient optimization method */
if(GRAD_METHOD==1){
PCG(fwiPSV.waveconv, taper_coeff, nsrc, acq.srcpos, acq.recpos, ntr_glob, iter, fwiPSV.gradp, fwiPSV.waveconv_u, fwiPSV.gradp_u, fwiPSV.waveconv_rho, fwiPSV.gradp_rho);
}
/* Use l-BFGS optimization */
if(GRAD_METHOD==2){
/* store models and gradients in l-BFGS vectors */
store_LBFGS_PSV(taper_coeff, nsrc, acq.srcpos, acq.recpos, ntr_glob, iter, fwiPSV.waveconv, fwiPSV.gradp, fwiPSV.waveconv_u, fwiPSV.gradp_u, fwiPSV.waveconv_rho,
fwiPSV.gradp_rho, y_LBFGS, s_LBFGS, q_LBFGS, matPSV.ppi, matPSV.pu, matPSV.prho, NXNYI, LBFGS_pointer, NLBFGS, NLBFGS_vec);
/* apply l-BFGS optimization */
LBFGS(iter, y_LBFGS, s_LBFGS, rho_LBFGS, alpha_LBFGS, q_LBFGS, r_LBFGS, beta_LBFGS, LBFGS_pointer, NLBFGS, NLBFGS_vec);
/* extract gradients and save old models/gradients for next l-BFGS iteration */
extract_LBFGS_PSV(iter, fwiPSV.waveconv, fwiPSV.gradp, fwiPSV.waveconv_u, fwiPSV.gradp_u, fwiPSV.waveconv_rho, fwiPSV.gradp_rho, matPSV.ppi, matPSV.pu, matPSV.prho, r_LBFGS);
}
opteps_vp=0.0;
opteps_vs=0.0;
opteps_rho=0.0;
/* ============================================================================================================================*/
/* =============================================== test loop L2 ===============================================================*/
/* ============================================================================================================================*/
/* set min_iter_help to initial global value of MIN_ITER */
if(iter==1){min_iter_help=MIN_ITER;}
/* Estimate optimum step length ... */
/* ... by line search (parabolic fitting) */
eps_scale = step_length_est_psv(&wavePSV,&wavePSV_PML,&matPSV,&fwiPSV,&mpiPSV,&seisPSV,&seisPSVfwi,&acq,hc,iter,nsrc,ns,ntr,ntr_glob,epst1,L2t,nsrc_glob,nsrc_loc,&step1,&step3,nxgrav,nygrav,ngrav,gravpos,gz_mod,NZGRAV,
ntr_loc,Ws,Wr,hin,DTINV_help,req_send,req_rec);
/* no model update due to steplength estimation failed or update with the smallest steplength if the number of iteration is smaller than the minimum number of iteration per
frequency MIN_ITER */
if((iter>min_iter_help)&&(step1==0)){
eps_scale=0.0;
opteps_vp=0.0;
}
else{
opteps_vp=eps_scale;
}
/* write log-parameter files */
if(MYID==0){
printf("MYID = %d \t opteps_vp = %e \t opteps_vs = %e \t opteps_rho = %e \n",MYID,opteps_vp,opteps_vs,opteps_rho);
printf("MYID = %d \t L2t[1] = %e \t L2t[2] = %e \t L2t[3] = %e \t L2t[4] = %e \n",MYID,L2t[1],L2t[2],L2t[3],L2t[4]);
printf("MYID = %d \t epst1[1] = %e \t epst1[2] = %e \t epst1[3] = %e \n",MYID,epst1[1],epst1[2],epst1[3]);
/*output of log file for combined inversion*/
if(iter_true==1){
LAMBDA = fopen("gravity/lambda.dat","w");
}
if(iter_true>1){
LAMBDA = fopen("gravity/lambda.dat","a");
}
fprintf(LAMBDA,"%d \t %d \t %e \t %e \t %e \t %e \t %e \t %e \t %e \n",nstage,iter,LAM_GRAV,L2sum,L2_grav,L2t[4],LAM_GRAV_GRAD,FWImax_all,GRAVmax_all);
fclose(LAMBDA);
}
if(MYID==0){
if (TIME_FILT==0){
fprintf(FPL2,"%e \t %e \t %e \t %e \t %e \t %e \t %e \t %e \t %d \n",opteps_vp,epst1[1],epst1[2],epst1[3],L2t[1],L2t[2],L2t[3],L2t[4],nstage);}
else{
fprintf(FPL2,"%e \t %e \t %e \t %e \t %e \t %e \t %e \t %e \t %f \t %f \t %d \n",opteps_vp,epst1[1],epst1[2],epst1[3],L2t[1],L2t[2],L2t[3],L2t[4],FC_START,FC,nstage);}}
/* saving history of final L2*/
L2_hist[iter]=L2t[4];
s=0;
/* calculate optimal change in the material parameters */
eps_true=calc_mat_change_test_PSV(fwiPSV.waveconv,fwiPSV.waveconv_rho,fwiPSV.waveconv_u,fwiPSV.prho_old,matPSV.prho,fwiPSV.ppi_old,matPSV.ppi,fwiPSV.pu_old,matPSV.pu,iter,1,eps_scale,0);
if (MODEL_FILTER){
/* smoothing the velocity models vp and vs */
smooth_model(matPSV.ppi,matPSV.pu,matPSV.prho,iter);
}
if(MYID==0){
/* fprintf(FPL2,"=============================================================\n");
fprintf(FPL2,"=============================================================\n");
fprintf(FPL2,"STATISTICS FOR ITERATION STEP %d \n",iter);
fprintf(FPL2,"=============================================================\n");
fprintf(FPL2,"=============================================================\n");*/
/* fprintf(FPL2,"Low-pass filter at %e Hz\n",freq);
fprintf(FPL2,"----------------------------------------------\n");
*/ /*fprintf(FPL2,"L2 at iteration step n = %e \n",L2);*/
/* fprintf(FPL2,"%e \t %e \t %e \t %e \t %e \t %e \t %e \t %e \n",EPSILON,EPSILON_u,EPSILON_rho,L2t[4],betaVp,betaVs,betarho,sqrt(C_vp));*/
/*fprintf(FPL2,"----------------------------------------------\n");*/
/* fprintf(FPL2,"=============================================================\n");
fprintf(FPL2,"=============================================================\n\n\n");*/
}
if(MYID==0){
fclose(FPL2);
}
if (iter>min_iter_help){
float diff=0.0, pro=PRO;
/* calculating differnce of the actual L2 and before two iterations, dividing with L2_hist[iter-2] provide changing in procent*/
diff=fabs((L2_hist[iter-2]-L2_hist[iter])/L2_hist[iter-2]);
if((diff<=pro)||(step3==1)){
/* output of the model at the end of given corner frequency */
model_freq_out_PSV(matPSV.ppi,matPSV.prho,matPSV.pu,nstage,FC);
s=1;
min_iter_help=0;
min_iter_help=iter+MIN_ITER;
iter=0;
if(GRAD_METHOD==2){
zero_LBFGS(NLBFGS, NLBFGS_vec, y_LBFGS, s_LBFGS, q_LBFGS, r_LBFGS, alpha_LBFGS, beta_LBFGS, rho_LBFGS);
LBFGS_pointer = 1;
}
if(MYID==0){
if(step3==1){
printf("\n Steplength estimation failed step3=%d \n Changing to next FWI stage \n",step3);
}
else{
printf("\n Reached the abort criterion of pro=%e and diff=%e \n Changing to next FWI stage \n",pro,diff);
}
}
break;
}
}
iter++;
iter_true++;
/* ====================================== */
} /* end of fullwaveform iteration loop*/
/* ====================================== */
} /* End of FWI-workflow loop */
/* deallocate memory for PSV forward problem */
dealloc_PSV(&wavePSV,&wavePSV_PML);
/* deallocation of memory */
free_matrix(fwiPSV.Vp0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.Vs0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.Rho0,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.prho_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prip,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.prjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ppi,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.ppi_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.pu,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.pu_old,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.puipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_lam,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(mpiPSV.bufferlef_to_rig,1,NY,1,fdo3);
free_matrix(mpiPSV.bufferrig_to_lef,1,NY,1,fdo3);
free_matrix(mpiPSV.buffertop_to_bot,1,NX,1,fdo3);
free_matrix(mpiPSV.bufferbot_to_top,1,NX,1,fdo3);
free_vector(hc,0,6);
free_matrix(fwiPSV.gradg,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradg_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho_s,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_rho_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradg_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.gradp_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_u,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_mu,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(fwiPSV.waveconv_u_shot,-nd+1,NY+nd,-nd+1,NX+nd);
free_vector(fwiPSV.forward_prop_x,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_y,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_rho_x,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_rho_y,1,NY*NX*NT);
free_vector(fwiPSV.forward_prop_u,1,NY*NX*NT);
if (nsrc_loc>0){
free_matrix(acq.signals,1,nsrc_loc,1,NT);
free_matrix(acq.srcpos_loc,1,8,1,nsrc_loc);
free_matrix(acq.srcpos_loc_back,1,6,1,nsrc_loc);
}
/* free memory for global source positions */
free_matrix(acq.srcpos,1,8,1,nsrc);
/* free memory for source position definition */
free_matrix(acq.srcpos1,1,8,1,1);
/* free memory for abort criterion */
free_vector(L2_hist,1,1000);
free_vector(L2t,1,4);
free_vector(epst1,1,3);
if(N_STREAMER==0){
if (SEISMO) free_imatrix(acq.recpos,1,3,1,ntr_glob);
if ((ntr>0) && (SEISMO)){
free_imatrix(acq.recpos_loc,1,3,1,ntr);
acq.recpos_loc = NULL;
switch (SEISMO){
case 1 : /* particle velocities only */
free_matrix(seisPSV.sectionvx,1,ntr,1,ns);
free_matrix(seisPSV.sectionvy,1,ntr,1,ns);
seisPSV.sectionvx=NULL;
seisPSV.sectionvy=NULL;
break;
case 2 : /* pressure only */
free_matrix(seisPSV.sectionp,1,ntr,1,ns);
break;
case 3 : /* curl and div only */
free_matrix(seisPSV.sectioncurl,1,ntr,1,ns);
free_matrix(seisPSV.sectiondiv,1,ntr,1,ns);
break;
case 4 : /* everything */
free_matrix(seisPSV.sectionvx,1,ntr,1,ns);
free_matrix(seisPSV.sectionvy,1,ntr,1,ns);
free_matrix(seisPSV.sectionp,1,ntr,1,ns);
free_matrix(seisPSV.sectioncurl,1,ntr,1,ns);
free_matrix(seisPSV.sectiondiv,1,ntr,1,ns);
break;
}
}
free_matrix(seisPSVfwi.sectionread,1,ntr_glob,1,ns);
free_ivector(acq.recswitch,1,ntr);
if((QUELLTYPB==1)||(QUELLTYPB==3)||(QUELLTYPB==5)||(QUELLTYPB==7)){
free_matrix(seisPSVfwi.sectionvxdata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvxdiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvxdiffold,1,ntr,1,ns);
}
if((QUELLTYPB==1)||(QUELLTYPB==2)||(QUELLTYPB==6)||(QUELLTYPB==7)){
free_matrix(seisPSVfwi.sectionvydata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvydiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionvydiffold,1,ntr,1,ns);
}
if(QUELLTYPB>=4){
free_matrix(seisPSVfwi.sectionpdata,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionpdiff,1,ntr,1,ns);
free_matrix(seisPSVfwi.sectionpdiffold,1,ntr,1,ns);
}
}
if(SEISMO){
free_matrix(seisPSV.fulldata,1,ntr_glob,1,NT);
}
if(SEISMO==1){
free_matrix(seisPSV.fulldata_vx,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_vy,1,ntr_glob,1,NT);
}
if(SEISMO==2){
free_matrix(seisPSV.fulldata_p,1,ntr_glob,1,NT);
}
if(SEISMO==3){
free_matrix(seisPSV.fulldata_curl,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_div,1,ntr_glob,1,NT);
}
if(SEISMO==4){
free_matrix(seisPSV.fulldata_vx,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_vy,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_p,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_curl,1,ntr_glob,1,NT);
free_matrix(seisPSV.fulldata_div,1,ntr_glob,1,NT);
}
free_ivector(DTINV_help,1,NT);
/* free memory for viscoelastic modeling variables */
if (L) {
free_matrix(matPSV.ptaus,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ptausipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.ptaup,-nd+1,NY+nd,-nd+1,NX+nd);
free_vector(matPSV.peta,1,L);
free_vector(matPSV.etaip,1,L);
free_vector(matPSV.etajm,1,L);
free_vector(matPSV.bip,1,L);
free_vector(matPSV.bjm,1,L);
free_vector(matPSV.cip,1,L);
free_vector(matPSV.cjm,1,L);
free_matrix(matPSV.f,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.g,-nd+1,NY+nd,-nd+1,NX+nd);
free_matrix(matPSV.fipjp,-nd+1,NY+nd,-nd+1,NX+nd);
free_f3tensor(matPSV.dip,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
free_f3tensor(matPSV.d,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
free_f3tensor(matPSV.e,-nd+1,NY+nd,-nd+1,NX+nd,1,L);
}
if(GRAVITY){
free_matrix(gravpos,1,2,1,ngrav);
free_vector(gz_mod,1,ngrav);
free_vector(gz_res,1,ngrav);
if(GRAVITY==2){
free_matrix(grad_grav,1,NY,1,NX);
}
}
/* de-allocate buffer for messages */
MPI_Buffer_detach(buff_addr,&buffsize);
MPI_Barrier(MPI_COMM_WORLD);
if (MYID==0){
fprintf(FP,"\n **Info from main (written by PE %d): \n",MYID);
fprintf(FP," CPU time of program per PE: %li seconds.\n",clock()/CLOCKS_PER_SEC);
time8=MPI_Wtime();
fprintf(FP," Total real time of program: %4.2f seconds.\n",time8-time1);
time_av_v_update=time_av_v_update/(double)NT;
time_av_s_update=time_av_s_update/(double)NT;
time_av_v_exchange=time_av_v_exchange/(double)NT;
time_av_s_exchange=time_av_s_exchange/(double)NT;
time_av_timestep=time_av_timestep/(double)NT;
/* fprintf(FP," Average times for \n");
fprintf(FP," velocity update: \t %5.3f seconds \n",time_av_v_update);
fprintf(FP," stress update: \t %5.3f seconds \n",time_av_s_update);
fprintf(FP," velocity exchange: \t %5.3f seconds \n",time_av_v_exchange);
fprintf(FP," stress exchange: \t %5.3f seconds \n",time_av_s_exchange);
fprintf(FP," timestep: \t %5.3f seconds \n",time_av_timestep);*/
}
fclose(FP);
}
void evolvedependent(long **matrix,long **tree,int *trpd,int ttlbr,int notu,int *steps,int ind,int dep,int nstates,int ctype,int bias,int maxd,int **taxachange,int deltas,int UNKNOWN,int INAP)
void forward_SH(char *fileinp1){
/* declaration of global variables */
extern int MYID, NF, MYID, LOG, NXG, NYG, NX, NY, NXNY, INFO, INVMAT, N_STREAMER;
extern int READMOD, NX0, NY0, NPML, READ_REC, FSSHIFT, NFREQ1, NFREQ2, COLOR;
extern int NPROCFREQ, NPROCSHOT, NP, MYID_SHOT, NSHOT1, NSHOT2, NF, SEISMO;
extern float FC_low, FC_high, A0_PML;
extern char LOG_FILE[STRING_SIZE];
extern FILE *FP;
/* declaration of local variables */
int i, j, nstage, stagemax, nfreq;
char ext[10];
int ntr, nshots;
FILE *FP_stage;
/* open log-file (each PE is using different file) */
/* fp=stdout; */
sprintf(ext,".%i",MYID);
strcat(LOG_FILE,ext);
if ((MYID==0) && (LOG==1)) FP=stdout;
else FP=fopen(LOG_FILE,"w");
fprintf(FP," This is the log-file generated by PE %d \n\n",MYID);
/* output of parameters to log-file or stdout */
if (MYID==0) write_par(FP);
/* store old NX and NY values */
NX0 = NX;
NY0 = NY;
/* add external PML layers */
NX += 2 * NPML;
NY += NPML + FSSHIFT;
NXG = NX;
NYG = NY;
/* size of impedance matrix */
NXNY = NX * NY;
/* Calculate number of non-zero elements in impedance matrix */
calc_nonzero();
/* define data structures for acoustic problem */
struct waveAC;
struct matSH;
struct PML_AC;
struct acq;
/* allocate memory for acoustic forward problem */
alloc_waveAC(&waveAC,&PML_AC);
alloc_matSH(&matSH);
/* If INVMAT!=0 deactivate unnecessary output */
INFO=0;
/* If INVMAT==0 allow unnecessary output */
if(INVMAT==0){
INFO=1;
}
/*if (MYID == 0) info_mem(stdout,NLBFGS_vec,ntr);*/
/* Reading source positions from SOURCE_FILE */
acq.srcpos=sources(&nshots);
/* read receiver positions from receiver files for each shot */
if(READ_REC==0){
acq.recpos=receiver(FP, &ntr, 1);
}
/* read/create S-wave velocity and density models */
if (READMOD){
readmod_SH(&matSH);
}else{
model_SH(&matSH);
}
/* read parameters from workflow-file (stdin) */
FP=fopen(fileinp1,"r");
if(FP==NULL) {
if (MYID == 0){
printf("\n==================================================================\n");
printf(" Cannot open GERMAINE workflow input file %s \n",fileinp1);
printf("\n==================================================================\n\n");
err(" --- ");
}
}
/* estimate number of lines in FWI-workflow */
i=0;
stagemax=0;
while ((i=fgetc(FP)) != EOF)
if (i=='\n') ++stagemax;
rewind(FP);
stagemax--;
fclose(FP);
/* loop over GERMAINE workflow stages */
for(nstage=1;nstage<=stagemax;nstage++){
/* read workflow input file *.inp */
FP_stage=fopen(fileinp1,"r");
read_par_inv(FP_stage,nstage,stagemax);
/* estimate frequency sample interval and set first frequency */
if(NF>1){waveAC.dfreq = (FC_high-FC_low) / (NF-1);}
else{waveAC.dfreq = (FC_high-FC_low) / NF;}
/* estimate frequencies for current FWI stage */
waveAC.stage_freq = vector(1,NF);
waveAC.stage_freq[1] = FC_low;
for(i=2;i<=NF;i++){
waveAC.stage_freq[i] = waveAC.stage_freq[i-1] + waveAC.dfreq;
}
/* split MPI communicator for shot parallelization */
COLOR = MYID / NPROCFREQ;
MPI_Comm shot_comm;
MPI_Comm_split(MPI_COMM_WORLD, COLOR, MYID, &shot_comm);
/* esimtate communicator size for shot_comm and number of colors (NPROCSHOT) */
MPI_Comm_rank(shot_comm, &MYID_SHOT);
NPROCSHOT = NP / NPROCFREQ;
/* Initiate MPI shot parallelization */
init_MPIshot(nshots);
/* Initiate MPI frequency parallelization */
init_MPIfreq();
/* allocate memory for FD data */
if(READ_REC==0){
alloc_seis_AC(&waveAC,ntr,nshots);
}
/* loop over frequencies at each stage */
for(nfreq=NFREQ1;nfreq<NFREQ2;nfreq++){
/* set frequency on local MPI process */
waveAC.freq = waveAC.stage_freq[nfreq];
/* define PML damping profiles */
pml_pro(&PML_AC,&waveAC);
/* solve forward problem for all shots*/
forward_shot_SH(&waveAC,&PML_AC,&matSH,acq.srcpos,nshots,acq.recpos,ntr,nstage,nfreq);
} /* end of loop over frequencies */
/* write FD seismogram files */
if(SEISMO==1){
write_seis_AC(&waveAC,nshots,ntr,nstage);
}
/* free memory */
if(READ_REC==0){
free_vector(waveAC.precr,1,ntr*NF*nshots);
free_vector(waveAC.preci,1,ntr*NF*nshots);
}
/* free shot_comm */
MPI_Comm_free(&shot_comm);
} /* end of loop over workflow stages*/
if(READ_REC==0){free_imatrix(acq.recpos,1,3,1,ntr);}
}
