! Copyright (C) GFD Dennou Club, 2000. All rights reserved. ! ! 次元変数 create ! ! create(var, url, xtype, length, [overwrite], [err]) は ! 長さ length の次元変数を作成する。 ! subroutine ANVarCreateD(var, url, xtype, length, overwrite, err) use an_types, only: AN_VARIABLE use dc_string use dc_url, only: UrlSplit use netcdf_f77, only: NF_NOERR, NF_REAL, NF_INT, NF_DOUBLE, & nf_def_var, nf_def_dim use an_file, only: ANFIleOpen, ANFileDefineMode use dc_error, only: StoreError, GT_ENOMEM implicit none type(AN_VARIABLE), intent(inout):: var character(len = *), intent(in):: url character(len = *), intent(in):: xtype integer, intent(in):: length logical, intent(in), optional:: overwrite logical, intent(out), optional:: err type(VSTRING):: filename, varname integer:: stat integer:: nc_xtype call UrlSplit(var_str(url), filename, varname) call ANFileOpen(var%fileid, filename, stat=stat, writable=.TRUE., & overwrite=overwrite) if (stat /= NF_NOERR) goto 999 stat = ANFileDefineMode(var%fileid) if (stat /= NF_NOERR) goto 999 nc_xtype = NF_REAL if (strieq(xtype, "double") .or. & & strieq(xtype, "DOUBLEPRECISION")) then nc_xtype = NF_DOUBLE endif if (strieq(xtype, "int") .or. strieq(xtype, "INTEGER")) then nc_xtype = NF_INT endif ! stat = nf_def_dim(var%fileid, vchar(varname, len(varname)), len=length, & & dimid=var%dimid) if (stat /= NF_NOERR) goto 999 stat = nf_def_var(var%fileid, vchar(varname, len(varname)), xtype=nc_xtype, & & ndims=1, dimids=(/var%dimid/), varid=var%varid) if (stat /= NF_NOERR) goto 999 ! イテレータ初期化 allocate(var%dimids(1), var%allcount(1), & & var%start(1), var%count(1), var%stride(1), stat=stat) if (stat /= 0) then stat = GT_ENOMEM goto 999 endif var%dimids(1) = var%dimid var%start(1) = 1 var%stride(1) = 1 if (length /= 0) then var%allcount(1) = length var%count(1) = length var%growable = 0 else var%allcount(1) = HUGE(1) var%count(1) = 1 var%growable = 1 endif ! その他成分 var%attrid = 0 ! エラーなし if (present(err)) err = .FALSE. return 999 continue call StoreError(stat, 'ANVarCreateD', err) end subroutine