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>
C> @author J. Woollen @date 1994-01-06
 
C> Read one or more data values from a data subset in
C> internal arrays.
C>
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> @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: First dimension of USR as
C>                      allocated within the calling program
C> @param[in] I2     -- integer: Second dimension of USR as
C>                      allocated within the calling program
C> @param[out] IRET -- integer: Number of replications of STR that were
C>                     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> @author J. Woollen @date 1994-01-06
      RECURSIVE SUBROUTINE ufbrms(IMSG,ISUB,USR,I1,I2,IRET,STR)
 
      USE modv_im8b
 
      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-----------------------------------------------------------------------
 
C  CHECK FOR I8 INTEGERS
C  ---------------------
 
      IF(im8b) THEN
         im8b=.false.
 
         CALL x84(imsg,my_imsg,1)
         CALL x84(isub,my_isub,1)
         CALL x84(i1,my_i1,1)
         CALL x84(i2,my_i2,1)
         CALL ufbrms(my_imsg,my_isub,usr,my_i1,my_i2,iret,str)
         CALL x48(iret,iret,1)
 
         im8b=.true.
         RETURN
      ENDIF
 
      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