! gtvargetattr.f90 - 数値型属性の入力
! Copyright (C) GFD Dennou Club, 2000.  All rights reserved.

! 引数の型に応じていろいろあるが、どうせ下部構造では同じモノを使っている。

! スカラで受け取るのが一番簡単。解釈可能な値がとられ、残りは捨てられる。

subroutine GTVarGetAttrR(var, attrname, value, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    use netcdf_f77, only: NF_FILL_REAL
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: attrname
    real, intent(out):: value
    real, intent(in), optional:: default
    integer:: stat
    real:: buffer(1)
    if (associated(var%an)) then
        call get_attr(var%an, attrname, value=buffer, &
            & stat=stat, default=default)
        value = buffer(1)
        if (stat >= 1) return
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrR")
    endif
    value = NF_FILL_REAL
    if (present(default)) value = default
end subroutine

subroutine GTVarGetAttrD(var, attrname, value, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    use netcdf_f77, only: NF_FILL_REAL
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: attrname
    double precision, intent(out):: value
    double precision, intent(in), optional:: default
    integer:: stat
    double precision:: buffer(1)
    if (associated(var%an)) then
        call get_attr(var%an, attrname, value=buffer, &
            & stat=stat, default=default)
        value = buffer(1)
        if (stat >= 1) return
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrR")
    endif
    value = NF_FILL_REAL
    if (present(default)) value = default
end subroutine

subroutine GTVarGetAttrI(var, attrname, value, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use netcdf_f77, only: NF_FILL_INT
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: attrname
    integer, intent(out):: value
    integer, intent(in), optional:: default
    integer:: stat
    integer:: buffer(1)
    if (associated(var%an)) then
        call get_attr(var%an, attrname, buffer, stat, default)
        value = buffer(1)
        if (stat >= 1) return
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrI")
    endif
    value = NF_FILL_INT
    if (present(default)) value = default
end subroutine

! ポインタ配列を使って受け取る場合は解釈可能な数だけ実体が割り付けられる。

subroutine GTVarGetAttrRP(var, name, value)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    real, pointer:: value(:)
    integer:: stat
    if (associated(var%an)) then
        allocate(value(1))
        call get_attr(var%an, name, value(1:0), stat)
        deallocate(value)
        if (stat < 1) return
        allocate(value(stat))
        call get_attr(var%an, name, value, stat)
        if (stat < 1) deallocate(value)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrRP")
    endif
end subroutine

subroutine GTVarGetAttrDP(var, name, value)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    double precision, pointer:: value(:)
    integer:: stat
    if (associated(var%an)) then
        allocate(value(1))
        call get_attr(var%an, name, value(1:0), stat)
        deallocate(value)
        if (stat < 1) return
        allocate(value(stat))
        call get_attr(var%an, name, value, stat)
        if (stat < 1) deallocate(value)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrRP")
    endif
end subroutine

subroutine GTVarGetAttrIP(var, name, value)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    integer, pointer:: value(:)
    integer:: stat
    if (associated(var%an)) then
        allocate(value(1))
        call get_attr(var%an, name, value(1:0), stat)
        deallocate(value)
        if (stat < 1) return
        allocate(value(stat))
        call get_attr(var%an, name, value, stat)
        if (stat < 1) deallocate(value)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrIP")
    endif
end subroutine

! integer 配列, real 配列として受け取る
! 場合は属性長があまっている場合には切り捨てられ、
! 属性長が足りない場合は default 値 (ポインタと違い必須) を埋める。

subroutine GTVarGetAttrRA(var, name, value, stat, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    real, intent(out):: value(:)
    integer, intent(out):: stat
    real, intent(in), optional:: default
    if (associated(var%an)) then
        call get_attr(var%an, name, value, stat, default)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrRA")
    endif
end subroutine

subroutine GTVarGetAttrDA(var, name, value, stat, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    double precision, intent(out):: value(:)
    integer, intent(out):: stat
    double precision, intent(in), optional:: default
    if (associated(var%an)) then
        call get_attr(var%an, name, value, stat, default)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrRA")
    endif
end subroutine

subroutine GTVarGetAttrIA(var, name, value, stat, default)
    use gtdata_types, only: GT_VARIABLE
    use an_generic, only: get_attr
    use dc_error
    type(GT_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    integer, intent(out):: value(:)
    integer, intent(out):: stat
    integer, intent(in), optional:: default
    if (associated(var%an)) then
        call get_attr(var%an, name, value, stat, default)
    else
        call StoreError(GT_ENOTVAR, "GTVarGetAttrIA")
    endif
end subroutine
