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 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 OUTPUT FILES: C UNIT 06 - STANDARD OUTPUT PRINT 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 RDMEMM RDMEMS STATUS C 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) COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES), . INODE(NFILES),IDATE(NFILES) COMMON /QUIET / IPRT CHARACTER*(*) STR CHARACTER*128 BORT_STR CHARACTER*8 SUBSET REAL*8 USR(I1,I2) C----------------------------------------------------------------------- C----------------------------------------------------------------------- IRET = 0 IF(I1.LE.0) THEN IF(IPRT.GE.0) THEN PRINT* PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++' PRINT*,'BUFRLIB: UFBRMS - FOURTH ARGUMENT (INPUT) IS .LE. 0', . ' - RETURN WITH SIXTH ARGUMENT (IRET) = 0' PRINT*,'STR = ',STR PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++' PRINT* ENDIF GOTO 100 ELSEIF(I2.LE.0) THEN IF(IPRT.GE.0) THEN PRINT* PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++' PRINT*,'BUFRLIB: UFBRMS - FIFTH ARGUMENT (INPUT) IS .LE. 0', . ' - RETURN WITH SIXTH ARGUMENT (IRET) = 0' PRINT*,'STR = ',STR PRINT*,'+++++++++++++++++++++++WARNING+++++++++++++++++++++++++' PRINT* ENDIF GOTO 100 ENDIF C UFBINT SUBSET #ISUB FROM MEMORY MESSAGE #IMSG C --------------------------------------------- CALL RDMEMM(IMSG,SUBSET,JDATE,IRET) IF(IRET.NE.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