Path: | src/gtvargetattrsc.f90 |
Last Update: | Wed Jul 20 18:22:24 JST 2005 |
Copyright (C) GFD Dennou Club, 2000. All rights reserved.
var : | type(GT_VARIABLE), intent(in) |
name : | character(len = *), intent(in) |
value : | character(len = *), intent(out) |
default : | character(len = *), intent(in), optional |
受け側変数の長さに合わせて切り捨て・空白埋めを行う。 属性が存在しない場合 default 値を使う。
subroutine GTVarGetAttrCC(var, name, value, default) implicit none type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name character(len = *), intent(out):: value character(len = *), intent(in), optional:: default logical:: err integer:: class, cid, stat character(len = string):: p_default character(len = *), parameter:: subnam = "gtvargetattrcc" continue call beginsub(subnam) call var_class(var, class, cid) p_default = "" if (present(default)) p_default = default if (class == vtb_class_netcdf) then call get_attr(an_variable(cid), name, value, p_default, stat) else if (class == vtb_class_memory) then call get_attr(mem_variable(cid), name, value, err) if (err) value = p_default endif call endsub(subnam, "%d:%d:%c = %c", i=(/class, cid/), c1=trim(name), c2=trim(value)) end subroutine
var : | type(GT_VARIABLE), intent(in) |
name : | character(len = *), intent(in) |
value : | type(VSTRING), intent(out) |
default : | character(len = *), intent(in), optional |
subroutine GTVarGetAttrSC(var, name, value, default) implicit none type(GT_VARIABLE), intent(in):: var character(len = *), intent(in):: name type(VSTRING), intent(out):: value character(len = *), intent(in), optional:: default logical:: err integer:: class, cid, stat character(len = string):: buffer character(len = string):: p_default character(len = *), parameter:: subnam = "gtvargetattrsc" continue call beginsub(subnam) call var_class(var, class, cid) p_default = "" if (present(default)) p_default = default if (class == vtb_class_netcdf) then call get_attr(an_variable(cid), name, buffer, p_default, stat) else if (class == vtb_class_memory) then call get_attr(mem_variable(cid), name, buffer, err) if (err) buffer = p_default endif value = trim(buffer) call endsub(subnam, "%d:%d:%c = %c", i=(/class, cid/), c1=trim(name), c2=trim(buffer)) end subroutine