!== Open GT_VARIABLE of dimension by dimord
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: gtvaropenbydimord.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 ã‹ã‚‰æä¾›ã•ã‚Œã¾ã™ã€‚
!

subroutine GTVarOpenByDimOrd(var, source_var, dimord, count_compact, err)
  !
  !== gtool4 ãƒ‡ãƒ¼ã‚¿ã®ã‚ªãƒ¼ãƒ—ãƒ³
  !
  ! æ—¢ã«é–‹ã‹ã‚ŒãŸå¤‰æ•° *source_var* ã® *dimord* ç•ªç›®ã®æ¬¡å…ƒã«ã‚ãŸã‚‹å¤‰æ•°ã‚’
  ! é–‹ã var ã«æ ¼ç´ã—ã¾ã™ã€‚é †åº *dimord* ã¯ç¾åœ¨ã®å…¥å‡ºåŠ›ç¯„å›²ãŒ
  ! å¹…ï¼‘ã«ãªã£ã¦ã„ã‚‹ (ã‚³ãƒ³ãƒ‘ã‚¯ãƒˆåŒ–ã—ã¦ã„ã‚‹) ã‚’é£›ã°ã—ãŸ
  ! é †åºã§ã‚ã™ãŒã€*count_compact* ã« <tt>.true.</tt>ã‚’æŒ‡å®šã™ã‚‹ã¨
  ! ã™ã¹ã¦ã®æ¬¡å…ƒã®ãªã‹ã®é †åºã«ãªã‚Šã¾ã™ã€‚
  !
  ! Open ã•ã‚ŒãŸå¤‰æ•°ã¯å¿…ãš Close ã•ã‚Œãªã‘ã‚Œã°ãªã‚Šã¾ã›ã‚“ã€‚
  !
  ! *dimord* == 0 ã®å ´åˆã¯å¤‰æ•°è‡ªä½“ã‚’å†åº¦é–‹ãã¾ã™ã€‚ã“ã‚Œã¯å‚ç…§ã‚«ã‚¦ãƒ³ã‚¿ã‚’
  ! å¢—åŠ ã•ã›ã‚‹æ‰‹æ®µã§ã™ã€‚
  !
  ! *Open* ã¯ 2 ã¤ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®ç·ç§°åã§ã‚ã‚Šã€
  ! å¤‰æ•° URL ã‚’ç›´æŽ¥æŒ‡å®šã™ã‚‹ã“ã¨ã§é–‹ãã“ã¨ã‚‚å¯èƒ½ã§ã™ã€‚
  ! ä¸‹è¨˜ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã‚’å‚ç…§ãã ã•ã„ã€‚
  !
  !=== è£œè¶³
  !
  ! å¤‰æ•° URL ã«ãƒ•ã‚¡ã‚¤ãƒ«åéƒ¨ã‚’æŒ‡å®šã—ãªã„å ´åˆã€gtool.nc ã§ã‚ã‚‹ã¨ã¿ãªã•ã‚Œã¾ã™ã€‚
  !
  ! å¤‰æ•° URL ã«ãƒ•ã‚¡ã‚¤ãƒ«åã ã‘ã‚’æŒ‡å®šã—ãŸå ´åˆã€é–‹ã‹ã‚Œã‚‹å¤‰æ•°ã¯ä»¥ä¸‹ã®è¦å‰‡
  ! ã§é¸æŠžã•ã‚Œã¾ã™ã€‚
  !
  ! * æ¬¡å…ƒå¤‰æ•°ã¯é¸æŠžã•ã‚Œãªã„
  ! * ãªã‚‹ã¹ãå…ˆã«å®šç¾©ã•ã‚ŒãŸå¤‰æ•°ãŒé¸æŠžã•ã‚Œã‚‹
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: var_class, vtb_class_netcdf, vtb_class_memory, &
    & map_dup, map_create, map_lookup, GT_DIMMAP, &
    & map_set, dimord_skip_compact
  use gtdata_netcdf_generic, only: Open, Inquire
  use gtdata_netcdf_types, only: GD_NC_VARIABLE
  use gtdata_generic, only: gt_open => open
  use dc_present, only: present_and_true
  use dc_trace, only: beginsub, endsub, DbgMessage
  use dc_string, only: CPrintf
  use dc_error, only: StoreError, GT_ENOMOREDIMS, GT_ENOMOREDIMS, &
    & DC_NOERR, GT_EFAKE
  use dc_types, only: STRING
  implicit none
  type(GT_VARIABLE), intent(out):: var
  type(GT_VARIABLE), intent(in):: source_var
  integer, intent(in):: dimord
  logical, intent(in), optional:: count_compact
  logical, intent(out), optional:: err
  integer:: sclass, scid, ld, sndims, stat, udimord, idimord, cause_i
  type(GD_NC_VARIABLE):: gdnc
  type(GT_DIMMAP), allocatable:: map_src(:)
  type(GT_DIMMAP):: map_result(1)
  logical:: cnt_compact
  character(STRING) :: endsub_msg
  character(len = *),      parameter:: subname = "GTVarOpen-By-Dimord"
  character(len = *),      parameter:: version = &
    & '$Name:  $' // &
    & '$Id: gtvaropenbydimord.f90,v 1.5 2009-07-04 04:58:06 morikawa Exp $'
continue
  call beginsub(subname, 'var.mapid=%d dimord=%d ', &
    & i=(/source_var%mapid, dimord/), version=version)
  stat = DC_NOERR
  cause_i = dimord
  endsub_msg = ''

  ! å¤‰æ•°ãã‚Œè‡ªä½“ã‚’é–‹ãç›´ã™å‡¦ç†
  if (dimord == 0) then
    call map_dup(var, source_var)
    if (present(err)) err = .false.
    endsub_msg = 'dup'
    goto 999
  endif

  ! è¡¨ã‚’å¼•ãã€dimord ç•ª (count_compact ã«æ³¨æ„) ã®æ¬¡å…ƒã®å†…éƒ¨å¤‰æ•°
  ! æ¬¡å…ƒç•ªå·ã‚’èª¿ã¹ã‚‹ã€‚
  call map_lookup(source_var, ndims=sndims)
  if (sndims <= 0 .or. dimord > sndims) then
    stat = GT_ENOMOREDIMS
    goto 999
  endif
  allocate(map_src(sndims))
  call map_lookup(source_var, map=map_src)
  cnt_compact = .false.
  if (present_and_true(count_compact)) then
    cnt_compact = .true.
  else
    cnt_compact = .false.
  end if
  call DbgMessage('count_compact=%y', l=(/cnt_compact/))

  if (cnt_compact) then
    udimord = dimord
  else
    udimord = dimord_skip_compact(dimord, map=map_src)
  endif
  if (udimord <= 0 .or. udimord > size(map_src)) then
    stat = GT_ENOMOREDIMS
    goto 999
  endif

  idimord = map_src(udimord)%dimno
  if (idimord < 1) then
    call gt_open(var, map_src(udimord)%url, err=err)
    ! storeerror ã¯ã—ãªãã¦ã‚ˆã„
    deallocate(map_src)
    goto 999
  endif

  ! å®Ÿæ…‹ç¨®åˆ¥ã«åˆã‚ã›ã€Œæ¬¡å…ƒå¤‰æ•°ã‚ªãƒ¼ãƒ—ãƒ³ã€å‡¦ç†
  call var_class(source_var, sclass, scid)
  if (sclass == vtb_class_netcdf) then
    call Open(gdnc, GD_NC_VARIABLE(scid), idimord, err)
    call inquire(gdnc, dimlen=ld)
    call map_create(var, vtb_class_netcdf, gdnc%id, 1, (/ld/), stat)
    if (stat /= DC_NOERR) then
      cause_i = 1
      goto 999
    end if
    call map_lookup(var, map=map_result)
    map_result(1)%offset = map_src(udimord)%offset
    map_result(1)%step = map_src(udimord)%step
    map_result(1)%allcount = map_src(udimord)%allcount
    map_result(1)%start = map_src(udimord)%start
    map_result(1)%count = map_src(udimord)%count
    map_result(1)%stride = map_src(udimord)%stride
    call map_set(var, map=map_result, stat=stat)
  else if (sclass == vtb_class_memory) then
    var = source_var
    stat = DC_NOERR
  else
    stat = GT_EFAKE
  endif

  deallocate(map_src)
  endsub_msg = CPrintf('result_var=%d', i=(/var%mapid/))
999 continue
  call StoreError(stat, subname, cause_i=cause_i, err=err)
  call endsub(subname, '%c', c1=trim(endsub_msg))
end subroutine GTVarOpenByDimOrd