! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

! Create(var, url, copyfrom, [copyvalue], [overwrite], [err])
! は変数 copyfrom と同じ次元、属性を持った変数を作成する。
! 必要ならば次元変数も複製される。
! copyvalue を真に指定すると値も複製される。
!
! なお、次元変数の複製は copyfrom と url が異なるファイルに
! 載っている場合に行なわれる。これは netCDF/an を想定したものだが
! ほかのファイル形式が追加されたときには変更を要するかもしれない。

subroutine GTVarCreateCopyC(var, url, copyfrom, copyvalue, &
    & overwrite, err)
    use gtdata_types, only: GT_VARIABLE
    use dc_types, only: STRING
    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
    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
continue
    call beginsub('gtvarcreatecopy', 'url=%c copyfrom=%d', &
        & c1=trim(url), i=(/copyfrom%mapid/))
    stat = 0
    myerr = .FALSE.
    call Inquire(copyfrom, alldims=nd)
    allocate(vDimSource(nd), vDimDest(nd), stat=stat)
    if (stat /= 0) goto 999
    desturl = url
    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
    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 Create(var, trim(desturl), dims=vDimDest, 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_string, only: var_str
        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
        call beginsub('gtvarcopydim', 'from=%d target=<%c>', &
            & i=(/from%mapid/), c1=trim(target))
        call Inquire(var=from, url=url)
        if (var_str(url) .onthesamefile. var_str(target)) then
            call Open(to, from, dimord=0)
            call endsub('gtvarcopydim', 'dup-handle')
            return
        endif
        call UrlSplit(target, file=file)
        if (LookupEquivalent(to, from, file)) then
            call endsub('gtvarcopydim', 'equivalent-exists')
            return
        else
            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

    logical function LookupEquivalent(to, from, file) result(result)
        use dc_types, only: string
        use dc_string, only: var_str
        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
        logical:: end
        integer:: len1, len2
        call beginsub('lookupequivalent', 'from=%d file=<%c>', &
            & i=(/from%mapid/), c1=trim(file))
        result = .FALSE.
        call Inquire(from, allcount=len1)
        call get_attr(from, 'units', units1, default='')
        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)
            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
            endif
            result = .TRUE.
            call endsub('lookupequivalent', 'found')
            return
        enddo
        call endsub('lookupequivalent', 'not found')
    end function

    ! すでに存在する変数について、値をコピーする。
    !
    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

end subroutine
