!
!= gtool 螟画焚陦ｨ
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: gtdata_internal_vartable.f90,v 1.2 2009-05-29 15:03:49 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!

module gtdata_internal_vartable
  !
  ! 縺薙�繝｢繧ｸ繝･繝ｼ繝ｫ縺ｯ gtool 繝｢繧ｸ繝･繝ｼ繝ｫ縺九ｉ逶ｴ謗･縺ｫ縺ｯ蠑慕畑縺輔ｌ縺ｪ縺�◆繧√�
  ! 逶ｸ蠖薙�縺｡繧�↑蜷榊燕縺ｮ菴ｿ縺�婿繧偵＠縺ｦ縺�ｋ縲ゅΘ繝ｼ繧ｶ縺ｯ蜻ｼ繧薙〒縺ｯ縺ｪ繧峨↑縺��
  !
  !=== gtool 螟画焚陦ｨ
  !
  ! gtool 螟画焚縺ｨ縺�≧縺ｮ縺ｯ螳溘�蜊倥↑繧九ワ繝ｳ繝峨Ν縺ｨ螟壽ｬ｡蜈�う繝�Ξ繝ｼ繧ｿ縺ｧ縺ゅｊ縲�
  ! 繝上Φ繝峨Ν縺ｯ蟆上＆縺ｪ謨ｴ謨ｰ蛟､縺ｧ縺ゅｋ縲�
  ! 螳滉ｽ薙↓繧｢繧ｯ繧ｻ繧ｹ縺吶ｋ縺溘ａ縺ｫ縺ｯ縲√ワ繝ｳ繝峨Ν蛟､繧偵く繝ｼ縺ｫ縺励※縺ｾ縺壹�繝��陦ｨ繧貞ｼ輔″縲�
  ! 縺昴％縺ｧ蠕励ｉ繧後◆ vid 繧偵く繝ｼ縺ｫ縺励※螟画焚陦ｨ繧貞ｼ輔＞縺ｦ縲�
  ! 遞ｮ蛻･縺ｨ遞ｮ蛻･縺斐→縺ｮ螟画焚逡ｪ蜿ｷ繧貞ｾ励ｋ縲ゅ％繧後ｉ縺ｯ縺溘°縺�縺九�繧､繝ｳ繧ｿ�九が繝輔そ繝�ヨ
  ! 蜿ら�遞句ｺｦ縺ｮ繧ｳ繧ｹ繝医〒縺ゅｋ縲�
  ! gtool 螟画焚縺ｯ螳滉ｽ灘､画焚縺九ｉ繧､繝�Ξ繝ｼ繧ｿ縺悟ｿ�ｦ√↑縺�縺台ｽ懈�縺輔ｌ繧九′縲�
  ! 縺薙�螟画焚陦ｨ縺ｯ螳滉ｽ灘､画焚縺ｫ縺､縺搾ｼ代お繝ｳ繝医Μ縺励°菴懈�縺励↑縺��縺ｧ縲∝盾辣ｧ謨ｰ繧呈戟縺､縲�
  ! 縺薙�縺溘ａ縲∝ｮ滉ｽ灘､画焚縺ｯ螟画焚縺ｫ莉倥＞縺ｦ蜿ら�謨ｰ邂｡逅�ｒ縺励↑縺上※繧ゅｈ縺上↑繧九�

  use gtdata_netcdf_types, only: GD_NC_VARIABLE_SEARCH
  use dc_types, only: STRING
  implicit none
  private

  integer, parameter, public :: vid_invalid = -1

  integer, parameter, public :: VTB_CLASS_UNUSED = 0
  integer, parameter, public :: VTB_CLASS_MEMORY = 1
  integer, parameter, public :: VTB_CLASS_NETCDF = 2
  integer, parameter, public :: CLASSES_MAX = 2

  type VAR_TABLE_ENTRY
    integer:: class
    integer:: cid
    integer:: refcount
  end type VAR_TABLE_ENTRY

  type(VAR_TABLE_ENTRY), save, allocatable:: table(:)
  integer, parameter:: table_ini_size = 16

  type(GD_NC_VARIABLE_SEARCH), public, save:: gdnc_search

  public:: VarTableAdd, VarTableDelete, VarTableMore, VarTableLookup
  public:: vartable_dump
  public:: dimrange, ndims, query_growable
  private:: var_table_entry, table, table_ini_size
  private:: entry_cleanup

  interface dimrange
    module procedure dimrange_direct
  end interface

contains

  subroutine vartable_dump(vid)
    use dc_trace, only: DbgMessage
    use gtdata_netcdf_generic, only: toString
    use gtdata_netcdf_types, only: GD_NC_VARIABLE
    integer, intent(in):: vid
    character(10):: class
    if (.not. allocated(table)) return
    if (vid <= 0 .or. vid > size(table)) return
    select case(table(vid)%class)
    case(vtb_class_netcdf)
      class = 'netcdf'
    case(vtb_class_memory)
      class = 'memory'
    case default
      write(class, fmt="(i10)") table(vid)%class
    end select
    call DbgMessage('[vartable %d: class=%c cid=%d ref=%d]', &
      & i=(/vid, table(vid)%cid, table(vid)%refcount/), &
      & c1=trim(class))
    select case(table(vid)%class)
    case(vtb_class_netcdf)
      call DbgMessage('[%c]', c1=trim(tostring(GD_NC_VARIABLE(table(vid)%cid))))
    end select
  end subroutine vartable_dump

  subroutine entry_cleanup(vtb_entry)
    type(VAR_TABLE_ENTRY), intent(out):: vtb_entry(:)
    vtb_entry(:)%class = VTB_CLASS_UNUSED
    vtb_entry(:)%cid = -1
    vtb_entry(:)%refcount = 0
  end subroutine entry_cleanup

  subroutine VarTableAdd(vid, class, cid)
    use dc_trace, only: DbgMessage
    integer, intent(out):: vid
    integer, intent(in):: class, cid
    type(VAR_TABLE_ENTRY), allocatable:: tmp_table(:)
    integer:: n
  continue
    ! 蠢�ｦ√↑繧峨�蛻晄悄蟷�｢ｺ菫�
    if (.not. allocated(table)) then
      allocate(table(table_ini_size))
      call entry_cleanup(table(:))
    endif
    ! 隧ｲ蠖薙′縺ゅｌ縺ｰ蜿ら�謨ｰ蠅怜刈
    do, n = 1, size(table)
      if (table(n)%class == class .and. table(n)%cid == cid) then
        table(n)%refcount = table(n)%refcount + 1
        call DbgMessage('gtdata_vartable.add(class=%d cid=%d) found (ref=%d)', &
          & i=(/table(n)%class, table(n)%cid, table(n)%refcount/))
        vid = n
        return
      endif
    enddo
    ! 繧ゅ＠遨ｺ縺阪′辟｡縺代ｌ縺ｰ陦ｨ繧呈僑蠑ｵ
    if (all(table(:)%class /= VTB_CLASS_UNUSED)) then
      n = size(table)
      allocate(tmp_table(n))
      tmp_table(:) = table(:)
      deallocate(table)
      allocate(table(n * 2))
      table(1:n) = tmp_table(1:n)
      deallocate(tmp_table)
      table(n+1:n*2) = var_table_entry(VTB_CLASS_UNUSED, -1, 0)
    endif
    do, n = 1, size(table)
      if (table(n)%class == VTB_CLASS_UNUSED) then
        table(n)%class = class
        table(n)%cid = cid
        table(n)%refcount = 1
        vid = n
        return
      endif
    enddo
    vid = vid_invalid
  end subroutine VarTableAdd

  subroutine VarTableDelete(vid, action, err)
    integer, intent(in):: vid
    logical, intent(out):: action
    logical, intent(out), optional:: err
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= VTB_CLASS_UNUSED) goto 999
    if (table(vid)%class > CLASSES_MAX) goto 999
    table(vid)%refcount = max(table(vid)%refcount - 1, 0)
    action = (table(vid)%refcount == 0)
    if (present(err)) err = .false.
    return
999 continue
    action = .false.
    if (present(err)) err = .true.
  end subroutine VarTableDelete

  subroutine VarTableLookup(vid, class, cid)
    ! 蜷後§繝輔ぃ繧､繝ｫ逡ｪ蜿ｷ縺ｮ螟画焚陦ｨ縺ｮ荳ｭ霄ｫ繧定ｿ斐☆
    integer, intent(in):: vid
    integer, intent(out), optional:: class, cid
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= VTB_CLASS_UNUSED) goto 999
    if (table(vid)%class > CLASSES_MAX) goto 999
    if (present(class)) class = table(vid)%class
    if (present(cid)) cid = table(vid)%cid
    return
999 continue
    if (present(class)) class = VTB_CLASS_UNUSED
  end subroutine VarTableLookup

  subroutine VarTableMore(vid, err)
    ! 蜷後§繝輔ぃ繧､繝ｫ逡ｪ蜿ｷ縺ｮ蜿ら�繧ｫ繧ｦ繝ｳ繝医ｒ蠅怜刈縺吶ｋ縲�
    integer, intent(in):: vid
    logical, intent(out), optional:: err
    if (.not. allocated(table)) goto 999
    if (vid <= 0 .or. vid > size(table)) goto 999
    if (table(vid)%class <= VTB_CLASS_UNUSED) goto 999
    if (table(vid)%class > CLASSES_MAX) goto 999
    table(vid)%refcount = table(vid)%refcount + 1
    if (present(err)) err = .false.
    return
999 continue
    if (present(err)) err = .true.
  end subroutine VarTableMore

  subroutine dimrange_direct(vid, dimlo, dimhi)
    use gtdata_netcdf_types, only: GD_NC_VARIABLE
    use gtdata_netcdf_generic, only: GDNcInquire => Inquire
    use dc_error, only: storeerror, NF90_EINVAL, gt_efake
    integer, intent(in):: vid
    integer, intent(out):: dimlo, dimhi
    integer:: class, cid
    call VarTableLookup(vid, class, cid)
    select case(class)
    case(VTB_CLASS_MEMORY)
      call storeerror(gt_efake, 'gtdata::dimrange')
    case(VTB_CLASS_NETCDF)
      dimlo = 1
      call GDNcInquire(GD_NC_VARIABLE(cid), dimlen=dimhi)
    case default
      call storeerror(NF90_EINVAL, 'gtdata::dimrange')
    end select
  end subroutine dimrange_direct

  integer function ndims(vid) result(result)
    use gtdata_netcdf_types, only: GD_NC_VARIABLE
    use gtdata_netcdf_generic, only: GDNcInquire => inquire
    use dc_error, only: storeerror, NF90_EINVAL
    integer, intent(in):: vid
    integer:: class, cid
    call VarTableLookup(vid, class, cid)
    select case(class)
    case(VTB_CLASS_MEMORY)
      result = 1
    case(VTB_CLASS_NETCDF)
      call GDNcInquire(GD_NC_VARIABLE(cid), ndims=result)
    case default
      call storeerror(NF90_EINVAL, 'gtdata::ndims')
    end select
  end function ndims

  subroutine query_growable(vid, result)
    use gtdata_netcdf_types, only: GD_NC_VARIABLE
    use gtdata_netcdf_generic, only: inquire
    use dc_error, only: storeerror, NF90_EINVAL
    integer, intent(in):: vid
    logical, intent(out):: result
    integer:: class, cid
    call vartablelookup(vid, class, cid)
    select case(class)
    case(vtb_class_memory)
      result = .false.
    case(vtb_class_netcdf)
      call inquire(GD_NC_VARIABLE(cid), growable=result)
    case default
      call storeerror(NF90_EINVAL, 'gtdata::ndims')
    end select
  end subroutine query_growable

end module gtdata_internal_vartable