| Class | gt_mem |
| In: |
gt_mem.f90
|
いわゆるメモリ変数をサポートします (いまのところ1次元だけ)
| 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
| Derived Type : | |
| name : | character(TOKEN) |
| xtype : | character(TOKEN) |
| dbuf(:) : | real(DP), pointer |
| attr : | type(attr_chain), pointer |
| current : | type(attr_chain), pointer |
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(in) |
| err : | logical, intent(out), optional |
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
| Subroutine : | |
| var : | type(mem_variable), intent(in) |
| name : | character(len = *), intent(in) |
| value : | character(len = *), intent(out) |
| err : | logical, intent(out), optional |
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
| Function : | |
| result : | logical |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(in) |
| default : | logical, intent(in), optional |
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
| Derived Type : | |
| next : | type(attr_chain), pointer |
| name : | character(TOKEN) |
| cbuf(:) : | character, pointer |
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(out) |
| err : | logical, intent(out), optional |
Alias for MemAttrNext
| Function : | |
| result : | logical |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(in) |
| default : | logical, intent(in), optional |
Alias for MemAttrTrue
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(in) |
| err : | logical, intent(out), optional |
Alias for MemAttrDel
| 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
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| name : | character(len = *), intent(out) |
| err : | logical, intent(out), optional |
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
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
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
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| attrname : | character(*), intent(in) |
| attrval : | character(*), intent(in) |
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
| Subroutine : | |
| var : | type(mem_variable), intent(in) |
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
| 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 |
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
| Subroutine : | |
| var : | type(MEM_VARIABLE), intent(in) |
| attrname : | character(*), intent(in) |
| attrval : | character(*), intent(in) |
Alias for memattradd
| Function : | |
| stat : | integer |
| var : | type(mem_variable), intent(out) |
| name : | character(len = *), intent(in) |
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
| Function : | |
| stat : | integer |
| var : | type(mem_variable), intent(in) |
| ent : | type(mem_variable_entry), pointer |
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