inline Matrix *
fmmul (const Matrix *m1, const Matrix *m2) {
Matrix *m;
int r, c, n;
float sum;
if (m1->cols != m2->rows) {
errno = EINVAL;
return NULL;
}
m = fmatrix(m1->rows, m2->cols);
if (m == NULL)
return NULL;
r = 0;
while (r < m1->rows) {
c = 0;
while (c < m2->cols) {
sum = 0;
n = 0;
while (n < m1->cols) {
sum += *fmget(m1, r, n) * *fmget(m2, n, c);
n++;
}
fmset(m, r, c, sum);
c++;
}
r++;
}
return m;
}
Matrix * Pose::origin4D(){
Matrix * origin= fmatrix(4,1);
float originContents[] = {0,0,0,1.0};
memcpy(origin->data,originContents, 4*sizeof(float));
return origin;
}
inline Matrix *
fmsub (const Matrix *m1, const Matrix *m2) {
Matrix *m;
int r, c;
if (m1->rows != m2->rows || m1->cols != m2->cols) {
errno = EINVAL;
return NULL;
}
m = fmatrix(m1->rows, m1->cols);
if (m == NULL)
return NULL;
r = 0;
while (r < m->rows) {
c = 0;
while (c < m->cols) {
fmset(m, r, c, *fmget(m1,r,c) - *fmget(m2,r,c));
c++;
}
r++;
}
return m;
}
void display_particles(NBody *data, double max, int n)
/*assume a top-down view (i.e. ignore the z-component*/
{
#ifdef PGPLOT
int npix=256;
float tr[6];
static int firsttime=1;
if (firsttime)
{
assert(NDIM>=2);
cpgopen("?");
cpgenv(1,npix,1,npix,0,1);
firsttime=0;
}
tr[0]=0;tr[1]=1;tr[2]=0;tr[3]=0;tr[4]=0;tr[5]=1;
float **mat=fmatrix(npix,npix);
for (int i=0;i<npix;i++)
for (int j=0;j<npix;j++)
mat[i][j]=0;
for (int i=0;i<n;i++)
{
int ii= npix*((data[i].x[0]+max)/(2*max));
int jj= npix*((data[i].x[1]+max)/(2*max));
if ((ii>=0)&&(ii<npix)&&(jj>=0)&&(jj<npix))
mat[ii][jj]++;
}
cpgimag(mat[0],npix,npix,1,npix,1,npix,0,5.0,tr);
#endif
}
inline Matrix *
fminvert (const Matrix *other) {
Matrix *result;
float det;
if (other->rows == 2 && other->cols == 2) {
result = fmatrix(2,2);
fmset(result,0,0, *fmget(other,1,1));
fmset(result,0,1, *fmget(other,0,1) * -1);
fmset(result,1,0, *fmget(other,1,0) * -1);
fmset(result,1,1, *fmget(other,0,0));
det = (*fmget(other,0,0) * *fmget(other,1,1)) -
(*fmget(other,0,1) * *fmget(other,1,0));
if (det != 0)
fmscaleeq(result, 1.0 / det);
else {
fmfree(result);
result = NULL;
errno = EDOM;
}
}else {
Matrix *id = fmidentity(other->rows);
result = fmsolve(other, id);
fmfree(id);
}
return result;
}
int mergecb(float *B,float **cb,unsigned char *P,int npt,int N,float thresh,int dim)
{
int i,j,newN,*count,l,ei,debug=0;
float **dist;
if (N==1) return N;
count=(int *)malloc(sizeof(int)*N);
for (l=0;l<npt;l++) count[P[l]]++;
dist=(float **)fmatrix(N,N);
ei = N-1;
for (i=0;i<ei;i++)
{
for (j=i+1;j<N;j++)
{
dist[i][j] = distance2(cb[i],cb[j],dim);
dist[j][i] = dist[i][j];
}
}
if (debug) printf("thresh %f ",thresh);
newN=mergecb1(dist,B,cb,N,thresh,dim,count);
free_fmatrix(dist,N);
free(count);
return newN;
}
int mergecb(float *B,float **cb,unsigned char *P,int npt,int N,float thresh,int dim)
{
int i,j,newN,*count,l,ei,*count2;
float **dist,**dist2,**cb2;
if (N==1) return 1;
count=(int *)calloc(N,sizeof(int));
for (l=0;l<npt;l++) count[P[l]]++;
dist=(float **)fmatrix(N,N);
ei = N-1;
for (i=0;i<ei;i++)
{
for (j=i+1;j<N;j++)
{
dist[i][j] = distance2(cb[i],cb[j],dim);
dist[j][i] = dist[i][j];
}
}
if (thresh<0)
{
cb2 = (float **)fmatrix(N,dim);
for (i=0;i<N;i++)
for (j=0;j<dim;j++) cb2[i][j]=cb[i][j];
count2=(int *)calloc(N,sizeof(int));
for (i=0;i<N;i++) count2[i]=count[i];
dist2=(float **)fmatrix(N,N);
for (i=0;i<N;i++)
for (j=0;j<N;j++) dist2[i][j]=dist[i][j];
if (dim==3) thresh=400;
else if (dim==1) thresh=800;
mergecb1(dist2,B,cb2,P,npt,N,&thresh,dim,count2,1);
free_fmatrix(cb2,N);
free(count2);
free_fmatrix(dist2,N);
}
printf("thresh %f ",thresh);
newN=mergecb1(dist,B,cb,P,npt,N,&thresh,dim,count,0);
free_fmatrix(dist,N);
free(count);
return newN;
}
inline Matrix *
fmatrix3 (const Matrix *other) {
Matrix *m;
m = fmatrix(other->rows, other->cols);
if (m == NULL)
return NULL;
memcpy(m->data, other->data, m->rows * m->cols * sizeof(float));
return m;
}
FFT2D::FFT2D( int Q_kw, int periods_1, int steps_pp_1, int screen_1,
int periods_2, int steps_pp_2, int screen_2 )
{
if (Q_kw){
periods_input_1 = periods_1;
periods_input_2 = periods_2;
steps_pp_input_1 = steps_pp_1;
steps_pp_input_2 = steps_pp_2;
screen_input_1 = screen_1;
screen_input_2 = screen_2;
steps_input_1 = periods_1 * steps_pp_1;
steps_input_2 = periods_2 * steps_pp_2;
dt_input_1 = (float) periods_input_1 / ( steps_input_1 - 1 );
dt_input_2 = (float) periods_input_2 / ( steps_input_2 - 1 );
steps_1 = steps_ft( steps_input_1 );
steps_2 = steps_ft( steps_input_1 );
steps_half_1 = (int) floor( 0.5*steps_1 + 0.5 );
steps_half_2 = (int) floor( 0.5*steps_2 + 0.5 );
dt_1 = (float) periods_input_1 / ( steps_1 - 1 ); // time step in periods
dt_2 = (float) periods_input_2 / ( steps_2 - 1 ); // time step in periods
df_1 = (float) 1.0 / periods_input_1; // frequency step
df_2 = (float) 1.0 / periods_input_2; // frequency step
nn = new int [ 3 ];
nn[1] = steps_1;
nn[2] = steps_2;
local = fmatrix( 0, steps_1, 0, steps_2 );
data = new float [ 2 * steps_1 * steps_2 + 1 ];
frequency_1 = new float [ steps_1 ];
frequency_2 = new float [ steps_2 ];
// co = fmatrix( 0, steps_half_1+1, 0, steps_2+1 );// pos and neg k, pos frequency!
// si = fmatrix( 0, steps_half_1+1, 0, steps_2+1 );
power = fmatrix( 0, steps_half_1+1, 0, steps_2+1 );
if (!nn || !local || !data || !frequency_1 || !frequency_2 || !power) {
printf( "\n allocation failure in FFT2D::constructor" );
exit(-1);
}
}
}
void Renderer::ScreenVertex::fragment_shader(Model &model, int *shadow_buffer, Renderer *r) {
TGAColor color = model.diffuse(uv);
fmatrix nm = fmatrix(model.normal(uv), 0.)*r->NormalTransformMatrix;
Vec3f normal = Vec3f(nm[0][0], nm[0][1], nm[0][2]).normalize(); // no need to divide by normal[0][3], normalizing anyway
float diffuse_coeff = std::max(normal*r->light_dir, 0.0f);
Vec3f reflected_light = normal*(normal*r->light_dir*2.f) - r->light_dir;
float shadow = 0.4;
fmatrix P = fmatrix(Vec3f(p.x, p.y, p.z), 1.) * r->ShadowMappingMatrix;
Vec3i iP = Vec3i(P[0][0]/P[0][3], P[0][1]/P[0][3], P[0][2]/P[0][3]);
if (iP.x>=0 && iP.y>=0 && iP.x<r->get_width() && iP.y<r->get_height()) {
int shadow_depth = shadow_buffer[iP.x + r->get_width()*iP.y];
if (shadow_depth<iP.z+10) shadow = 1.; // +10 to avoid z-fighting, especially awful due to mutliple int casts
}
float specularLightWeighting = pow(std::max(reflected_light.z/reflected_light.norm(), 0.0f), model.specular(uv));
for (int c=0; c<3; c++) color.raw[c] = std::min(5 + shadow*color.raw[c]*(diffuse_coeff+ .9f*specularLightWeighting), 255.f);
r->set(p.x, p.y, color);
}
Matrix * Pose::intersectLineWithXYPlane(vector<Matrix *> * aLine){
Matrix *l1 = aLine->at(0);
Matrix *l2 = aLine->at(1);
//points on the plane level with the ground in the horizon coord frame
//normally need 3 points, but since one is the origin, it can get ignored
Matrix * horizonUnitX = point4D(1,0,0);
Matrix * horizonUnitY = point4D(0,1,0);
//we now solve the point of intersection using linear algebra
//Ax=b, where b is the target, x is the solution of weights (t,u,v)
//to solve l1 + (l2 -l1)t = o1*u + o2*v
//Note!: usually a plane is defined by three vectors, but in this
//case, the horizon plane goes through the origin of the horizon
//frame, so one of the vectors is the zero vector, so we ignore it
//See http://en.wikipedia.org/wiki/Line-plane_intersection for detail
float contents[] =
{*fmget(l1,0,0) - *fmget(l2,0,0), *fmget(horizonUnitX,0,0),
*fmget(horizonUnitY,0,0),
*fmget(l1,1,0) - *fmget(l2,1,0), *fmget(horizonUnitX,1,0),
*fmget(horizonUnitY,1,0),
*fmget(l1,2,0) - *fmget(l2,2,0), *fmget(horizonUnitX,2,0),
*fmget(horizonUnitY,2,0)
};
Matrix *eqSystem = fmatrix(3,3);
memcpy(eqSystem->data,contents,3*3*sizeof(float));
// Solve for the solution of the weights.
// Now usually we would fmsolve(eqSystem,l1), but l1 is defined in
// homogeneous coordiantes. We need it to be a 3 by 1 vector to solve the
// system of equations.
Matrix *target = fmatrix4(l1,0,3,0,1);
Matrix *result = fmsolve(eqSystem,target);
float t = *fmget(result,0,0);
fmfree(result); fmfree(eqSystem);
fmfree(horizonUnitX); fmfree(horizonUnitY);
//solution.get(0,0) contains the value of the parameter t
//such that the point l1 + (l2 -l1)t is on the horizon plane
//NOTE: this intersection is still in the horizon frame though
Matrix *intersection = fmsub(l2,l1);
fmscaleeq(intersection,t);
fmaddeq(intersection,l1);
return intersection;
}
inline Matrix *
fmatrix2 (int nrows, int ncols, float value) {
Matrix *m;
float *ptr;
int length;
m = fmatrix(nrows, ncols);
if (m == NULL)
return NULL;
ptr = m->data;
length = m->rows * m->cols;
while (ptr < m->data + length)
*ptr++ = value;
return m;
}
bool SparseRec2View::run()
{
if( !detector || !descriptor || !matcher ) {
TagE("No valid detector or descriptor or matcher\n");
return false;
}
if( !loadImage() ) return false;
if( !detect() ) return false;
if( !match() ) return false;
if( !fmatrix() ) return false;
if(_onlymatch) return true;
if( !estimateRelativePose() ) return false;
return true;
}
inline int
fmpowereq (Matrix *m, int pow) {
Matrix *tmp, *tmp2, *tmp3;
int i;
if (pow > 1) {
tmp = fmmul(m, m);
if (tmp == NULL)
return -1;
if (pow != 2) {
tmp2 = fmatrix(m->rows, m->cols);
if (tmp2 == NULL) {
fmfree(tmp);
return -1;
}
}else
tmp2 = tmp;
i = 2;
}else {
errno = EINVAL;
return -1;
}
while (i < pow) {
if (fmmulstore(m, tmp, tmp2) != 0) {
fmfree(tmp);
fmfree(tmp2);
return -1;
}
tmp3 = tmp;
tmp = tmp2;
tmp2 = tmp3;
i++;
}
free(m->data); // Clear old data
*m = *tmp2; // Set m to the power result
free(tmp2); // Free the tmp2 Matrix (but not its data!)
if (tmp != tmp2) // Free the tmp1 Matrix fully, if not the same
fmfree(tmp); // (which would happen when pow == 2)
return 0;
}
inline Matrix *
fmatrix4 (const Matrix *other, int r1, int r2, int c1, int c2) {
Matrix *m;
int r;
//m = fmatrix(gr2 - r1, gc2 - gc1);
m = fmatrix(r2 - r1, c2 - c1);
if (m == NULL)
return NULL;
r = 0;
while (r < m->rows) {
memcpy(m->data + r * m->cols,
other->data + (r1 + r) * other->cols + c1,
m->cols * sizeof(float));
r++;
}
return m;
}
inline Matrix *
fmgetmatrix (const Matrix *other, const int *rows, int nrows, int c1, int c2) {
Matrix *m;
int r, c;
m = fmatrix(nrows, c2 - c1);
if (m == NULL)
return NULL;
r = 0;
while (r < m->rows) {
c = 0;
while (c < m->cols) {
fmset(m, r, c, *fmget(other, rows[r], c1 + c));
c++;
}
r++;
}
return m;
}
inline Matrix *
fmtranspose (const Matrix *other) {
Matrix *m;
int r, c;
m = fmatrix(other->cols, other->rows);
if (m == NULL)
return NULL;
r = 0;
while (r < m->rows) {
c = 0;
while (c < m->cols) {
fmset(m, r, c, *fmget(other,c,r));
c++;
}
r++;
}
return m;
}
inline Matrix *
fmscale (const Matrix *other, float scalar) {
Matrix *m;
int r, c;
m = fmatrix(other->rows, other->cols);
if (m == NULL)
return NULL;
r = 0;
while (r < m->rows) {
c = 0;
while (c < m->cols) {
fmset(m, r, c, scalar * *fmget(other, r, c));
c++;
}
r++;
}
return m;
}
int greedy(float *A,int nvec,int ndim,int N,float **codebook,float t,unsigned char *P,
float *weight)
{
int iv,in,jn,imax,nsplit,*index2,k,i,retgla,kn;
float *totalw,*d,**buf, *variance;
buf=fmatrix(N,ndim);
d=(float *)calloc(ndim,sizeof(float));
variance=(float *)calloc(N,sizeof(float));
totalw=(float *)calloc(N,sizeof(float));
index2=(int *)calloc(N,sizeof(int));
/* Calculate the initial centroid */
for (k=0;k<ndim;k++) codebook[0][k]=0.0;
totalw[0]=0; i=0;
for (iv=0;iv<nvec;iv++)
{
P[iv]= 0;
totalw[0]+=weight[iv];
for (k=0;k<ndim;k++) codebook[0][k] += weight[iv]*A[i++];
}
for (k=0;k<ndim;k++) codebook[0][k]/=totalw[0];
in=1;
while (in<N)
{
/* find the maximum variance */
for (jn=0;jn<in;jn++)
{
variance[jn]=0;
totalw[jn]=0;
for (k=0;k<ndim;k++) buf[jn][k]=0.0;
}
i = 0;
for (iv=0;iv<nvec;iv++)
{
for (k=0;k<ndim;k++) d[k] = codebook[P[iv]][k] - A[i++];
for (k=0;k<ndim;k++)
{
buf[P[iv]][k] += weight[iv]*sqr(d[k]);
variance[P[iv]]+= buf[P[iv]][k];
}
totalw[P[iv]] += weight[iv];
}
for (jn=0;jn<in;jn++)
{
for (k=0;k<ndim;k++) buf[jn][k] = sqrt(buf[jn][k]/totalw[jn]);
}
piksrt(in,variance,index2);
/* split */
nsplit=in/2+1;
if ((nsplit+in)>N) nsplit=N-in;
for (jn=0;jn<nsplit;jn++)
{
imax=index2[jn];
for (k=0;k<ndim;k++) codebook[in+jn][k] = codebook[imax][k] - buf[imax][k];
for (k=0;k<ndim;k++) codebook[imax] [k] = codebook[imax][k] + buf[imax][k];
}
/* run gla on the codebook */
in=in+nsplit;
retgla=gla(A,nvec,ndim,in,codebook,t,P,weight);
/* find the code vectors same, remove them and stop */
if (retgla)
{
for (jn=0;jn<in-1;jn++)
{
for (kn=jn+1;kn<in;kn++)
{
if (distance2(codebook[jn],codebook[kn],ndim)==0)
{
for (i=kn;i<in-1;i++)
for (k=0;k<ndim;k++) codebook[i][k]=codebook[i+1][k];
in--;
}
}
}
break;
}
}
free_fmatrix(buf,N);
free (d);
free (index2);
free(variance);
free(totalw);
return in;
}
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 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);
}
/*************************************************************************
Weighted fitting by Chebyshev polynomial in barycentric form, with
constraints on function values or first derivatives.
Small regularizing term is used when solving constrained tasks (to improve
stability).
Task is linear, so linear least squares solver is used. Complexity of this
computational scheme is O(N*M^2), mostly dominated by least squares solver
SEE ALSO:
PolynomialFit()
INPUT PARAMETERS:
X - points, array[0..N-1].
Y - function values, array[0..N-1].
W - weights, array[0..N-1]
Each summand in square sum of approximation deviations from
given values is multiplied by the square of corresponding
weight. Fill it by 1's if you don't want to solve weighted
task.
N - number of points, N>0.
XC - points where polynomial values/derivatives are constrained,
array[0..K-1].
YC - values of constraints, array[0..K-1]
DC - array[0..K-1], types of constraints:
* DC[i]=0 means that P(XC[i])=YC[i]
* DC[i]=1 means that P'(XC[i])=YC[i]
SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS
K - number of constraints, 0<=K<M.
K=0 means no constraints (XC/YC/DC are not used in such cases)
M - number of basis functions (= polynomial_degree + 1), M>=1
OUTPUT PARAMETERS:
Info- same format as in LSFitLinearW() subroutine:
* Info>0 task is solved
* Info<=0 an error occured:
-4 means inconvergence of internal SVD
-3 means inconsistent constraints
-1 means another errors in parameters passed
(N<=0, for example)
P - interpolant in barycentric form.
Rep - report, same format as in LSFitLinearW() subroutine.
Following fields are set:
* RMSError rms error on the (X,Y).
* AvgError average error on the (X,Y).
* AvgRelError average relative error on the non-zero Y
* MaxError maximum error
NON-WEIGHTED ERRORS ARE CALCULATED
IMPORTANT:
this subroitine doesn't calculate task's condition number for K<>0.
SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES:
Setting constraints can lead to undesired results, like ill-conditioned
behavior, or inconsistency being detected. From the other side, it allows
us to improve quality of the fit. Here we summarize our experience with
constrained regression splines:
* even simple constraints can be inconsistent, see Wikipedia article on
this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation
* the greater is M (given fixed constraints), the more chances that
constraints will be consistent
* in the general case, consistency of constraints is NOT GUARANTEED.
* in the one special cases, however, we can guarantee consistency. This
case is: M>1 and constraints on the function values (NOT DERIVATIVES)
Our final recommendation is to use constraints WHEN AND ONLY when you
can't solve your task without them. Anything beyond special cases given
above is not guaranteed and may result in inconsistency.
-- ALGLIB PROJECT --
Copyright 10.12.2009 by Bochkanov Sergey
*************************************************************************/
void polynomialfitwc(ap::real_1d_array x,
ap::real_1d_array y,
const ap::real_1d_array& w,
int n,
ap::real_1d_array xc,
ap::real_1d_array yc,
const ap::integer_1d_array& dc,
int k,
int m,
int& info,
barycentricinterpolant& p,
polynomialfitreport& rep)
{
double xa;
double xb;
double sa;
double sb;
ap::real_1d_array xoriginal;
ap::real_1d_array yoriginal;
ap::real_1d_array y2;
ap::real_1d_array w2;
ap::real_1d_array tmp;
ap::real_1d_array tmp2;
ap::real_1d_array tmpdiff;
ap::real_1d_array bx;
ap::real_1d_array by;
ap::real_1d_array bw;
ap::real_2d_array fmatrix;
ap::real_2d_array cmatrix;
int i;
int j;
double mx;
double decay;
double u;
double v;
double s;
int relcnt;
lsfitreport lrep;
if( m<1||n<1||k<0||k>=m )
{
info = -1;
return;
}
for(i = 0; i <= k-1; i++)
{
info = 0;
if( dc(i)<0 )
{
info = -1;
}
if( dc(i)>1 )
{
info = -1;
}
if( info<0 )
{
return;
}
}
//
// weight decay for correct handling of task which becomes
// degenerate after constraints are applied
//
decay = 10000*ap::machineepsilon;
//
// Scale X, Y, XC, YC
//
lsfitscalexy(x, y, n, xc, yc, dc, k, xa, xb, sa, sb, xoriginal, yoriginal);
//
// allocate space, initialize/fill:
// * FMatrix- values of basis functions at X[]
// * CMatrix- values (derivatives) of basis functions at XC[]
// * fill constraints matrix
// * fill first N rows of design matrix with values
// * fill next M rows of design matrix with regularizing term
// * append M zeros to Y
// * append M elements, mean(abs(W)) each, to W
//
y2.setlength(n+m);
w2.setlength(n+m);
tmp.setlength(m);
tmpdiff.setlength(m);
fmatrix.setlength(n+m, m);
if( k>0 )
{
cmatrix.setlength(k, m+1);
}
//
// Fill design matrix, Y2, W2:
// * first N rows with basis functions for original points
// * next M rows with decay terms
//
for(i = 0; i <= n-1; i++)
{
//
// prepare Ith row
// use Tmp for calculations to avoid multidimensional arrays overhead
//
for(j = 0; j <= m-1; j++)
{
if( j==0 )
{
tmp(j) = 1;
}
else
{
if( j==1 )
{
tmp(j) = x(i);
}
else
{
tmp(j) = 2*x(i)*tmp(j-1)-tmp(j-2);
}
}
}
ap::vmove(&fmatrix(i, 0), &tmp(0), ap::vlen(0,m-1));
}
for(i = 0; i <= m-1; i++)
{
for(j = 0; j <= m-1; j++)
{
if( i==j )
{
fmatrix(n+i,j) = decay;
}
else
{
fmatrix(n+i,j) = 0;
}
}
}
ap::vmove(&y2(0), &y(0), ap::vlen(0,n-1));
ap::vmove(&w2(0), &w(0), ap::vlen(0,n-1));
mx = 0;
for(i = 0; i <= n-1; i++)
{
mx = mx+fabs(w(i));
}
mx = mx/n;
for(i = 0; i <= m-1; i++)
{
y2(n+i) = 0;
w2(n+i) = mx;
}
//
// fill constraints matrix
//
for(i = 0; i <= k-1; i++)
{
//
// prepare Ith row
// use Tmp for basis function values,
// TmpDiff for basos function derivatives
//
for(j = 0; j <= m-1; j++)
{
if( j==0 )
{
tmp(j) = 1;
tmpdiff(j) = 0;
}
else
{
if( j==1 )
{
tmp(j) = xc(i);
tmpdiff(j) = 1;
}
else
{
tmp(j) = 2*xc(i)*tmp(j-1)-tmp(j-2);
tmpdiff(j) = 2*(tmp(j-1)+xc(i)*tmpdiff(j-1))-tmpdiff(j-2);
}
}
}
if( dc(i)==0 )
{
ap::vmove(&cmatrix(i, 0), &tmp(0), ap::vlen(0,m-1));
}
if( dc(i)==1 )
{
ap::vmove(&cmatrix(i, 0), &tmpdiff(0), ap::vlen(0,m-1));
}
cmatrix(i,m) = yc(i);
}
//
// Solve constrained task
//
if( k>0 )
{
//
// solve using regularization
//
lsfitlinearwc(y2, w2, fmatrix, cmatrix, n+m, m, k, info, tmp, lrep);
}
else
{
//
// no constraints, no regularization needed
//
lsfitlinearwc(y, w, fmatrix, cmatrix, n, m, 0, info, tmp, lrep);
}
if( info<0 )
{
return;
}
//
// Generate barycentric model and scale it
// * BX, BY store barycentric model nodes
// * FMatrix is reused (remember - it is at least MxM, what we need)
//
// Model intialization is done in O(M^2). In principle, it can be
// done in O(M*log(M)), but before it we solved task with O(N*M^2)
// complexity, so it is only a small amount of total time spent.
//
bx.setlength(m);
by.setlength(m);
bw.setlength(m);
tmp2.setlength(m);
s = 1;
for(i = 0; i <= m-1; i++)
{
if( m!=1 )
{
u = cos(ap::pi()*i/(m-1));
}
else
{
u = 0;
}
v = 0;
for(j = 0; j <= m-1; j++)
{
if( j==0 )
{
tmp2(j) = 1;
}
else
{
if( j==1 )
{
tmp2(j) = u;
}
else
{
tmp2(j) = 2*u*tmp2(j-1)-tmp2(j-2);
}
}
v = v+tmp(j)*tmp2(j);
}
bx(i) = u;
by(i) = v;
bw(i) = s;
if( i==0||i==m-1 )
{
bw(i) = 0.5*bw(i);
}
s = -s;
}
barycentricbuildxyw(bx, by, bw, m, p);
barycentriclintransx(p, 2/(xb-xa), -(xa+xb)/(xb-xa));
barycentriclintransy(p, sb-sa, sa);
//
// Scale absolute errors obtained from LSFitLinearW.
// Relative error should be calculated separately
// (because of shifting/scaling of the task)
//
rep.taskrcond = lrep.taskrcond;
rep.rmserror = lrep.rmserror*(sb-sa);
rep.avgerror = lrep.avgerror*(sb-sa);
rep.maxerror = lrep.maxerror*(sb-sa);
rep.avgrelerror = 0;
relcnt = 0;
for(i = 0; i <= n-1; i++)
{
if( ap::fp_neq(yoriginal(i),0) )
{
rep.avgrelerror = rep.avgrelerror+fabs(barycentriccalc(p, xoriginal(i))-yoriginal(i))/fabs(yoriginal(i));
relcnt = relcnt+1;
}
}
if( relcnt!=0 )
{
rep.avgrelerror = rep.avgrelerror/relcnt;
}
}
void Renderer::set_light(Vec3f light) {
fmatrix lm = fmatrix(light, 0)*_Projection * _Viewport;
light_dir = Vec3f(lm[0][0], lm[0][1], lm[0][2]).normalize(); //no need to divide by lm[0][3], normalizing anyway
}
Vec3i Renderer::vertex_shader(Model &model, int ivert) {
fmatrix v = fmatrix(model.vert(ivert), 1.) * ModelViewProjectionViewportMatrix;
return Vec3i(v[0][0]/v[0][3], v[0][1]/v[0][3], v[0][2]/v[0][3]);
}
Matrix * Pose::point4D(float x, float y, float z, float w ){
Matrix * p = fmatrix(4,1);
float pContents[] = {x,y,z,w};
memcpy(p->data,pContents, 4*sizeof(float));
return p;
}
Matrix * Pose::point3D(float x, float y, float z){
Matrix * p = fmatrix(3,1);
float pContents[] = {x,y,z};
memcpy(p->data,pContents, 3*sizeof(float));
return p;
}
