Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

update strnum to handle valx functionality, and remove valx #406

Merged
merged 2 commits into from
Mar 21, 2023
Merged

update strnum to handle valx functionality, and remove valx #406

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
93c0b55
update strnum to handle valx functionality, and remove valx
jbathegit Mar 21, 2023
de6a8a9
Merge branch 'develop' into jba-strnum
jbathegit Mar 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions src/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,11 +21,11 @@ list(APPEND fortran_src
rdcmps.f rdmemm.f rdmems.f rdmgsb.f rdmsgw.f rdmtbb.f rdmtbd.f rdmtbf.f rdtree.f rdusdx.f readdx.f
readerme.f readlc.f readmg.f readmm.f readns.f reads3.f readsb.f rewnbf.f rsvfvm.f rtrcpt.f
rtrcptb.f seqsdx.f setblock.f setbmiss.f setvalnb.f sntbbe.f sntbde.f sntbfe.f status.f stbfdx.f
stdmsg.f stndrd.f stntbi.f stntbia.f strbtm.f strcln.f strcpt.f string.f strnum.f strsuc.f tabent.f
stdmsg.f stndrd.f stntbi.f stntbia.f strbtm.f strcln.f strcpt.f string.f strnum.F90 strsuc.F90 tabent.f
tabsub.f trybump.f ufbcnt.f ufbcpy.f ufbcup.f ufbdmp.f ufbevn.f ufbget.f ufbin3.f ufbint.f ufbinx.f
ufbmem.f ufbmex.f ufbmms.f ufbmns.f ufbovr.f ufbpos.f ufbqcd.f ufbqcp.f ufbrep.f ufbrms.f ufbrp.f
ufbrw.f ufbseq.f ufbsp.f ufbstp.f ufbtab.f ufbtam.f ufdump.f upb.f upbb.f upc.f upds3.f upftbv.f
ups.f uptdd.f usrtpl.f valx.f wrcmps.f wrdxtb.f writcp.f writdx.f writlc.f writsa.f writsb.f
ups.f uptdd.f usrtpl.f wrcmps.f wrdxtb.f writcp.f writdx.f writlc.f writsa.f writsb.f
wrtree.f wtstat.f arallocf.f ardllocf.f closbf.f ireadmt.f irev.F isetprm.f openbf.f pkvs01.f
wrdlen.F fortran_open.f90 fortran_close.f90 bufr_interface.f90 pkb8.f upb8.f up8.f setim8b.f90
x48.F x84.F)
Expand Down
3 changes: 2 additions & 1 deletion src/bufrlib.h.in
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -476,11 +476,12 @@ void stntbi( f77int *n, f77int *lun, char *numb, char *nemo, char *celsq, size_t
*
* @param str - String.
* @param num - Value decoded from str.
* @param iret - Return code.
* @param s1 - Extra C-Fortran interface argument containing length of str variable.
*
* @author J.Ator @date 2003-11-04
*/
void strnum( char *str, f77int *num, size_t s1 );
void strnum( char *str, f77int *num, f77int *iret, size_t s1 );

void stseq( f77int *lun, f77int *irepct, f77int *idn, char *nemo, char *cseq, f77int *cdesc, f77int *ncdesc );

Expand Down
10 changes: 5 additions & 5 deletions src/gettbh.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,8 @@ SUBROUTINE GETTBH ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
CALL PARSTR ( HEADER, TAGS, 5, NTAG, '|', .FALSE. )
IF ( NTAG .LT. 3 ) GOTO 900
IF ( BADLABEL ( TAGS(1) ) ) GOTO 900
IMT = VALX ( TAGS(2) )
IMTV = VALX ( TAGS(3) )
CALL STRNUM ( TAGS(2), IMT, IERSN )
CALL STRNUM ( TAGS(3), IMTV, IERSN )

C Read and parse the header line of the local file.

Expand All @@ -69,9 +69,9 @@ SUBROUTINE GETTBH ( LUNS, LUNL, TAB, IMT, IMTV, IOGCE, ILTV )
CALL PARSTR ( HEADER, TAGS, 5, NTAG, '|', .FALSE. )
IF ( NTAG .LT. 4 ) GOTO 900
IF ( BADLABEL ( TAGS(1) ) ) GOTO 900
IMT2 = VALX ( TAGS(2) )
IOGCE = VALX ( TAGS(3) )
ILTV = VALX ( TAGS(4) )
CALL STRNUM ( TAGS(2), IMT2, IERSN )
CALL STRNUM ( TAGS(3), IOGCE, IERSN )
CALL STRNUM ( TAGS(4), ILTV, IERSN )

C Verify that both files are for the same master table.

Expand Down
4 changes: 2 additions & 2 deletions src/jstnum.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,8 +48,8 @@ SUBROUTINE JSTNUM(STR,SIGN,IRET)
SIGN = '+'
ENDIF

CALL STRNUM(STR,NUM)
IF(NUM.LT.0) THEN
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 '//
Expand Down
6 changes: 3 additions & 3 deletions src/nemtbb.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -39,9 +39,9 @@ SUBROUTINE NEMTBB(LUN,ITAB,UNIT,ISCL,IREF,IBIT)
IDN = IDNB(ITAB,LUN)
NEMO = TABB(ITAB,LUN)( 7:14)
UNIT = TABB(ITAB,LUN)(71:94)
ISCL = VALX(TABB(ITAB,LUN)( 95: 98))
IREF = VALX(TABB(ITAB,LUN)( 99:109))
IBIT = VALX(TABB(ITAB,LUN)(110:112))
CALL STRNUM(TABB(ITAB,LUN)( 95: 98),ISCL,IERNS)
CALL STRNUM(TABB(ITAB,LUN)( 99:109),IREF,IERNS)
CALL STRNUM(TABB(ITAB,LUN)(110:112),IBIT,IERNS)

C CHECK TABLE B CONTENTS
C ----------------------
Expand Down
4 changes: 2 additions & 2 deletions src/parutg.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -195,8 +195,8 @@ SUBROUTINE PARUTG(LUN,IO,UTG,NOD,KON,VAL)
C ---------------------------------------------------------------------

IF(KON.NE.0) THEN
CALL STRNUM(UTG(ICV:LTG),NUM)
IF(NUM.LT.0) GOTO 903
CALL STRNUM(UTG(ICV:LTG),NUM,IER)
IF(IER.LT.0) GOTO 903
VAL = NUM
ENDIF

Expand Down
2 changes: 1 addition & 1 deletion src/seqsdx.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ SUBROUTINE SEQSDX(CARD,LUN)
C return NUMR = (the number of replications for the mnemonic
C using F=1 "regular" (i.e. non-delayed) replication).

CALL STRNUM(ATAG(J+1:MAXTAG),NUMR)
CALL STRNUM(ATAG(J+1:MAXTAG),NUMR,IER)
IF(I.EQ.1 .AND. NUMR.LE.0 ) GOTO 903
IF(I.EQ.1 .AND. NUMR.GT.255) GOTO 904
IF(I.NE.1 .AND. NUMR.NE.0 ) GOTO 905
Expand Down
4 changes: 2 additions & 2 deletions src/sntbfe.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ SUBROUTINE SNTBFE ( LUNT, IFXYN, LINE )
ENDIF
DO II = 1, NIDVAL
CVAL(II) = ADJUSTL( CVAL(II) )
CALL STRNUM ( CVAL(II), IVAL )
CALL STRNUM ( CVAL(II), IVAL, IER )
IDVAL(II) = IVAL
ENDDO

Expand All @@ -106,7 +106,7 @@ SUBROUTINE SNTBFE ( LUNT, IFXYN, LINE )
ENDIF

TAGS(2) = ADJUSTL( TAGS(2) )
CALL STRNUM ( TAGS(2), IVAL )
CALL STRNUM ( TAGS(2), IVAL, IER )

C Find the last non-blank character in the meaning string.

Expand Down
73 changes: 73 additions & 0 deletions src/strnum.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,73 @@
!> @file
!> @brief Decode an integer from a character string.
!>
!> @author J. Woollen @date 1994-01-06

!> This subroutine decodes an integer from a character string. The
!> string may contain leading or trailing blanks, but otherwise should
!> contain only digits and an (optional) leading sign ('+' or '-')
!> character.
!>
!> If the string contains all blank characters, then num is returned
!> with a value of 0.
!>
!> @param[in] str -- character*(*): String
!> @param[out] num -- integer: Value decoded from str
!> @param[out] iret -- return code:
!> 0 = success
!> -1 = string contained one or more illegal characters
!>
!> @author J. Woollen @date 1994-01-06
recursive subroutine strnum(str,num,iret)
use modv_im8b

implicit none

character*(*), intent(in) :: str

integer, intent(out) :: num, iret

character str2*40, fmt*8

integer lens

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

! Check for I8 integers.

if (im8b) then
im8b = .false.

call strnum ( str, num, iret )
call x48 ( num, num, 1 )
call x48 ( iret, iret, 1 )

im8b = .true.
return
end if

iret = 0

! Check for blank input string.

if ( str .eq. ' ' ) then
edwardhartnett marked this conversation as resolved.
Show resolved Hide resolved
num = 0
return
end if

! Verify that the string contains all legal characters.

call strsuc ( str, str2, lens )
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why strsuc? Can't trim() do this already?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If you look at my new strsuc in this PR (where I've completely rewritten it and migrated it to F90), you'll see that it now does nothing more than call the intrinsic functions adjustl and len_trim ;-)

It's true that, after having done that, I could have just done away with strsuc altogether and just called adjustl and len_trim directly from within strnum.F90. But then I'd have to do likewise in a bunch of different subprograms in the library which also call strsuc, so I decided (again, just IMHO) to do it this way.

if ( verify ( str2(1:lens), "0123456789+-" ) .ne. 0 ) then
iret = -1
return
end if

! Decode the integer from the string.

write ( fmt, '(''(I'',I2,'')'')' ) lens
read ( str2(1:lens), fmt ) num
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If non-numeric characters are in the string, won't this fail? In which case, why try to detect non-numeric characters? Why not just try to read and if there is a failure, report a failure?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

IMHO, the prior verify check was a cleaner and clearer way to confirm that str2(1:lens) contained only valid characters, and in such cases to go ahead and report the failure by setting iret to a value of -1.

That said, I certainly could change this to add an err= option to the read statement and have it reroute control to a new numbered statement to set iret = -1 and return that way, if you and/or Jack think that would be a better way to do it. Again, this was just my personal preference.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

OK, I just saw your #409 (sorry, it's hard keeping track of all of these overlapping conversations and PR's flying around ;-)

So I take it you would indeed prefer that I just modify the new strnum.F90 to add an iostat= check to the read and remove the verify check, and I see where you've already included some very thorough strnum testing in test_misc.F90, so I'll go ahead and remove my less thorough tests from intest7.F90 as well.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We want to reduce code to the smallest amount that can meet current requirements. This is the lowest cost for NOAA over the long term, and the least amount of work for us.

So if using iostat can save us a few lines of code, those are lines NOAA does not have to pay for. Recall that maintenance costs for a line of code are an order of magnitude more than the cost to write the line of code. Code is not free to keep, it's like owning a horse - it costs a lot of money even if you don't use it much.

We must always prefer the solution that meets current requirements with the least lines of code.


return
end subroutine strnum
64 changes: 0 additions & 64 deletions src/strnum.f
View file
Open in desktop

This file was deleted.

30 changes: 30 additions & 0 deletions src/strsuc.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,30 @@
!> @file
!> @brief Remove leading and trailing blanks from a character string.
!>
!> @author J. Woollen @date 1994-01-06

!> This subroutine removes leading and trailing blanks from a
!> character string. The string may not contain any embedded blanks.
!>
!> @param[in] str1 -- character*(*): String
!> @param[out] str2 -- character*(*): Copy of str1 with leading and
!> trailing blanks removed
!> @param[out] lens -- integer: Length of str2
!>
!> @author J. Woollen @date 1994-01-06
subroutine strsuc(str1,str2,lens)
implicit none

character*(*), intent(in) :: str1
character*(*), intent(out) :: str2

integer, intent(out) :: lens

!-----------------------------------------------------------------------
!-----------------------------------------------------------------------

str2 = adjustl(str1)
lens = len_trim(str2)

return
end subroutine strsuc
69 changes: 0 additions & 69 deletions src/strsuc.f
View file
Open in desktop

This file was deleted.

10 changes: 5 additions & 5 deletions src/stseq.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
void stseq( f77int *lun, f77int *irepct, f77int *idn, char *nemo,
char *cseq, f77int *cdesc, f77int *ncdesc )
{
f77int i, j, nb, nd, ipt, ix, iy, iret, nbits;
f77int i, j, nb, nd, ipt, ix, iy, ier, iret, nbits;
f77int i0 = 0, imxcd, rpidn, pkint, ilen;

char tab, adn[7], adn2[7], nemo2[9], units[10], errstr[129];
Expand Down Expand Up @@ -122,8 +122,8 @@ void stseq( f77int *lun, f77int *irepct, f77int *idn, char *nemo,
/*
** cdesc[i] is an operator descriptor.
*/
strnum( &adn[1], &ix, 2 );
strnum( &adn[3], &iy, 3 );
strnum( &adn[1], &ix, &ier, 2 );
strnum( &adn[3], &iy, &ier, 3 );

if ( ( ( ix >= 4 ) && ( ix <= 6 ) ) || ( imrkopr( adn, 6 ) ) ) {
/*
Expand Down Expand Up @@ -258,7 +258,7 @@ void stseq( f77int *lun, f77int *irepct, f77int *idn, char *nemo,
*/
adn[6] = '\0';

strnum( &adn[3], &iy, 3 );
strnum( &adn[3], &iy, &ier, 3 );
/*
** See subroutine BFRINI and COMMON /REPTAB/ for the source of the FXY
** values referenced in the following block. Note we are guaranteed
Expand Down Expand Up @@ -303,7 +303,7 @@ void stseq( f77int *lun, f77int *irepct, f77int *idn, char *nemo,
bort( errstr, ( f77int ) strlen( errstr ) );
}

strnum( &adn[1], &ix, 2 );
strnum( &adn[1], &ix, &ier, 2 );
/*
** Note we are guaranteed that 0 < ix <= 63 since adn was generated
** using subroutine CADN30.
Expand Down
Loading