igetrfel.f

Go to the documentation of this file.

C> @file
C> @brief Check whether a specified element refers to
C> a previous element within the same subset via an internal bitmap.
C>
C> @author J Ator @date 2016-05-27
 
C> This function checks whether the input element refers to
C> a previous element within the same subset via an internal bitmap.
C> If so, then the referenced element is returned. In addition, if
C> the input element is a 2-XX-255 marker operator, its scale factor,
C> bit width and reference value are set internally to match those
C> of the referenced element.
C>
C> @param[in] N - integer: subset element.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C>
C> @return Subset element referenced by element N within the same subset.
C> - 0 input element does not refer to a previous element, or referenced
C> element not found.
C>
C> @author J. Ator @date 2016-05-27
        INTEGER FUNCTION igetrfel ( N, LUN )
 
        USE moda_msgcwd
        USE moda_usrint
        USE moda_tables
        USE moda_bitmaps
        USE moda_nrv203
 
        CHARACTER*128   bort_str
        CHARACTER*6     cflwopr,adn30,fxy
        CHARACTER*1     tab
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
        igetrfel = 0
 
        node = inv( n, lun )
 
        IF ( itp(node) .GT. 1 ) THEN
            IF ( node .EQ. lstnod ) THEN
                lstnodct = lstnodct + 1
            ELSE
                lstnod = node
                lstnodct = 1
            END IF
C
C           Does this subset definition contain any Table C operators
C           with an X value of 21 or greater?
C
            idxta = 0
            IF ( ntamc .GT. 0 ) THEN
                nodtam = lstjpb( node, lun, 'SUB' )
                DO ii = 1, ntamc
                  IF ( nodtam .EQ. inodtamc(ii) ) THEN
                    idxta = ii
                    ntc = ntco(ii)
                  END IF
                END DO
            END IF
            IF ( ( idxta .GT. 0 ) .AND. ( nbtm .GT. 0 ) ) THEN
 
C               Check whether this element references a previous element
C               in the same subset via an internal bitmap.  To do this,
C               we first need to determine the appropriate "follow"
C               operator (if any) corresponding to this element.
 
                cflwopr = 'XXXXXX'
                IF ( imrkopr(tag(node)) .EQ. 1 ) THEN
                  cflwopr = tag(node)(1:3) // '000'
                ELSE
                  CALL nemtab( lun, tag(node), idn, tab, nn )
                  IF ( tab .EQ. 'B' ) THEN
                    fxy = adn30(idn,6)
                    IF ( fxy(2:3) .EQ. '33' ) cflwopr = '222000'
                  END IF
                END IF
                IF ( cflwopr .EQ. 'XXXXXX' ) THEN
                  IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 900
                  RETURN
                END IF
 
C               Now, check whether the appropriate "follow" operator was
C               actually present in the subset.  If there are multiple
C               occurrences, we want the one that most recently precedes
C               the element in question.
 
                nodflw = 0
                DO jj = 1, ntc
                  IF ( ( ctco(idxta,jj) .EQ. cflwopr ) .AND.
     .                ( inodtco(idxta,jj) .GE. inode(lun) ) .AND.
     .                ( inodtco(idxta,jj) .LE. isc(inode(lun)) ) .AND.
     .                ( inodtco(idxta,jj) .LT. node ) )
     .              nodflw = inodtco(idxta,jj)
                ENDDO
                IF ( nodflw .EQ. 0 ) THEN
                  IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 901
                  RETURN
                END IF
 
C               We found an appropriate corresponding "follow" operator,
C               so now we need to look for a bitmap corresponding to
C               this operator.  First, look for a bitmap indicator.
 
                nodl236 = 0
                nodbmap = 0
                jj = 1
                DO WHILE ( ( jj .LE. ntc ) .AND.
     .                ( inodtco(idxta,jj) .GE. inode(lun) ) .AND.
     .                ( inodtco(idxta,jj) .LE. isc(inode(lun)) ) .AND.
     .                  ( nodbmap .EQ. 0 ) )
                  IF ( ctco(idxta,jj) .EQ. '236000' ) THEN
                    nodl236 = inodtco(idxta,jj)
                    IF ( inodtco(idxta,jj) .EQ. nodflw ) THEN
                      nodbmap = nodflw
                    END IF
                  ELSE IF ( ( ctco(idxta,jj) .EQ. '235000' ) .OR.
     .                      ( ctco(idxta,jj) .EQ. '237255' ) ) THEN
                    nodl236 = 0
                  ELSE IF ( ( ctco(idxta,jj) .EQ. '237000' ) .AND.
     .                     ( inodtco(idxta,jj) .EQ. nodflw ) .AND.
     .                      ( nodl236 .NE. 0 ) ) THEN
                    nodbmap = nodl236
                  END IF
                  jj = jj + 1
                END DO
                IF ( nodbmap .EQ. 0 ) THEN
 
C                 There was no valid bitmap indicator, so we'll just
C                 look for a bitmap after the "follow" indicator.
 
                  nodbmap = nodflw
                END IF
 
C               Find the corresponding bitmap.
 
                nn = 1
                idxbtm = 0
                DO WHILE ( ( idxbtm .EQ. 0 ) .AND.
     .                    ( nn .LE. nval(lun) ) )
                  IF ( inv( nn, lun ) .GT. nodbmap ) THEN
                    ii = 1
                    DO WHILE ( ( idxbtm .EQ. 0 ) .AND.
     .                        ( ii .LE. nbtm ) )
                      IF ( nn .EQ. istbtm(ii) ) THEN
                        idxbtm = ii
                      ELSE
                        ii = ii + 1
                      END IF
                    END DO
                  END IF
                  nn = nn + 1
                END DO
                IF ( idxbtm .EQ. 0 ) THEN
                  IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 902
                  RETURN
                END IF
 
C               Use the bitmap to find the previous element in the
C               subset that is referenced by the current element.
C               Search backwards from the start of the bitmap, but
C               make sure not to cross a 2-35-000 operator.
 
                IF ( lstnodct .GT. nbtmse(idxbtm) ) THEN
                  IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 903
                  RETURN
                END IF
                iemrk = iszbtm(idxbtm) - ibtmse(idxbtm,lstnodct) + 1
                iect = 0
                DO WHILE ( ( nn .GE. 1 ) .AND. ( igetrfel .EQ. 0 ) )
                  nodnn = inv( nn, lun )
                  IF ( nodnn .LE. nodbmap ) THEN
                    DO jj = 1, ntc
                      IF ( ( nodnn .EQ. inodtco(idxta,jj) ) .AND.
     .                    ( ctco(idxta,jj) .EQ. '235000' ) ) THEN
                        IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 903
                        RETURN
                      END IF
                    END DO
                    IF ( itp(nodnn) .GT. 1 ) THEN
                      iect = iect + 1
                      IF ( iect .EQ. iemrk ) igetrfel = nn
                    END IF
                  END IF
                  nn = nn - 1
                END DO
                IF ( igetrfel .EQ. 0 ) THEN
                  IF ( imrkopr(tag(node)) .EQ. 1 ) GOTO 903
                  RETURN
                END IF
 
                IF ( imrkopr(tag(node)) .EQ. 1 ) THEN
 
C                 This element is a marker operator, so set the scale,
C                 reference value and bit width accordingly based on
C                 those of the previous referenced element.
 
                  nodrfe = inv( igetrfel, lun )
                  isc(node) = isc(nodrfe)
                  IF ( tag(node)(1:3) .EQ. '225' ) THEN
                    ibt(node) = ibt(nodrfe) + 1
                    irf(node) = -1 * (2 ** ibt(nodrfe))
                  ELSE
                    ibt(node) = ibt(nodrfe)
                    irf(node) = irf(nodrfe)
                    IF ( nnrv .GT. 0 ) THEN
                      DO ii = 1, nnrv
                        IF ( ( nodrfe .NE. inodnrv(ii) ) .AND.
     .                      ( tag(nodrfe)(1:8) .EQ. tagnrv(ii) ) .AND.
     .                      ( nodrfe .GE. isnrv(ii) ) .AND.
     .                      ( nodrfe .LE. ienrv(ii) ) ) THEN
                          irf(node) = int(nrv(ii))
                          RETURN
                        END IF
                      END DO
                    END IF
                  END IF
                END IF
 
            END IF
        END IF
 
        RETURN
900     WRITE(bort_str,'("BUFRLB: IGETRFEL - UNABLE TO DETERMINE '//
     .      'FOLLOW OPERATOR FOR MARKER OPERATOR ",A)') tag(node)
        CALL bort(bort_str)
901     WRITE(bort_str,'("BUFRLB: IGETRFEL - UNABLE TO FIND FOLLOW '//
     .      'OPERATOR ",A," IN SUBSET")') cflwopr
        CALL bort(bort_str)
902     WRITE(bort_str,'("BUFRLB: IGETRFEL - UNABLE TO FIND BITMAP '//
     .      'FOR MARKER OPERATOR ",A)') tag(node)
        CALL bort(bort_str)
903     WRITE(bort_str,'("BUFRLB: IGETRFEL - UNABLE TO FIND PREVIOUS '//
     .      'ELEMENT REFERENCED BY MARKER OPERATOR ",A)') tag(node)
        CALL bort(bort_str)
        END