var/external/bufr/rdmgsb.f

   1       SUBROUTINE RDMGSB(LUNIT,IMSG,ISUB)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    RDMGSB
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2003-11-04
   7 C
   8 C ABSTRACT: THIS SUBROUTINE OPENS A BUFR FILE IN LOGICAL UNIT LUNIT FOR
   9 C   INPUT OPERATIONS, THEN READS A PARTICULAR SUBSET INTO INTERNAL
  10 C   SUBSET ARRAYS FROM A PARTICULAR BUFR MESSAGE IN A MESSAGE BUFFER.
  11 C   THIS IS BASED ON THE SUBSET NUMBER IN THE MESSAGE AND THE MESSAGE
  12 C   NUMBER IN THE BUFR FILE.  THE MESSAGE NUMBER DOES NOT INCLUDE THE
  13 C   DICTIONARY MESSAGES AT THE BEGINNING OF THE FILE.
  14 C
  15 C PROGRAM HISTORY LOG:
  16 C 2003-11-04  J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION
  17 C                           VERSION BUT MAY HAVE BEEN IN THE PRODUCTION
  18 C                           VERSION AT ONE TIME AND THEN REMOVED)
  19 C 2003-11-04  D. KEYSER  -- INCORPORATED INTO "UNIFIED" BUFR ARCHIVE
  20 C                           LIBRARY; UNIFIED/PORTABLE FOR WRF; ADDED
  21 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  22 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  23 C                           ABNORMALLY
  24 C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  25 C                           20,000 TO 50,000 BYTES
  26 C 2009-03-23  J. ATOR    -- MODIFY LOGIC TO HANDLE BUFR TABLE MESSAGES
  27 C                           ENCOUNTERED ANYWHERE IN THE FILE (AND NOT
  28 C                           JUST AT THE BEGINNING!)
  29 C
  30 C USAGE:    CALL RDMGSB (LUNIT, IMSG, ISUB)
  31 C   INPUT ARGUMENT LIST:
  32 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  33 C     IMSG     - INTEGER: POINTER TO BUFR MESSAGE NUMBER TO READ IN
  34 C                BUFR FILE
  35 C     ISUB     - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR
  36 C                MESSAGE
  37 C
  38 C   INPUT FILES:
  39 C     UNIT "LUNIT" - BUFR FILE
  40 C
  41 C REMARKS:
  42 C    THIS ROUTINE CALLS:        BORT     OPENBF   READMG   READSB
  43 C                               STATUS   UPB
  44 C    THIS ROUTINE IS CALLED BY: None
  45 C                               Normally called only by application
  46 C                               programs.
  47 C
  48 C ATTRIBUTES:
  49 C   LANGUAGE: FORTRAN 77
  50 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  51 C
  52 C$$$
  53
  54       INCLUDE 'bufrlib.prm'
  55
  56       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  57      .                INODE(NFILES),IDATE(NFILES)
  58       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
  59      .                MBAY(MXMSGLD4,NFILES)
  60
  61       CHARACTER*128 BORT_STR
  62       CHARACTER*8   SUBSET
  63
  64 C-----------------------------------------------------------------------
  65 C-----------------------------------------------------------------------
  66
  67 C  OPEN THE FILE AND SKIP TO MESSAGE # IMSG
  68 C  ----------------------------------------
  69
  70       CALL OPENBF(LUNIT,'IN',LUNIT)
  71       CALL STATUS(LUNIT,LUN,IL,IM)
  72
  73 C     Note that we need to use subroutine READMG to actually read in all
  74 C     of the messages (including the first (IMSG-1) messages!), just in
  75 C     case there are any embedded dictionary messages in the file.
  76
  77       DO I=1,IMSG
  78         CALL READMG(LUNIT,SUBSET,JDATE,IRET)
  79         IF(IRET.LT.0) GOTO 901
  80       ENDDO
  81
  82 C  POSITION AT SUBSET # ISUB
  83 C  -------------------------
  84
  85       DO I=1,ISUB-1
  86         IF(NSUB(LUN).GT.MSUB(LUN)) GOTO 902
  87         IBIT = MBYT(LUN)*8
  88         CALL UPB(NBYT,16,MBAY(1,LUN),IBIT)
  89         MBYT(LUN) = MBYT(LUN) + NBYT
  90         NSUB(LUN) = NSUB(LUN) + 1
  91       ENDDO
  92
  93       CALL READSB(LUNIT,IRET)
  94       IF(IRET.NE.0) GOTO 902
  95
  96 C  EXITS
  97 C  -----
  98
  99       RETURN
 100 900   WRITE(BORT_STR,'("BUFRLIB: RDMGSB - ERROR READING MESSAGE '//
 101      . '(RECORD) NUMBER",I5," IN INPUT BUFR FILE CONNECTED TO UNIT",'//
 102      . 'I4)')  I,LUNIT
 103       CALL BORT(BORT_STR)
 104 901   WRITE(BORT_STR,'("BUFRLIB: RDMGSB - HIT END OF FILE BEFORE '//
 105      . 'READING REQUESTED MESSAGE NO.",I5," IN BUFR FILE CONNECTED TO'//
 106      . ' UNIT",I4)')  IMSG,LUNIT
 107       CALL BORT(BORT_STR)
 108 902   WRITE(BORT_STR,'("BUFRLIB: RDMGSB - ALL SUBSETS READ BEFORE '//
 109      . 'READING REQ. SUBSET NO.",I3," IN REQ. MSG NO.",I5," IN BUFR '//
 110      . 'FILE CONNECTED TO UNIT",I4)') ISUB,IMSG,LUNIT
 111       CALL BORT(BORT_STR)
 112       END