! Copyright (C) GFD Dennou Club, 2001. All rights reserved
module an_vartable 29,4
use an_types
, only: an_variable, an_variable_entry, an_variable_search
use dc_error
use netcdf_f77
use dc_trace, only: DbgMessage
implicit none
private
type(an_variable_entry), save, target, allocatable:: antab(:)
integer, parameter:: antab_init_size = 16
public:: vtable_add, vtable_delete, vtable_lookup, an_variable_entry
public:: vtable_set_attrid
contains
integer function vtable_add(var, entry) result(result) 4,3
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) 1,1
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
! 成功時は fileid を、失敗時は NF_ENOTVAR を返す
!
integer function vtable_delete(var) result(result) 1,1
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
integer function vtable_lookup(var, entry) result(result) 27
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
integer function vtable_set_attrid(var, attrid) result(result) 3
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
end module