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

! お客様向きではないけれど、情報落ちのないインターフェイスということで....
! stat < 0:  エラー、あるいはその属性は存在しなかった
! stat = 0 ... size(value):  その属性を全部読み取った。サイズは stat 個
! stat > size(value):  配列長不足のため属性が全部読み取れなかった。
!                      サイズは stat 個必要

subroutine ANVarGetAttrRA(var, name, value, stat, default)
    use an_types, only: AN_VARIABLE
    use netcdf_f77
    use dc_url, only: GT_PLUS
    use an_generic, only: get_attr
    use dc_string
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    real, intent(out):: value(:)
    integer, intent(out):: stat
    real, intent(in), optional:: default
    real, allocatable:: rbuffer(:)
    type(VSTRING):: sbuffer
    type(STRING_LIST):: lbuffer
    integer:: attrlen, xtype, i, xferend
continue
    ! 型と長さを知る
    if (name(1:1) == GT_PLUS) then
        stat = nf_inq_att(var%fileid, NF_GLOBAL, name(2:), xtype=xtype, len=attrlen)
    else
        stat = nf_inq_att(var%fileid, var%varid, name, xtype=xtype, len=attrlen)
    endif
    if (stat /= NF_NOERR) then
        if (present(default)) value(:) = default
        return
    endif
    ! 文字型の場合は長さをコンマで分解した語数と読み替える
    if (xtype == NF_CHAR) then
        call get_attr(var, name, sbuffer)
        call Split(lbuffer, sbuffer, ", ")
        attrlen = len(lbuffer)
    endif
    ! 結果を入れるところがなければ長さだけを伝え終了
    if (size(value) == 0) then
        if (xtype == NF_CHAR) call dispose(lbuffer)
        stat = attrlen
        return
    endif
    ! 型に応じて要求されただけ値を転送
    xferend = min(size(value), attrlen)
    if (present(default)) value(xferend+1: ) = default
    if (xtype == NF_CHAR) then
        do, i = 1, xferend
            value(i) = stod(element(lbuffer, i))
        enddo
        stat = attrlen
        return
! なぜか以下のようにすると value が読み取れない
!    else if (attrlen <= size(value)) then
!        stat = nf_get_att_real(var%fileid, var%varid, name, value)
!        if (stat == NF_NOERR) stat = attrlen
!        return
    else
        allocate(rbuffer(attrlen), stat=stat)
        if (stat /= 0) then
            stat = NF_ENOMEM
            return
        endif
        if (name(1:1) == GT_PLUS) then
            stat = nf_get_att_real(var%fileid, NF_GLOBAL, name(2:), rbuffer)
        else
            stat = nf_get_att_real(var%fileid, var%varid, name, rbuffer)
        endif
        if (stat == NF_NOERR) then
            value(1:xferend) = rbuffer(1:xferend)
            stat = attrlen
        endif
        deallocate(rbuffer)
        return
    endif
end subroutine

subroutine ANVarGetAttrDA(var, name, value, stat, default)
    use an_types, only: AN_VARIABLE
    use netcdf_f77
    use dc_url, only: GT_PLUS
    use an_generic, only: get_attr
    use dc_string
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    double precision, intent(out):: value(:)
    integer, intent(out):: stat
    double precision, intent(in), optional:: default
    double precision, allocatable:: rbuffer(:)
    type(VSTRING):: sbuffer
    type(STRING_LIST):: lbuffer
    integer:: attrlen, xtype, i, xferend
continue
    ! 型と長さを知る
    if (name(1:1) == GT_PLUS) then
        stat = nf_inq_att(var%fileid, NF_GLOBAL, name(2:), xtype=xtype, len=attrlen)
    else
        stat = nf_inq_att(var%fileid, var%varid, name, xtype=xtype, len=attrlen)
    endif
    if (stat /= NF_NOERR) then
        if (present(default)) value(:) = default
        return
    endif
    ! 文字型の場合は長さをコンマで分解した語数と読み替える
    if (xtype == NF_CHAR) then
        call get_attr(var, name, sbuffer)
        call Split(lbuffer, sbuffer, ", ")
        attrlen = len(lbuffer)
    endif
    ! 結果を入れるところがなければ長さだけを伝え終了
    if (size(value) == 0) then
        if (xtype == NF_CHAR) call dispose(lbuffer)
        stat = attrlen
        return
    endif
    ! 型に応じて要求されただけ値を転送
    xferend = min(size(value), attrlen)
    if (present(default)) value(xferend+1: ) = default
    if (xtype == NF_CHAR) then
        do, i = 1, xferend
            value(i) = stod(element(lbuffer, i))
        enddo
        stat = attrlen
        return
! なぜか以下のようにすると value が読み取れない
!    else if (attrlen <= size(value)) then
!        stat = nf_get_att_double(var%fileid, var%varid, name, value)
!        if (stat == NF_NOERR) stat = attrlen
!        return
    else
        allocate(rbuffer(attrlen), stat=stat)
        if (stat /= 0) then
            stat = NF_ENOMEM
            return
        endif
        if (name(1:1) == GT_PLUS) then
            stat = nf_get_att_double(var%fileid, NF_GLOBAL, name(2:), rbuffer)
        else
            stat = nf_get_att_double(var%fileid, var%varid, name, rbuffer)
        endif
        if (stat == NF_NOERR) then
            value(1:xferend) = rbuffer(1:xferend)
            stat = attrlen
        endif
        deallocate(rbuffer)
        return
    endif
end subroutine

subroutine ANVarGetAttrIA(var, name, value, stat, default)
    use an_types, only: AN_VARIABLE
    use netcdf_f77
    use an_generic, only: get_attr
    use dc_string
    use dc_url, only: GT_PLUS
    type(AN_VARIABLE), intent(in):: var
    character(len = *), intent(in):: name
    integer, intent(out):: value(:)
    integer, intent(out):: stat
    integer, intent(in), optional:: default
    integer, allocatable:: ibuffer(:)
    type(VSTRING):: sbuffer
    type(STRING_LIST):: lbuffer
    integer:: attrlen, xtype, i, xferend
continue
    ! 型と長さを知る
    if (name(1:1) == GT_PLUS) then
        stat = nf_inq_att(var%fileid, NF_GLOBAL, name(2:), xtype=xtype, len=attrlen)
    else
        stat = nf_inq_att(var%fileid, var%varid, name, xtype=xtype, len=attrlen)
    endif
    if (stat /= NF_NOERR) then
        if (present(default)) value(:) = default
        return
    endif
    ! 文字型の場合は長さをコンマで分解した語数と読み替える
    if (xtype == NF_CHAR) then
        call get_attr(var, name, sbuffer)
        call Split(lbuffer, sbuffer, ", ")
        attrlen = len(lbuffer)
    endif
    ! 結果を入れるところがなければ長さだけを伝え終了
    if (size(value) == 0) then
        if (xtype == NF_CHAR) call dispose(lbuffer)
        stat = attrlen
        return
    endif
    ! 型に応じて要求されただけ値を転送
    xferend = min(size(value), attrlen)
    if (present(default)) value(xferend+1: ) = default
    if (xtype == NF_CHAR) then
        do, i = 1, xferend
            value(i) = stoi(element(lbuffer, i))
        enddo
        stat = attrlen
        return
    else
        allocate(ibuffer(attrlen), stat=stat)
        if (stat /= 0) then
            stat = NF_ENOMEM
            return
        endif
        if (name(1:1) == GT_PLUS) then
            stat = nf_get_att_int(var%fileid, NF_GLOBAL, name(2:), ibuffer)
        else
            stat = nf_get_att_int(var%fileid, var%varid, name, ibuffer)
        endif
        if (stat == NF_NOERR) then
            value(1:xferend) = ibuffer(1:xferend)
            stat = attrlen
        endif
        deallocate(ibuffer)
        return
    endif
end subroutine
