float modeling()
{
/* declaration of variables */
FILE *fp; /* to report results */
int iF, iF1, iR, offset, iT1, iT2, iS, iProc, i, k;
/* counters */
int wL; /* window length */
int die; /* die processor flag */
int FReceived; /* number of frequencies processed */
int apl_pid; /* PVM process id control */
int pid; /* process id */
int processControl; /* monitoring PVM start */
int FInfo[2]; /* frequency delimiters */
float wallcpu; /* wall clock time */
float oF; /* value of the objective function */
float residue; /* data residue */
float wdw; /* windowing purposes */
float *buffer, *bufferRCD; /* auxiliary buffers */
/* upgoing waves */
complex **dataS; /* synthethics in the frequency domain */
complex *bufferC; /* auxiliary buffer */
complex **freqPart; /* frequency arrays sent by the slaves */
/* Clean up log files */
CleanLog();
/* Reseting synchronization flags */
for (i = 0; i < nFreqPart; i++)
{
statusFreq[i][2] = 0;
}
/* allocating some memory */
dataS = alloc2complex(info->nF, info->nR);
buffer = alloc1float(info->nSamples);
bufferRCD = alloc1float(info->nSamples);
bufferC = alloc1complex(info->nSamples / 2 + 1);
freqPart = alloc2complex(info->nFreqProc, info->nR);
/* reseting */
for (iF = 0; iF < info->nSamples / 2 + 1; iF++)
bufferC[iF] = zeroC;
for (iS = 0; iS < info->nSamples; iS++)
{
buffer[iS] = 0; bufferRCD[iS] = 0;
}
/* DD
fprintf(stderr, "nF -> %d\n", info->nF);*/
fprintf(stderr, "Starting communication with PVM for modeling\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
pvm_perror("Error enrolling master process");
exit(-1);
}
processControl = CreateSlaves(processes, PROCESS_MODELING, nProc);
if (processControl != nProc)
{
fprintf(stderr,"Problem starting PVM daemons\n");
exit(-1);
}
/* converting to velocities */
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] /= rho[i];
beta[i] /= rho[i];
}
}
/* Broadcasting all processes common information */
BroadINFO(info, 1, processes, nProc, GENERAL_INFORMATION);
/* sending all profiles */
BroadFloat(thick, info->nL + 1, processes, nProc, THICKNESS);
BroadFloat(rho, info->nL + 1, processes, nProc, DENSITY);
BroadFloat(alpha, info->nL + 1, processes, nProc, ALPHAS);
BroadFloat(qP, info->nL + 1, processes, nProc, QALPHA);
BroadFloat(beta, info->nL + 1, processes, nProc, BETAS);
BroadFloat(qS, info->nL + 1, processes, nProc, QBETA);
/* sending frequency partitions for each process */
for (iProc = 0; iProc < nProc; iProc++)
{
FInfo[0] = statusFreq[iProc][0];
FInfo[1] = statusFreq[iProc][1];
if (info->verbose)
fprintf(stderr,
"Master sending frequencies [%d, %d] out of %d to slave Modeling %d [id:%d]\n", FInfo[0], FInfo[1], info->nF, iProc, processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[iProc][2] = 1;
}
/* waiting modelled frequencies */
/* master process will send more frequencies if there's more work to do */
/* measuring elapsed time */
wallcpu = walltime();
/* reseting frequency counter */
FReceived = 0;
while (FOREVER)
{
pid = RecvCplx(freqPart[0], info->nR * info->nFreqProc, -1,
FREQUENCY_PARTITION);
/* finding the frequency limits of this process */
/* DD
fprintf(stderr, "Master finding the frequency limits of this process\n");
*/
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* DD
fprintf(stderr, "iProc %d pid %d\n", iProc, pid);*/
/* copying into proper place of the total frequency array */
for (iR = 0; iR < info->nR; iR++)
{
for (k = 0, i = procInfo[iProc][0]; i <= procInfo[iProc][1]; i++, k++)
{
dataS[iR][i - initF] = freqPart[iR][k];
}
}
/* summing frequencies that are done */
FReceived += procInfo[iProc][1] - procInfo[iProc][0] + 1;
if (info->verbose)
fprintf(stderr, "Master received %d frequencies, remaining %d\n",
FReceived, info->nF - FReceived);
/* defining new frequency limits */
i = 0;
while (i < nFreqPart && statusFreq[i][2])
i++;
/* DD
fprintf(stderr, "i %d nFreqPart %d\n", i, nFreqPart);*/
if (i < nFreqPart)
{
/* there is still more work to be done */
/* tell this process to not die */
die = 0;
SendInt(&die, 1, processes[iProc], DIE);
FInfo[0] = statusFreq[i][0];
FInfo[1] = statusFreq[i][1];
if (info->verbose)
fprintf(stderr, "Master sending frequencies [%d, %d] to slave %d\n", FInfo[0], FInfo[1], processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[i][2] = 1;
}
else
{
/* tell this process to die since there is no more work to do */
if (info->verbose)
fprintf(stderr, "Master ''killing'' slave %d\n", processes[iProc]);
die = 1;
SendInt(&die, 1, processes[iProc], DIE);
}
/* a check to get out the loop */
if (FReceived >= info->nF) break;
}
/* quitting PVM */
EndOfMaster();
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Modeling wall clock time = %f seconds\n",
wallcpu);
/* back to impedances*/
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] *= rho[i];
beta[i] *= rho[i];
}
}
/* computing the objective function for the time window */
for (oF = 0, residue = 0, iR = 0; iR < info->nR; iR++)
{
/* windowing as it was done to the input data */
iT1 = NINT(info->f1 / info->dF);
iT2 = NINT(info->f2 / info->dF);
wL = info->nF * PERC_WINDOW / 2;
wL = 2 * wL + 1;
for (iS = 0, iF = 0; iF < info->nSamples / 2 + 1; iF++)
{
if (iF < iT1 || iF >= iT2)
{
bufferC[iF] = cmplx(0, 0);
}
else if (iF - iT1 < (wL - 1) / 2)
{
wdw = .42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r = dataS[iR][iF - iT1].r * wdw;
bufferC[iF].i = dataS[iR][iF - iT1].i * wdw;
iS++;
}
else if (iF - iT1 >= info->nF - (wL - 1) / 2)
{
iS++;
wdw = .42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferC[iF].r = dataS[iR][iF - iT1].r * wdw;
bufferC[iF].i = dataS[iR][iF - iT1].i * wdw;
}
else
{
bufferC[iF] = dataS[iR][iF - iT1];
}
}
/* going to time domain */
/* DD
fprintf(stderr, "going to time domain \n");*/
pfacr(1, info->nSamples, bufferC, buffer);
/* muting ? */
if (MUTE)
{
for (iS = 0; iS <= NINT(t1Mute[iR] / dt); iS++)
{
buffer[iS] = 0;
}
}
/* and computing data misfit and likelihood function */
iS = NINT(t1 / dt);
for (iT1 = 0; iT1 < nDM; iT1++)
{
bufferRCD[iT1 + iS] = 0;
for (offset = iT1, iT2 = 0; iT2 < nDM; iT2++)
{
bufferRCD[iT1 + iS] +=
(buffer[iT2 + iS] - dataObs[iR][iT2]) * CD[offset];
offset += MAX(SGN0(iT1 - iT2) * (nDM - 1 - iT2), 1);
}
oF += (buffer[iT1 + iS] - dataObs[iR][iT1]) * bufferRCD[iT1 + iS];
residue += (buffer[iT1 + iS] - dataObs[iR][iT1]) *
(buffer[iT1 + iS] - dataObs[iR][iT1]);
/* DD
fprintf(stdout, "%d %f %f %f %f %f %d %f %f\n",
nTotalSamples, oF, dt, auxm1,
info->tau, residue, iT1, buffer[iT1],
dataObs[iR][iT1 - NINT(t1 / dt)]); */
}
/* windowing bufferRCD */
iT1 = NINT(t1 / dt);
iT2 = NINT(t2 / dt);
wL = nDM * PERC_WINDOW / 2;
wL = 2 * wL + 1;
for (iS = 0, iF = 0; iF < info->nSamples; iF++)
{
if (iF < iT1 || iF >= iT2)
{
bufferRCD[iF] = 0;
}
else if (iF - iT1 < (wL - 1) / 2)
{
wdw =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferRCD[iF] *= wdw;
iS++;
}
else if (iF - iT1 >= nDM - (wL - 1) / 2)
{
iS++;
wdw =
.42 - .5 * cos(2 * PI * (float) iS / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) iS / ((float) (wL - 1)));
bufferRCD[iF] *= wdw;
}
}
/* going back to Fourier domain */
pfarc(-1, info->nSamples, bufferRCD, bufferC);
for (iF1 = 0, iF = NINT(info->f1 / info->dF);
iF <= NINT(info->f2 / info->dF); iF++, iF1++)
{
resCD[iR][iF1] = bufferC[iF];
}
}
/* considering the .5 factor of the exponent of the Gaussian */
/* and normalizing the likelihood by the number of samples */
oF /= (2 * nTotalSamples);
/* freeing some memory */
/* allocating some memory */
free2complex(dataS);
free1float(buffer);
free1float(bufferRCD);
free1complex(bufferC);
free2complex(freqPart);
/* considering the regularizaton or model covariance term */
if (PRIOR)
{
auxm1 = 1. / (float) (numberPar * limRange); /* normalization */
for (auxm2 = 0, iF = 0; iF < limRange; iF++)
{
for (offset = iF, iF1 = 0; iF1 < limRange; iF1++)
{
if (vpFrechet)
{
auxm2 += (alpha[iF + lim[0]] - alphaMean[iF + lim[0]]) *
CMvP[offset] * auxm1 *
(alpha[iF1 + lim[0]] - alphaMean[iF1 + lim[0]]);
}
if (vsFrechet)
{
auxm2 += (beta[iF + lim[0]] - betaMean[iF + lim[0]]) *
CMvS[offset] * auxm1 *
(beta[iF1 + lim[0]] - betaMean[iF1 + lim[0]]);
}
if (rhoFrechet)
{
auxm2 += (rho[iF + lim[0]] - rhoMean[iF + lim[0]]) *
CMrho[offset] * auxm1 *
(rho[iF1 + lim[0]] - rhoMean[iF1 + lim[0]]);
}
offset += MAX(SGN0(iF - iF1) * (limRange - 1 - iF1), 1);
}
}
}
/* getting normalization factor */
fp = fopen("report", "a");
fprintf(fp,"-----------------------\n");
if (modCount == 0)
{
oFNorm = oF;
fprintf(fp,">> Normalization constant for objective function: %f <<\n",
oFNorm);
}
/* normalizing residue */
residue /= (nTotalSamples);
if (!DATACOV && noiseVar == 0) noiseVar = residue / 10.;
if (PRIOR)
{
fprintf(fp,
"residue at iteration [%d] : Data residue variance %f , Noise variance %f , Likelihood %f , Prior %f\n",
modCount, residue, noiseVar, oF / oFNorm, auxm2 / oFNorm);
}
else
{
fprintf(fp,"residue at iteration [%d] : Data residue variance %f , Noise variance %f , Likelihood %f , No Prior\n", modCount, residue, noiseVar, oF / oFNorm);
}
/* checking if we reached noise variance with the data residue */
if (residue / noiseVar <= 1)
{
/* DATA IS FIT, stop the procedure */
fprintf(fp, "[][][][][][][][][][][][][][][][][][][][]\n");
fprintf(fp, "DATA WAS FIT UP TO 1 VARIANCE!\n");
fprintf(fp, "[][][][][][][][][][][][][][][][][][][][]\n");
exit(0);
}
/* adding Likelihood and Prior */
if (PRIOR) oF += auxm2 / 2;
fprintf(fp,"TOTAL residue at iteration [%d] : %f\n",
modCount, oF / oFNorm);
fprintf(fp,"-----------------------\n");
fclose(fp);
/* returning objective function value */
return(oF / oFNorm);
}
void gradient(float *grad)
{
/* declaration of variables */
int i, iF, iR, iProc, iDer, iL, iU, offset;
/* counters */
int FReceived; /* number of frequencies processed */
int die; /* die processor flag */
int apl_pid; /* PVM process id control */
int pid; /* process id */
int masterId; /* master id */
int processControl; /* monitoring PVM start */
int FInfo[2]; /* frequency delimiters */
float wallcpu; /* wall clock time */
float *gradPart; /* partition of gradients */
complex **resCDPart; /* partition of resCD */
/* Clean up log files */
CleanLog();
/* Reseting synchronization flags */
for (i = 0; i < nFreqPart; i++)
{
statusFreq[i][2] = 0;
}
/* allocating some memory */
gradPart = alloc1float(numberPar * limRange);
for (i = 0; i < numberPar * limRange; i++)
{
grad[i] = 0;
}
fprintf(stderr, "Starting communication with PVM for derivatives\n");
/* starting communication with PVM */
if ((apl_pid = pvm_mytid()) < 0)
{
pvm_perror("Error enrolling master process");
exit(-1);
}
processControl = CreateSlaves(processes, PROCESS_FRECHET, nProc);
if (processControl != nProc)
{
fprintf(stderr,"Problem starting PVM daemons\n");
exit(-1);
}
/* converting to velocities */
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] /= rho[i];
beta[i] /= rho[i];
}
}
/* Broadcasting all processes common information */
BroadINFO(info, 1, processes, nProc, GENERAL_INFORMATION);
/* sending all profiles */
BroadFloat(thick, info->nL + 1, processes, nProc, THICKNESS);
BroadFloat(rho, info->nL + 1, processes, nProc, DENSITY);
BroadFloat(alpha, info->nL + 1, processes, nProc, ALPHAS);
BroadFloat(qP, info->nL + 1, processes, nProc, QALPHA);
BroadFloat(beta, info->nL + 1, processes, nProc, BETAS);
BroadFloat(qS, info->nL + 1, processes, nProc, QBETA);
/* sending frequency partitions for each process */
for (iProc = 0; iProc < nProc; iProc++)
{
FInfo[0] = statusFreq[iProc][0];
FInfo[1] = statusFreq[iProc][1];
if (info->verbose)
fprintf(stderr,
"Master sending frequencies [%d, %d] out of %d to slave Frechet %d [id:%d]\n", FInfo[0], FInfo[1], info->nF, iProc, processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[iProc][2] = 1;
/* and sending the appropriate correlation chunk */
/* allocating some memory */
resCDPart = alloc2complex(FInfo[1] - FInfo[0] + 1, info->nR);
for (iR = 0; iR < info->nR; iR++)
{
for (i = 0, iF = FInfo[0]; iF <= FInfo[1]; iF++, i++)
{
resCDPart[iR][i] = resCD[iR][iF - initF];
/* fprintf(stderr, "iR %d iF %d [%f %f]\n",
iR, iF, resCDPart[iR][i].r, resCDPart[iR][i].i);*/
}
}
/* sending frequency partition to the slave process */
SendCplx(resCDPart[0], (FInfo[1] - FInfo[0] + 1) * info->nR,
processes[iProc], COVARIANCE_PARTITION);
free2complex(resCDPart);
}
/* waiting modelled frequencies */
/* master process will send more frequencies if there's more work to do */
/* measuring elapsed time */
wallcpu = walltime();
/* reseting frequency counter */
FReceived = 0;
while (FOREVER)
{
pid = RecvFloat(gradPart, info->numberPar * info->limRange, -1,
PARTIAL_GRADIENT);
/* finding the frequency limits of this process */
/* DD
fprintf(stderr, "Master finding the frequency limits of this process\n");
*/
iProc = 0;
while (pid != processes[iProc])
iProc++;
/* stacking gradient */
for (i = 0; i < info->numberPar * info->limRange; i++)
{
grad[i] += gradPart[i];
/* DD
fprintf(stderr, "i %d grad %f gradPart %f\n", i, grad[i], gradPart[i]);*/
}
/* summing frequencies that are done */
FReceived += procInfo[iProc][1] - procInfo[iProc][0] + 1;
if (info->verbose)
fprintf(stderr, "Master received %d frequencies, remaining %d\n",
FReceived, info->nF - FReceived);
/* defining new frequency limits */
i = 0;
while (i < nFreqPart && statusFreq[i][2])
i++;
/* DD
fprintf(stderr, "i %d nFreqPart %d\n", i, nFreqPart);*/
if (i < nFreqPart)
{
/* there is still more work to be done */
/* tell this process to not die */
die = 0;
SendInt(&die, 1, processes[iProc], DIE);
FInfo[0] = statusFreq[i][0];
FInfo[1] = statusFreq[i][1];
if (info->verbose)
fprintf(stderr,
"Master sending frequencies [%d, %d] to slave %d\n",
FInfo[0], FInfo[1], processes[iProc]);
procInfo[iProc][0] = FInfo[0];
procInfo[iProc][1] = FInfo[1];
SendInt(FInfo, 2, processes[iProc], FREQUENCY_LIMITS);
statusFreq[i][2] = 1;
/* sending covariance partition */
/* allocating some memory */
resCDPart = alloc2complex(FInfo[1] - FInfo[0] + 1, info->nR);
for (iR = 0; iR < info->nR; iR++)
{
for (i = 0, iF = FInfo[0]; iF <= FInfo[1]; iF++, i++)
{
resCDPart[iR][i] = resCD[iR][iF - initF];
}
}
/* sending frequency partition to the slave process */
SendCplx(resCDPart[0], (FInfo[1] - FInfo[0] + 1) * info->nR,
processes[iProc], COVARIANCE_PARTITION);
free2complex(resCDPart);
}
else
{
/* tell this process to die since there is no more work to do */
if (info->verbose)
fprintf(stderr, "Master ''killing'' slave %d\n", processes[iProc]);
die = 1;
SendInt(&die, 1, processes[iProc], DIE);
}
/* a check to get out the loop */
if (FReceived >= info->nF) break;
}
/* getting elapsed time */
wallcpu = walltime() - wallcpu;
fprintf(stderr, "Frechet derivative wall clock time = %f seconds\n\n",
wallcpu);
/* back to impedances*/
if (IMPEDANCE)
{
for (i = 0; i < info->nL + 1; i++)
{
alpha[i] *= rho[i];
beta[i] *= rho[i];
}
}
/* finally the gradient, the 2 is due Parseval */
for (iDer = 0; iDer < numberPar * limRange; iDer++)
{
grad[iDer] *= 2 / (float) (nTotalSamples * oFNorm);
}
/* getting gradient in impedance domain */
if (IMPEDANCE)
{
offset = 0;
for (i = lim[0], iL = 0; iL < limRange; iL++, i++)
{
if (vpFrechet)
{
grad[iL] /= rho[i];
offset = limRange;
}
if (vsFrechet)
{
grad[iL + offset] /= rho[i];
offset += limRange;
}
if (rhoFrechet)
{
grad[iL + offset] = - alpha[i] * grad[iL] -
beta[i] * grad[iL + limRange] + grad[iL + 2 * limRange];
}
}
}
if (PRIOR)
{
auxm1 = 1. / (float) (numberPar * limRange); /* normalization */
/* considering the regularization or model covariance term */
for (i = 0; i < limRange; i++)
{
for (offset = i, iL = 0; iL < limRange; iL++)
{
iU = 0;
if (vpFrechet)
{
grad[iL] += (alpha[i + lim[0]] - alphaMean[i + lim[0]]) *
CMvP[offset] * auxm1;
iU = limRange; /* used as offset in gradient vector */
}
if (vsFrechet)
{
grad[iL + iU] += (beta[i + lim[0]] - betaMean[i + lim[0]]) *
CMvS[offset] * auxm1;
iU += limRange;
}
if (rhoFrechet)
{
grad[iL + iU] += (rho[i + lim[0]] - rhoMean[i + lim[0]]) *
CMrho[offset] * auxm1;
}
offset += MAX(SGN0(i - iL) * (limRange - 1 - iL), 1);
}
}
}
/* normalizing gradient
normalize(grad, numberPar * limRange);*/
/* freeing memory */
free1float(gradPart);
}
/************************ end self doc ***********************************/
void main (int argc, char **argv)
{
/* declaration of variables */
FILE *fp, *gp; /* file pointers */
char *orientation = " "; /* orientation of recordings */
char *recFile = " "; /* receiver location file */
char *postFile = " "; /* posteriori file */
char *modelFile = " "; /* elastic model file */
char *corrDataFile = " "; /* data covariance file */
char *corrModelFile[3]; /* model covariance file */
char *frechetFile = " "; /* frechet derivative file */
int verbose; /* verbose flag */
int noFrechet; /* if 1 don't store Frechet derivatives */
int i, j, k, iU, iParam, offset, iR, shift;
/* counters */
int wL; /* taper length */
int nParam; /* number of parameters altogether */
int numberParImp; /* number of distinct parameters in */
/* impedance inversion */
float dZ; /* layer thickness within target zone */
float F1, F2, F3; /* source components */
float depth; /* current depth used in defining limits */
/* for Frechet derivatives */
float fR; /* reference frequency */
float percU; /* amount of slowness windowing */
float percW; /* amount of frequency windowing */
float limZ[2]; /* target interval (Km) */
float tMod; /* maximum modeling time */
float phi; /* azimuth angle */
float *buffer1, *buffer2; /* auxiliary buffers */
float **CmPost; /* posteriori model covariance */
float **CmPostInv; /* posteriori model covariance - inverse */
/* allocing for orientation */
orientation = malloc(1);
/* complex Zero */
zeroC = cmplx(0, 0);
/* getting input parameters */
initargs(argc, argv);
requestdoc(0);
/* seismic data and model parameters */
if (!getparstring("model", &modelFile)) modelFile = "model";
if (!getparstring("postfile", &postFile)) postFile = "posteriori";
if (!getparstring("corrData", &corrDataFile)) corrDataFile = "corrdata";
if (!getparint("impedance", &IMPEDANCE)) IMPEDANCE = 0;
if (!getparstring("frechetfile", &frechetFile)) noFrechet = 0;
else noFrechet = 1;
if (!getparint("prior", &PRIOR)) PRIOR = 1;
if (IMPEDANCE)
{
if (!getparint("p", &ipFrechet)) vpFrechet = 1;
if (!getparint("s", &isFrechet)) vsFrechet = 1;
if (!getparint("r", &rhoFrechet)) rhoFrechet = 1;
}
else
{
if (!getparint("p", &vpFrechet)) vpFrechet = 1;
if (!getparint("s", &vsFrechet)) vsFrechet = 1;
if (!getparint("rho", &rhoFrechet)) rhoFrechet = 1;
}
/* a couple of things to use later in chain rule */
if (!IMPEDANCE)
{
ipFrechet = 0; isFrechet = 0;
}
else
{
if (ipFrechet && !isFrechet)
{
vpFrechet = 1; vsFrechet = 0;
}
if (!ipFrechet && isFrechet)
{
vpFrechet = 0; vsFrechet = 1;
}
if (!ipFrechet && !isFrechet)
{
vpFrechet = 0; vsFrechet = 0;
}
if (ipFrechet && isFrechet)
{
vpFrechet = 1; vsFrechet = 1;
}
if (rhoFrechet)
{
vpFrechet = 1; vsFrechet = 1; rhoFrechet = 1;
}
}
if (!ipFrechet && ! isFrechet && !rhoFrechet && !vpFrechet && !vsFrechet)
err("No inverse unknowns to work with!\n");
numberPar = vpFrechet + vsFrechet + rhoFrechet;
numberParImp = ipFrechet + isFrechet + rhoFrechet;
if (PRIOR)
{
if (vpFrechet || ipFrechet)
{
if (!getparstring("corrP", &corrModelFile[0]))
corrModelFile[0] = "covP";
}
if (vsFrechet || isFrechet)
{
if (!getparstring("corrS", &corrModelFile[1]))
corrModelFile[1] = "covS";
}
if (rhoFrechet)
{
if (!getparstring("corrR", &corrModelFile[2]))
corrModelFile[2] = "covR";
}
}
if (!getparstring("orientation", &orientation)) orientation[0] = 'Z';
if (orientation[0] == 'z' || orientation[0] == 'Z')
{
VERTICAL = 1; RADIAL = 0;
}
else
{
VERTICAL = 0; RADIAL = 1;
}
if (!getparfloat("dz", &dZ)) dZ = .5;
if (!getparfloat("targetbeg", &limZ[0])) limZ[0] = 0.5;
if (!getparfloat("targetend", &limZ[1])) limZ[1] = 1.0;
/* geometry */
if (!getparfloat("r1", &r1)) r1 = 0.25;
if (!getparint("nr", &nR)) nR = 48;
if (!getparfloat("dr", &dR)) dR = .025;
if (!getparfloat("zs", &zs)) zs = .001;
if (!getparfloat("F1", &F1)) F1 = 0;
if (!getparfloat("F2", &F2)) F2 = 0;
if (!getparfloat("F3", &F3)) F3 = 1;
/* modeling */
if (!getparstring("receiverfile", &recFile)) recFile = " ";
if (!getparfloat("u1", &u1)) u1 = 0.0;
if (!getparfloat("u2", &u2)) u2 = 1.;
if (!getparint("directwave", &directWave)) directWave = 1;
if (!getparfloat("tau", &tau)) err("Specify tau!\n");
if (!getparint("nu", &nU)) nU = 1000;
if (!getparfloat("f1", &f1)) f1 = 2;
if (!getparfloat("f2", &f2)) f2 = 50;
if (!getparfloat("dt", &dt)) dt = 0.004;
if (!getparfloat("tmod", &tMod)) tMod = 8;
if (!getparfloat("t1", &t1)) t1 = 0;
if (!getparfloat("t2", &t2)) t2 = tMod;
if (!getparint("hanning", &hanningFlag)) hanningFlag = 1;
if (!getparfloat("wu", &percU)) percU = 10; percU /= 100;
if (!getparfloat("ww", &percW)) percW = 25; percW /= 100;
/* dialogue */
if (!getparint("verbose", &verbose)) verbose = 0;
/* checking number of receivers */
fp = fopen(recFile, "r");
if (fp != NULL)
{
nR = 0;
while (fscanf(fp, "%f\n", &auxm1) != EOF) nR++;
}
fclose(fp);
/* some hard-coded parameters */
fR = 1; wR = 2 * PI * fR; /* reference frequency */
/* how many layers */
fp = fopen(modelFile,"r");
if (fp == NULL)
err("No model file!\n");
nL = 0;
depth = 0;
while (fscanf(fp, "%f %f %f %f %f %f\n",
&aux, &aux, &aux, &aux, &aux, &aux) != EOF)
nL++;
nL--;
/* considering the unknown layers */
limRange = NINT((limZ[1] - limZ[0]) / dZ);
if (verbose)
{
fprintf(stderr,"Number of layers: %d\n", nL + 1);
fprintf(stderr,"Number of layers in target zone: %d\n", limRange);
}
if (IMPEDANCE)
{
nParam = numberParImp * limRange;
}
else
{
nParam = numberPar * limRange;
}
/* basic time-frequency stuff */
nSamples = NINT(tMod / dt) + 1;
nSamples = npfar(nSamples);
/* length of time misfit */
nDM = NINT((t2 - t1) / dt) + 1;
/* maximum time for modeling */
tMod = dt * (nSamples - 1);
dF = 1. / (tMod);
/* adjusting f1 and f2 */
aux = dF;
while (aux < f1)
aux += dF;
f1 = aux;
while (aux < f2)
aux += dF;
f2 = aux;
nF = NINT((f2 - f1) / dF);
if (nF%2 == 0)
{
f2 += dF;
nF++;
}
/* memory allocation */
alpha = alloc1float(nL + 1);
beta = alloc1float(nL + 1);
rho = alloc1float(nL + 1);
qP = alloc1float(nL + 1);
qS = alloc1float(nL + 1);
thick = alloc1float(nL + 1);
recArray = alloc1float(nR);
PSlowness = alloc2complex(2, nL + 1);
SSlowness = alloc2complex(2, nL + 1);
S2Velocity = alloc2complex(2, nL + 1);
CD = alloc1float(nDM * (nDM + 1) / 2);
if (PRIOR)
{
if(vpFrechet || ipFrechet)
CMP = alloc1float(limRange * (limRange + 1) / 2);
if(vsFrechet || isFrechet)
CMS = alloc1float(limRange * (limRange + 1) / 2);
if(rhoFrechet)
CMrho = alloc1float(limRange * (limRange + 1) / 2);
}
/* FRECHET derivative operator F */
F = alloc2float(nR * nDM, numberPar * limRange);
if (IMPEDANCE)
CmPostInv =
alloc2float(numberParImp * limRange, numberParImp * limRange);
else
CmPostInv = alloc2float(numberPar * limRange, numberPar * limRange);
v1 = alloc2complex(2, numberPar * limRange + 1);
v2 = alloc2complex(2, numberPar * limRange + 1);
DmB = alloc3complex(4, numberPar * (limRange + 2), nL);
derFactor = alloc2complex(2, nL + 1);
aux11 = alloc2complex(nR, numberPar * limRange);
aux12 = alloc2complex(nR, numberPar * limRange);
aux21 = alloc2complex(nR, numberPar * limRange);
aux22 = alloc2complex(nR, numberPar * limRange);
aux11Old = alloc2complex(nR, numberPar * limRange);
aux12Old = alloc2complex(nR, numberPar * limRange);
aux21Old = alloc2complex(nR, numberPar * limRange);
aux22Old = alloc2complex(nR, numberPar * limRange);
/* reading receiver configuration */
fp = fopen(recFile, "r");
if (fp == NULL)
{
/* standard end-on */
if (verbose) fprintf(stderr, "No receiver file available\n");
for (i = 0; i < nR; i++)
{
recArray[i] = r1 + i * dR;
}
}
else
{
if (verbose) fprintf(stderr, "Reading receiver file %s\n", recFile);
for (i = 0; i < nR; i++)
{
fscanf(fp, "%f\n", &recArray[i]);
}
}
fclose(fp);
/* reading the model file */
fp = fopen(modelFile,"r");
if (verbose)
fprintf(stderr," Thickness rho vP qP vS qS\n");
for (k = 0; k < nL + 1; k++)
{
fscanf(fp, "%f %f %f %f %f %f\n", &thick[k], &rho[k], &alpha[k],
&qP[k], &beta[k], &qS[k]);
if (verbose)
fprintf(stderr," %7.4f %4.3f %3.2f %5.1f %3.2f %5.1f\n",
thick[k], rho[k], alpha[k], qP[k], beta[k], qS[k]);
}
fclose(fp);
/* setting lim[0] and lim[1] */
for (depth = thick[0], i = 1; i <= nL; depth += thick[i], i++)
{
if (NINT(depth / dZ) <= NINT(limZ[0] / dZ)) lim[0] = i;
if (NINT(depth / dZ) < NINT(limZ[1] / dZ)) lim[1] = i;
}
lim[1]++;
/* some modeling parameters */
/* slowness increment */
dU = (u2 - u1) / (float) nU;
/* computing the window length for the slowness domain */
epslon1 = (u2 - u1) * percU;
wL = NINT(epslon1 / dU);
wL = 2 * wL + 1;
u2 += epslon1;
nU = NINT((u2 - u1) / dU); /* new nU to preserve last slowness */
/* w/o being windowed */
taper = alloc1float(nU);
/* building window for slowness integration */
for (i = (wL - 1) / 2, iU = 0; iU < nU; iU++)
{
taper[iU] = 1;
if (iU >= nU - (wL - 1) / 2)
{
i++;
taper[iU] =
.42 - .5 * cos(2 * PI * (float) i / ((float) (wL - 1))) +
.08 * cos(4 * PI * (float) i / ((float) (wL - 1)));
}
}
/* filtering in frequency domain */
filter(percW);
/* building frequency filtering */
/* I will assume that the receivers are in line (at z = 0) so phi = 0 */
phi = 0;
epslon1 = F3;
epslon2 = F1 * cos(phi) + F2 * sin(phi);
/* correction for the 1st layer */
thick[0] -= zs;
/* imaginary part of frequency for damping wrap-around */
tau = log(tau) / tMod;
if (tau > TAUMAX)
tau = TAUMAX;
/* normalization for the complex slowness */
if (f1 > 7.5)
wRef = f1 * 2 * PI;
else
wRef = 7.5 * 2 * PI;
/* reading data and model covariance matrixes */
inputCovar(corrDataFile, corrModelFile);
/* starting inverse procedure */
/* FRECHET derivative matrix */
gradient();
if (!noFrechet)
{
fp = fopen(frechetFile, "w");
for (i = 0; i < numberPar * limRange; i++)
{
fwrite(&F[i][0], sizeof(float), nR * nDM, fp);
}
fclose(fp);
}
/* building a-posteriori model covariance matrix */
/* prior information is used */
buffer1 = alloc1float(nDM);
buffer2 = alloc1float(nDM * nR);
if (verbose) fprintf(stderr, "Building posteriori covariance...\n");
for (iParam = 0; iParam < nParam; iParam++)
{
for (i = 0; i < nDM; i++)
{
for (offset = i, k = 0; k < nDM; k++)
{
buffer1[k] = CD[offset];
offset += MAX(SGN0(i - k) * (nDM - 1 - k), 1);
}
/* doing the product CD F */
for (iR = 0; iR < nR; iR++)
{
buffer2[iR * nDM + i] = 0;
for (k = 0; k < nDM; k++)
{
buffer2[iR * nDM + i] += buffer1[k] *
F[iParam][iR * nDM + k];
}
}
}
for (j = 0; j < nParam; j++)
{
CmPostInv[j][iParam] = 0;
for (k = 0; k < nDM * nR; k++)
{
CmPostInv[j][iParam] += buffer2[k] * F[j][k];
}
}
}
if (verbose)
fprintf(stderr, "Posteriori covariance built. Including prior...\n");
free1float(buffer1);
buffer1 = alloc1float(nParam);
/* including prior covariance matrix */
if (PRIOR)
{
shift = 0;
if (IMPEDANCE)
{
if (ipFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vpFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMP[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam][k] += buffer1[k];
}
}
shift += limRange;
}
}
if (IMPEDANCE)
{
if (isFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
else
{
if (vsFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMS[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
shift += limRange;
}
}
if (rhoFrechet)
{
for (iParam = 0; iParam < limRange; iParam++)
{
for (offset = iParam, k = 0; k < limRange; k++)
{
buffer1[k] = CMrho[offset];
offset += MAX(SGN0(iParam - k) * (limRange - 1 - k), 1);
}
for (k = 0; k < limRange; k++)
{
CmPostInv[iParam + shift][k + shift] += buffer1[k];
}
}
}
}
if (verbose) fprintf(stderr, "Prior included. Inverting matrix...\n");
/* freeing memory */
free1float(buffer1);
free1float(buffer2);
free1float(alpha);
free1float(beta);
free1float(rho);
free1float(qP);
free1float(qS);
free1float(thick);
free2complex(PSlowness);
free2complex(SSlowness);
free2complex(S2Velocity);
free1float(CD);
free1float(CMP);
free1float(CMS);
free1float(CMrho);
free2float(F);
free2complex(v1);
free2complex(v2);
free3complex(DmB);
free2complex(derFactor);
free2complex(aux11);
free2complex(aux12);
free2complex(aux21);
free2complex(aux22);
free2complex(aux11Old);
free2complex(aux12Old);
free2complex(aux21Old);
free2complex(aux22Old);
/* inverting the matrix */
CmPost = alloc2float(nParam, nParam);
for (i = 0; i < nParam; i++) for (j = 0; j < nParam; j++)
CmPostInv[i][j] = CmPost[i][j];
inverse_matrix(nParam, CmPostInv);
if (verbose) fprintf(stderr, "Done with inverse matrix routine.\n");
buffer1 = alloc1float(nParam);
gp = fopen(postFile, "w");
for (i = 0; i < nParam; i++)
{
fwrite(CmPostInv[i], sizeof(float), nParam, gp);
}
fclose(fp);
}
