Class gt_mem
In: src/gt_mem.f90

Methods

Attr_Rewind   Close   Create   attr_next   attr_true   del_attr   get_attr   get_attr   memtab_add   memtab_lookup   put_attr   put_attr  

Included Modules

dc_types dc_error netcdf_f77 dc_string

Public Instance methods

Attr_Rewind(var)
var :type(MEM_VARIABLE), intent(in)

[Source]


    subroutine memAttrRewind(var)

        type(MEM_VARIABLE), intent(in):: var
        type(mem_variable_entry), pointer:: ent

        if (memtab_lookup(var, ent) /= nf_noerr) return
        nullify(ent%current)
    end subroutine
Close(var)
var :type(mem_variable), intent(in)

[Source]


    subroutine memclose(var)
        type(mem_variable), intent(in):: var
        type(mem_variable_entry), pointer:: ent
        if (memtab_lookup(var, ent) /= 0) return
        deallocate(ent%dbuf)
        if (associated(ent%attr)) deallocate(ent%attr)
        if (associated(ent%current)) deallocate(ent%current)
        ent%name = ""
    end subroutine
Create(var, url, length, xtype, long_name, overwrite, err)
var :type(MEM_VARIABLE), intent(out)
url :character(*), intent(in)
length :integer, intent(in)
xtype :character(*), intent(in), optional
long_name :character(*), intent(in), optional
overwrite :logical, intent(in), optional
err :logical, intent(out), optional

[Source]


    subroutine memcreated(var, url, length, xtype, long_name, overwrite, err)

        type(MEM_VARIABLE), intent(out):: var
        character(*), intent(in):: url
        integer, intent(in):: length
        character(*), intent(in), optional:: xtype, long_name
        logical, intent(in), optional:: overwrite
        logical, intent(out), optional:: err
        type(mem_variable_entry), pointer:: ent
        integer:: stat
    continue
        stat = memtab_add(var, url)
        if (stat /= 0) then
            if (present(err)) err = .true.
            return
        endif
        ent => memtab(var%id)
        if (present(xtype)) then
            ent%xtype = xtype
        else
            ent%xtype = "real"
        endif
        allocate(ent%dbuf(length))
        nullify(ent%attr, ent%current)
        if (present(long_name)) call memattradd(var, "long_name", long_name)
        if (present(err)) err = .false.
    end subroutine
attr_next(var, name, err)
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(out)
err :logical, intent(out), optional

[Source]



    subroutine memAttrNext(var, name, err)

        type(MEM_VARIABLE), intent(in):: var
        character(len = *), intent(out):: name
        logical, intent(out), optional:: err
        type(mem_variable_entry), pointer:: ent

        if (memtab_lookup(var, ent) /= nf_noerr) goto 999
        if (.not. associated(ent%current)) then
            ent%current => ent%attr
        else
            ent%current => ent%current%next
        endif
        if (.not. associated(ent%current)) goto 999
        name = ent%current%name
        if (present(err)) err = .false.
        return
        !
    999 continue
        if (present(err)) err = .true.
    end subroutine
attr_true(var, name, default) result(result)
result :logical
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
default :logical, intent(in), optional

[Source]




    logical function MemAttrTrue(var, name, default) result(result)

        type(MEM_VARIABLE), intent(in):: var
        character(len = *), intent(in):: name
        logical, intent(in), optional:: default
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p
        character(10):: s
        integer:: stat, i

        stat = memtab_lookup(var, ent)
        if (stat /= nf_noerr) goto 999
        p => ent%attr
        do, while (associated(p))
            if (p%name == name) then
                if (associated(p%cbuf)) then
                    s = ""
                    do, i = 1, min(len(s), size(p%cbuf))
                        s(i:i) = p%cbuf(i)
                    enddo
                    result = str_to_logical(s)
                else
                    exit
                endif
                return
            endif
            p => p%next
        enddo
    999 continue
        result = .false.
        if (present(default)) result = default
        return
    end function
del_attr(var, name, err)
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
err :logical, intent(out), optional

[Source]



    subroutine MemAttrDel(var, name, err)

        type(MEM_VARIABLE), intent(in):: var
        character(len = *), intent(in):: name
        logical, intent(out), optional:: err
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p, prev
        integer:: stat
        stat = memtab_lookup(var, ent)
        if (stat /= nf_noerr) goto 999
        nullify(prev)
        p => ent%attr
        do, while (associated(p))
            if (p%name == name) then
                if (associated(p%cbuf)) deallocate(p%cbuf)
                prev%next => p%next
                deallocate(p)
                call StoreError(nf_noerr, "MemAttrDel", err)
                return
            endif
            prev => p
            p => p%next
        enddo
        stat = nf_enotatt
    999 continue
        call StoreError(stat, "MemAttrDel", err, cause_c=name)
    end subroutine
get_attr(var, name, value, err)
var :type(mem_variable), intent(in)
name :character(len = *), intent(in)
value :character(len = *), intent(out)
err :logical, intent(out), optional

[Source]



    subroutine MemAttrGet(var, name, value, err)

        type(mem_variable), intent(in):: var
        character(len = *), intent(in):: name
        character(len = *), intent(out):: value
        logical, intent(out), optional:: err
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p
        integer:: i, stat
        stat = memtab_lookup(var, ent)
        if (stat == nf_noerr) then
            if (associated(ent%current)) then
                p => ent%current
                if (p%name == name) goto 100
            endif
            p => ent%attr
            do, while (associated(p))
                if (p%name == name) goto 100
                p => p%next
            enddo
            stat = nf_enotatt
        endif
        call StoreError(stat, "MemAttrGet", err, cause_c=name)
        return

        100 continue
        if (associated(p%cbuf)) then
            do, i = 1, len(value)
                value(i:i) = p%cbuf(i)
            enddo
        else
            value = ""
        endif

    end subroutine
get_attr(var, name, value, err)
var :type(mem_variable), intent(in)
name :character(len = *), intent(in)
value :type(vstring), intent(out)
err :logical, intent(out), optional

[Source]



    subroutine MemAttrGetV(var, name, value, err)

        type(mem_variable), intent(in):: var
        character(len = *), intent(in):: name
        type(vstring), intent(out):: value
        logical, intent(out), optional:: err
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p
        integer:: i, stat
        stat = memtab_lookup(var, ent)
        if (stat == nf_noerr) then
            if (associated(ent%current)) then
                if (ent%current%name == name) then
                    p => ent%current
                    goto 100
                endif
            endif
            p => ent%attr
            do, while (associated(p))
                if (p%name == name) goto 100
                p => p%next
            enddo
            stat = nf_enotatt
        endif
        call StoreError(stat, "MemAttrGet", err, cause_c=name)
        return

        100 continue
        if (associated(p%cbuf)) then
            do, i = 1, len(value)
                value = p%cbuf(:)
            enddo
        else
            value = ""
        endif
        call StoreError(nf_noerr, "MemAttrGet", err)
        return

    end subroutine
memtab_lookup(var, ent) result(stat)
stat :integer
var :type(mem_variable), intent(in)
ent :type(mem_variable_entry), pointer

[Source]




    integer function memtab_lookup(var, ent) result(stat)

        type(mem_variable), intent(in):: var
        type(mem_variable_entry), pointer:: ent
        if (.not. allocated(memtab)) goto 999
        if (var%id <= 0 .or. var%id > size(memtab)) goto 999
        if (memtab(var%id)%name == "") goto 999
        ent => memtab(var%id)
        stat = 0
    999 continue
        nullify(ent)
        stat = nf_enotvar
    end function
put_attr(var, attrname, attrval)
var :type(MEM_VARIABLE), intent(in)
attrname :character(*), intent(in)
attrval :character(*), intent(in)

[Source]



    subroutine memattradd(var, attrname, attrval)

        type(MEM_VARIABLE), intent(in):: var
        character(*), intent(in):: attrname
        character(*), intent(in):: attrval
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p
        integer:: i, stat

        stat = memtab_lookup(var, ent)
        if (stat == nf_noerr) then
            if (associated(ent%current)) then
                if (ent%current%name == attrname) then
                    p => ent%current
                    goto 100
                endif
            endif
            p => ent%attr
            do, while (associated(p))
                if (p%name == attrname) goto 100
                p => p%next
            enddo
            stat = nf_enotatt
        endif
        allocate(p)
        nullify(p%next)
        goto 120

        100 continue
        if (associated(p%cbuf)) then
            deallocate(p%cbuf)
        endif

        120 continue
        allocate(p%cbuf(len(attrval)))
        do, i = 1, len(attrval)
            p%cbuf(i) = attrval(i:i)
        enddo
        return
    end subroutine
put_attr(var, attrname, attrval)
var :type(MEM_VARIABLE), intent(in)
attrname :character(*), intent(in)
attrval :type(vstring), intent(in)

[Source]



    subroutine memattradd_v(var, attrname, attrval)

        type(MEM_VARIABLE), intent(in):: var
        character(*), intent(in):: attrname
        type(vstring), intent(in):: attrval
        type(mem_variable_entry), pointer:: ent
        type(attr_chain), pointer:: p
        integer:: stat

        stat = memtab_lookup(var, ent)
        if (stat == nf_noerr) then
            if (associated(ent%current)) then
                if (ent%current%name == attrname) then
                    p => ent%current
                    goto 100
                endif
            endif
            p => ent%attr
            do, while (associated(p))
                if (p%name == attrname) goto 100
                p => p%next
            enddo
            stat = nf_enotatt
        endif
        allocate(p)
        nullify(p%next)
        goto 120

        100 continue
        if (associated(p%cbuf)) then
            deallocate(p%cbuf)
        endif

        120 continue
        allocate(p%cbuf(len(attrval)))
        p%cbuf(:) = attrval
        return
    end subroutine

Protected Instance methods

memtab_add(var, name) result(stat)
stat :integer
var :type(mem_variable), intent(out)
name :character(len = *), intent(in)

[Source]


    integer function memtab_add(var, name) result(stat)

        type(mem_variable), intent(out):: var
        character(len = *), intent(in):: name
        type(mem_variable_entry), allocatable:: tmptab(:)
        integer:: i, n

        if (.not. allocated(memtab)) then
            allocate(memtab(16), stat=stat)
            if (stat /= 0) then
                stat = gt_enomem
                return
            endif
            do, i = 1, size(memtab)
                memtab(i)%name = ""
                memtab(i)%xtype = ""
                nullify(memtab(i)%dbuf)
                nullify(memtab(i)%attr, memtab(i)%current)
            enddo
        endif
        do, i = 1, size(memtab)
            if (memtab(i)%name == "") then
                stat = 0
                var = mem_variable(i)
                memtab(i)%name = name
                return
            endif
        end do

        n = size(memtab)
        allocate(tmptab(n), stat=stat)
        if (stat /= 0) then
            stat = gt_enomem
            return
        endif
        tmptab(:) = memtab(:)
        deallocate(memtab)
        allocate(memtab(n * 2), stat=stat)
        if (stat /= 0) then
            stat = gt_enomem
            return
        endif
        memtab(1:n) = tmptab(1:n)
        deallocate(tmptab)
        do, i = n + 1, n * 2
            memtab(i)%name = ""
            nullify(memtab(i)%dbuf)
            nullify(memtab(i)%attr, memtab(i)%current)
        enddo

        i = n + 1
        var = mem_variable(i)
        memtab(i)%name = name
    end function

[Validate]