! netcdf_filename.f90 - object-oriented netCDF file interface (filename)
! vi: set sw=4:
! Copyright (C) TOYODA Eizi, 2000.  All rights reserved.
!
! 2000-01-12 豊田英司	初版
! 2000-01-16 豊田英司	スタイルハック
! 2000-02-22 豊田英司	可変長文字列採用

! netcdf_filename モジュールの目的
!
! netcdf_file モジュールで定義されることになる NC_FILE 構造体は
! ファイル ID しか管理しない。NC_FILE 構造体を多数作成すると
! ファイル記述子不足に陥るおそれがある。
! netcdf_filename モジュールはファイル名とモードの
! 検査によって NF_OPEN を省略できるかどうかを判定する。
!

module netcdf_filename
    use dc_string
    implicit none

    private
    public:: StoreFilename, DisposeFilename, FilenameById, IdByFilename
    public:: CompatibleMode

    character(len = *), parameter:: RCSID = &
	& '$Id: netcdf_filename.f90,v 1.5 2000/05/31 10:22:05 eizi Exp $'

    integer, parameter:: INITIAL_TABLE_SIZE = 16
    integer, parameter:: ID_INVALID = -1
    integer, parameter:: INDEX_INVALID = -1

    !
    ! ある id を持つファイルの名前を name に、
    ! いくつの NF_FILE オブジェクトが生成されたかを n_link に格納する。
    ! ファイルが書き込み可能で開かれたかどうかを writable に格納する。
    ! 

    type TABLE_ENTRY
    	integer::			id
	type(VARYING_STRING)::		name
	integer::			n_link
	logical::			writable
    end type

    type(TABLE_ENTRY), save, pointer::	Table(:)

contains

    !
    ! --- 初期化とデータの登録 ---
    !

    subroutine init_entry(entry)
	type(TABLE_ENTRY), intent(out):: entry
    continue
	entry%id = ID_INVALID
	entry%name = ''
	entry%n_link = 0
	entry%writable = .TRUE.
    end subroutine

    logical function init_table() result(result)
	integer:: status, i
    continue
	result = .true.
	if (associated(Table)) return
	allocate(Table(INITIAL_TABLE_SIZE), stat=status)
	if (status == 0) then
	    do, i = 1, size(Table)
		call init_entry(Table(i))
	    enddo
	else
	    result = .false.
	endif
    end function

    subroutine grow_table(newsize)
	integer, intent(in)::		newsize
	integer::			copysize, status, i
	type(TABLE_ENTRY), pointer::	newtable(:)
    continue
	copysize = min(size(Table), newsize)
	allocate(newtable(newsize), stat=status)
	if (status == 0) then
	    newtable(1: copysize) = Table(1: copysize)
	    do, i = copysize + 1, newsize
		call init_entry(newtable(i))
	    enddo
	    deallocate(Table)
	    Table => newtable
	endif
    end subroutine

    subroutine StoreFilename(id, name, writable)
	integer, intent(in):: id
	character(len=*), intent(in):: name
	logical, intent(in):: writable
	integer:: i
    continue
	if (.not. init_table()) return
	i = lookup_id(id)
	if (i /= INDEX_INVALID) then
	    ! 同じ id の表エントリがあれば
	    if (Table(i)%name /= name) Table(i)%n_link = 0
	    Table(i)%name = name
	    Table(i)%writable = writable
	    Table(i)%n_link = Table(i)%n_link + 1
	    return
	endif
	i = lookup_id(ID_INVALID)
	if (i == INDEX_INVALID) then
	    call grow_table(size(Table) * 2)
	    i = lookup_id(ID_INVALID)
	endif
	if (i /= INDEX_INVALID) then
	    Table(i)%id = id
	    Table(i)%name = name
	    Table(i)%writable = writable
	    Table(i)%n_link = 1
	endif
    end subroutine

    !
    ! --- 表からの情報の取得 ---
    !

    integer function lookup_id(id) result(result)
	integer, intent(in)::		id
	integer::			i
    continue
	if (.not. init_table()) return
	do, i = 1, size(Table)
	    if (Table(i)%id == id) then
		result = i
		return
	    endif
	enddo
	result = INDEX_INVALID
    end function

    integer function IdByFilename(filename) result(result)
	type(VARYING_STRING), intent(in):: filename
	integer:: i
    continue
	if (.not. init_table()) then
	    result = ID_INVALID;  return
	endif
	do, i = 1, size(Table)
	    if (Table(i)%id == ID_INVALID) cycle
	    if (Table(i)%name == filename) then
		result = Table(i)%id; return
	    endif
	enddo
	result = ID_INVALID
    end function

    subroutine DisposeFilename(id, end)
	integer, intent(in)::		id
	logical, intent(out)::		end
	integer::			i
    continue
	i = lookup_id(id)
	if (i < 1 .or. i > size(Table)) then
	    call put_line('Disable(' // itos(id) // '): invalid file id')
	    stop
	endif
	end = (Table(i)%n_link == 1)
	Table(i)%n_link = max(Table(i)%n_link - 1, 0)
	if (end) then
	    Table(i)%id = ID_INVALID
	    Table(i)%name = ""
	endif
    end subroutine

    type(VARYING_STRING) function FilenameById(id) result(result)
	integer, intent(in)::		id
	integer::			i
    continue
	i = lookup_id(id)
	if (i < 1 .or. id < 1) then
	    result = "(invalid file id " // itos(id) // ")"
	    return
	endif
	result = Table(i)%name
    end function

    logical function CompatibleMode(id, writable) result(result)
	integer, intent(in):: id
	logical, intent(in):: writable
	integer:: idx
    continue
	idx = lookup_id(id)
	if (idx < 1) then
	    result = .FALSE.;  return
	endif
	! Readonly で開かれたファイル番号を writable に
	! 転用することはできない。
	result = .TRUE.
	if (writable .and. .not. Table(idx)%writable) result = .FALSE.
    end function

end module netcdf_filename
