var/external/bufr/ufbrms.f

   1       SUBROUTINE UFBRMS(IMSG,ISUB,USR,I1,I2,IRET,STR)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UFBRMS
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE READS SPECIFIED VALUES OUT OF A PARTICULAR
   9 C   SUBSET WHICH HAS BEEN READ INTO INTERNAL SUBSET ARRAYS FROM A
  10 C   PARTICULAR BUFR MESSAGE IN INTERNAL MEMORY.  THE DATA VALUES
  11 C   CORRESPOND TO MNEMONICS WHICH ARE PART OF A DELAYED-REPLICATION
  12 C   SEQUENCE, OR FOR WHICH THERE IS NO REPLICATION AT ALL. THE SUBSET
  13 C   READ IN IS BASED ON THE SUBSET NUMBER IN THE MESSAGE AND THE
  14 C   MESSAGE READ IN IS BASED ON THE MESSAGE NUMBER IN INTERNAL MEMORY.
  15 C   THIS SUBROUTINE IS ACTUALLY A COMBINATION OF BUFR ARCHIVE LIBRARY
  16 C   SUBROUTINES RDMEMM, RDMEMS AND UFBINT.
  17 C
  18 C PROGRAM HISTORY LOG:
  19 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  20 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  21 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  22 C                           ROUTINE "BORT"
  23 C 1999-11-18  J. WOOLLEN -- THE MAXIMUM NUMBER OF BYTES REQUIRED TO
  24 C                           STORE ALL MESSAGES INTERNALLY WAS INCREASED
  25 C                           FROM 4 MBYTES TO 8 MBYTES
  26 C 2001-08-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  27 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  28 C                           INTERNALLY) WAS INCREASED FROM 8 MBYTES TO
  29 C                           16 MBYTES
  30 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  31 C                           INTERDEPENDENCIES
  32 C 2003-11-04  D. KEYSER  -- PARAMETER MAXMSG (THE MAXIMUM NUMBER OF
  33 C                           BUFR MESSAGES WHICH CAN BE STORED
  34 C                           INTERNALLY) INCREASED FROM 50000 TO 200000;
  35 C                           UNIFIED/PORTABLE FOR WRF; ADDED
  36 C                           DOCUMENTATION (INCLUDING HISTORY); OUTPUTS
  37 C                           MORE COMPLETE DIAGNOSTIC INFO WHEN ROUTINE
  38 C                           TERMINATES ABNORMALLY OR UNUSUAL THINGS
  39 C                           HAPPEN
  40 C 2004-11-15  D. KEYSER  -- PARAMETER MAXMEM (THE MAXIMUM NUMBER OF
  41 C                           BYTES REQUIRED TO STORE ALL MESSAGES
  42 C                           INTERNALLY) WAS INCREASED FROM 16 MBYTES TO
  43 C                           50 MBYTES
  44 C 2009-04-21  J. ATOR    -- USE ERRWRT
  45 C
  46 C USAGE:    CALL UFBRMS (IMSG, ISUB, USR, I1, I2, IRET, STR)
  47 C   INPUT ARGUMENT LIST:
  48 C     IMSG     - INTEGER: POINTER TO BUFR MESSAGE NUMBER (RECORD) IN
  49 C                STORAGE
  50 C     ISUB     - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR
  51 C                MESSAGE
  52 C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE
  53 C                NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER
  54 C                MUST BE AT LEAST AS LARGE AS LATTER)
  55 C     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF USR
  56 C     STR      - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
  57 C                MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
  58 C                DIMENSION OF USR {THIS CAN ALSO BE A SINGLE TABLE D
  59 C                (SEQUENCE) MNEMONIC WITH EITHER 8- OR 16-BIT DELAYED
  60 C                REPLICATION (SEE REMARKS 1 IN UFBINT DOCBLOCK)}
  61 C
  62 C   OUTPUT ARGUMENT LIST:
  63 C     USR      - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES READ
  64 C                FROM DATA SUBSET
  65 C     IRET     - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
  66 C                DATA SUBSET (MUST BE NO LARGER THAN I2)
  67 C
  68 C REMARKS:
  69 C    NOTE THAT UFBMEM IS CALLED PRIOR TO THIS TO STORE THE BUFR
  70 C    MESSAGES INTO INTERNAL MEMORY.
  71 C
  72 C    THIS ROUTINE CALLS:        BORT     ERRWRT   RDMEMM   RDMEMS
  73 C                               STATUS   UFBINT
  74 C    THIS ROUTINE IS CALLED BY: None
  75 C                               Normally called only by application
  76 C                               programs.
  77 C
  78 C ATTRIBUTES:
  79 C   LANGUAGE: FORTRAN 77
  80 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  81 C
  82 C$$$
  83
  84       INCLUDE 'bufrlib.prm'
  85
  86       COMMON /MSGMEM/ MUNIT,MLAST,MSGP(0:MAXMSG),MSGS(MAXMEM),
  87      .                MDX(MXDXW),IPDXM(MXDXM),LDXM,NDXM,LDXTS,NDXTS,
  88      .                IFDXTS(MXDXTS),ICDXTS(MXDXTS),IPMSGS(MXDXTS)
  89       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  90      .                INODE(NFILES),IDATE(NFILES)
  91       COMMON /QUIET / IPRT
  92
  93       CHARACTER*(*) STR
  94       CHARACTER*128 BORT_STR,ERRSTR
  95       CHARACTER*8   SUBSET
  96       REAL*8        USR(I1,I2)
  97
  98 C-----------------------------------------------------------------------
  99 C-----------------------------------------------------------------------
 100
 101       IRET = 0
 102       IF(I1.LE.0) THEN
 103          IF(IPRT.GE.0) THEN
 104       CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
 105       ERRSTR = 'BUFRLIB: UFBRMS - 4th ARG. (INPUT) IS .LE. 0, ' //
 106      .   'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
 107       CALL ERRWRT(ERRSTR)
 108       CALL ERRWRT(STR)
 109       CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
 110       CALL ERRWRT(' ')
 111          ENDIF
 112          GOTO 100
 113       ELSEIF(I2.LE.0) THEN
 114          IF(IPRT.GE.0) THEN
 115       CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
 116       ERRSTR = 'BUFRLIB: UFBRMS - 5th ARG. (INPUT) IS .LE. 0, ' //
 117      .   'SO RETURN WITH 6th ARG. (IRET) = 0; 7th ARG. (STR) ='
 118       CALL ERRWRT(ERRSTR)
 119       CALL ERRWRT(STR)
 120       CALL ERRWRT('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
 121       CALL ERRWRT(' ')
 122          ENDIF
 123          GOTO 100
 124       ENDIF
 125
 126 C  UFBINT SUBSET #ISUB FROM MEMORY MESSAGE #IMSG
 127 C  ---------------------------------------------
 128
 129       CALL RDMEMM(IMSG,SUBSET,JDATE,IRET)
 130       IF(IRET.LT.0) GOTO 900
 131       CALL RDMEMS(ISUB,IRET)
 132       IF(IRET.NE.0) GOTO 901
 133
 134       CALL UFBINT(MUNIT,USR,I1,I2,IRET,STR)
 135
 136 C  EXITS
 137 C  -----
 138
 139 100   RETURN
 140 900   IF(IMSG.GT.0)  THEN
 141       WRITE(BORT_STR,'("BUFRLIB: UFBRMS - REQUESTED MEMORY MESSAGE '//
 142      . 'NUMBER TO READ IN (",I5,") EXCEEDS THE NUMBER OF MESSAGES IN '//
 143      . 'MEMORY (",I5,")")') IMSG,MSGP(0)
 144       ELSE
 145       WRITE(BORT_STR,'("BUFRLIB: UFBRMS - REQUESTED MEMORY MESSAGE '//
 146      . 'NUMBER TO READ IN IS ZERO - THIS IS NOT VALID")')
 147       ENDIF
 148       CALL BORT(BORT_STR)
 149 901   CALL STATUS(MUNIT,LUN,IL,IM)
 150       WRITE(BORT_STR,'("BUFRLIB: UFBRMS - REQ. SUBSET NUMBER TO READ '//
 151      . 'IN (",I3,") EXCEEDS THE NUMBER OF SUBSETS (",I3,") IN THE '//
 152      . 'REQ. MEMORY MESSAGE (",I5,")")') ISUB,MSUB(LUN),IMSG
 153       CALL BORT(BORT_STR)
 154       END