ufbrms.f

Go to the documentation of this file.

C> @file
C> @brief Read one or more data values from a data subset in
C> internal arrays.

C> This subroutine provides a handy way to combine the functionality
C> of subroutines rdmemm(), rdmems() and ufbint() within a single
C> subroutine call.
C>
C> @author J. Woollen
C> @date 1994-01-06
C>
C> @param[in] IMSG   -- integer: Number of BUFR message to be
C>                      read into scope for further processing,
C>                      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,
C>                      counting from the beginning of the message
C> @param[out] USR   -- real*8(*,*): Data values
C> @param[in] I1     -- integer: Actual first dimension of USR as
C>                      allocated within the calling program
C> @param[in] I2     -- integer: Actual second dimension of USR as
C>                      allocated within the calling program
C> @param[out] IRET -- integer: Number of replications of STR that were
C>                     actually read from the data subset
C> @param[in] STR  -- character*(*): String of blank-separated
C>                    Table B mnemonics in one-to-one
C>                    correspondence with the number of data
C>                    values that will be read from the data
C>                    subset within the first dimension of USR (see
C>                    [DX BUFR Tables](@ref dfbftab) for further
C>                    information about Table B mnemonics)
C>
C> <b>Program history log:</b>
C> | Date | Programmer | Comments |
C> | -----|------------|----------|
C> | 1994-01-06 | J. Woollen | Original author |
C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine "ABORT" with call to new internal routine bort() |
C> | 1999-11-18 | J. Woollen | Increased MAXMEM from 4 Mb to 8 Mb |
C> | 2001-08-15 | D. Keyser  | Increased MAXMEM from 8 Mb to 16 Mb |
C> | 2004-11-15 | D. Keyser  | Increased MAXMEM from 16 Mb to 50 Mb |
C> | 2009-04-21 | J. Ator    | Use errwrt() |
C> | 2014-12-10 | J. Ator    | Use modules instead of COMMON blocks |
C>
      SUBROUTINE ufbrms(IMSG,ISUB,USR,I1,I2,IRET,STR)

      USE moda_msgcwd
      USE moda_msgmem

      COMMON /quiet / iprt

      CHARACTER*(*) str
      CHARACTER*128 bort_str,errstr
      CHARACTER*8   subset
      REAL*8        usr(i1,i2)

C-----------------------------------------------------------------------
C-----------------------------------------------------------------------

      iret = 0
      IF(i1.LE.0) THEN
         IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      errstr = .LE.'BUFRLIB: UFBRMS - 4th ARG. (INPUT) IS  0, ' //
     .   'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
      CALL errwrt(errstr)
      CALL errwrt(str)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         goto 100
      ELSEIF(i2.LE.0) THEN
         IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      errstr = .LE.'BUFRLIB: UFBRMS - 5th ARG. (INPUT) IS  0, ' //
     .   'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
      CALL errwrt(errstr)
      CALL errwrt(str)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         goto 100
      ENDIF

C  UFBINT 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

      CALL ufbint(munit,usr,i1,i2,iret,str)

C  EXITS
C  -----

100   RETURN
900   IF(imsg.GT.0)  THEN
      WRITE(bort_str,'("BUFRLIB: UFBRMS - REQUESTED MEMORY MESSAGE '//
     . 'NUMBER TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN '//
     . 'MEMORY (",I5,")")') imsg,msgp(0)
      ELSE
      WRITE(bort_str,'("BUFRLIB: UFBRMS - 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: UFBRMS - REQ. SUBSET NUMBER TO READ '//
     . 'IN (",I3,") EXCEEDS THE NUMBER OF SUBSETS (",I3,") IN THE '//
     . 'REQ. MEMORY MESSAGE (",I5,")")') isub,msub(lun),imsg
      CALL bort(bort_str)
      END