!
!= å¾“å±žå¤‰æ•°ã®ä½œæˆ
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: gtvarcreate.f90,v 1.4 2009-05-25 09:55:58 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! ä»¥ä¸‹ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³, é–¢æ•°ã¯ gtdata_generic ã‹ã‚‰æä¾›ã•ã‚Œã¾ã™ã€‚
!

subroutine GTVarCreate(var, url, dims, xtype, long_name, overwrite, err)
  !
  !== å¾“å±žå¤‰æ•°ã®ä½œæˆ
  !
  ! å ´æ‰€ *url* ã«æ¬¡å…ƒ *dims* ã‚’æŒã£ãŸå¤‰æ•°ã¤ã¾ã‚Š GT_VARIABLE åž‹
  ! ã®å®Ÿä½“ã‚’ä½œæˆã—ã€ãã‚Œã‚’ç¬¬ 1 å¼•æ•° *var* ã«ã‚»ãƒƒãƒˆã—ã¾ã™ã€‚
  ! Open ã•ã‚ŒãŸã‚‚ã®ã¨åŒæ§˜ã€ç¬¬1å¼•æ•° *var* ã¯å¾Œã§å¿…ãš
  ! Close ã•ã‚Œãªã‘ã‚Œã°ãªã‚Šã¾ã›ã‚“ã€‚
  !
  ! åž‹ *xtype* ã‚’çœç•¥ã™ã‚‹ã¨ "+float+" ã¨
  ! ã¿ãªã•ã‚Œã¾ã™ã€‚æ—¢å˜å¤‰æ•°ãŒã‚ã‚‹ã¨ãå¤±æ•—ã—ã¾ã™ãŒã€
  ! overwrite == .true. ã§ã‚ã‚Œã°ä¸Šæ›¸ãã—ã¦ç¶šè¡Œã—ã¾ã™ã€‚
  ! (ã¾ã  *overwrite* ã®å‹•ä½œã¯ä¿éšœã•ã‚Œã¦ã„ã¾ã›ã‚“)ã€‚
  ! dims ã®çœç•¥ã¯ 0 æ¬¡å…ƒå¤‰æ•°ã®è¨å®šã‚’æ„å‘³ã—ã¾ã™ã€‚
  !
  ! ä½œæˆã®éš›ã«ã‚¨ãƒ©ãƒ¼ãŒç”Ÿã˜ãŸå ´åˆã€ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã—ã¦ãƒ—ãƒã‚°ãƒ©ãƒ ã¯
  ! å¼·åˆ¶çµ‚äº†ã—ã¾ã™ã€‚*err* ã‚’ä¸Žãˆã¦ã‚ã‚‹å ´åˆã«ã¯ã“ã®å¼•æ•°ã« .true.
  ! ãŒè¿”ã‚Šã€ãƒ—ãƒã‚°ãƒ©ãƒ ã¯çµ‚äº†ã—ã¾ã›ã‚“ã€‚
  !
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory, &
    & map_create, gtvar_dump
  use gtdata_netcdf_generic, only: create, put_attr, inquire
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use dc_string, only: strhead
  use dc_error, only: StoreError, DC_NOERR, GT_EFAKE
  use dc_types, only: TOKEN
  use dc_trace, only: BeginSub, EndSub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(out):: var
  character(len = *), intent(in):: url
  type(GT_VARIABLE), intent(in), optional:: dims(:)
  character(len = *), intent(in), optional:: xtype
  character(len = *), intent(in), optional:: long_name
  logical, intent(in), optional:: overwrite
  logical, intent(out), optional:: err
  type(GD_NC_VARIABLE), allocatable:: gdnc_dims(:)
  type(GD_NC_VARIABLE):: gdnc
  integer, allocatable:: allcount(:)
  integer:: i, ndims, stat, cause_i
  character(len = TOKEN):: myxtype
  character(len = *),      parameter:: subname = "GTVarCreate"
  character(len = *),      parameter:: version = &
    & '$Name:  $' // &
    & '$Id: gtvarcreate.f90,v 1.4 2009-05-25 09:55:58 morikawa Exp $'
continue
  stat = DC_NOERR
  ndims = 0
  cause_i = 0
  if (present(dims)) ndims = size(dims)
  call BeginSub(subname, 'url=%c ndims=%d', c1=trim(url), i=(/ndims/), &
    & version=version)
  if (strhead(url, "memory:")) then
    ! ãƒ¡ãƒ¢ãƒªå¤‰æ•°ã®ä½œæˆ
    stat = GT_EFAKE
    goto 999
  else
    ! gdnc å¤‰æ•°ã®ä½œæˆ
    if (present(err)) err = .false.
    if (present(xtype)) then
      myxtype = xtype
    else
      myxtype = "float"
    endif
    if (present(dims)) then
      allocate(gdnc_dims(ndims), allcount(ndims))
      do, i = 1, ndims
        call var_class(dims(i), cid=gdnc_dims(i)%id)
        call DbgMessage('dim=%d mapid=%d -> cid=%d', i=(/i, dims(i)%mapid, gdnc_dims(i)%id/))
        call inquire(gdnc_dims(i), dimlen=allcount(i))
      enddo
      call create(var=gdnc, url=url, dims=gdnc_dims, xtype=myxtype, &
        & overwrite=overwrite, err=err)
    else
      ndims = 0
      allocate(gdnc_dims(1), allcount(1)) ! dummy
      call create(var=gdnc, url=url, dims=gdnc_dims(1:0), &
        & xtype=myxtype, overwrite=overwrite, err=err)
    endif
    call map_create(var, vtb_class_netcdf, gdnc%id, ndims, allcount, stat)
    if (stat /= DC_NOERR) then
      cause_i = ndims
      goto 999
    end if
    deallocate(gdnc_dims, allcount)
    if (present(long_name)) then
      call put_attr(gdnc, 'long_name', long_name, err=err)
    endif
  endif
  call gtvar_dump(var)
  call DbgMessage('var%%mapid=%d', i=(/var % mapid/))
999 continue
  call StoreError(stat, subname, err, cause_i=cause_i)
  call EndSub(subname)
end subroutine GTVarCreate