! ! create(var, url, [dims], [xtype], [overwrite], [err]) は ! 場所 url に次元 dims を持った変数を作成し、それを開いた ! ものを var に格納する。型 xtype を省略すると "float" と ! みなされる。既存変数があるとき失敗するが ! overwrite が真であれば続行する。 ! subroutine GTVarCreate(var, url, dims, xtype, long_name, overwrite, err) use gtdata_types, only: gt_variable use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory, & & map_create, gtvar_dump use an_generic, only: create, put_attr, inquire use an_types, only: an_variable use netcdf_f77, only: nf_real, nf_int use dc_string, only: strhead use dc_error use dc_types, only: token use dc_trace, only: beginsub, endsub, DbgMessage implicit none type(gt_variable), intent(inout):: var character(len = *), intent(in):: url type(gt_variable), intent(in), optional:: dims(:) character(len = *), intent(in), optional:: xtype character(len = *), intent(in), optional:: long_name logical, intent(in), optional:: overwrite logical, intent(out), optional:: err type(an_variable), allocatable:: an_dims(:) type(an_variable):: an integer, allocatable:: allcount(:) integer:: i, ndims character(len = token):: myxtype continue ndims = 0 if (present(dims)) ndims = size(dims) call beginsub('gtvarcreate', 'url=%c ndims=%d', c1=trim(url), i=(/ndims/)) if (strhead(url, "memory:")) then ! メモリ変数の作成 call StoreError(GT_EFAKE, "GTVarCreate", err) call endsub('gtvarcreate') return else ! an 変数の作成 if (present(err)) err = .false. if (present(xtype)) then myxtype = xtype else myxtype = "float" endif if (present(dims)) then allocate(an_dims(ndims), allcount(ndims)) do, i = 1, ndims call var_class(dims(i), cid=an_dims(i)%id) call DbgMessage('dim=%d mapid=%d -> cid=%d', i=(/i, dims(i)%mapid, an_dims(i)%id/)) call inquire(an_dims(i), dimlen=allcount(i)) enddo call create(var=an, url=url, dims=an_dims, xtype=myxtype, & & overwrite=overwrite, err=err) else ndims = 0 allocate(an_dims(1), allcount(1)) ! dummy call create(var=an, url=url, dims=an_dims(1:0), & & xtype=myxtype, overwrite=overwrite, err=err) endif call map_create(var, vtb_class_netcdf, an%id, ndims, allcount) deallocate(an_dims, allcount) if (present(long_name)) then call put_attr(an, 'long_name', long_name, err=err) endif endif call gtvar_dump(var) call endsub('gtvarcreate', 'var%%mapid=%d', i=(/var%mapid/)) end subroutine