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



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

SUBROUTINE ANATTRGETDOUBLE(VAR, NAME, VALUE, STAT, DEFAULT)
    USE AN_TYPES, ONLY: AN_VARIABLE, AN_VARIABLE_ENTRY
    USE AN_VARTABLE, ONLY: VTABLE_LOOKUP
    USE NETCDF_F77, ONLY: NF_NOERR, NF_EINVAL, NF_GLOBAL, NF_CHAR, NF_ENOMEM, &
        & NF_INQ_ATT, NF_GET_ATT_DOUBLE
    USE DC_URL, ONLY: GT_PLUS
    USE AN_GENERIC, ONLY: GET_ATTR
    USE DC_TYPES, ONLY: STRING
    USE DC_STRING
    IMPLICIT NONE
    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(:)
    CHARACTER(LEN = STRING):: CBUFFER
    TYPE(STRING_LIST):: LBUFFER
    INTEGER:: ATTRLEN, XTYPE, I, XFEREND, INAME, VARID
    TYPE(AN_VARIABLE_ENTRY):: ENT
CONTINUE
    STAT = VTABLE_LOOKUP(VAR, ENT)
    IF (STAT /= NF_NOERR) THEN
        IF (PRESENT(DEFAULT)) VALUE(:) = DEFAULT
        RETURN
    ENDIF
    ! 型と長さを取得
    IF (NAME(1:1) == GT_PLUS) THEN
        INAME = 2
        VARID = NF_GLOBAL
    ELSE
        INAME = 1
        VARID = ENT%VARID
    ENDIF
    STAT = NF_INQ_ATT(ENT%FILEID, VARID, NAME(INAME:), XTYPE=XTYPE, LEN=ATTRLEN)
    IF (STAT /= NF_NOERR) THEN
        IF (PRESENT(DEFAULT)) VALUE(:) = DEFAULT
        RETURN
    ENDIF
    ! 文字型の場合は長さをコンマで分解した語数と読み替える
    IF (XTYPE == NF_CHAR) THEN
        CALL GET_ATTR(VAR, NAME, CBUFFER, "", STAT)
        IF (STAT /= 0) RETURN
        CALL SPLIT(LBUFFER, CBUFFER, ", ")
        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
        CALL DISPOSE(LBUFFER)
        STAT = ATTRLEN
        RETURN
    ELSE
        ALLOCATE(RBUFFER(ATTRLEN), STAT=STAT)
        IF (STAT /= 0) THEN
            STAT = NF_ENOMEM
            RETURN
        ENDIF
        STAT = NF_GET_ATT_DOUBLE(ENT%FILEID, VARID, NAME(INAME:), RBUFFER)
        IF (STAT == NF_NOERR) THEN
            VALUE(1:XFEREND) = RBUFFER(1:XFEREND)
            STAT = ATTRLEN
        ENDIF
        DEALLOCATE(RBUFFER)
        RETURN
    ENDIF
END SUBROUTINE
