! Copyright (C) GFD Dennou Club, 2000. All rights reserved. ! お客様向きではないけれど、情報落ちのないインターフェイスということで.... ! stat < 0: エラー、あるいはその属性は存在しなかった ! stat = 0 ... size(value): その属性を全部読み取った。サイズは stat 個 ! stat > size(value): 配列長不足のため属性が全部読み取れなかった。 ! サイズは stat 個必要 ! ! バグ: ! 属性が文字型で STRING 文字を越える場合、GT_ECHARSHORT が返る SUBROUTINE ANATTRGETINT(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_INT 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 INTEGER, INTENT(OUT):: VALUE(:) INTEGER, INTENT(OUT):: STAT INTEGER, INTENT(IN), OPTIONAL:: DEFAULT INTEGER, 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_INT(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