Class gt_mem
In: gt_mem.f90

いわゆるメモリ変数をサポートします (いまのところ１次元だけ)

Methods

Attr_Rewind   Close   Create   MEM_VARIABLE   MEM_VARIABLE_ENTRY   MemAttrDel   MemAttrGet   MemAttrTrue   attr_chain   attr_next   attr_true   del_attr   get_attr   memAttrNext   memAttrRewind   memattradd   memclose   memcreated   memtab   memtab_add   memtab_lookup   put_attr  

Included Modules

dc_types dc_error netcdf_f77 dc_string

Public Instance methods

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

Alias for MemAttrRewind

Close( var )
Subroutine :
var :type(mem_variable), intent(in)

Alias for MemClose

Create( var, url, length, [xtype], [long_name], [overwrite], [err] )
Subroutine :
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

Alias for MemCreateD

MEM_VARIABLE
Derived Type :
id :integer
MEM_VARIABLE_ENTRY
Derived Type :
name :character(TOKEN)
xtype :character(TOKEN)
dbuf(:) :real(DP), pointer
attr :type(attr_chain), pointer
current :type(attr_chain), pointer
MemAttrDel( var, name, [err] )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
err :logical, intent(out), optional

[Source]

  subroutine MemAttrDel(var, name, err)
    use dc_error, only: StoreError
    use netcdf_f77, only: NF_ENOTATT, nf_noerr
    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
      if (.not. associated(p)) exit
      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 MemAttrDel
MemAttrGet( var, name, value, [err] )
Subroutine :
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)
    use dc_error, only: StoreError
    use netcdf_f77, only: nf_enotatt, nf_noerr
    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
        if (.not. associated(p)) exit
        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 MemAttrGet
MemAttrTrue( var, name, [default] ) result(result)
Function :
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)
    use dc_string, only: str_to_logical
    use netcdf_f77, only: nf_noerr
    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
      if (.not. associated(p)) exit
      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 MemAttrTrue
attr_chain
Derived Type :
next :type(attr_chain), pointer
name :character(TOKEN)
cbuf(:) :character, pointer
attr_next( var, name, [err] )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(out)
err :logical, intent(out), optional

Alias for MemAttrNext

attr_true( var, name, [default] ) result(result)
Function :
result :logical
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
default :logical, intent(in), optional

Alias for MemAttrTrue

del_attr( var, name, [err] )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(in)
err :logical, intent(out), optional

Alias for MemAttrDel

get_attr( var, name, value, [err] )
Subroutine :
var :type(mem_variable), intent(in)
name :character(len = *), intent(in)
value :character(len = *), intent(out)
err :logical, intent(out), optional

Alias for MemAttrGet

memAttrNext( var, name, [err] )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
name :character(len = *), intent(out)
err :logical, intent(out), optional

[Source]

  subroutine memAttrNext(var, name, err)
    use netcdf_f77, only: nf_noerr
    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 memAttrNext
memAttrRewind( var )
Subroutine :
var :type(MEM_VARIABLE), intent(in)

[Source]

  subroutine memAttrRewind(var)
    use netcdf_f77, only: nf_noerr
    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 memAttrRewind
memattradd( var, attrname, attrval )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
attrname :character(*), intent(in)
attrval :character(*), intent(in)

[Source]

  subroutine memattradd(var, attrname, attrval)
    use netcdf_f77, only: nf_noerr, nf_enotatt
    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
        if (.not. associated(p)) exit
        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 memattradd
memclose( var )
Subroutine :
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 memclose
memcreated( var, url, length, [xtype], [long_name], [overwrite], [err] )
Subroutine :
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 memcreated
put_attr( var, attrname, attrval )
Subroutine :
var :type(MEM_VARIABLE), intent(in)
attrname :character(*), intent(in)
attrval :character(*), intent(in)

Alias for memattradd

Private Instance methods

memtab
Variable :
memtab(:) :type(mem_variable_entry), allocatable, save, target
memtab_add( var, name ) result(stat)
Function :
stat :integer
var :type(mem_variable), intent(out)
name :character(len = *), intent(in)

[Source]

  integer function memtab_add(var, name) result(stat)
    use dc_error, only: gt_enomem
    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 memtab_add
memtab_lookup( var, ent ) result(stat)
Function :
stat :integer
var :type(mem_variable), intent(in)
ent :type(mem_variable_entry), pointer

[Source]

  integer function memtab_lookup(var, ent) result(stat)
    use netcdf_f77, only: nf_enotvar, nf_noerr
    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 memtab_lookup

[Validate]