C234567890--------------------------------------------------------------------
      program getupa_site   
c
c  Program to read upper air data and write data for a given site to a file
c
c      written on  10/14/98 by paul ciesielski
c
c      gfortran getupa_site.f -o getupa_site.x 
c
C-----------------------------------------------------------------------------
c      character tline*120, line*120, cid*5, sid*5, upaf*12, site*9
       character tline*64, line*64, line2*64, cid*5, sid*5
       character upaf*14, site*9
C----------------------------------------------------------------------------

       nsnd = 0

       print *, 'specify site wmo number ...>'
       read(5,'(a5)') cid

       write(site, 4) cid
    4  format('upa_',a5)
       print *, 'write data to file :', site

       open(2, file='upa.list', form='formatted', status='unknown')
       open(3, file=site, form='formatted', status='unknown')

   5   read(2, '(a14)',end=99) upaf

c   open data sounding data file

       open (8,file=upaf, status='old', form='formatted', err=5 )

       num = 0
 10    read (8,'(a64)',end=5) tline
       if (tline(2:4) .eq. 'STN') then
 	  read (8,'(a64)',end=5) line
	  read (line,702) sid
          if(sid .eq. cid) then
	     read (8,'(a64)',end=5) line2
             read (line2(7:11),*) nlvl
             if(nlvl .gt. 0) then
                go to 12
             endif
          endif
          go to 10
   12     continue
          print *, 'found data for time :', upaf(7:14)
          write(11,*) 'found data for time :', upaf(7:14)
          nsnd = nsnd + 1
          write(3,'(a64)') tline
          write(3,'(a64)') line
 702      format (45x,a5)
 705      format (i3,a7,2x,i8,2x,2f8.2)
C----------------------------------------------------------------------------
          lvl = 0
c	  read (8,'(a64)',end=5) line
          write(3,'(a64)') line2
          read (8,'(a64)',end=5) line
          write(3,'(a64)') line
   20     read (8,'(a64)',end=5) line
          lvl = lvl + 1
          if (line(2:4) .eq. 'STN') then
            nl = lvl - 1
            if (nl .ne. nlvl) then
               print *, 'nlvl, nl', nlvl, nl
               write(17,*) 'upa.',upaf(5:12), ' nlvl, nl', nlvl, nl
            endif
	    close(8)
            go to 5
	  else
            write(3,'(a64)') line
            go to 20
          endif
        else
           go to 10
        endif

   99 continue

      print *, 'found data for ',nsnd,' times'
      stop 'Success'
      end
c------------------------------------------------------------------
