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

!
! 次元変数 create
!
! create(var, url, xtype, length, [overwrite], [err]) は
! 長さ length の次元変数を作成する。
!
subroutine ANVarCreateD(var, url, xtype, length, overwrite, err)
    use an_types, only: AN_VARIABLE
    use dc_string
    use dc_url, only: UrlSplit
    use netcdf_f77, only: NF_NOERR, NF_REAL, NF_INT, NF_DOUBLE, &
        nf_def_var, nf_def_dim
    use an_file, only: ANFIleOpen, ANFileDefineMode
    use dc_error, only: StoreError, GT_ENOMEM
    implicit none
    type(AN_VARIABLE), intent(inout):: var
    character(len = *), intent(in):: url
    character(len = *), intent(in):: xtype
    integer, intent(in):: length
    logical, intent(in), optional:: overwrite
    logical, intent(out), optional:: err
    type(VSTRING):: filename, varname
    integer:: stat
    integer:: nc_xtype
    call UrlSplit(var_str(url), filename, varname)
    call ANFileOpen(var%fileid, filename, stat=stat, writable=.TRUE., &
        overwrite=overwrite)
    if (stat /= NF_NOERR) goto 999
    stat = ANFileDefineMode(var%fileid)
    if (stat /= NF_NOERR) goto 999
    nc_xtype = NF_REAL
    if (strieq(xtype, "double") .or. &
        & strieq(xtype, "DOUBLEPRECISION")) then
        nc_xtype = NF_DOUBLE
    endif
    if (strieq(xtype, "int") .or. strieq(xtype, "INTEGER")) then
        nc_xtype = NF_INT
    endif
    !
    stat = nf_def_dim(var%fileid, vchar(varname, len(varname)), len=length, &
        & dimid=var%dimid)
    if (stat /= NF_NOERR) goto 999
    stat = nf_def_var(var%fileid, vchar(varname, len(varname)), xtype=nc_xtype, &
        & ndims=1, dimids=(/var%dimid/), varid=var%varid)
    if (stat /= NF_NOERR) goto 999
    ! イテレータ初期化
    allocate(var%dimids(1), var%allcount(1), &
        & var%start(1), var%count(1), var%stride(1), stat=stat)
    if (stat /= 0) then
        stat = GT_ENOMEM
        goto 999
    endif
    var%dimids(1) = var%dimid
    var%start(1) = 1
    var%stride(1) = 1
    if (length /= 0) then
        var%allcount(1) = length
        var%count(1) = length
        var%growable = 0
    else
        var%allcount(1) = HUGE(1)
        var%count(1) = 1
        var%growable = 1
    endif
    ! その他成分
    var%attrid = 0
    ! エラーなし
    if (present(err)) err = .FALSE.
    return

999 continue
    call StoreError(stat, 'ANVarCreateD', err)
end subroutine
