ufbqcd.f

Go to the documentation of this file.

C> @file
C> @brief Get the event program code associated with a Table D mnemonic
C> from an NCEP prepbufr file
C>
C> @author J. Woollen @date 1994-01-06
 
C> Given a mnemonic associated with a category 63 Table D
C> descriptor from an NCEP prepbufr file, this subroutine returns the
C> corresponding event program code.
C>
C> The event program code is equivalent to the Y value of the
C> category 63 (i.e. X=63) Table D descriptor.  Knowledge of this value
C> is especially useful for application programs which are writing data
C> events to NCEP prepbufr files.
C>
C> Logical unit LUNIT should have already been opened via a previous
C> call to subroutine openbf().
C>
C> This subroutine is the logical inverse of subroutine ufbqcp().
C>
C> @param[in] LUNIT -- integer: Fortran logical unit number for
C>                     NCEP prepbufr file
C> @param[in] NEMO  -- character*(*): Mnemonic associated with a
C>                     category 63 (i.e. X=63) Table D descriptor
C> @param[out] IQCD -- integer: Y value of descriptor associated
C>                     with NEMO
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE ufbqcd(LUNIT,NEMO,IQCD)
 
      USE modv_im8b
 
      CHARACTER*(*) nemo
      CHARACTER*128 bort_str
      CHARACTER*6   fxy,adn30
      CHARACTER*1   tab
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(lunit,my_lunit,1)
         CALL ufbqcd(my_lunit,nemo,iqcd)
         CALL x48(iqcd,iqcd,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      CALL status(lunit,lun,il,im)
      IF(il.EQ.0) GOTO 900
 
      CALL nemtab(lun,nemo,idn,tab,iret)
      IF(tab.NE.'D') GOTO 901
 
      fxy = adn30(idn,6)
      IF(fxy(2:3).NE.'63') GOTO 902
      READ(fxy(4:6),'(I3)',err=903) iqcd
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort('BUFRLIB: UFBQCD - BUFR FILE IS CLOSED, IT MUST BE'//
     . ' OPEN')
901   WRITE(bort_str,'("BUFRLIB: UFBQCD - INPUT MNEMONIC ",A," NOT '//
     . 'DEFINED AS A SEQUENCE DESCRIPTOR IN BUFR TABLE")') nemo
      CALL bort(bort_str)
902   WRITE(bort_str,'("BUFRLIB: UFBQCD - BUFR TABLE SEQ. DESCRIPTOR '//
     . 'ASSOC. WITH INPUT MNEMONIC ",A," HAS INVALID CATEGORY ",A," -'//
     . ' CATEGORY MUST BE 63")') nemo,fxy(2:3)
      CALL bort(bort_str)
903   WRITE(bort_str,'("BUFRLIB: UFBQCD - ERROR READING ENTRY '//
     . '(PROGRAM CODE) FROM BUFR TBL SEQ. DESCRIPTOR ",A," ASSOC. '//
     . 'WITH INPUT MNEM. ",A)') fxy,nemo
      CALL bort(bort_str)
      END