ncdf_value_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:   value_m.f95
! Author: josephalevin
!
! Created on March 7, 2012, 10:14 PM
!

module ncdf_value_m

    use ncdf_string_m

    implicit none

    private

    public :: ncdf_value, ncdf_value_create, &
        ncdf_value_destroy, ncdf_value_add, &
        ncdf_value_get, ncdf_value_count, &
        ncdf_value_print

    !constants for the value types
    integer, public, parameter :: type_unknown = -1
    integer, public, parameter :: type_null = 0
    integer, public, parameter :: type_object = 1
    integer, public, parameter :: type_array = 2
    integer, public, parameter :: type_string = 3
    integer, public, parameter :: type_integer = 4
    integer, public, parameter :: type_real = 5
    integer, public, parameter :: type_logical = 6


    !
    ! FSON VALUE
    !
    type ncdf_value
        type(ncdf_string), pointer :: name => null()
        integer :: value_type = type_unknown
        logical :: value_logical
        integer :: value_integer
        real :: value_real
        double precision :: value_double
        integer, private :: count = 0
        type(ncdf_string), pointer :: value_string => null()
        type(ncdf_value), pointer :: next => null()
        type(ncdf_value), pointer :: parent => null()
        type(ncdf_value), pointer :: children => null()
        type(ncdf_value), pointer :: tail => null()
    end type ncdf_value

    !
    ! FSON VALUE GET
    !
    ! Use either a 1 based index or member name to get the value.
    interface ncdf_value_get
        module procedure ncdf_get_by_index
        module procedure ncdf_get_by_name_chars
        module procedure ncdf_get_by_name_string
    end interface ncdf_value_get

contains

    !
    ! FSON VALUE CREATE
    !
    function ncdf_value_create() result(new)
        type(ncdf_value), pointer :: new

        nullify(new)
        allocate(new)

    end function ncdf_value_create

    !
    ! FSON VALUE DESTROY
    !
    recursive subroutine ncdf_value_destroy(this, destroy_next)

      implicit none
      type(ncdf_value), pointer :: this
      logical, intent(in), optional :: destroy_next

      type(ncdf_value), pointer :: p
      integer :: count
      logical :: donext

      if (present(destroy_next)) then
         donext = destroy_next
      else
         donext = .true.
      end if

      if (associated(this)) then

         if(associated(this % name)) then
            call ncdf_string_destroy(this % name)
            nullify (this % name)
         end if

         if(associated(this % value_string)) then
            call ncdf_string_destroy(this % value_string)
            nullify (this % value_string)
         end if

         if(associated(this % children)) then
            do while (this % count > 0)
               p => this % children
               this % children => this % children % next
               this % count = this % count - 1
               call ncdf_value_destroy(p, .false.)
            end do
            nullify(this % children)
         end if

         if ((associated(this % next)) .and. (donext)) then
            call ncdf_value_destroy(this % next)
            nullify (this % next)
         end if

         if(associated(this % tail)) then
            nullify (this % tail)
         end if

         deallocate(this)
         nullify(this)

      end if

    end subroutine ncdf_value_destroy

    !
    ! FSON VALUE ADD
    !
    ! Adds the member to the linked list

    subroutine ncdf_value_add(this, member)

      implicit none
      type(ncdf_value), pointer :: this, member

      ! associate the parent
      member % parent => this

      ! add to linked list
      if (associated(this % children)) then
         this % tail % next => member
      else
         this % children => member
      end if

      this % tail => member
      this % count = this % count + 1

    end subroutine ncdf_value_add

    !
    ! FSON_VALUE_COUNT
    !
    integer function ncdf_value_count(this) result(count)
        type(ncdf_value), pointer :: this, p

        count = this % count

    end function

    !
    ! GET BY INDEX
    !
    function ncdf_get_by_index(this, index) result(p)
        type(ncdf_value), pointer :: this, p
        integer, intent(in) :: index
        integer :: i

        p => this % children

        do i = 1, index - 1
            p => p % next
        end do

    end function ncdf_get_by_index

    !
    ! GET BY NAME CHARS
    !
    function ncdf_get_by_name_chars(this, name) result(p)
        type(ncdf_value), pointer :: this, p
        character(len=*), intent(in) :: name
        
        type(ncdf_string), pointer :: string
        
        ! convert the char array into a string
        string => ncdf_string_create(name)
        
        p => ncdf_get_by_name_string(this, string)

        call ncdf_string_destroy(string)
        
    end function ncdf_get_by_name_chars
    
    !
    ! GET BY NAME STRING
    !
    function ncdf_get_by_name_string(this, name) result(p)
        type(ncdf_value), pointer :: this, p
        type(ncdf_string), pointer :: name
        integer :: i                
        
        if(this % value_type .ne. type_object) then
            nullify(p)
            return 
        end if
        
        do i=1, ncdf_value_count(this)
            p => ncdf_value_get(this, i)
            if (ncdf_string_equals(p%name, name)) then                
                return
            end if
        end do
        
        ! didn't find anything
        nullify(p)
        
        
    end function ncdf_get_by_name_string
    
    !
    ! FSON VALUE PRINT
    !
    recursive subroutine ncdf_value_print(this, indent)
        type(ncdf_value), pointer :: this, element
        integer, optional, intent(in) :: indent
        character (len = 1024) :: tmp_chars
        integer :: tab, i, count, spaces
                
        if (present(indent)) then
            tab = indent
        else
            tab = 0
        end if
        
        spaces = tab * 2

        select case (this % value_type)
        case(type_object)
            print *, repeat(" ", spaces), "{"
            count = ncdf_value_count(this)
            do i = 1, count
                ! get the element
                element => ncdf_value_get(this, i)
                ! get the name
                call ncdf_string_copy(element % name, tmp_chars)
                ! print the name
                print *, repeat(" ", spaces), '"', trim(tmp_chars), '":'
                ! recursive print of the element
                call ncdf_value_print(element, tab + 1)
                ! print the separator if required
                if (i < count) then
                    print *, repeat(" ", spaces), ","
                end if
            end do

            print *, repeat(" ", spaces), "}"
        case (type_array)
            print *, repeat(" ", spaces), "["
            count = ncdf_value_count(this)
            do i = 1, count
                ! get the element
                element => ncdf_value_get(this, i)
                ! recursive print of the element
                call ncdf_value_print(element, tab + 1)
                ! print the separator if required
                if (i < count) then
                    print *, ","
                end if
            end do
            print *, repeat(" ", spaces), "]"
        case (type_null)
            print *, repeat(" ", spaces), "null"
        case (type_string)
            call ncdf_string_copy(this % value_string, tmp_chars)
            print *, repeat(" ", spaces), '"', trim(tmp_chars), '"'
        case (type_logical)
            if (this % value_logical) then
                print *, repeat(" ", spaces), "true"
            else
                print *, repeat(" ", spaces), "false"
            end if
        case (type_integer)
            print *, repeat(" ", spaces), this % value_integer
        case (type_real)
            print *, repeat(" ", spaces), this % value_double
        end select
    end subroutine ncdf_value_print
       

end module ncdf_value_m