igetfxy.f

Go to the documentation of this file.

C> @file
C> @author ATOR @date 2007-01-19
    
C> THIS FUNCTION LOOKS FOR AND RETURNS A VALID FXY NUMBER
C>   FROM WITHIN THE GIVEN INPUT STRING.  THE FXY NUMBER MAY BE IN
C>   FORMAT OF EITHER FXXYYY OR F-XX-YYY WITHIN THE INPUT STRING, BUT
C>   IT IS ALWAYS RETURNED IN FORMAT FXXYYY UPON OUTPUT.
C>
C> PROGRAM HISTORY LOG:
C> 2007-01-19  J. ATOR    -- ORIGINAL AUTHOR
C> - 2021-09-30  J. Ator    -- Replace jstchr with Fortran intrinsic
C>                             adjustl
C>
C> USAGE:    IGETFXY ( STR, CFXY )
C>   INPUT ARGUMENT LIST:
C>     STR      - CHARACTER*(*): INPUT STRING
C>
C>   OUTPUT ARGUMENT LIST:
C>     CFXY     - CHARACTER*6: FXY NUMBER IN FORMAT FXXYYY
C>     IGETFXY  - INTEGER: RETURN CODE:
C>                       0 = normal return
C>                      -1 = could not find a valid FXY number in STR
C>
C> REMARKS:
C>    THIS ROUTINE CALLS:        NUMBCK
C>    THIS ROUTINE IS CALLED BY: GETNTBE  SNTBDE   SNTBFE
C>                               Normally not called by any application
C>                               programs.
C>
    FUNCTION igetfxy ( STR, CFXY )
 
 
 
    character*(*)   str
    character*6 cfxy
 
    parameter( lstr2 = 120 )
    CHARACTER*(LSTR2)  str2
 
C-----------------------------------------------------------------------
C-----------------------------------------------------------------------
 
    igetfxy = -1
 
    lstr = len( str )
    IF ( lstr .LT. 6 ) RETURN
 
C   Left-justify a copy of the input string.
 
    IF ( lstr .GT. lstr2 ) THEN
        str2(1:lstr2) = str(1:lstr2)
    ELSE
        str2 = str
    ENDIF
    str2 = adjustl( str2 )
    IF ( str2 .EQ. ' ' ) RETURN
 
C   Look for an FXY number.
 
    IF ( index( str2, '-' ) .NE. 0 ) THEN
C       Format of field is F-XX-YYY.
        cfxy(1:1) = str2(1:1)
        cfxy(2:3) = str2(3:4)
        cfxy(4:6) = str2(6:8)
    ELSE
C       Format of field is FXXYYY.
        cfxy = str2(1:6)
    ENDIF
 
C   Check that the FXY number is valid.
 
    IF ( numbck( cfxy ) .EQ. 0 ) igetfxy = 0
 
    RETURN
    END