anvarcreate.f90

subroutine ANVarCreate(var, url, xtype, dims, overwrite, err)
    use an_types, only: AN_VARIABLE, an_variable_entry, an_variable_search
    use dc_types, only: string
    use dc_string, only: strieq
    use an_vartable, only: vtable_add, vtable_lookup
    use an_file, only: ANFileOpen, ANFileDefineMode
    use dc_url, only: UrlSplit
    use dc_trace, only: beginsub, endsub, DbgMessage
    use an_generic, only: toString ! for debug
    use netcdf_f77, only: NF_NOERR, nf_def_var, NF_REAL, NF_INT, NF_DOUBLE,         NF_EBADDIM, nf_inq_unlimdim
    use dc_error, only: StoreError, GT_ENOMEM, GT_EOTHERFILE,         GT_EDIMNODIM, GT_EDIMMULTIDIM
    implicit none
    type(AN_VARIABLE), intent(out):: var
    character(len = *), intent(in):: url
    character(len = *), intent(in):: xtype
    type(AN_VARIABLE), intent(in):: dims(:)
    logical, intent(in), optional:: overwrite
    logical, intent(out), optional:: err
    type(an_variable_search):: ent
    type(an_variable_entry):: ent_dim
    character(len = string):: filename, varname
    integer, allocatable:: dimids(:)
    integer:: stat, nvdims, i
    integer:: nc_xtype
    logical:: clobber
    intrinsic trim
    character(len = *), parameter:: subnam = "anvarcreate"
continue
    clobber = .false.
    if (present(overwrite)) clobber = overwrite
    call beginsub(subnam)
    call DbgMessage('url=%c', c1=trim(url))
    call DbgMessage('xtype=%c', c1=trim(xtype))
    call DbgMessage('dims=(/%*d/)', i=dims(:)%id, n=(/size(dims)/))
    call DbgMessage('ovwr=%y', L=(/clobber/))

    ! もし必要ならファイル作成
    call UrlSplit(url, filename, varname)
    call ANFileOpen(ent%fileid, filename, stat=stat, writable=.TRUE.,         overwrite=clobber)
    if (stat /= NF_NOERR) goto 999

    ! 次元にまつわる準備
    nvdims = size(dims)
    allocate(dimids(max(1, nvdims)), stat=stat)
    if (stat /= 0) goto 990
    do, i = 1, nvdims
        stat = vtable_lookup(dims(i), ent_dim)
        if (stat /= NF_NOERR) then
            stat = NF_EBADDIM
            goto 999
        endif
        if (ent%fileid /= ent_dim%fileid) then
            stat = GT_EOTHERFILE
            goto 999
        endif
        if (ent_dim%dimid <= 0) then
            stat = GT_EDIMMULTIDIM
            goto 999
        endif
        dimids(i) = ent_dim%dimid
    enddo
    ent%dimid = 0

    ! 変数の型の判定
    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 = ANFileDefineMode(ent%fileid)
    if (stat /= NF_NOERR) goto 999
    stat = nf_def_var(ent%fileid, trim(varname),  xtype=nc_xtype, ndims=nvdims, dimids=dimids, varid=ent%varid)
    if (stat /= NF_NOERR) goto 999

    ! 登録
    stat = vtable_add(var, ent)
    if (stat /= NF_NOERR) goto 999
    call StoreError(stat, subnam, err, cause_c=url)
    call endsub(subnam, 'varid=%d', i=(/var%id/))
    return

990 continue
    stat = GT_ENOMEM
999 continue
    var = an_variable(-1)
    call StoreError(stat, subnam, err, cause_c=url)
    call endsub(subnam, 'error=%d', i=(/stat/))
end subroutine