ncdf_string_m.f90

Go to the documentation of this file.

! Copyright (c) 2012 Joseph A. Levin
!
! Permission is hereby granted, free of charge, to any person obtaining a copy of this
! software and associated documentation files (the "Software"), to deal in the Software
! without restriction, including without limitation the rights to use, copy, modify, merge,
! publish, distribute, sublicense, and/or sell copies of the Software, and to permit 
! persons to whom the Software is furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all copies or 
! substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, 
! INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
! PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE 
! LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT
! OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
! DEALINGS IN THE SOFTWARE.

!     
! File:   string.f95
! Author: josephalevin
!
! Created on March 7, 2012, 7:40 PM
!

module ncdf_string_m

    private

    public :: ncdf_string, ncdf_string_create, ncdf_string_destroy, ncdf_ncdf_string_length, ncdf_string_append, ncdf_ncdf_string_clear 
    public :: ncdf_string_equals, ncdf_string_copy

    integer, parameter :: block_size = 32

    type ncdf_string
        character (len = BLOCK_SIZE) :: chars
        integer :: index = 0
        type(ncdf_string), pointer :: next => null()
    end type ncdf_string

    interface ncdf_string_append
        module procedure ncdf_append_chars, ncdf_append_string
    end interface ncdf_string_append

    interface ncdf_string_copy
        module procedure ncdf_copy_chars
    end interface ncdf_string_copy

    interface ncdf_string_equals
        module procedure ncdf_equals_string
    end interface ncdf_string_equals
    
    interface ncdf_ncdf_string_length
        module procedure ncdf_string_length
    end interface ncdf_ncdf_string_length

contains

    !
    ! FSON STRING CREATE
    !
    function ncdf_string_create(chars) result(new)
        character(len=*), optional :: chars
        type(ncdf_string), pointer :: new

        nullify(new)
        allocate(new)
        
        ! append chars if available
        if(present(chars)) then
            call ncdf_append_chars(new, chars)
        end if

    end function ncdf_string_create
    
    !
    ! FSON STRING CREATE
    !
    recursive subroutine ncdf_string_destroy(this)

      implicit none
      type(ncdf_string), pointer :: this

      if (associated(this)) then

         if(associated(this % next)) then
            call ncdf_string_destroy(this % next)
         end if

         deallocate(this)
         nullify (this)

      end if

    end subroutine ncdf_string_destroy

    !
    ! ALLOCATE BLOCK
    !
    subroutine ncdf_allocate_block(this)

      implicit none
      type(ncdf_string), pointer :: this
      type(ncdf_string), pointer :: new

      if (.not.associated(this % next)) then
         nullify(new)
         allocate(new)
         this % next => new
      end if

    end subroutine ncdf_allocate_block


    !
    ! APPEND_STRING
    !
    subroutine ncdf_append_string(str1, str2)
        type(ncdf_string), pointer :: str1, str2
        integer length, i

        length = ncdf_string_length(str2)

        do i = 1, length
            call ncdf_append_char(str1, ncdf_get_char_at(str2, i))
        end do


    end subroutine ncdf_append_string

    !
    ! APPEND_CHARS
    !
    subroutine ncdf_append_chars(str, c)
        type(ncdf_string), pointer :: str
        character (len = *), intent(in) :: c
        integer length, i

        length = len(c)

        do i = 1, length
            call ncdf_append_char(str, c(i:i))
        end do


    end subroutine ncdf_append_chars

    !
    ! APPEND_CHAR
    !
    recursive subroutine ncdf_append_char(str, c)
        type(ncdf_string), pointer :: str
        character, intent(in) :: c

        if (str % index .GE. block_size) then
            !set down the chain
            call ncdf_allocate_block(str)
            call ncdf_append_char(str % next, c)

        else
            ! set local
            str % index = str % index + 1
            str % chars(str % index:str % index) = c
        end if

    end subroutine ncdf_append_char

    !
    ! COPY CHARS
    !
    subroutine ncdf_copy_chars(this, to)
        type(ncdf_string), pointer :: this
        character(len = *), intent(inout) :: to
        integer :: length
        integer :: i

        length = min(ncdf_string_length(this), len(to))

        do i = 1, length
            to(i:i) = ncdf_get_char_at(this, i)
        end do

        ! pad with nothing
        do i = length + 1, len(to)
            to(i:i) = ""
        end do


    end subroutine ncdf_copy_chars



    !
    ! CLEAR
    !
    recursive subroutine ncdf_string_clear(this)
        type(ncdf_string), pointer :: this

        if (associated(this % next)) then
            call ncdf_string_clear(this % next)
            deallocate(this % next)
            nullify (this % next)
        end if

        this % index = 0

    end subroutine ncdf_string_clear

    !
    ! SIZE    
    !
    recursive integer function ncdf_string_length(str) result(count)
        type(ncdf_string), pointer :: str

        count = str % index

        if (str % index == block_size .AND. associated(str % next)) then
            count = count + ncdf_string_length(str % next)
        end if

    end function ncdf_string_length


    !
    ! GET CHAR AT
    !
    recursive character function ncdf_get_char_at(this, i) result(c)
        type(ncdf_string), pointer :: this
        integer, intent(in) :: i

        if (i .LE. this % index) then
            c = this % chars(i:i)
        else
            c = ncdf_get_char_at(this % next, i - this % index)
        end if

    end function ncdf_get_char_at

    !
    ! EQUALS STRING
    !
    logical function ncdf_equals_string(this, other) result(equals)
        type(ncdf_string), pointer :: this, other
        integer :: i
        equals = .false.
        
        if(ncdf_ncdf_string_length(this) .ne. ncdf_ncdf_string_length(other)) then
            equals = .false.
            return
        else if(ncdf_ncdf_string_length(this) == 0) then
            equals = .true.
            return
        end if
        
        do i=1, ncdf_string_length(this)
            if(ncdf_get_char_at(this, i) .ne. ncdf_get_char_at(other, i)) then
                equals = .false.
                return
            end if
        end do
        
        equals = .true.
        
    end function ncdf_equals_string

end module ncdf_string_m