!
!= å¤‰æ•°ã¾ãŸã¯å±žæ€§ã«é–¢ã™ã‚‹å•ã„åˆã‚ã›
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: gtvarinquire.f90,v 1.5 2009-07-04 04:58:06 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! ä»¥ä¸‹ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã€é–¢æ•°ã¯ gtdata_generic ã‹ã‚‰ gtdata_generic#Inquire
! ã¨ã—ã¦æä¾›ã•ã‚Œã¾ã™ã€‚

subroutine GTVarInquire(var, growable, rank, alldims, allcount, &
  & size, xtype, name, url, err )
  !
  !== å¤‰æ•°ã«é–¢ã™ã‚‹å•ã„åˆã‚ã›
  !
  ! å¤‰æ•° *var* ã«é–¢ã™ã‚‹å•ã„åˆã‚ã›ã‚’è¡Œã„ã¾ã™ã€‚
  !
  ! è¿”ã‚Šå€¤ã¨ãªã‚‹å¼•æ•°ã®æ–‡å—åž‹ã®å®Ÿå¼•æ•°ã®é•·ã•ãŒè¶³ã‚Šãªã„ã¨ã€
  ! çµæžœãŒæãªã‚ã‚Œã¾ã™ã€‚å¼•æ•°ã®æ–‡å—åˆ—ã®é•·ã•ã¨ã—ã¦ dc_types#STRING
  ! ã‚’ç”¨ã„ã‚‹ã“ã¨ã‚’æŽ¨å¥¨ã—ã¾ã™ã€‚
  !
  ! *Inquire* ã¯è¤‡æ•°ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®ç·ç§°åã§ã‚ã‚Šã€
  ! å•ã„åˆã‚ã›æ–¹æ³•ã¯è¤‡æ•°ç”¨æ„ã•ã‚Œã¦ã„ã¾ã™ã€‚
  ! ä¸‹è¨˜ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚‚å‚ç…§ã—ã¦ãã ã•ã„ã€‚
  !
  ! ä»–ã«ã‚‚å¤‰æ•°ã«é–¢ã™ã‚‹å•ã„åˆã‚ã›ã®ãŸã‚ã®æ‰‹ç¶šãã¨ã—ã¦
  ! Get_Slice, Dimname_to_Dimord ãŒã‚ã‚Šã¾ã™ã€‚
  !
  !--
  ! ã“ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã¯ INQUIRE æ–‡ã‚’æ¨¡ã—ã¦ä½œã‚‰ã‚ŒãŸã‚‚ã®ã§ã€
  ! ã‚ªãƒ–ã‚¸ã‚§ã‚¯ãƒˆãƒ»å¤‰æ•°ãƒ»å±žæ€§ã«é–¢ã™ã‚‹å•ã„åˆã‚ã›ã‚’è¡Œã„ã¾ã™ã€‚
  !++
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: inquire
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use dc_trace, only: beginsub, endsub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len=*), intent(out), optional:: xtype
                                        ! å¤–éƒ¨åž‹ã®åå‰
  character(len=*), intent(out), optional:: name
                                        ! name ã¯å¤‰æ•°åã®æœ€å°ã®å˜ä½ã‚’è¿”ã—ã¾ã™ã€‚
                                        ! ãƒ•ã‚¡ã‚¤ãƒ«åã‚’å«ã¾ãªã„ãŸã‚
                                        ! ãƒ—ãƒã‚°ãƒ©ãƒ å†…ã§ã®ä¸€æ„æ€§ã¯
                                        ! ä¿è¨¼ã•ã‚Œã¾ã›ã‚“ã€‚
                                        !
  character(len=*), intent(out), optional:: url
                                        ! url ã¯ãƒ•ã‚¡ã‚¤ãƒ«åã®ã¤ã„ãŸå¤‰æ•°å
                                        ! ã‚’è¿”ã—ã¾ã™ã€‚
                                        ! ãƒ—ãƒã‚°ãƒ©ãƒ å†…ã§ä¸€æ„ã§ã™ã€‚
                                        !
  integer, intent(out), optional:: rank
                                        ! ã‚³ãƒ³ãƒ‘ã‚¯ãƒˆ(ç¸®é€€)æ¬¡å…ƒã‚’æ•°ãˆãªã„ã€
                                        ! æ¬¡å…ƒã®æ•°
                                        !
  integer, intent(out), optional:: alldims
                                        ! ç¸®é€€æ¬¡å…ƒã‚’å«ã‚€å…¨æ¬¡å…ƒæ•°ã€‚
                                        ! dimord ã«ã¯åŸºæœ¬çš„ã«ã“ã¡ã‚‰ã‚’
                                        ! ä½¿ã„ã¾ã™ã€‚
                                        !
  integer, intent(out), optional:: allcount
                                        ! å¤‰æ•°ãŒæ¬¡å…ƒå¤‰æ•°ã§ã‚ã‚‹å ´åˆã€
                                        ! ç·æ•°ã‚’è¿”ã—ã¾ã™ã€‚
                                        ! ã‚¨ãƒ©ãƒ¼ã®å ´åˆã¯ã‚¼ãƒã‚’è¿”ã—ã¾ã™ã€‚
                                        !
  integer, intent(out), optional:: size
                                        ! å¤‰æ•°ã®å…¥å‡ºåŠ›é ˜åŸŸã®å¤§ãã•ã€‚
                                        ! (å¤‰æ•°ãŒä¾å˜ã™ã‚‹å„æ¬¡å…ƒã®é•·
                                        ! [æ ¼åç‚¹æ•°]ã®ç©)
                                        !
  logical, intent(out), optional:: growable
                                        ! å¤‰æ•°ãŒæ¬¡å…ƒå¤‰æ•°ã§ã‚ã‚‹å ´åˆã€
                                        ! è‡ªå‹•æ‹¡å¼µå¯èƒ½ã‹å¦ã‹ã‚’è¿”ã—ã¾ã™ã€‚
                                        ! æ¬¡å…ƒå¤‰æ•°ã§ãªã„å ´åˆã¯ä¸å®šã¨ãªã‚Šã¾ã™ã€‚
                                        !
  logical, intent(out), optional:: err
                                        ! ä¾‹å¤–å‡¦ç†ç”¨ãƒ•ãƒ©ã‚°.
                                        ! ãƒ‡ãƒ•ã‚©ãƒ«ãƒˆã§ã¯, ã“ã®æ‰‹ç¶šãå†…ã§ã‚¨ãƒ©ãƒ¼ãŒ
                                        ! ç”Ÿã˜ãŸå ´åˆ, ãƒ—ãƒã‚°ãƒ©ãƒ ã¯å¼·åˆ¶çµ‚äº†ã—ã¾ã™.
                                        ! å¼•æ•° *err* ãŒä¸Žãˆã‚‰ã‚Œã‚‹å ´åˆ,
                                        ! ãƒ—ãƒã‚°ãƒ©ãƒ ã¯å¼·åˆ¶çµ‚äº†ã›ãš, ä»£ã‚ã‚Šã«
                                        ! *err* ã« .true. ãŒä»£å…¥ã•ã‚Œã¾ã™.
                                        !
                                        ! Exception handling flag.
                                        ! By default, when error occur in
                                        ! this procedure, the program aborts.
                                        ! If this *err* argument is given,
                                        ! .true. is substituted to *err* and
                                        ! the program does not abort.
            integer:: class, cid
continue
  call beginsub('gtvarinquire', 'var.mapid=%d', i=(/var%mapid/))
  call var_class(var, class, cid)
  select case(class)
  case(vtb_class_netcdf)
    if (present(xtype) .or. present(name) .or. present(url)) then
      call inquire(GD_NC_VARIABLE(cid), xtype=xtype, name=name, url=url)
      if (present(xtype)) call DbgMessage('xtype=%c', c1=trim(xtype))
      if (present(name)) call DbgMessage('name=%c', c1=trim(name))
      if (present(url)) call DbgMessage('url=%c', c1=trim(url))
    endif
    if (present(growable)) then
      call inquire(GD_NC_VARIABLE(cid), growable=growable)
      call DbgMessage('growable=%y', L=(/growable/))
    endif
  case(vtb_class_memory)
    call DbgMessage('vtb_class_memory not implemented: skipped')
  end select
  if (present(alldims)) alldims = internal_get_alldims(var)
  if (present(allcount)) allcount = internal_get_allcount(var)
  if (present(size)) size = internal_get_size(var)
  if (present(rank)) rank = internal_get_rank(var)
  call endsub('gtvarinquire')
  return
contains

  integer function internal_get_alldims(var) result(result)
    use gtdata_internal_map, only: map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    call map_lookup(var, ndims=result)
    call DbgMessage('alldims=%d', i=(/result/))
  end function internal_get_alldims

  integer function internal_get_allcount(var) result(result)
    use gtdata_internal_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_allcount: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%allcount)
    call DbgMessage('internal_get_allcount: %d map.size=%d', &
      & i=(/result, nd/))
    deallocate(map)
  end function internal_get_allcount

  integer function internal_get_size(var) result(result)
    use gtdata_internal_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd
    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_size: no map')
      result = 1
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = product(map(1:nd)%count)
    call DbgMessage('internal_get_size: %d map.size=%d', &
      & i=(/result, nd/))
    deallocate(map)
  end function internal_get_size

  integer function internal_get_rank(var) result(result)
    use gtdata_internal_map, only: gt_dimmap, map_lookup
    implicit none
    type(GT_VARIABLE), intent(in):: var
    type(gt_dimmap), allocatable:: map(:)
    integer:: nd

    call map_lookup(var, ndims=nd)
    if (nd <= 0) then
      call DbgMessage('internal_get_rank: no map')
      result = 0
      return
    endif
    allocate(map(nd))
    call map_lookup(var, map=map)
    result = count(map(1:nd)%count > 1)
    call DbgMessage('internal_get_rank: %d', i=(/result/))
    deallocate(map)
  end function internal_get_rank

end subroutine GTVarInquire

subroutine GTVarInquire2(var, allcount)
  !
  !== å¤‰æ•°ã®ä¾å˜ã™ã‚‹æ¬¡å…ƒ (è¤‡æ•°) ã®ç·æ•°ã®å•ã„åˆã‚ã›
  !
  ! å¤‰æ•° *var* ãŒä¾å˜ã™ã‚‹å„æ¬¡å…ƒã®ç·æ•°ã‚’è¿”ã—ã¾ã™ã€‚
  ! *allcount* ã®é…åˆ—ã®ã‚µã‚¤ã‚ºã¯ä¾å˜ã™ã‚‹æ¬¡å…ƒã®æ•°ã ã‘å¿…è¦ã§ã™ã€‚
  ! ä¾å˜ã™ã‚‹æ¬¡å…ƒã®æ•°ã¯ä¸Šè¨˜ã® *Inquire* ã® *alldims* ã§èª¿ã¹ã‚‹ã“ã¨ãŒ
  ! ã§ãã¾ã™ã€‚
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: inquire, open, close
  use dc_trace, only: beginsub, endsub
  type(GT_VARIABLE), intent(in):: var
  integer, intent(out):: allcount(:) ! alldims å€‹å¿…è¦
  integer:: i, n
  type(GT_VARIABLE):: v
  call beginsub('gtvarinquire2')
  call inquire(var, alldims=n)
  do, i = 1, n
    call Open(v, var, i, count_compact=.true.)
    call inquire(var, allcount=allcount(i))
    call Close(v)
  enddo
  call endsub('gtvarinquire2')
end subroutine

subroutine GTVarInquireA(var, attrname, xtype)
  !
  !== å¤‰æ•°ã®å±žæ€§ã®åž‹ã®å•ã„åˆã‚ã›
  !
  ! å¤‰æ•° *var* ã®å±žæ€§ *attrname* ã®å€¤ã®åž‹ã‚’ *xtype* ã«è¿”ã—ã¾ã™ã€‚
  !
  !--
  ! æ–‡å—æ•°ãŒåˆã‚ãªã‘ã‚Œã°å½“ç„¶å¤‰ãªã“ã¨ãŒèµ·ã“ã‚‹ãŒã€æ°—ã«ã—ãªã„ã€‚
  !++
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use dc_trace, only: beginsub, endsub
  use gtdata_netcdf_generic, only: inquire
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  type(GT_VARIABLE), intent(in):: var
  character(len=*), intent(in):: attrname
  character(len=*), intent(out), optional:: xtype
  integer:: class, cid
  character(len = *), parameter:: subnam = "gtvarinquireA"
continue
  call beginsub(subnam, "%c", c1=trim(attrname))
  call var_class(var, class, cid)
  select case(class)
  case(vtb_class_netcdf)
    call inquire(GD_NC_VARIABLE(cid), attrname=attrname, xtype=xtype)
  end select
  call endsub(subnam)
end subroutine GTVarInquireA

subroutine GTVarInquireD(var, dimord, url, allcount, err)
  !
  !== å¤‰æ•°ã®æ¬¡å…ƒã«é–¢ã™ã‚‹å•ã„åˆã‚ã›
  !
  ! å¤‰æ•° *var* ã®æ¬¡å…ƒé †åºç•ªå· *dimord* ã«å¯¾å¿œã™ã‚‹æ¬¡å…ƒã®
  ! URL *url* ã¨ç·æ•° *allcout* ã‚’è¿”ã—ã¾ã™ã€‚
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: open, close, inquire
  use dc_trace, only: beginsub, endsub
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, intent(in):: dimord
  character(len=*), intent(out), optional:: url
  integer, intent(out), optional:: allcount
  logical, intent(out), optional:: err
  type(GT_VARIABLE):: dimvar
  character(len = *), parameter:: subnam = "gtvarinquireD"
continue
  call beginsub(subnam, "%d", i=(/dimord/))
  call open(dimvar, source_var=var, dimord=dimord, err=err)
  if (present(url)) call inquire(dimvar, url=url)
  if (present(allcount)) call inquire(dimvar, allcount=allcount)
  call close(dimvar)
  call endsub(subnam)
end subroutine GTVarInquireD