C     program read_molts
C
C     this program will debufr the RUC MOLTS data into ascii files
C
C                                                    B. Schwartz
C                                                    June 1997
C
c     this code is built around the Jack Woolen (jb) lib stuff
C     it works EXACTLY like reading the prepbufr files
C
C     the user is asked to input station numbers for desired sta sata
c     or all stations can be retrieved. 
c
c     this initial version will return all parameters that are
c     found in a seperate file called 'molts_parm.lis'
c

      PARAMETER	(MAXDTA = 100000)
      parameter(ifn = 11)
      character*256 input_file
      character*80 output_file
      character*72 reqparms(100)
      character*4 ahr
      character*5 asta  
      real*8 data (maxdta),stadata(50000)
      integer ista(100)
      character*9 adate
C--------------------------------------------------------------------
C
1     WRITE (6,*) ' Enter the MOLTS BUFR file name'
      READ (5,100) input_file
100   FORMAT (A)
      IF ( filnam .eq. ' ' ) STOP
      CALL JB_OPEN ( input_file, ifn,ier )
      IF ( ier .ne. 0 ) THEN
      WRITE (6,*) ' Error opening file, IRET = ', ier
      GO TO 1
      END IF
c
c     ask the user what they want
c
      write(6,*) 'enter the adate of the data(a9)'
      read(5,'(a9)') adate
      write(6,*) ' enter 0 for all stations;0TRW anything (i1)'
      read(5,'(i1)') nst
c
      if(nst.ne.0) then
                   write(6,*) 'enter # of stations(i3)'
                   read(5,'(i3)') nsta
c
      write(6,*) 'enter the station #s one per line(max=100,i5)'
      do 125 i = 1,nsta
      read(5,'(i5)') ista(i)
 125  continue
                   endif
c
c     read list of parameters to get data for
c
      open(unit=10,file='molts_parms.lis',status='old')
c
      read(10,'(i2)') nparms
      do 128 i = 1,nparms
      read(10,'(a4)') reqparms(i)
 128  continue
c
c
c
      do 1000 iii = 1, 100000
c
c
c  
      CALL JB_NEXT ( ifn, iymdh, ier )
c
      if(ier.ne.0) then
                   write(6,*) 'problem with/ or end of file'
                   go to 1025
                   endif
c
      CALL JB_READ ( ifn, 'STNM', MAXDTA,
     +data, np, nlv, ier )
c
      write(6,'(f7.0)') data(1)

      if(nsta.eq.0) go to 150 !doing all stations
c
c     get station number so we can check it
c
      if(ier.ne.0) then
                   write(6,*) 'error calling jb_read'
                   stop
                   endif
c       
c
      do 140 i = 1,nsta
      if(data(1).ne.ista(i)) go to 140
      go to 150
 140  continue
c
c     station is not one we want; read next BUFR station
c
      go to 1000
c
c     now get data for all parameters in the file (input parm list)
c
 150   ifound = ifound + 1
       ic = 0 !counts data items (words) for this station's output array
       is = is + 1 !counts stations encountered
       nid = data(1) !save sta number
c
c      get the ftim regardless of whether it is in the list
c
       call jb_read( ifn, 'FTIM', MAXDTA, data,np,nlv,ier)
       nhr = data(1)/3600
       write(ahr,155) nhr !for file name later
 155   format('00',i2.2)
c
      do 300 i = 1, nparms
c
      call jb_read( ifn, reqparms(i),maxdta,data,np,nlv,ier)
c
      if(ier.ne.0) then
      write(6,160) reqparms(i)
 160  format(' cant find this parameter in the data: ', a4)
      go to 300
                    endif
c
c
c     store all the data for this station in an array
c
      do 200 j = 1,nlv
      ic = ic + 1 !number of words in the data array
      stadata(ic) = data(j)
 200  continue                  !next level this parameter
c
 300  continue !next parameter this station
c
c     write a file for this sta using date from input_file
c
      write(asta,'(i5.5)') nid
      output_file = adate//ahr//'.'//asta
c
      il = index(output_file,'  ') - 1
      open(unit=20,file=output_file(1:il),status='unknown',
     *form = 'formatted')
c
      do 375 k = 1,ic
      write(20,325) stadata(k)
 325  format(f15.5)
 375  continue
c
      write(6,400) output_file,ic
 400  format('wrote file: ',a<il>, ' with ',i5,' words')
c
      close(20)
c
c
c     if(ifound.eq.nsta) go to 1025 !done
 1000 continue
c
c
c
 1025 write(6,1050) is
 1050 format('done: wrote out ',i5,' stations')
c
      stop
      end
c***********************************************************