!
!= å¤‰æ•°ã®ã‚³ãƒ”ãƒ¼
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: gtvarcreatecopy.f90,v 1.1 2009-03-20 09:09:51 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! ä»¥ä¸‹ã®ã‚µãƒ–ãƒ«ãƒ¼ãƒãƒ³, é–¢æ•°ã¯ gtdata_generic ã‹ã‚‰æä¾›ã•ã‚Œã¾ã™ã€‚
!

subroutine GTVarCreateCopyC(var, url, copyfrom, copyvalue, &
  & overwrite, err)
  !
  !== å¤‰æ•°ã®ã‚³ãƒ”ãƒ¼
  !
  ! å¤‰æ•° *copyfrom* ã¨åŒã˜æ¬¡å…ƒã€å±žæ€§ã‚’æŒã£ãŸå¤‰æ•°ã‚’ *url* ã«ä½œæˆã—ã¾ã™ã€‚
  ! å¿…è¦ãªã‚‰ã°æ¬¡å…ƒå¤‰æ•°ã‚‚è¤‡è£½ã•ã‚Œã¾ã™ã€‚
  ! *copyvalue* ã‚’ <tt>.true.</tt> ã«æŒ‡å®šã™ã‚‹ã¨å€¤ã‚‚è¤‡è£½ã•ã‚Œã¾ã™ã€‚
  ! ä½œæˆã•ã‚ŒãŸå¤‰æ•°ã® ID ã¯ var ã«è¿”ã•ã‚Œã¾ã™ã€‚
  !
  ! æ—¢å˜å¤‰æ•°ãŒã‚ã‚‹ã¨ãå¤±æ•—ã—ã¾ã™ãŒã€
  ! overwrite == .true. ã§ã‚ã‚Œã°ä¸Šæ›¸ãã—ã¦ç¶šè¡Œã—ã¾ã™ã€‚
  ! (ã¾ã  *overwrite* ã®å‹•ä½œã¯ä¿éšœã•ã‚Œã¦ã„ã¾ã›ã‚“)ã€‚
  !
  ! ä½œæˆã®éš›ã«ã‚¨ãƒ©ãƒ¼ãŒç”Ÿã˜ãŸå ´åˆã€ãƒ¡ãƒƒã‚»ãƒ¼ã‚¸ã‚’å‡ºåŠ›ã—ã¦ãƒ—ãƒã‚°ãƒ©ãƒ ã¯
  ! å¼·åˆ¶çµ‚äº†ã—ã¾ã™ã€‚*err* ã‚’ä¸Žãˆã¦ã‚ã‚‹å ´åˆã«ã¯ã“ã®å¼•æ•°ã« .true.
  ! ãŒè¿”ã‚Šã€ãƒ—ãƒã‚°ãƒ©ãƒ ã¯çµ‚äº†ã—ã¾ã›ã‚“ã€‚
  !
  !--
  ! ãªãŠã€æ¬¡å…ƒå¤‰æ•°ã®è¤‡è£½ã¯ copyfrom ã¨ url ãŒç•°ãªã‚‹ãƒ•ã‚¡ã‚¤ãƒ«ã«
  ! è¼‰ã£ã¦ã„ã‚‹å ´åˆã«è¡Œãªã‚ã‚Œã‚‹ã€‚ã“ã‚Œã¯ netCDF/an ã‚’æƒ³å®šã—ãŸã‚‚ã®ã ãŒ
  ! ã»ã‹ã®ãƒ•ã‚¡ã‚¤ãƒ«å½¢å¼ãŒè¿½åŠ ã•ã‚ŒãŸã¨ãã«ã¯å¤‰æ›´ã‚’è¦ã™ã‚‹ã‹ã‚‚ã—ã‚Œãªã„ã€‚
  !++
  !
  use gtdata_types, only: GT_VARIABLE
  use dc_types, only: STRING, TOKEN
  use gtdata_generic, only: Open, Inquire, Close, Create, Copy_Attr
  use dc_url, only: UrlSplit, GT_ATMARK
  use dc_trace, only: BeginSub, EndSub
  use dc_error, only: StoreError, GT_ENOMEM
  implicit none
  intrinsic trim
  type(GT_VARIABLE),    intent(out)   :: var
  character(len = *),   intent(in)    :: url
  type(GT_VARIABLE),    intent(inout) :: copyfrom
  logical, intent(in),  optional      :: copyvalue
  logical, intent(in),  optional      :: overwrite
  logical, intent(out), optional      :: err
  type(GT_VARIABLE),    allocatable   :: vDimSource(:)
  type(GT_VARIABLE),    allocatable   :: vDimDest(:)
  integer                             :: i, nd, stat
  logical                             :: myerr
  character(STRING)                   :: vpart, upart, desturl
  character(TOKEN)                    :: xtype
  character(len = *),      parameter:: version = &
    & '$Name:  $' // &
    & '$Id: gtvarcreatecopy.f90,v 1.1 2009-03-20 09:09:51 morikawa Exp $'
continue
  call BeginSub('gtvarcreatecopy', 'url=%c copyfrom=%d', &
    & c1=trim(url), i=(/copyfrom%mapid/), version=version)
  stat = 0
  myerr = .FALSE.
  !-----------------------------------------------------------------
  !  ã‚³ãƒ”ãƒ¼ã™ã‚‹å¤‰æ•°ã®æ¬¡å…ƒã‚’ã‚³ãƒ”ãƒ¼å…ˆã®ãƒ•ã‚¡ã‚¤ãƒ«ã«ä½œæˆ
  !-----------------------------------------------------------------
  !----- ã‚³ãƒ”ãƒ¼å…ƒ copyfrom ã®æ¬¡å…ƒå¤‰æ•°ã®å–å¾— -----
  call Inquire(copyfrom, alldims=nd)
  allocate(vDimSource(nd), vDimDest(nd), stat=stat)
  if (stat /= 0) goto 999
  desturl = url
  !----- ã‚³ãƒ”ãƒ¼å…ƒ copyfrom ã®å„æ¬¡å…ƒæƒ…å ±ã‚’ vDimSource ã«å–ã‚Šå‡ºã—, -----
  !----- ãã‚Œã‚’ã‚³ãƒ”ãƒ¼å…ˆ desturl ã¸ã‚³ãƒ”ãƒ¼ã—ã¦ãã®æ¬¡å…ƒ ID ã‚’       -----
  !----- vDimDest ã«è¿”ã—ã¦ã‚‚ã‚‰ã†.                                -----
  do, i = 1, nd
    call Open(vDimSource(i), copyfrom, dimord=i, &
      & count_compact=.TRUE., err=myerr)
    call GTVarCopyDim(to=vDimDest(i), from=vDimSource(i), &
      & target=desturl)
  end do
  !-----------------------------------------------------------------
  !  å¤‰æ•°ä½œæˆ
  !-----------------------------------------------------------------
  !----- url ã«å¤‰æ•°åãŒç„¡ã„å ´åˆ, ã‚³ãƒ”ãƒ¼å…ƒã®å¤‰æ•°åã‚’ä½¿ç”¨ -----
  call UrlSplit(url, var=vpart)
  if (vpart == "") then
    call Inquire(copyfrom, url=upart)
    call UrlSplit(upart, var=vpart)
    desturl = trim(desturl) // GT_ATMARK // trim(vpart)
  end if
  !----- å®Ÿéš›ã«å¤‰æ•°ä½œæˆ -----
  call Inquire(copyfrom, xtype=xtype)
  call Create(var, trim(desturl), dims=vDimDest, xtype=xtype, &
    &      overwrite=overwrite, err=myerr)
  if (myerr) goto 990
  call copy_attr(to=var, from=copyfrom, err=myerr)
  if (myerr) goto 990
  if (present(copyvalue)) then
    if (copyvalue) then
      call GTVarCopyValue(to=var, from=copyfrom)
    endif
  endif
  do, i = 1, nd
    call Close(vDimSource(i))
    call Close(vDimDest(i))
  end do
990 continue
  deallocate(vDimSource, vDimDest, stat=stat)
999 continue
  if (stat /= 0) then
    call StoreError(GT_ENOMEM, "GTVarCreateCopy", err)
  else if (present(err)) then
    err = myerr
  else if (myerr) then
    call DumpError
  end if
  call EndSub('gtvarcreatecopy', 'result=%d', i=(/var%mapid/))
contains

  ! from ã¨åŒã˜å†…å®¹ã®æ¬¡å…ƒå¤‰æ•°ã‚’ URL target ã§ç¤ºã•ã‚Œã‚‹å¤‰æ•°ã®ä½œæˆæ™‚ã«
  ! æ¬¡å…ƒã¨ã—ã¦ä½¿ãˆã‚‹ã‚ˆã†ã« to ã«è¤‡å†™ã€‚
  ! ãªã‚‹ã¹ãå†ã‚ªãƒ¼ãƒ—ãƒ³ã§æ¸ˆã¾ãã†ã¨ã™ã‚‹ã€‚
  ! è¤‡å†™ã™ã‚‹å ´åˆã‚‚ãªã‚‹ã¹ãæ¬¡å…ƒåã‚’åˆã‚ã›ã‚ˆã†ã¨ã™ã‚‹ã€‚
  !
  subroutine GTVarCopyDim(to, from, target)
    use gtdata_types
    use dc_types, only: token, string
    use dc_url, only: UrlSplit, UrlMerge, operator(.onthesamefile.)
    use gtdata_generic, only: Open, Inquire, Create, copy_attr
    type(GT_VARIABLE), intent(out):: to
    type(GT_VARIABLE), intent(inout):: from
    character(len = *), intent(in):: target
    character(len = string):: url, file, dimname
    character(len = token):: xtype
    logical:: growable, myerr
    integer:: length
  continue
    call BeginSub('gtvarcopydim', 'from=%d target=<%c>', &
      & i=(/from%mapid/), c1=trim(target))
    !----- åŒã˜ãƒ•ã‚¡ã‚¤ãƒ«ä¸Šã«ã‚³ãƒ”ãƒ¼ã™ã‚‹å ´åˆã¯å‚ç…§ã‚«ã‚¦ãƒ³ã‚¿ã‚’1ã¤å›žã™ã ã‘ -----
    call Inquire(var=from, url=url)
    if (trim(url) .onthesamefile. trim(target)) then
      call Open(to, from, dimord=0)
      call EndSub('gtvarcopydim', 'dup-handle')
      return
    endif
    !----- ç•°ãªã‚‹ãƒ•ã‚¡ã‚¤ãƒ«ä¸Šã«ã‚³ãƒ”ãƒ¼ã™ã‚‹å ´åˆ, æ—¢ã«æ¬¡å…ƒå¤‰æ•° from ãŒ -----
    !----- target ã®æ¬¡å…ƒå¤‰æ•°ã¨ã—ã¦å«ã¾ã‚Œã‚‹ã‹ãƒã‚§ãƒƒã‚¯              -----
    call UrlSplit(target, file=file)
    if (LookupEquivalent(to, from, file)) then
      !----- å«ã¾ã‚Œã‚‹å ´åˆã¯ãã‚Œã§çµ‚äº† -----
      call EndSub('gtvarcopydim', 'equivalent-exists')
      return
    else
      !----- å«ã¾ã‚Œãªã„å ´åˆæ¬¡å…ƒå¤‰æ•° from ã‚’ target ä¸Šã«ä½œæˆ -----
      ! æ¬¡å…ƒå¤‰æ•° from ãŒç„¡åˆ¶é™æ¬¡å…ƒã§ã‚ã‚‹å ´åˆã«ã¯é•·ã•ã‚’ 0 ã«
      call Inquire(var=from, growable=growable, allcount=length)
      if (growable) length = 0
      call Inquire(var=from, xtype=xtype, name=dimname)
      !
      url = urlmerge(file, dimname)
      call Create(to, trim(url), length, xtype, err=myerr)
      if (myerr) then
        ! æŒ‡å®šåç§°ã§ã†ã¾ãã„ã‹ãªã„å ´åˆã¯è‡ªå‹•ç”Ÿæˆåã«ã™ã‚‹
        call Create(to, trim(file), length, xtype)
      endif
      call copy_attr(to, from, myerr)
      call GTVarCopyValue(to, from)
      call EndSub('gtvarcopydim', 'created')
      return
    endif
  end subroutine GTVarCopyDim

  !-----------------------------------------------------------------
  !  ãƒ» æ¬¡å…ƒå¤‰æ•° from ãŒæ—¢ã« file ã«ã‚ã‚‹ã®ã‹ã‚’åˆ¤å®š
  !       æ¬¡å…ƒå¤‰æ•° from ãŒã‚³ãƒ”ãƒ¼å…ˆã® nc ãƒ•ã‚¡ã‚¤ãƒ« file ã«æ—¢ã«
  !       å˜åœ¨ã™ã‚‹ãªã‚‰ .TRUE. ã—ãªã„ãªã‚‰ .FALSE. ã‚’ result ã«è¿”ã™.
  !       result = .TRUE. ãŒè¿”ã‚‹å ´åˆã«ã¯ãã‚Œã«è©²å½“ã™ã‚‹æ¬¡å…ƒã® ID ã‚’
  !       to ã«è¿”ã™.
  !       - åˆ¤å®šæ¡ä»¶ã¯ 1) from ãŒç„¡åˆ¶é™æ¬¡å…ƒã§, file ã‚‚ç„¡åˆ¶é™æ¬¡å…ƒã‚’
  !         æŒã¤ã“ã¨, ã¾ãŸã¯ 2) æ¬¡å…ƒå¤‰æ•° from ã®ã‚µã‚¤ã‚ºã¨ä¸€è‡´ã™ã‚‹æ¬¡å…ƒãŒ
  !         file å†…ã«ã‚ã‚Š, ä¸”ã¤ãã®æ¬¡å…ƒã®å˜ä½åãŒ from ã®å˜ä½åã¨ä¸€è‡´
  !         ã™ã‚‹ã“ã¨.
  !         â€» ã‚‚ã—ã‹ã™ã‚‹ã¨æ¡ä»¶ãŒè¶³ã‚Šãªã„ã‹ã‚‚çŸ¥ã‚Œãªã„.
  !-----------------------------------------------------------------
  logical function LookupEquivalent(to, from, file) result(result)
    use dc_types, only: string
    use dc_string, only: toChar
    use gtdata_generic, only: Inquire, GTVarSearch, Open, get_attr
    type(GT_VARIABLE), intent(out):: to
    type(GT_VARIABLE), intent(in):: from
    character(len = *), intent(in):: file
    character(len = string):: url, units1, units2, reason
    logical:: end, growable1, growable2
    integer:: len1, len2
    character(len = *), parameter:: subnam = "lookupequivalent"
    call BeginSub(subnam, 'from=%d file=<%c>', &
      & i=(/from%mapid/), c1=trim(file))
    result = .FALSE.
    !----- æ¬¡å…ƒå¤‰æ•° from ã®ã‚µã‚¤ã‚ºã¨å˜ä½, ç„¡åˆ¶é™æ¬¡å…ƒã‹ã©ã†ã‹ã‚’æŽ¢æŸ» -----
    call Inquire(from, allcount=len1, growable=growable1)
    call get_attr(from, 'units', units1, default='')
    !----- ã‚³ãƒ”ãƒ¼å…ˆ file ã®å¤‰æ•°æƒ…å ±ã‚’æŽ¢æŸ» -----
    ! ã¨ã‚Šã‚ãˆãšã¯æ¬¡å…ƒã ã‘ã§ãªãå…¨ã¦ã®å¤‰æ•°ã«ã¤ã„ã¦é–‹ã
    call GTVarSearch(file)
    do
      call GTVarSearch(url, end)
      if (end) exit
      call Open(to, url, writable=.TRUE., err=end)
      if (end) exit
      ! æ¬¡å…ƒå¤‰æ•°ã®ã‚µã‚¤ã‚ºã¨, ç„¡åˆ¶é™æ¬¡å…ƒã‹ã©ã†ã‹ã‚’å–å¾—
      !   (æ¬¡å…ƒå¤‰æ•°ã§ãªã„ã‚‚ã®ã®ã‚µã‚¤ã‚ºã¯, ä¾å˜ã™ã‚‹æ¬¡å…ƒå¤‰æ•°ã®ã‚µã‚¤ã‚ºã‚’
      !    æŽ›ã‘åˆã‚ã›ãŸã‚‚ã®ã¨ãªã‚‹ã®ã§, ã‚‚ã—ã‹ã™ã‚‹ã¨èª¤å‹•ä½œã™ã‚‹ã‹ã‚‚).
      call Inquire(to, allcount=len2, growable=growable2)
      ! æ¬¡å…ƒå¤‰æ•° from ãŒç„¡åˆ¶é™æ¬¡å…ƒã§, ä¸”ã¤ file å†…ã®æ¬¡å…ƒå¤‰æ•°ã‚‚
      ! ç„¡åˆ¶é™æ¬¡å…ƒã®å ´åˆã¯, åŒã˜æ¬¡å…ƒå¤‰æ•°ã¨è€ƒãˆã‚‹.
      if (.not. growable1 .or. .not. growable2) then
        ! æ¬¡å…ƒå¤‰æ•° from ã®ã‚µã‚¤ã‚ºã¨ file å†…ã®æ¬¡å…ƒå¤‰æ•°ã®ã‚µã‚¤ã‚ºãŒ
        ! ç•°ãªã‚‹å ´åˆã¯ã‚¹ã‚ãƒƒãƒ—
        if (len1 /= len2) then
          call Close(to)
          cycle
        endif
        call get_attr(to, 'units', units2, default='')
        ! æœ¬å½“ã¯ dc_units ã§æ¯”è¼ƒã™ã¹ãã ãŒã¨ã‚Šã‚ãˆãšæ–‡å—åˆ—æ¯”è¼ƒ
        if (units1 /= units2) then
          call Close(to)
          cycle
        else
          reason = 'length of from is ' // trim(toChar(len1)) // &
            &   '. units of from is ' // "[" //               &
            &   trim(units1) // "]" //                        &
            &   '. And file has same length and units.'
        endif
      else
        reason = 'from is UNLIMITED dimension, and file has it'
      endif
      result = .TRUE.
      call EndSub(subnam, 'found (%c)', c1=trim(reason))
      return
    enddo
    call EndSub(subnam, 'not found')
  end function LookupEquivalent

  ! ã™ã§ã«å˜åœ¨ã™ã‚‹å¤‰æ•°ã«ã¤ã„ã¦ã€å€¤ã‚’ã‚³ãƒ”ãƒ¼ã™ã‚‹ã€‚
  !
  subroutine GTVarCopyValue(to, from)
    use gtdata_types, only: GT_VARIABLE
    use gtdata_generic, only: GTVarGetReal, GTVarPutReal, Inquire, Slice, Slice_Next
    use dc_error, only: DumpError
    use dc_string
    type(GT_VARIABLE), intent(inout):: to
    type(GT_VARIABLE), intent(inout):: from
    real, allocatable:: rbuffer(:)
    logical:: err
    integer:: siz, stat
    !
    call BeginSub('gtvarcopyvalue')
    ! å€¤ã®ã‚³ãƒ”ãƒ¼
    call Slice(from)
    call Slice(to, compatible=from)
    call Inquire(from, size=siz)
    allocate (rbuffer(siz))
    do
      call GTVarGetReal(from, rbuffer, siz, err)
      if (err) call DumpError()
      call GtVarPutReal(to, rbuffer, siz, err)
      if (err) call DumpError()
      call Slice_Next(from, stat=stat)
      if (stat /= 0) exit
      call Slice_Next(to, stat=stat)
    enddo
    deallocate (rbuffer)
    call EndSub('gtvarcopyvalue')
  end subroutine GTVarCopyValue

end subroutine GTVarCreateCopyC