json.f90

Go to the documentation of this file.

!    Copyright (c) 2016  Forschungszentrum Juelich GmbH
!                        Markus Brenneis, Vladislav Kotov 
!
!    This file is part of EIRAM.
!
!    EIRAM is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    EIRAM is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with EIRAM.  If not, see <http://www.gnu.org/licenses/>.
!

    module json
    
    implicit none

    public :: eiram_json_getarrayasjson,eiram_json_jsonescape,eiram_json_writejsonstringproperty

    contains

    function eiram_json_getarrayasjson(arr, length, itol)

        real(8), dimension(:), intent(in) :: arr
        integer, intent(out) :: length
        integer,intent(in) :: itol
        character(size(arr)*(itol+9)+2) :: eiram_json_getArrayAsJson
        integer :: c, i, lfld
        character(16) :: frm

        eiram_json_getarrayasjson = " "
        eiram_json_getarrayasjson(1:1) = "["
        c = 2
        lfld=itol+8
        write(frm,'(A3,i2.2,A1,i2.2,A3)') '(Es',lfld,'.',itol,'E3)'
        do i = 1, size(arr)
            if(i > 1) then
                eiram_json_getarrayasjson(c:c) = ","
                c = c+1
            end if
            if(abs(arr(i)) < huge(1d0)) then
                write(eiram_json_getarrayasjson(c:c+lfld),frm) arr(i)
            else
                write(eiram_json_getarrayasjson(c:c+lfld), '(A)') "null"
            end if
            c = c+lfld
        end do
        eiram_json_getarrayasjson(c:c) = "]"
        length = len_trim(eiram_json_getarrayasjson)
    end function eiram_json_getarrayasjson
    
    function eiram_json_jsonescape(str, length)

        character(*), intent(in) :: str
        integer, intent(out) :: length
        character(len_trim(str)*2) ::  eiram_json_jsonEscape
        integer :: s
        length = 1
        foreachchar: do s = 1, len_trim(str)
            if(str(s:s) == '"') then
                 eiram_json_jsonescape(length:length+1) = '\' 
                length = length + 2
            else if(str(s:s) == ') then
                eiram_json_jsonescape(length:length+1) = '\\'
                length = length + 2
            else
                 eiram_json_jsonescape(length:length) = str(s:s)
                length = length + 1
            end if
        end do foreachchar
         eiram_json_jsonescape(length:) = " "
        length = length - 1
    end function eiram_json_jsonescape
    
    subroutine eiram_json_writejsonstringproperty(name, value, jsonString, ind)

        character(*), intent(in) :: name
        character(*), intent(in) :: value
        character(*), intent(inout) :: jsonString
        integer, intent(inout) :: ind
        integer :: length
        intrinsic trim,len_trim,max
        jsonstring(ind:) = ',"'//trim(eiram_json_jsonescape(trim(name), length))//'":"'
        ind = ind+length+5
        jsonstring(ind:) = trim(eiram_json_jsonescape(trim(value), length))
        ind = ind+length
        jsonstring(ind:ind) = '"'
        ind = ind+1
    end subroutine eiram_json_writejsonstringproperty

    end module json