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

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

subroutine GTVarCreateCopy(var, url, copyfrom, copyvalue, &
    & overwrite, err)
    use gtdata_types, only: GT_VARIABLE
    use dc_string, only: VSTRING, vchar, len, STRING_MAX, assignment(=), &
        & operator(==), operator(//)
    use gtdata_generic, only: Open, Inquire, Close, Create
    use dc_url, only: UrlSplit, GT_ATMARK
    use dc_error
    implicit none
    intrinsic trim
    type(GT_VARIABLE), intent(out):: var
    type(VSTRING), 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
    type(VSTRING):: vpart, upart
    character(STRING_MAX):: desturl
    stat = 0
    myerr = .FALSE.
    call Inquire(copyfrom, alldims=nd)
    allocate(vDimSource(nd), vDimDest(nd), stat=stat)
    if (stat /= 0) goto 999
    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=url)
    end do
    desturl = url
    call UrlSplit(url, var=vpart)
    if (vpart == "") then
        call Inquire(copyfrom, url=upart)
        call UrlSplit(upart, var=vpart)
        desturl = trim(desturl) // GT_ATMARK // vpart
    end if
    call Create(var, trim(desturl), dims=vDimDest, err=myerr)
    if (myerr) goto 990
    if (present(copyvalue)) then
        call GTVarCopyValue(to=var, from=copyfrom)
    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
contains

    ! from と同じ内容の変数を URL target で示される変数の作成時に
    ! 次元として使えるように to に複写。
    ! なるべく再オープンで済まそうとする。
    subroutine GTVarCopyDim(to, from, target)
        use gtdata_types
        use dc_string
        use dc_url, only: UrlSplit, operator(.onthesamefile.)
        use gtdata_generic, only: Open, Inquire, Create
        type(GT_VARIABLE), intent(out):: to
        type(GT_VARIABLE), intent(inout):: from
        type(VSTRING), intent(in):: target
        type(VSTRING):: xtype, url, file
        integer:: length
        call Inquire(var=from, url=url)
        if (url .onthesamefile. target) then
            call Open(to, from, dimord=0)
            return
        endif
        call UrlSplit(target, file=file)
        if (LookupEquivalent(to, from, file)) then
            return
        else
            call Inquire(var=from, xtype=xtype, allcount=length)
            if (length < 0) length = 0
            ! ファイル名だけを与えたら新規作成時は変数名を自動生成
            call Create(to, vchar(file, len(file)), &
                & length, vchar(xtype, len(xtype)))
            call GTVarCopyValue(to, from)
            return
        endif
    end subroutine

    logical function LookupEquivalent(to, from, file) result(result)
        use dc_string
        use gtdata_generic, only: Inquire, GTVarSearch
        type(GT_VARIABLE), intent(out):: to
        type(GT_VARIABLE), intent(in):: from
        type(VSTRING), intent(in):: file
        type(VSTRING):: url
        logical:: end
        integer:: len1, len2
        result = .FALSE.
        call Inquire(from, allcount=len1)
        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
            result = .TRUE.
            return
        enddo
    end function

    ! すでに存在する変数について、値と属性をコピーする。
    !
    subroutine GTVarCopyValue(to, from)
        use gtdata_types, only: GT_VARIABLE
        use gtdata_generic, only: GTVarGetReal, GTVarPutReal, &
            Attr_Rewind, Attr_Next, Copy_Attr, Inquire, Slice, Slice_Next
        use dc_error, only: DumpError
        use dc_string
        type(GT_VARIABLE), intent(inout):: to
        type(GT_VARIABLE), intent(inout):: from
        type(VSTRING):: aname
        real, allocatable:: rbuffer(:)
        logical:: err, end
        integer:: siz, stat
        ! 属性のコピー
        call Attr_Rewind(from)
        do
            call Attr_Next(from, aname, end)
            if (end) exit
            call Copy_Attr(to=to, attrname=vchar(aname, len(aname)), &
                & from=from, err=err)
            if (err) call DumpError()
        enddo
        ! 値のコピー
        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)
    end subroutine

end subroutine
