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

gresy [FEATURE]: provide Fourier domain filters

parent 546f20c9
......@@ -89,7 +89,7 @@ c functions
real sffu_offset, sffu_tfirst
c free block
integer maxfree, nfree
parameter(maxfree=5)
parameter(maxfree=15)
character*80 free(maxfree)
c SFF parameters
real sffversion, tanf
......@@ -455,7 +455,6 @@ c apply Fourier domain filter
& cmplx(exp(ime*(tshiftorigin-tshiftsrc)*om(io)))
response(io)=response(io)*
& cmplx(fou_eval(dble(om(io))))
print *,om(io),response(io)
enddo
c
c----------------------------------------------------------------------
......@@ -473,6 +472,26 @@ c
& //rcvname(1:index(rcvname, ' '))
free(4)=rcvtext
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'
scs='C'
sc1=0.
......@@ -481,12 +500,24 @@ c
date='990418'
time='000000.000'
endif
if (verbose) then
print *,'open output file ',seisname(1:index(seisname, ' '))
endif
if (optnew) call sff_New(lu, seisname, ierr)
if (ierr.ne.0) stop 'ERROR: deleting seismogram file'
call sff_WOpenFS(lu, seisname, free, nfree, srctype,
& scs, sc1 ,sc2 ,sc3,
& date, time, ierr)
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 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