      program ttable
c        designed for use with ellipticity
c        phases unwrapped to 0-360 deg
      save
      parameter (max=60,nda=400,nde=10)
      logical log,prnt(3)
      character*20 ctnam,cfnam
      dimension tt(max),dtdd(max),dtdh(max),dddp(max),mn(max),ts(max)
      real tab(max,nda,nde),pab(max,nda,nde),depab(nde),rangab(nda)
      integer iab(nda,nde)
      character*8 pcdab(max,nda,nde)
      character*8 phcd(max),phlst(10),phchr
      character*20 modnam
      dimension xcor(max),tcor(max),usrc(2)
      data in/1/,modnam/'iasp91'/,phlst(1)/'query'/,prnt(3)/.true./
c
      call assign(10,3,'ttim1.lis')
c                                  read model name
c                                  in assignment routine
      read (5,fmt='(a)') ctnam
      write(6,*) 'Model: ',ctnam
      call tabin(in,ctnam)
c                                  read file name for tables
      read (5,fmt='(a)') cfnam
      write(6,*) ' Table file:',cfnam
c     call tabin(in,modnam)
      prnt(1) = .false.
      prnt(2) = .false.
      write(6,*) 'Phase specification'
      read(5,*) phchr
      phlst(1) = phchr
*      phlst(1) = 'all'
      phlst(2) = '   '
      call brnset(1,phlst,prnt)
c
      read(5,*) ndepth
      write(6,*) 'no of depths:',ndepth
      read(5,*) (depab(k),k=1,ndepth)
      write(6,*) 'depths:',(depab(k),k=1,ndepth)
      read(5,*)  delmin,delmax,delinc 
      write(6,*)'delmin delmax delinc:',delmin,delmax,delinc
      ndelta = int((delmax-delmin)/delinc)+1
c     
      open(8,file=cfnam)
      do 400 k=1,ndepth    
        zs = depab(k)
        write(6,*) 'depth',zs
        call depset(zs,usrc)
        delta = delmin
        do 500 m=1,ndelta
          rangab(m) = delta
          call trtm(delta,max,n,tt,dtdd,dtdh,dddp,phcd)
          if(n.le.0) then    
           write(*,101)delta
 101       format(/1x,'No arrivals for delta =',f7.2)
           go to 539
          endif
          write(6,*) k,m
          iab(m,k) = n
          do 540 i=1,n
            mn(i)=tt(i)/60.
            ts(i)=tt(i)-mn(i)*60.
            pcdab(i,m,k) = phcd(i)
            tab(i,m,k)   = tt(i)
            pab(i,m,k)   = dtdd(i) 
 540      continue
c         write(6,*) rangab(m)
c         write(6,*) (i,pcdab(i,m,k),tab(i,m,k),mn(i),ts(i),
c    1     pab(i,m,k),i=1,n)
 539      delta = delta+delinc 
 500    continue
 400  continue
c
      write(6,*) ndelta,ndepth
      write(8,*) ndelta,ndepth
      do 600 m=1,ndelta
        delta = rangab(m)
        write(8,*) delta
        do 700 k=1,ndepth
          nfa = 0
          nsz = iab(m,k)
          do 710 i=1,nsz
            if(delta.le.180) then
             if(pab(i,m,k).gt.0) then
               nfa = nfa+1
             endif
            elseif(delta.gt.180) then
             if(pab(i,m,k).lt.0) then
               nfa = nfa+1
             endif
            endif
 711        format(a,2x,f12.2,f12.5)
 710      continue
          write(8,*) depab(k),nfa
          do 712 i=1,nsz
            if(delta.le.180) then
             if(pab(i,m,k).gt.0) then
               write(8,711) pcdab(i,m,k),tab(i,m,k),pab(i,m,k)
             endif
            elseif(delta.gt.180) then
             if(pab(i,m,k).lt.0) then
               pmab = -pab(i,m,k)
               write(8,711) pcdab(i,m,k),tab(i,m,k),pmab
             endif
            endif
 712      continue
 700    continue
 600  continue
      close (8)
 13   continue 
      close (in)
c     call retrns(in)
      call exit(0)
      end 

