!
!= æ•°å€¤åž‹å±žæ€§ã®å…¥åŠ›
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: gtvargetattr.f90,v 1.6 2010-06-17 00:41:41 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! ä»¥ä¸‹ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³, é–¢æ•°ã¯ gtdata_generic ã‹ã‚‰æä¾›ã•ã‚Œã¾ã™ã€‚
!
!--
! å¼•æ•°ã®åž‹ã«å¿œã˜ã¦ã„ã‚ã„ã‚ã‚ã‚‹ãŒã€ã©ã†ã›ä¸‹éƒ¨æ§‹é€ ã§ã¯åŒã˜ãƒ¢ãƒŽã‚’ä½¿ã£ã¦ã„ã‚‹ã€‚
!
! ã‚¹ã‚«ãƒ©ã§å—ã‘å–ã‚‹ã®ãŒä¸€ç•ªç°¡å˜ã€‚è§£é‡ˆå¯èƒ½ãªå€¤ãŒã¨ã‚‰ã‚Œã€æ®‹ã‚Šã¯æ¨ã¦ã‚‰ã‚Œã‚‹ã€‚
!++

subroutine GTVarGetAttrI(var, attrname, value, default)
  !
  !== å±žæ€§ã®å…¥åŠ›
  !
  ! å¤‰æ•° *var* ã«ä»˜åŠ ã•ã‚Œã¦ã„ã‚‹å±žæ€§ *name* ã®å€¤ã‚’è¿”ã—ã¾ã™ã€‚
  ! *Get_Attr* ã¯è¤‡æ•°ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®ç·ç§°åãªã®ã§ã€
  ! *value* ã«ã¯æ§˜ã€…ãªåž‹ã®å¤‰æ•° (ãƒã‚¤ãƒ³ã‚¿ã‚‚å¯èƒ½)
  ! ã‚’ä¸Žãˆã‚‹ã“ã¨ãŒå¯èƒ½ã§ã™ã€‚
  ! ä»¥ä¸‹ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’å‚ç…§ã—ã¦ãã ã•ã„ã€‚
  !
  ! å±žæ€§ã®å€¤ãŒæ£å¸¸ã«å–å¾—ã§ããšã€ä¸”ã¤ *default* ãŒä¸Žãˆã‚‰ã‚Œã¦
  ! ã„ãŸå ´åˆã€ãã®å€¤ãŒè¿”ã‚Šã¾ã™ã€‚
  ! *default* ãŒä¸Žãˆã‚‰ã‚Œãªã„å ´åˆã®ãƒ‡ãƒ•ã‚©ãƒ«ãƒˆã®å€¤ã¯ãã‚Œãžã‚Œä»¥ä¸‹ã®
  ! é€šã‚Šã§ã™ã€‚
  !
  ! character :: "" (ç©ºæ–‡å—)
  ! real      :: netcdf_f77#NF90_FILL_REAL
  ! real(DP)  :: netcdf_f77#NF90_FILL_DOUBLE
  ! integer   :: netcdf_f77#NF90_FILL_INT
  !
  ! *value* ãŒãƒã‚¤ãƒ³ã‚¿ã®å ´åˆã¯ã€åž‹ã«ä¾ã‚‰ãšç©ºçŠ¶æ…‹ãŒè¿”ã‚Šã¾ã™ã€‚
  !
  ! *value* ã«ãƒã‚¤ãƒ³ã‚¿ã‚’ä¸ŽãˆãŸå ´åˆã€å±žæ€§ã®å€¤ã«å¿œã˜ã¦è‡ªå‹•çš„ã«
  ! å‰²ã‚Šä»˜ã‘ãŒè¡Œã‚ã‚Œã¾ã™ã€‚ãã®ãŸã‚ã€å¿…ãšç©ºçŠ¶æ…‹ã«ã—ã¦ã‹ã‚‰ä¸Žãˆã¦ãã ã•ã„ã€‚
  !
  ! *value* ã«å›ºå®šé•·é…åˆ—ã‚’ç”¨æ„ã™ã‚‹å ´åˆ *default* ãŒå¿…é ˆã«ãªã‚Šã¾ã™ãŒã€
  ! ã“ã‚Œã¯ Fortran ã®è¨€èªžä»•æ§˜ä¸Šãƒã‚¤ãƒ³ã‚¿æ–¹å¼ã¨å¼•ç”¨ä»•æ§˜ãŒåŒã˜ã§ã‚ã£ã¦ã¯
  ! ãªã‚‰ãªã„ã‹ã‚‰ã§ã™ã€‚
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use netcdf, only: NF90_FILL_INT
  use dc_string, only: StoI
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: attrname
  integer, intent(out):: value
  integer, intent(in), optional:: default
  integer:: stat, buffer(1), class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(GD_NC_VARIABLE(cid), attrname, buffer, stat, default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  else if (class == vtb_class_memory) then
    call get_attr(GD_MEM_VARIABLE(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = StoI(cbuffer)
      return
    endif
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrI")
  endif
  value = NF90_FILL_INT
  if (present(default)) value = default
end subroutine GTVarGetAttrI

subroutine GTVarGetAttrR(var, attrname, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use dc_error, only: GT_EBADVAR, StoreError
  use dc_string, only: StoD
  use netcdf, only: NF90_FILL_FLOAT
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: attrname
  real, intent(out):: value
  real, intent(in), optional:: default
  integer:: stat
  real:: buffer(1)
  character(STRING):: cbuffer
  integer:: class, cid
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(GD_NC_VARIABLE(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    endif
  else if (class == vtb_class_memory) then
    call get_attr(GD_MEM_VARIABLE(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = StoD(cbuffer)
      return
    endif
  else
    call StoreError(GT_EBADVAR, "GTVarGetAttrR")
  endif
  if (present(default)) then
    value = default
  else
    value = NF90_FILL_FLOAT
  endif
end subroutine GTVarGetAttrR

subroutine GTVarGetAttrD(var, attrname, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use dc_string, only: StoD
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_types, only: DP
  use netcdf, only: NF90_FILL_DOUBLE
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: attrname
  real(DP), intent(out):: value
  real(DP), intent(in), optional:: default
  integer:: stat
  real(DP):: buffer(1)
  character(STRING):: cbuffer
  integer:: class, cid
  logical:: err
continue
  call var_class(var, class, cid)
  select case(class)
  case (vtb_class_netcdf)
    call get_attr(GD_NC_VARIABLE(cid), attrname, value=buffer, &
      & stat=stat, default=default)
    if (stat >= 1) then
      value = buffer(1)
      return
    end if
  case (vtb_class_memory)
    call get_attr(GD_MEM_VARIABLE(cid), attrname, cbuffer, err)
    if (.not. err) then
      value = StoD(cbuffer)
      return
    endif
  case default
    call StoreError(GT_ENOTVAR, "GTVarGetAttrR")
  end select
  value = NF90_FILL_DOUBLE
  if (present(default)) value = default
end subroutine

!
! ãƒã‚¤ãƒ³ã‚¿é…åˆ—ã‚’ä½¿ã£ã¦å—ã‘å–ã‚‹å ´åˆã¯è§£é‡ˆå¯èƒ½ãªæ•°ã ã‘å®Ÿä½“ãŒå‰²ã‚Šä»˜ã‘ã‚‰ã‚Œã‚‹ã€‚
!

subroutine GTVarGetAttrIP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_string, only: get_array
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  integer, pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(GD_NC_VARIABLE(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(GD_MEM_VARIABLE(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrIP")
  endif
end subroutine GTVarGetAttrIP

subroutine GTVarGetAttrRP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use dc_string, only: get_array
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  real, pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(GD_NC_VARIABLE(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(GD_MEM_VARIABLE(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    nullify(value)
    call StoreError(GT_ENOTVAR, "GTVarGetAttrRP")
  endif
end subroutine GTVarGetAttrRP

subroutine GTVarGetAttrDP(var, name, value)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_memory_generic, only: get_attr
  use gtdata_memory_types, only: GD_MEM_VARIABLE
  use dc_types, only: DP
  use dc_error, only: GT_ENOTVAR, StoreError
  use dc_string, only: get_array
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), pointer:: value(:) !(out)
  integer:: stat, class, cid
  character(STRING):: cbuffer
  logical:: err
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    allocate(value(1))
    call get_attr(GD_NC_VARIABLE(cid), name, value(1:0), stat)
    deallocate(value)
    if (stat < 1) return
    allocate(value(stat))
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat)
    if (stat < 1) deallocate(value)
  else if (class == vtb_class_memory) then
    call get_attr(GD_MEM_VARIABLE(cid), name, cbuffer, err)
    if (err) then
      nullify(value)
      return
    endif
    call get_array(value, cbuffer)
    cbuffer = ""
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrRP")
  endif
end subroutine GTVarGetAttrDP

! integer é…åˆ—, real é…åˆ—ã¨ã—ã¦å—ã‘å–ã‚‹
! å ´åˆã¯å±žæ€§é•·ãŒã‚ã¾ã£ã¦ã„ã‚‹å ´åˆã«ã¯åˆ‡ã‚Šæ¨ã¦ã‚‰ã‚Œã€
! å±žæ€§é•·ãŒè¶³ã‚Šãªã„å ´åˆã¯ default å€¤ (ãƒã‚¤ãƒ³ã‚¿ã¨é•ã„å¿…é ˆ) ã‚’åŸ‹ã‚ã‚‹ã€‚

subroutine GTVarGetAttrIA(var, name, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use dc_error, only: GT_ENOTVAR, StoreError
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  integer, intent(out):: value(:)
  integer, intent(in):: default
  integer, pointer:: ptr(:)
  integer:: n, stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrIA")
  endif
end subroutine GTVarGetAttrIA

subroutine GTVarGetAttrRA(var, name, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use dc_error, only: GT_ENOTVAR, StoreError
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  real, intent(out):: value(:)
  real, intent(in):: default
  real, pointer:: ptr(:)
  integer:: n, class, cid, stat
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrRA")
  endif
end subroutine GTVarGetAttrRA

subroutine GTVarGetAttrDA(var, name, value, default)
  use gtdata_types, only: GT_VARIABLE
  use gtdata_generic, only: friend => get_attr
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory
  use gtdata_netcdf_generic, only: get_attr
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use dc_types, only: DP
  use dc_error, only: GT_ENOTVAR, StoreError
  implicit none
  type(GT_VARIABLE), intent(in):: var
  character(len = *), intent(in):: name
  real(DP), intent(out):: value(:)
  real(DP), intent(in):: default
  real(DP), pointer:: ptr(:)
  integer:: n, stat, class, cid
continue
  call var_class(var, class, cid)
  if (class == vtb_class_netcdf) then
    call get_attr(GD_NC_VARIABLE(cid), name, value, stat, default)
  else if (class == vtb_class_memory) then
    call friend(var, name, ptr)
    if (.not. associated(ptr)) then
      value(:) = default
    else
      n = min(size(ptr), size(value))
      value(1:n) = ptr(1:n)
      if (n < size(ptr)) value(n+1: ) = default
      deallocate(ptr)
    endif
  else
    call StoreError(GT_ENOTVAR, "GTVarGetAttrRA")
  endif
end subroutine GTVarGetAttrDA