!
!= å…¥å‡ºåŠ›ç¯„å›²ã®æŒ‡å®š
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: gtvarslice.f90,v 1.3 2009-05-25 09:55:57 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#Slice
! ã¨ã—ã¦æä¾›ã•ã‚Œã¾ã™ã€‚

subroutine GTVarSlice(var, dimord, start, count, stride)
  !
  !== å…¥å‡ºåŠ›ç¯„å›²ã‚’æ•°å€¤ã§æŒ‡å®š
  !
  ! å¤‰æ•° *var* ã®å…¥å‡ºåŠ›ç¯„å›²ã‚’æŒ‡å®šã—ã¾ã™ã€‚
  !
  ! å¤‰æ•° *var* ã® *dimord* ç•ªç›®ã®æ¬¡å…ƒã®å…¥å‡ºåŠ›ç¯„å›²ã‚’ *start* ã‹ã‚‰
  ! *stride* å€‹ãŠãã« *count* å€‹ã¨ã—ã¾ã™ã€‚*start*, *count*,
  ! *stride* ã®ã„ãšã‚Œã‚’çœç•¥ã—ã¦ã‚‚ <b>1</b> ãŒä»®å®šã•ã‚Œã¾ã™ã€‚æˆåŠŸã—
  ! ãŸã‹å¦ã‹ã‚’è¿”ã™å¼•æ•°ã¯ã‚ã‚Šã¾ã›ã‚“ã€‚ä»®ã«æŒ‡å®šã§ããªã„ç¯„å›²ãŒæŒ‡å®šã•
  ! ãŸå ´åˆã«ã¯ã€æŒ‡å®šç¯„å›²ã‚’å«ã‚€ãªã‚‹ã¹ãåºƒã„ç¯„å›²ã‚’è¨å®šã—ã¾ã™ã€‚
  !
  ! *Slice* ã¯è¤‡æ•°ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®ç·ç§°åã§ã‚ã‚Šã€
  ! ä»–ã«ã‚‚æ–‡å—åˆ—ã‚„ç•ªå·ã§æŒ‡å®šã™ã‚‹æ–¹æ³•ãŒã‚ã‚Šã¾ã™ã€‚
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_vartable, only: query_growable
  use gtdata_internal_map, only: map_lookup, map_set, gt_dimmap, gtvar_dump
  use dc_error, only: NF90_ENOTVAR, StoreError
  use dc_trace, only: beginsub, endsub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, intent(in):: dimord
  integer, intent(in), optional:: start
  integer, intent(in), optional:: count
  integer, intent(in), optional:: stride
  type(gt_dimmap), allocatable:: map(:)
  integer:: vid, maxindex, maxcount, nd, stat
  logical:: growable_dimension
continue
  call beginsub('GTVarSlice', 'var%%mapid=%d dimord=%d', &
    & i=(/var%mapid, dimord/))
  call gtvar_dump(var)
  call map_lookup(var, vid=vid, ndims=nd)
  if (vid < 0) then
    call StoreError(NF90_ENOTVAR, "GTVarSlice")
  endif

  if (vid > 0) then
    call query_growable(vid, growable_dimension)
  else
    growable_dimension = .false.
  endif

  if (nd == 0) goto 999
  allocate(map(nd))
  call map_lookup(var, map=map)

  if (dimord <= 0 .or. dimord > size(map)) goto 998

  call DbgMessage('map(dimord): originally start=%d count=%d stride=%d', &
    & i=(/map(dimord)%start, map(dimord)%count, map(dimord)%stride/))
  if (.not. growable_dimension) then
    maxindex = map(dimord)%allcount
    call DbgMessage('maxindex=%d', i=(/maxindex/))
  endif

  if (present(start)) then
    if (start < 0) then
      map(dimord)%start = max(1, maxindex + 1 + start)
    else if (growable_dimension) then
      map(dimord)%start = max(1, start)
    else
      map(dimord)%start = min(maxindex, max(1, start))
    endif
    call DbgMessage('start=%d (%d specified)', i=(/map(dimord)%start, start/))
  endif

  if (present(stride)) then
    map(dimord)%stride = stride
    if (stride == 0) map(dimord)%stride = 1
    call DbgMessage('stride=%d (%d specified)', &
      & i=(/map(dimord)%stride, stride/))
  endif

  if (present(count)) then
    map(dimord)%count = abs(count)
    if (count == 0) map(dimord)%count = 1
    call DbgMessage('count=%d (%d specified)', &
      & i=(/map(dimord)%count, count/))
  endif

  if (.not. growable_dimension) then
    maxcount = 1 + (maxindex - map(dimord)%start) / map(dimord)%stride
    map(dimord)%count = max(1, min(maxcount, map(dimord)%count))
    call DbgMessage('count=%d ', i=(/map(dimord)%count/))
  endif
  call map_set(var, map, stat)
  if (stat /= 0) goto 998

  call endsub('GTVarSlice')
  deallocate(map)
  return

998 continue
  deallocate(map)
999 continue
  call endsub('GTVarSlice', 'err skipped')
end subroutine GTVarSlice

subroutine GTVarSliceC(var, string, err)
  !
  !== å…¥å‡ºåŠ›ç¯„å›²ã‚’æ–‡å—åˆ—ã§æŒ‡å®š
  !
  ! å¤‰æ•° *var* ã®å…¥å‡ºåŠ›ç¯„å›²ã‚’ã€*string* ã«å¿œã˜ã¦æŒ‡å®šã—ã¾ã™ã€‚
  ! *string* ã«ã¯ {gtool4 netCDF è¦ç´„}[link:../xref.htm#label-6] ã®
  ! ã€Œ5.4 ã‚³ãƒ³ãƒžè¨˜æ³•ã€ã«è¿°ã¹ã‚‰ã‚Œã‚‹ç¯„å›²æŒ‡å®šè¡¨ç¾ã‚’ç”¨ã„ã¾ã™ã€‚
  ! å‡¡ä¾‹ã‚’ä»¥ä¸‹ã«æŒ™ã’ã¾ã™ã€‚
  !
  !     <dim>=<lower>
  !
  !     <dim>=<lower>:<upper>
  !
  !     <dim>=<lower>:<upper>:<stride>
  !
  ! ã“ã“ã§ã€<tt><dim></tt> ã¯æ¬¡å…ƒç•ªå·ã¾ãŸã¯æ¬¡å…ƒåã§ã‚ã‚Šã€
  ! <tt><lower></tt>, <tt><upper></tt>
  ! ã¯åº§æ¨™å€¤ã¾ãŸã¯ "<tt>^</tt>" ã‚’å‰ç½®ã—ãŸæ ¼åç•ªå·ã§ã™ã€‚
  ! <tt><stride></tt> ã¯æ ¼åæ•°ã§ã™ã€‚
  !
  ! ç¾åœ¨ *err* ã¯å¿…ãš <tt>.false.</tt> ã‚’è¿”ã™ã“ã¨ã«ãªã£ã¦ã„ã¾ã™ã€‚
  !
  ! *Slice* ã¯è¤‡æ•°ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³ã®ç·ç§°åã§ã‚ã‚Šã€
  ! ä»–ã«ã‚‚æ–‡å—åˆ—ã‚„ç•ªå·ã§æŒ‡å®šã™ã‚‹æ–¹æ³•ãŒã‚ã‚Šã¾ã™ã€‚
  !
  !
  !
  !--
  ! å¤‰æ•° var ã« string ã«ã‚ˆã‚‹ãƒžãƒƒãƒ—æ“ä½œã‚’è¡Œã†ã€‚
  ! string ã¯ã‚³ãƒ³ãƒžã§åŒºåˆ‡ã‚‰ã‚ŒãŸå¤‰æ›æŒ‡å®šã®åˆ—ã§ã‚ã‚‹ã€‚
  ! å¤‰æ›æŒ‡å®šã¯é ˜åŸŸè¨å®šã¨æ¬¡å…ƒé †åºå¤‰æ›ã®ã©ã¡ã‚‰ã‹ã§ã‚ã‚‹ã€‚
  ! é ˜åŸŸè¨å®šã¯è‹±æ•°å—ã§å§‹ã¾ã‚‹ã‚‚ã®ã§ã€<dim>=<lower>, <dim>=<lower>:<upper>,
  !   <dim>=<lower>:<upper>:<stride> ã®ã‚ˆã†ãªå½¢å¼ã§ã‚ã‚‹ã€‚
  !   ã“ã“ã§ã€dim ã¯æ¬¡å…ƒç•ªå·ã¾ãŸã¯æ¬¡å…ƒåã§ã‚ã‚Šã€<lower>, <upper>
  !   ã¯ ^ ã‚’å‰ç½®ã—ãŸåº§æ¨™å³å€¤ã¾ãŸã¯æ ¼åç•ªå·ã§ã‚ã‚‹ã€‚
  !   <stride> ã¯æ ¼åæ•°ã§ã‚ã‚‹ã€‚
  ! (æœªå®Ÿè£…) æ¬¡å…ƒé †åºå¤‰æ›ã¯ = ã§å§‹ã¾ã‚‹ã‚‚ã®ã§ã€
  !   IGN:<dim>=<pos>
  ! ã®å½¢æ…‹ã‚’ã¨ã‚‹ã€‚
  !++
  !
  use gtdata_types,   only: GT_VARIABLE
  use gtdata_generic, only: slice
  use dc_trace,       only: beginsub, endsub
  use dc_url,         only: GT_COMMA
  use gtdata_internal_map,         only: gtvar_dump
  type(GT_VARIABLE),  intent(inout) :: var
  character(len = *), intent(in)    :: string
  logical,            intent(out)   :: err
  integer:: is, ie
continue
  call beginsub('GTVarSliceC', 'var=%d lim=<%c>', &
    & i=(/var%mapid/), c1=trim(string))
  call gtvar_dump(var)
  ! ã‚³ãƒ³ãƒžã§åŒºåˆ‡ã£ã¦è§£é‡ˆ
  is = 1
  do
    ie = index(string(is: ), GT_COMMA)
    if (ie == 0) exit
    call limit_one(string(is: is+ie-2))
    is = is + ie
    if (is > len(string)) exit
  enddo
  call limit_one(string(is: ))
  err = .false.
  call endsub('GTVarSliceC')
  return
contains

  subroutine limit_one(string)
    use dc_url, only: gt_equal
    use dc_string, only: strieq, stoi
    use gtdata_generic, only: del_dim, dimname_to_dimord
    character(len = *), intent(in):: string
    integer:: equal, dimord
    integer:: start, count, stride
    logical:: myerr

    if (string == '') return

    if (strieq(string(1:4), "IGN:")) then
      ! éš è”½åž‹æŒ‡å®šå ign:<dim> ã¾ãŸã¯ ign:<dim>=<start>
      equal = index(string, gt_equal)
      if (equal == 0) then
        start = 1
      else
        start = stoi(string(equal+1: ), default=1)
      endif
      dimord = dimname_to_dimord(var, string(5: equal-1))
      call slice(var, dimord, start, 1, 1)
      call del_dim(var, dimord, myerr)
      return
    endif

    ! é™å®šåž‹æŒ‡å®šå <dim>=<start>:<finish>:<stride>
    !
    equal = index(string, gt_equal)
    if (equal == 0) return
    dimord = dimname_to_dimord(var, string(1: equal-1))
    if (dimord <= 0) return
    !
    call region_spec(dimord, string(equal+1: ), start, count, stride)
    call slice(var, dimord, start, count, stride)
  end subroutine limit_one

  !
  ! ç¯„å›²æŒ‡å®šã® = ã®ã‚ã¨ã‚’ : ã§åŒºåˆ‡ã£ã¦ãƒžãƒƒãƒ—ã«ã„ã‚Œã‚‹
  !
  subroutine region_spec(dimord, string, start, count, stride)
    use dc_types, only: token
    use dc_string, only: index_ofs, stoi
    use dc_url, only: gt_circumflex, gt_colon
    use gtdata_internal_map, only: dimrange
    integer, intent(in):: dimord
    integer, intent(out):: start, count, stride
    character(len = *), intent(in):: string
    integer:: colon, prev_colon, finish, dimlo, dimhi
    character(len = token):: val(3)
  continue
    colon = index(string, gt_colon)
    if (colon == 0) then
      ! ã‚³ãƒãƒ³ãŒãªã„å ´åˆã¯ä¸Šä¸‹ç«¯ã«åŒã˜å€¤
      val(1) = string(1: )
      val(2) = val(1)
      val(3) = ""
    else
      val(1) = string(1: colon - 1)
      prev_colon = colon
      colon = index_ofs(string, colon + 1, gt_colon)
      if (colon > 0) then
        val(2) = string(prev_colon + 1: colon - 1)
        val(3) = string(colon + 1: )
      else
        val(2) = string(prev_colon + 1: )
        val(3) = ""
      endif
    endif
    if (val(3) == "") val(3) = "^1"

    if (val(1)(1:1) == gt_circumflex) then
      start = stoi(val(1)(2: ))
    else if (val(1) == val(2)) then
      start = nint(value_to_index(dimord, val(1)))
    else
      start = floor(value_to_index(dimord, val(1)))
    endif
    if (val(2) == val(1)) then
      finish = start
    else if (val(2)(1:1) == gt_circumflex) then
      finish = stoi(val(2)(2: ))
    else
      finish = ceiling(value_to_index(dimord, val(2)))
    endif

    call dimrange(var, dimord, dimlo, dimhi)
    start = min(max(dimlo, start), dimhi)
    finish = min(max(dimlo, finish), dimhi)
    count = abs(finish - start) + 1

    if (val(3)(1:1) == gt_circumflex) then
      stride = stoi(val(3)(2: ))
    else
      stride = stoi(val(3))
    endif
    stride = sign(stride, finish - start)
  end subroutine region_spec

  real function value_to_index(dimord, value) result(result)
    !
    ! GTVarSlice ã®å¼•æ•° *var* ã«æ ¼ç´ã•ã‚Œã‚‹å¤‰æ•°ã®æ¬¡å…ƒ *dimord*
    ! ã«æ ¼ç´ã•ã‚Œã‚‹ãƒ‡ãƒ¼ã‚¿ã®ã†ã¡, *value* ãŒæ ¼ç´ã•ã‚Œã‚‹
    ! æ ¼åç•ªå·ã‚’æ•´æ•°å€¤ã«ã—ã¦è¿”ã—ã¾ã™.
    !
    ! ä¾‹ãˆã°æ¬¡å…ƒã«ä»¥ä¸‹ã®ãƒ‡ãƒ¼ã‚¿ãŒæ ¼ç´ã•ã‚Œã¦ã„ã‚‹ã¨ã—ã¾ã™.
    !
    !     0.05  0.1  0.15  0.20  0.25  0.30
    !
    ! ã“ã®å ´åˆ, *value* ã« 0.15 ãŒä¸Žãˆã‚‰ã‚Œã‚Œã°æˆ»ã‚Šå€¤ã¯ 3. ã¨ãªã‚Šã¾ã™.
    ! ã¾ãŸ *value* ã« 0.225 ãŒä¸Žãˆã‚‰ã‚Œã‚Œã°æˆ»ã‚Šå€¤ã¯ 4.5 ã¨ãªã‚Šã¾ã™.
    !
    !
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: get, open, close
    use dc_string, only: stod
    use dc_trace, only: beginsub, endsub, DbgMessage
    integer, intent(in):: dimord
    character(len = *), intent(in):: value
    type(GT_VARIABLE):: axisvar
    real, pointer:: axisval(:)
    real:: val
    integer:: i
  continue
    call beginsub('value_to_index', 'var=%d dimord=%d value=%c', &
      & i=(/var%mapid, dimord/), c1=trim(value))

    call Open(axisvar, var, dimord, count_compact=.true.)
    call Get(axisvar, axisval)
    call Close(axisvar)
    if (.not. associated(axisval)) then
      result = -1.0
      return
    else if (size(axisval) < 2) then
      result = 1.0
      goto 900
    endif

    val = stod(value)

    ! call DbgMessage('value=%f axis=(/%*r/)', r=(/val, axisval(:)/), &
    !    & n=(/size(axisval)/))

    do, i = 1, size(axisval) - 1
      if (axisval(i + 1) == axisval(i)) then
        result = real(i) + 0.5
        goto 900
      endif
      result = i + (val - axisval(i)) / (axisval(i + 1) - axisval(i))
      if (result <= (i + 1)) goto 900
    enddo

900 continue
    call endsub('value_to_index', 'value(%c) =~ index(%r)', &
      & c1=trim(value), r=(/result/))
    deallocate(axisval)
  end function value_to_index

end subroutine GTVarSliceC