rdmems.f

Go to the documentation of this file.

C> @file
C> @brief Read a specified data subset from a BUFR message.
C>
C> @author J. Woollen @date 1994-01-06
 
C> This subroutine reads a specified data subset from the BUFR message
C> that was most recently read via a call to subroutine rdmemm() or
C> readmm().
C>
C> Whenever this subroutine returns with IRET = 0, this indicates
C> that a new BUFR data subset (i.e. report) was successfully read into
C> internal arrays within the BUFRLIB software, and from where it can
C> now be easily manipulated or further parsed via calls to any of the
C> [values-reading subroutines](@ref hierarchy) using the Fortran
C> logical unit number IUNIT that was returned from the most recent
C> call to subroutine ufbmem().
C>
C> @param[in] ISUB - integer: Number of data subset to be
C> read from BUFR message, counting from the beginning of the message.
C> @param[out] IRET - integer: return code
C> - 0 = requested data subset was successfully read.
C> - -1 = requested subset number could not be found in the message.
C>
C> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE rdmems(ISUB,IRET)
 
      USE moda_msgcwd
      USE moda_unptyp
      USE moda_bitbuf
      USE moda_msgmem
      USE modv_im8b
 
      CHARACTER*128 bort_str,errstr
 
      COMMON /quiet / iprt
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(isub,my_isub,1)
         CALL rdmems(my_isub,iret)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
C  CHECK THE MESSAGE REQUEST AND FILE STATUS
C  -----------------------------------------
 
      CALL status(munit,lun,il,im)
      IF(il.EQ.0) GOTO 900
      IF(il.GT.0) GOTO 901
      IF(im.EQ.0) GOTO 902
      IF(nsub(lun).NE.0) GOTO 903
 
      IF(isub.GT.msub(lun)) THEN
         IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
           WRITE ( unit=errstr, fmt='(A,I5,A,A,I5,A)' )
     .      'BUFRLIB: RDMEMS - REQ. SUBSET #', isub, ' (= 1st INPUT ',
     .      'ARG.) > # OF SUBSETS IN MEMORY MESSAGE (', msub(lun), ')'
           CALL errwrt(errstr)
           CALL errwrt('RETURN WITH IRET = -1')
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         iret = -1
         GOTO 100
      ENDIF
 
      mbym = mbyt(lun)
      nbyt = 0
 
C  POSITION TO SUBSET NUMBER ISUB IN MEMORY MESSAGE
C  ------------------------------------------------
 
      IF(msgunp(lun).EQ.0) THEN
         nsub(lun) = isub-1
         DO i=1,isub-1
         mbyt(lun) = mbyt(lun) + iupb(mbay(1,lun),mbyt(lun)+1,16)
         ENDDO
      ELSEIF(msgunp(lun).EQ.1) THEN
c  .... message with "standard" Section 3
         DO i=1,isub-1
         CALL readsb(munit,iret)
         ENDDO
      ELSEIF(msgunp(lun).EQ.2) THEN
c  .... compressed message
         nsub(lun) = isub-1
      ENDIF
 
C  NOW READ SUBSET NUMBER ISUB FROM MEMORY MESSAGE
C  -----------------------------------------------
 
      CALL readsb(munit,iret)
c  .... This should have already been accounted for with stmt. 902 or
c       IRET = -1 above
      IF(iret.NE.0) GOTO 904
 
C  RESET SUBSET POINTER BACK TO ZERO (BEGINNING OF MESSAGE) AND RETURN
C  -------------------------------------------------------------------
 
      mbyt(lun) = mbym
      nsub(lun) = 0
 
C  EXITS
C  -----
 
100   RETURN
900   CALL bort('BUFRLIB: RDMEMS - INPUT BUFR FILE IS CLOSED, IT '//
     . 'MUST BE OPEN FOR INPUT')
901   CALL bort('BUFRLIB: RDMEMS - INPUT BUFR FILE IS OPEN FOR '//
     . 'OUTPUT, IT MUST BE OPEN FOR INPUT')
902   CALL bort('BUFRLIB: RDMEMS - A MEMORY MESSAGE MUST BE OPEN IN '//
     . 'INPUT BUFR FILE, NONE ARE')
903   WRITE(bort_str,'("BUFRLIB: RDMEMS - UPON ENTRY, SUBSET POINTER '//
     . 'IN MEMORY MESSAGE IS NOT AT BEGINNING (",I3," SUBSETS HAVE '//
     . 'BEEN READ, SHOULD BE 0)")') nsub(lun)
      CALL bort(bort_str)
904   CALL bort('BUFRLIB: RDMEMS - CALL TO ROUTINE READSB RETURNED '//
     . 'WITH IRET = -1 (EITHER MEMORY MESSAGE NOT OPEN OR ALL '//
     . 'SUBSETS IN MESSAGE READ')
      END