strbtm.f

Go to the documentation of this file.

C> @file
C> @brief Store information about a bitmap element.
C>
C> @author J Ator @date 2016-05-27
 
C> This subroutine stores internal information in
c> module bitmaps if the input element is part of a bitmap.
C>
C> @param[in] N - integer: subset element.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C>
C> @author J. Ator @date 2016-05-27
        SUBROUTINE strbtm ( N, LUN )
 
        USE modv_mxbtm
        USE modv_mxbtmse
 
        USE moda_msgcwd
        USE moda_usrint
        USE moda_tables
        USE moda_bitmaps
 
        LOGICAL ISBTME
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
        node = inv( n, lun )
 
        IF ( tag(node)(1:5) .EQ. 'DPRI ' ) THEN
 
C           Confirm that this is really an entry within a bitmap.
C           Although it is rare, it is possible for a DPRI element
C           to appear in a subset definition outside of a bitmap.
 
            isbtme = .false.
            IF ( ntamc .GT. 0 ) THEN
                nodtam = lstjpb( node, lun, 'SUB' )
                DO ii = 1, ntamc
                  IF ( nodtam .EQ. inodtamc(ii) ) THEN
                    DO jj = 1, ntco(ii)
                      IF ( ( inodtco(ii,jj) .GE. inode(lun) ) .AND.
     .                     ( inodtco(ii,jj) .LE. isc(inode(lun)) ) .AND.
     .                     ( inodtco(ii,jj) .LT. node ) ) THEN
                        IF ( ctco(ii,jj) .EQ. '236000' ) THEN
                          isbtme = .true.
                        ELSE IF ( ( ctco(ii,jj) .EQ. '235000' ) .OR.
     .                            ( ctco(ii,jj) .EQ. '237255' ) ) THEN
                          isbtme = .false.
                        END IF
                      END IF
                    END DO
                  END IF
                END DO
            END IF
            IF ( .NOT. isbtme ) THEN
              linbtm = .false.
              RETURN
            ELSE IF ( .NOT. linbtm ) THEN
 
C               This is the start of a new bitmap.
 
                IF ( nbtm .GE. mxbtm ) GOTO 900
                nbtm = nbtm + 1
                istbtm(nbtm) = n
                iszbtm(nbtm) = 0
                nbtmse(nbtm) = 0
                linbtm = .true.
            END IF
            iszbtm(nbtm) = iszbtm(nbtm) + 1
            IF ( ibfms(val(n,lun)) .EQ. 0 ) THEN
 
C               This is a "set" (value=0) entry in the bitmap.
 
                IF ( nbtmse(nbtm) .GE. mxbtmse ) GOTO 901
                nbtmse(nbtm) = nbtmse(nbtm) + 1
                ibtmse(nbtm,nbtmse(nbtm)) = iszbtm(nbtm)
            END IF
        ELSE IF ( itp(node) .GT. 1 ) THEN
            linbtm = .false.
        END IF
 
        RETURN
900     CALL bort('BUFRLIB: STRBTM - MXBTM OVERFLOW')
901     CALL bort('BUFRLIB: STRBTM - MXBTMSE OVERFLOW')
        END