var/external/bufr/rdmsgb.f

   1       SUBROUTINE RDMSGB(LUNIT,MESG,IRET)
   2
   3 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
   4 C
   5 C SUBPROGRAM:    RDMSGB
   6 C   PRGMMR: ATOR             ORG: NP12       DATE: 2005-11-29
   7 C
   8 C ABSTRACT: THIS SUBROUTINE READS THE NEXT BUFR MESSAGE FROM LOGICAL
   9 C   UNIT LUNIT AS AN ARRAY OF BYTES, WHICH ARE THEN TRANSFERRED TO
  10 C   AN ARRAY OF INTEGER WORDS FOR OUTPUT.
  11 C
  12 C PROGRAM HISTORY LOG:
  13 C 2005-11-29  J. ATOR    -- ORIGINAL AUTHOR
  14 C 2009-03-23  D. KEYSER  -- CALLS BORT IN CASE OF MESG OVERFLOW
  15 C
  16 C USAGE:    CALL RDMSGB (LUNIT, MESG, IRET)
  17 C   INPUT ARGUMENT LIST:
  18 C     LUNIT    - INTEGER: FORTRAN LOGICAL UNIT NUMBER FOR BUFR FILE
  19 C
  20 C   OUTPUT ARGUMENT LIST:
  21 C     MESG     - *-WORD ARRAY CONTAINING BUFR MESSAGE READ FROM LUNIT
  22 C     IRET     - INTEGER: RETURN CODE:
  23 C                       0 = normal return
  24 C                      -1 = end-of-file encountered while reading
  25 C                           from LUNIT
  26 C                      -2 = I/O error encountered while reading
  27 C                           from LUNIT
  28 C
  29 C   INPUT FILES:
  30 C     UNIT "LUNIT" - BUFR FILE
  31 C
  32 C REMARKS:
  33 C    THIS ROUTINE CALLS:        BORT     ICHKSTR  IUPBS01  LMSG
  34 C    THIS ROUTINE IS CALLED BY: None
  35 C                               Normally not called by any application
  36 C                               programs.
  37 C
  38 C ATTRIBUTES:
  39 C   LANGUAGE: FORTRAN 77
  40 C   MACHINE:  PORTABLE TO ALL PLATFORMS
  41 C
  42 C$$$
  43
  44       INCLUDE 'bufrlib.prm'
  45
  46       COMMON /HRDWRD/ NBYTW,NBITW,IORD(8)
  47
  48       DIMENSION   MESG(*)
  49
  50       CHARACTER*128 BORT_STR
  51       CHARACTER*8 SEC0
  52       CHARACTER*1 CBAY(8*MXMSGLD4)
  53       DIMENSION   JBAY(MXMSGLD4)
  54
  55       EQUIVALENCE (CBAY(1),JBAY(1),SEC0)
  56
  57 C-----------------------------------------------------------------------
  58 C-----------------------------------------------------------------------
  59
  60       SEC0 = ' '
  61
  62 C     Read Section 0 from the next message in the file.
  63
  64       READ(LUNIT,END=100,ERR=200) SEC0
  65
  66 C     Confirm that the first 4 bytes contain 'BUFR' encoded in
  67 C     CCITT IA5 (i.e. ASCII).
  68
  69       IF(ICHKSTR('BUFR',CBAY,4).NE.0) GOTO 200
  70
  71 C     Check the length of the next message to make sure it will fit
  72 C     within the output array.
  73
  74       LNMSG = LMSG(SEC0)
  75       IF(LNMSG*NBYTW.GT.MXMSGL) GOTO 900
  76
  77 C     Read the rest of the message as an array of bytes.
  78
  79       READ(LUNIT,END=100,ERR=200) (CBAY(I),I=9,IUPBS01(JBAY,'LENM'))
  80
  81 C     Transfer the message to the output array.
  82
  83       DO I=1,LNMSG
  84         MESG(I) = JBAY(I)
  85       ENDDO
  86
  87 C  EXITS
  88 C  -----
  89
  90       IRET = 0
  91       RETURN
  92
  93 100   IRET = -1
  94       RETURN
  95
  96 200   IRET = -2
  97       RETURN
  98
  99 900   WRITE(BORT_STR,'("BUFRLIB: RDMSGB - INPUT BUFR MESSAGE LENGTH (",
 100      . I6," BYTES) IS LARGER THAN LIMIT OF ",I6," BYTES")')
 101      . LNMSG*NBYTW,MXMSGL
 102       CALL BORT(BORT_STR)
 103       END