gtvarinquire.f90

subroutine GTVarInquire(var, growable, rank, alldims, allcount,  size, xtype, name, url)

    implicit none
    type(gt_variable), intent(in):: var
    ! 外部型の名前
    character(len=*), intent(out), optional:: xtype
    ! name は変数名の最小の単位を返す。
    ! ファイル名を含まないためプログラム内での一意性は保証されない。
    character(len=*), intent(out), optional:: name
    ! url はファイル名のついた変数名を返す。プログラム内で
    ! 一意である。
    character(len=*), intent(out), optional:: url
    ! コンパクト(縮退)次元を数えない, 次元の数
    integer, intent(out), optional:: rank
    ! 縮退次元を含む全次元数。dimord には基本的にこちらを使う
    integer, intent(out), optional:: alldims
    ! 変数が次元変数である場合、総数を返す。エラーはゼロ。
    integer, intent(out), optional:: allcount
    ! 変数の入出力領域の大きさ。(変数が依存する各次元の長さ[格子点数]の積)
    integer, intent(out), optional:: size
    ! growable: 変数が次元変数である場合、自動拡張可能か否かを返す。
    ! 次元変数でない場合は不定。
    logical, intent(out), optional:: growable
    integer:: class, cid
continue
    call beginsub('gtvarinquire', 'var.mapid=%d', i=(/var%mapid/))
    call var_class(var, class, cid)
    select case(class)
    case(vtb_class_netcdf)
        if (present(xtype) .or. present(name) .or. present(url)) then
            call inquire(an_variable(cid), xtype=xtype, name=name, url=url)
            if (present(xtype)) call DbgMessage('xtype=%c', c1=trim(xtype))
            if (present(name)) call DbgMessage('name=%c', c1=trim(name))
            if (present(url)) call DbgMessage('url=%c', c1=trim(url))
        endif
        if (present(growable)) then
            call inquire(an_variable(cid), growable=growable)
            call DbgMessage('growable=%y', L=(/growable/))
        endif
    case(vtb_class_memory)
        call DbgMessage('vtb_class_memory not implemented: skipped')
    end select
    if (present(alldims)) alldims = internal_get_alldims(var)
    if (present(allcount)) allcount = internal_get_allcount(var)
    if (present(size)) size = internal_get_size(var)
    if (present(rank)) rank = internal_get_rank(var)
    call endsub('gtvarinquire')
    return
contains

    integer function internal_get_alldims(var) result(result)

        implicit none
        type(gt_variable), intent(in):: var
        call map_lookup(var, ndims=result)
        call DbgMessage('alldims=%d', i=(/result/))
    end function

    integer function internal_get_allcount(var) result(result)

        implicit none
        type(gt_variable), intent(in):: var
        type(gt_dimmap), allocatable:: map(:)
        integer:: nd
!!$        intrinsic size
        call map_lookup(var, ndims=nd)
        if (nd <= 0) then
            call DbgMessage('internal_get_allcount: no map')
            result = 1
            return
        endif
        allocate(map(nd))
        call map_lookup(var, map=map)
        result = product(map(1:nd)%allcount)
        call DbgMessage('internal_get_allcount: %d map.size=%d',  i=(/result, nd/))
        deallocate(map)
    end function

    integer function internal_get_size(var) result(result)

        implicit none
        type(gt_variable), intent(in):: var
        type(gt_dimmap), allocatable:: map(:)
        integer:: nd
!!$        intrinsic size
        call map_lookup(var, ndims=nd)
        if (nd <= 0) then
            call DbgMessage('internal_get_size: no map')
            result = 1
            return
        endif
        allocate(map(nd))
        call map_lookup(var, map=map)
        result = product(map(1:nd)%count)
        call DbgMessage('internal_get_size: %d map.size=%d',  i=(/result, nd/))
        deallocate(map)
    end function

    integer function internal_get_rank(var) result(result)

        implicit none
        type(gt_variable), intent(in):: var
        type(gt_dimmap), allocatable:: map(:)
        integer:: nd

        call map_lookup(var, ndims=nd)
        if (nd <= 0) then
            call DbgMessage('internal_get_rank: no map')
            result = 1
            return
        endif
        allocate(map(nd))
        call map_lookup(var, map=map)
        result = count(map(1:nd)%count > 1)
        call DbgMessage('internal_get_rank: %d', i=(/result/))
        deallocate(map)
    end function

end subroutine

subroutine GTVarInquireA(var, attrname, xtype)

    type(GT_VARIABLE), intent(in):: var
    character(len=*), intent(in):: attrname
    character(len=*), intent(out), optional:: xtype
    integer:: class, cid
    character(len = *), parameter:: subnam = "gtvarinquireA"
continue
    call beginsub(subnam, "%c", c1=trim(attrname))
    call var_class(var, class, cid)
    select case(class)
    case(vtb_class_netcdf)
        call inquire(an_variable(cid), attrname=attrname, xtype=xtype)
    end select
    call endsub(subnam)
end subroutine

subroutine GTVarInquireD(var, dimord, url, allcount)

    implicit none
    type(GT_VARIABLE), intent(in):: var
    integer, intent(in):: dimord
    character(len=*), intent(out), optional:: url
    integer, intent(out), optional:: allcount
    type(GT_VARIABLE):: dimvar
    character(len = *), parameter:: subnam = "gtvarinquireD"
continue
    call beginsub(subnam, "%d", i=(/dimord/))
    call open(dimvar, source_var=var, dimord=dimord)
    if (present(url)) call inquire(dimvar, url=url)
    if (present(allcount)) call inquire(dimvar, allcount=allcount)
    call close(dimvar)
    call endsub(subnam)
end subroutine