int main (int argc, char **argv) { short verbose; double part, wb, vzero, k, twt, t, depth; initargs(argc, argv); if (!getparshort("verbose" , &verbose)) verbose = 0; if (!getpardouble("wb", &wb)) { fprintf ( stderr, "Must input water-bottom (wb) parameter --> exiting" ); return EXIT_FAILURE; } if (!getpardouble("twt", &twt)) { fprintf ( stderr, "Must input Two-Way Time (twt) parameter --> exiting" ); return EXIT_FAILURE; } if (!getpardouble("vzero", &vzero)) { fprintf ( stderr, "Must input VZERO (vzero) parameter --> exiting" ); return EXIT_FAILURE; } if (!getpardouble("depth", &depth)) { fprintf ( stderr, "Must input DEPTH (depth) parameter --> exiting" ); return EXIT_FAILURE; } if ( verbose ) { fprintf ( stderr, "\n" ); fprintf ( stderr, "Water-Bottm = %f\n", wb ); fprintf ( stderr, "TWT = %f\n", twt ); fprintf ( stderr, "VZERO = %f\n", vzero ); fprintf ( stderr, "DEPTH = %f\n", depth ); fprintf ( stderr, "\n" ); } t = ( twt * 0.0005 ) - ( wb / vzero ); part = vzero * exp ( t ); k = -1.0 * ( vzero / ( depth - part - wb ) ); printf ( "K = %.15f\n", k ); k = 0.48; fprintf ( stderr, "DEPTH check = %f\n", (vzero/k) * ( exp ( k * t ) - 1 ) + wb ); return EXIT_SUCCESS; }
/* Value getpar -- omitted string type for now */ void getparval(String name, String type, int n, Value *valp) { register int k; short *h; unsigned short *u; long *l; unsigned long *v; int *i; unsigned int *p; float *f; double *d; switch(*type) { case 'h': h = (short*) ealloc1(n, sizeof(short)); getparshort(name, h); for (k = 0; k < n; ++k) valp[k].h = h[k]; break; case 'u': u = (unsigned short*) ealloc1(n, sizeof(unsigned short)); getparushort(name, u); for (k = 0; k < n; ++k) valp[k].u = u[k]; break; case 'l': l = (long*) ealloc1(n, sizeof(long)); getparlong(name, l); for (k = 0; k < n; ++k) valp[k].l = l[k]; break; case 'v': v = (unsigned long*) ealloc1(n, sizeof(unsigned long)); getparulong(name, v); for (k = 0; k < n; ++k) valp[k].v = v[k]; break; case 'i': i = (int*) ealloc1(n, sizeof(int)); getparint(name, i); for (k = 0; k < n; ++k) valp[k].i = i[k]; break; case 'p': p = (unsigned int*) ealloc1(n, sizeof(unsigned int)); getparuint(name, p); for (k = 0; k < n; ++k) valp[k].p = p[k]; break; case 'f': f = (float*) ealloc1(n, sizeof(float)); getparfloat(name, f); for (k = 0; k < n; ++k) valp[k].f = f[k]; break; case 'd': d = (double*) ealloc1(n, sizeof(double)); getpardouble(name, d); for (k = 0; k < n; ++k) valp[k].d = d[k]; break; default: err("getparval: %d: mysterious type %s", __LINE__, type); } }
main(int argc, char **argv) { String key; String type; int index; double a, c, b, d, i, j; int itr = 0; Value val; FILE *infp=stdin, *outfp=stdout; /* Initialize */ initargs(argc, argv); requestdoc(1); /* Get parameters */ if (!getparstring("key", &key)) key = "cdp"; if (!getpardouble("a" , &a)) a = 0; if (!getpardouble("b" , &b)) b = 0; if (!getpardouble("c" , &c)) c = 0; if (!getpardouble("d" , &d)) d = 0; if (!getpardouble("j" , &j)) j = ULONG_MAX; type = hdtype(key); index = getindex(key); file2g(infp); file2g(outfp); while (gettr(&tr)) { i = (double) itr++ + d; setval(type, &val, a, b, c, i, j); puthval(&tr, index, &val); puttr(&tr); } return EXIT_SUCCESS; }
static int verhulst_equation(double t, double y[3] , double yprime[3]) /********************************************************************* verhulst_equation - the system of ODEs describing population growth by the logistic or verhulst equation. ********************************************************************** t independent variable "time" y dependent variable being solved for y(t) yprime derivative of dependent variable y'(t) ********************************************************************** Notes: This is an example of an autonomous system of ODE's **********************************************************************/ { double a1, a2; if (!getpardouble("a1", &a1)) a1 = 1.0; if (!getpardouble("a2", &a2)) a2 = 2000; yprime[0] = a1*y[0]*( 1 - y[0]/a2 ); y[1] = yprime[0]; return 1; }
int main(int argc, char **argv) { cwp_String key1,key2,key3; /* panel/trace/flag key */ cwp_String type1,type2,type3; /* type for panel/trace/flag key*/ int index1,index2,index3; /* indexes for key1/2/3 */ Value val1,val2,val3; /* value of key1/2/3 */ double dval1=0.0,dval2=0.0,dval3=0.0; /* value of key1/2/3 */ double c; /* trace key spacing */ double dmin,dmax,dx; /* trace key start/end/spacing */ double panelno=0.0,traceno=0.0; int nt; /* number of samples per trace */ int isgn; /* sort order */ int iflag; /* internal flag: */ /* -1 exit */ /* 0 regular mode */ /* 1 first time */ /* 2 trace out of range */ /* initialize */ initargs(argc, argv); requestdoc(1); /* get parameters */ if (!getparstring("key1", &key1)) key1 = "ep"; if (!getparstring("key2", &key2)) key2 = "tracf"; if (!getparstring("key3", &key3)) key3 = "trid"; if (!getpardouble("val3", &dval3)) dval3 = 2.; if (!getpardouble("d", &dx)) dx = 1.; if (!getpardouble("min", &dmin)) err("need lower panel boundary MIN"); if (!getpardouble("max", &dmax)) err("need upper panel boundary MAX"); checkpars(); /* check parameters */ if (dx==0) err("trace spacing d cannot be zero"); if (dmax<dmin) err("max needs to be greater than min"); if (dx<0) { isgn = -1; } else { isgn = 1; } /* get types and index values */ type1 = hdtype(key1); type2 = hdtype(key2); type3 = hdtype(key3); index1 = getindex(key1); index2 = getindex(key2); index3 = getindex(key3); /* loop over traces */ iflag = 1; while (iflag>=0) { if (gettr(&tr)) { /* get header values */ gethval(&tr, index1, &val1); gethval(&tr, index2, &val2); dval1 = vtod(type1, val1); dval2 = vtod(type2, val2); /* Initialize zero trace */ nt = tr.ns; memset( (void *) nulltr.data, 0, nt*FSIZE); if ( iflag==1 ) { panelno = dval1; traceno = dmin - dx; } iflag = 0; if ( dval2<dmin || dval2>dmax ) iflag = 2; /* fprintf(stderr,"if=%d, dmin=%8.0f, dmax=%8.0f\n",iflag,dmin,dmax);*/ } else { iflag = -1; /* exit flag */ } /* fprintf(stderr,"if=%d, dval1=%8.0f, dval2=%8.0f\n",iflag,dval1,dval2);*/ /* if new panel or last trace --> finish the previous panel */ if ( panelno!=dval1 || iflag==-1 ) { /* fprintf(stderr,"finish previous\n");*/ for (c=traceno+dx; isgn*c<=isgn*dmax; c=c+dx) { assgnval(type2, &val2, c); puthval(&nulltr, index2, &val2); assgnval(type3, &val3, dval3); puthval(&nulltr, index3, &val3); puttr(&nulltr); } traceno = dmin - dx; /* reset to pad present panel */ panelno = dval1; /* added by Ted Stieglitz 28Nov2012*/ } /* if trace within boundaries --> pad the present panel */ if ( iflag==0 ) { /* fprintf(stderr,"pad present, trn=%5.0f,dval2=%5.0f\n",traceno,dval2);*/ memcpy( (void *) &nulltr, (const void *) &tr, 240); for (c=traceno+dx; isgn*c<isgn*dval2; c=c+dx) { assgnval(type2, &val2, c); puthval(&nulltr, index2, &val2); assgnval(type3, &val3, dval3); puthval(&nulltr, index3, &val3); puttr(&nulltr); } } /* write the present trace and save header indices */ if ( iflag==0 ) { puttr(&tr); panelno = dval1; traceno = dval2; } } return(CWP_Exit()); }
int main(int argc, char **argv) { cwp_String key[SU_NKEYS]; /* array of keywords */ cwp_String type[SU_NKEYS]; /* array of keywords */ int index[SU_NKEYS]; /* name of type of getparred key */ int ikey; /* key counter */ int nkeys; /* number of header fields set */ int count=0; /* number of header fields from file */ double i; /* parameters for computing fields */ int itr = 0; /* trace counter */ Value val; /* value of key field */ char *infile=""; /* name of input file of header values */ FILE *infp=NULL; /* pointer to input file */ cwp_Bool from_file=cwp_false; /* is the data from infile? */ float *afile=NULL; /* array of "a" values from file */ double *a=NULL; /* array of "a" values */ double *b=NULL; /* array of "b" values */ double *c=NULL; /* array of "c" values */ double *d=NULL; /* array of "d" values */ double *j=NULL; /* array of "j" values */ int n; /* number of a,b,c,d,j values */ /* Initialize */ initargs(argc, argv); requestdoc(1); /* Get "key" values */ if ((nkeys=countparval("key"))!=0) { getparstringarray("key",key); } else { key[0]="cdp"; } /* get types and indexes corresponding to the keys */ for (ikey=0; ikey<nkeys; ++ikey) { type[ikey]=hdtype(key[ikey]); index[ikey]=getindex(key[ikey]); } /* get name of infile */ getparstring("infile",&infile); /* if infile is specified get specified keys from file */ if (*infile!='\0') { /* open infile */ if((infp=efopen(infile,"r"))==NULL) err("cannot open infile=%s\n",infile); /* set from_file flag */ from_file=cwp_true; } /* If not from file, getpar a,b,c,d,j */ if (!from_file) { /* get "a" values */ if ((n=countparval("a"))!=0) { if (n!=nkeys) err("number of a values not equal to number of keys"); a=ealloc1double(n); getpardouble("a",a); } else { a=ealloc1double(nkeys); for (ikey=0; ikey<nkeys; ++ikey) a[ikey]=0.; } /* get "b" values */ if ((n=countparval("b"))!=0) { if (n!=nkeys) err("number of b values not equal to number of keys"); b=ealloc1double(n); getpardouble("b",b); } else { b=ealloc1double(nkeys); for (ikey=0; ikey<nkeys; ++ikey) b[ikey]=0.; } /* get "c" values */ if ((n=countparval("c"))!=0) { if (n!=nkeys) err("number of c values not equal to number of keys"); c=ealloc1double(n); getpardouble("c",c); } else { c=ealloc1double(nkeys); for (ikey=0; ikey<nkeys; ++ikey) c[ikey]=0.; } /* get "d" values */ if ((n=countparval("d"))!=0) { if (n!=nkeys) err("number of d values not equal to number of keys"); d=ealloc1double(n); getpardouble("d",d); } else { d=ealloc1double(nkeys); for (ikey=0; ikey<nkeys; ++ikey) d[ikey]=0.; } /* get "j" values */ if ((n=countparval("j"))!=0) { if (n!=nkeys) err("number of j values not equal to number of keys"); j=ealloc1double(n); getpardouble("j",j); /* make sure that j!=0 */ for (ikey=0; ikey<nkeys; ++ikey) if(j[ikey]==0) j[ikey]=ULONG_MAX; } else { j=ealloc1double(nkeys); for (ikey=0; ikey<nkeys; ++ikey) j[ikey]=ULONG_MAX; } } else { /* if reading from a file */ /* allocate space for afile */ afile=ealloc1float(nkeys); } checkpars(); /* loop over traces */ while (gettr(&tr)) { if (from_file) { /* use the "a" value from file to trace by trace */ if (efread(afile,FSIZE,nkeys,infp)!=0) { for (ikey=0; ikey<nkeys; ++ikey) { double a_in; a_in=(double) afile[ikey]; setval(type[ikey],&val,a_in, 0,0,0,ULONG_MAX); puthval(&tr,index[ikey],&val); ++count; } } } else { /* use getparred values of a,b,c,d,j */ for (ikey=0; ikey<nkeys; ++ikey) { i = (double) itr + d[ikey]; setval(type[ikey],&val,a[ikey],b[ikey], c[ikey],i,j[ikey]); puthval(&tr,index[ikey],&val); } } ++itr; puttr(&tr); } if (from_file) { efclose(infp); if (count < (int)(itr*nkeys) ) { warn("itr=%d > count=%d %s",(int) itr*count,count); warn("n traces=%d > data count =%d",(itr*nkeys),count); } } return(CWP_Exit()); }
/* the main program */ int main (int argc, char **argv) { double vp,vs,rho; double aspect,cdens; double scale,eps,delta,gamma; int fill; char *outpar=NULL; /* name of file holding output parfile */ FILE *outparfp=NULL; /* ... its file pointer */ /* Stiff2D *spar1, *spar2; */ Stiff2D *spar1; spar1=(Stiff2D*)emalloc(sizeof(Stiff2D)); /* spar2=(Stiff2D*)emalloc(sizeof(Stiff2D)); */ /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(0); if (!getpardouble("vp",&vp)) vp = 4.5; if (!getpardouble("vs",&vs)) vs = 2.53; if (!getpardouble("rho",&rho)) rho = 2.8; if (!getpardouble("aspect",&aspect)) aspect = 0.000001; if (!getpardouble("cdens",&cdens)) cdens = 0.0; if (!getparint("fill",&fill)) fill = 0; /*************** open par-file ******************/ if (!getparstring("outpar", &outpar)) outpar = "/dev/tty" ; outparfp = efopen(outpar, "w"); checkpars(); /*************** check input **********************/ if (fill !=0 && fill !=1 ) err(" \n wrong FILL parameter !! \n"); if(cdens !=0 && aspect==0) err(" \n wrong value for <aspect> "); if ( hudsonstiff(fill,vp,vs,rho,cdens,aspect,spar1) !=1 ) err(" ERROR in <hudsonstiff> \n "); fprintf(outparfp," \n ----------Hudson's crack model ----------\n \n"); fprintf(outparfp," vp=%g \t vs=%g \t rho=%g \n",vp,vs,rho); fprintf(outparfp," cdens=%g \t aspect=%g \t fill=%i \n\n", cdens,aspect,fill); fprintf(outparfp," \n ----------Hudson output ----------\n \n"); fprintf(outparfp," c11=%g \t c33=%g \n",spar1->a1111,spar1->a3333); fprintf(outparfp," c44=%g \t c55=%g \n",spar1->a2323,spar1->a1313); fprintf(outparfp," c13=%g \n\n",spar1->a1133); /* convert stiffness into density normalized stiffnesses */ scale=1./rho; spar1->a1111=scale*spar1->a1111; spar1->a3333=scale*spar1->a3333; spar1->a2323=scale*spar1->a2323; spar1->a1313=scale*spar1->a1313; spar1->a1133=scale*spar1->a1133; fprintf(outparfp," a11=%g \t a33=%g \n", spar1->a1111,spar1->a3333); fprintf(outparfp," a44=%g \t a55=%g \n", spar1->a2323,spar1->a1313); fprintf(outparfp," a13=%g \n\n",spar1->a1133); /* convert stiffnesses into generic Thomsen */ if (stiff2thomVTI (spar1->a3333, spar1->a1111, spar1->a1133, spar1->a1313, spar1-> a2323,&vp,&vs,&eps, &delta,&gamma) != 1) err(" ERROR in <stiff2thomVTI> "); fprintf(outparfp," vp0=%g \t vs0=%g \t rho=%g \n",vp,vs,rho); fprintf(outparfp," eps=%g \t delta=%g \t gamma=%g \n\n",eps,delta,gamma); /* compute thomsen of equivalent VTI medium */ spar1->a1212=spar1->a1313; if(stiff2tv(spar1,&vp,&vs,&eps,&delta,&gamma) != 1) err("\n ERROR in <stiff2tv> \n\n"); fprintf(outparfp," alpha=%g \t beta=%g \t rho=%g \n",vp,vs,rho); fprintf(outparfp," e(V)=%g \t d(V)=%g \t g(V)=%g \n\n",eps,delta,gamma); fclose(outparfp); return 1; }
int main(int argc, char **argv) { char *coeff_x, *coeff_x2, *coeff_x3, *coeff_x4, file[BUFSIZ]; struct GRD_HEADER grd_x, grd_x2, grd_x3, grd_x4; struct GMT_EDGEINFO edgeinfo_x, edgeinfo_x2, edgeinfo_x3, edgeinfo_x4; struct GMT_BCR bcr_x, bcr_x2, bcr_x3, bcr_x4; double x_loc, y_loc, value_coeff_x, value_coeff_x2, value_coeff_x3, value_coeff_x4; char temp[256]; cwp_String pfile; FILE *fpp; short verbose, check; int kount, nump1; double sum, error1, sign; double delta, thresh; double *vzero_opt, *k_opt; double *datain, *samp, *xloc_array, *yloc_array; double depth_water, factor, num, sample; double vzero, k; double *wb_twt_array, *wb_z_array; double error, x, y, zero; register int i; initargs(argc, argv); argc = GMT_begin (argc, argv); if (!getparstring("pfile",&pfile)) pfile = "tops.lis"; if (!getparshort("verbose", &verbose)) verbose = 1; if (!getpardouble("delta", &delta)) delta = 0.00001; if (!getpardouble("thresh", &thresh)) thresh = 0.01; zero = 0.0; if (!getparstring("coeff_x", &coeff_x)) coeff_x="wb.twt.grd"; if (!getparstring("coeff_x2", &coeff_x2)) coeff_x2="wvavg.dat.trimmed.sample.smooth.grd"; if (!getparstring("coeff_x3", &coeff_x3)) coeff_x3="vzero.seismic.dat.trimmed.sample.smooth.grd"; if (!getparstring("coeff_x4", &coeff_x4)) coeff_x4="k.seismic.dat.trimmed.sample.smooth.grd"; if ( verbose ) { fprintf ( stderr, "\n" ); fprintf ( stderr, "WB TWT (ms.) GMT grid file name = %s\n", coeff_x ); fprintf ( stderr, "WB VAVG (m) GMT grid file name = %s\n", coeff_x2 ); fprintf ( stderr, "Seismic VZERO GMT grid file name = %s\n", coeff_x3 ); fprintf ( stderr, "Seismic K GMT grid file name = %s\n", coeff_x4 ); fprintf ( stderr, "Delta = %.10f\n", delta ); fprintf ( stderr, "Threshold = %f\n", thresh ); } GMT_boundcond_init (&edgeinfo_x); GMT_boundcond_init (&edgeinfo_x2); GMT_boundcond_init (&edgeinfo_x3); GMT_boundcond_init (&edgeinfo_x4); GMT_grd_init (&grd_x, argc, argv, FALSE); GMT_grd_init (&grd_x2, argc, argv, FALSE); GMT_grd_init (&grd_x3, argc, argv, FALSE); GMT_grd_init (&grd_x4, argc, argv, FALSE); if (GMT_read_grd_info (coeff_x, &grd_x)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_x2, &grd_x2)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_x3, &grd_x3)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_x4, &grd_x4)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); f1 = (float *) GMT_memory (VNULL, (size_t)((grd_x.nx + 4) * (grd_x.ny + 4)), sizeof(float), GMT_program); f2 = (float *) GMT_memory (VNULL, (size_t)((grd_x2.nx + 4) * (grd_x2.ny + 4)), sizeof(float), GMT_program); f3 = (float *) GMT_memory (VNULL, (size_t)((grd_x3.nx + 4) * (grd_x3.ny + 4)), sizeof(float), GMT_program); f4 = (float *) GMT_memory (VNULL, (size_t)((grd_x4.nx + 4) * (grd_x4.ny + 4)), sizeof(float), GMT_program); GMT_pad[0] = GMT_pad[1] = GMT_pad[2] = GMT_pad[3] = 2; GMT_boundcond_param_prep (&grd_x, &edgeinfo_x); GMT_boundcond_param_prep (&grd_x2, &edgeinfo_x2); GMT_boundcond_param_prep (&grd_x3, &edgeinfo_x3); GMT_boundcond_param_prep (&grd_x4, &edgeinfo_x4); GMT_boundcond_set (&grd_x, &edgeinfo_x, GMT_pad, f1); GMT_boundcond_set (&grd_x2, &edgeinfo_x2, GMT_pad, f2); GMT_boundcond_set (&grd_x3, &edgeinfo_x3, GMT_pad, f3); GMT_boundcond_set (&grd_x4, &edgeinfo_x4, GMT_pad, f4); GMT_bcr_init (&grd_x, GMT_pad, BCR_BSPLINE, 1, &bcr_x); GMT_bcr_init (&grd_x2, GMT_pad, BCR_BSPLINE, 1, &bcr_x2); GMT_bcr_init (&grd_x3, GMT_pad, BCR_BSPLINE, 1, &bcr_x3); GMT_bcr_init (&grd_x4, GMT_pad, BCR_BSPLINE, 1, &bcr_x4); GMT_read_grd (coeff_x, &grd_x, f1, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_x2, &grd_x2, f2, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_x3, &grd_x3, f3, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_x4, &grd_x4, f4, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); fpp = efopen (pfile, "r"); kount = 0; while (NULL != fgets ( temp, sizeof(temp), fpp )) { ++kount; (void) sscanf ( ((&(temp[0]))), "%lf%lf%lf%lf", &x_loc, &y_loc, &num, &sample ); } if ( verbose != 0) { fprintf (stderr,"\n"); fprintf (stderr,"Data file name = %s, number of input samples = %d\n", pfile, kount); fprintf (stderr,"\n"); } samp = ealloc1double ( kount ); datain = ealloc1double ( kount ); xloc_array = ealloc1double ( kount ); yloc_array = ealloc1double ( kount ); vzero_opt = ealloc1double ( kount ); k_opt = ealloc1double ( kount ); wb_twt_array = ealloc1double ( kount ); wb_z_array = ealloc1double ( kount ); rewind ( fpp ); kount = -1; while (NULL != fgets ( temp, sizeof(temp), fpp )) { ++kount; (void) sscanf ( ((&(temp[0]))), "%lf%lf%lf%lf", &x_loc, &y_loc, &num, &sample ); xloc_array[kount] = x_loc; yloc_array[kount] = y_loc; samp[kount] = num; datain[kount] = sample; if ( verbose == 2 ) fprintf ( stderr, "kount = %5d, x_loc = %12.2f, y_loc = %12.2f, num = %8.2f, sample = %8.2f\n", kount, xloc_array[kount], yloc_array[kount], samp[kount], datain[kount] ); } if ( verbose == 2 ) fprintf ( stderr, "\n" ); efclose (fpp); factor = 0.0005; nump1 = kount + 1; depth_water = error = zero; for ( i=0; i<=kount; i++ ) { check = 0; x_loc = xloc_array[i]; y_loc = yloc_array[i]; if ( x_loc >= grd_x.x_min && x_loc <= grd_x.x_max && y_loc >= grd_x.y_min && y_loc <= grd_x.y_max ) check = 1; if ( check ) { value_coeff_x = GMT_get_bcr_z (&grd_x, x_loc, y_loc, f1, &edgeinfo_x, &bcr_x); value_coeff_x2 = GMT_get_bcr_z (&grd_x2, x_loc, y_loc, f2, &edgeinfo_x2, &bcr_x2); value_coeff_x3 = GMT_get_bcr_z (&grd_x3, x_loc, y_loc, f3, &edgeinfo_x3, &bcr_x3); value_coeff_x4 = GMT_get_bcr_z (&grd_x4, x_loc, y_loc, f4, &edgeinfo_x4, &bcr_x4); if (GMT_is_dnan (value_coeff_x) || GMT_is_dnan (value_coeff_x2) || GMT_is_dnan (value_coeff_x3) || GMT_is_dnan (value_coeff_x4) ) { check = 0; } else { if ( value_coeff_x < 0.0 ) value_coeff_x *= -1.0; if ( value_coeff_x2 < 0.0 ) value_coeff_x2 *= -1.0; if ( value_coeff_x3 < 0.0 ) value_coeff_x3 *= -1.0; if ( value_coeff_x4 < 0.0 ) value_coeff_x4 *= -1.0; samp[i] -= value_coeff_x; depth_water = value_coeff_x * value_coeff_x2 * factor; datain[i] -= depth_water; wb_twt_array[i] = value_coeff_x; wb_z_array[i] = depth_water; if ( verbose == 3 ) fprintf ( stderr, "num = %5d, xloc = %10.2f yloc = %10.2f, WB TWT = %8.2f ms., WB Depth = %8.2f m., WB VEL = %8.2f mps., Vzero = %20.15f, K = %20.15f\n", i, x_loc, y_loc, value_coeff_x, depth_water, value_coeff_x2, value_coeff_x3, value_coeff_x4 ); vzero_opt[i] = value_coeff_x3; k_opt[i] = value_coeff_x4; } } } if ( verbose == 3 ) fprintf ( stderr, "\n" ); sum = zero; for ( i=0; i<=kount; i++ ) { vzero = vzero_opt[i]; k = k_opt[i]; x = samp[i]; y = ( vzero / k ) * ( exp ( k * x * factor ) - 1.0 ); error += abs ( y - datain[i] ); if ( verbose == 3 ) fprintf ( stderr, "%-5d %12.2f %12.2f %12.2f %12.4f %12.4f\n", i, x, datain[i], y, y - datain[i], error ); sign = 1.0; error = error1 = y - datain[i]; for (;;) { if ( abs(error1) < thresh ) break; vzero = vzero_opt[i]; k += ( delta * sign ); x = samp[i]; y = ( vzero / k ) * ( exp ( k * x * factor ) - 1.0 ); error1 = y - datain[i]; if ( verbose == 2 ) fprintf ( stderr, "%-5d %12.2f %12.2f %12.2f %12.4f\n", i, x, datain[i], y, error1 ); if ( (error1 > zero && error1 > error) || (error1 < zero && error1 < error) ) sign *= -1.0; } sum += abs ( y - datain[i] ); if ( verbose ) { fprintf ( stderr, "%-5d %12.2f %12.2f %12.2f %12.4f %12.4f\n", i, x, datain[i], y, y - datain[i], sum ); fprintf ( stderr, "%12.2f %12.2f ", xloc_array[i], yloc_array[i] ); fprintf ( stderr, "%30.25f %30.25f %8.2f %8.2f %8.2f\n", vzero, k, wb_twt_array[i], wb_z_array[i], sum / (float) nump1 ); } printf ( "%12.2f %12.2f ", xloc_array[i], yloc_array[i] ); printf ( "%30.25f %30.25f %8.2f %8.2f %8.2f\n", vzero, k, wb_twt_array[i], wb_z_array[i], sum / (float) nump1 ); } free1double (samp); free1double (datain); free1double (xloc_array); free1double (yloc_array); free1double (vzero_opt); free1double (k_opt); free1double (wb_twt_array); free1double (wb_z_array); GMT_free ((void *)f1); GMT_free ((void *)f2); GMT_free ((void *)f3); GMT_free ((void *)f4); GMT_end (argc, argv); return EXIT_SUCCESS; }
int main(int argc, char **argv) { int ix,it; /* loop counters */ int i,j,k; int ntr; /* number of input traces */ int nt; /* number of time samples */ int nx; /* number of horizontal samples */ float dt; /* Time sample interval */ float dx=1; /* horizontal sample interval */ float pminf; /* Minimum slope for Tau-P transform */ float pmaxf; /* Maximum slope for Tau-P transform */ float dpf; /* slope sampling interval */ int np; /* number of slopes for slant stack */ int nwin; /* spatial window length */ int npoints; /* number of points for rho filter */ float **twin; /* array[nwin][nt] of window traces */ float **pwin; /* array[np][nt] of sl traces */ int ntrw; /* number of traces in processing window */ /* full multiple of nwin */ int ist; /* start processing from this window */ int ntfft; float **traces; int w; /* flag to apply semblance weights */ int s; /* flag to apply smoothing weights */ int sl1; /* length of smoothing window */ int sl2; /* length of smoothing window */ float *smb; /* semblance weights */ double pw; float smbwin; int sn; float *spw; /* array of spatial weights */ float **out_traces; /* array[nx][nt] of output traces */ int verbose; /* flag for echoing information */ char *tmpdir; /* directory path for tmp files */ cwp_Bool istmpdir=cwp_false;/* true for user-given path */ float fh1; /* maximum frequency before taper */ float fh2; /* maximum frequency */ float prw; /* prewithening */ /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(1); if (!getparint("verbose", &verbose)) verbose = 0; /* Look for user-supplied tmpdir */ if (!getparstring("tmpdir",&tmpdir) && !(tmpdir = getenv("CWP_TMPDIR"))) tmpdir=""; if (!STREQ(tmpdir, "") && access(tmpdir, WRITE_OK)) err("you can't write in %s (or it doesn't exist)", tmpdir); /* get info from first trace */ if (!gettr(&tr)) err("can't get first trace"); nt = tr.ns; dt = (float) tr.dt/1000000.0; /* Store traces in tmpfile while getting a count */ if (STREQ(tmpdir,"")) { tracefp = etmpfile(); headerfp = etmpfile(); if (verbose) warn("using tmpfile() call"); } else { /* user-supplied tmpdir */ char directory[BUFSIZ]; strcpy(directory, tmpdir); strcpy(tracefile, temporary_filename(directory)); strcpy(headerfile, temporary_filename(directory)); /* Trap signals so can remove temp files */ signal(SIGINT, (void (*) (int)) closefiles); signal(SIGQUIT, (void (*) (int)) closefiles); signal(SIGHUP, (void (*) (int)) closefiles); signal(SIGTERM, (void (*) (int)) closefiles); tracefp = efopen(tracefile, "w+"); headerfp = efopen(headerfile, "w+"); istmpdir=cwp_true; if (verbose) warn("putting temporary files in %s", directory); } ntr = 0; do { ++ntr; efwrite(&tr, 1, HDRBYTES, headerfp); efwrite(tr.data, FSIZE, nt, tracefp); } while (gettr(&tr)); /* get general flags and parameters and set defaults */ if (!getparint("np",&np)) np = 25; if (!getparfloat("pminf",&pminf)) pminf = -0.01; if (!getparfloat("pmaxf",&pmaxf)) pmaxf = 0.01; if (!getparfloat("fh1",&fh1)) fh1 = 100; if (!getparfloat("fh2",&fh2)) fh2 = 120; if (!getparfloat("prw",&prw)) prw = 0.01; if (!getparfloat("dx",&dx)) dx = 1.0; if (!getparint("npoints",&npoints)) npoints = 71; if (!getparint("nwin",&nwin)) nwin= 5; if (!getparfloat("dt",&dt)) dt = dt; if (!getparfloat("smbwin",&smbwin)) smbwin = 0.05; if (!getpardouble("pw",&pw)) pw = 1.0; if (!getparint("w",&w)) w = 0; if (!getparint("s",&s)) s = 0; if (!getparint("sl1",&sl1)) sl1 = 2*nwin; if (!getparint("sl2",&sl2)) sl2 = nwin; nx = ntr; if (dt == 0.0) err("header field dt not set, must be getparred"); /* allocate space */ ntfft=npfar(nt); ntrw=nwin; while (ntrw < ntr) { ntrw+=nwin; } ist = ntrw-ntr/2; twin = alloc2float(nt, nwin); pwin = ealloc2float(ntfft,np); traces = alloc2float(nt, ntr); out_traces = alloc2float(nt, ntr); smb = ealloc1float(nt); /* Set up some constans*/ dpf=(pmaxf-pminf)/(np-1); sn = (int)(smbwin/dt+0.5); if(sn%2==0) sn++; if(nwin%2==0) nwin++; /* spatial trace weigths */ spw = ealloc1float(nwin); for(k=0,i=1;k<nwin/2+1;k++,i++) spw[k] = (float)i; for(k=nwin/2+1,i=nwin/2;k<nwin;k++,i--) spw[k] = (float)i; /* for(k=0,i=1;k<nwin;k++,i++) spw[k] =1.0; */ /* load traces into an array and close temp file */ erewind(headerfp); erewind(tracefp); memset( (void *) traces[0], (int) '\0', (nt*ntr)*FSIZE); memset( (void *) out_traces[0], (int) '\0', (nt*ntr)*FSIZE); for (ix=0; ix<ntr; ix++) fread (traces[ix], FSIZE, nt, tracefp); efclose (tracefp); if (istmpdir) eremove(tracefile); /* do requested operation */ for(i=0; i<ntr; i+=nwin/2) { memcpy( (void *) twin[0], (const void *) traces[i], nt*nwin*FSIZE); /* compute forward slant stack */ /* fwd_tx_sstack (dt, nt, nwin, -nwin/2*dx, dx, np, pminf, dpf, twin, pwin); */ forward_p_transform(nwin,nt,dt,pmaxf*1000.0,pminf*1000.0,dpf*1000.0, 0.0,fh1,fh2,3.0,30.0,400,5,1,0,0,1,prw, 0.0,nwin*dx,1,dx,0.0,0.0,0.0,twin,pwin); /* fwd_FK_sstack (dt, nt, nwin, -nwin/2*dx, dx, np, pminf, dpf,0, twin, pwin); */ /* compute semplance */ if(w==1) { semb(sn,pwin,np,nt,smb); /* apply weights */ for(j=0;j<nt;j++) for(k=0;k<np;k++) pwin[k][j] *=smb[j]; } if(s==1) { gaussian2d_smoothing (np,nt,sl2,sl1,pwin); } if(s==2) { dlsq_smoothing (nt,np,0,nt,0,np,sl1,sl2,0,pwin); } /* compute inverse slant stack */ /* inv_tx_sstack (dt, nt, nwin, npoints,-nwin/2*dx, dx, np,pminf,dpf, pwin, twin); */ inverse_p_transform(nwin,nt,dt,pmaxf*1000.0,pminf*1000.0,dpf*1000.0, 0.0,fh1,fh2,0.0,nwin*dx,1,dx,0.0, pwin,twin); /* inv_FK_sstack (dt, nt, nwin,-nwin/2*dx, dx, np,pminf,dpf,0, pwin, twin); */ { register int itr,it,spind;; for(itr=0;itr<nwin;itr++) { spind=i+itr; for(it=0;it<nt;it++) { if(spind>0 && spind<ntr) out_traces[spind][it] += spw[itr]*twin[itr][it]; /* out_traces[spind][it] = twin[itr][it]; */ } } } /* fprintf(stderr," Trace #= %5d\n",i); */ } /* write output traces */ erewind(headerfp); { register int itr; for (itr=0; itr<ntr; itr++) { efread(&tr, 1, HDRBYTES, headerfp); for (it=0; it<nt; it++) tr.data[it]=out_traces[itr][it]; puttr(&tr); } } efclose(headerfp); if (istmpdir) eremove(headerfile); /* free allocated space */ free2float(out_traces); free1float(spw); return EXIT_SUCCESS; }
int main (int argc, char **argv) { double vp,vs,eps,delta,gamma,phi,rho; double temp; /* v33,v44; */ char *outpar=NULL; /* name of file holding output parfile */ FILE *outparfp=NULL; /* ... its file pointer */ int sign; Stiff2D *spar1; spar1=(Stiff2D*)emalloc(sizeof(Stiff2D)); /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(0); if (!getpardouble("vp",&vp)) vp = 2.0; if (!getpardouble("vs",&vs)) vs = 1.0; if (!getpardouble("rho",&rho)) rho = 1; if (!getpardouble("eps",&eps)) eps = 0.; if (!getpardouble("delta",&delta)) delta = 0.; if (!getpardouble("gamma",&gamma)) gamma = 0.; if (!getpardouble("phi",&phi)) phi = 0.; if (!getparint("sign",&sign)) sign = 1; if (!getparstring("outpar", &outpar)) outpar = "/dev/tty" ; outparfp = efopen(outpar, "w"); if (!thom2stiffTI(vp,vs,eps,delta,gamma,phi*PI/180.,spar1,sign) ){ fprintf(stderr," problems in thom2stiffTI "); return (-1); } temp=spar1->a1111; fprintf(outparfp," a1111 = %f \t c1111 = %f \n",temp,temp*rho); temp=spar1->a3333; fprintf(outparfp," a3333 = %f \t c3333 = %f \n",temp,temp*rho); temp=spar1->a1133; fprintf(outparfp," a1133 = %f \t c1133 = %f \n",temp,temp*rho); temp=spar1->a1313; fprintf(outparfp," a1313 = %f \t c1313 = %f \n",temp,temp*rho); temp=spar1->a1212; fprintf(outparfp," a1212 = %f \t c1212 = %f \n",temp,temp*rho); temp=spar1->a2323; fprintf(outparfp," a2323 = %f \t c2323 = %f \n",temp,temp*rho); /* fprintf(outparfp," INPUT TO ANISYN: \n\n"); fprintf(outparfp," V11 = %f\n", sqrt(spar1->a1111)*1000); fprintf(outparfp," V22 = %f\n", sqrt(spar1->a3333)*1000); fprintf(outparfp," V33 = %f\n", sqrt(spar1->a3333)*1000); fprintf(outparfp," V44 = %f\n", sqrt(spar1->a2323)*1000); fprintf(outparfp," V55 = %f\n", sqrt(spar1->a1313)*1000); fprintf(outparfp," V66 = %f\n", sqrt(spar1->a1212)*1000); fprintf(outparfp," V12 = %f\n", sqrt(spar1->a1133)*1000); fprintf(outparfp," V13 = %f\n", sqrt(spar1->a1133)*1000); v33=sqrt(spar1->a3333)*1000; v44=sqrt(spar1->a2323)*1000; fprintf(outparfp," V23 = %f\n \n\n", sqrt(v33*v33-2*v44*v44)); */ return (1); }
int main(int argc, char **argv) { /* OUTPUT FILE POINTERS */ FILE *stalta=NULL; FILE *headerfp=NULL; /* temporary file for trace headers */ char *file=NULL; /* base of output file name(s) */ char *fname=NULL; /* complete output file name */ int nt; /* number of samples in one trace */ int nsta; /* number of samples for short term window */ int nlta; /* number of samples for long term window */ int verbose; /* design info flag */ int it; /* index for time sample in main loop */ double *data_trace; /* individual trace data */ double dt; /* sample spacing, sec */ // double nyq; /* nyquist frequency */ // double sta=0; /* short term avg. value */ // double lta=1.0e-99; /* long term avg. value */ double trigger; /* threshold value for detection */ double *charfct=NULL; /* output sta/lta trace */ cwp_Bool seismic; /* is this seismic data? */ /* Initialize */ initargs(argc, argv); requestdoc(1); /* Get info from first trace */ if (!gettr(&tr)) err("can't get first trace"); seismic = ISSEISMIC(tr.trid); if (!seismic) warn("input is not seismic data, trid=%d", tr.trid); if (!getparint("ns", &nt)) nt = tr.ns; if (!getpardouble("dt", &dt)) dt = ((double) tr.dt)/1000000.0; if (!dt) err("dt field is zero and not getparred"); /* Get Parameters */ if (!getparint("verbose", &verbose)) verbose = 0; if (!getparint("nlta", &nlta)) nlta = nt/ 10; if (!getparint("nsta", &nsta)) nsta = nlta / 10; if (!getparstring("file", &file)) file="sta_lta"; /* allocate space for input data and analysis vectors */ data_trace = ealloc1double(nt); data_trace-=1; /* open temporary file for trace headers */ headerfp = etmpfile(); /* set filenames and open files */ fname = malloc( strlen(file)+7 ); sprintf(fname, "%s.su", file); stalta = efopen(fname, "w"); free(fname); /* allocate and zero out space for output data */ charfct = ealloc1double(nt); memset((void *) charfct, 0, nt*FSIZE); /* Main loop over traces */ do { /* store trace header in temporary file and read data */ efwrite(&tr, HDRBYTES, 1, headerfp); memcpy((void *) data_trace, (const void *) &tr.data, nt*FSIZE); /* STA/LTA trace generation */ recstalta(data_trace, charfct, nt, nsta, nlta); fputdata(stalta, headerfp, charfct, nt); } while (gettr(&tr)); /* close files */ efclose(headerfp); efclose(stalta); return(CWP_Exit()); }
/* the main program */ int main (int argc, char **argv) { double vp1,vp2,vs1,vs2,rho1,rho2; double eps1,eps2,delta1,delta2,sangle; float fangle,langle,dangle,angle; double coeff,p=0; float anglef,dummy; FILE *outparfp=NULL, *coeffp=NULL; int ibin,modei,modet,rort,test,iangle,iscale; int axes1,axes2; char *outparfile=NULL,*coeffile=NULL; Stiff2D *spar1, *spar2; spar1=(Stiff2D*)emalloc(sizeof(Stiff2D)); spar2=(Stiff2D*)emalloc(sizeof(Stiff2D)); /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(0); if (!getparint("ibin",&ibin)) ibin = 1; if (!getparint("modei",&modei)) modei = 0; if (!getparint("modet",&modet)) modet = 0; if (!getparint("rort",&rort)) rort = 1; if (!getparint("iscale",&iscale)) iscale = 0; if (!getparint("axis1",&axes1)) axes1 = 0; if (!getparint("axis2",&axes2)) axes2 = 0; if(modei != 0 && modei !=1){ fprintf(stderr," ERROR wrong incidence mode \n"); return (-1); /* wrong mode */ } if(modet != 0 && modet !=1){ fprintf(stderr," ERROR wrong scattering mode \n"); return (-1); /* wrong mode */ } if(rort != 0 && rort !=1){ fprintf(stderr," ERROR wrong rort parameter \n"); return (-1); /* wrong mode */ } if(iscale != 0 && iscale !=1 && iscale !=2 && iscale!=3 ){ fprintf(stderr," ERROR wrong iscale parameter \n"); return (-1); /* wrong mode */ } if (!getparfloat("fangle",&fangle)) fangle = 0.0; if (!getparfloat("langle",&langle)) langle = 45.0; if (!getparfloat("dangle",&dangle)) dangle = 1.0; if (!getpardouble("vp1",&vp1)) vp1 = 2.0; if (!getpardouble("vp2",&vp2)) vp2 = 2.5; if (!getpardouble("vs1",&vs1)) vs1 = 1.0; if (!getpardouble("vs2",&vs2)) vs2 = 1.2; if (!getpardouble("rho1",&rho1)) rho1 = 2.7; if (!getpardouble("rho2",&rho2)) rho2 = 3.0; if (!getpardouble("eps1",&eps1)) eps1 = 0.; if (!getpardouble("eps2",&eps2)) eps2 = 0.; if (!getpardouble("delta1",&delta1)) delta1 = 0.; if (!getpardouble("delta2",&delta2)) delta2 = 0.; if (getparstring("outparfile",&outparfile)) { outparfp = efopen(outparfile,"w"); } else { outparfp = efopen("outpar","w"); } if (getparstring("coeffile",&coeffile)) { coeffp = efopen(coeffile,"w"); } else { coeffp = efopen("coeff.data","w"); } /* ddprint(vp1); ddprint(vs1); ddprint(rho1); ddprint(eps1); ddprint(delta1); diprint(axes1); ddprint(vp2); ddprint(vs2); ddprint(rho2); ddprint(eps2); ddprint(delta2); diprint(axes2); */ if (!thom2stiffTI(vp1,vs1,eps1,delta1,0.,axes1*PI/2.,spar1,1) ){ fprintf(stderr," ERROR in thom2stiffTI (1)"); return (-1); } if (!thom2stiffTI(vp2,vs2,eps2,delta2,0.,axes2*PI/2.,spar2,1) ){ fprintf(stderr," ERROR in thom2stiffTI (2)"); return (-1); } /* diprint(modei); diprint(modet); diprint(rort); ddprint(spar1->a1111); ddprint(spar1->a3333); ddprint(spar1->a1133); ddprint(spar1->a1313); ddprint(spar2->a1111); ddprint(spar2->a3333); ddprint(spar2->a1133); ddprint(spar2->a1313); */ for(angle=fangle,iangle=0;angle<=langle;angle+=dangle){ sangle = (double) sin(angle*PI/180.); /* determine horizontal slowness */ if(p_hor2DTI(spar1,sangle,modei,&p) == -1){ fprintf(stderr," ERROR in p_hoz2DTI \n"); return (-1); } /* compute reflection/transmission coefficient */ test=graebner2D(spar1,rho1,spar2,rho2,p, modei,modet,rort,&coeff); if(test==1){ ++iangle; if(iscale==0) anglef=(float) angle; else if(iscale==1) anglef=(float) angle*PI/180.; else if(iscale==2) anglef=(float) p; else if(iscale==3) anglef=(float) sangle*sangle; dummy= (float)coeff; /* Binary output for x_t */ if(ibin==1){ fwrite(&anglef,sizeof(float),1,coeffp); fwrite(&dummy,sizeof(float),1,coeffp); /* ASCII output */ } else if(ibin==0){ fprintf(coeffp,"%f %f\n",anglef,dummy); } } else if(test==-1) fprintf(stderr,"ERROR in graebner1 \n"); } if(ibin) fprintf(outparfp,"%i\n",iangle); return 1; }
int main(int argc, char **argv) { int i=0; /* counter */ int verbose=0; /* verbose flag =1 chatty, =0 silent */ int stepmax=0; /* maximum number of steps */ double t=0.0; /* time */ double h=.001; /* time increment */ double tol=0.0; /* time increment */ double y[3]= {0.0}; /* dependent variable of ODE system */ rke_variables p; /* variable used by RKE routines */ FILE *out_file=stdout; /* pointer to file that we write out to */ cwp_String mode="x"; /* output mode of program */ int imode=SXY; /* integer flag for mode */ /* Hook up getpar */ initargs(argc, argv); requestdoc(0); switch(filestat(STDOUT)) { /* Prevent floats from dumping on screen */ case BADFILETYPE: warn("stdout is illegal filetype"); pagedoc(); break; case TTY: warn("stdout can't be tty"); pagedoc(); break; default: /* rest are OK */ break; } /* Get parameters */ if (!getparint("stepmax", &stepmax)) stepmax = 500; if (!getparint("verbose", &verbose)) verbose = 0; if (!getpardouble("y0", &y[0])) y[0]=10; if (!getpardouble("h", &h)) h = .01; if (!getpardouble("tol", &tol)) tol = RKE_ERR_BIAS_INIT; /* Get output mode, recall imode initialized to the default FABS */ getparstring("mode", &mode); if (STREQ(mode, "yz")) imode = SYZ; else if (STREQ(mode, "xz")) imode = SXZ; else if (STREQ(mode, "x")) imode = SX; else if (STREQ(mode, "y")) imode = SY; else if (STREQ(mode, "z")) imode = SZ; else if (!STREQ(mode, "xy")) err("unknown operation=\"%s\", see self-doc", mode); /* initialize Runge-Kutta-England routines */ p = (rke_variables) rke_init(1, verhulst_equation); /* set tolerance */ p->error_bias=tol; for (i=0; i<stepmax; ++i) { register int j; register int number=3; float yout[3]= {0,0,0}; double aimed_t; t=i*h; aimed_t=t+h; if (verbose) { warn("using %3d accepted and %3d rejected steps", p->accepted_steps, p->rejected_steps); if (verbose) warn("error tolerance = %10.24f",p->error_bias); } /* convert doubles in y to floats in yout and write out */ for(j=0; j<number; ++j) yout[j] = (float) y[j]; /* write out according to the mode */ { float tmpout[2]= {0,0}; switch(imode) { case SXY: /* write out xy pairs */ tmpout[0]=yout[0]; tmpout[1]=yout[1]; efwrite(tmpout,sizeof(float),2,out_file); break; case SYZ: /* write out yz pairs */ tmpout[0]=yout[1]; tmpout[1]=yout[2]; efwrite(tmpout,sizeof(float),2,out_file); break; case SXZ: /* write out xz pairs */ tmpout[0]=yout[0]; tmpout[1]=yout[2]; efwrite(tmpout,sizeof(float),2,out_file); break; case SXYZ: /* write out xyz triplet */ efwrite(yout,sizeof(float),3,out_file); break; case SX: /* write out x only */ tmpout[0] = yout[0]; efwrite(tmpout,sizeof(float),1,out_file); break; case SY: /* write out y only */ tmpout[0] = yout[1]; efwrite(tmpout,sizeof(float),1,out_file); break; case SZ: /* write out z only */ tmpout[0] = yout[2]; efwrite(tmpout,sizeof(float),1,out_file); break; default: /* defensive programming */ err("mysterious operation=\"%s\"", mode); } /* end scope of imode */ } /* run the Runge-Kutta-England solver */ rke_solve (p, &t, y, aimed_t); } /* end the session with rke */ rke_term(p); return EXIT_SUCCESS; }
/* the main program */ int main (int argc, char **argv) { double vp1,vp2,vs1,vs2,rho1,rho2; double eps1,eps2,delta1,delta2; double gamma1,gamma2,azimuth; float fangle,langle,dangle,angle; double *coeff,p=0; double sangle,cangle,sazi,cazi; float anglef,dummy; FILE *outparfp=NULL, *coeffp=NULL; int ibin,modei,modet,rort,iangle,iscale,index; char *outparfile=NULL,*coeffile=NULL; Stiff2D *spar1, *spar2; double **a,*rcond,*z; int *ipvt; /* allocate space for stiffness elements */ spar1=(Stiff2D*)emalloc(sizeof(Stiff2D)); spar2=(Stiff2D*)emalloc(sizeof(Stiff2D)); /* allocate space for matrix system */ a = alloc2double(6,6); coeff = alloc1double(6); ipvt=alloc1int(6); z = alloc1double(6); rcond=alloc1double(6); /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(0); if (!getparint("ibin",&ibin)) ibin = 1; if (!getparint("modei",&modei)) modei = 0; if (!getparint("modet",&modet)) modet = 0; if (!getparint("rort",&rort)) rort = 1; if (!getparint("iscale",&iscale)) iscale = 0; if (!getparint("test",&test)) test = 1; if (!getparint("info",&info)) info = 0; if(modei != 0 && modei !=1 && modei !=2){ fprintf(stderr," \n ERROR wrong incidence mode \n"); return (-1); /* wrong mode */ } if(modet != 0 && modet !=1 && modet !=2){ fprintf(stderr," \n ERROR wrong scattering mode \n"); return (-1); /* wrong mode */ } if(rort != 0 && rort !=1){ fprintf(stderr," ERROR wrong rort parameter \n"); return (-1); /* wrong mode */ } if(iscale != 0 && iscale !=1 && iscale !=2 && iscale!=3 ){ fprintf(stderr," ERROR wrong iscale parameter \n"); return (-1); /* wrong mode */ } if (!getparfloat("fangle",&fangle)) fangle = 0.0; if (!getparfloat("langle",&langle)) langle = 45.0; if (!getparfloat("dangle",&dangle)) dangle = 1.0; if (!getpardouble("azimuth",&azimuth)) azimuth = 0.; if (!getpardouble("vp1",&vp1)) vp1 = 2.0; if (!getpardouble("vp2",&vp2)) vp2 = 2.0; if (!getpardouble("vs1",&vs1)) vs1 = 1.0; if (!getpardouble("vs2",&vs2)) vs2 = 1.0; if (!getpardouble("rho1",&rho1)) rho1 = 2.7; if (!getpardouble("rho2",&rho2)) rho2 = 2.7; if (!getpardouble("eps1",&eps1)) eps1 = 0.; if (!getpardouble("eps2",&eps2)) eps2 = 0.; if (!getpardouble("delta1",&delta1)) delta1 = 0.; if (!getpardouble("delta2",&delta2)) delta2 = 0.; if (!getpardouble("gamma1",&gamma1)) gamma1 = 0.; if (!getpardouble("gamma2",&gamma2)) gamma2 = 0.; if (getparstring("outparfile",&outparfile)) { outparfp = efopen(outparfile,"w"); } else { outparfp = efopen("outpar","w"); } if (getparstring("coeffile",&coeffile)) { coeffp = efopen(coeffile,"w"); } else { coeffp = efopen("coeff.data","w"); } /****** some debugging information ******************/ if(info){ ddprint(azimuth); ddprint(vp1); ddprint(vs1); ddprint(rho1); ddprint(eps1); ddprint(delta1); ddprint(gamma1); ddprint(vp2); ddprint(vs2); ddprint(rho2); ddprint(eps2); ddprint(delta2); ddprint(gamma2); } /* convert into rad */ azimuth=azimuth*PI /180.; sazi=sin(azimuth); cazi=cos(azimuth); /****** convertion into cij's ************************/ if (!thom2stiffTI(vp1,vs1,eps1,delta1,gamma1,PI/2.,spar1,1) ){ fprintf(stderr," \n ERROR in thom2stiffTI (1) \n"); return (-1); } if (!thom2stiffTI(vp2,vs2,eps2,delta2,gamma2,PI/2.,spar2,1) ){ fprintf(stderr,"\n ERROR in thom2stiffTI (2) \n"); return (-1); } /***** more debugging output ************************/ if(info){ diprint(modei); diprint(modet); diprint(rort); ddprint(spar1->a1111); ddprint(spar1->a3333); ddprint(spar1->a1133); ddprint(spar1->a1313); ddprint(spar1->a2323); ddprint(spar1->a1212); ddprint(spar2->a1111); ddprint(spar2->a3333); ddprint(spar2->a1133); ddprint(spar2->a1313); ddprint(spar2->a2323); ddprint(spar2->a1212); } /******** find generated wave type-index ************/ /* reflect_P (0) reflect_S (1) transm_P (2) transm_S (3) */ if(modet == 0 && rort==1) index = 0; else if(modet == 1 && rort==1) index = 1; else if(modet == 2 && rort==1) index = 2; else if(modet == 0 && rort==0) index = 3; else if(modet == 1 && rort==0) index = 4; else if(modet == 2 && rort==0) index = 5; else { fprintf(stderr,"\n ERROR wrong (index) \n "); return (-1); } /***************** LOOP OVER ANGLES ************************/ for(angle=fangle,iangle=0;angle<=langle;angle+=dangle){ if(info) ddprint(angle); sangle=(double) angle*PI/180; cangle=cos(sangle); sangle=sin(sangle); /* get horizontal slowness */ if(p_hor3DTIH(spar1,modei,sangle,cangle,sazi,cazi,&p)!=1){ fprintf(stderr,"\n ERROR in p_hor3DTIH \n "); return (-1); } /* compute reflection/transmission coefficient */ if(graebner3D(spar1,spar2,rho1,rho2,modei,modet,rort, sazi,cazi,p,coeff,a,ipvt,z,rcond)!=1){ fprintf(stderr,"\n ERROR in p_hor3DTIH \n "); return (-1); } ++iangle; if(iscale==0) anglef=(float) angle; else if(iscale==1) anglef=(float) angle*PI/180.; else if(iscale==2) anglef=(float) p; else if(iscale==3) anglef=(float) sangle*sangle; dummy= (float)coeff[index]; /* Binary output for x_t */ if(ibin==1){ fwrite(&anglef,sizeof(float),1,coeffp); fwrite(&dummy,sizeof(float),1,coeffp); /* ASCII output */ } else if(ibin==0){ fprintf(coeffp,"%f %f\n",anglef,dummy); } } /********* No of output pairs for plotting ********/ if(ibin) fprintf(outparfp,"%i\n",iangle); return 1; }
int main (int argc, char **argv) { char file[BUFSIZ]; char *coeff_top_k, *coeff_bottom_k; char *coeff_wb_twt, *coeff_top_twt, *coeff_middle_twt, *coeff_bottom_twt; char *coeff_middle_vint, *coeff_bottom_vint, *coeff_campan_vint; char *coeff_top_z, *coeff_bottom_z; struct GRD_HEADER grd_top_k, grd_bottom_k; struct GRD_HEADER grd_wb_twt, grd_top_twt, grd_middle_twt, grd_bottom_twt; struct GRD_HEADER grd_middle_vint, grd_bottom_vint, grd_campan_vint; struct GRD_HEADER grd_top_z, grd_bottom_z; struct GMT_EDGEINFO edgeinfo_top_k, edgeinfo_bottom_k; struct GMT_EDGEINFO edgeinfo_wb_twt, edgeinfo_top_twt, edgeinfo_middle_twt, edgeinfo_bottom_twt; struct GMT_EDGEINFO edgeinfo_middle_vint, edgeinfo_bottom_vint, edgeinfo_campan_vint; struct GMT_EDGEINFO edgeinfo_top_z, edgeinfo_bottom_z; struct GMT_BCR bcr_top_k, bcr_bottom_k; struct GMT_BCR bcr_wb_twt, bcr_top_twt, bcr_middle_twt, bcr_bottom_twt; struct GMT_BCR bcr_middle_vint, bcr_bottom_vint, bcr_campan_vint; struct GMT_BCR bcr_top_z, bcr_bottom_z; double value_coeff_top_k, value_coeff_bottom_k; double value_coeff_wb_twt, value_coeff_top_twt, value_coeff_middle_twt, value_coeff_bottom_twt; double value_coeff_middle_vint, value_coeff_bottom_vint, value_coeff_campan_vint; double value_coeff_top_z, value_coeff_bottom_z; short verbose; int scalar, nz, ntr, ns; double water_depth, vwater, ratio, factor1, dz, x_loc, y_loc; double tr_msec, tr_msec_orig, dt_msec, depth_input, amp_output; double delrt_depth, delta_twt, delta_k, gradient, K; double *tr_amp, *depth; register int k, n; initargs(argc, argv); argc = GMT_begin (argc, argv); if (!getparstring ("coeff_top_k", &coeff_top_k)) coeff_top_k = "/home/user/FIELD.new/PICKS/DEPTH_GRIDS/below.ml.K.grd"; if (!getparstring ("coeff_bottom_k", &coeff_bottom_k)) coeff_bottom_k = "/home/user/FIELD.new/PICKS/DEPTH_GRIDS/bottom.K.grd"; if (!getparstring ("coeff_wb_twt", &coeff_wb_twt)) coeff_wb_twt = "/home/user/FIELD.new/PICKS/wb.twt.grd"; if (!getparstring ("coeff_top_twt", &coeff_top_twt)) coeff_top_twt = "/home/user/FIELD.new/PICKS/TWT_GRIDS/01_FIELD_Top_Reservoir_twt.reform.dat.trimmed.grd"; if (!getparstring ("coeff_middle_twt", &coeff_middle_twt)) coeff_middle_twt = "/home/user/FIELD.new/PICKS/TWT_GRIDS/06_FIELD_C_top_twt.reform.dat.trimmed.grd"; if (!getparstring ("coeff_bottom_twt", &coeff_bottom_twt)) coeff_bottom_twt = "/home/user/FIELD.new/PICKS/TWT_GRIDS/10_FIELD_80MaSB_twt.reform.dat.trimmed.grd"; if (!getparstring ("coeff_middle_vint", &coeff_middle_vint)) coeff_middle_vint = "/home/user/FIELD.new/PICKS/VINT_GRIDS/vint.top_res.C_Sand.mps.filter.grd"; if (!getparstring ("coeff_bottom_vint", &coeff_bottom_vint)) coeff_bottom_vint = "/home/user/FIELD.new/PICKS/VINT_GRIDS/vint.C_Sand.80MaSB.mps.filter.grd"; if (!getparstring ("coeff_campan_vint", &coeff_campan_vint)) coeff_campan_vint = "/home/user/FIELD.new/PICKS/VINT_GRIDS/vint.top_res.80MaSB.mps.filter.grd"; if (!getparstring ("coeff_top_z", &coeff_top_z)) coeff_top_z = "/home/user/FIELD.new/PICKS/DEPTH_GRIDS/01_FIELD_Top_Reservoir.depth.new.grd"; if (!getparstring ("coeff_bottom_z", &coeff_bottom_z)) coeff_bottom_z = "/home/user/FIELD.new/PICKS/DEPTH_GRIDS/10_FIELD_80MaSB.depth.new.grd"; if (!getparshort ("verbose", &verbose)) verbose = 0; if ( verbose ) { fprintf ( stderr, "\n" ); fprintf ( stderr, "Top_K - GMT grid file name = %s\n", coeff_top_k ); fprintf ( stderr, "Bottom_K - GMT grid file name = %s\n", coeff_bottom_k ); fprintf ( stderr, "WB_TWT - GMT grid file name = %s\n", coeff_wb_twt ); fprintf ( stderr, "TOP_TWT - GMT grid file name = %s\n", coeff_top_twt ); fprintf ( stderr, "MIDDLE_TWT - GMT grid file name = %s\n", coeff_middle_twt ); fprintf ( stderr, "BOTTOM_TWT - GMT grid file name = %s\n", coeff_bottom_twt ); fprintf ( stderr, "MIDDLE_VINT - GMT grid file name = %s\n", coeff_middle_vint ); fprintf ( stderr, "BOTTOM_VINT - GMT grid file name = %s\n", coeff_bottom_vint ); fprintf ( stderr, "CAMPAN_VINT - GMT grid file name = %s\n", coeff_campan_vint ); fprintf ( stderr, "TOP_Z - GMT grid file name = %s\n", coeff_top_z ); fprintf ( stderr, "BOTTOM_Z - GMT grid file name = %s\n", coeff_bottom_z ); fprintf ( stderr, "\n" ); } GMT_boundcond_init (&edgeinfo_top_k); GMT_boundcond_init (&edgeinfo_bottom_k); GMT_boundcond_init (&edgeinfo_wb_twt); GMT_boundcond_init (&edgeinfo_top_twt); GMT_boundcond_init (&edgeinfo_middle_twt); GMT_boundcond_init (&edgeinfo_bottom_twt); GMT_boundcond_init (&edgeinfo_middle_vint); GMT_boundcond_init (&edgeinfo_bottom_vint); GMT_boundcond_init (&edgeinfo_campan_vint); GMT_boundcond_init (&edgeinfo_top_z); GMT_boundcond_init (&edgeinfo_bottom_z); GMT_grd_init (&grd_top_k, argc, argv, FALSE); GMT_grd_init (&grd_bottom_k, argc, argv, FALSE); GMT_grd_init (&grd_wb_twt, argc, argv, FALSE); GMT_grd_init (&grd_top_twt, argc, argv, FALSE); GMT_grd_init (&grd_middle_twt, argc, argv, FALSE); GMT_grd_init (&grd_bottom_twt, argc, argv, FALSE); GMT_grd_init (&grd_middle_vint, argc, argv, FALSE); GMT_grd_init (&grd_bottom_vint, argc, argv, FALSE); GMT_grd_init (&grd_campan_vint, argc, argv, FALSE); GMT_grd_init (&grd_top_z, argc, argv, FALSE); GMT_grd_init (&grd_bottom_z, argc, argv, FALSE); if (GMT_read_grd_info (coeff_top_k, &grd_top_k)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_bottom_k, &grd_bottom_k)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_wb_twt, &grd_wb_twt)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_top_twt, &grd_top_twt)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_middle_twt, &grd_middle_twt)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_bottom_twt, &grd_bottom_twt)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_middle_vint, &grd_middle_vint)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_bottom_vint, &grd_bottom_vint)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_campan_vint, &grd_campan_vint)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_top_z, &grd_top_z)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_bottom_z, &grd_bottom_z)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); f_top_k = (float *) GMT_memory (VNULL, (size_t)((grd_top_k.nx + 4) * (grd_top_k.ny + 4)), sizeof(float), GMT_program); f_bottom_k = (float *) GMT_memory (VNULL, (size_t)((grd_bottom_k.nx + 4) * (grd_bottom_k.ny + 4)), sizeof(float), GMT_program); f_wb_twt = (float *) GMT_memory (VNULL, (size_t)((grd_wb_twt.nx + 4) * (grd_wb_twt.ny + 4)), sizeof(float), GMT_program); f_top_twt = (float *) GMT_memory (VNULL, (size_t)((grd_top_twt.nx + 4) * (grd_top_twt.ny + 4)), sizeof(float), GMT_program); f_middle_twt = (float *) GMT_memory (VNULL, (size_t)((grd_middle_twt.nx + 4) * (grd_middle_twt.ny + 4)), sizeof(float), GMT_program); f_bottom_twt = (float *) GMT_memory (VNULL, (size_t)((grd_bottom_twt.nx + 4) * (grd_bottom_twt.ny + 4)), sizeof(float), GMT_program); f_middle_vint = (float *) GMT_memory (VNULL, (size_t)((grd_middle_vint.nx + 4) * (grd_middle_vint.ny + 4)), sizeof(float), GMT_program); f_bottom_vint = (float *) GMT_memory (VNULL, (size_t)((grd_bottom_vint.nx + 4) * (grd_bottom_vint.ny + 4)), sizeof(float), GMT_program); f_campan_vint = (float *) GMT_memory (VNULL, (size_t)((grd_campan_vint.nx + 4) * (grd_campan_vint.ny + 4)), sizeof(float), GMT_program); f_top_z = (float *) GMT_memory (VNULL, (size_t)((grd_top_z.nx + 4) * (grd_top_z.ny + 4)), sizeof(float), GMT_program); f_bottom_z = (float *) GMT_memory (VNULL, (size_t)((grd_bottom_z.nx + 4) * (grd_bottom_z.ny + 4)), sizeof(float), GMT_program); GMT_pad[0] = GMT_pad[1] = GMT_pad[2] = GMT_pad[3] = 2; GMT_boundcond_param_prep (&grd_top_k, &edgeinfo_top_k); GMT_boundcond_param_prep (&grd_bottom_k, &edgeinfo_bottom_k); GMT_boundcond_param_prep (&grd_wb_twt, &edgeinfo_wb_twt); GMT_boundcond_param_prep (&grd_top_twt, &edgeinfo_top_twt); GMT_boundcond_param_prep (&grd_middle_twt, &edgeinfo_middle_twt); GMT_boundcond_param_prep (&grd_bottom_twt, &edgeinfo_bottom_twt); GMT_boundcond_param_prep (&grd_middle_vint, &edgeinfo_middle_vint); GMT_boundcond_param_prep (&grd_bottom_vint, &edgeinfo_bottom_vint); GMT_boundcond_param_prep (&grd_campan_vint, &edgeinfo_campan_vint); GMT_boundcond_param_prep (&grd_top_z, &edgeinfo_top_z); GMT_boundcond_param_prep (&grd_bottom_z, &edgeinfo_bottom_z); GMT_boundcond_set (&grd_top_k, &edgeinfo_top_k, GMT_pad, f_top_k); GMT_boundcond_set (&grd_bottom_k, &edgeinfo_bottom_k, GMT_pad, f_bottom_k); GMT_boundcond_set (&grd_wb_twt, &edgeinfo_wb_twt, GMT_pad, f_wb_twt); GMT_boundcond_set (&grd_top_twt, &edgeinfo_top_twt, GMT_pad, f_top_twt); GMT_boundcond_set (&grd_middle_twt, &edgeinfo_middle_twt, GMT_pad, f_middle_twt); GMT_boundcond_set (&grd_bottom_twt, &edgeinfo_bottom_twt, GMT_pad, f_bottom_twt); GMT_boundcond_set (&grd_middle_vint, &edgeinfo_middle_vint, GMT_pad, f_middle_vint); GMT_boundcond_set (&grd_bottom_vint, &edgeinfo_bottom_vint, GMT_pad, f_bottom_vint); GMT_boundcond_set (&grd_campan_vint, &edgeinfo_campan_vint, GMT_pad, f_campan_vint); GMT_boundcond_set (&grd_top_z, &edgeinfo_top_z, GMT_pad, f_top_z); GMT_boundcond_set (&grd_bottom_z, &edgeinfo_bottom_z, GMT_pad, f_bottom_z); GMT_bcr_init (&grd_top_k, GMT_pad, BCR_BSPLINE, 1, &bcr_top_k); GMT_bcr_init (&grd_bottom_k, GMT_pad, BCR_BSPLINE, 1, &bcr_bottom_k); GMT_bcr_init (&grd_wb_twt, GMT_pad, BCR_BSPLINE, 1, &bcr_wb_twt); GMT_bcr_init (&grd_top_twt, GMT_pad, BCR_BSPLINE, 1, &bcr_top_twt); GMT_bcr_init (&grd_middle_twt, GMT_pad, BCR_BSPLINE, 1, &bcr_middle_twt); GMT_bcr_init (&grd_bottom_twt, GMT_pad, BCR_BSPLINE, 1, &bcr_bottom_twt); GMT_bcr_init (&grd_middle_vint, GMT_pad, BCR_BSPLINE, 1, &bcr_middle_vint); GMT_bcr_init (&grd_bottom_vint, GMT_pad, BCR_BSPLINE, 1, &bcr_bottom_vint); GMT_bcr_init (&grd_campan_vint, GMT_pad, BCR_BSPLINE, 1, &bcr_campan_vint); GMT_bcr_init (&grd_top_z, GMT_pad, BCR_BSPLINE, 1, &bcr_top_z); GMT_bcr_init (&grd_bottom_z, GMT_pad, BCR_BSPLINE, 1, &bcr_bottom_z); GMT_read_grd (coeff_top_k, &grd_top_k, f_top_k, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_bottom_k, &grd_bottom_k, f_bottom_k, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_wb_twt, &grd_wb_twt, f_wb_twt, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_top_twt, &grd_top_twt, f_top_twt, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_middle_twt, &grd_middle_twt, f_middle_twt, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_bottom_twt, &grd_bottom_twt, f_bottom_twt, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_middle_vint, &grd_middle_vint, f_middle_vint, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_bottom_vint, &grd_bottom_vint, f_bottom_vint, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_campan_vint, &grd_campan_vint, f_campan_vint, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_top_z, &grd_top_z, f_top_z, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_bottom_z, &grd_bottom_z, f_bottom_z, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); /* Get info from first trace */ ntr = gettra (&tr, 0); ns = tr.ns; scalar = abs ( tr.scalel ); if ( scalar == 0 ) scalar = 1; dt_msec = tr.dt * 0.001; if (!getpardouble ("dz",&dz)) dz = 1; if (!getpardouble ("vwater",&vwater)) vwater = 1452.05; if (!getparint ("nz",&nz)) nz = ns; if ( verbose ) { fprintf ( stderr, "Output depth sample rate (dz) = %f\n", dz ); fprintf ( stderr, "Number of output depth samples per trace = %d\n", nz ); fprintf ( stderr, "Number of traces = %d, number of samples per trace = %d\n", ntr, ns ); fprintf ( stderr, "Time sample rate (milliseconds) = %f\n", dt_msec ); fprintf ( stderr, "Vwater = %f (meters/second)\n", vwater ); fprintf ( stderr, "Location scalar = %d\n", scalar ); fprintf ( stderr, "\n" ); } rewind (stdin); if ( ns > nz ) { depth = ealloc1double ( ns ); } else { depth = ealloc1double ( nz ); } tr_amp = ealloc1double ( ns ); factor1 = 0.0005; delrt_depth = 0.0; /* Main loop over traces */ for ( k = 0; k < ntr; ++k ) { gettr (&tr); x_loc = tr.sx / scalar; y_loc = tr.sy / scalar; for ( n=ns; n < nz; ++n ) depth[n] = 0; if ( x_loc >= grd_wb_twt.x_min && x_loc <= grd_wb_twt.x_max && y_loc >= grd_wb_twt.y_min && y_loc <= grd_wb_twt.y_max ) { value_coeff_top_k = GMT_get_bcr_z (&grd_top_k, x_loc, y_loc, f_top_k, &edgeinfo_top_k, &bcr_top_k); value_coeff_bottom_k = GMT_get_bcr_z (&grd_bottom_k, x_loc, y_loc, f_bottom_k, &edgeinfo_bottom_k, &bcr_bottom_k); value_coeff_wb_twt = GMT_get_bcr_z (&grd_wb_twt, x_loc, y_loc, f_wb_twt, &edgeinfo_wb_twt, &bcr_wb_twt); value_coeff_top_twt = GMT_get_bcr_z (&grd_top_twt, x_loc, y_loc, f_top_twt, &edgeinfo_top_twt, &bcr_top_twt); value_coeff_middle_twt = GMT_get_bcr_z (&grd_middle_twt, x_loc, y_loc, f_middle_twt, &edgeinfo_middle_twt, &bcr_middle_twt); value_coeff_bottom_twt = GMT_get_bcr_z (&grd_bottom_twt, x_loc, y_loc, f_bottom_twt, &edgeinfo_bottom_twt, &bcr_bottom_twt); value_coeff_middle_vint = GMT_get_bcr_z (&grd_middle_vint, x_loc, y_loc, f_middle_vint, &edgeinfo_middle_vint, &bcr_middle_vint); value_coeff_bottom_vint = GMT_get_bcr_z (&grd_bottom_vint, x_loc, y_loc, f_bottom_vint, &edgeinfo_bottom_vint, &bcr_bottom_vint); value_coeff_campan_vint = GMT_get_bcr_z (&grd_campan_vint, x_loc, y_loc, f_campan_vint, &edgeinfo_campan_vint, &bcr_campan_vint); value_coeff_top_z = GMT_get_bcr_z (&grd_top_z, x_loc, y_loc, f_top_z, &edgeinfo_top_z, &bcr_top_z); value_coeff_bottom_z = GMT_get_bcr_z (&grd_bottom_z, x_loc, y_loc, f_bottom_z, &edgeinfo_bottom_z, &bcr_bottom_z); if ( GMT_is_dnan (value_coeff_wb_twt) || GMT_is_dnan (value_coeff_top_k) || GMT_is_dnan (value_coeff_top_twt) ||\ GMT_is_dnan (value_coeff_bottom_twt) || GMT_is_dnan (value_coeff_campan_vint) || GMT_is_dnan (value_coeff_bottom_k) ||\ GMT_is_dnan (value_coeff_top_z) || GMT_is_dnan (value_coeff_bottom_z) ) { for ( n=0; n < nz; ++n ) tr.data[n] = 0; tr.delrt = 0; tr.trid = 0; } else { water_depth = value_coeff_wb_twt * factor1 * vwater; ratio = vwater / value_coeff_top_k; if ( verbose == 2 ) { fprintf ( stderr, "\n" ); fprintf ( stderr, "Trace num = %5d X-Loc = %10.2f Y-Loc = %10.2f\n", k+1, x_loc, y_loc ); fprintf ( stderr, "Top_K = %8.5f\n", value_coeff_top_k ); fprintf ( stderr, "Bottom_K = %8.5f\n", value_coeff_bottom_k ); fprintf ( stderr, "WB_TWT = %8.2f\n", value_coeff_wb_twt ); fprintf ( stderr, "TOP_TWT = %8.2f\n", value_coeff_top_twt ); fprintf ( stderr, "MIDDLE_TWT = %8.2f\n", value_coeff_middle_twt ); fprintf ( stderr, "BOTTOM_TWT = %8.2f\n", value_coeff_bottom_twt ); fprintf ( stderr, "MIDDLE_VINT = %8.2f\n", value_coeff_middle_vint ); fprintf ( stderr, "BOTTOM_VINT = %8.2f\n", value_coeff_bottom_vint ); fprintf ( stderr, "CAMPANIAN_VINT = %8.2f\n", value_coeff_campan_vint ); fprintf ( stderr, "TOP_Z = %8.2f\n", value_coeff_top_z ); fprintf ( stderr, "BOTTOM_Z = %8.2f\n", value_coeff_bottom_z ); } delta_twt = value_coeff_bottom_twt - value_coeff_top_twt; delta_k = value_coeff_bottom_k - value_coeff_top_k; gradient = delta_k / delta_twt; for ( n=0; n < ns; ++n ) { tr_amp[n] = tr.data[n]; if ( tr.delrt == 0 ) { tr_msec = n * dt_msec; } else { tr_msec = tr.delrt + ( n * dt_msec ); } if ( tr_msec <= value_coeff_wb_twt ) { depth[n] = tr_msec * factor1 * vwater; if ( tr_msec <= tr.delrt ) delrt_depth = depth[n]; } else if ( tr_msec <= value_coeff_top_twt ) { tr_msec_orig = tr_msec; tr_msec = ( tr_msec - value_coeff_wb_twt ) * factor1; depth[n] = ( ratio * (exp (value_coeff_top_k*tr_msec) - 1.0) ) + water_depth; if ( tr_msec_orig <= tr.delrt ) delrt_depth = depth[n]; } else if ( tr_msec > value_coeff_top_twt && tr_msec <= value_coeff_bottom_twt ) { K = value_coeff_top_k + ( ( tr_msec - value_coeff_top_twt ) * gradient ); tr_msec_orig = tr_msec; tr_msec = ( tr_msec - value_coeff_wb_twt ) * factor1; ratio = vwater / K; depth[n] = ( ratio * (exp (K*tr_msec) - 1.0) ) + water_depth; if ( tr_msec_orig <= tr.delrt ) delrt_depth = depth[n]; /* fprintf ( stderr, "Trace = %5d, Sample = %5d, Top_TWT = %8.2f, TWT = %8.2f, Bottom_TWT = %8.2f, Top_Z = %8.2f, Depth = %8.2f, Bottom_Z = %8.2f, Delta_twt = %8.2f, Delta_K = %10.6f, Gradient = %10.6f, K = %10.6f\n",\ k, n, value_coeff_top_twt, n * dt_msec, value_coeff_bottom_twt, value_coeff_top_z, depth[n], value_coeff_bottom_z, delta_twt, delta_k, gradient, K ); */ } else if ( tr_msec > value_coeff_bottom_twt ) { tr_msec_orig = tr_msec; tr_msec = ( tr_msec - value_coeff_wb_twt ) * factor1; ratio = vwater / value_coeff_bottom_k; depth[n] = ( ratio * (exp (value_coeff_bottom_k*tr_msec) - 1.0) ) + water_depth; if ( tr_msec_orig <= tr.delrt ) delrt_depth = depth[n]; } } for ( n=0; n < nz; ++n ) { depth_input = n * dz; if ( depth_input < delrt_depth ) { tr.data[n] = 0.0; } else { dintlin ( ns, depth, tr_amp, tr_amp[0], tr_amp[ns-1], 1, &depth_input, &_output ); tr.data[n] = (float) amp_output; } } tr.trid = 1; } tr.ns = nz; tr.delrt = 0; tr.dt = nint(dz*1000); puttr (&tr); } else { fprintf ( stderr, "Input trace = %d, Xloc = %.0f Yloc = %.0f is out of bounds\n", k, x_loc, y_loc); } } GMT_free ((void *)f_top_k); GMT_free ((void *)f_bottom_k); GMT_free ((void *)f_wb_twt); GMT_free ((void *)f_top_twt); GMT_free ((void *)f_middle_twt); GMT_free ((void *)f_bottom_twt); GMT_free ((void *)f_middle_vint); GMT_free ((void *)f_bottom_vint); GMT_free ((void *)f_campan_vint); free1double (depth); free1double (tr_amp); GMT_end (argc, argv); return (0); }
int main (int argc, char **argv) { char *coeff_x, *coeff_x2, *coeff_x3, file[BUFSIZ]; cwp_Bool active = TRUE; struct GRD_HEADER grd_x, grd_x2, grd_x3; struct GMT_EDGEINFO edgeinfo_x, edgeinfo_x2, edgeinfo_x3; struct GMT_BCR bcr_x, bcr_x2, bcr_x3; short check, verbose; int nz, ntr, ns; double value, scale_factor, dz, x_loc, y_loc; double weight_x, weight_x2, weight_x3; double value_coeff_x, value_coeff_x2, value_coeff_x3, tr_sec, dt_sec; float depth_input, amp_output, *tr_amp, *depth; register int k, n; initargs(argc, argv); argc = GMT_begin (argc, argv); if (!getparstring("coeff_x", &coeff_x)) { fprintf ( stderr, "Must supply Coefficient_X GMT grid (COEFF_X Parameter) --> exiting\n" ); return EXIT_FAILURE; } if (!getparstring("coeff_x2", &coeff_x2)) { fprintf ( stderr, "Must supply Coefficient_X2 GMT grid (COEFF_X2 Parameter)--> exiting\n" ); return EXIT_FAILURE; } if (!getparstring("coeff_x3", &coeff_x3)) { fprintf ( stderr, "Must supply Coefficient_X3 GMT grid (COEFF_X3 Parameter)--> exiting\n" ); return EXIT_FAILURE; } if (!getparshort("verbose" , &verbose)) verbose = 0; if (!getpardouble("weight_x", &weight_x)) weight_x = 1.0; if (!getpardouble("weight_x2", &weight_x2)) weight_x2 = 1.0; if (!getpardouble("weight_x3", &weight_x3)) weight_x3 = 1.0; if ( verbose ) { fprintf ( stderr, "\n" ); fprintf ( stderr, "X1 Coefficient GMT grid file name = %s\n", coeff_x ); fprintf ( stderr, "X2 Coefficient GMT grid file name = %s\n", coeff_x2 ); fprintf ( stderr, "X3 Coefficient GMT grid file name = %s\n", coeff_x3 ); fprintf ( stderr, "X1 Grid Weighting Value = %f\n", weight_x ); fprintf ( stderr, "X2 Grid Weighting Value = %f\n", weight_x2 ); fprintf ( stderr, "X3 Grid Weighting Value = %f\n", weight_x3 ); fprintf ( stderr, "\n" ); } weight_x = 1.0 / weight_x; weight_x2 = 1.0 / weight_x2; weight_x3 = 1.0 / weight_x3; GMT_boundcond_init (&edgeinfo_x); GMT_boundcond_init (&edgeinfo_x2); GMT_boundcond_init (&edgeinfo_x3); GMT_grd_init (&grd_x, argc, argv, FALSE); GMT_grd_init (&grd_x2, argc, argv, FALSE); GMT_grd_init (&grd_x3, argc, argv, FALSE); if (GMT_read_grd_info (coeff_x, &grd_x)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_x2, &grd_x2)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); if (GMT_read_grd_info (coeff_x3, &grd_x3)) fprintf (stderr, "%s: Error opening file %s\n", GMT_program, file); f1 = (float *) GMT_memory (VNULL, (size_t)((grd_x.nx + 4) * (grd_x.ny + 4)), sizeof(float), GMT_program); f2 = (float *) GMT_memory (VNULL, (size_t)((grd_x2.nx + 4) * (grd_x2.ny + 4)), sizeof(float), GMT_program); f3 = (float *) GMT_memory (VNULL, (size_t)((grd_x3.nx + 4) * (grd_x3.ny + 4)), sizeof(float), GMT_program); GMT_pad[0] = GMT_pad[1] = GMT_pad[2] = GMT_pad[3] = 2; GMT_boundcond_param_prep (&grd_x, &edgeinfo_x); GMT_boundcond_param_prep (&grd_x2, &edgeinfo_x2); GMT_boundcond_param_prep (&grd_x3, &edgeinfo_x3); GMT_boundcond_set (&grd_x, &edgeinfo_x, GMT_pad, f1); GMT_boundcond_set (&grd_x2, &edgeinfo_x2, GMT_pad, f2); GMT_boundcond_set (&grd_x3, &edgeinfo_x3, GMT_pad, f3); value = 0.0; GMT_bcr_init (&grd_x, GMT_pad, active, value, &bcr_x); GMT_bcr_init (&grd_x2, GMT_pad, active, value, &bcr_x2); GMT_bcr_init (&grd_x3, GMT_pad, active, value, &bcr_x3); GMT_read_grd (coeff_x, &grd_x, f1, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_x2, &grd_x2, f2, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); GMT_read_grd (coeff_x3, &grd_x3, f3, 0.0, 0.0, 0.0, 0.0, GMT_pad, FALSE); /* Get info from first trace */ ntr = gettra (&tr, 0); ns = tr.ns; dt_sec = tr.dt * 0.000001; scale_factor = tr.scalco; if (scale_factor < 0.0 ) scale_factor *= -1.0; if (scale_factor == 0.0 ) scale_factor = 1.0; if (!getpardouble ("dz",&dz)) dz = 2.0; if (!getparint ("nz",&nz)) nz = ns; if ( verbose ) { fprintf ( stderr, "Output depth sample rate = %f\n", dz ); fprintf ( stderr, "Coordinate scale factor = %f\n", scale_factor ); fprintf ( stderr, "Number of output depth samples per trace = %d\n", nz ); fprintf ( stderr, "number of traces = %d, number of samples per trace = %d\n", ntr, ns ); fprintf ( stderr, "time sample rate (seconds) = %f\n", dt_sec ); } rewind (stdin); depth = ealloc1float ( ns ); tr_amp = ealloc1float ( nz ); /* Main loop over traces */ for ( k = 0; k < ntr; ++k ) { gettr (&tr); x_loc = tr.sx / scale_factor; y_loc = tr.sy / scale_factor; check = 0; if ( x_loc >= grd_x.x_min && x_loc <= grd_x.x_max && y_loc >= grd_x.y_min && y_loc <= grd_x.y_max ) check = 1; if ( check ) { value_coeff_x = GMT_get_bcr_z (&grd_x, x_loc, y_loc, f1, &edgeinfo_x, &bcr_x); value_coeff_x2 = GMT_get_bcr_z (&grd_x2, x_loc, y_loc, f2, &edgeinfo_x2, &bcr_x2); value_coeff_x3 = GMT_get_bcr_z (&grd_x3, x_loc, y_loc, f3, &edgeinfo_x3, &bcr_x3); if ( verbose ) fprintf ( stderr, "Trace num = %d, X-Loc = %f, Y-Loc = %f, X Coefficient = %0.10f, X2 Coefficient = %0.10f, X3 Coefficient = %0.10f\n", k+1, x_loc, y_loc, value_coeff_x, value_coeff_x2, value_coeff_x3 ); for ( n=0; n < ns; ++n ) { tr_amp[n] = tr.data[n]; tr_sec = n * dt_sec; depth[n] = (((value_coeff_x*tr_sec)*weight_x) + ((value_coeff_x2*pow(tr_sec,2))*weight_x2) + ((value_coeff_x3*pow(tr_sec,3))*weight_x3)) * -1.0; if ( verbose == 2 ) fprintf ( stderr, "Trace no. = %5d, Sample = %5d, TWT (secs.) = %.4f, Depth (feet) = %.4f\n", k, n, tr_sec, depth[n] ); } for ( n=0; n < nz; ++n ) { depth_input = n * dz; intlin ( ns, depth, tr_amp, tr_amp[0], tr_amp[ns-1], 1, &depth_input, &_output ); dtr.data[n] = amp_output; } dtr.tracl = tr.tracl; dtr.tracr = tr.tracr; dtr.ep = tr.ep; dtr.ns = nz; dtr.dt = nint (dz * 1000.0); dtr.sx = tr.sx; dtr.sy = tr.sy; dtr.trid = 1; dtr.fldr = tr.fldr; dtr.cdp = tr.cdp ; puttr (&dtr); } else { fprintf ( stderr, "input trace = %d, xloc = %.0f yloc = %.0f is out of bounds\n", k, x_loc, y_loc); } } GMT_free ((void *)f1); GMT_free ((void *)f2); GMT_free ((void *)f3); GMT_end (argc, argv); free1float (depth); free1float (tr_amp); return (0); }
int main(int argc, char **argv) { /********************* variables declaration **************************/ int info, itype, lda, ldb, lwork, order; /* variables for lapack function */ char jobz, uplo; /* variables for lapack function */ int nfreq; /* number of frequencies displayed on the screen */ int d; /* dimension of the problem - determine the size r of the partial basis*/ int shape; /* shape of the body */ int r; /* actual size of the partial basis */ int i, j; /* indices */ int ir1; int *itab, *ltab, *mtab, *ntab; /* tabulation of indices */ int *irk; int k; int ns; /* symmetry of the system */ int hextype; /* type of hexagonal symmetry - VTI or HTI*/ double d1, d2, d3; /* dimension of the sample */ double rho; /* density */ double **cm; double ****c; /* stiffness tensor */ double **e, **gamma, *work, **w; /* matrices of the eigenvalue problem */ double *wsort; int outeigen; /* 1 if eigenvectors calculated */ char *eigenfile; /** FILE *file; */ /********************* end variables declaration **********************/ /* hook up getpar to handle the parameters */ initargs(argc,argv); requestdoc(1); /* get required parameters */ if (!getparint("d", &d)) err("must specify d!\n"); if (!getpardouble("d1", &d1)) err("must specify d1!\n"); if (!getpardouble("d2", &d2)) err("must specify d2!\n"); if (!getpardouble("d3", &d3)) err("must specify d3!\n"); if (!getpardouble("rho", &rho)) err("must specify rho!\n"); if (!getparint("ns", &ns)) err("must specify ns!\n"); cm=ealloc2double(6,6); for (i=0; i<6; ++i) for (j=0; j<6; ++j) cm[i][j]=0.0; if (ns==2) { /* isotropic */ if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); cm[0][0]=cm[0][0]/100; cm[3][3]=cm[3][3]/100; cm[1][1]=cm[2][2]=cm[0][0]; cm[4][4]=cm[5][5]=cm[3][3]; cm[0][1]=cm[0][2]=cm[1][2]=cm[0][0]- 2.0*cm[3][3]; cm[1][0]=cm[2][0]=cm[2][1]=cm[0][0]- 2.0*cm[3][3]; } else if (ns==3) { /* cubic */ if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n"); if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); cm[0][0]=cm[0][0]/100; cm[0][1]=cm[0][1]/100; cm[3][3]=cm[3][3]/100; cm[1][1]=cm[2][2]=cm[0][0]; cm[4][4]=cm[5][5]=cm[3][3]; cm[0][2]=cm[1][2]=cm[0][1]; cm[2][0]=cm[2][1]=cm[1][0]=cm[0][1]; } else if (ns==5) { /* hexagonal */ if (!getparint("hextype", &hextype)) err("must specify hextype!\n"); if (hextype==1) { /* VTI */ if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n"); if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n"); if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n"); cm[2][2]=cm[2][2]/100; cm[1][2]=cm[1][2]/100; cm[0][1]=cm[0][1]/100; cm[3][3]=cm[3][3]/100; cm[5][5]=cm[5][5]/100; cm[0][0]=cm[1][1]=2.0*cm[5][5] + cm[0][1]; cm[0][2]=cm[2][0]=cm[2][1]=cm[1][2]; cm[1][0]=cm[0][1]; cm[4][4]=cm[3][3]; } else if (hextype==2) { /* HTI */ if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n"); if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n"); if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n"); cm[0][0]=cm[0][0]/100; cm[2][2]=cm[2][2]/100; cm[0][1]=cm[0][1]/100; cm[3][3]=cm[3][3]/100; cm[5][5]=cm[5][5]/100; cm[1][2]=cm[2][1]=cm[2][2] - 2.0*cm[3][3]; cm[0][2]=cm[1][0]=cm[2][0]=cm[0][1]; cm[1][1]=cm[2][2]; cm[4][4]=cm[5][5]; } else { err("for hexagonal symmetry hextype must equal 1 (VTI) or 2 (HTI)!\n"); } } else if (ns==6){ /* tetragonal */ if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n"); if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n"); if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n"); if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n"); cm[0][0]=cm[0][0]/100; cm[2][2]=cm[2][2]/100; cm[1][2]=cm[1][2]/100; cm[3][3]=cm[3][3]/100; cm[0][1]=cm[0][1]/100; cm[5][5]=cm[5][5]/100; cm[1][1]=cm[0][0]; cm[0][2]=cm[2][0]=cm[1][2]; cm[1][0]=cm[0][1]; cm[2][1]=cm[1][2]; cm[4][4]=cm[3][3]; } else if (ns==9){/* orthorhombic */ if (!getpardouble("c11", &cm[0][0])) err("must specify c11!\n"); if (!getpardouble("c22", &cm[1][1])) err("must specify c22!\n"); if (!getpardouble("c33", &cm[2][2])) err("must specify c33!\n"); if (!getpardouble("c23", &cm[1][2])) err("must specify c23!\n"); if (!getpardouble("c13", &cm[0][2])) err("must specify c13!\n"); if (!getpardouble("c12", &cm[0][1])) err("must specify c12!\n"); if (!getpardouble("c44", &cm[3][3])) err("must specify c44!\n"); if (!getpardouble("c55", &cm[4][4])) err("must specify c55!\n"); if (!getpardouble("c66", &cm[5][5])) err("must specify c66!\n"); cm[0][0]=cm[0][0]/100; cm[1][1]=cm[1][1]/100; cm[2][2]=cm[2][2]/100; cm[1][2]=cm[1][2]/100; cm[0][2]=cm[0][2]/100; cm[0][1]=cm[0][1]/100; cm[3][3]=cm[3][3]/100; cm[4][4]=cm[4][4]/100; cm[5][5]=cm[5][5]/100; cm[2][0]=cm[0][2]; cm[1][0]=cm[0][1]; cm[2][1]=cm[1][2]; } else err("given elatic moduli does not fit given ns"); /* get optional parameters */ if (!getparint("outeigen", &outeigen)) outeigen=0; if (outeigen!=0) if (!getparstring("eigenfile", &eigenfile)) err("must specify eigenfile since outeigen>0!\n"); if (!getparint("shape", &shape)) shape=1; /* changed from zero default to 1 */ if (!getparint("nfreq", &nfreq)) nfreq=10; /* dimension of the problem */ r= 3*(d+1)*(d+2)*(d+3)/6; d1=d1/2.0; /* half sample dimensions are used in calculations */ d2=d2/2.0; d3=d3/2.0; /* alloc work space*/ itab=ealloc1int(r); ltab=ealloc1int(r); mtab=ealloc1int(r); ntab=ealloc1int(r); /* relationship between ir and l,m,n - filling tables */ irk=ealloc1int(8); index_relationship(itab, ltab, mtab, ntab, d, irk); /* alloc workspace to solve for eigenvalues and eigenfunctions */ e= (double **) malloc(8*sizeof(double *)); for (k=0; k<8; ++k) e[k] = ealloc1double(irk[k]*irk[k]); gamma= (double **) malloc(8*sizeof(double *)); for (k=0; k<8; ++k) gamma[k] = ealloc1double(irk[k]*irk[k]); /* filling matrix e */ for (k=0; k<8; ++k) e_fill(e[k], itab, ltab, mtab, ntab, r, d1, d2, d3, rho, shape, k, irk); /* stiffness tensor calculation*/ c= (double ****) malloc(sizeof(double ***)*3); for (i=0; i<3; ++i) c[i]=ealloc3double(3,3,3); stiffness (c, cm); /* filling matrix gamma */ for (k=0; k<8; ++k) gamma_fill(gamma[k], itab, ltab, mtab, ntab, r, d1, d2, d3, c, shape, k, irk); /* clean workspace */ free1int(itab); free1int(ltab); free1int(mtab); free1int(ntab); for (i=0; i<3; ++i) free3double(c[i]); free(c); fprintf(stderr,"done preparing matrices\n"); /*-------------------------------------------------------------*/ /*--------- solve the generalized eigenvalue problem ----------*/ /*-------------------------------------------------------------*/ w= (double **) malloc(sizeof(double *)*8); itype=1; if (outeigen==0) jobz='N'; else jobz='V'; uplo='U'; for (k=0; k<8; ++k){ w[k] =ealloc1double(irk[k]); lda=ldb=irk[k]; order=irk[k]; lwork=MAX(1, 3*order-1); work=ealloc1double(lwork); /* lapack routine */ dsygv_(&itype, &jobz, &uplo, &order, gamma[k], &lda, e[k], &ldb, w[k], work, &lwork, &info); free1double(work); } /*-------------------------------------------------------------*/ /*-------------------------------------------------------------*/ /*-------------------------------------------------------------*/ wsort=ealloc1double(r); for (i=0, k=0; k<8; ++k) for (ir1=0;ir1<irk[k];++ir1,++i) wsort[i]=w[k][ir1]; /* sorting the eigenfrequencies */ dqksort(r,wsort); for (i=0, ir1=0; ir1<nfreq;++i) if ((wsort[i]>0) && ((sqrt(wsort[i])/(2.0*PI))>0.00001)){ ++ir1; /*fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI));*/ fprintf(stderr," f%d = %f\n", ir1, 1000000*sqrt(wsort[i])/(2.0*PI)); } /* modify output of freq values here*/ /* for (k=0;k<8;++k){ for (ir2=0;ir2<irk[k]*irk[k];++ir2){ fprintf(stderr,"gamma[%d][%d]=%f\n",k,ir2,gamma[k][ir2]); fprintf(stderr,"e[%d][%d]=%f\n",k,ir2,e[k][ir2]); } }*/ /******************* write eigenvectors in files ***************/ /*if (outeigen==1){ z=ealloc2double(r,r); for (ir1=0; ir1<r; ++ir1) for (ir2=0; ir2<r; ++ir2) z[ir2][ir1]=gamma[ir1][ir2*r+ir1]; */ /* change the order of the array at the same time */ /* since we go from fortran array */ /* to C array */ /* clean workspace */ /* free1double(gamma); file = efopen(eigenfile, "w"); efwrite(&irf, sizeof(int), 1, file); efwrite(w, sizeof(double), r, file); efwrite(z[0], sizeof(double), r*r, file); efclose(file);*/ /* clean workspace */ /* free2double(z); */ /* }*/ /* clean workspace */ /* free1double(w); */ /* end of main */ return EXIT_SUCCESS; }