!
!= 蜈･蜃ｺ蜉帷ｯ�峇縺ｮ諡俶據
!
! Authors::   Eizi TOYODA, Yasuhiro MORIKAWA
! Version::   $Id: gtvarlimit.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#Limit
! 縺ｨ縺励※謠蝉ｾ帙＆繧後∪縺吶�

subroutine GTVarLimit_iiii(var, dimord, start, count, stride, err)
  !
  !== 蜈･蜃ｺ蜉帷ｯ�峇縺ｮ諡俶據 (謨ｰ蛟､縺ｧ謖�ｮ�)
  !
  ! 螟画焚 *var* 谺｡蜈��蜈･蜃ｺ蜉帷ｯ�峇繧呈鋸譚溘＠縺ｾ縺吶�
  ! Limit 繧貞他縺ｳ蜃ｺ縺励◆蠕後〒縺ｯ Slice 縺ｧ縺昴�遽�峇縺ｮ螟悶↓蜈･蜃ｺ蜉帷ｯ�峇繧�
  ! 險ｭ螳壹〒縺阪↑縺上↑繧翫∪縺吶ゅ％繧後↓繧医ｊ縲∝､画焚蜈ｨ菴薙〒縺ｯ縺ｪ縺丈ｸ驛ｨ繧�
  ! Slice_Next 繧ｵ繝悶Ν繝ｼ繝√Φ繧堤畑縺�※襍ｰ譟ｻ縺ｧ縺阪ｋ繧医≧縺ｫ縺ｪ繧翫∪縺吶�
  !
  ! 謖�ｮ壽婿豕輔�縲∝､画焚 *var* 縺ｮ *dimord* 逡ｪ逶ｮ縺ｮ谺｡蜈�ｒ蝓ｺ轤ｹ *start*,
  ! 譬ｼ蟄千ｷ乗焚 *count* 髢馴囈 *stride* 縺ｫ髯仙ｮ壹＠縺ｾ縺吶�
  ! 縺薙�縺ゅ→縺ｧ縺ｯ縲√せ繝ｩ繧､繧ｹ謖�ｮ壹�隨ｬ1譬ｼ蟄舌� *start* 逡ｪ逶ｮ縺ｮ譬ｼ蟄舌ｒ
  ! 謖�､ｺ縺吶ｋ縺薙→縺ｫ縺ｪ繧翫√せ繝ｩ繧､繧ｹ謖�ｮ壹〒縺ｮ譬ｼ蟄先焚縺ｯ *count* 蛟九ｒ
  ! 雜翫∴繧九％縺ｨ縺後〒縺阪↑縺上↑繧翫√せ繝ｩ繧､繧ｹ謖�ｮ壹〒髢灘ｼ輔″縺ｪ縺励ｒ謖�ｮ壹☆繧九→
  ! *stride* 蛟九＃縺ｨ縺ｮ謖�ｮ壹ｒ謖�､ｺ縺吶ｋ縺薙→縺ｫ縺ｪ繧翫∪縺吶�
  !
  ! 繧ｨ繝ｩ繝ｼ縺檎函縺倥◆蝣ｴ蜷医√Γ繝�そ繝ｼ繧ｸ繧貞�蜉�
  ! 縺励※繝励Ο繧ｰ繝ｩ繝�縺ｯ蠑ｷ蛻ｶ邨ゆｺ�＠縺ｾ縺吶�*err* 繧剃ｸ弱∴縺ｦ縺ゅｋ蝣ｴ蜷医↓縺ｯ
  ! 縺ｮ蠑墓焚縺ｫ .true. 縺瑚ｿ斐ｊ縲√�繝ｭ繧ｰ繝ｩ繝�縺ｯ邨ゆｺ�＠縺ｾ縺帙ｓ縲�
  !
  ! *Limit* 縺ｯ 2 縺､縺ｮ繧ｵ繝悶Ν繝ｼ繝√Φ縺ｮ邱冗ｧｰ蜷阪〒縺ゅｊ縲�
  ! 莉悶↓繧� {gtool4 netCDF 隕冗ｴм[link:../xref.htm#label-6] 縺ｮ
  ! 縲�5.4 繧ｳ繝ｳ繝櫁ｨ俶ｳ輔阪ｒ逕ｨ縺�※謖�ｮ壹☆繧九％縺ｨ繧ょ庄閭ｽ縺ｧ縺吶�
  ! 荳玖ｨ倥�繧ｵ繝悶Ν繝ｼ繝√Φ繧貞盾辣ｧ縺励※縺上□縺輔＞縲�
  !
  use gtdata_types, only: GT_VARIABLE
  use gtdata_internal_map, only: map_lookup, gt_dimmap, dimrange, map_set
  use dc_error, only: dc_noerr, NF90_EINVAL, storeerror
  use dc_trace, only: beginsub, endsub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(inout):: var
  integer, intent(in)             :: dimord
  integer, intent(in) , optional  :: start, count, stride
  logical, intent(out), optional  :: err
  type(gt_dimmap), allocatable:: map(:)
  integer:: iolo, iohi, uilo, uihi, lowerlim, upperlim, dimlo, dimhi
  integer:: ndims, stat

  stat = NF90_EINVAL
  call beginsub('GTVarLimit_iiii', &
    & 'var%d-dim%d start=%d count=%d stride=%d', &
    & i=(/var%mapid, dimord, start, count, stride/))
  ! 繧ｨ繝ｩ繝ｼ繝√ぉ繝�け
  if (dimord < 1) then
    print *, "dimord =", dimord, " < 1"
    goto 999
  endif
  if (stride == 0) then
    print *, "stride == 0"
    goto 999
  endif
  call map_lookup(var, ndims=ndims)
  if (ndims <= 0) then
    print *, "ndims =", ndims, " <= 0"
    goto 999
  endif
  if (dimord > ndims) then
    print *, "dimrod =", dimord, " > ndims =", ndims
    goto 999
  endif
  if (allocated(map)) then
    deallocate(map)
  end if
  allocate(map(ndims))
  call map_lookup(var, map=map)
  ! (/lowerlim, upperlim/) 縺ｯ蜀�Κ譬ｼ蟄舌�遽�峇 (髯埼��庄)
  lowerlim = min(start, start + (count - 1) * stride)
  upperlim = max(start, start + (count - 1) * stride)
  call dimrange(var, dimord, dimlo, dimhi)
  if (lowerlim < dimlo) then
    print *, "lowerlim = ", lowerlim, " < dimlo =", dimlo
    goto 999
  endif
  if (upperlim > dimhi) then
    print *, "upperlim = ", upperlim, " < dimhi =", dimhi
    goto 999
  endif

  call DbgMessage('@ lowerlim=%d upperlim=%d', i=(/lowerlim, upperlim/))

  ! 蜈･蜃ｺ蜉帷ｯ�峇繧貞�驛ｨ譬ｼ蟄千分蜿ｷ縺ｫ螟峨∴縺ｦ縺翫￥
  uilo = map(dimord)%start
  iolo = 1 + map(dimord)%step * (uilo - 1) + map(dimord)%offset
  uihi = map(dimord)%start + (map(dimord)%count - 1) * map(dimord)%stride
  iohi = 1 + map(dimord)%step * (uihi - 1) + map(dimord)%offset

  call DbgMessage('@ userindex=%d %d, internal=%d %d', &
    & i=(/uilo, uihi, iolo, iohi/))
  call DbgMessage('@ DbgMessage offset %d -> %d step=%d', &
    & i=(/map(dimord)%offset, (start-1), stride/))

  ! 蛻ｶ髯舌ｒ隱ｲ縺吶Ｐffset 縺悟､峨ｏ繧後�繝ｦ繝ｼ繧ｶ譬ｼ蟄千分蜿ｷ縺ｮ諢丞袖縺悟､峨ｏ繧�
  map(dimord)%offset = start - 1
  map(dimord)%allcount = count
  map(dimord)%step = stride

  ! 蜈･蜃ｺ蜉帷ｯ�峇繧貞�驛ｨ譬ｼ蟄千分蜿ｷ縺九ｉ繝ｦ繝ｼ繧ｶ譬ｼ蟄千分蜿ｷ縺ｫ謌ｻ縺�
  uilo = 1 + (iolo - 1 - map(dimord)%offset) / map(dimord)%step
  uihi = 1 + (iohi - 1 - map(dimord)%offset) / map(dimord)%step
  call DbgMessage('@ userindex=%d %d', i=(/uilo, uihi/))

  ! 縺昴ｌ縺槭ｌ縺ｯ蛻ｶ髯� [1 .. allcount] 縺ｮ荳ｭ縺ｫ縺ｪ縺代ｌ縺ｰ縺ｪ繧峨↑縺�
  uilo = max(1, min(map(dimord)%allcount, uilo))
  uihi = max(1, min(map(dimord)%allcount, uihi))

  call DbgMessage('@ userindex=%d %d orig_stride=%d', &
    & i=(/uilo, uihi, map(dimord)%stride/))

  ! 蜈��繧ｹ繝医Λ繧､繝峨�隨ｦ蜿ｷ縺ｯ辟｡隕悶＠縲∵ｭ｣縺ｫ蝗ｺ螳壹☆繧�
  map(dimord)%stride = max(1, abs(map(dimord)%stride))
  map(dimord)%start = min(uilo, uihi)
  map(dimord)%count = 1 + abs(uihi - uilo) / map(dimord)%stride

  call map_set(var, map, stat)
  if (stat /= 0) call DbgMessage("map_set fail")

999 continue
  call storeerror(stat, 'GTVarLimit_iiii', err)
  call endsub('GTVarLimit_iiii')
end subroutine GTVarLimit_iiii

! 螟画焚 var 縺ｫ string 縺ｫ繧医ｋ繝槭ャ繝玲桃菴懊ｒ陦後≧縲�
! string 縺ｯ繧ｳ繝ｳ繝槭〒蛹ｺ蛻�ｉ繧後◆螟画鋤謖�ｮ壹�蛻励〒縺ゅｋ縲�
! 螟画鋤謖�ｮ壹�鬆伜沺險ｭ螳壹→谺｡蜈���ｺ丞､画鋤縺ｮ縺ｩ縺｡繧峨°縺ｧ縺ゅｋ縲�
! 鬆伜沺險ｭ螳壹�闍ｱ謨ｰ蟄励〒蟋九∪繧九ｂ縺ｮ縺ｧ縲�<dim>=<lower>, <dim>=<lower>:<upper>,
!   <dim>=<lower>:<upper>:<stride> 縺ｮ繧医≧縺ｪ蠖｢蠑上〒縺ゅｋ縲�
!   縺薙％縺ｧ縲‥im 縺ｯ谺｡蜈�分蜿ｷ縺ｾ縺溘�谺｡蜈�錐縺ｧ縺ゅｊ縲�<lower>, <upper>
!   縺ｯ ^ 繧貞燕鄂ｮ縺励◆蠎ｧ讓吝叉蛟､縺ｾ縺溘�譬ｼ蟄千分蜿ｷ縺ｧ縺ゅｋ縲�
!   <stride> 縺ｯ譬ｼ蟄先焚縺ｧ縺ゅｋ縲�
! (譛ｪ螳溯｣�) 谺｡蜈���ｺ丞､画鋤縺ｯ = 縺ｧ蟋九∪繧九ｂ縺ｮ縺ｧ縲�
!   IGN:<dim>=<pos>
! 縺ｮ蠖｢諷九ｒ縺ｨ繧九�

subroutine GTVarLimit(var, string, err)
  !
  !== 蜈･蜃ｺ蜉帷ｯ�峇縺ｮ諡俶據 (譁�ｭ怜�縺ｧ謖�ｮ�)
  !
  ! 螟画焚 *var* 谺｡蜈��蜈･蜃ｺ蜉帷ｯ�峇繧呈鋸譚溘＠縺ｾ縺吶�
  ! *Limit* 縺ｯ 2 縺､縺ｮ繧ｵ繝悶Ν繝ｼ繝√Φ縺ｮ邱冗ｧｰ蜷阪〒縺ゅｊ縲�
  ! 蛻･縺ｮ謖�ｮ壽婿豕輔ｂ縺ゅｊ縺ｾ縺吶ゅ∪縺壹�荳願ｨ倥�繧ｵ繝悶Ν繝ｼ繝√Φ繧貞盾辣ｧ縺励※縺上□縺輔＞縲�
  !
  ! 謖�ｮ壽婿豕輔�縲�*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* 繧剃ｸ弱∴縺ｦ縺ゅｋ蝣ｴ蜷医↓縺ｯ
  ! 縺ｮ蠑墓焚縺ｫ .true. 縺瑚ｿ斐ｊ縲√�繝ｭ繧ｰ繝ｩ繝�縺ｯ邨ゆｺ�＠縺ｾ縺帙ｓ縲�
  !
  use gtdata_types, only: GT_VARIABLE
  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), optional   :: err
  integer:: is, ie
continue
  call beginsub('GTVarLimit', '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: ))
  if (present(err)) err = .false.
  call endsub('GTVarLimit')
  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
    use gtdata_generic, only: del_dim, dimname_to_dimord, limit
    character(len = *), intent(in):: string
    integer:: equal, dimord
    integer:: start, count, stride, strhead
    logical:: myerr

    if (string == '') return

    strhead = 4
    if (len(string) < 4) strhead = len(string)

    if (strieq(string(1:strhead), "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 limit(var, dimord, start, 1, 1, err)
      call del_dim(var, dimord, myerr)
      return
    endif

    ! 髯仙ｮ壼梛謖�ｮ壼ｭ� <dim>=<start>:<finish>:<stride>
    ! 縺�∪縺ｯ螳溯｣�′繝舌げ縺｣縺ｦ縺�※ <start>:<count>:<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 limit(var, dimord, start, count, stride, err)
  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)
    !
    ! GTVarLimit 縺ｮ蠑墓焚 *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(:) => null()
    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.)
    nullify(axisval)
    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', '(%c) = %r', &
      & c1=trim(value), r=(/result/))
    deallocate(axisval)
  end function value_to_index

end subroutine GTVarLimit