String_Utility.f90

Go to the documentation of this file.

!
! String_Utility
!
! Module containing string utility routines
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 18-Oct-1999
!                       paul.vandelst@ssec.wisc.edu
!

MODULE string_utility

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Disable implicit typing
  IMPLICIT NONE


  ! ----------
  ! Visibility
  ! ----------
  ! Everything private by default
  PRIVATE
  ! Public procedures
  PUBLIC :: strupcase
  PUBLIC :: strlowcase
  PUBLIC :: strcompress
  PUBLIC :: strclean


  ! ---------------------
  ! Procedure overloading
  ! ---------------------
  INTERFACE strclean
    MODULE PROCEDURE strclean_scalar
    MODULE PROCEDURE strclean_rank1
  END INTERFACE strclean


  ! -----------------
  ! Module parameters
  ! -----------------
  CHARACTER(*), PARAMETER :: module_rcs_id = &
    '$Id: String_Utility.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  ! List of character for case conversion
  CHARACTER(*), PARAMETER :: lower_case = 'abcdefghijklmnopqrstuvwxyz'
  CHARACTER(*), PARAMETER :: upper_case = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 


CONTAINS


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       StrUpCase
!
! PURPOSE:
!       Function to convert an input string to upper case.
!
! CALLING SEQUENCE:
!       Result = StrUpCase( String )
!
! INPUT ARGUMENTS:
!       String:  Character string to be converted to upper case.
!                UNITS:      N/A
!                TYPE:       CHARACTER(*)
!                DIMENSION:  Scalar
!                ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Result:  The input character string converted to upper case.
!                UNITS:      N/A
!                TYPE:       CHARACTER(LEN(String))
!                DIMENSION:  Scalar
!
! EXAMPLE:
!       string = 'this is a string'
!       WRITE( *, '( a )' ) StrUpCase( string )
!   THIS IS A STRING
!
! PROCEDURE:
!       Figure 3.5B, pg 80, "Upgrading to Fortran 90", by Cooper Redwine,
!       1995 Springer-Verlag, New York.
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 18-Oct-1999
!                       paul.vandelst@ssec.wisc.edu
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION strupcase( Input_String ) RESULT( Output_String )
    ! Arguments
    CHARACTER(*), INTENT(IN)     :: input_string
    ! Function result
    CHARACTER(LEN(Input_String)) :: output_string
    ! Local variables
    INTEGER :: i, n

    ! Copy input string
    output_string = input_string

    ! Convert case character by character
    DO i = 1, len(output_string)
      n = index(lower_case, output_string(i:i))
      IF ( n /= 0 ) output_string(i:i) = upper_case(n:n)
    END DO
  END FUNCTION strupcase


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       StrLowCase
!
! PURPOSE:
!       Function to convert an input string to lower case.
!
! CALLING SEQUENCE:
!       Result = StrLowCase( String )
!
! INPUT ARGUMENTS:
!       String: Character string to be converted to lower case.
!               UNITS:      N/A
!               TYPE:       CHARACTER(*)
!               DIMENSION:  Scalar
!               ATTRIBUTES: INTENT(IN)
!
! FUNCTION RESULT:
!       Result:  The input character string converted to lower case.
!                UNITS:      N/A
!                TYPE:       CHARACTER( LEN(String) )
!                DIMENSION:  Scalar
!
! EXAMPLE:
!       string = 'THIS IS A STRING'
!       WRITE( *, '( a )' ) StrLowCase( string )
!   this is a string
!
! PROCEDURE:
!       Figure 3.5B, pg 80, "Upgrading to Fortran 90", by Cooper Redwine,
!       1995 Springer-Verlag, New York.
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 18-Oct-1999
!                       paul.vandelst@ssec.wisc.edu
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION strlowcase( Input_String ) RESULT( Output_String )
    ! Argument
    CHARACTER(*), INTENT(IN)     :: input_string
    ! Function result
    CHARACTER(LEN(Input_String)) :: output_string
    ! Local variables
    INTEGER :: i, n

    ! Copy input string
    output_string = input_string

    ! Convert case character by character
    DO i = 1, len(output_string)
      n = index(upper_case, output_string(i:i))
      IF ( n /= 0 ) output_string(i:i) = lower_case(n:n)
    END DO
  END FUNCTION strlowcase


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       StrCompress
!
! PURPOSE:
!       Subroutine to return a copy of an input string with all whitespace
!       (spaces and tabs) removed.
!
! CALLING SEQUENCE:
!       Result = StrCompress( String,  &  ! Input
!                             n = n    )  ! Optional Output
!
! INPUT ARGUMENTS:
!       String:         Character string to be compressed.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(*)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OPTIONAL OUTPUT ARGUMENTS:
!       n:              Number of useful characters in output string
!                       after compression. From character n+1 -> LEN(Input_String)
!                       the output is padded with blanks.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT), OPTIONAL
!
! FUNCTION RESULT:
!       Result:         Input string with all whitespace removed before the
!                       first non-whitespace character, and from in-between 
!                       non-whitespace characters.
!                       UNITS:      N/A
!                       TYPE:       CHARACTER(LEN(String))
!                       DIMENSION:  Scalar
!
! EXAMPLE:
!       Input_String = '  This is a string with spaces in it.'
!       Output_String = StrCompress( Input_String, n=n )
!       WRITE( *, '( a )' ) '>',Output_String( 1:n ),'<'
!   >Thisisastringwithspacesinit.<
!
!       or
!
!       WRITE( *, '( a )' ) '>',TRIM( Output_String ),'<'
!   >Thisisastringwithspacesinit.<
!
! PROCEDURE:
!       Definitions of a space and a tab character are made for the
!       ASCII collating sequence. Each single character of the input
!       string is checked against these definitions using the IACHAR()
!       intrinsic. If the input string character DOES NOT correspond 
!       to a space or tab, it is not copied to the output string.
!
!       Note that for input that ONLY has spaces or tabs BEFORE the first
!       useful character, the output of this function is the same as the
!       ADJUSTL() instrinsic.
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 18-Oct-1999
!                       paul.vandelst@ssec.wisc.edu
!
!:sdoc-:
!------------------------------------------------------------------------------

  FUNCTION strcompress( Input_String, n ) RESULT( Output_String )
    ! Arguments
    CHARACTER(*),      INTENT(IN)  :: input_string
    INTEGER, OPTIONAL, INTENT(OUT) :: n
    ! Function result
    CHARACTER(LEN(Input_String)) :: output_string
    ! Local parameters
    INTEGER, PARAMETER :: iachar_space = 32
    INTEGER, PARAMETER :: iachar_tab   = 9
    ! Local variables
    INTEGER :: i, j
    INTEGER :: iachar_character

    ! Setup
    ! -----
    ! Initialise output string
    output_string = ' '
    ! Initialise output string "useful" length counter
    j = 0

    ! Loop over string contents character by character
    ! ------------------------------------------------
    DO i = 1, len(input_string)

      ! Convert the current character to its position
      ! in the ASCII collating sequence
      iachar_character = iachar(input_string(i:i))

      ! If the character is NOT a space ' ' or a tab '->|'
      ! copy it to the output string.
      IF ( iachar_character /= iachar_space .AND. &
           iachar_character /= iachar_tab         ) THEN
        j = j + 1
        output_string(j:j) = input_string(i:i)
      END IF

    END DO

    ! Save the non-whitespace count
    ! -----------------------------
    IF ( PRESENT(n) ) n = j

  END FUNCTION strcompress



!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       StrClean
!
! PURPOSE:
!       Subroutine to replace terminating NULL characters (ASCII 0, \0 in C)
!       in an input string with whitespace.
!
! CALLING SEQUENCE:
!       CALL StrClean( String )
!
! INPUT ARGUMENTS:
!       String:  On input, this argument contains the character string or
!                string array from which NULL characters are to be
!                removed.
!                UNITS:      N/A
!                TYPE:       CHARACTER(*)
!                DIMENSION:  Scalar or Rank-1
!                ATTRIBUTES: INTENT(IN OUT)
!
! OUTPUT ARGUMENTS:
!       String:  On output, this argument contains the character string or
!                string array from which the NULL characters have been
!                converted to whitespace.
!                UNITS:      N/A
!                TYPE:       CHARACTER(*)
!                DIMENSION:  Scalar or Rank-1
!                ATTRIBUTES: INTENT(IN OUT)
!
! SIDE EFFECTS:
!       The String argument has INTENT(IN OUT) and its contents are modified
!       as required to remove NULL Characters.
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, CIMSS/SSEC 07-Jul-2002
!                       paul.vandelst@ssec.wisc.edu
!
!:sdoc-:
!------------------------------------------------------------------------------

  SUBROUTINE strclean_scalar( String )
    ! Arguments
    CHARACTER(*), INTENT(IN OUT) :: String
    ! Local parameters
    INTEGER, PARAMETER :: IACHAR_NULL = 0
    ! Local variables
    INTEGER :: i
    
    ! Search for null character
    character_loop: DO i = 1, len(string)
      IF ( iachar(string(i:i)) == iachar_null ) THEN
        string(i:len(string) ) = ' '
        EXIT character_loop
      END IF
    END DO character_loop
  END SUBROUTINE strclean_scalar

  SUBROUTINE strclean_rank1( String )
    ! Arguments
    CHARACTER(*), INTENT(IN OUT) :: String(:)
    ! Local variables
    INTEGER :: n
    DO n = 1, SIZE(string)
      CALL strclean_scalar( string(n) )
    END DO
  END SUBROUTINE strclean_rank1

END MODULE string_utility