Commit a1e2be8e authored by thomas.forbriger's avatar thomas.forbriger

gresy [FEATURE]: provide Fourier domain filters

parent 546f20c9
...@@ -89,7 +89,7 @@ c functions ...@@ -89,7 +89,7 @@ c functions
real sffu_offset, sffu_tfirst real sffu_offset, sffu_tfirst
c free block c free block
integer maxfree, nfree integer maxfree, nfree
parameter(maxfree=5) parameter(maxfree=15)
character*80 free(maxfree) character*80 free(maxfree)
c SFF parameters c SFF parameters
real sffversion, tanf real sffversion, tanf
...@@ -455,7 +455,6 @@ c apply Fourier domain filter ...@@ -455,7 +455,6 @@ c apply Fourier domain filter
& cmplx(exp(ime*(tshiftorigin-tshiftsrc)*om(io))) & cmplx(exp(ime*(tshiftorigin-tshiftsrc)*om(io)))
response(io)=response(io)* response(io)=response(io)*
& cmplx(fou_eval(dble(om(io)))) & cmplx(fou_eval(dble(om(io))))
print *,om(io),response(io)
enddo enddo
c c
c---------------------------------------------------------------------- c----------------------------------------------------------------------
...@@ -473,6 +472,26 @@ c ...@@ -473,6 +472,26 @@ c
& //rcvname(1:index(rcvname, ' ')) & //rcvname(1:index(rcvname, ' '))
free(4)=rcvtext free(4)=rcvtext
nfree=4 nfree=4
if (lpbo.gt.0) then
nfree=nfree+1
write (free(nfree), '(a,g8.2,a,i3)')
& 'apply lpb ',lpbf,',',lpbo
endif
if (hpbo.gt.0) then
nfree=nfree+1
write (free(nfree), '(a,g8.2,a,i3)')
& 'apply lpb ',hpbf,',',hpbo
endif
if (tshiftsrc.ne.0) then
nfree=nfree+1
write (free(nfree), '(a,g8.2,a)')
& 'shift source onset by ',tshiftsrc,'s'
endif
if (tshiftorigin.ne.0) then
nfree=nfree+1
write (free(nfree), '(a,g8.2,a)')
& 'shift origin time by ',tshiftorigin,'s'
endif
srctype='implicit in green file' srctype='implicit in green file'
scs='C' scs='C'
sc1=0. sc1=0.
...@@ -481,12 +500,24 @@ c ...@@ -481,12 +500,24 @@ c
date='990418' date='990418'
time='000000.000' time='000000.000'
endif endif
if (verbose) then
print *,'open output file ',seisname(1:index(seisname, ' '))
endif
if (optnew) call sff_New(lu, seisname, ierr) if (optnew) call sff_New(lu, seisname, ierr)
if (ierr.ne.0) stop 'ERROR: deleting seismogram file' if (ierr.ne.0) stop 'ERROR: deleting seismogram file'
call sff_WOpenFS(lu, seisname, free, nfree, srctype, call sff_WOpenFS(lu, seisname, free, nfree, srctype,
& scs, sc1 ,sc2 ,sc3, & scs, sc1 ,sc2 ,sc3,
& date, time, ierr) & date, time, ierr)
if (ierr.ne.0) stop 'ERROR: opening seismogram file' if (ierr.ne.0) stop 'ERROR: opening seismogram file'
if (verbose) then
print *,'information encoded in file header FREE data:'
do i=1,nfree
print *,' ',free(i)(1:76)
enddo
endif
c---------------------------------------------------------------------- c----------------------------------------------------------------------
c c
c preparatory calculations c preparatory calculations
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment