NCEPLIBS-bufr  11.6.0
 All Data Structures Files Functions Variables Pages
jstnum.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Left-justify a character string containing an encoded integer
3 
4 C> This subroutine left-justifies a character string containing an
5 C> encoded integer, by removing all leading blanks and any leading
6 C> sign ('+' or '-') character. The string is modified in place, and
7 C> the sign is returned as a separate parameter. If the input string
8 C> contains only blank characters, then a call is made to subroutine
9 C> bort().
10 C>
11 C> @author J. Woollen
12 C> @date 1994-01-06
13 C>
14 C> @param[in,out] STR -- character*(*): String
15 C> @param[out] SIGN -- character*1: Sign of encoded integer value
16 C> - '+' = positive value
17 C> - '-' = negative value
18 C> @param[out] IRET -- integer: return code
19 C> - 0 = normal return
20 C> - -1 = input string contained non-blank
21 C> characters which were also non-numeric
22 C>
23 C> <b>Program History Log:</b>
24 C> | Date | Programmer | Comments |
25 C> | -----|------------|----------|
26 C> | 1994-01-06 | J. Woollen | Original author |
27 C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
28 C> | 2002-05-14 | J. Woollen | Changed from an entry point to increase portability to other platforms |
29 C> | 2003-11-04 | J. Ator | Added documentation |
30 C> | 2009-04-21 | J. Ator | Use errwrt() |
31 C> | 2021-09-30 | J. Ator | Use Fortran intrinsic adjustl |
32 C>
33  SUBROUTINE jstnum(STR,SIGN,IRET)
34 
35  CHARACTER*(*) str
36 
37  CHARACTER*128 errstr
38  CHARACTER*1 sign
39 
40  COMMON /quiet / iprt
41 
42 C-----------------------------------------------------------------------
43 C-----------------------------------------------------------------------
44 
45  iret = 0
46 
47  IF(str.EQ.' ') goto 900
48 
49  str = adjustl(str)
50  lstr = len(str)
51  IF(str(1:1).EQ.'+') THEN
52  str = str(2:lstr)
53  sign = '+'
54  ELSEIF(str(1:1).EQ.'-') THEN
55  str = str(2:lstr)
56  sign = '-'
57  ELSE
58  sign = '+'
59  ENDIF
60 
61  CALL strnum(str,num)
62  IF(num.LT.0) THEN
63  IF(iprt.GE.0) THEN
64  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
65  errstr = 'BUFRLIB: JSTNUM: ENCODED VALUE WITHIN RESULTANT '//
66  . 'CHARACTER STRING (' // str // ') IS NOT AN INTEGER - '//
67  . 'RETURN WITH IRET = -1'
68  CALL errwrt(errstr)
69  CALL errwrt('+++++++++++++++++++++WARNING+++++++++++++++++++++++')
70  CALL errwrt(' ')
71  ENDIF
72  iret = -1
73  ENDIF
74 
75 C EXITS
76 C -----
77 
78  RETURN
79 900 CALL bort('BUFRLIB: JSTNUM - INPUT BLANK CHARACTER STRING NOT '//
80  . 'ALLOWED')
81  END
subroutine jstnum(STR, SIGN, IRET)
This subroutine left-justifies a character string containing an encoded integer, by removing all lead...
Definition: jstnum.f:33
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
Definition: strnum.f:23
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
Definition: errwrt.f:41
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.f:22