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; }