var/external/bufr/readmg.f

   1       SUBROUTINE READMG(LUNXX,SUBSET,JDATE,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    READMG
   6 C   PRGMMR: WOOLLEN          ORG: NP20       DATE: 1994-01-06
   7 C
   8 C ABSTRACT: THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL
   9 C   UNIT NUMBER ABS(LUNXX) INTO AN INTERNAL MESSAGE BUFFER (I.E. ARRAY
  10 C   MBAY IN COMMON BLOCK /BITBUF/).  ABS(LUNXX) SHOULD ALREADY BE OPENED
  11 C   FOR INPUT OPERATIONS.  IF LUNXX < 0, THEN A READ ERROR FROM
  12 C   ABS(LUNXX) IS TREATED THE SAME AS THE END-OF-FILE (EOF) CONDITION;
  13 C   OTHERWISE, BUFR ARCHIVE LIBRARY SUBROUTINE BORT IS NORMALLY CALLED
  14 C   IN SUCH SITUATIONS.  ANY DX DICTIONARY MESSAGES ENCOUNTERED WITHIN
  15 C   ABS(LUNXX) ARE AUTOMATICALLY PROCESSED AND STORED INTERNALLY, SO A
  16 C   SUCCESSFUL RETURN FROM THIS SUBROUTINE WILL ALWAYS RESULT IN A BUFR
  17 C   MESSAGE CONTAINING ACTUAL DATA VALUES.
  18 C
  19 C PROGRAM HISTORY LOG:
  20 C 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
  21 C 1996-11-25  J. WOOLLEN -- MODIFIED TO EXIT GRACEFULLY WHEN THE BUFR
  22 C                           FILE IS POSITIONED AFTER AN "END-OF-FILE"
  23 C 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
  24 C                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
  25 C                           ROUTINE "BORT"; MODIFIED TO MAKE Y2K
  26 C                           COMPLIANT
  27 C 1999-11-18  J. WOOLLEN -- THE NUMBER OF BUFR FILES WHICH CAN BE
  28 C                           OPENED AT ONE TIME INCREASED FROM 10 TO 32
  29 C                           (NECESSARY IN ORDER TO PROCESS MULTIPLE
  30 C                           BUFR FILES UNDER THE MPI); MODIFIED WITH
  31 C                           SEMANTIC ADJUSTMENTS TO AMELIORATE COMPILER
  32 C                           COMPLAINTS FROM LINUX BOXES (INCREASES
  33 C                           PORTABILITY)
  34 C 2000-09-19  J. WOOLLEN -- REMOVED MESSAGE DECODING LOGIC THAT HAD
  35 C                           BEEN REPLICATED IN THIS AND OTHER READ
  36 C                           ROUTINES AND CONSOLIDATED IT INTO A NEW
  37 C                           ROUTINE CKTABA, CALLED HERE, WHICH IS
  38 C                           ENHANCED TO ALLOW COMPRESSED AND STANDARD
  39 C                           BUFR MESSAGES TO BE READ; MAXIMUM MESSAGE
  40 C                           LENGTH INCREASED FROM 10,000 TO 20,000
  41 C                           BYTES
  42 C 2002-05-14  J. WOOLLEN -- REMOVED ENTRY POINT DATELEN (IT BECAME A
  43 C                           SEPARATE ROUTINE IN THE BUFRLIB TO INCREASE
  44 C                           PORTABILITY TO OTHER PLATFORMS)
  45 C 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
  46 C 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
  47 C                           INTERDEPENDENCIES
  48 C 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
  49 C                           DOCUMENTATION; OUTPUTS MORE COMPLETE
  50 C                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
  51 C                           ABNORMALLY
  52 C 2004-08-09  J. ATOR    -- MAXIMUM MESSAGE LENGTH INCREASED FROM
  53 C                           20,000 TO 50,000 BYTES
  54 C 2005-11-29  J. ATOR    -- ADDED RDMSGW AND RDMSGB CALLS TO SIMULATE
  55 C                           READIBM; ADDED LUNXX < 0 OPTION TO SIMULATE
  56 C                           READFT
  57 C 2009-03-23  J. ATOR    -- ADD LOGIC TO ALLOW SECTION 3 DECODING;
  58 C                           ADD LOGIC TO PROCESS INTERNAL DICTIONARY
  59 C                           MESSAGES
  60 C 2012-06-07  J. ATOR    -- DON'T RESPOND TO INTERNAL DICTIONARY
  61 C                           MESSAGES IF SECTION 3 DECODING IS BEING USED
  62 C 2012-09-15  J. WOOLLEN -- CONVERT TO C LANGUAGE I/O INTERFACE;
  63 C                           REMOVE CODE TO REREAD MESSAGE AS BYTES;
  64 C                           REPLACE FORTRAN BACKSPACE WITH C BACKBUFR
  65 C
  66 C USAGE:    CALL READMG (LUNXX, SUBSET, JDATE, IRET)
  67 C   INPUT ARGUMENT LIST:
  68 C     LUNXX    - INTEGER: ABSOLUTE VALUE IS FORTRAN LOGICAL UNIT NUMBER
  69 C                FOR BUFR FILE (IF LUNXX IS LESS THAN ZERO, THEN READ
  70 C                ERRORS FROM ABS(LUNXX) ARE TREATED THE SAME AS EOF)
  71 C
  72 C   OUTPUT ARGUMENT LIST:
  73 C     SUBSET   - CHARACTER*8: TABLE A MNEMONIC FOR TYPE OF BUFR MESSAGE
  74 C                BEING READ
  75 C     JDATE    - INTEGER: DATE-TIME STORED WITHIN SECTION 1 OF BUFR
  76 C                MESSAGE BEING READ, IN FORMAT OF EITHER YYMMDDHH OR
  77 C                YYYYMMDDHH, DEPENDING ON DATELEN() VALUE
  78 C     IRET     - INTEGER: RETURN CODE:
  79 C                       0 = normal return
  80 C                      -1 = there are no more BUFR mesages in ABS(LUNXX)
  81 C
  82 C REMARKS:
  83 C    THIS ROUTINE CALLS:        BORT     CKTABA   ERRWRT   IDXMSG
  84 C                               RDBFDX   RDMSGW   READS3   STATUS
  85 C                               WTSTAT   BACKBUFR
  86 C    THIS ROUTINE IS CALLED BY: IREADMG  READNS   RDMGSB   REWNBF
  87 C                               UFBINX   UFBPOS
  88 C                               Also called by application programs.
  89 C
  90 C ATTRIBUTES:
  91 C   LANGUAGE: FORTRAN 77
  92 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  93 C
  94 C$$$
  95
  96       INCLUDE 'bufrlib.prm'
  97
  98       COMMON /SC3BFR/ ISC3(NFILES),TAMNEM(NFILES)
  99       COMMON /MSGCWD/ NMSG(NFILES),NSUB(NFILES),MSUB(NFILES),
 100      .                INODE(NFILES),IDATE(NFILES)
 101       COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
 102      .                MBAY(MXMSGLD4,NFILES)
 103       COMMON /QUIET / IPRT
 104
 105       CHARACTER*128 ERRSTR
 106       CHARACTER*8 SUBSET,TAMNEM
 107
 108 C-----------------------------------------------------------------------
 109 C-----------------------------------------------------------------------
 110
 111       IRET = 0
 112       LUNIT = ABS(LUNXX)
 113
 114 C  CHECK THE FILE STATUS
 115 C  ---------------------
 116
 117       CALL STATUS(LUNIT,LUN,IL,IM)
 118       IF(IL.EQ.0) GOTO 900
 119       IF(IL.GT.0) GOTO 901
 120       CALL WTSTAT(LUNIT,LUN,IL,1)
 121
 122 C  READ A MESSAGE INTO THE INTERNAL MESSAGE BUFFER
 123 C  -----------------------------------------------
 124
 125 1     CALL RDMSGW(LUNIT,MBAY(1,LUN),IER)
 126       IF(IER.EQ.-1) GOTO 200
 127
 128 C  PARSE THE MESSAGE SECTION CONTENTS
 129 C  ----------------------------------
 130
 131       IF(ISC3(LUN).NE.0) CALL READS3(LUN)
 132       CALL CKTABA(LUN,SUBSET,JDATE,IRET)
 133
 134 C  LOOK FOR A DICTIONARY MESSAGE
 135 C  -----------------------------
 136
 137       IF(IDXMSG(MBAY(1,LUN)).NE.1) RETURN
 138
 139 C     This is an internal dictionary message that was
 140 C     generated by the BUFRLIB archive library software.
 141
 142       IF(ISC3(LUN).NE.0) RETURN
 143
 144 C     Section 3 decoding isn't being used, so backspace the
 145 C     file pointer and then use subroutine RDBFDX to read in
 146 C     all such dictionary messages (they should be stored
 147 C     consecutively!) and reset the internal tables.
 148
 149       CALL BACKBUFR(LUN)
 150       CALL RDBFDX(LUNIT,LUN)
 151
 152       IF(IPRT.GE.1) THEN
 153       CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
 154       ERRSTR = 'BUFRLIB: READMG - INTERNAL DICTIONARY MESSAGE READ;'//
 155      .' ACCOUNT FOR IT THEN READ IN NEXT MESSAGE WITHOUT RETURNING'
 156       CALL ERRWRT(ERRSTR)
 157       CALL ERRWRT('++++++++++++++BUFR ARCHIVE LIBRARY+++++++++++++++++')
 158       CALL ERRWRT(' ')
 159       ENDIF
 160
 161 C     Now go read another message.
 162
 163       GOTO 1
 164
 165 C  EOF ON ATTEMPTED READ
 166 C  ---------------------
 167
 168 200   CALL WTSTAT(LUNIT,LUN,IL,0)
 169       INODE(LUN) = 0
 170       IDATE(LUN) = 0
 171       SUBSET = ' '
 172       JDATE = 0
 173       IRET = -1
 174       RETURN
 175
 176 C  EXITS
 177 C  -----
 178
 179 900   CALL BORT('BUFRLIB: READMG - INPUT BUFR FILE IS CLOSED, IT MUST'//
 180      . ' BE OPEN FOR INPUT')
 181 901   CALL BORT('BUFRLIB: READMG - INPUT BUFR FILE IS OPEN FOR OUTPUT'//
 182      . ', IT MUST BE OPEN FOR INPUT')
 183 902   CALL BORT('BUFRLIB: READMG - ERROR READING A BUFR MESSAGE')
 184       END