void
time_marching_RK2_cavity
(
real * * const pu,
real * * const pv,
real * * const pp,
const real dt,
const Mesh & mesh
){
const real Re = 3200.0;
real * & u_0 = *pu;
real * & v_0 = *pv;
real * & p = *pp;
//--------------------------
// RK 1
//--------------------------
const real dt_1 = dt / 2.0;
real * u_1 = new real[mesh.size()];
real * v_1 = new real[mesh.size()];
calc_nu( u_1, u_0, v_0, p, dt_1, Re, u_0, mesh );
calc_nv( v_1, u_0, v_0, p, dt_1, Re, v_0, mesh );
boundary_update_u_v( u_1, v_1, mesh );
real * phi = new real[mesh.size()];
calc_phi( phi, u_1, v_1, dt_1, mesh );
correct_u_v_p( u_1, v_1, p, phi, dt_1, mesh );
boundary_update_u_v( u_1, v_1, mesh );
//--------------------------
// RK 2
//--------------------------
const real dt_2 = dt;
real * u_2 = new real[mesh.size()];
real * v_2 = new real[mesh.size()];
calc_nu( u_2, u_1, v_1, p, dt_2, Re, u_0, mesh );
calc_nv( v_2, u_1, v_1, p, dt_2, Re, v_0, mesh );
boundary_update_u_v( u_2, v_2, mesh );
calc_phi( phi, u_2, v_2, dt_2, mesh );
correct_u_v_p( u_2, v_2, p, phi, dt_2, mesh );
boundary_update_u_v( u_2, v_2, mesh );
delete[] u_0;
delete[] v_0;
delete[] u_1; u_1 = NULL;
delete[] v_1; v_1 = NULL;
delete[] phi; phi = NULL;
u_0 = u_2; u_2 = NULL;
v_0 = v_2; v_2 = NULL;
}
Iter
time_marching_RK1_cavity
(
real * const nu,
real * const nv,
real * const p,
const real * const u,
const real * const v,
const real dt,
const Mesh & mesh
){
const real Re = 1000.0;
//const real Re = 1.0;
calc_nu( nu, u, v, p, dt, Re, u, mesh );
calc_nv( nv, u, v, p, dt, Re, v, mesh );
boundary_update_u_v( nu, nv, mesh );
static int i = 0;
real * phi;
if ( i == 0 ) {
phi = new real[mesh.size()];
make_initial_value_0( phi, mesh );
i++;
}
calc_phi( phi, nu, nv, dt, mesh );
const Iter iter = calc_phi( phi, nu, nv, dt, 1.5, 10000, 1.0e-4, mesh );
correct_u_v_p( nu, nv, p, phi, dt, mesh );
//delete[] phi; phi = NULL;
boundary_update_u_v( nu, nv, mesh );
return iter;
}
/* compute function */
static int compute(void* km)
{
/* local variables */
intptr_t* pkim = *((intptr_t**) km);
double R;
double Rsqij;
double phi;
double dphi;
double dEidr = 0.0;
double Rij[DIM];
int ier;
int i;
int j;
int jj;
int k;
int numOfPartNeigh;
int currentPart;
int comp_energy;
int comp_force;
int comp_particleEnergy;
int comp_virial;
int IterOrLoca;
int HalfOrFull;
int NBC;
const char* NBCstr;
int numberContrib;
int* nParts;
int* particleSpecies;
double* Rij_list;
double* coords;
double* energy;
double* force;
double* particleEnergy;
double* virial;
int* neighListOfCurrentPart;
double* boxSideLengths;
int* numContrib;
/* Determine neighbor list boundary condition (NBC) */
/* and half versus full mode: */
/*****************************
* HalfOrFull = 1 -- Half
* = 2 -- Full
*****************************/
ier = KIM_API_get_NBC_method(pkim, &NBCstr);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_get_NBC_method", ier);
return ier;
}
if (!strcmp("NEIGH_RVEC_H",NBCstr))
{
NBC = 0;
HalfOrFull = 1;
}
else if (!strcmp("NEIGH_PURE_H",NBCstr))
{
NBC = 1;
HalfOrFull = 1;
}
else if (!strcmp("NEIGH_RVEC_F",NBCstr))
{
NBC = 0;
HalfOrFull = 2;
}
else if (!strcmp("NEIGH_PURE_F",NBCstr))
{
NBC = 1;
HalfOrFull = 2;
}
else if (!strcmp("MI_OPBC_H",NBCstr))
{
NBC = 2;
HalfOrFull = 1;
}
else if (!strcmp("MI_OPBC_F",NBCstr))
{
NBC = 2;
HalfOrFull = 2;
}
else if (!strcmp("CLUSTER",NBCstr))
{
NBC = 3;
HalfOrFull = 1;
}
else
{
ier = KIM_STATUS_FAIL;
KIM_API_report_error(__LINE__, __FILE__, "Unknown NBC method", ier);
return ier;
}
/* determine neighbor list handling mode */
if (NBC != 3)
{
/*****************************
* IterOrLoca = 1 -- Iterator
* = 2 -- Locator
*****************************/
IterOrLoca = KIM_API_get_neigh_mode(pkim, &ier);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_get_neigh_mode", ier);
return ier;
}
if ((IterOrLoca != 1) && (IterOrLoca != 2))
{
printf("* ERROR: Unsupported IterOrLoca mode = %i\n", IterOrLoca);
return KIM_STATUS_FAIL;
}
}
else
{
IterOrLoca = 2; /* for CLUSTER NBC */
}
/* check to see if we have been asked to compute the forces, particleEnergy, energy and virial */
KIM_API_getm_compute(pkim, &ier, 4*3,
"energy", &comp_energy, 1,
"forces", &comp_force, 1,
"particleEnergy", &comp_particleEnergy, 1,
"virial", &comp_virial, 1);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_getm_compute", ier);
return ier;
}
/* unpack data from KIM object */
KIM_API_getm_data(pkim, &ier, 9*3,
"numberOfParticles", &nParts, 1,
"particleSpecies", &particleSpecies,1,
"coordinates", &coords, 1,
"numberContributingParticles", &numContrib, (HalfOrFull==1),
"boxSideLengths", &boxSideLengths, (NBC==2),
"energy", &energy, (comp_energy==1),
"forces", &force, (comp_force==1),
"particleEnergy", &particleEnergy, (comp_particleEnergy==1),
"virial", &virial, (comp_virial==1));
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_getm_data", ier);
return ier;
}
if (HalfOrFull == 1)
{
if (3 != NBC) /* non-CLUSTER cases */
{
numberContrib = *numContrib;
}
else
{
numberContrib = *nParts;
}
}
else
{ /* provide initialization even if not used */
numberContrib = *nParts;
}
/* Check to be sure that the species are correct */
/**/
ier = KIM_STATUS_FAIL; /* assume an error */
for (i = 0; i < *nParts; ++i)
{
if ( SPECCODE != particleSpecies[i])
{
KIM_API_report_error(__LINE__, __FILE__, "Unexpected species detected", ier);
return ier;
}
}
ier = KIM_STATUS_OK; /* everything is ok */
/* initialize potential energies, forces, and virial term */
if (comp_particleEnergy)
{
for (i = 0; i < *nParts; ++i)
{
particleEnergy[i] = 0.0;
}
}
if (comp_energy)
{
*energy = 0.0;
}
if (comp_force)
{
for (i = 0; i < *nParts; ++i)
{
for (k = 0; k < DIM; ++k)
{
force[i*DIM + k] = 0.0;
}
}
}
if (comp_virial)
{
for (i = 0; i < 6; ++i)
{
virial[i] = 0.0;
}
}
/* Initialize neighbor handling for CLUSTER NBC */
if (3 == NBC) /* CLUSTER */
{
neighListOfCurrentPart = (int *) malloc((*nParts)*sizeof(int));
}
/* Initialize neighbor handling for Iterator mode */
if (1 == IterOrLoca)
{
ier = KIM_API_get_neigh(pkim, 0, 0, ¤tPart, &numOfPartNeigh,
&neighListOfCurrentPart, &Rij_list);
/* check for successful initialization */
if (KIM_STATUS_NEIGH_ITER_INIT_OK != ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_get_neigh", ier);
ier = KIM_STATUS_FAIL;
return ier;
}
}
/* Compute energy and forces */
/* loop over particles and compute enregy and forces */
i = -1;
while( 1 )
{
/* Set up neighbor list for next particle for all NBC methods */
if (1 == IterOrLoca) /* ITERATOR mode */
{
ier = KIM_API_get_neigh(pkim, 0, 1, ¤tPart, &numOfPartNeigh,
&neighListOfCurrentPart, &Rij_list);
if (KIM_STATUS_NEIGH_ITER_PAST_END == ier) /* the end of the list, terminate loop */
{
break;
}
if (KIM_STATUS_OK > ier) /* some sort of problem, return */
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_get_neigh", ier);
return ier;
}
i = currentPart;
}
else
{
i++;
if (*nParts <= i) /* incremented past end of list, terminate loop */
{
break;
}
if (3 == NBC) /* CLUSTER NBC method */
{
numOfPartNeigh = *nParts - (i + 1);
for (k = 0; k < numOfPartNeigh; ++k)
{
neighListOfCurrentPart[k] = i + k + 1;
}
ier = KIM_STATUS_OK;
}
else /* All other NBCs */
{
ier = KIM_API_get_neigh(pkim, 1, i, ¤tPart, &numOfPartNeigh,
&neighListOfCurrentPart, &Rij_list);
if (KIM_STATUS_OK != ier) /* some sort of problem, return */
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_get_neigh", ier);
ier = KIM_STATUS_FAIL;
return ier;
}
}
}
/* loop over the neighbors of particle i */
for (jj = 0; jj < numOfPartNeigh; ++ jj)
{
j = neighListOfCurrentPart[jj]; /* get neighbor ID */
/* compute relative position vector and squared distance */
Rsqij = 0.0;
for (k = 0; k < DIM; ++k)
{
if (0 != NBC) /* all methods except NEIGH_RVEC */
{
Rij[k] = coords[j*DIM + k] - coords[i*DIM + k];
}
else /* NEIGH_RVEC_F method */
{
Rij[k] = Rij_list[jj*DIM + k];
}
/* apply periodic boundary conditions if required */
if (2 == NBC)
{
if (abs(Rij[k]) > 0.5*boxSideLengths[k])
{
Rij[k] -= (Rij[k]/fabs(Rij[k]))*boxSideLengths[k];
}
}
/* compute squared distance */
Rsqij += Rij[k]*Rij[k];
}
/* compute energy and force */
if (Rsqij < MODEL_CUTSQ) /* particles are interacting ? */
{
R = sqrt(Rsqij);
if (comp_force || comp_virial)
{
/* compute pair potential and its derivative */
calc_phi_dphi(R, &phi, &dphi);
/* compute dEidr */
if ((1 == HalfOrFull) && (j < numberContrib))
{
/* HALF mode -- double contribution */
dEidr = dphi;
}
else
{
/* FULL mode -- regular contribution */
dEidr = 0.5*dphi;
}
}
else
{
/* compute just pair potential */
calc_phi(R, &phi);
}
/* contribution to energy */
if (comp_particleEnergy)
{
particleEnergy[i] += 0.5*phi;
/* if half list add energy for the other particle in the pair */
if ((1 == HalfOrFull) && (j < numberContrib)) particleEnergy[j] += 0.5*phi;
}
if (comp_energy)
{
if ((1 == HalfOrFull) && (j < numberContrib))
{
/* Half mode -- add v to total energy */
*energy += phi;
}
else
{
/* Full mode -- add half v to total energy */
*energy += 0.5*phi;
}
}
/* contribution to virial tensor */
if (comp_virial)
{
/* virial(i,j) = r(i)*r(j)*(dV/dr)/r */
virial[0] += Rij[0]*Rij[0]*dEidr/R;
virial[1] += Rij[1]*Rij[1]*dEidr/R;
virial[2] += Rij[2]*Rij[2]*dEidr/R;
virial[3] += Rij[1]*Rij[2]*dEidr/R;
virial[4] += Rij[0]*Rij[2]*dEidr/R;
virial[5] += Rij[0]*Rij[1]*dEidr/R;
}
/* contribution to forces */
if (comp_force)
{
for (k = 0; k < DIM; ++k)
{
force[i*DIM + k] += dEidr*Rij[k]/R; /* accumulate force on particle i */
force[j*DIM + k] -= dEidr*Rij[k]/R; /* accumulate force on particle j */
}
}
}
} /* loop on jj */
} /* infinite while loop (terminated by break statements above */
/* Free temporary storage */
if (3 == NBC)
{
free(neighListOfCurrentPart);
}
/* everything is great */
ier = KIM_STATUS_OK;
return ier;
}
int main(int argc, char **argv)
{
/* output file pointers */
FILE *rlfp=NULL, *taufp=NULL, *e21fp=NULL;
FILE *e31fp=NULL, *e32fp=NULL, *plnfp=NULL;
FILE *f1fp=NULL, *l1fp=NULL;
FILE *thetafp=NULL, *phifp=NULL, *dirfp=NULL;
FILE *erfp=NULL, *irfp=NULL, *qrfp=NULL;
FILE *headerfp=NULL, *pfiltfp=NULL, *sfiltfp=NULL;
FILE *nfiltfp=NULL, *efiltfp=NULL;
// FILE *pkur=NULL, *skur=NULL;
/* temporary file for trace headers */
/* (one 3C station only) */
char *file=NULL; /* base of output file name(s) */
char *fname=NULL; /* complete output file name */
char *angle=NULL; /* unit used for angles theta and phi */
char *win=NULL; /* shape of used time window */
float fangle=0.0; /* unit conversion factor applied to angles theta and phi */
int iwin=0; /* time window shape identifier */
/* flags (see selfdoc) */
int rl,theta,phi,tau,ellip,pln,f1,l1,dir,amp,verbose,all;
int i,j,icomp; /* indices for components (in loops) */
int it; /* index for time sample in main loop */
int iwl; /* correlation window length in samples */
int nstat; /* number of 3-component datasets */
int nt; /* number of time samples in one trace */
// int kwl; /* kurtosis window length in seconds */
float **data3c; /* three-component data ([1..3][0..nt-1]) */
float **a; /* covariance matrix (a[1..3][1..3]) */
float **v; /* eigenvectors of covariance matrix (v[1..3][1..3]) */
float *d; /* the corresponding eigenvalues (d[1..3]) */
float *w; /* time window weights for correlation window */
float dt; /* sampling interval in seconds */
float rlq; /* contrast factor of rectilinearity */
float wl; /* correlation window length in seconds */
float *data_e21=NULL; /* main ellipticity */
float *data_e31=NULL; /* second ellipticity */
float *data_e32=NULL; /* transverse ellipticity */
float *data_er=NULL; /* eigenresultant */
float *data_f1=NULL; /* flatness coefficient */
float *data_ir=NULL; /* instantaneous resultant */
float *data_l1=NULL; /* linearity coefficient */
float *data_phi=NULL; /* horizontal azimuth phi */
float *data_pln=NULL; /* planarity */
float *data_qr=NULL; /* quadratic resultant */
float *data_rl=NULL; /* rectilinearity factor */
float *data_tau=NULL; /* polarization parameter tau */
float *data_theta=NULL; /* inclination angle theta */
float *data_pfilt=NULL; /* P (vertical) polarization filter */
float *data_sfilt=NULL; /* S (horizontal) polarization filter */
float *data_zfilt=NULL; /* Z Filtered Trace */
float *data_nfilt=NULL; /* N Filtered Trace */
float *data_efilt=NULL; /* E Filtered Trace */
// float *data_kwl=NULL; /* Data for Kurtosis Window */
// float *data_pkur=NULL; /* Kurtosis detector for P */
// float *data_skur=NULL; /* Kurtosis detector for S */
float **data3c_dir=NULL; /* 3 components of direction of polarization ([1..3][0..nt-1]) */
/* initialize */
initargs(argc, argv);
requestdoc(1);
/* get info from first trace */
if(!gettr(&tr)) err("can't get first trace");
nt = tr.ns;
/* get parameters ... */
if (!getparstring("file", &file)) file="polar";
if (!getparstring("angle", &angle)) angle="rad";
if (!getparstring("win", &win)) win="boxcar";
if (!getparfloat("wl", &wl)) wl = 0.1;
if (!getparfloat("dt", &dt)) dt = ((double) tr.dt)/1000000.0;
if (!getparfloat("rlq", &rlq)) rlq = 1.0;
if (!getparint("verbose", &verbose)) verbose = 0;
// if (!getparint("kwl", &kwl)) kwl = 5 * ((int) 1/dt);
/* ... and output flags */
if (!getparint("all", &all)) all = 0;
if (!getparint("rl", &rl)) rl = (all) ? all : 1;
if (!getparint("dir", &dir)) dir = (all) ? 1 : 1;
if (!getparint("theta", &theta)) theta = (all) ? all : 0;
if (!getparint("phi", &phi)) phi = (all) ? all : 0;
if (!getparint("tau", &tau)) tau = (all) ? 1 : 0;
if (!getparint("ellip", &ellip)) ellip = (all) ? 1 : 0;
if (!getparint("pln", &pln)) pln = (all) ? 1 : 0;
if (!getparint("f1", &f1)) f1 = (all) ? 1 : 0;
if (!getparint("l1", &l1)) l1 = (all) ? 1 : 0;
if (!getparint("amp", &)) amp = (all) ? 1 : 0;
checkpars();
/* get time window shape */
if (STREQ(win, "boxcar")) iwin=WBOXCAR;
else if (STREQ(win, "bartlett")) iwin=WBARTLETT;
else if (STREQ(win, "hanning")) iwin=WHANNING;
else if (STREQ(win, "welsh")) iwin=WWELSH;
else err("unknown win=%s", win);
/* get unit conversion factor for angles */
if (STREQ(angle, "rad")) fangle=1.0;
else if (STREQ(angle, "deg")) fangle=180.0/PI;
else if (STREQ(angle, "gon")) fangle=200.0/PI;
else err("unknown angle=%s", angle);
/* convert seconds to samples */
if (!dt) {
dt = 0.004;
warn("dt not set, assuming dt=0.004");
}
iwl = NINT(wl/dt);
/* data validation */
if (iwl<1) err("wl=%g must be positive", wl);
if (iwl>nt) err("wl=%g too long for trace", wl);
if (!strlen(file)) err("file= not set and default overridden");
/* echo some information */
if (verbose && (theta || phi)) warn("computing angles in %s", angle);
if (verbose) warn("%s window length = %d samples\n", win, iwl);
if (rl && theta) warn("computing filtered phase");
/* open temporary file for trace headers */
headerfp = etmpfile();
/* set filenames and open files */
fname = malloc( strlen(file)+7 );
sprintf(fname, "%s.rl", file); if (rl) rlfp = efopen(fname, "w");
sprintf(fname, "%s.theta", file); if (theta) thetafp = efopen(fname, "w");
sprintf(fname, "%s.phi", file); if (phi) phifp = efopen(fname, "w");
sprintf(fname, "%s.tau", file); if (tau) taufp = efopen(fname, "w");
sprintf(fname, "%s.e21", file); if (ellip) e21fp = efopen(fname, "w");
sprintf(fname, "%s.e31", file); if (ellip) e31fp = efopen(fname, "w");
sprintf(fname, "%s.e32", file); if (ellip) e32fp = efopen(fname, "w");
sprintf(fname, "%s.pln", file); if (pln) plnfp = efopen(fname, "w");
sprintf(fname, "%s.f1", file); if (f1) f1fp = efopen(fname, "w");
sprintf(fname, "%s.l1", file); if (l1) l1fp = efopen(fname, "w");
sprintf(fname, "%s.dir", file); if (dir) dirfp = efopen(fname, "w");
sprintf(fname, "%s.er", file); if (amp) erfp = efopen(fname, "w");
sprintf(fname, "%s.ir", file); if (amp) irfp = efopen(fname, "w");
sprintf(fname, "%s.qr", file); if (amp) qrfp = efopen(fname, "w");
sprintf(fname, "%s.pfilt", file); if (rl && theta) pfiltfp = efopen(fname, "w");
sprintf(fname, "%s.sfilt", file); if (rl && theta) sfiltfp = efopen(fname, "w");
sprintf(fname, "%s.nfilt", file); if (rl && theta) nfiltfp = efopen(fname, "w");
sprintf(fname, "%s.efilt", file); if (rl && theta) efiltfp = efopen(fname, "w");
// sprintf(fname, "%s.pkur", file); if (rl && theta) pkur = efopen(fname, "w");
// sprintf(fname, "%s.skur", file); if (rl && theta) skur = efopen(fname, "w");
free(fname);
/* allocate space for input data and analysis matrices */
/* index ranges used here: data3c[1..3][0..nt-1], */
/* a[1..3][1..3], v[1..3][1..3], d[1..3] */
data3c = ealloc2float(nt,3); data3c-=1;
a = ealloc2float(3,3); a[0]-=1; a-=1;
v = ealloc2float(3,3); v[0]-=1; v-=1;
d = ealloc1float(3); d-=1;
/* calculate time window weights */
w = ealloc1float(iwl);
memset((void *) w, 0, iwl*FSIZE);
calc_window(w, iwl, iwin);
/* allocate and zero out space for output data */
if (rl) {
data_rl = ealloc1float(nt);
memset((void *) data_rl, 0, nt*FSIZE);
}
if (theta) {
data_theta = ealloc1float(nt);
memset((void *) data_theta, 0, nt*FSIZE);
}
if (phi) {
data_phi = ealloc1float(nt);
memset((void *) data_phi, 0, nt*FSIZE);
}
if (tau) {
data_tau = ealloc1float(nt);
memset((void *) data_tau, 0, nt*FSIZE);
}
if (ellip) {
data_e21 = ealloc1float(nt);
data_e31 = ealloc1float(nt);
data_e32 = ealloc1float(nt);
memset((void *) data_e21, 0, nt*FSIZE);
memset((void *) data_e31, 0, nt*FSIZE);
memset((void *) data_e32, 0, nt*FSIZE);
}
if (pln) {
data_pln = ealloc1float(nt);
memset((void *) data_pln, 0, nt*FSIZE);
}
if (f1) {
data_f1 = ealloc1float(nt);
memset((void *) data_f1, 0, nt*FSIZE);
}
if (l1) {
data_l1 = ealloc1float(nt);
memset((void *) data_l1, 0, nt*FSIZE);
}
if (amp) {
data_er = ealloc1float(nt);
data_ir = ealloc1float(nt);
data_qr = ealloc1float(nt);
memset((void *) data_er, 0, nt*FSIZE);
memset((void *) data_ir, 0, nt*FSIZE);
memset((void *) data_qr, 0, nt*FSIZE);
}
if (dir) {
data3c_dir = ealloc2float(nt,3); data3c_dir-=1;
for (i=1;i<=3;i++) memset((void *) data3c_dir[i], 0, nt*FSIZE);
}
if (rl && theta) {
data_pfilt = ealloc1float(nt);
memset((void *) data_pfilt, 0, nt*FSIZE);
data_sfilt = ealloc1float(nt);
memset((void *) data_pfilt, 0, nt*FSIZE);
/* data_3Cfilt = ealloc2float(nt,3);
for (i=1;i<=3;i++) memset((void *) data_3Cfilt[i], 0, nt*FSIZE); */
data_zfilt = ealloc1float(nt);
data_nfilt = ealloc1float(nt);
data_efilt = ealloc1float(nt);
memset((void *) data_zfilt, 0, nt*FSIZE);
memset((void *) data_nfilt, 0, nt*FSIZE);
memset((void *) data_efilt, 0, nt*FSIZE);
// data_pkur = ealloc1float(nt);
// data_skur = ealloc1float(nt);
// memset((void *) data_pkur, 0, nt*FSIZE);
// memset((void *) data_skur, 0, nt*FSIZE);
/* Allocate data for kurtosis window arrays */
// data_kwl = ealloc1float(iwl);
// memset((void *) data_kwl, 0, kwl*FSIZE);
}
/* ************************ BEGIN CALCULATION ******************************* */
/* loop over traces */
icomp=0;
nstat=0;
// Need to convert this do while loop into a for loop so as to be easier
// to parallelize
warn("Trace Start Time: %d %d %d %d %d", tr.year, tr.day, tr.hour, tr.minute, tr.sec);
do {
/* store trace header in temporary file and read data */
efwrite(&tr, HDRBYTES, 1, headerfp);
icomp++;
memcpy((void *)data3c[icomp], (const void *) tr.data, nt*FSIZE);
/* process 3-component dataset */
if (icomp==3) {
erewind(headerfp);
icomp = 0;
nstat++;
if (verbose)
fprintf(stderr,"%s: analyzing station %d \r",argv[0], nstat);
/* start loop over samples */
for (it=iwl/2;it<nt-iwl/2;it++) {
//warn("Sample %d", it);
/* covariance matrix */
for (i=1;i<=3;i++)
{
for (j=i;j<=3;j++)
{
a[i][j]=a[j][i]=covar(data3c[i], data3c[j], it-iwl/2, iwl, w);
}
}
/* compute eigenvalues and vectors */
eig_jacobi(a,d,v,3);
sort_eigenvalues(d,v,3);
/* polarization parameters */
if (rl) data_rl[it]=calc_rl(d,rlq,rl);
if (theta) data_theta[it]=calc_theta(v, theta) * fangle;
if (phi) data_phi[it]=calc_phi(v, phi) * fangle;
if (tau) data_tau[it]=calc_tau(d);
if (ellip) {
data_e21[it]=calc_ellip(d,2,1);
data_e31[it]=calc_ellip(d,3,1);
data_e32[it]=calc_ellip(d,3,2);
}
if (pln) data_pln[it]=calc_plan(d);
if (f1) data_f1[it]=calc_f1(d);
if (l1) data_l1[it]=calc_l1(d);
if (amp) data_er[it]=calc_er(d);
if (dir) calc_dir(data3c_dir,v,it);
if (rl && theta)
{
data_zfilt[it] = data3c[1][it] * calc_pfilt(rl, theta);
data_nfilt[it] = data3c[2][it] * calc_sfilt(rl, theta);
data_efilt[it] = data3c[3][it] * calc_sfilt(rl, theta);
data_pfilt[it] = data_zfilt[it];
data_sfilt[it] = (data_nfilt[it] + data_efilt[it]) / 2;
// data_pkur[it] = kurtosiswindow(data_pfilt,data_kwl,it - kwl/2,kwl,nt);
// data_skur[it] = kurtosiswindow(data_sfilt,data_kwl,it - kwl/2,kwl,nt);
}
} /* end loop over samples */
/* compute amplitude parameters */
if (amp) ampparams(data3c, data_ir, data_qr, nt, iwl);
/* *************************** END CALCULATION ****************************** */
/* ***************************** BEGIN WRITE ******************************** */
/* write polarization attributes to files */
if (rl) fputdata(rlfp, headerfp, data_rl, nt);
if (theta) fputdata(thetafp, headerfp, data_theta, nt);
if (phi) fputdata(phifp, headerfp, data_phi, nt);
if (tau) fputdata(taufp, headerfp, data_tau, nt);
if (ellip) {
fputdata(e21fp, headerfp, data_e21, nt);
fputdata(e31fp, headerfp, data_e31, nt);
fputdata(e32fp, headerfp, data_e32, nt);
}
if (pln) fputdata(plnfp, headerfp, data_pln, nt);
if (f1) fputdata(f1fp, headerfp, data_f1, nt);
if (l1) fputdata(l1fp, headerfp, data_l1, nt);
if (amp) {
fputdata(erfp, headerfp, data_er, nt);
fputdata(irfp, headerfp, data_ir, nt);
fputdata(qrfp, headerfp, data_qr, nt);
}
if (dir) fputdata3c(dirfp, headerfp, data3c_dir, nt);
if (rl && theta)
{
fputdata(pfiltfp, headerfp, data_pfilt, nt);
fputdata(sfiltfp, headerfp, data_sfilt, nt);
fputdata(nfiltfp, headerfp, data_nfilt, nt);
fputdata(efiltfp, headerfp, data_efilt, nt);
// fputdata(pkur, headerfp, data_pkur, nt);
// fputdata(skur, headerfp, data_skur, nt);
}
/* ****************************** END WRITE ********************************* */
} /* end of processing three-component dataset */
} while (gettr(&tr)); /* end loop over traces */
if (verbose) {
fprintf(stderr,"\n");
if (icomp) warn("last %d trace(s) skipped", icomp);
}
/* close files */
efclose(headerfp);
if (rl) efclose(rlfp);
if (theta) efclose(thetafp);
if (phi) efclose(phifp);
if (tau) efclose(taufp);
if (ellip) {
efclose(e21fp);
efclose(e31fp);
efclose(e32fp);
}
if (pln) efclose(plnfp);
if (f1) efclose(f1fp);
if (l1) efclose(l1fp);
if (amp) {
efclose(erfp);
efclose(irfp);
efclose(qrfp);
}
if (dir) efclose(dirfp);
if (rl && theta) {
efclose(pfiltfp);
efclose(sfiltfp);
// efclose(pkur);
// efclose(skur);
}
return(CWP_Exit());
}
/* compute function */
static int compute(void* km)
{
/* local variables */
intptr_t* pkim = *((intptr_t**) km);
double R;
double Rsqij;
double phi;
double dphi;
double Rij[DIM];
int ier;
int i;
int j;
int k;
int comp_energy;
int comp_force;
int comp_particleEnergy;
int comp_virial;
int* nAtoms;
int* particleTypes;
double* cutoff;
double* epsilon;
double* sigma;
double* A;
double* B;
double* C;
double* cutsq;
double* coords;
double* energy;
double* force;
double* particleEnergy;
double* virial;
/* check to see if we have been asked to compute the forces, particleEnergy, and virial */
KIM_API_getm_compute(pkim, &ier, 4*3,
"energy", &comp_energy, 1,
"forces", &comp_force, 1,
"particleEnergy", &comp_particleEnergy, 1,
"virial", &comp_virial, 1);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_getm_compute", ier);
return ier;
}
/* unpack data from KIM object */
KIM_API_getm_data(pkim, &ier, 7*3,
"numberOfParticles", &nAtoms, 1,
"particleTypes", &particleTypes, 1,
"energy", &energy, comp_energy,
"coordinates", &coords, 1,
"forces", &force, comp_force,
"particleEnergy", &particleEnergy, comp_particleEnergy,
"virial", &virial, comp_virial);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_getm_data", ier);
return ier;
}
/* unpack the Model's parameters stored in the KIM API object */
KIM_API_getm_data(pkim, &ier, 7*3,
"cutoff", &cutoff, 1,
"PARAM_FREE_epsilon", &epsilon, 1,
"PARAM_FREE_sigma", &sigma, 1,
"PARAM_FIXED_A", &A, 1,
"PARAM_FIXED_B", &B, 1,
"PARAM_FIXED_C", &C, 1,
"PARAM_FIXED_cutsq", &cutsq, 1);
if (KIM_STATUS_OK > ier)
{
KIM_API_report_error(__LINE__, __FILE__, "KIM_API_getm_data", ier);
return ier;
}
/* Check to be sure that the atom types are correct */
/**/
ier = KIM_STATUS_FAIL; /* assume an error */
for (i = 0; i < *nAtoms; ++i)
{
if ( SPECCODE != particleTypes[i])
{
KIM_API_report_error(__LINE__, __FILE__, "Unexpected species type detected", ier);
return ier;
}
}
ier = KIM_STATUS_OK; /* everything is ok */
/* initialize potential energies, forces, and virial term */
if (comp_particleEnergy)
{
for (i = 0; i < *nAtoms; ++i)
{
particleEnergy[i] = 0.0;
}
}
if (comp_energy)
{
*energy = 0.0;
}
if (comp_force)
{
for (i = 0; i < *nAtoms; ++i)
{
for (k = 0; k < DIM; ++k)
{
force[i*DIM + k] = 0.0;
}
}
}
if (comp_virial)
{
for (i = 0; i < 6; ++i)
{
virial[i] = 0.0;
}
}
/* Compute energy and forces */
/* We'll use a half list approach */
/* Don't need to consider the last atom since all its interactions */
/* are accounted for eariler in the loop */
for (i = 0; i < *nAtoms-1; ++i)
{
for (j = i+1; j < *nAtoms; ++j)
{
/* compute relative position vector and squared distance */
Rsqij = 0.0;
for (k = 0; k < DIM; ++k)
{
Rij[k] = coords[j*DIM + k] - coords[i*DIM + k];
/* compute squared distance */
Rsqij += Rij[k]*Rij[k];
}
/* compute energy and force */
if (Rsqij < *cutsq) /* particles are interacting ? */
{
R = sqrt(Rsqij);
if (comp_force || comp_virial)
{
/* compute pair potential and its derivative */
calc_phi_dphi(cutoff, epsilon, sigma, A, B, C, R, &phi, &dphi);
}
else
{
/* compute just pair potential */
calc_phi(cutoff, epsilon, sigma, A, B, C, R, &phi);
}
/* contribution to energy */
if (comp_particleEnergy)
{
particleEnergy[i] += 0.5*phi;
particleEnergy[j] += 0.5*phi;
}
if (comp_energy)
{
*energy += phi;
}
/* contribution to virial tensor */
if (comp_virial)
{
/* virial(i,j) = r(i)*r(j)*(dV/dr)/r */
virial[0] += Rij[0]*Rij[0]*dphi/R;
virial[1] += Rij[1]*Rij[1]*dphi/R;
virial[2] += Rij[2]*Rij[2]*dphi/R;
virial[3] += Rij[1]*Rij[2]*dphi/R;
virial[4] += Rij[0]*Rij[2]*dphi/R;
virial[5] += Rij[0]*Rij[1]*dphi/R;
}
/* contribution to forces */
if (comp_force)
{
for (k = 0; k < DIM; ++k)
{
force[i*DIM + k] += dphi*Rij[k]/R; /* accumulate force on atom i */
force[j*DIM + k] -= dphi*Rij[k]/R; /* accumulate force on atom j */
}
}
}
} /* loop on j */
} /* loop on i */
/* everything is great */
ier = KIM_STATUS_OK;
return ier;
}
int main(){
int i, j, iter,isource,idir,step,irec;
clock_t start = clock();
setbuf(stdout,NULL);
/*** Initial Condition ***/
init();
printf("Start calculation\n");
/*** Calculating for iteratively ***/
for(iter=0;iter<MAXITR;iter++){
printf("%03d th iterative\n",iter);
media_coeff_3d();
init_iterate();
init_FILE3(iter);
//*********** Start backward calculation **********//
for(irec=0;irec<rec_num;irec++){
for(idir=0;idir<NDIRECT;idir++){
banner1(idir,irec);
set_zero_eh();
/*** Calculating for step ***/
for(step=0;step<it-1;step++){
backpropagation(idir, irec, step);
copytoEcal_b(EX,EY,EZ,step,idir, irec,ofe1,ofe2,ofe3);
if(step%(it/20)==it/20-1) printf("#");
}
printf("\n");
laplaceToFreq_back(irec,idir);
output_backwave(irec,idir);
} // END loop for direction
}// END loop for ireceiver
close_FILE3();
//*********** Start of FWD calculation **********//
/*** Calculating for each source ***/
for(isource=0;isource<shot_num;isource++){
printf("This is %2d loop for Transmitter \n",isource);
read_Eobs(isource); // Read observed value of Ex
//init_FILE2(isource, iter);
printf("[PROGRESS =>] ");
set_zero_eh();
media_coeff_3d();
/*** Calculating for step ***/
for(step=0;step<it-1;step++){
fwdpropagation(isource, step);
copytoEcal(EX,EY,EZ,step);
if(step%(it/20)==it/20-1) printf("#");
} // END loop for step
laplaceToFreq_2(isource);
output_fwdwave(isource);
//close_FILE2();
// Calculation of residual error
residualE(iter);
sensitivity();
// Convolution of Greenfunc and conjugated delE
conv_GdelE();
// Calculation of gamma
calc_gamma();
} // END loop for isource
// Calclulation of delta model
calc_phi();
//printf("sig2 %e\n",sig[0]);
media_coeff_sig_tmp();
//*********** again FWD calculation **********//
for(isource=0;isource<shot_num;isource++){
printf("This is %2d loop for AGAIN Transmitter \n",isource);
printf("[PROGRESS =>] ");
set_zero_eh();
/*** Calculating for step ***/
for(step=0;step<it-1;step++){
fwdpropagation(isource, step);
copytoEcal(EX,EY,EZ,step);
if(step%(it/20)==it/20-1) printf("#");
} // END loop for step
laplaceToFreq_3();
calc_alpha(isource);
} // END loop for isource
update_para2(iter);
show_error(iter);
} // END loop for iter
printf("\n");
printf("%f [s] \n",(double)(clock()-start)/CLOCKS_PER_SEC);
fclose(ofer);
}
