writetest()

subroutine writetest	(	character*(*)	filename,
		double precision	indt
	)

Definition at line 131 of file fapidtest.f.

Referenced by fapidtest().

c
      character*(*) filename
      double precision indt
c
      integer m
      parameter(m=1024)
      real d(m)
      integer id(m)
      equivalence(d,id)
      integer n,i,j,s,k
      real p,dx,dt,rate
c 
      integer lu, ierr
      parameter(lu=10)
      character date*7, time*12,stype*22, wid2line*132, nil*10
      parameter(nil='NIL')
c 
      print *,'write test'
      print *,'----------'
      print *,'open ',filename(1:index(filename,' '))
      dt=indt
      rate=1./dt
      dx=1.
      n=40
      p=(dt*m)/(dx*n)
      stype='synthetic'
      date='110401'
      time='123209.012345'
      call sff_prepwid2(m, rate, 'sta   ',
     &   2011, 04, 01, 12, 32, 'chan   ', 'aux   ', 'ins     ', 
     &   10.023456, -1., -1., -1., -1., wid2line, ierr)
      if (ierr.ne.0) stop 'ERROR: preparing wid2line'
      call sff_wopens(lu, filename, stype, 'C', 0., 0., 0., date, time, ierr)
      if (ierr.ne.0) stop 'ERROR: opening file'
      s=int((dx*p)/dt)
      k=s
      do i=1,n
        print *,'write trace #',i
        do j=1,m
          d(j)=0.
        enddo
        if (k.le.m) d(k)=1./sqrt(i*dx)
        k=k+s
        if (i.eq.n) then
          call sff_wtracei(lu, wid2line, m, d, id, .true., 'C',
     &                     i*dx, 0., 0., 1, ierr)
        else
          call sff_wtracei(lu, wid2line, m, d, id, .false., 'C',
     &                     i*dx, 0., 0., 1, ierr)
        endif
        if (ierr.ne.0) stop 'ERROR: writing trace'
      enddo
c
      return

Here is the caller graph for this function: