jstnum.f

Go to the documentation of this file.

C> @file
C> @brief Left-justify a character string containing an encoded integer
C>
C> @author J. Woollen @date 1994-01-06
 
C> This subroutine left-justifies a character string containing an
C> encoded integer, by removing all leading blanks and any leading
C> sign ('+' or '-') character.  The string is modified in place, and
C> the sign is returned as a separate parameter.  If the input string
C> contains only blank characters, then a call is made to subroutine
C> bort().
C>
C> @param[in,out] STR -- character*(*): String
C> @param[out]   SIGN -- character*1: Sign of encoded integer value
C>                       - '+' = positive value
C>                       - '-' = negative value
C> @param[out]   IRET -- integer: return code
C>                       - 0 = normal return
C>                       - -1 = input string contained non-blank
C>                              characters which were also non-numeric
C>
C> @author J. Woollen @date 1994-01-06
      SUBROUTINE jstnum(STR,SIGN,IRET)
 
      CHARACTER*(*) STR
 
      CHARACTER*128 ERRSTR
      CHARACTER*1  SIGN
 
      COMMON /quiet / iprt
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
      iret = 0
 
      IF(str.EQ.' ') GOTO 900
 
      str = adjustl(str)
      lstr = len(str)
      IF(str(1:1).EQ.'+') THEN
         str  = str(2:lstr)
         sign = '+'
      ELSEIF(str(1:1).EQ.'-') THEN
         str  = str(2:lstr)
         sign = '-'
      ELSE
         sign = '+'
      ENDIF
 
      CALL strnum(str,num,ier)
      IF(ier.LT.0) THEN
         IF(iprt.GE.0) THEN
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      errstr = 'BUFRLIB: JSTNUM: ENCODED VALUE WITHIN RESULTANT '//
     .    'CHARACTER STRING (' // str // ') IS NOT AN INTEGER - '//
     .    'RETURN WITH IRET = -1'
      CALL errwrt(errstr)
      CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
      CALL errwrt(' ')
         ENDIF
         iret = -1
      ENDIF
 
C  EXITS
C  -----
 
      RETURN
900   CALL bort('BUFRLIB: JSTNUM - INPUT BLANK CHARACTER STRING NOT '//
     . 'ALLOWED')
      END