! Copyright (C) GFD Dennou Club, 2000. All rights reserved subroutine GTVarPutAttrChar(var, name, value, xtype, err) use gtdata_types, only: GT_VARIABLE use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory use an_generic, only: put_attr, an_variable use gt_mem, only: put_attr, mem_variable use dc_trace, only: beginsub, endsub implicit none type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name character(len = *), intent(in):: value character(len = *), intent(in), optional:: xtype logical, intent(out), optional:: err integer:: class, cid character(*), parameter:: subnam = "gtvarputattrchar" call beginsub(subnam, "%d:%c = %c", i=(/var%mapid/), c1=trim(name), c2=trim(value)) call var_class(var, class, cid) if (class == vtb_class_netcdf) then call put_attr(an_variable(cid), name, value, xtype, err) else if (class == vtb_class_memory) then call put_attr(mem_variable(cid), name, value) if (present(err)) err = .false. endif call endsub(subnam) end subroutine ! VSTRING 型を引き取り上記 put_attr を呼び出す。下位層のことは関知しない subroutine GTVarPutAttrString(var, name, value, err) use gtdata_types, only: GT_VARIABLE use dc_string, only: VSTRING, vchar, operator(==), len use gtdata_generic, only: put_attr implicit none type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name type(VSTRING), intent(in):: value logical, intent(out), optional:: err call put_attr(var, name, vchar(value, len(value)), err=err) end subroutine subroutine GTVarPutAttrReal(var, name, value, err) use gtdata_types, only: GT_VARIABLE use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory use an_generic, only: put_attr, an_variable use gt_mem, only: put_attr, mem_variable use dc_string, only: toChar implicit none type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name real, intent(in):: value(:) logical, intent(out), optional:: err integer:: class, cid call var_class(var, class, cid) if (class == vtb_class_netcdf) then call put_attr(an_variable(cid), name, value, err) else if (class == vtb_class_memory) then call put_attr(mem_variable(cid), name, trim(toChar(value))) if (present(err)) err = .false. endif end subroutine subroutine GTVarPutAttrDouble(var, name, value, err) use gtdata_types, only: GT_VARIABLE use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory use an_generic, only: put_attr, an_variable use gt_mem, only: put_attr, mem_variable use dc_string, only: toChar implicit none type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name double precision, intent(in):: value(:) logical, intent(out), optional:: err integer:: class, cid call var_class(var, class, cid) if (class == vtb_class_netcdf) then call put_attr(an_variable(cid), name, value, err) else if (class == vtb_class_memory) then call put_attr(mem_variable(cid), name, trim(toChar(value))) if (present(err)) err = .false. endif end subroutine subroutine GTVarPutAttrInt(var, name, value, err) use gtdata_types, only: GT_VARIABLE use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory use an_generic, only: put_attr, an_variable use gt_mem, only: put_attr, mem_variable use dc_string, only: toChar type(GT_VARIABLE), intent(inout):: var character(len = *), intent(in):: name integer, intent(in):: value(:) logical, intent(out), optional:: err integer:: class, cid call var_class(var, class, cid) if (class == vtb_class_netcdf) then call put_attr(an_variable(cid), name, value, err) else if (class == vtb_class_memory) then call put_attr(mem_variable(cid), name, trim(toChar(value))) if (present(err)) err = .false. endif end subroutine subroutine GTVarPutAttrLogical(var, name, value, err) use gtdata_types, only: GT_VARIABLE use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory use an_generic, only: put_attr, an_variable use gt_mem, only: put_attr, mem_variable use dc_string, only: toChar implicit none type(GT_VARIABLE), intent(inout) :: var character(len = *), intent(in) :: name logical, intent(in) :: value logical, intent(out), optional:: err integer:: class, cid continue call var_class(var, class, cid) if (class == vtb_class_netcdf) then if (value) then call put_attr(an_variable(cid), name, "true", err=err) else call put_attr(an_variable(cid), name, "false", err=err) endif else if (class == vtb_class_memory) then if (value) then call put_attr(mem_variable(cid), name, "true") else call put_attr(mem_variable(cid), name, "false") endif if (present(err)) err = .false. endif end subroutine