var/external/bufr/ufbinx.f

   1       SUBROUTINE UFBINX(LUNIT,IMSG,ISUB,USR,I1,I2,IRET,STR)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    UFBINX
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 2003-11-04
   7 C
   8 C ABSTRACT: THIS SUBROUTINE EITHER OPENS A BUFR FILE CONNECTED TO
   9 C   LOGICAL UNIT LUNIT FOR INPUT OPERATIONS (IF IT IS NOT ALREADY
  10 C   OPENED AS SUCH), OR SAVES ITS POSITION AND REWINDS IT TO THE FIRST
  11 C   DATA MESSAGE (IF BUFR FILE ALREADY OPENED), THEN (VIA A CALL TO
  12 C   BUFR ARCHIVE LIBRARY SUBROUTINE UFBINT) READS SPECIFIED VALUES FROM
  13 C   INTERNAL SUBSET ARRAYS ASSOCIATED WITH A PARTICULAR SUBSET FROM A
  14 C   PARTICULAR BUFR MESSAGE IN A MESSAGE BUFFER.  THE PARTICULAR SUBSET
  15 C   AND BUFR MESSAGE ARE BASED BASED ON THE SUBSET NUMBER IN THE
  16 C   MESSAGE AND THE MESSAGE NUMBER IN THE BUFR FILE.  FINALLY, THIS
  17 C   SUBROUTINE EITHER CLOSES THE BUFR FILE IN LUNIT (IF IS WAS OPENED
  18 C   HERE) OR RESTORES IT TO ITS PREVIOUS READ/WRITE STATUS AND POSITION
  19 C   (IF IT WAS NOT OPENED HERE).  SEE UFBINT FOR MORE INFORMATION ON
  20 C   THE READING OF VALUES OUT OF A BUFR MESSAGE SUBSET.  NOTE: THE
  21 C   MESSAGE NUMBER HERE DOES NOT INCLUDE THE DICTIONARY MESSAGES AT THE
  22 C   BEGINNING OF THE FILE.
  23 C
  24 C PROGRAM HISTORY LOG:
  25 C 2003-11-04  J. WOOLLEN -- ORIGINAL AUTHOR (WAS IN VERIFICATION
  26 C                           VERSION BUT MAY HAVE BEEN IN THE PRODUCTION
  27 C                           VERSION AT ONE TIME AND THEN REMOVED)
  28 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED
  29 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  30 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  31 C                           ABNORMALLY
  32 C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  33 C                           20,000 TO 50,000 BYTES
  34 C 2009-03-23  J. ATOR    -- MODIFY LOGIC TO HANDLE BUFR TABLE MESSAGES
  35 C                           ENCOUNTERED ANYWHERE IN THE FILE (AND NOT
  36 C                           JUST AT THE BEGINNING!)
  37 C 2012-09-15  J. WOOLLEN -- MODIFIED FOR C/I/O/BUFR INTERFACE
  38 C                           USE 'INX' ARGUMENT TO OPENBF
  39 C
  40 C USAGE:    CALL UFBINX (LUNIT, IMSG, ISUB, USR, I1, I2, IRET, STR)
  41 C   INPUT ARGUMENT LIST:
  42 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  43 C     IMSG     - INTEGER: POINTER TO BUFR MESSAGE NUMBER TO READ IN
  44 C                BUFR FILE
  45 C     ISUB     - INTEGER: POINTER TO SUBSET NUMBER TO READ IN BUFR
  46 C                MESSAGE
  47 C     I1       - INTEGER: LENGTH OF FIRST DIMENSION OF USR OR THE
  48 C                NUMBER OF BLANK-SEPARATED MNEMONICS IN STR (FORMER
  49 C                MUST BE AT LEAST AS LARGE AS LATTER)
  50 C     I2       - INTEGER: LENGTH OF SECOND DIMENSION OF USR
  51 C     STR      - CHARACTER*(*): STRING OF BLANK-SEPARATED TABLE B
  52 C                MNEMONICS IN ONE-TO-ONE CORRESPONDENCE WITH FIRST
  53 C                DIMENSION OF USR {THIS CAN ALSO BE A SINGLE TABLE D
  54 C                (SEQUENCE) MNEMONIC WITH EITHER 8- OR 16-BIT DELAYED
  55 C                REPLICATION (SEE REMARKS 1 IN UFBINT DOCBLOCK)}
  56 C
  57 C   OUTPUT ARGUMENT LIST:
  58 C     USR      - REAL*8: (I1,I2) STARTING ADDRESS OF DATA VALUES READ
  59 C                FROM DATA SUBSET
  60 C     IRET     - INTEGER: NUMBER OF "LEVELS" OF DATA VALUES READ FROM
  61 C                DATA SUBSET (MUST BE NO LARGER THAN I2)
  62 C
  63 C   INPUT FILES:
  64 C     UNIT "LUNIT" - BUFR FILE
  65 C
  66 C REMARKS:
  67 C    THIS ROUTINE CALLS:        BORT     CLOSBF   OPENBF   READMG
  68 C                               READSB   REWNBF   STATUS   UFBINT
  69 C                               UPB
  70 C    THIS ROUTINE IS CALLED BY: None
  71 C                               Normally called only by application
  72 C                               programs.
  73 C
  74 C ATTRIBUTES:
  75 C   LANGUAGE: FORTRAN 77
  76 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  77 C
  78 C$$$
  79
  80       INCLUDE 'bufrlib.prm'
  81
  82       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
  83      .                INODE(NFILES),IDATE(NFILES)
  84       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
  85      .                MBAY(MXMSGLD4,NFILES)
  86
  87       CHARACTER*(*) STR
  88       CHARACTER*128 BORT_STR
  89       CHARACTER*8   SUBSET
  90       LOGICAL       OPENIT
  91       REAL*8        USR(I1,I2)
  92
  93 C-----------------------------------------------------------------------
  94 C-----------------------------------------------------------------------
  95
  96       CALL STATUS(LUNIT,LUN,IL,IM)
  97       OPENIT = IL.EQ.0
  98
  99       IF(OPENIT) THEN
 100
 101 C  OPEN BUFR FILE CONNECTED TO UNIT LUNIT IF IT IS NOT ALREADY OPEN
 102 C  ----------------------------------------------------------------
 103
 104          CALL OPENBF(LUNIT,'INX',LUNIT)
 105       ELSE
 106
 107 C  IF BUFR FILE ALREADY OPENED, SAVE POSITION & REWIND TO FIRST DATA MSG
 108 C  ---------------------------------------------------------------------
 109
 110          CALL REWNBF(LUNIT,0)
 111       ENDIF
 112
 113 C  SKIP TO MESSAGE # IMSG
 114 C  ----------------------
 115
 116 C     Note that we need to use subroutine READMG to actually read in all
 117 C     of the messages (including the first (IMSG-1) messages!), just in
 118 C     case there are any embedded dictionary messages in the file.
 119
 120       DO I=1,IMSG
 121          CALL READMG(LUNIT,SUBSET,JDATE,JRET)
 122          IF(JRET.LT.0) GOTO 901
 123       ENDDO
 124
 125 C  POSITION AT SUBSET # ISUB
 126 C  -------------------------
 127
 128       DO I=1,ISUB-1
 129          IF(NSUB(LUN).GT.MSUB(LUN)) GOTO 902
 130          IBIT = MBYT(LUN)*8
 131          CALL UPB(NBYT,16,MBAY(1,LUN),IBIT)
 132          MBYT(LUN) = MBYT(LUN) + NBYT
 133          NSUB(LUN) = NSUB(LUN) + 1
 134       ENDDO
 135
 136       CALL READSB(LUNIT,JRET)
 137       IF(JRET.NE.0) GOTO 902
 138
 139       CALL UFBINT(LUNIT,USR,I1,I2,IRET,STR)
 140
 141       IF(OPENIT) THEN
 142
 143 C  CLOSE BUFR FILE IF IT WAS OPENED HERE
 144 C  -------------------------------------
 145
 146          CALL CLOSBF(LUNIT)
 147       ELSE
 148
 149
 150 C  RESTORE BUFR FILE TO PREV. STATUS & POSITION IF NOT ORIG. OPENED HERE
 151 C  ---------------------------------------------------------------------
 152
 153          CALL REWNBF(LUNIT,1)
 154       ENDIF
 155
 156 C  EXITS
 157 C  -----
 158
 159       RETURN
 160 901   WRITE(BORT_STR,'("BUFRLIB: UFBINX - HIT END OF FILE BEFORE '//
 161      . 'READING REQUESTED MESSAGE NO.",I5," IN BUFR FILE CONNECTED TO'//
 162      . ' UNIT",I4)')  IMSG,LUNIT
 163       CALL BORT(BORT_STR)
 164 902   WRITE(BORT_STR,'("BUFRLIB: UFBINX - ALL SUBSETS READ BEFORE '//
 165      . 'READING REQ. SUBSET NO.",I3," IN REQ. MSG NO.",I5," IN BUFR '//
 166      . 'FILE CONNECTED TO UNIT",I4)') ISUB,IMSG,LUNIT
 167       CALL BORT(BORT_STR)
 168       END