!
! 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 99117 2017-11-27 18:37:14Z tong.zhu@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