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