elemdx.f

Go to the documentation of this file.

C> @file
C> @brief Decode the scale factor, reference value,
C> bit width, and units from a Table B mnemonic definition.
C> @author Woollen @date 1994-01-06
 
C> This subroutine decodes the scale factor, reference value,
C> bit width and units (i.e., the "elements") from a Table B mnemonic
C> definition card that was previously read from a user-supplied DX BUFR
C> table file in character format by subroutine rdusdx().
C> These decoded values are then added to the
C> already-existing entry for that mnemonic within the internal BUFR
C> Table B array TABB(*,LUN) in module @ref moda_tababd.
C>
C> @param[in] CARD - character*80: mnemonic definition card that was read
C> from a user-supplied DX BUFR table.
C> @param[in] LUN - integer: I/O stream index into internal memory arrays.
C>
C> @author Woollen @date 1994-01-06
      SUBROUTINE elemdx(CARD,LUN)
 
      USE moda_tababd
 
      CHARACTER*128 BORT_STR1,BORT_STR2
      CHARACTER*80  CARD
      CHARACTER*24  UNIT
      CHARACTER*11  REFR,REFR_ORIG
      CHARACTER*8   NEMO
      CHARACTER*4   SCAL,SCAL_ORIG
      CHARACTER*3   BITW,BITW_ORIG
      CHARACTER*1   SIGN,TAB
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
C  CAPTURE THE VARIOUS ELEMENTS CHARACTERISTICS
C  --------------------------------------------
 
      nemo = card( 3:10)
      scal = card(14:17)
      refr = card(21:31)
      bitw = card(35:37)
      unit = card(41:64)
c  .... Make sure the units are all capitalized
      CALL capit(unit)
 
C  FIND THE ELEMENT TAG IN TABLE B
C  -------------------------------
 
C     Note that an entry for this mnemonic should already exist within
C     the internal BUFR Table B array TABB(*,LUN).  We now need to
C     retrieve the positional index for that entry within TABB(*,LUN)
C     so that we can access the entry and then add the scale factor,
C     reference value, bit width, and units to it.
 
      CALL nemtab(lun,nemo,idsn,tab,iele)
      IF(tab.NE.'B') GOTO 900
 
C  LEFT JUSTIFY AND STORE CHARACTERISTICS
C  --------------------------------------
 
      unit = adjustl(unit)
      IF(unit.EQ.' ') GOTO 904
      tabb(iele,lun)(71:94) = unit
 
      scal_orig=scal
      CALL jstnum(scal,sign,iret)
      IF(iret.NE.0) GOTO 901
      tabb(iele,lun)(95:95) = sign
      tabb(iele,lun)(96:98) = scal(1:3)
 
      refr_orig=refr
      CALL jstnum(refr,sign,iret)
      IF(iret.NE.0) GOTO 902
      tabb(iele,lun)( 99: 99) = sign
      tabb(iele,lun)(100:109) = refr(1:10)
 
      bitw_orig=bitw
      CALL jstnum(bitw,sign,iret)
      IF(iret.NE.0  ) GOTO 903
      IF(sign.EQ.'-') GOTO 903
      tabb(iele,lun)(110:112) = bitw
 
C  EXITS
C  -----
 
      RETURN
900   WRITE(bort_str1,'("BUFRLIB: ELEMDX - CARD READ IN IS: ",A)') card
      WRITE(bort_str2,'(18X,"MNEMONIC ",A," IS NOT A TABLE B ENTRY '//
     . '(UNDEFINED, TAB=",A,")")') nemo,tab
      CALL bort2(bort_str1,bort_str2)
901   WRITE(bort_str1,'("BUFRLIB: ELEMDX - CARD READ IN IS: ",A)') card
      WRITE(bort_str2,'(18X,"PARSED SCALE VALUE (=",A,") IS NOT '//
     . 'NUMERIC")') scal_orig
      CALL bort2(bort_str1,bort_str2)
902   WRITE(bort_str1,'("BUFRLIB: ELEMDX - CARD READ IN IS: ",A)') card
      WRITE(bort_str2,'(18X,"PARSED REFERENCE VALUE (=",A,") IS NOT '//
     . 'NUMERIC")') refr_orig
      CALL bort2(bort_str1,bort_str2)
903   WRITE(bort_str1,'("BUFRLIB: ELEMDX - CARD READ IN IS: ",A)') card
      WRITE(bort_str2,'(18X,"PARSED BIT WIDTH VALUE (=",A,") IS NOT '//
     . 'NUMERIC")') bitw_orig
      CALL bort2(bort_str1,bort_str2)
904   WRITE(bort_str1,'("BUFRLIB: ELEMDX - CARD READ IN IS: ",A)') card
      WRITE(bort_str2,'(18X,"UNITS FIELD IS EMPTY")')
      CALL bort2(bort_str1,bort_str2)
      END