valx.f

Go to the documentation of this file.

C> @file
C> @author WOOLLEN @date 1994-01-06
      
C> THIS FUNCTION DECODES A REAL NUMBER FROM A CHARACTER
C>   STRING.  IF THE DECODE FAILS, THEN THE VALUE BMISS IS
C>   RETURNED.  NOTE THAT, UNLIKE FOR SUBROUTINE STRNUM, THE INPUT
C>   STRING MAY CONTAIN A LEADING SIGN CHARACTER (E.G. '+', '-').
C>
C> PROGRAM HISTORY LOG:
C> 1994-01-06  J. WOOLLEN -- ORIGINAL AUTHOR
C> 1998-07-08  J. WOOLLEN -- REPLACED CALL TO CRAY LIBRARY ROUTINE
C>                           "ABORT" WITH CALL TO NEW INTERNAL BUFRLIB
C>                           ROUTINE "BORT"
C> 1999-11-18  J. WOOLLEN -- RENAMED THIS FUNCTION FROM "VAL$" TO "VALX"
C>                           TO REMOVE THE POSSIBILITY OF THE "$" SYMBOL
C>                           CAUSING PROBLEMS ON OTHER PLATFORMS
C> 2003-11-04  J. ATOR    -- ADDED DOCUMENTATION
C> 2003-11-04  S. BENDER  -- ADDED REMARKS/BUFRLIB ROUTINE
C>                           INTERDEPENDENCIES
C> 2003-11-04  D. KEYSER  -- UNIFIED/PORTABLE FOR WRF; ADDED HISTORY
C>                           DOCUMENTATION; OUTPUTS MORE COMPLETE
C>                           DIAGNOSTIC INFO WHEN ROUTINE TERMINATES
C>                           ABNORMALLY; CHANGED CALL FROM BORT TO BORT2
C> 2009-04-21  J. ATOR    -- USE ERRWRT
C>
C> USAGE:    VALX (STR)
C>   INPUT ARGUMENT LIST:
C>     STR      - CHARACTER*(*): STRING CONTAINING ENCODED REAL VALUE
C>
C>   OUTPUT ARGUMENT LIST:
C>     VALX     - REAL: DECODED VALUE
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        BORT2    ERRWRT   RJUST
C>    THIS ROUTINE IS CALLED BY: GETTBH   NEMTBB   UPFTBV
C>                               Normally not called by any application
C>                               programs but it could be.
C>
      FUNCTION valx(STR)

      USE modv_bmiss

      CHARACTER*(*) str
      CHARACTER*128 bort_str1,bort_str2
      CHARACTER*99  bstr
      CHARACTER*8   fmt

      COMMON /quiet / iprt

C----------------------------------------------------------------------
C----------------------------------------------------------------------

      lens = len(str)
      IF(lens.GT.99) goto 900
      bstr(1:lens) = str
      rj = rjust(bstr(1:lens))
      WRITE(fmt,'(''(F'',I2,''.0)'')') lens
      valx = bmiss
      READ(bstr,fmt,err=800) val
      valx = val
      goto 100
800   IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt('BUFRLIB: VALX - ERROR READING STRING:')
      CALL errwrt(bstr(1:lens))
      CALL errwrt('RETURN WITH VALX = MISSING')
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
      ENDIF

C  EXITS
C  -----

100   RETURN
900   WRITE(bort_str1,'("STRING IS: ",A)') str
      WRITE(bort_str2,'("BUFRLIB: VALX - STRING LENGTH EXCEEDS LIMIT '//
     . ' OF 99 CHARACTERS")')
      CALL bort2(bort_str1,bort_str2)
      END