NCEPLIBS-bufr 11.7.1
jstnum.f
Go to the documentation of this file.
1C> @file
2C> @brief Left-justify a character string containing an encoded integer
3
4C> This subroutine left-justifies a character string containing an
5C> encoded integer, by removing all leading blanks and any leading
6C> sign ('+' or '-') character. The string is modified in place, and
7C> the sign is returned as a separate parameter. If the input string
8C> contains only blank characters, then a call is made to subroutine
9C> bort().
10C>
11C> @author J. Woollen
12C> @date 1994-01-06
13C>
14C> @param[in,out] STR -- character*(*): String
15C> @param[out] SIGN -- character*1: Sign of encoded integer value
16C> - '+' = positive value
17C> - '-' = negative value
18C> @param[out] IRET -- integer: return code
19C> - 0 = normal return
20C> - -1 = input string contained non-blank
21C> characters which were also non-numeric
22C>
23C> <b>Program History Log:</b>
24C> | Date | Programmer | Comments |
25C> | -----|------------|----------|
26C> | 1994-01-06 | J. Woollen | Original author |
27C> | 1998-07-08 | J. Woollen | Replaced call to Cray library routine ABORT with call to new internal routine bort() |
28C> | 2002-05-14 | J. Woollen | Changed from an entry point to increase portability to other platforms |
29C> | 2003-11-04 | J. Ator | Added documentation |
30C> | 2009-04-21 | J. Ator | Use errwrt() |
31C> | 2021-09-30 | J. Ator | Use Fortran intrinsic adjustl |
32C>
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
42C-----------------------------------------------------------------------
43C-----------------------------------------------------------------------
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
75C EXITS
76C -----
77
78 RETURN
79900 CALL bort('BUFRLIB: JSTNUM - INPUT BLANK CHARACTER STRING NOT '//
80 . 'ALLOWED')
81 END
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
Definition: bort.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:42
subroutine jstnum(STR, SIGN, IRET)
This subroutine left-justifies a character string containing an encoded integer, by removing all lead...
Definition: jstnum.f:34
subroutine strnum(STR, NUM)
This subroutine decodes an integer from a character string.
Definition: strnum.f:24