resamp()

subroutine resamp	(	real, dimension(nsamp2)	data2,
		real, dimension(nsamp1)	data3,
		integer	nsamp1,
		integer	nsamp2,
		real	tanf1,
		real	dt1,
		real	tanf2
	)

Definition at line 281 of file dise.f.

Referenced by dise().

     &  ifirst, ilast)
c 
      real data2(nsamp2), data3(nsamp1)
      integer nsamp1, nsamp2, ifirst, ilast
      real tanf1, tanf2, dt1, dt2
c 
      logical verbose
      parameter(verbose=.true.)
c
      integer maxspec
      parameter(maxspec=100000)
      complex spect(maxspec)
      integer nspec
c 
      real pi, t, sum,dper,selbeg,selend,oselbeg,oselend
      integer ispec,i,oifirst,oilast,onspec,nout
      integer limit,percount,nextper
      complex ime, expfac, expfacbase
      parameter(pi=3.1415926535897931159979,ime=(0.,1.))
c 
      if (verbose) then
        print *,' '
        print *,'do some resampling...'
      endif
c 
      selbeg=(ifirst-1)*dt1+tanf1
      selend=(ilast-1)*dt1+tanf1
      oifirst=int((selbeg-tanf2)/dt2)
      oilast=2+int((selend-tanf2)/dt2)
      if ((oifirst.gt.oilast).or.(oifirst.lt.1).or.(oilast.gt.nsamp2))
     &  stop 'ERROR: check times'
      onspec=oilast-oifirst+1
      nout=ilast-ifirst+1
      oselbeg=(oifirst-1)*dt2+tanf2
      oselend=(oilast-1)*dt2+tanf2
c 
      print *,'  original trace:'
      print *,'    first sample: ',tanf2,'sec; last sample: ',
     &  (nsamp2-1)*dt2+tanf2,'sec'
      print *,'    sampling interval: ',dt2,'sec'
      print *,'    selected first sample: ',oifirst
      print *,'    selected last sample:  ',oilast
      print *,'    selected start time:   ',oselbeg,'sec'
      print *,'    selected end time:     ',oselend,'sec'
      print *,'  master trace:'
      print *,'    first sample: ',tanf1,'sec; last sample: ',
     &  (nsamp1-1)*dt1+tanf1,'sec'
      print *,'    sampling interval: ',dt1,'sec'
      print *,'    selected first sample: ',ifirst
      print *,'    selected last sample:  ',ilast
      print *,'    selected start time:   ',selbeg,'sec'
      print *,'    selected end time:     ',selend,'sec'
c 
      nspec=2
      do while(nspec.lt.onspec)
        nspec=nspec*2
      enddo
      if (nspec.gt.maxspec) stop 'ERROR: maxspec too small!'
c
      print *,'preparing spectrum with ',nspec,' samples'
      do i=1,nspec
        spect(i)=(0.,0.)
      enddo
c
      print *,'   extracting'
      print *,'     original trace ',oifirst,'-',oifirst-1+onspec
      print *,'     to spectrum trace ',1,'-',onspec
      do i=1,onspec
        spect(i)=cmplx(data2(oifirst+i-1))
      enddo
c 
      call tf_fork(nspec,spect,-1.)
c 
      if (verbose) then
        print *,'  we hold the spectrum now'
        print *,'  going to perform resampling DFT (which will be slow)...'
      endif
c 
c
c dt*sqrt(nsamples) is the factor we have to multiply in order to get
c   spectral coefficients corresponding to a foruier integral transform
c
c dt*(nsamples-1) is the time length of the original trace, which is the 
c   recurrence time of the time limited fourier signal
c 
c 1./(dt*nsamples) is the frequency step size
c
      if (dt1.gt.dt2) then
        print *,'      old sampling interval (',dt2,'sec)'
        print *,'      is less than new one (',dt1,'sec) !'
        print *,
     &  '      it''s up to you to perform a correct low pass filtering'
      endif
c 
c 
      expfacbase=2.*pi*ime/(dt2*float(nspec))
      limit=nspec/2
      dper=10.
      percount=1
      nextper=nout*dper/100.
c 
      do i=1,nout
        t=(i-1)*dt1+selbeg
c        print *,'calc sample ',i,' at ',t,'sec'
        expfac=expfacbase*(t-oselbeg)
        if ((t.lt.oselbeg).or.(t.gt.oselend)) then
          data3(i)=0.
          print *,'trapped'
        else
           sum=0.5*real(spect(1))
           do ispec=2,limit
             sum=sum+real(spect(ispec)*cexp(expfac*float(ispec-1)))
           enddo
           sum=sum+0.5*real(spect(limit+1)*cexp(expfac*(limit)))
           data3(i)=2.*sum/sqrt(float(nspec))
        endif
        if (i.gt.nextper) then
          print *,'    finished ',percount*dper,'%'
          percount=percount+1
          nextper=percount*nout*dper/100.
        endif
      enddo
      print *,'    finished 100.%'
c 
      return

Here is the caller graph for this function: