SUBROUTINE UFBRMS(IMSG,ISUB,USR,I1,I2,IRET,STR)
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: UFBRMS
C PRGMMR: WOOLLEN ORG: NP20 DATE: 1994-01-06
C
C ABSTRACT: THIS SUBROUTINE READS SPECIFIED VALUES OUT OF A PARTICULAR
C SUBSET WHICH HAS BEEN READ INTO INTERNAL SUBSET ARRAYS FROM A
C PARTICULAR BUFR MESSAGE IN INTERNAL MEMORY. THE DATA VALUES
C CORRESPOND TO MNEMONICS WHICH ARE PART OF A DELAYED-REPLICATION
C SEQUENCE, OR FOR WHICH THERE IS NO REPLICATION AT ALL. THE SUBSET
C READ IN IS BASED ON THE SUBSET NUMBER IN THE MESSAGE AND THE
C MESSAGE READ IN IS BASED ON THE MESSAGE NUMBER IN INTERNAL MEMORY.
C THIS SUBROUTINE IS ACTUALLY A COMBINATION OF BUFR ARCHIVE LIBRARY
C SUBROUTINES RDMEMM, RDMEMS AND UFBINT.
C
C PROGRAM HISTORY LOG:
C 1994-01-06 J. WOOLLEN -- ORIGINAL AUTHOR
C 1998-07-08 J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C ROUTINE "BORT"
C 1999-11-18 J. WOOLLEN -- THE MAXIMUM NUMBER OF BYTES REQUIRED TO
C STORE ALL MESSAGES INTERNALLY WAS INCREASED
C FROM 4 MBYTES TO 8 MBYTES
C 2001-08-15 D. KEYSER -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
C BYTES REQUIRED TO STORE ALL MESSAGES
C INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
C 16 MBYTES
C 2003-11-04 S. BENDER -- ADDED REMARKS/BUFRLIB ROUTINE
C INTERDEPENDENCIES
C 2003-11-04 D. KEYSER -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
C BUFR MESSAGES WHICH CAN BE STORED
C INTERNALLY) INCREASED FROM 50000 TO 200000;
C UNIFIED/PORTABLE FOR WRF; ADDED
C DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
C MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
C TERMINATES ABNORMALLY OR UNUSUAL THINGS
C HAPPEN
C 2004-11-15 D. KEYSER -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
C BYTES REQUIRED TO STORE ALL MESSAGES
C INTERNALLY) WAS INCREASED FROM 16 MBYTES TO
C 50 MBYTES
C 2009-04-21 J. ATOR -- USE ERRWRT
C
C USAGE: CALL UFBRMS (IMSG, ISUB, USR, I1, I2, IRET, STR)
C INPUT ARGUMENT LIST:
C IMSG - INTEGER: POINTER TO BUFR MESSAGE NUMBER (RECORD) IN
C STORAGE
C ISUB - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR
C MESSAGE
C I1 - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE
C NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER
C MUST BE AT LEAST AS LARGE AS LATTER)
C I2 - INTEGER: LENGTH OF SECOND DIMENSION OF USR
C STR - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
C MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
C DIMENSION OF USR {THIS CAN ALSO BE A SINGLE TABLE D
C (SEQUENCE) MNEMONIC WITH EITHER 8- OR 16-BIT DELAYED
C REPLICATION (SEE REMARKS 1 IN UFBINT DOCBLOCK)}
C
C OUTPUT ARGUMENT LIST:
C USR - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES READ
C FROM DATA SUBSET
C IRET - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
C DATA SUBSET (MUST BE NO LARGER THAN I2)
C
C REMARKS:
C NOTE THAT UFBMEM IS CALLED PRIOR TO THIS TO STORE THE BUFR
C MESSAGES INTO INTERNAL MEMORY.
C
C THIS ROUTINE CALLS: BORT ERRWRT RDMEMM RDMEMS
C STATUS UFBINT
C THIS ROUTINE IS CALLED BY: None
C Normally called only by application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
. MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
. IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
. INODE(NFILES),IDATE(NFILES)
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 = 'BUFRLIB: UFBRMS - 4th ARG. (INPUT) IS .LE. 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 = 'BUFRLIB: UFBRMS - 5th ARG. (INPUT) IS .LE. 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