| Class | an_vartable |
| In: |
an_vartable.f90
|
| Derived Type : | |||
| fileid : | integer | ||
| varid : | integer | ||
| dimid : | integer
| ||
| dimids(:) : | integer, pointer
| ||
| attrid : | integer |
ID 情報
変数 (an_variable 実体) は (/fileid, varid, dimid/) で
同定される。正当な変数の fileid は必ず正である。
Original external subprogram is an_types#AN_VARIABLE_ENTRY
| Derived Type : | |||
| fileid : | integer | ||
| varid : | integer | ||
| dimid : | integer
| ||
| dimids(:) : | integer, pointer
| ||
| attrid : | integer |
ID 情報
変数 (an_variable 実体) は (/fileid, varid, dimid/) で
同定される。正当な変数の fileid は必ず正である。
Original external subprogram is an_types#AN_VARIABLE_ENTRY
| Function : | |
| result : | integer |
| var : | type(an_variable), intent(out) |
| entry : | type(an_variable_search), intent(in) |
integer function vtable_add(var, entry) result(result)
type(an_variable), intent(out):: var
type(an_variable_search), intent(in):: entry
type(an_variable_entry), allocatable:: tmp_table(:)
integer:: i, n
! --- 必要なら初期確保 ---
if (.not. allocated(antab)) then
allocate(antab(antab_init_size), stat=result)
if (result /= 0) goto 999
do, i = 1, antab_init_size
antab(i)%fileid = 0
antab(i)%varid = 0
antab(i)%dimid = 0
antab(i)%attrid = 0
nullify(antab(i)%dimids)
enddo
endif
! --- 同じ内容が既登録ならばそれを返す (attrid は変更しない) ---
do, i = 1, size(antab)
if (antab(i)%fileid == entry%fileid .and. antab(i)%varid == entry%varid .and. antab(i)%dimid == entry%dimid) then
var = an_variable(i)
result = NF_NOERR
call DbgMessage('an_vartable.add: found %d', i=(/i/))
return
endif
enddo
!
! --- 空き地があればそこに割り当て ---
var = an_variable(-1)
do, i = 1, size(antab)
if (antab(i)%fileid == 0) then
var = an_variable(i)
exit
endif
enddo
if (var%id == -1) then
! --- 空き地はなかったのだから倍幅確保 ---
n = size(antab)
allocate(tmp_table(n), stat=result)
if (result /= 0) goto 999
tmp_table(:) = antab(:)
deallocate(antab, stat=result)
if (result /= 0) goto 999
allocate(antab(n * 2), stat=result)
if (result /= 0) goto 999
antab(1:n) = tmp_table(1:n)
deallocate(tmp_table, stat=result)
if (result /= 0) goto 999
!
antab(n+2)%fileid = 0
antab(n+2)%varid = 0
antab(n+2)%dimid = 0
antab(n+2)%attrid = 0
nullify(antab(n+2)%dimids)
antab(n+3: n*2) = antab(n+2)
! 確保域の先頭を使用
var = an_variable(n + 1)
endif
antab(var%id)%fileid = entry%fileid
antab(var%id)%varid = entry%varid
antab(var%id)%dimid = entry%dimid
!
! --- 次元表の確保 ---
call internal_build_dimids(antab(var%id), result)
if (result /= nf_noerr) goto 999
!
result = nf_noerr
call DbgMessage('an_vartable.add: added %d', i=(/var%id/))
return
!
999 continue
var = an_variable(-1)
result = NF_ENOMEM
return
contains
subroutine internal_build_dimids(ent, stat)
use netcdf_f77, only: nf_noerr, nf_inq_varndims, nf_inq_vardimid
type(an_variable_entry), intent(inout):: ent
integer, intent(out):: stat
integer:: ndims
if (ent%varid > 0) then
stat = nf_inq_varndims(ent%fileid, ent%varid, ndims)
if (stat /= nf_noerr) return
if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
if (ndims == 0) then
nullify(ent%dimids)
stat = nf_noerr
return
endif
allocate(ent%dimids(ndims), stat=stat)
if (stat /= 0) then
stat = nf_enomem
return
endif
stat = nf_inq_vardimid(ent%fileid, ent%varid, ent%dimids)
if (stat /= nf_noerr) return
if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
deallocate(ent%dimids)
goto 100
endif
else
allocate(ent%dimids(1), stat=stat)
if (stat /= 0) then
stat = nf_enomem
return
endif
ent%dimids(1) = ent%dimid
endif
stat = nf_noerr
return
100 continue
ent%varid = 0
allocate(ent%dimids(1))
ent%dimids(1) = ent%dimid
end subroutine
end function
| Function : | |
| result : | integer |
| var : | type(an_variable), intent(in) |
integer function vtable_delete(var) result(result)
type(an_variable), intent(in):: var
if (.not. allocated(antab)) goto 999
if (var%id <= 0 .or. var%id > size(antab)) goto 999
if (antab(var%id)%fileid == 0) goto 999
result = antab(var%id)%fileid
antab(var%id)%fileid = 0
antab(var%id)%varid = 0
antab(var%id)%dimid = 0
antab(var%id)%attrid = 0
if (associated(antab(var%id)%dimids)) deallocate(antab(var%id)%dimids)
call DbgMessage('an_vartable.delete: delete %d', i=(/var%id/))
return
!
999 continue
result = NF_ENOTVAR
end function
| Function : | |
| result : | integer |
| var : | type(an_variable), intent(in) |
| entry : | type(an_variable_entry), intent(out) |
integer function vtable_lookup(var, entry) result(result)
type(an_variable), intent(in):: var
type(an_variable_entry), intent(out):: entry
if (.not. allocated(antab)) goto 999
if (var%id <= 0 .or. var%id > size(antab)) goto 999
if (antab(var%id)%fileid == 0) goto 999
entry = antab(var%id)
result = NF_NOERR
return
!
999 continue
nullify(entry%dimids)
entry%fileid = -1
entry%varid = -1
entry%dimid = -1
entry%attrid = -1
result = NF_ENOTVAR
end function
| Function : | |
| result : | integer |
| var : | type(an_variable), intent(in) |
| attrid : | integer, intent(in) |
integer function vtable_set_attrid(var, attrid) result(result)
type(an_variable), intent(in):: var
integer, intent(in):: attrid
continue
if (.not. allocated(antab)) goto 999
if (var%id <= 0 .or. var%id > size(antab)) goto 999
if (antab(var%id)%fileid == 0) goto 999
antab(var%id)%attrid = attrid
result = NF_NOERR
return
!
999 continue
result = NF_ENOTVAR
end function
| Subroutine : | |
| ent : | type(an_variable_entry), intent(inout) |
| stat : | integer, intent(out) |
subroutine internal_build_dimids(ent, stat)
use netcdf_f77, only: nf_noerr, nf_inq_varndims, nf_inq_vardimid
type(an_variable_entry), intent(inout):: ent
integer, intent(out):: stat
integer:: ndims
if (ent%varid > 0) then
stat = nf_inq_varndims(ent%fileid, ent%varid, ndims)
if (stat /= nf_noerr) return
if ((ent%dimid > 0) .and. (ndims /= 1)) goto 100
if (ndims == 0) then
nullify(ent%dimids)
stat = nf_noerr
return
endif
allocate(ent%dimids(ndims), stat=stat)
if (stat /= 0) then
stat = nf_enomem
return
endif
stat = nf_inq_vardimid(ent%fileid, ent%varid, ent%dimids)
if (stat /= nf_noerr) return
if ((ent%dimid > 0) .and. (ent%dimids(1) /= ent%dimid)) then
deallocate(ent%dimids)
goto 100
endif
else
allocate(ent%dimids(1), stat=stat)
if (stat /= 0) then
stat = nf_enomem
return
endif
ent%dimids(1) = ent%dimid
endif
stat = nf_noerr
return
100 continue
ent%varid = 0
allocate(ent%dimids(1))
ent%dimids(1) = ent%dimid
end subroutine