main(int ac,char **av)
{
FILE *fopfile(), *fpr, *fpw;
float dip, dtop, flen, fwid, msum, dwid;
int i, nseg, nlen, nwid;
char *rchar, infile[512], str[1024], velfile[512];
struct velmodel vmod;
float moment = -1.0;
float mag = -1.0;
sprintf(infile,"stdin");
sprintf(velfile,"NOT_PROVIDED");
setpar(ac, av);
getpar("infile","s",infile);
getpar("velfile","s",velfile);
getpar("moment","f",&moment);
if(moment < 0.0)
mstpar("mag","f",&mag);
endpar();
if(mag > 0.0)
moment = exp(1.5*(mag+10.7)*log(10.0));
read_Fvelmodel(velfile,&vmod);
if(strcmp(infile,"stdin") == 0)
fpr = stdin;
else
fpr = fopfile(infile,"r");
fgets(str,1024,fpr);
while(strncmp(str,"#",1) == 0)
{
rchar = fgets(str,1024,fpr);
if(rchar == NULL)
{
fprintf(stderr,"Unexpected EOF in %s, exiting...\n",infile);
exit(-99);
}
}
sscanf(str,"%d",&nseg);
msum = 0.0;
for(i=0;i<nseg;i++)
{
fgets(str,1024,fpr);
sscanf(str,"%f %f %f %f %d %d",&dtop,&dip,&flen,&fwid,&nlen,&nwid);
dwid = fwid/nwid;
moment_sum(&vmod,&dtop,&dip,&flen,&dwid,nwid,&msum);
}
fclose(fpr);
fprintf(stdout,"average_slip= %.2f moment= %13.5e msum= %13.5e\n",moment/msum,moment,msum);
}
int main(int ac,char **av)
{
struct statdata shead1, shead2, shead3;
float *s1, *s2, *p;
float f1 = 1.0;
float f2 = 1.0;
float t1 = 0.0;
float t2 = 0.0;
char infile1[256];
char infile2[256];
char outfile[256];
int inbin1 = 0;
int inbin2 = 0;
int outbin = 0;
int it;
float add_rand = 0.0;
setpar(ac,av);
getpar("f1","f",&f1);
getpar("t1","f",&t1);
mstpar("infile1","s",infile1);
getpar("f2","f",&f2);
getpar("t2","f",&t2);
mstpar("infile2","s",infile2);
mstpar("outfile","s",outfile);
getpar("inbin1","d",&inbin1);
getpar("inbin2","d",&inbin2);
getpar("outbin","d",&outbin);
getpar("add_rand","f",&add_rand);
endpar();
s1 = NULL;
s1 = read_wccseis(infile1,&shead1,s1,inbin1);
s2 = NULL;
s2 = read_wccseis(infile2,&shead2,s2,inbin2);
p = (float *) check_malloc ((shead1.nt+shead2.nt)*size_float);
sum(s1,&shead1,&f1,&t1,s2,&shead2,&f2,&t2,p,&shead3);
strcpy(shead3.stat,shead1.stat);
strcpy(shead3.comp,shead1.comp);
sprintf(shead3.stitle,"summed output");
if(add_rand > (float)(0.0))
{
for(it=0;it<shead3.nt;it++)
p[it] = p[it] + add_rand*frand();
}
write_wccseis(outfile,&shead3,p,outbin);
}
int getpar(int x){
if(par[x]==x){
return x;
}
else{
return getpar(par[x]);
}
}
main(int ac,char **av)
{
char infile[256], outfile[256], new_version[256];
struct standrupformat srf1;
struct srf_prectsegments *prseg_ptr1;
struct srf_apointvalues *apval_ptr1;
int inbin = 0;
int outbin = 0;
int i, ioff;
sprintf(infile,"stdin");
sprintf(outfile,"stdout");
sprintf(new_version,"1.0");
setpar(ac,av);
getpar("infile","s",infile);
getpar("inbin","d",&inbin);
getpar("outfile","s",outfile);
getpar("outbin","d",&outbin);
getpar("new_version","s",new_version);
endpar();
read_srf(&srf1,infile,inbin);
strcpy(srf1.version,new_version);
/*
sprintf(srf1.srf_hcmnt.cbuf,"#\n");
sprintf((srf1.srf_hcmnt.cbuf)+MAXLINE,"# ");
sprintf((srf1.srf_hcmnt.cbuf)+2*MAXLINE,"#\n");
ioff = 2;
for(i=0;i<ac;i++)
{
sprintf((srf1.srf_hcmnt.cbuf)+ioff+MAXLINE,"%s ",av[i]);
while(srf1.srf_hcmnt.cbuf[ioff+MAXLINE] != '\0' && ioff < MAXLINE-2)
ioff++;
}
sprintf((srf1.srf_hcmnt.cbuf)+ioff+MAXLINE,"\n");
*/
write_srf(&srf1,outfile,outbin);
}
int main(){
ios::sync_with_stdio(0);
cin >> y >> x >> k >> w;
for(int i=1;i<=k;i++){
for(int j=0;j<y;j++)
for(int k=0;k<x;k++)
cin >> lvl[i][j][k];
}
vector< pair<int,pii> > E;
int kons=y*x;
for(int i=1;i<=k;i++)
E.pb(mp(kons,mp(0,i)));
for(int i=1;i<=k;i++)
for(int j=i+1;j<=k;j++)
E.pb(mp(dist(i,j),mp(i,j)));
sortv(E);
int res=0;
for(int i=0;i<=k;i++)par[i]=i;
for(int i=0;i<E.size();i++){
int D=E[i].f;
int a=E[i].s.f;
int b=E[i].s.s;
if(getpar(a)!=getpar(b)){
res+=D;
par[getpar(a)]=getpar(b);
V[a].pb(b);
V[b].pb(a);
}
}
cout << res << endl;
DFS(0,-1);
return 0;
}
main(int ac,char **av)
{
int nseg;
char infile[256], type[64], outfile[256];
struct standrupformat srf;
int vmax2slip = 0;
int inbin = 0;
float maxslip = 0.0;
int kp = -1;
sprintf(infile,"stdin");
sprintf(outfile,"stdout");
sprintf(type,"slip");
nseg = 0;
setpar(ac,av);
getpar("infile","s",infile);
getpar("outfile","s",outfile);
getpar("type","s",type);
getpar("nseg","d",&nseg);
getpar("inbin","d",&inbin);
getpar("vmax2slip","d",&vmax2slip);
getpar("maxslip","f",&maxslip);
getpar("kp","d",&kp);
endpar();
read_srf(&srf,infile,inbin);
if(vmax2slip == 1)
get_vmax2slip(outfile,&srf,type,nseg);
else
{
write_maxsvf(outfile,&srf,type,nseg,&maxslip,kp);
fprintf(stderr,"maxslip= %f\n",maxslip);
}
}
main(int ac,char **av)
{
char infile1[1024], infile2[1024], outfile[1024];
struct standrupformat srf1, srf2, srf3;
int inbin = 0;
int outbin = 0;
sprintf(outfile,"stdout");
setpar(ac,av);
mstpar("infile1","s",infile1);
mstpar("infile2","s",infile2);
getpar("outfile","s",outfile);
endpar();
read_srf(&srf1,infile1,inbin);
read_srf(&srf2,infile2,inbin);
join_segs(&srf1,&srf2,&srf3);
write_srf(&srf3,outfile,outbin);
}
/*
* continue to parse obsolete keywords so that old configurations can
* still work.
*/
void
mergeconf(Iobuf *p)
{
char word[Maxword+1];
char *cp;
Filsys *fs;
Fspar *fsp;
for (cp = p->iobuf; *cp != '\0'; cp++) {
cp = getwrd(word, cp);
if(word[0] == '\0')
break;
else if (word[0] == '#')
while (*cp != '\n' && *cp != '\0')
cp++;
else if(strcmp(word, "service") == 0) {
cp = getwrd(word, cp);
if(service[0] == 0)
strncpy(service, word, sizeof service);
} else if(strcmp(word, "ipauth") == 0) /* obsolete */
cp = getwrd(word, cp);
else if(astrcmp(word, "ip") == 0) /* obsolete */
cp = getwrd(word, cp);
else if(astrcmp(word, "ipgw") == 0) /* obsolete */
cp = getwrd(word, cp);
else if(astrcmp(word, "ipsntp") == 0) /* obsolete */
cp = getwrd(word, cp);
else if(astrcmp(word, "ipmask") == 0) /* obsolete */
cp = getwrd(word, cp);
else if(strcmp(word, "filsys") == 0) {
cp = getwrd(word, cp);
for(fs = filsys; fs < filsys + nelem(filsys) - 1 &&
fs->name; fs++)
if(strcmp(fs->name, word) == 0)
break;
if (fs >= filsys + nelem(filsys) - 1)
panic("out of filsys structures");
if (fs->name && strcmp(fs->name, word) == 0 &&
fs->flags & FEDIT)
cp = getwrd(word, cp); /* swallow conf */
else {
fs->name = strdup(word);
cp = getwrd(word, cp);
if (word[0] == '\0')
fs->conf = nil;
else
fs->conf = strdup(word);
}
} else if ((fsp = getpar(word)) != nil) {
cp = getwrd(word, cp);
if (!isascii(word[0]) || !isdigit(word[0]))
print("bad %s value: %s", fsp->name, word);
else
fsp->declared = atol(word);
} else {
putbuf(p);
panic("unknown keyword in config block: %s", word);
}
if(*cp != '\n') {
putbuf(p);
panic("syntax error in config block at `%s'", word);
}
}
}
main(int ac,char **av)
{
FILE *fpr, *fpw, *fopfile();
float *per, *resid, vs30, cdst, xcos, ycos, tmin, tmax;
float *bias, *sigma, *sigma0, *cl90m, *cl90p;
int nstat, nper, nval, i;
float min_cdst = -1e+15;
float max_cdst = 1e+15;
float min_vs30 = -1e+15;
float max_vs30 = 1e+15;
float min_xcos = -1e+15;
float max_xcos = 1e+15;
float min_ycos = -1e+15;
float max_ycos = 1e+15;
char residfile[256], fileroot[256], comp[16], rdcomp[16];
char *sptr, string[2048];
setpar(ac,av);
mstpar("residfile","s",residfile);
mstpar("fileroot","s",fileroot);
mstpar("comp","s",comp);
mstpar("nstat","d",&nstat);
mstpar("nper","d",&nper);
getpar("min_cdst","f",&min_cdst);
getpar("max_cdst","f",&max_cdst);
getpar("min_vs30","f",&min_vs30);
getpar("max_vs30","f",&max_vs30);
getpar("min_xcos","f",&min_xcos);
getpar("max_xcos","f",&max_xcos);
getpar("min_ycos","f",&min_ycos);
getpar("max_ycos","f",&max_ycos);
endpar();
per = (float *) check_malloc (nper*sizeof(float));
bias = (float *) check_malloc (nper*sizeof(float));
sigma = (float *) check_malloc (nper*sizeof(float));
sigma0 = (float *) check_malloc (nper*sizeof(float));
cl90m = (float *) check_malloc (nper*sizeof(float));
cl90p = (float *) check_malloc (nper*sizeof(float));
resid = (float *) check_malloc (nstat*nper*sizeof(float));
fpr = fopfile(residfile,"r");
fgets(string,2048,fpr);
sptr = skipval(13,string);
for(i=0;i<nper;i++)
sptr = getflt(&per[i],sptr);
nval = 0;
while(fgets(string,2048,fpr) != NULL)
{
sscanf(string,"%*s %*f %*s %*f %*f %*d %f %f %f %f %f %f %s",&vs30,&cdst,&xcos,&ycos,&tmin,&tmax,rdcomp);
if((vs30 >= min_vs30 && vs30 <= max_vs30) &&
(cdst >= min_cdst && cdst <= max_cdst) &&
(xcos >= min_xcos && xcos <= max_xcos) &&
(ycos >= min_ycos && ycos <= max_ycos) &&
(strcmp(rdcomp,comp)==0) )
{
sptr = skipval(13,string);
for(i=0;i<nper;i++)
sptr = getflt(&resid[i+nval*nper],sptr);
nval++;
}
if(nval>nstat)
{
fprintf(stderr,"(nval= %d) > (nstat= %d), exiting...\n",nval,nstat);
exit(-1);
}
}
fclose(fpr);
fprintf(stderr,"nval= %d\n",nval);
uncert(nval,nper,resid,bias,sigma,sigma0,cl90m,cl90p);
sprintf(string,"%s.bias",fileroot);
fpw = fopfile(string,"w");
for(i=0;i<nper;i++)
fprintf(fpw,"%13.5e %13.5e\n",per[i],bias[i]);
fclose(fpw);
sprintf(string,"%s.sigma",fileroot);
fpw = fopfile(string,"w");
for(i=0;i<nper;i++)
fprintf(fpw,"%13.5e %13.5e\n",per[i],sigma[i]);
fclose(fpw);
sprintf(string,"%s.sigma0",fileroot);
fpw = fopfile(string,"w");
for(i=0;i<nper;i++)
fprintf(fpw,"%13.5e %13.5e\n",per[i],sigma0[i]);
fclose(fpw);
sprintf(string,"%s.m90",fileroot);
fpw = fopfile(string,"w");
for(i=0;i<nper;i++)
fprintf(fpw,"%13.5e %13.5e\n",per[i],cl90m[i]);
fclose(fpw);
sprintf(string,"%s.p90",fileroot);
fpw = fopfile(string,"w");
for(i=0;i<nper;i++)
fprintf(fpw,"%13.5e %13.5e\n",per[i],cl90p[i]);
fclose(fpw);
}
int QtXmlWrapper::getpar127(const std::string &name, int defaultpar) const
{
return getpar(name, defaultpar, 0, 127);
}
int getpar(int i){
if(par[i]==i)return i;
return par[i]=getpar(par[i]);
}
main(int ac, char **av)
{
struct tsheader tsh;
float s1[10];
int i, it, ixp, iyp;
int np1_byte, off1, off2, off3;
int fdr, fdw1, fdw2, fdw3;
char in_tsfile[128], out_tsfile[128];
off_t off;
int swap_bytes = 0;
int inbin = 0;
int zero_tsfile = 0;
int nt = -1;
it = -1;
setpar(ac, av);
mstpar("in_tsfile","s",in_tsfile);
getpar("it","d",&it);
endpar();
fdr = opfile_ro(in_tsfile);
reed(fdr,&tsh,sizeof(struct tsheader));
if(swap_bytes)
{
swap_in_place(1,(char *)(&tsh.ix0));
swap_in_place(1,(char *)(&tsh.iy0));
swap_in_place(1,(char *)(&tsh.iz0));
swap_in_place(1,(char *)(&tsh.it0));
swap_in_place(1,(char *)(&tsh.nx));
swap_in_place(1,(char *)(&tsh.ny));
swap_in_place(1,(char *)(&tsh.nz));
swap_in_place(1,(char *)(&tsh.nt));
swap_in_place(1,(char *)(&tsh.dx));
swap_in_place(1,(char *)(&tsh.dy));
swap_in_place(1,(char *)(&tsh.dz));
swap_in_place(1,(char *)(&tsh.dt));
swap_in_place(1,(char *)(&tsh.modelrot));
swap_in_place(1,(char *)(&tsh.modellat));
swap_in_place(1,(char *)(&tsh.modellon));
}
fprintf(stderr,"ix= %d iy= %d iz= %d it= %d\n",tsh.ix0,tsh.iy0,tsh.iz0,tsh.it0);
fprintf(stderr,"nx= %d ny= %d nz= %d nt= %d\n",tsh.nx,tsh.ny,tsh.nz,tsh.nt);
fprintf(stderr,"dx= %12.4e dy= %12.4e dz= %12.4e dt= %12.4e\n",tsh.dx,tsh.dy,tsh.dz,tsh.dt);
fprintf(stderr,"lon= %10.4f lat= %10.4f rot= %10.4f\n",tsh.modellon,tsh.modellat,tsh.modelrot);
if(it<0)
off = (3*tsh.nx*tsh.ny*tsh.nt-5)*sizeof(float);
else
off = it*sizeof(float);
fprintf(stderr,"off= %20.0f\n",1.0*off);
fprintf(stderr,"off= %lld\n",off);
/*
split_bytes((char *)(&off),(char *)(&off1),(char *)(&off2));
*/
fprintf(stderr,"off2= %d off1= %d\n",off2,off1);
fprintf(stderr,"size= %d\n",sizeof(off_t));
fprintf(stderr,"size= %d\n",sizeof(off));
lseek(fdr,off,SEEK_CUR);
reed(fdr,s1,10*sizeof(float));
close(fdr);
for(i=0;i<10;i++)
fprintf(stderr,"s1[%d]= %13.5e\n",i,s1[i]);
}
main(int ac,char **av)
{
float *stf1, *stf2;
int it, i, ip, ig, ix, iy, ixp, iyp;
int ncoarsestk, ncoarsedip;
int ntot1, ntot2, *new_nstk, *new_ndip, *old_nstk, *old_ndip;
char infile[256], outfile[256];
struct standrupformat srf1, srf2;
struct srf_prectsegments *prseg_ptr1, *prseg_ptr2;
struct srf_apointvalues *apval_ptr1, *apval_ptr2;
int inbin = 0;
int outbin = 0;
sprintf(infile,"stdin");
sprintf(outfile,"stdout");
setpar(ac,av);
getpar("infile","s",infile);
getpar("inbin","d",&inbin);
getpar("outfile","s",outfile);
getpar("outbin","d",&outbin);
mstpar("ncoarsestk","d",&ncoarsestk);
mstpar("ncoarsedip","d",&ncoarsedip);
endpar();
read_srf(&srf1,infile,inbin);
strcpy(srf2.version,srf1.version);
copy_hcmnt(&srf2,&srf1);
if(strncmp(srf1.type,"PLANE",5) == 0)
{
strcpy(srf2.type,srf1.type);
srf2.srf_prect.nseg = srf1.srf_prect.nseg;
srf2.srf_prect.prectseg = (struct srf_prectsegments *)check_malloc(srf2.srf_prect.nseg*sizeof(struct srf_prectsegments));
prseg_ptr1 = srf1.srf_prect.prectseg;
prseg_ptr2 = srf2.srf_prect.prectseg;
old_nstk = (int *)check_malloc((srf1.srf_prect.nseg)*sizeof(int));
old_ndip = (int *)check_malloc((srf1.srf_prect.nseg)*sizeof(int));
new_nstk = (int *)check_malloc((srf2.srf_prect.nseg)*sizeof(int));
new_ndip = (int *)check_malloc((srf2.srf_prect.nseg)*sizeof(int));
for(ig=0;ig<srf2.srf_prect.nseg;ig++)
{
prseg_ptr2[ig].elon = prseg_ptr1[ig].elon;
prseg_ptr2[ig].elat = prseg_ptr1[ig].elat;
prseg_ptr2[ig].nstk = (int)((1.0*prseg_ptr1[ig].nstk/ncoarsestk + 0.5));
prseg_ptr2[ig].ndip = (int)((1.0*prseg_ptr1[ig].ndip/ncoarsedip + 0.5));
prseg_ptr2[ig].flen = prseg_ptr2[ig].nstk*ncoarsestk*(prseg_ptr1[ig].flen/prseg_ptr1[ig].nstk);
prseg_ptr2[ig].fwid = prseg_ptr2[ig].ndip*ncoarsedip*(prseg_ptr1[ig].fwid/prseg_ptr1[ig].ndip);
prseg_ptr2[ig].stk = prseg_ptr1[ig].stk;
prseg_ptr2[ig].dip = prseg_ptr1[ig].dip;
prseg_ptr2[ig].dtop = prseg_ptr1[ig].dtop;
prseg_ptr2[ig].shyp = prseg_ptr1[ig].shyp;
prseg_ptr2[ig].dhyp = prseg_ptr1[ig].dhyp;
old_nstk[ig] = prseg_ptr1[ig].nstk;
old_ndip[ig] = prseg_ptr1[ig].ndip;
new_nstk[ig] = prseg_ptr2[ig].nstk;
new_ndip[ig] = prseg_ptr2[ig].ndip;
}
}
srf2.nseg = srf1.nseg;
srf2.np_seg = (int *)check_malloc((srf2.nseg)*sizeof(int));
if(atof(srf2.version) < 2.0)
{
for(ig=1;ig<srf2.nseg;ig++)
{
old_nstk[0] = old_nstk[0] + old_nstk[ig];
new_nstk[0] = new_nstk[0] + new_nstk[ig];
}
srf2.np_seg[0] = new_nstk[0]*new_ndip[0];
srf2.srf_apnts.np = new_nstk[0]*new_ndip[0];
}
else if(atof(srf2.version) >= 2.0)
{
srf2.srf_apnts.np = 0;
for(ig=0;ig<srf2.nseg;ig++)
{
srf2.np_seg[ig] = new_nstk[ig]*new_ndip[ig];
srf2.srf_apnts.np = srf2.srf_apnts.np + srf2.np_seg[ig];
}
}
srf2.srf_apnts.apntvals = (struct srf_apointvalues *)check_malloc((srf2.srf_apnts.np)*sizeof(struct srf_apointvalues));
apval_ptr1 = srf1.srf_apnts.apntvals;
apval_ptr2 = srf2.srf_apnts.apntvals;
ntot1 = 0;
ntot2 = 0;
for(ig=0;ig<srf2.nseg;ig++)
{
for(iy=0;iy<new_ndip[ig];iy++)
{
iyp = (int)((float)(iy + 0.5)*ncoarsedip);
for(ix=0;ix<new_nstk[ig];ix++)
{
ixp = (int)((float)(ix + 0.5)*ncoarsestk);
i = ix + iy*new_nstk[ig] + ntot2;
ip = ixp + iyp*old_nstk[ig] + ntot1;
apval_ptr2[i].lon = apval_ptr1[ip].lon;
apval_ptr2[i].lat = apval_ptr1[ip].lat;
apval_ptr2[i].dep = apval_ptr1[ip].dep;
apval_ptr2[i].stk = apval_ptr1[ip].stk;
apval_ptr2[i].dip = apval_ptr1[ip].dip;
apval_ptr2[i].area = apval_ptr1[ip].area*(ncoarsestk*ncoarsedip);
apval_ptr2[i].tinit = apval_ptr1[ip].tinit;
apval_ptr2[i].dt = apval_ptr1[ip].dt;
apval_ptr2[i].vs = apval_ptr1[ip].vs;
apval_ptr2[i].den = apval_ptr1[ip].den;
apval_ptr2[i].rake = apval_ptr1[ip].rake;
apval_ptr2[i].slip1 = apval_ptr1[ip].slip1;
apval_ptr2[i].nt1 = apval_ptr1[ip].nt1;
apval_ptr2[i].slip2 = apval_ptr1[ip].slip2;
apval_ptr2[i].nt2 = apval_ptr1[ip].nt2;
apval_ptr2[i].slip3 = apval_ptr1[ip].slip3;
apval_ptr2[i].nt3 = apval_ptr1[ip].nt3;
apval_ptr2[i].stf1 = (float *)check_malloc((apval_ptr2[i].nt1)*sizeof(float));
apval_ptr2[i].stf2 = (float *)check_malloc((apval_ptr2[i].nt2)*sizeof(float));
apval_ptr2[i].stf3 = (float *)check_malloc((apval_ptr2[i].nt3)*sizeof(float));
stf1 = apval_ptr1[ip].stf1;
stf2 = apval_ptr2[i].stf1;
for(it=0;it<apval_ptr2[i].nt1;it++)
stf2[it] = stf1[it];
stf1 = apval_ptr1[ip].stf2;
stf2 = apval_ptr2[i].stf2;
for(it=0;it<apval_ptr2[i].nt2;it++)
stf2[it] = stf1[it];
stf1 = apval_ptr1[ip].stf3;
stf2 = apval_ptr2[i].stf3;
for(it=0;it<apval_ptr2[i].nt3;it++)
stf2[it] = stf1[it];
}
}
ntot1 = ntot1 + srf1.np_seg[ig];
ntot2 = ntot2 + srf2.np_seg[ig];
}
write_srf(&srf2,outfile,outbin);
}
int main(int ac,char **av)
{
struct statdata head1;
float *s1, vref, vsite, vpga;
float *ampf;
int nt_p2;
float tap_per = TAP_PERC;
float pga = -1.0;
float fmin = 0.1;
float fmax = 15.0;
float flowcap = 0.0; /* ampf for f<flowcap set equal to ampf[f=flowcap], (caps low-freq amplification level) */
char infile[128];
char outfile[128];
char model[128];
int inbin = 0;
int outbin = 0;
float fmidbot = 0.2; /* bottom-end of middle frequency range */
float fmid = 1.0; /* center of middle frequency range */
float fhigh = 3.333; /* center of high frequency range */
float fhightop = 10.0; /* top-end of high frequency range */
/*
sprintf(model,"borcherdt");
*/
sprintf(model,"cb2014");
setpar(ac,av);
mstpar("infile","s",infile);
mstpar("outfile","s",outfile);
mstpar("vref","f",&vref);
mstpar("vsite","f",&vsite);
getpar("model","s",model);
getpar("pga","f",&pga);
vpga = vref;
getpar("vpga","f",&vpga);
getpar("flowcap","f",&flowcap);
getpar("tap_per","f",&tap_per);
getpar("fmin","f",&fmin);
getpar("fmidbot","f",&fmidbot);
getpar("fmid","f",&fmid);
getpar("fhigh","f",&fhigh);
getpar("fhightop","f",&fhightop);
getpar("fmax","f",&fmax);
getpar("inbin","d",&inbin);
getpar("outbin","d",&outbin);
endpar();
if(strncmp(model,"borcherdt",9) != 0 && strncmp(model,"cb2008",6) != 0 && strncmp(model,"bssa2014",6) != 0)
sprintf(model,"cb2014");
s1 = NULL;
s1 = read_wccseis(infile,&head1,s1,inbin);
nt_p2 = getnt_p2(head1.nt);
s1 = (float *) check_realloc (s1,nt_p2*size_float);
ampf = (float *) check_malloc ((nt_p2/2)*size_float);
if(pga < 0.0)
getpeak(s1,head1.nt,&pga);
else
fprintf(stderr,"*** External PGA used: ");
fprintf(stderr,"pga= %13.5e\n",pga);
taper_norm(s1,&head1.dt,head1.nt,&tap_per);
zero(s1+head1.nt,(nt_p2)-head1.nt);
forfft((struct complex *)s1,nt_p2,-1);
if(strncmp(model,"cb2014",6) == 0)
cb2014_ampf(ampf,&head1.dt,nt_p2,&vref,&vsite,&vpga,&pga,&fmin,&fmidbot,&fmid,&fhigh,&fhightop,&fmax,&flowcap);
else if(strncmp(model,"bssa2014",8) == 0)
bssa2014_ampf(ampf,&head1.dt,nt_p2,&vref,&vsite,&vpga,&pga,&fmin,&fmidbot,&fmid,&fhigh,&fhightop,&fmax,&flowcap);
else if(strncmp(model,"cb2008",6) == 0)
cb2008_ampf(ampf,&head1.dt,nt_p2,&vref,&vsite,&vpga,&pga,&fmin,&fmidbot,&fmid,&fhigh,&fhightop,&fmax,&flowcap);
else
borch_ampf(ampf,&head1.dt,nt_p2,&vref,&vsite,&pga,&fmin,&fmidbot,&fmid,&fhigh,&fhightop,&fmax);
ampfac((struct complex *)s1,ampf,nt_p2);
invfft((struct complex *)s1,nt_p2,1);
norm(s1,&head1.dt,nt_p2);
write_wccseis(outfile,&head1,s1,outbin);
}
uint32_t
decode_time(uint8_t init_min, uint8_t minlen, uint32_t acc_minlen,
const uint8_t * const buffer, struct tm * const time)
{
struct tm newtime;
uint32_t rval = 0;
int16_t increase, i;
uint8_t tmp0, tmp1, tmp2, tmp3, tmp4, tmp5, utchour;
int8_t centofs;
bool generr, p1, p2, p3, ok;
static uint32_t acc_minlen_partial, old_acc_minlen;
static bool olderr, prev_toolong;
memset(&newtime, 0, sizeof(newtime));
/* Initially, set time offset to unknown */
if (init_min == 2)
time->tm_isdst = -1;
newtime.tm_isdst = time->tm_isdst; /* save DST value */
if (minlen < 59)
rval |= DT_SHORT;
if (minlen > 60)
rval |= DT_LONG;
if (buffer[0] == 1)
rval |= DT_B0;
if (buffer[20] == 0)
rval |= DT_B20;
if (buffer[17] == buffer[18])
rval |= DT_DSTERR;
generr = (rval != 0); /* do not decode if set */
if (buffer[15] == 1)
rval |= DT_XMIT;
/* See if there are any partial / split minutes to be combined: */
if (acc_minlen <= 59000) {
acc_minlen_partial += acc_minlen;
if (acc_minlen_partial >= 60000) {
acc_minlen = acc_minlen_partial;
acc_minlen_partial %= 60000;
}
}
/* Calculate number of minutes to increase time with: */
if (prev_toolong)
increase = (int16_t)((acc_minlen - old_acc_minlen) / 60000);
else
increase = (int16_t)(acc_minlen / 60000);
if (acc_minlen >= 60000)
acc_minlen_partial %= 60000;
/* Account for complete minutes with a short acc_minlen: */
if (acc_minlen % 60000 > 59000) {
increase++;
acc_minlen_partial %= 60000;
}
prev_toolong = (minlen == 0xff);
old_acc_minlen = acc_minlen - (acc_minlen % 60000);
/* There is no previous time on the very first (partial) minute: */
if (init_min < 2) {
for (i = increase; increase > 0 && i > 0; i--)
add_minute(time, true);
for (i = increase; increase < 0 && i < 0; i++)
substract_minute(time, false);
}
p1 = getpar(buffer, 21, 28);
tmp0 = getbcd(buffer, 21, 24);
tmp1 = getbcd(buffer, 25, 27);
if (!p1 || tmp0 > 9 || tmp1 > 5) {
rval |= DT_MIN;
p1 = false;
}
if ((init_min == 2 || increase != 0) && p1 && !generr) {
newtime.tm_min = (int)(tmp0 + 10 * tmp1);
if (init_min == 0 && time->tm_min != newtime.tm_min)
rval |= DT_MINJUMP;
}
p2 = getpar(buffer, 29, 35);
tmp0 = getbcd(buffer, 29, 32);
tmp1 = getbcd(buffer, 33, 34);
if (!p2 || tmp0 > 9 || tmp1 > 2 || tmp0 + 10 * tmp1 > 23) {
rval |= DT_HOUR;
p2 = false;
}
if ((init_min == 2 || increase != 0) && p2 && !generr) {
newtime.tm_hour = (int)(tmp0 + 10 * tmp1);
if (init_min == 0 && time->tm_hour != newtime.tm_hour)
rval |= DT_HOURJUMP;
}
p3 = getpar(buffer, 36, 58);
tmp0 = getbcd(buffer, 36, 39);
tmp1 = getbcd(buffer, 40, 41);
tmp2 = getbcd(buffer, 42, 44);
tmp3 = getbcd(buffer, 45, 48);
tmp4 = getbcd(buffer, 50, 53);
tmp5 = getbcd(buffer, 54, 57);
if (!p3 || tmp0 > 9 || tmp0 + 10 * tmp1 == 0 ||
tmp0 + 10 * tmp1 > 31 || tmp2 == 0 || tmp3 > 9 ||
tmp3 + 10 * buffer[49] == 0 || tmp3 + 10 * buffer[49] > 12 ||
tmp4 > 9 || tmp5 > 9) {
rval |= DT_DATE;
p3 = false;
}
if ((init_min == 2 || increase != 0) && p3 && !generr) {
newtime.tm_mday = (int)(tmp0 + 10 * tmp1);
newtime.tm_mon = (int)(tmp3 + 10 * buffer[49]);
newtime.tm_year = (int)(tmp4 + 10 * tmp5);
newtime.tm_wday = (int)tmp2;
if (init_min == 0 && time->tm_mday != newtime.tm_mday)
rval |= DT_MDAYJUMP;
if (init_min == 0 && time->tm_wday != newtime.tm_wday)
rval |= DT_WDAYJUMP;
if (init_min == 0 && time->tm_mon != newtime.tm_mon)
rval |= DT_MONTHJUMP;
centofs = century_offset(newtime);
if (centofs == -1) {
rval |= DT_DATE;
p3 = false;
} else {
if (init_min == 0 && time->tm_year !=
(int)(BASEYEAR + 100 * centofs + newtime.tm_year))
rval |= DT_YEARJUMP;
newtime.tm_year += BASEYEAR + 100 * centofs;
if (newtime.tm_mday > (int)lastday(newtime)) {
rval |= DT_DATE;
p3 = false;
}
}
}
ok = !generr && p1 && p2 && p3; /* shorthand */
utchour = get_utchour(*time);
/*
* h==23, last day of month (UTC) or h==0, first day of next month (UTC)
* according to IERS Bulletin C
* flag still set at 00:00 UTC, prevent DT_LEAPERR
*/
if (buffer[19] == 1 && ok) {
if (time->tm_mday == 1 && is_leapsecmonth(*time) &&
((time->tm_min > 0 && utchour == 23) ||
(time->tm_min == 0 && utchour == 0)))
announce |= ANN_LEAP;
else {
announce &= ~ANN_LEAP;
rval |= DT_LEAPERR;
}
}
/* process possible leap second, always reset announcement at hh:00 */
if (((announce & ANN_LEAP) == ANN_LEAP) && time->tm_min == 0) {
announce &= ~ANN_LEAP;
rval |= DT_LEAP;
if (minlen == 59) {
/* leap second processed, but missing */
rval |= DT_SHORT;
ok = false;
generr = true;
} else if (minlen == 60 && buffer[59] == 1)
rval |= DT_LEAPONE;
}
if ((minlen == 60) && ((rval & DT_LEAP) == 0)) {
/* leap second not processed, so bad minute */
rval |= DT_LONG;
ok = false;
generr = true;
}
/* h==0 (UTC) because sz->wz -> h==2 and wz->sz -> h==1,
* last Sunday of month (reference?) */
if (buffer[16] == 1 && ok) {
if ((time->tm_wday == 7 && time->tm_mday > (int)(lastday(*time) - 7) &&
(time->tm_mon == (int)summermonth ||
time->tm_mon == (int)wintermonth)) && ((time->tm_min > 0 &&
utchour == 0) || (time->tm_min == 0 &&
utchour == 1 + buffer[17] - buffer[18])))
announce |= ANN_CHDST; /* time zone just changed */
else {
announce &= ~ANN_CHDST;
rval |= DT_CHDSTERR;
}
}
if ((int)buffer[17] != time->tm_isdst || (int)buffer[18] == time->tm_isdst) {
/* Time offset change is OK if:
* announced and time is Sunday, lastday, 01:00 UTC
* there was an error but not any more (needed if decoding at
* startup is problematic)
* initial state (otherwise DST would never be valid)
*/
if ((((announce & ANN_CHDST) == ANN_CHDST) && time->tm_min == 0) ||
(olderr && ok) ||
((rval & DT_DSTERR) == 0 && time->tm_isdst == -1))
newtime.tm_isdst = (int)buffer[17]; /* expected change */
else {
if ((rval & DT_DSTERR) == 0)
rval |= DT_DSTJUMP; /* sudden change, ignore */
ok = false;
}
}
/* check if DST is within expected date range */
if ((time->tm_mon > (int)summermonth && time->tm_mon < (int)wintermonth) ||
(time->tm_mon == (int)summermonth && time->tm_wday < 7 &&
(int)(lastday(*time)) - time->tm_mday < 7) ||
(time->tm_mon == (int)summermonth && time->tm_wday == 7 &&
(int)(lastday(*time)) - time->tm_mday < 7 && utchour > 0) ||
(time->tm_mon == (int)wintermonth && time->tm_wday < 7 &&
(int)(lastday(*time)) - time->tm_mday >= 7) ||
(time->tm_mon == (int)wintermonth && time->tm_wday == 7 &&
(int)(lastday(*time)) - time->tm_mday < 7 &&
(utchour >= 22 /* previous day */ || utchour == 0))) {
/* expect DST */
if (newtime.tm_isdst == 0 && (announce & ANN_CHDST) == 0 &&
utchour < 24) {
rval |= DT_DSTJUMP; /* sudden change */
ok = false;
}
} else {
/* expect non-DST */
if (newtime.tm_isdst == 1 && (announce & ANN_CHDST) == 0 &&
utchour < 24) {
rval |= DT_DSTJUMP; /* sudden change */
ok = false;
}
}
/* done with DST */
if (((announce & ANN_CHDST) == ANN_CHDST) && time->tm_min == 0) {
announce &= ~ANN_CHDST;
rval |= DT_CHDST;
}
newtime.tm_gmtoff = 3600 * (newtime.tm_isdst + 1);
if (olderr && ok)
olderr = false;
if (!generr) {
if (p1)
time->tm_min = newtime.tm_min;
if (p2)
time->tm_hour = newtime.tm_hour;
if (p3) {
time->tm_mday = newtime.tm_mday;
time->tm_mon = newtime.tm_mon;
time->tm_year = newtime.tm_year;
time->tm_wday = newtime.tm_wday;
}
if ((rval & DT_DSTJUMP) == 0) {
time->tm_isdst = newtime.tm_isdst;
time->tm_gmtoff = newtime.tm_gmtoff;
}
}
if (!ok)
olderr = true;
return rval | announce;
}
main(int ac,char **av)
{
FILE *fopfile(), *fpr, *fpwsv, *fpwrt, *fpwtr;
struct gfheader gfhead[4];
float maxgft;
struct gfparam gfpar;
float *gf, *gfmech;
int kg, ig;
float kperd_n, kperd_e;
float elat, elon, slat, slon, snorth, seast;
double e2, den, g2, lat0;
float len, wid, strike, dip, rake, dtop;
int i, j, k, l, ip, ip0;
int tshift_timedomain = 0;
struct beroza brm;
struct okumura orm;
struct gene grm;
struct rob rrm;
struct standrupformat srf;
struct srf_planerectangle *prect_ptr;
struct srf_prectsegments *prseg_ptr;
struct srf_allpoints *apnts_ptr;
struct srf_apointvalues *apval_ptr;
struct mechparam mechpar;
int maxmech;
int nstf;
float vslip;
int apv_off;
int nseg = 0;
int inbin = 0;
float tsfac = 0.0;
float tmom = 0.0;
float rupvel = -1.0;
float shal_vrup = 1.0;
float htol = 0.1;
double rayp, rupt_rad;
float rvfrac, rt, *randt;
struct velmodel vmod, rvmod;
int seed = 1;
int randtime = 0;
float perc_randtime = 0.0;
float delt = 0.0;
int smooth_randt = 2;
int gaus_randt = 0;
int randmech = 0;
float deg_randstk = 0.0;
float deg_randdip = 0.0;
float deg_randrak = 0.0;
float zap = 0.0;
int nn;
int kp;
float *rwt, sum;
float randslip = 0.0;
float len2, ds0, dd0, dsf, ddf, s2;
int ntsum, maxnt, it, ntp2;
float mindt;
float x0, y0, z0, dd;
float x0c, ddc, avgvrup;
float shypo, dhypo;
int nsubstk, nsubdip;
int nfinestk = 1;
int nfinedip = 1;
int ntout = -99;
float *stf, *seis, *subseis, *se, *sn, *sv;
float cosS, sinS, cosA, sinA;
float scale, arg, cosD, sinD;
float xstr, xdip, xrak;
float area, sfac;
float trise;
float azi, rng, deast, dnorth;
int ncomp = 3;
float *space;
float dtout = -1.0;
int fdw;
char gfpath[128], gfname[64];
char rtimesfile[128], modfile[128], outfile[128];
char slipfile[128], rupmodfile[128], outdir[128], stat[64], sname[8];
char rupmodtype[128], trisefile[128];
char string[256];
int write_ruptimes = 0;
int write_slipvals = 0;
int write_risetime = 0;
double rperd = 0.017453293;
float normf = 1.0e+10; /* km^2 -> cm^2 */
float targetslip = 1.0; /* slip in cm on each subfault */
float slip_conv = 1.0; /* input slip in cm on each subfault */
float half = 0.5;
float two = 2.0;
int latloncoords = 0;
float tstart = 0.0;
rtimesfile[0] = '\0';
slipfile[0] = '\0';
trisefile[0] = '\0';
sname[0] = '\0';
sprintf(rupmodtype,"NULL");
sprintf(gfpar.gftype,"fk");
setpar(ac, av);
getpar("latloncoords","d",&latloncoords);
if(latloncoords == 1)
{
mstpar("elat","f",&elat);
mstpar("elon","f",&elon);
mstpar("slat","f",&slat);
mstpar("slon","f",&slon);
}
else
{
mstpar("snorth","f",&snorth);
mstpar("seast","f",&seast);
}
mstpar("dtop","f",&dtop);
mstpar("strike","f",&strike);
mstpar("dip","f",&dip);
mstpar("rake","f",&rake);
getpar("rupmodtype","s",rupmodtype);
if(strcmp(rupmodtype,"BEROZA") == 0)
{
brm.inc_stk = 1;
brm.inc_dip = 1;
brm.generic_risetime = -1.0;
brm.robstf = 0;
mstpar("rupmodfile","s",rupmodfile);
mstpar("npstk","d",&brm.npstk);
mstpar("npdip","d",&brm.npdip);
mstpar("inc_stk","d",&brm.inc_stk);
mstpar("inc_dip","d",&brm.inc_dip);
mstpar("len","f",&len);
mstpar("wid","f",&wid);
getpar("robstf","d",&brm.robstf);
getpar("generic_risetime","f",&brm.generic_risetime);
if(brm.robstf == 0 && brm.generic_risetime > 0.0)
{
mstpar("generic_pulsedur","f",&brm.generic_pulsedur);
mstpar("generic_t2","f",&brm.generic_t2);
}
getpar("slip_conv","f",&slip_conv);
mstpar("outdir","s",outdir);
mstpar("stat","s",stat);
}
else if(strcmp(rupmodtype,"OKUMURA") == 0)
{
mstpar("rupmodfile","s",rupmodfile);
getpar("slip_conv","f",&slip_conv);
mstpar("outdir","s",outdir);
mstpar("stat","s",stat);
}
else if(strcmp(rupmodtype,"GENE") == 0)
{
mstpar("rupmodfile","s",rupmodfile);
getpar("slip_conv","f",&slip_conv);
mstpar("outdir","s",outdir);
mstpar("stat","s",stat);
}
else if(strcmp(rupmodtype,"ROB") == 0)
{
mstpar("rupmodfile","s",rupmodfile);
getpar("slip_conv","f",&slip_conv);
mstpar("outdir","s",outdir);
mstpar("stat","s",stat);
mstpar("shypo","f",­po);
mstpar("dhypo","f",&dhypo);
getpar("tsfac","f",&tsfac);
getpar("rupvel","f",&rupvel);
if(rupvel < 0.0)
{
mstpar("modfile","s",modfile);
mstpar("rvfrac","f",&rvfrac);
getpar("shal_vrup","f",&shal_vrup);
}
}
else if(strcmp(rupmodtype,"SRF") == 0)
{
mstpar("rupmodfile","s",rupmodfile);
getpar("slip_conv","f",&slip_conv);
getpar("nseg","d",&nseg);
getpar("inbin","d",&inbin);
mstpar("outdir","s",outdir);
mstpar("stat","s",stat);
}
else
{
mstpar("shypo","f",­po);
mstpar("dhypo","f",&dhypo);
mstpar("nsubstk","d",&nsubstk);
mstpar("nsubdip","d",&nsubdip);
mstpar("len","f",&len);
mstpar("wid","f",&wid);
getpar("rupvel","f",&rupvel);
if(rupvel < 0.0)
{
mstpar("modfile","s",modfile);
mstpar("rvfrac","f",&rvfrac);
getpar("shal_vrup","f",&shal_vrup);
}
getpar("targetslip","f",&targetslip);
mstpar("outfile","s",outfile);
}
getpar("nfinestk","d",&nfinestk);
getpar("nfinedip","d",&nfinedip);
mstpar("gftype","s",gfpar.gftype);
if((strncmp(gfpar.gftype,"fk",2) == 0) || (strncmp(gfpar.gftype,"FK",2) == 0))
{
gfpar.flag3d = 0;
gfpar.nc = 8;
mstpar("gflocs","s",gfpar.gflocs);
mstpar("gftimes","s",gfpar.gftimes);
gfpar.swap_flag = 0;
getpar("gf_swap_bytes","d",&gfpar.swap_flag);
}
else if((strncmp(gfpar.gftype,"3d",2) == 0) || (strncmp(gfpar.gftype,"3D",2) == 0))
{
gfpar.flag3d = 1;
gfpar.nc = 18;
mstpar("gflocs","s",gfpar.gflocs);
mstpar("gfrange_tolerance","f",&gfpar.rtol);
}
else
{
fprintf(stderr,"gftype= %s invalid option, exiting...\n",gfpar.gftype);
exit(-1);
}
mstpar("gfpath","s",gfpath);
mstpar("gfname","s",gfname);
mstpar("maxnt","d",&maxnt);
mstpar("mindt","f",&mindt);
getpar("ntout","d",&ntout);
getpar("dtout","f",&dtout);
getpar("tstart","f",&tstart);
getpar("rtimesfile","s",rtimesfile);
getpar("slipfile","s",slipfile);
getpar("trisefile","s",trisefile);
getpar("seed","d",&seed);
getpar("randtime","d",&randtime);
if(randtime >= 1)
mstpar("perc_randtime","f",&perc_randtime);
if(randtime >= 2)
getpar("delt","f",&delt);
getpar("smooth_randt","d",&smooth_randt);
getpar("gaus_randt","d",&gaus_randt);
getpar("randslip","f",&randslip);
getpar("randmech","d",&randmech);
if(randmech)
{
mstpar("deg_randstk","f",°_randstk);
mstpar("deg_randdip","f",°_randdip);
mstpar("deg_randrak","f",°_randrak);
}
getpar("tshift_timedomain","d",&tshift_timedomain);
getpar("sname","s",sname);
endpar();
fprintf(stderr,"type= %s\n",rupmodtype);
maxmech = 1;
mechpar.nmech = 1;
mechpar.flag[0] = U1FLAG;
mechpar.flag[1] = 0;
mechpar.flag[2] = 0;
if(strcmp(rupmodtype,"BEROZA") == 0)
{
len2 = 0.5*len;
read_beroza(&brm,rupmodfile,&len2);
nsubstk = (brm.npstk) - 1;
nsubdip = (brm.npdip) - 1;
targetslip = slip_conv;
}
else if(strcmp(rupmodtype,"OKUMURA") == 0)
{
read_okumura(&orm,rupmodfile,&len2);
nsubstk = orm.nstk;
nsubdip = orm.ndip;
len = orm.flen;
wid = orm.fwid;
targetslip = slip_conv;
}
else if(strcmp(rupmodtype,"GENE") == 0)
{
read_gene(&grm,rupmodfile,&len2);
nsubstk = grm.nstk;
nsubdip = grm.ndip;
len = grm.flen;
wid = grm.fwid;
targetslip = slip_conv;
}
else if(strcmp(rupmodtype,"ROB") == 0)
{
read_rob(&rrm,rupmodfile,&tsfac);
/* 07/15/04
For now, just use the getpar values, eventually we should modify
in order to use the values read in from the slipmodel
*/
rrm.elon = elon;
rrm.elat = elat;
rrm.stk = strike;
rrm.dip = dip;
rrm.dtop = dtop;
rrm.shyp = shypo;
rrm.dhyp = dhypo;
nsubstk = rrm.nstk;
nsubdip = rrm.ndip;
len = rrm.flen;
wid = rrm.fwid;
len2 = 0.5*len;
if(rupvel < 0.0)
{
read_velmodel(modfile,&vmod);
conv2vrup(&vmod,&rvmod,&dip,&dtop,&wid,&rvfrac,&shal_vrup);
}
targetslip = slip_conv;
}
else if(strcmp(rupmodtype,"SRF") == 0)
{
maxmech = 3;
read_srf(&srf,rupmodfile,inbin);
prect_ptr = &srf.srf_prect;
prseg_ptr = prect_ptr->prectseg;
apnts_ptr = &srf.srf_apnts;
apval_ptr = apnts_ptr->apntvals;
/* 05/19/05
For now, only use one segment from standard rupture model format;
specified with 'nseg'.
*/
elon = prseg_ptr[nseg].elon;
elat = prseg_ptr[nseg].elat;
strike = prseg_ptr[nseg].stk;
dip = prseg_ptr[nseg].dip;
dtop = prseg_ptr[nseg].dtop;
shypo = prseg_ptr[nseg].shyp;
dhypo = prseg_ptr[nseg].dhyp;
nsubstk = prseg_ptr[nseg].nstk;
nsubdip = prseg_ptr[nseg].ndip;
len = prseg_ptr[nseg].flen;
wid = prseg_ptr[nseg].fwid;
/* reset POINTS pointer to appropriate segment */
apv_off = 0;
for(i=0;i<nseg;i++)
apv_off = apv_off + prseg_ptr[i].nstk*prseg_ptr[i].ndip;
apval_ptr = apval_ptr + apv_off;
len2 = 0.5*len;
targetslip = slip_conv;
}
else
{
len2 = 0.5*len;
if(rupvel < 0.0)
{
read_velmodel(modfile,&vmod);
conv2vrup(&vmod,&rvmod,&dip,&dtop,&wid,&rvfrac,&shal_vrup);
}
}
if(randtime)
{
fprintf(stderr,"**** Initiation time randomized\n");
fprintf(stderr," slow variation= +/-%.0f percent\n",100*perc_randtime);
fprintf(stderr," fast variation= +/-%g sec\n",delt);
}
else
{
perc_randtime = 0.0;
delt = 0.0;
}
if(randmech)
{
fprintf(stderr,"**** strike randomized by +/-%.0f degrees\n",deg_randstk);
fprintf(stderr," dip randomized by +/-%.0f degrees\n",deg_randdip);
fprintf(stderr," rake randomized by +/-%.0f degrees\n",deg_randrak);
}
else
{
deg_randstk = 0.0;
deg_randdip = 0.0;
deg_randrak = 0.0;
}
arg = strike*rperd;
cosS = cos(arg);
sinS = sin(arg);
arg = dip*rperd;
cosD = cos(arg);
sinD = sin(arg);
get_gfpars(&gfpar);
if(latloncoords) /* calculate lat,lon to km conversions */
set_ne(&elon,&elat,&slon,&slat,&snorth,&seast);
if(dtout < 0.0)
dtout = mindt;
if(dtout < mindt)
maxnt = (maxnt*mindt/dtout);
ntsum = 2;
while(ntsum < 4*maxnt)
ntsum = ntsum*2;
if(ntout < 0)
ntout = ntsum;
gf = (float *) check_malloc (4*gfpar.nc*ntsum*sizeof(float));
gfmech = (float *) check_malloc (maxmech*12*ntsum*sizeof(float));
space = (float *) check_malloc (2*ntsum*sizeof(float));
seis = (float *) check_malloc (3*ntout*sizeof(float));
subseis = (float *) check_malloc (maxmech*3*ntout*sizeof(float));
stf = (float *) check_malloc (ntout*sizeof(float));
/* Calculate subfault responses */
ds0 = len/nsubstk;
dd0 = wid/nsubdip;
dsf = ds0/nfinestk;
ddf = dd0/nfinedip;
area = (len*wid)/(nsubstk*nsubdip);
sfac = targetslip*normf*area/(nfinestk*nfinedip);
if(gfpar.flag3d == 0) /* add addtnl factor to convert mu for 1d GFs */
sfac = sfac*normf;
rwt = (float *) check_malloc (nfinestk*nfinedip*sizeof(float));
if(randtime)
{
nn = nsubstk*nsubdip*nfinestk*nfinedip;
randt = (float *) check_malloc (nn*sizeof(float));
rand_init(randt,&perc_randtime,&seed,nsubstk,nsubdip,nfinestk,nfinedip,smooth_randt,gaus_randt);
}
/* open output file */
if(strcmp(rupmodtype,"NULL") == 0)
fdw = croptrfile(outfile);
if(rtimesfile[0] != '\0')
{
write_ruptimes = 1;
fpwrt = fopfile(rtimesfile,"w");
}
if(slipfile[0] != '\0')
{
write_slipvals = 1;
fpwsv = fopfile(slipfile,"w");
}
if(trisefile[0] != '\0')
{
write_risetime = 1;
fpwtr = fopfile(trisefile,"w");
}
zapit(seis,3*ntout);
for(i=0;i<4;i++)
{
gfhead[i].id = -1; /* initialize: -1 means none read yet */
gfhead[i].ir = -1; /* initialize: -1 means none read yet */
}
tmom = 0.0;
for(i=0;i<nsubstk;i++)
{
for(j=0;j<nsubdip;j++)
{
sum = 0.0;
for(l=0;l<nfinedip*nfinestk;l++)
{
rwt[l] = randslip*sfrand(&seed);
sum = sum + rwt[l];
}
sum = sum/(float)(nfinedip*nfinestk);
for(l=0;l<nfinedip*nfinestk;l++)
rwt[l] = rwt[l] - sum;
zapit(subseis,maxmech*3*ntout);
ip0 = i + j*nsubstk;
for(k=0;k<nfinestk;k++)
{
x0 = i*ds0 + (k+0.5)*dsf - len2;
for(l=0;l<nfinedip;l++)
{
dd = j*dd0 + (l+0.5)*ddf;
y0 = dd*cosD;
z0 = dtop + dd*sinD;
kp = l + k*nfinedip;
ip = kp + (j + i*nsubdip)*nfinestk*nfinedip;
if(strcmp(rupmodtype,"BEROZA") == 0)
{
get_brmpars(&brm,i,j,&x0,&dd,&rt,&vslip);
trise = brm.tdur[ip0];
}
else if(strcmp(rupmodtype,"OKUMURA") == 0)
{
get_ormpars(&orm,i,j,&x0,&dd,&rt,&vslip);
trise = orm.rist[ip0];
}
else if(strcmp(rupmodtype,"GENE") == 0)
{
get_grmpars(&grm,i,j,&x0,&dd,&rt,&vslip,&rake);
trise = (grm.nt[ip0]-1)*grm.tdel + grm.trise;
}
else if(strcmp(rupmodtype,"ROB") == 0)
{
get_rrmpars(&rrm,i,j,&x0,&dd,&rt,&vslip,&rake,&tsfac);
trise = rrm.trise[ip0];
if(rt < 0.0)
{
if(rupvel < 0.0)
get_rupt(&rvmod,&htol,&dhypo,&dd,­po,&x0,&rayp,&rupt_rad,&rt);
else
rt = sqrt((shypo-x0)*(shypo-x0)+(dhypo-dd)*(dhypo-dd))/rupvel;
rt = rt + tsfac;
}
if(rt < 0.0)
rt = 0.0;
}
else if(strcmp(rupmodtype,"SRF") == 0)
{
get_srfpars(&srf,apv_off,ip0,&rt,&vslip,&strike,&dip,&rake,&mechpar);
trise = apval_ptr[ip0].dt*apval_ptr[ip0].nt1;
/*
For case when nfinestk,nfinedip > 1 =>
calculate avg. Vr based on subfault center, then re-estimate Tinit
when nfinestk = nfinedip = 1, x0c=x0, ddc=dd.
*/
x0c = (i+0.5)*ds0 - len2;
ddc = (j+0.5)*dd0;
avgvrup = sqrt((shypo-x0c)*(shypo-x0c)+(dhypo-ddc)*(dhypo-ddc))/rt;
rt = sqrt((shypo-x0)*(shypo-x0)+(dhypo-dd)*(dhypo-dd))/avgvrup;
}
else
{
vslip = 1.0;
if(rupvel < 0.0)
get_rupt(&rvmod,&htol,&dhypo,&dd,­po,&x0,&rayp,&rupt_rad,&rt);
else
rt = sqrt((shypo-x0)*(shypo-x0)+(dhypo-dd)*(dhypo-dd))/rupvel;
}
if(randtime)
rt = rt*(1.0 + randt[ip]);
if(randtime == 2)
{
rt = rt + delt*sfrand(&seed);
if(rt < 0.0)
rt = 0.0;
}
if(write_ruptimes == 1)
fprintf(fpwrt,"%13.5e %13.5e %13.5e\n",x0+len2,dd,rt);
vslip = (1.0 + rwt[kp])*vslip;
if(write_slipvals == 1)
fprintf(fpwsv,"%13.5e %13.5e %13.5e\n",x0+len2,dd,slip_conv*vslip);
if(write_risetime == 1)
fprintf(fpwtr,"%13.5e %13.5e %13.5e\n",x0+len2,dd,trise);
get_radazi(&azi,&rng,&deast,&dnorth,&x0,&y0,&cosS,&sinS,&seast,&snorth);
find_4gf(gfpar,gfhead,&rng,&z0,&deast,&dnorth);
fprintf(stderr,"i=%3d j=%3d k=%3d l=%3d ",i,j,k,l);
fprintf(stderr," s=%7.2f d=%7.2f",x0,dd);
fprintf(stderr," dn=%10.5f de=%10.5f",dnorth,deast);
fprintf(stderr," a=%7.2f r=%7.2f\n",azi,rng);
read_4gf(gfpath,gfname,gf,ntsum,gfhead,gfpar,&maxgft,&maxnt,&dtout,space);
if(randmech)
{
mechpar.stk = strike + deg_randstk*sfrand(&seed);
mechpar.dip = dip + deg_randdip*sfrand(&seed);
mechpar.rak = rake + deg_randrak*sfrand(&seed);
}
else
{
mechpar.stk = strike;
mechpar.dip = dip;
mechpar.rak = rake;
}
scale = sfac;
mech_4gf(gfmech,gf,gfhead,gfpar,ntsum,mechpar,&azi,&scale);
/* scale now contains the moment released by this point source */
tmom = tmom + vslip*scale;
sum_4gf(subseis,ntout,gfmech,gfhead,ntsum,maxnt,&rt,&maxgft,&tstart,tshift_timedomain,mechpar);
}
}
z0 = dtop + (j+0.5)*dd0*sinD;
if(strcmp(rupmodtype,"BEROZA") == 0)
beroza_stf(&brm,i,j,seis,subseis,stf,ntout,&dtout,&z0);
else if(strcmp(rupmodtype,"OKUMURA") == 0)
okumura_stf(&orm,i,j,seis,subseis,stf,ntout,&dtout);
else if(strcmp(rupmodtype,"GENE") == 0)
gene_stf(&grm,i,j,seis,subseis,stf,ntout,&dtout);
else if(strcmp(rupmodtype,"ROB") == 0)
rob_stf(&rrm,i,j,seis,subseis,stf,ntout,&dtout,&z0);
else if(strcmp(rupmodtype,"SRF") == 0)
srf_stf(&srf,apv_off,ip0,seis,subseis,stf,ntout,&dtout,mechpar);
else
{
sv = subseis;
sn = subseis + ntout;
se = subseis + 2*ntout;
fortran_rite(fdw,1,&ncomp,sizeof(int));
fortran_rite(fdw,2,&rng,sizeof(float),&tstart,sizeof(float));
fortran_rite(fdw,2,&ntout,sizeof(int),&dtout,sizeof(float));
fortran_rite(fdw,1,sn,ntout*sizeof(float));
fortran_rite(fdw,2,&rng,sizeof(float),&tstart,sizeof(float));
fortran_rite(fdw,2,&ntout,sizeof(int),&dtout,sizeof(float));
fortran_rite(fdw,1,se,ntout*sizeof(float));
fortran_rite(fdw,2,&rng,sizeof(float),&tstart,sizeof(float));
fortran_rite(fdw,2,&ntout,sizeof(int),&dtout,sizeof(float));
fortran_rite(fdw,1,sv,ntout*sizeof(float));
}
}
}
if(strcmp(rupmodtype,"NULL") == 0)
close(fdw);
else
{
sv = seis;
sn = seis + ntout;
se = seis + 2*ntout;
if(sname[0] == '\0')
{
strncpy(sname,stat,7);
sname[7] = '\0';
}
write_seis(outdir,stat,sname,"000",sn,&dtout,ntout,&tstart);
write_seis(outdir,stat,sname,"090",se,&dtout,ntout,&tstart);
write_seis(outdir,stat,sname,"ver",sv,&dtout,ntout,&tstart);
fprintf(stderr,"Total moment= %13.5e\n",tmom);
}
if(write_ruptimes == 1)
{
fflush(fpwrt);
fclose(fpwrt);
}
if(write_slipvals == 1)
{
fflush(fpwsv);
fclose(fpwsv);
}
if(write_risetime == 1)
{
fflush(fpwtr);
fclose(fpwtr);
}
}
main(int ac, char **av)
{
struct statdata gfh;
float *gf;
int k, isub, j, nc, nt;
int nbyte;
float dt, rng, tst;
int fdr;
char infile[128];
char name[128];
char outfile[128];
int outbin = 0;
static char *comp[] = {"000","090","ver"};
gfh.stitle[0] = '\0';
gfh.hr = 0;
gfh.min = 0;
gfh.sec = 0.0;
gfh.edist = 0.0;
gfh.az = 0.0;
gfh.baz = 0.0;
setpar(ac, av);
mstpar("infile","s",infile);
mstpar("isub","d",&isub);
getpar("outbin","d",&outbin);
endpar();
sprintf(gfh.stat,"%d",isub);
fdr = opfile_ro(infile);
for(k=0;k<isub;k++)
{
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nc,sizeof(int));
reed(fdr,&nbyte,sizeof(int));
for(j=0;j<nc;j++)
{
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&rng,sizeof(float));
reed(fdr,&tst,sizeof(float));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nt,sizeof(int));
reed(fdr,&dt,sizeof(float));
reed(fdr,&nbyte,sizeof(int));
gf = (float *) check_realloc(gf,nt*sizeof(float));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,gf,nt*sizeof(float));
reed(fdr,&nbyte,sizeof(int));
}
}
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nc,sizeof(int));
reed(fdr,&nbyte,sizeof(int));
for(j=0;j<nc;j++)
{
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&rng,sizeof(float));
reed(fdr,&tst,sizeof(float));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,&nt,sizeof(int));
reed(fdr,&dt,sizeof(float));
reed(fdr,&nbyte,sizeof(int));
gf = (float *) check_realloc(gf,nt*sizeof(float));
reed(fdr,&nbyte,sizeof(int));
reed(fdr,gf,nt*sizeof(float));
reed(fdr,&nbyte,sizeof(int));
gfh.nt = nt;
gfh.dt = dt;
gfh.edist = rng;
gfh.hr = (int)(tst/3600.0);
gfh.min = (int)((tst - 3600.0*gfh.hr)/60.0);
gfh.sec = (float)(tst - 60.0*gfh.min - 3600.0*gfh.hr);
strcpy(gfh.comp,comp[j]);
sprintf(outfile,"%s.%s",gfh.stat,gfh.comp);
write_wccseis(outfile,&gfh,gf,outbin);
}
close(fdr);
}
int main(int ac,char **av)
{
struct statdata head1;
float *s1;
float *p;
int nt1, i, j;
int order = 4;
float nyq_perc = 1.0;
float tap_perc = TAP_PERC;
int resamp = 0;
int ntpad, ntrsmp;
float fnt, dtout, *space;
int gnt;
float newdt = -1.0;
int ntout = -1;
float tol = 1.0e-02;
char infile[256];
char outfile[256];
int inbin = 0;
int outbin = 0;
int pow2 = 0;
sprintf(infile,"stdin");
sprintf(outfile,"stdout");
setpar(ac,av);
getpar("infile","s",infile);
getpar("outfile","s",outfile);
mstpar("newdt","f",&newdt);
getpar("nyq_perc","f",&nyq_perc);
getpar("tap_perc","f",&tap_perc);
getpar("order","d",&order);
getpar("ntout","d",&ntout);
getpar("inbin","d",&inbin);
getpar("outbin","d",&outbin);
getpar("pow2","d",&pow2);
endpar();
s1 = NULL;
s1 = read_wccseis(infile,&head1,s1,inbin);
if(newdt < 0.0 || newdt == head1.dt)
{
resamp = 0;
if(ntout < 0)
ntout = head1.nt;
if(ntout > head1.nt)
ntout = head1.nt;
dtout = head1.dt;
}
else /* need to resample time history */
{
ntpad = 2*head1.nt;
fnt = ntpad*head1.dt/newdt;
gnt = (int)(fnt + 0.5);
//force power of 2
/*if (pow2==1) {
printf("Forcing to power of 2.\n");
int tot_t = head1.dt*head1.nt;
//continue...
ntrsmp = (int)fnt;
while(nt_tol(fnt,gnt)>tol || ( (ntrsmp & (ntrsmp-1))!=0) ){
ntpad++;
fnt = ntpad*head1.dt/newdt;
gnt = (int)(fnt + 0.5);
ntrsmp = (int)fnt;
}
} else {*/
while(nt_tol(fnt,gnt) > tol)
{
ntpad++;
fnt = ntpad*head1.dt/newdt;
gnt = (int)(fnt + 0.5);
}
//}
ntrsmp = (int)(fnt);
if(ntout < 0)
ntout = (int)(head1.nt*head1.dt/newdt);
dtout = newdt;
fprintf(stderr,"*** ntpad=%d ntrsmp=%d\n",ntpad,ntrsmp);
if(newdt < head1.dt)
{
resamp = 1;
if(ntout > ntrsmp)
ntout = ntrsmp;
space = (float *) check_malloc (2*ntrsmp*sizeof(float));
s1 = (float *) check_realloc(s1,2*ntrsmp*sizeof(float));
}
else
{
resamp = -1;
if(ntout > ntpad)
ntout = ntpad;
space = (float *) check_malloc (2*ntpad*sizeof(float));
s1 = (float *) check_realloc(s1,2*ntpad*sizeof(float));
}
}
fprintf(stderr,"***nt=%d dt=%f\n",head1.nt,head1.dt);
if(resamp != 0)
resample(s1,head1.nt,&head1.dt,resamp,ntpad,ntrsmp,&newdt,space,order,&nyq_perc,&tap_perc);
head1.nt = ntout;
head1.dt = dtout;
fprintf(stderr,"***nt=%d dt=%f\n",head1.nt,head1.dt);
write_wccseis(outfile,&head1,s1,outbin);
}
int XMLwrapper::getpar127(const char *name,int defaultpar){
return(getpar(name,defaultpar,0,127));
};
void simdetect (
int *detect, /* detector -1 single, 0 multi, 1 proximity, 2 count,... */
double *gsb0val, /* Parameter values (matrix nr= comb of g0,sigma,b nc=3) [naive animal] */
double *gsb1val, /* Parameter values (matrix nr= comb of g0,sigma,b nc=3) [caught before] */
int *cc0, /* number of g0/sigma/b combinations for naive animals */
int *cc1, /* number of g0/sigma/b combinations for caught before */
int *gsb0, /* lookup which g0/sigma/b combination to use for given g, S, K
[naive animal] */
int *gsb1, /* lookup which g0/sigma/b combination to use for given n, S, K
[caught before] */
int *N, /* number of animals */
int *ss, /* number of occasions */
int *kk, /* number of traps */
int *nmix, /* number of classes */
int *knownclass, /* known membership of 'latent' classes */
double *animals, /* x,y points of animal range centres (first x, then y) */
double *traps, /* x,y locations of traps (first x, then y) */
double *dist2, /* distances squared (optional: -1 if unused) */
double *Tsk, /* ss x kk array of 0/1 usage codes or effort */
int *btype, /* code for behavioural response
0 none
1 individual
2 individual, trap-specific
3 trap-specific
*/
int *Markov, /* learned vs transient behavioural response
0 learned
1 Markov
*/
int *binomN, /* number of trials for 'count' detector modelled with binomial */
double *miscparm, /* detection threshold on transformed scale, etc. */
int *fn, /* code 0 = halfnormal, 1 = hazard, 2 = exponential, 3 = uniform */
int *maxperpoly, /* */
int *n, /* number of individuals caught */
int *caught, /* sequence number in session (0 if not caught) */
double *detectedXY, /* x,y locations of detections */
double *signal, /* vector of signal strengths, one per detection */
int *value, /* return value array of trap locations n x s */
int *resultcode
)
{
double d2val;
double p;
int i,j,k,l,s;
int ik;
int nc = 0;
int nk = 0; /* number of detectors (polygons or transects when *detect==6,7) */
int count = 0;
int *caughtbefore;
int *x; /* mixture class of animal i */
double *pmix;
double runif;
int wxi = 0;
int c = 0;
int gpar = 2;
double g0 = 0;
double sigma = 0;
double z = 0;
double Tski = 1.0;
double *work = NULL;
double *noise = NULL; /* detectfn 12,13 only */
int *sortorder = NULL;
double *sortkey = NULL;
/*
*detect may take values -
-1 single-catch traps
0 multi-catch traps
1 binary proximity detectors
2 count proximity detectors
5 signal detectors
6 polygon detectors
7 transect detectors
*/
/*========================================================*/
/* 'single-catch only' declarations */
int tr_an_indx = 0;
int nanimals;
int ntraps;
int *occupied = NULL;
int *intrap = NULL;
struct trap_animal *tran = NULL;
double event_time;
int anum = 0;
int tnum = 0;
int nextcombo;
int finished;
int OK;
/*========================================================*/
/* 'multi-catch only' declarations */
double *h = NULL; /* multi-catch only */
double *hsum = NULL; /* multi-catch only */
double *cump = NULL; /* multi-catch only */
/*========================================================*/
/* 'polygon & transect only' declarations */
int nd = 0;
int cumk[maxnpoly+1];
int sumk; /* total number of vertices */
int g=0;
int *gotcha;
double xy[2];
int n1,n2,t;
double par[3];
int np = 1; /* n points each call of gxy */
double w, ws;
int maxdet=1;
double *cumd = NULL;
struct rpoint *line = NULL;
struct rpoint xyp;
struct rpoint animal;
double lx;
double maxg = 0;
double lambdak; /* temp value for Poisson rate */
double grx; /* temp value for integral gr */
double H;
int J;
int maybecaught;
double dx,dy,d;
double pks;
double sumhaz;
/*========================================================*/
/* 'signal-strength only' declarations */
double beta0;
double beta1;
double muS;
double sdS;
double muN = 0;
double sdN = 1;
double signalvalue;
double noisevalue;
double cut;
double *ex;
/*========================================================*/
/* MAIN LINE */
gotcha = &g;
*resultcode = 1;
caughtbefore = (int *) R_alloc(*N * *kk, sizeof(int));
x = (int *) R_alloc(*N, sizeof(int));
for (i=0; i<*N; i++) x[i] = 0;
pmix = (double *) R_alloc(*nmix, sizeof(double));
/* ------------------------------------------------------ */
/* pre-compute distances */
if (dist2[0] < 0) {
dist2 = (double *) S_alloc(*kk * *N, sizeof(double));
makedist2 (*kk, *N, traps, animals, dist2);
}
else {
squaredist (*kk, *N, dist2);
}
/* ------------------------------------------------------ */
if ((*detect < -1) || (*detect > 7)) return;
if (*detect == -1) { /* single-catch only */
occupied = (int*) R_alloc(*kk, sizeof(int));
intrap = (int*) R_alloc(*N, sizeof(int));
tran = (struct trap_animal *) R_alloc(*N * *kk,
sizeof(struct trap_animal));
/* 2*sizeof(int) + sizeof(double)); */
}
if (*detect == 0) { /* multi-catch only */
h = (double *) R_alloc(*N * *kk, sizeof(double));
hsum = (double *) R_alloc(*N, sizeof(double));
cump = (double *) R_alloc(*kk+1, sizeof(double));
cump[0] = 0;
}
if (*detect == 5) { /* signal only */
maxdet = *N * *ss * *kk;
if (!((*fn == 10) || (*fn == 11)))
error ("simsecr not implemented for this combination of detector & detectfn");
}
if ((*detect == 3) || (*detect == 4) || (*detect == 6) || (*detect == 7)) {
/* polygon or transect */
cumk[0] = 0;
for (i=0; i<maxnpoly; i++) { /* maxnpoly much larger than npoly */
if (kk[i]<=0) break;
cumk[i+1] = cumk[i] + kk[i];
nk++;
}
sumk = cumk[nk];
if ((*detect == 6) || (*detect == 7))
maxdet = *N * *ss * nk * *maxperpoly;
else
maxdet = *N * *ss;
}
else nk = *kk;
if ((*detect == 4) || (*detect == 7)) { /* transect only */
line = (struct rpoint *) R_alloc(sumk, sizeof(struct rpoint));
cumd = (double *) R_alloc(sumk, sizeof(double));
/* coordinates of vertices */
for (i=0; i<sumk; i++) {
line[i].x = traps[i];
line[i].y = traps[i+sumk];
}
/* cumulative distance along line; all transects end on end */
for (k=0; k<nk; k++) {
cumd[cumk[k]] = 0;
for (i=cumk[k]; i<(cumk[k+1]-1); i++) {
cumd[i+1] = cumd[i] + distance(line[i], line[i+1]);
}
}
}
if ((*detect==3) || (*detect==4) || (*detect==5) || (*detect==6) || (*detect==7)) {
work = (double*) R_alloc(maxdet*2, sizeof(double)); /* twice size needed for signal */
sortorder = (int*) R_alloc(maxdet, sizeof(int));
sortkey = (double*) R_alloc(maxdet, sizeof(double));
}
if ((*fn==12) || (*fn==13)) {
noise = (double*) R_alloc(maxdet*2, sizeof(double)); /* twice size needed for signal */
}
GetRNGstate();
gpar = 2;
if ((*fn == 1) || (*fn == 3) || (*fn == 5)|| (*fn == 6) || (*fn == 7) || (*fn == 8) ||
(*fn == 10) || (*fn == 11)) gpar ++;
/* ------------------------------------------------------------------------- */
/* mixture models */
/* may be better to pass pmix */
if (*nmix>1) {
if (*nmix>2)
error("simsecr nmix>2 not implemented");
gpar++; /* these models have one more detection parameter */
for (i=0; i<*nmix; i++) {
wxi = i4(0,0,0,i,*N,*ss,nk);
c = gsb0[wxi] - 1;
pmix[i] = gsb0val[*cc0 * (gpar-1) + c]; /* assuming 4-column gsb */
}
for (i=0; i<*N; i++) {
if (knownclass[i] > 1)
x[i] = knownclass[i] - 2; /* knownclass=2 maps to x=0 etc. */
else
x[i] = rdiscrete(*nmix, pmix) - 1;
}
}
/* ------------------------------------------------------------------------- */
/* zero caught status */
for (i=0; i<*N; i++)
caught[i] = 0;
for (i=0; i<*N; i++)
for (k=0; k < nk; k++)
caughtbefore[k * (*N-1) + i] = 0;
/* ------------------------------------------------------------------------- */
/* MAIN LOOP */
for (s=0; s<*ss; s++) {
/* ------------------ */
/* single-catch traps */
if (*detect == -1) {
/* initialise day */
tr_an_indx = 0;
nanimals = *N;
ntraps = nk;
for (i=0; i<*N; i++) intrap[i] = 0;
for (k=0; k<nk; k++) occupied[k] = 0;
nextcombo = 0;
/* make tran */
for (i=0; i<*N; i++) { /* animals */
for (k=0; k<nk; k++) { /* traps */
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
/* d2val = d2(i,k, animals, traps, *N, nk); */
d2val = d2L(k, i, dist2, nk);
p = pfn(*fn, d2val, g0, sigma, z, miscparm, 1e20); /* effectively inf w2 */
if (fabs(Tski-1) > 1e-10)
p = 1 - pow(1-p, Tski);
event_time = randomtime(p);
if (event_time <= 1) {
tran[tr_an_indx].time = event_time;
tran[tr_an_indx].animal = i; /* 0..*N-1 */
tran[tr_an_indx].trap = k; /* 0..nk-1 */
tr_an_indx++;
}
}
}
}
/* end of make tran */
if (tr_an_indx > 1) probsort (tr_an_indx, tran);
while ((nextcombo < tr_an_indx) && (nanimals>0) && (ntraps>0)) {
finished = 0;
OK = 0;
while ((1-finished)*(1-OK) > 0) { /* until finished or OK */
if (nextcombo >= (tr_an_indx))
finished = 1; /* no more to process */
else {
anum = tran[nextcombo].animal;
tnum = tran[nextcombo].trap;
OK = (1-occupied[tnum]) * (1-intrap[anum]); /* not occupied and not intrap */
nextcombo++;
}
}
if (finished==0) {
/* Record this capture */
occupied[tnum] = 1;
intrap[anum] = tnum+1; /* trap = k+1 */
nanimals--;
ntraps--;
}
}
for (i=0; i<*N; i++) {
if (intrap[i]>0) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc; /* nc-th animal to be captured */
for (j=0; j<*ss; j++)
value[*ss * (nc-1) + j] = 0;
}
value[*ss * (caught[i]-1) + s] = intrap[i]; /* trap = k+1 */
}
}
}
/* -------------------------------------------------------------------------- */
/* multi-catch trap; only one site per occasion (drop last dimension of capt) */
else if (*detect == 0) {
for (i=0; i<*N; i++) {
hsum[i] = 0;
for (k=0; k<nk; k++) {
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
/* d2val = d2(i,k, animals, traps, *N, nk); */
d2val = d2L(k, i, dist2, nk);
p = pfn(*fn, d2val, g0, sigma, z, miscparm, 1e20);
h[k * *N + i] = - Tski * log(1 - p);
hsum[i] += h[k * *N + i];
}
}
for (k=0; k<nk; k++) {
cump[k+1] = cump[k] + h[k * *N + i]/hsum[i];
}
if (Random() < (1-exp(-hsum[i]))) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (j=0; j<*ss; j++)
value[*ss * (nc-1) + j] = 0;
}
/* find trap with probability proportional to p
searches cumulative distribution of p */
runif = Random();
k = 0;
while ((runif > cump[k]) && (k<nk)) k++;
value[*ss * (caught[i]-1) + s] = k; /* trap = k+1 */
}
}
}
/* -------------------------------------------------------------------------------- */
/* the 'proximity' group of detectors 1:2 - proximity, count */
else if ((*detect >= 1) && (*detect <= 2)) {
for (i=0; i<*N; i++) {
for (k=0; k<nk; k++) {
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
/* d2val = d2(i,k, animals, traps, *N, nk); */
d2val = d2L(k, i, dist2, nk);
p = pfn(*fn, d2val, g0, sigma, z, miscparm, 1e20);
if (p < -0.1) { PutRNGstate(); return; } /* error */
if (p>0) {
if (*detect == 1) {
if (fabs(Tski-1) > 1e-10)
p = 1 - pow(1-p, Tski);
count = Random() < p; /* binary proximity */
}
else if (*detect == 2) { /* count proximity */
if (*binomN == 1)
count = rcount(round(Tski), p, 1);
else
count = rcount(*binomN, p, Tski);
}
if (count>0) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (j=0; j<*ss; j++)
for (l=0; l<nk; l++)
value[*ss * ((nc-1) * nk + l) + j] = 0;
}
value[*ss * ((caught[i]-1) * nk + k) + s] = count;
}
}
}
}
}
}
/* -------------------------------------------------------------------------------- */
/* exclusive polygon detectors */
else if (*detect == 3) {
/* find maximum distance between animal and detector vertex */
w = 0;
J = cumk[nk];
for (i = 0; i< *N; i++) {
for (j = 0; j < J; j++) {
dx = animals[i] - traps[j];
dy = animals[*N + i] - traps[J + j];
d = sqrt(dx*dx + dy*dy);
if (d > w) w = d;
}
}
for (i=0; i<*N; i++) {
/* this implementation assumes NO VARIATION AMONG DETECTORS */
getpar (i, s, 0, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, 0, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
maybecaught = Random() < g0;
if (w > (10 * sigma))
ws = 10 * sigma;
else
ws = w;
par[0] = 1;
par[1] = sigma;
par[2] = z;
if (maybecaught) {
gxy (&np, fn, par, &ws, xy); /* simulate location */
xy[0] = xy[0] + animals[i];
xy[1] = xy[1] + animals[*N + i];
for (k=0; k<nk; k++) { /* each polygon */
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
n1 = cumk[k];
n2 = cumk[k+1]-1;
inside(xy, &n1, &n2, &sumk, traps, gotcha); /* assume closed */
if (*gotcha > 0) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (t=0; t<*ss; t++)
value[*ss * (nc-1) + t] = 0;
}
nd++;
value[*ss * (caught[i]-1) + s] = k+1;
work[(nd-1)*2] = xy[0];
work[(nd-1)*2+1] = xy[1];
sortkey[nd-1] = (double) (s * *N + caught[i]);
break; /* no need to look at more poly */
}
}
}
}
}
}
/* -------------------------------------------------------------------------------- */
/* exclusive transect detectors */
else if (*detect == 4) {
ex = (double *) R_alloc(10 + 2 * maxvertices, sizeof(double));
for (i=0; i<*N; i++) { /* each animal */
animal.x = animals[i];
animal.y = animals[i + *N];
sumhaz = 0;
/* ------------------------------------ */
/* sum hazard */
for (k=0; k<nk; k++) {
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
par[0] = g0;
par[1] = sigma;
par[2] = z;
n1 = cumk[k];
n2 = cumk[k+1]-1;
H = hintegral1(*fn, par);
sumhaz += -log(1 - par[0] * integral1D (*fn, i, 0, par, 1, traps,
animals, n1, n2, sumk, *N, ex) / H);
}
}
/* ------------------------------------ */
for (k=0; k<nk; k++) { /* each transect */
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
par[0] = g0;
par[1] = sigma;
par[2] = z;
n1 = cumk[k];
n2 = cumk[k+1]-1;
H = hintegral1(*fn, par);
lambdak = par[0] * integral1D (*fn, i, 0, par, 1, traps, animals,
n1, n2, sumk, *N, ex) / H;
pks = (1 - exp(-sumhaz)) * (-log(1-lambdak)) / sumhaz;
count = Random() < pks;
maxg = 0;
if (count>0) { /* find maximum - approximate */
for (l=0; l<=100; l++) {
lx = (cumd[n2] - cumd[n1]) * l/100;
xyp = getxy (lx, cumd, line, sumk, n1);
grx = gr (fn, par, xyp, animal);
if (R_FINITE(grx))
maxg = fmax2(maxg, grx);
}
for (l=n1; l<=n2; l++) {
xyp = line[l];
grx = gr (fn, par, xyp, animal);
if (R_FINITE(grx))
maxg = fmax2(maxg, grx);
}
maxg= 1.2 * maxg; /* safety margin */
if (maxg<=0)
Rprintf("maxg error in simsecr\n"); /* not found */
*gotcha = 0;
l = 0;
while (*gotcha == 0) {
lx = Random() * (cumd[n2] - cumd[n1]); /* simulate location */
xyp = getxy (lx, cumd, line, sumk, n1);
grx = gr (fn, par, xyp, animal);
if (Random() < (grx/maxg)) /* rejection sampling */
*gotcha = 1;
l++;
if (l % 10000 == 0)
R_CheckUserInterrupt();
if (l>1e8) *gotcha = 1; /* give up and accept anything!!!! */
}
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (t=0; t<*ss; t++)
value[*ss * (nc-1) + t] = 0;
}
nd++;
if (nd >= maxdet) {
*resultcode = 2; /* error */
return;
}
value[*ss * (caught[i]-1) + s] = k+1;
work[(nd-1)*2] = xyp.x;
work[(nd-1)*2+1] = xyp.y;
sortkey[nd-1] = (double) (s * *N + caught[i]);
}
if (count>0) break; /* no need to look further */
}
} /* end loop over transects */
} /* end loop over animals */
}
/* -------------------------------------------------------------------------------- */
/* polygon detectors */
else if (*detect == 6) {
for (i=0; i<*N; i++) {
/* this implementation assumes NO VARIATION AMONG DETECTORS */
getpar (i, s, 0, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, 0, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
count = rcount(*binomN, g0, Tski);
w = 10 * sigma;
par[0] = 1;
par[1] = sigma;
par[2] = z;
for (j=0; j<count; j++) {
gxy (&np, fn, par, &w, xy); /* simulate location */
xy[0] = xy[0] + animals[i];
xy[1] = xy[1] + animals[*N + i];
for (k=0; k<nk; k++) { /* each polygon */
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
n1 = cumk[k];
n2 = cumk[k+1]-1;
inside(xy, &n1, &n2, &sumk, traps, gotcha); /* assume closed */
if (*gotcha > 0) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (t=0; t<*ss; t++)
for (l=0; l<nk; l++)
value[*ss * ((nc-1) * nk + l) + t] = 0;
}
nd++;
if (nd > maxdet) {
*resultcode = 2;
return; /* error */
}
value[*ss * ((caught[i]-1) * nk + k) + s]++;
work[(nd-1)*2] = xy[0];
work[(nd-1)*2+1] = xy[1];
sortkey[nd-1] = (double) (k * *N * *ss + s * *N + caught[i]);
}
}
}
}
}
}
/* -------------------------------------------------------------------------------- */
/* transect detectors */
else if (*detect == 7) {
ex = (double *) R_alloc(10 + 2 * maxvertices, sizeof(double));
for (i=0; i<*N; i++) { /* each animal */
animal.x = animals[i];
animal.y = animals[i + *N];
for (k=0; k<nk; k++) { /* each transect */
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
bswitch (*btype, *N, i, k, caughtbefore),
gsb0, gsb0val, gsb1, gsb1val, &g0, &sigma, &z);
par[0] = g0;
par[1] = sigma;
par[2] = z;
n1 = cumk[k];
n2 = cumk[k+1]-1;
H = hintegral1(*fn, par);
lambdak = par[0] * integral1D (*fn, i, 0, par, 1, traps, animals,
n1, n2, sumk, *N, ex) / H;
count = rcount(*binomN, lambdak, Tski); /* numb detections on transect */
maxg = 0;
if (count>0) { /* find maximum - approximate */
for (l=0; l<=100; l++) {
lx = (cumd[n2]-cumd[n1]) * l/100;
xyp = getxy (lx, cumd, line, sumk, n1);
grx = gr (fn, par, xyp, animal);
if (R_FINITE(grx))
maxg = fmax2(maxg, grx);
}
for (l=n1; l<=n2; l++) {
xyp = line[l];
grx = gr (fn, par, xyp, animal);
if (R_FINITE(grx))
maxg = fmax2(maxg, grx);
}
maxg= 1.2 * maxg; /* safety margin */
if (maxg<=0)
Rprintf("maxg error in simsecr\n"); /* not found */
}
for (j=0; j<count; j++) {
*gotcha = 0;
l = 0;
while (*gotcha == 0) {
lx = Random() * (cumd[n2]-cumd[n1]); /* simulate location */
xyp = getxy (lx, cumd, line, sumk, n1);
grx = gr (fn, par, xyp, animal);
if (Random() < (grx/maxg)) /* rejection sampling */
*gotcha = 1;
l++;
if (l % 10000 == 0)
R_CheckUserInterrupt();
if (l>1e8) *gotcha = 1; /* give up and accept anything!!!! */
}
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (t=0; t<*ss; t++)
for (l=0; l<nk; l++)
value[*ss * ((nc-1) * nk + l) + t] = 0;
}
nd++;
if (nd >= maxdet) {
*resultcode = 2; /* error */
return;
}
value[*ss * ((caught[i]-1) * nk + k) + s]++;
work[(nd-1)*2] = xyp.x;
work[(nd-1)*2+1] = xyp.y;
sortkey[nd-1] = (double) (k * *N * *ss + s * *N + caught[i]);
}
}
} /* end loop over transects */
} /* end loop over animals */
}
/* ------------------------ */
/* signal strength detector */
else if (*detect == 5) {
cut = miscparm[0];
if ((*fn == 12) || (*fn == 13)) {
muN = miscparm[1];
sdN = miscparm[2];
}
for (i=0; i<*N; i++) {
for (k=0; k<nk; k++) {
Tski = Tsk[s * nk + k];
if (fabs(Tski) > 1e-10) {
/* sounds not recaptured */
getpar (i, s, k, x[i], *N, *ss, nk, *cc0, *cc1, *fn,
0, gsb0, gsb0val, gsb0, gsb0val, &beta0, &beta1, &sdS);
/*
if ((*fn == 10) || (*fn == 12))
muS = mufn (i, k, beta0, beta1, animals, traps, *N, nk, 0);
else
muS = mufn (i, k, beta0, beta1, animals, traps, *N, nk, 1);
*/
if ((*fn == 10) || (*fn == 12))
muS = mufnL (k, i, beta0, beta1, dist2, nk, 0);
else
muS = mufnL (k, i, beta0, beta1, dist2, nk, 1);
signalvalue = norm_rand() * sdS + muS;
if ((*fn == 10) || (*fn == 11)) {
if (signalvalue > cut) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (j=0; j<*ss; j++)
for (l=0; l<nk; l++)
value[*ss * ((nc-1) * *kk + l) + j] = 0;
}
nd++;
value[*ss * ((caught[i]-1) * *kk + k) + s] = 1;
work[nd-1] = signalvalue;
sortkey[nd-1] = (double) (k * *N * *ss + s * *N + caught[i]);
}
}
else {
noisevalue = norm_rand() * sdN + muN;
if ((signalvalue - noisevalue) > cut) {
if (caught[i]==0) { /* first capture of this animal */
nc++;
caught[i] = nc;
for (j=0; j<*ss; j++)
for (l=0; l<nk; l++)
value[*ss * ((nc-1) * *kk + l) + j] = 0;
}
nd++;
value[*ss * ((caught[i]-1) * *kk + k) + s] = 1;
work[nd-1] = signalvalue;
noise[nd-1] = noisevalue;
sortkey[nd-1] = (double) (k * *N * *ss + s * *N + caught[i]);
}
}
}
}
}
}
if ((*btype > 0) && (s < (*ss-1))) {
/* update record of 'previous-capture' status */
if (*btype == 1) {
for (i=0; i<*N; i++) {
if (*Markov)
caughtbefore[i] = 0;
for (k=0; k<nk; k++)
caughtbefore[i] = imax2 (value[i3(s, k, i, *ss, nk)], caughtbefore[i]);
}
}
else if (*btype == 2) {
for (i=0; i<*N; i++) {
for (k=0; k<nk; k++) {
ik = k * (*N-1) + i;
if (*Markov)
caughtbefore[ik] = value[i3(s, k, i, *ss, nk)];
else
caughtbefore[ik] = imax2 (value[i3(s, k, i, *ss, nk)],
caughtbefore[ik]);
}
}
}
else {
for (k=0;k<nk;k++) {
if (*Markov)
caughtbefore[k] = 0;
for (i=0; i<*N; i++)
caughtbefore[k] = imax2 (value[i3(s, k, i, *ss, nk)], caughtbefore[k]);
}
}
}
} /* loop over s */
if ((*detect==3) || (*detect==4) || (*detect==5) || (*detect==6) || (*detect==7)) {
for (i=0; i<nd; i++) sortorder[i] = i;
if (nd>0) rsort_with_index (sortkey, sortorder, nd);
if (*detect==5) {
for (i=0; i<nd; i++) signal[i] = work[sortorder[i]];
if ((*fn == 12) || (*fn == 13)) {
for (i=0; i<nd; i++) signal[i+nd] = noise[sortorder[i]];
}
}
else {
for (i=0; i<nd; i++) {
detectedXY[i] = work[sortorder[i]*2];
detectedXY[i+nd] = work[sortorder[i]*2+1];
}
}
}
*n = nc;
PutRNGstate();
*resultcode = 0;
}
