ufbmms.f

Go to the documentation of this file.

C> @file
C> @brief Read a specified data subset from internal arrays.
C>
C> @author J. Woollen @date 1994-01-06
 
C> Read a specified data subset from internal arrays.
C>
C> This subroutine provides a handy way to combine the functionality
C> of subroutines rdmemm() and rdmems() within a single subroutine
C> call.
C>
C> Whenever this subroutine returns successfully, the requested data
C> subset can now be easily manipulated or further parsed via calls to
C> any of the [values-reading subroutines](@ref hierarchy) using the
C> Fortran logical unit number IUNIT that was returned from the most
C> recent call to subroutine ufbmem().
C>
C> @param[in] IMSG - integer: Number of BUFR message to be
C> read into scope for further processing, counting from the beginning of the
C> internal arrays in memory.
C> @param[in] ISUB - integer: Number of data subset to be
C> read from the (IMSG)th BUFR message, counting from the beginning of the message.
C> @param[out] SUBSET - character*8: Table A mnemonic for type of
C> (IMSG)th BUFR message (see [DX BUFR Tables](@ref dfbftab) for
C> further information about Table A mnemonics).
C> @param[out] JDATE - integer: Date-time stored within Section 1 of
C> (IMSG)th BUFR message, in format of either YYMMDDHH or YYYYMMDDHH, depending 
C> on the most recent call to subroutine datelen().
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE ufbmms(IMSG,ISUB,SUBSET,JDATE)
 
      USE modv_im8b
 
      USE moda_msgcwd
      USE moda_msgmem
 
      CHARACTER*128 bort_str
      CHARACTER*8   subset
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(imsg,my_imsg,1)
         CALL x84(isub,my_isub,1)
         CALL ufbmms(my_imsg,my_isub,subset,jdate)
         CALL x48(jdate,jdate,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
C  READ SUBSET #ISUB FROM MEMORY MESSAGE #IMSG
C  -------------------------------------------
 
      CALL rdmemm(imsg,subset,jdate,iret)
      IF(iret.LT.0) GOTO 900
      CALL rdmems(isub,iret)
      IF(iret.NE.0) GOTO 901
 
C  EXITS
C  -----
 
      RETURN
900   IF(imsg.GT.0)  THEN
      WRITE(bort_str,'("BUFRLIB: UFBMMS - REQUESTED MEMORY MESSAGE '//
     . 'NUMBER TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN '//
     . 'MEMORY (",I5,")")') imsg,msgp(0)
      ELSE
      WRITE(bort_str,'("BUFRLIB: UFBMMS - REQUESTED MEMORY MESSAGE '//
     . 'NUMBER TO READ IN IS ZERO - THIS IS NOT VALID")')
      ENDIF
      CALL bort(bort_str)
901   CALL status(munit,lun,il,im)
      WRITE(bort_str,'("BUFRLIB: UFBMMS - REQ. SUBSET NUMBER TO READ '//
     . 'IN (",I3,") EXCEEDS THE NUMBER OF SUBSETS (",I3,") IN THE '//
     . 'REG. MEMORY MESSAGE (",I5,")")') isub,msub(lun),imsg
      CALL bort(bort_str)
      END