module HandleStrings 

 use selectrealkind , only : kpr
 use Incapsulated

 implicit none

 integer , parameter, public :: iCharMax=1064 

 private 

 public :: & 
           strip,&
           FunctionStringToReal,&
           FunctionRealToString,&
           FunctionStringToInteger,&
           FunctionIntegerToString,&
           StringToInteger,&
           LowerCase,&
           UpperCase,&
           lower,&
           upper,&
           RemoveBlanksFromString,& 
           ReadInput,&
           isBlank,&
           RemoveDuplicatesFromList
      
 character(len=*),parameter :: lower_alphabet = 'abcdefghijklmnopqrstuvwxyz' !! lowercase characters
 character(len=*),parameter :: upper_alphabet = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' !! uppercase characters

 contains 

  !function Split(string,delimiter) result(outputString)

    !implicit none 
    !character(len=*),intent(in) :: string 
    !character(len=*),intent(in) :: delimiter 
    !character(len=:),dimension(:),allocatable :: outputString 

    !!Local Variables
    !integer :: lengthOfString

    !!Dumb Parser
    !lengthOfString=len(string)
    !iCounter=0
    !do i=1,lengthOfString
       !if(string(i:i).eq.delimiter)then
         !iCounter=iCounter+1
       !endif
    !enddo   

  !end function  

  subroutine ReadInput(filename,strings)
 
    implicit none 
    character(len=*),intent(in) :: filename
    character(len=:),intent(inout),allocatable :: strings(:)

    ! Local Variables
    integer :: iErr,iunit,nRows 
    integer :: i 
    
    call GetRows(filename,nRows)

    allocate(character(len=iCharMax)::strings(nRows))
    open(newunit=iunit,file=filename,action='read',&
         status='unknown',iostat=iErr)
    if(iErr/=0)stop' [ReadInput] I/O Error '
    do i=1,nRows
       read(unit=iunit,fmt=*)strings(i)
    enddo 

  end subroutine ReadInput

  subroutine RemoveDuplicatesFromList(str,Repeated,Unrepeated)

    implicit none 
    character(len=*),intent(in),dimension(:) :: str
    character(len=:),intent(inout),dimension(:),allocatable :: Repeated,Unrepeated

    !Local Variables 
    integer :: i,j,k
    integer :: iAllocated
    integer :: ifound,kfound 
    integer :: nRepeated,nUnrepeated
    integer :: nElements 

    character(len=:),dimension(:),allocatable :: tempRep,tempUnrep

    nElements=size(str)
    allocate(character(len_trim(str(1)))::tempRep(nElements),stat=iAllocated) 
    if(iAllocated/=0)stop' [RemoveDuplicatesFromList] tempRep Alloc Error '
    allocate(character(len_trim(str(1)))::tempUnrep(nElements),stat=iAllocated)
    if(iAllocated/=0)stop' [RemoveDuplicatesFromList] tempUnRep Alloc Error '

    ! Create list of Repeated
    ! and Unrepeated strings
    nUnrepeated=0 
    nRepeated=0
    iLoop: do i=1,nElements
     ifound=0
     jLoop: do j=1,nElements
      if(j.eq.i) cycle jLoop
      if(str(i).eq.str(j))then 
       ifound=1 
       exit jLoop
      endif  
     enddo jLoop
     select case (ifound)
      case (0)
           kLoop:do k=1,nElements
              kfound=0
              if(str(i).eq.tempUnrep(k))then
                 kfound=1
                 exit kLoop
              endif   
           enddo  kLoop
           if(kfound.eq.0)then 
              nUnrepeated=nUnrepeated+1
              tempUnrep(nUnrepeated)=str(i)
           endif   
      case (1) 
           kLoopEncore:do k=1,nElements
              kfound=0
              if(str(i).eq.tempRep(k))then
                 kfound=1
                 exit kLoopEncore
              endif   
           enddo  kLoopEncore
           if(kfound.eq.0)then 
              nRepeated=nRepeated+1
              tempRep(nRepeated)=str(i)
           endif   
     end select 
    enddo iLoop
    
    allocate(character(len_trim(str(1)))::Repeated(nElements),stat=iAllocated) 
    if(iAllocated/=0)stop' [RemoveDuplicatesFromList] Rep Alloc Error '
    if(iAllocated/=0)stop' [RemoveDuplicatesFromList] UnRep Alloc Error '
    Repeated=tempRep(1:nRepeated)
    Unrepeated=tempUnrep(1:nUnrepeated)
    
  end subroutine RemoveDuplicatesFromList   

  subroutine UpperCase(str)
  ! Convert the string to uppercase.
    implicit none
    character(len=*),intent(inout) :: str

    !Local Variables
    integer :: i,idx

    do i=1,len_trim(str)
        idx = index(lower_alphabet,str(i:i))
        if (idx>0) str(i:i) = upper_alphabet(idx:idx)
    end do
  end subroutine UpperCase 

  function upper(string) result(output) 

    implicit none 
    character(len=*),intent(in) :: string
    character(len=:),allocatable :: output 

    !Local Variables 
    character(len=:),allocatable :: temp 


    temp=string
    call UpperCase(temp)
    output=temp

  end function upper  

  function lower(string) result(output) 

    implicit none 
    character(len=*),intent(in) :: string
    character(len=:),allocatable :: output 

    !Local Variables 
    character(len=:),allocatable :: temp 


    if(allocated(output)) deallocate(output)
    temp=string
    call LowerCase(temp)
    output=temp
    deallocate(temp)

  end function lower  

  subroutine LowerCase(str)
   ! Convert the string to lowercase.
   implicit none
   character(len=*),intent(inout) :: str

   ! Local Variables
   integer :: i,idx

    do i=1,len_trim(str)
        idx = index(upper_alphabet,str(i:i))
        if (idx>0) str(i:i) = lower_alphabet(idx:idx)
    end do

  end subroutine LowerCase

  subroutine RemoveBlanksFromString(s)

    implicit none
    character(len=*),intent(inout) :: s
    character :: c
    integer :: iget
    integer :: iput
    character(len=1), parameter :: tab = char ( 9 )

    iput = 0

    do iget = 1, len ( s )
      c = s(iget:iget)
      if ( c /= ' ' .and. c /= TAB ) then
        iput = iput + 1
        s(iput:iput) = c
      end if
    end do
    s(iput+1:) = ' '

  end subroutine RemoveBlanksFromString

  function FunctionStringToReal(string) result(real)

    implicit none 

    character(len=*),intent(in) :: string
    real(kind=kpr) :: real   

    logical :: lDebug 

    lDebug=.false. 

    if(lDebug) write(*,*) ' [FunctionStringToReal] ' , string 

    read(unit=string,fmt=*) real

  end function FunctionStringToReal  

  function isBlank(input) result(output) 

    implicit none 
    character(len=*),intent(in) :: input 
    logical :: output 

    !Local Variables 
    integer :: i,iLength

    output=.true.
    iLength=len(input)
    do i=1,iLength
       if(input(i:i).ne." ")then 
         output=.false.
         exit 
       endif 
    enddo 

  end function isBlank

  function strip(string) result(str)

    ! Remove Blank Spaces from string 

    implicit none 

    character(len=*) :: string 
    character(len=:), allocatable :: str

    call RemoveBlanksFromString(string)
    str=trim(string)

  end function strip

  function FunctionRealToString(real,width,digit) result(str)

    ! Convert real to a string 

    implicit none 

    real(kind=kpr),intent(in) :: real 
    character(len=*),intent(in) :: width
    character(len=*),intent(in) :: digit
    character(len=:),allocatable :: str

    !Local Variables
    integer :: istr

    istr=FunctionStringToInteger(width)
    allocate(character(len=istr)::str)
    write(unit=str,fmt='(f'//width//'.'//digit//')') real 
    call RemoveBlanksFromString(str)
    str=trim(str)

  end function FunctionRealToString

  pure function FunctionIntegerToString(int,idigits) result(str)

    ! Convert integer int to a string 
    ! by prepending the int string 
    ! with "idigits" zeros.

    implicit none 

    integer,intent(in) :: int 
    integer,intent(in) :: idigits
    character(len=idigits) :: str

    character(len=15) :: string 

    write(unit=string,fmt='(i10)') idigits 
    write(unit=str,fmt='(i'//string//'.'//string//')') int 

  end function FunctionIntegerToString

  pure function FunctionStringToInteger(str) result(int)

    implicit none

    character(len=*),intent(in)  :: str
    integer                      :: int

    !Local Variables
    character(len=len(str)) :: tempchar
    character(len=len(str)) :: strformat

    read(unit=str,fmt=*) int

  end function FunctionStringToInteger 

  elemental subroutine StringToInteger(str,int,stat)

    implicit none

    character(len=*),intent(in)  :: str
    integer,intent(out)          :: int
    integer,intent(out),optional :: stat

    if (present(stat).eqv..true.) then
        read(str,*,iostat=stat)  int
    else    
        read(str,*)  int
    endif     

  end subroutine StringToInteger 

end module HandleStrings
