SUBROUTINE READS3 ( LUN )
C$$$ SUBPROGRAM DOCUMENTATION BLOCK
C
C SUBPROGRAM: READS3
C PRGMMR: ATOR ORG: NP12 DATE: 2009-03-23
C
C ABSTRACT: THIS SUBROUTINE READS THE SECTION 3 DESCRIPTORS FROM THE
C BUFR MESSAGE IN MBAY(1,LUN). IT THEN USES THE BUFR MASTER TABLES
C TO GENERATE THE NECESSARY INFORMATION FOR THESE DESCRIPTORS WITHIN
C THE INTERNAL BUFR TABLE ARRAYS.
C
C PROGRAM HISTORY LOG:
C 2009-03-23 J. ATOR -- ORIGINAL AUTHOR
C
C USAGE: CALL READS3 (LUN)
C INPUT ARGUMENT LIST:
C LUN - INTEGER: I/O STREAM INDEX INTO INTERNAL MEMORY ARRAYS
C
C REMARKS:
C THIS ROUTINE CALLS: ADN30 BORT DXINIT ERRWRT
C IGETNTBI IGETTDI ISTDESC IUPBS01
C MAKESTAB READMT STNTBIA STSEQ
C UPDS3
C THIS ROUTINE IS CALLED BY: READERME READMG
C Normally not called by any application
C programs.
C
C ATTRIBUTES:
C LANGUAGE: FORTRAN 77
C MACHINE: PORTABLE TO ALL PLATFORMS
C
C$$$
INCLUDE 'bufrlib.prm'
COMMON /QUIET/ IPRT
COMMON /SC3BFR/ ISC3(NFILES),TAMNEM(NFILES),IRDMT
COMMON /BITBUF/ MAXBYT,IBIT,IBAY(MXMSGLD4),MBYT(NFILES),
. MBAY(MXMSGLD4,NFILES)
COMMON /DSCACH/ NCNEM,CNEM(MXCNEM),NDC(MXCNEM),
. IDCACH(MXCNEM,MAXNC)
DIMENSION IDS3(MAXNC)
CHARACTER*6 CDS3(MAXNC),NUMB,ADN30
CHARACTER*8 CNEM,TAMNEM
CHARACTER*55 CSEQ
CHARACTER*128 ERRSTR
LOGICAL INCACH, ALLSTD
C* Initializing the following value ensures that new master tables
C* are read during the first call to this subroutine.
DATA LMT /-99/
SAVE LMT, LMTV, LOGCE, LMTVL, IREPCT
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
C* Unpack some Section 1 information from the message.
IMT = IUPBS01 ( MBAY(1,LUN), 'BMT' )
IMTV = IUPBS01 ( MBAY(1,LUN), 'MTV' )
IOGCE = IUPBS01 ( MBAY(1,LUN), 'OGCE' )
IMTVL = IUPBS01 ( MBAY(1,LUN), 'MTVL' )
C* Unpack the list of Section 3 descriptors from the message.
CALL UPDS3 ( MBAY(1,LUN), MAXNC, CDS3, NCDS3 )
DO II = 1, NCDS3
IDS3(II) = IFXY( CDS3(II) )
ENDDO
C* Compare the master table and master table version numbers from
C* this message to those from the message that was processed during
C* the previous call to this subroutine.
IF ( ( IMT .NE. LMT )
. .OR.
. ( ( IMT .NE. 0 ) .AND. ( IMTV .NE. LMTV ) )
. .OR.
. ( ( IMT .EQ. 0 ) .AND. ( IMTV .NE. LMTV ) .AND.
. ( ( IMTV .GT. 13 ) .OR. ( LMTV .GT. 13 ) ) ) )
. THEN
C* Either the master table number has changed
C* .OR.
C* The master table number hasn't changed, but it isn't 0, and
C* the table version number has changed
C* .OR.
C* The master table number hasn't changed and is 0, but the table
C* version number has changed, and at least one of the table
C* version numbers (i.e. the current or the previous) is greater
C* than 13 (which is the last version that was a superset of all
C* earlier versions of master table 0!)
C* In any of these cases, we need to read in new tables and reset
C* the internal tables and local descriptor cache, since the
C* meanings of one or more Section 3 descriptors may have changed.
CALL READMT ( IMT, IMTV, IOGCE, IMTVL )
LMT = IMT
LMTV = IMTV
LOGCE = IOGCE
LMTVL = IMTVL
CALL DXINIT ( LUN, 0 )
IREPCT = 0
NCNEM = 0
ELSE
C* Check whether all of the Section 3 descriptors are standard.
C* If so, then the originating center and local table version
C* numbers are irrelevant as far as Section 3 is concerned.
II = 1
ALLSTD = .TRUE.
DO WHILE ( (ALLSTD) .AND. (II.LE.NCDS3) )
IF ( ISTDESC(IDS3(II)) .EQ. 0 ) THEN
ALLSTD = .FALSE.
ELSE
II = II + 1
ENDIF
ENDDO
IF ( .NOT. ALLSTD ) THEN
C* There was at least one local (i.e. non-standard) descriptor,
C* so check whether the originating center and/or local table
C* version number are different than those from the message
C* that was processed during the previous call to this
C* subroutine. If so, then read in new tables and reset the
C* internal tables and local descriptor cache, since the
C* meanings of one or more local descriptors in Section 3 may
C* have changed.
IF ( ( IOGCE .NE. LOGCE ) .OR. ( IMTVL .NE. LMTVL ) ) THEN
CALL READMT ( IMT, IMTV, IOGCE, IMTVL )
LMT = IMT
LMTV = IMTV
LOGCE = IOGCE
LMTVL = IMTVL
CALL DXINIT ( LUN, 0 )
IREPCT = 0
NCNEM = 0
ENDIF
ENDIF
ENDIF
C* Is the list of Section 3 descriptors already in the cache?
C* The cache is a performance-enhancing device which saves
C* time when the same descriptor sequences are encountered
C* over and over within the calling program. Time is saved
C* because the below calls to subroutines STSEQ and MAKESTAB
C* are bypassed whenever a list is already in the cache.
INCACH = .FALSE.
IF ( NCNEM .GT. 0 ) THEN
II = 1
DO WHILE ( (.NOT.INCACH) .AND. (II.LE.NCNEM) )
IF ( NCDS3 .EQ. NDC(II) ) THEN
JJ = 1
INCACH = .TRUE.
DO WHILE ( (INCACH) .AND. (JJ.LE.NCDS3) )
IF ( IDS3(JJ) .EQ. IDCACH(II,JJ) ) THEN
JJ = JJ + 1
ELSE
INCACH = .FALSE.
ENDIF
ENDDO
IF (INCACH) THEN
C* The list is already in the cache, so store the
C* corresponding Table A mnemonic into COMMON /SC3BFR/
C* and return.
IF ( IPRT .GE. 2 ) THEN
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: READS3 - RE-USED CACHE LIST FOR ' // CNEM(II)
CALL ERRWRT(ERRSTR)
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
TAMNEM(LUN) = CNEM(II)
RETURN
ENDIF
ENDIF
II = II + 1
ENDDO
ENDIF
C* Get the next available index within the internal Table A.
N = IGETNTBI ( LUN, 'A' )
C* Generate a Table A mnemonic and sequence description.
WRITE ( TAMNEM(LUN), '(A5,I3.3)') 'MSTTB', N
CSEQ = 'TABLE A MNEMONIC ' // TAMNEM(LUN)
C* Store the Table A mnemonic and sequence into the cache.
NCNEM = NCNEM + 1
IF ( NCNEM .GT. MXCNEM ) GOTO 900
CNEM(NCNEM) = TAMNEM(LUN)
NDC(NCNEM) = NCDS3
DO JJ = 1, NCDS3
IDCACH(NCNEM,JJ) = IDS3(JJ)
ENDDO
IF ( IPRT .GE. 2 ) THEN
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
ERRSTR = 'BUFRLIB: READS3 - STORED CACHE LIST FOR ' //
. CNEM(NCNEM)
CALL ERRWRT(ERRSTR)
CALL ERRWRT('+++++++++++++++++++++++++++++++++++++++++++++++++')
CALL ERRWRT(' ')
ENDIF
C* Get an FXY value to use with this Table A mnemonic.
IDN = IGETTDI ( LUN )
NUMB = ADN30 ( IDN, 6 )
C* Store all of the information for this mnemonic within the
C* internal Table A.
CALL STNTBIA ( N, LUN, NUMB, TAMNEM(LUN), CSEQ )
C* Store all of the information for this sequence within the
C* internal Tables B and D.
CALL STSEQ ( LUN, IREPCT, IDN, TAMNEM(LUN), CSEQ, IDS3, NCDS3 )
C* Update the jump/link table.
CALL MAKESTAB
RETURN
900 CALL BORT('BUFRLIB: READS3 - MXCNEM OVERFLOW')
END