! 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