MODULE NFSTR
!
!   NAME:       NFSTR                                      
!   STATUS:     Ver. 1.0                                              
!   PURPOSE:    character utility routines              
!   LIBRARY:    MATH                                                  
!   TYPE:       SINGLE, DOUBLE PRECISION                              
!   AUTHOR:     Shigeru Inagaki                                       
!               National Institute for Fusion Science                 
!               +81-572-58-2143                                       
!               inagaki@LHD.nifs.ac.jp                                
!                                                                     
!   DESCRIPTION:                                                      
!     Character operaters are packaged.  
!                                                                     
!   SEE ALSO:                                           
!   CALLED:                                                            
!   REVISION HISTORY:                                                 
!     01-JUL-2004 (CREATION)                                          
!   COMMENTS:                                                         
!              
  USE NFNUM_KINDS, ONLY : i4b, sp, dp, lgt
!
  IMPLICIT NONE
!
  PRIVATE
!
  INTEGER(i4b), PARAMETER :: strsplit_length = 64
!
  INTERFACE TOSTR
    MODULE PROCEDURE INTTOSTR, FLTTOSTR, DBLTOSTR
  END INTERFACE
!
  PUBLIC :: strsplit_length
  PUBLIC :: ADDNULL
  PUBLIC :: TOINT, TOFLT, TODBL, TOSTR
  PUBLIC :: TOLOWER, TOUPPER, DELCHAR, STRCOUNT, STRSPLIT, STRSPLIT_TO_VEC, STRREPLACE
  PUBLIC :: ISDIGIT, ISREAL
!
CONTAINS
!
!-------------------------------------------------------
!
FUNCTION ADDNULL(fstr) RESULT(cstr)
! 
! Add NULL-character for C-wrapper routines
! 
  CHARACTER(LEN=*), INTENT(IN) :: fstr
  CHARACTER(LEN=LEN_TRIM(fstr)+1) :: cstr
!
  cstr = TRIM(fstr)//CHAR(0)
  RETURN
END FUNCTION ADDNULL 
!
!-------------------------------------------------------
!
FUNCTION TOLOWER(str)
!
! Translate all uppercase characters in STR to their equivalent
! lowercase counterpart. Non-alphabetic characters are not
! altered.
!
  CHARACTER(LEN=*), INTENT(IN) :: str
  CHARACTER(LEN=LEN_TRIM(str)) :: TOLOWER
!
  INTEGER(i4b) :: i, ilen, idx
!
  ilen = LEN_TRIM(str)
  DO i = 1, ilen
    idx = ICHAR(str(i:i))
    IF (65 <= idx .AND. idx <= 90) THEN
      TOLOWER(i:i) = CHAR(idx+32)
    ELSE
      TOLOWER(i:i) = str(i:i)
    ENDIF
  ENDDO
  RETURN
END FUNCTION TOLOWER
!
!-------------------------------------------------------
!
FUNCTION TOUPPER(str)
!
! Translate all lowercase characters in STR to their equivalent
! uppercase counterpart. Non-alphabetic characters are not
! altered.
!
  CHARACTER(LEN=*), INTENT(IN) :: str
  CHARACTER(LEN=LEN_TRIM(str)) :: TOUPPER
!
  INTEGER(i4b) :: i, ilen, idx
!
 ilen = LEN_TRIM(str)
 DO i = 1, ilen
   idx = ICHAR(str(i:i))
   IF (97 <= idx .AND. idx <= 122) THEN
     TOUPPER(i:i) = CHAR(idx-32)
   ELSE
     TOUPPER(i:i) = str(i:i)
   ENDIF
  ENDDO
  RETURN
END FUNCTION TOUPPER
!
!-------------------------------------------------------
!
SUBROUTINE DELCHAR(str, char)
  CHARACTER(LEN=*), INTENT(INOUT) :: str
  CHARACTER(LEN=1), INTENT(IN)    :: char  
!
  CHARACTER(LEN=LEN_TRIM(str)) :: buf
  INTEGER(i4b) :: ilen, i, j
!
  ilen = LEN_TRIM(str)
  j = 0
  DO i = 1, ilen
    IF (str(i:i) /= char) THEN
      j = j + 1
      buf(j:j) = str(i:i)
    ENDIF
  ENDDO
  str = buf(1:j)
  RETURN
END SUBROUTINE DELCHAR  
!
!-------------------------------------------------------
!
SUBROUTINE STRSPLIT_TO_VEC(str, vec, delim)
!
  CHARACTER(LEN=*), INTENT(IN)  :: str
  CHARACTER(LEN=*), INTENT(OUT) :: vec(:)
  CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: delim
!
  CHARACTER(LEN=1) :: ch
  INTEGER(i4b) :: n, ilen, i, is, ie
!
  IF (PRESENT(delim)) THEN
    ch = delim
  ELSE
    ch = ','
  ENDIF
  n = SIZE(vec)
  IF (n == 0) THEN
    RETURN
  ENDIF
!
  is = 1
  ilen = LEN_TRIM(str)
  IF (n == 1) THEN
    vec(n) = str(is:ilen)
    RETURN
  ENDIF
  DO i = 1, n-1
    ie = INDEX(str(is:ilen), ch) - 1 + is - 1
    IF (ie >= is) THEN
      vec(i) = str(is:ie)
    ELSE
      vec(i) = ''
    ENDIF
    is = ie + 2
  ENDDO
  vec(n) = str(is:ilen)
  RETURN
END SUBROUTINE STRSPLIT_TO_VEC
!
!-------------------------------------------------------
!
FUNCTION STRSPLIT(str, delim) RESULT(vec)
!
  CHARACTER(LEN=*), INTENT(IN) :: str
  CHARACTER(LEN=1), OPTIONAL, INTENT(IN) :: delim
  CHARACTER(LEN=strsplit_length), POINTER :: vec(:)
!
  CHARACTER(LEN=1) :: ch
  INTEGER(i4b) :: istat, n, ilen, i, is, ie
!
  IF (PRESENT(delim)) THEN
    ch = delim
  ELSE
    ch = ','
  ENDIF
  n = STRCOUNT(str, ch) + 1
  ALLOCATE(vec(n), STAT=istat)
  IF (istat /= 0) THEN
    RETURN
  ENDIF
!
  is = 1
  ilen = LEN_TRIM(str)
  IF (n == 1) THEN
    vec(n) = str(is:ilen)
    RETURN
  ENDIF
  DO i = 1, n-1
    ie = INDEX(str(is:ilen), ch) - 1 + is - 1
    IF (ie >= is) THEN
      vec(i) = str(is:ie)
    ELSE
      vec(i) = ''
    ENDIF
    is = ie + 2
  ENDDO
  vec(n) = str(is:ilen)
  RETURN
END FUNCTION STRSPLIT
!
!-------------------------------------------------------
!
FUNCTION STRCOUNT(string, char)
!
! Return numbers of appearance of char in string
!
  CHARACTER(LEN=*), INTENT(IN) :: string
  CHARACTER(LEN=1), INTENT(IN) :: char
  INTEGER(i4b) :: STRCOUNT
!
  INTEGER(i4b) :: i, ilen
!
  STRCOUNT = 0
  ilen = LEN_TRIM(string)
  IF (ilen == 0) THEN
    RETURN
  ENDIF
  DO i = 1, ilen
    IF (string(i:i) == char) THEN
      STRCOUNT = STRCOUNT + 1
    ENDIF
  ENDDO
  RETURN
END FUNCTION STRCOUNT
!
!-------------------------------------------------------
!
FUNCTION STRREPLACE(string, target, change) RESULT(ierr)
!
! Replace target in string to change.
! If target is not changed, 1 is returned. 
!  
  CHARACTER(LEN=*), INTENT(INOUT) :: string
  CHARACTER(LEN=*), INTENT(IN)    :: target
  CHARACTER(LEN=*), INTENT(IN)    :: change
  INTEGER(i4b) :: ierr
!
  INTEGER(i4b) :: ipos
  INTEGER(i4b) :: ilen_string, ilen_target, ilen_change
!
  ilen_string = LEN_TRIM(string)
  ilen_target = LEN_TRIM(target)
  ilen_change = LEN_TRIM(change)
  IF (ilen_string*ilen_target*ilen_change == 0) THEN
    ierr = 1
    RETURN
  ENDIF
  ipos = INDEX(string, TRIM(target))
  IF (ipos == 0) THEN
    ierr = 1
    RETURN
  ENDIF
  string = string(1:ipos-1)//TRIM(change)//TRIM(string(ipos+ilen_target:)) 
  IF (ilen_string + ilen_target + ilen_change > LEN(string)) THEN
    ierr = 2
  ELSE
    ierr = 0
  ENDIF
  RETURN
END FUNCTION STRREPLACE  
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION TOINT(str) RESULT(num)
  CHARACTER(LEN=*), INTENT(IN) :: str
  INTEGER(i4b) :: num
!
  READ(str,*) num
  RETURN
END FUNCTION TOINT
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION TOFLT(str) RESULT(num)
  CHARACTER(LEN=*), INTENT(IN) :: str
  REAL(sp) :: num
!
  READ(str,*) num
  RETURN
END FUNCTION TOFLT
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION TODBL(str) RESULT(num)
  CHARACTER(LEN=*), INTENT(IN) :: str
  REAL(dp) :: num
!
  READ(str,*) num
  RETURN
END FUNCTION TODBL
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION INTTOSTR(num, fmt) RESULT(str)
  INTEGER(i4b),               INTENT(IN) :: num
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
  CHARACTER(LEN=11) :: str
!
  IF (PRESENT(fmt)) THEN
    WRITE(str, TRIM(fmt)) num
  ELSE
    WRITE(str,*) num
  ENDIF
  str = ADJUSTL(str)
  RETURN
END FUNCTION INTTOSTR
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION FLTTOSTR(num, fmt) RESULT(str)
  REAL(sp),                   INTENT(IN) :: num
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
  CHARACTER(LEN=13) :: str
!
  IF (PRESENT(fmt)) THEN
    WRITE(str, TRIM(fmt)) num
  ELSE
    WRITE(str,*) num
  ENDIF
  str = ADJUSTL(str)
  RETURN
END FUNCTION FLTTOSTR
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION DBLTOSTR(num, fmt) RESULT(str)
  REAL(dp),                   INTENT(IN) :: num
  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fmt
  CHARACTER(LEN=22) :: str
!
  IF (PRESENT(fmt)) THEN
    WRITE(str, fmt) num
  ELSE
    WRITE(str,*) num
  ENDIF
  str = ADJUSTL(str)
  RETURN
END FUNCTION DBLTOSTR
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION ISDIGIT(str) RESULT(stat)
  CHARACTER(LEN=*), INTENT(IN) :: str
  LOGICAL(lgt) :: stat
!
  IF (LEN_TRIM(str) == 0) THEN
    stat = .FALSE.
    RETURN
  ENDIF
  IF (VERIFY(str, "+-0123456789") /= 0) THEN
   stat = .FALSE.
  ELSE
   stat = .TRUE.
  ENDIF
  RETURN
END FUNCTION ISDIGIT  
!
!-------------------------------------------------------
!
ELEMENTAL FUNCTION ISREAL(str) RESULT(stat)
  CHARACTER(LEN=*), INTENT(IN) :: str
  LOGICAL(lgt) :: stat
!
  IF (LEN_TRIM(str) == 0) THEN
    stat = .FALSE.
    RETURN
  ENDIF
  IF (VERIFY(str, "+-0123456789.EDed") /= 0) THEN
   stat = .FALSE.
  ELSE
   stat = .TRUE.
  ENDIF
  RETURN
END FUNCTION ISREAL
!
END MODULE NFSTR