!--------------------------------------------------------------------- ! Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. !--------------------------------------------------------------------- != Get AN_VARIABLES ! ! This file is created by "anattergettype.m4" by m4 command using ! "intrinsic_types.m4". Don't edit each files directly. ! ! ! お客様向きではないけれど、情報落ちのないインターフェイスということで.... ! 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, DP 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(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 ANAttrGetInt subroutine ANAttrGetReal(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_Real use dc_url, only: gt_plus use an_generic, only: get_attr use dc_types, only: STRING, DP use dc_string implicit none 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(:) character(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_Real(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 ANAttrGetReal 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, DP use dc_string implicit none type(AN_VARIABLE), intent(in) :: var character(len = *), intent(in) :: name real(DP), intent(out):: value(:) integer, intent(out):: stat real(DP), intent(in), optional:: default real(DP), allocatable:: rbuffer(:) character(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 ANAttrGetDouble !-- ! vi:set readonly sw=4 ts=8: ! !Local Variables: !mode: f90 !buffer-read-only: t !End: ! !++