! Copyright (C) GFD Dennou Club, 2000. All rights reserved. subroutine ANVarCreate(var, url, xtype, dims, overwrite, err) use dc_string use an_types, only: AN_VARIABLE use an_file, only: ANFileOpen, ANFileDefineMode use dc_url, only: UrlSplit use an_generic, only: toString ! for debug use netcdf_f77, only: NF_NOERR, nf_def_var, NF_REAL, NF_INT, NF_DOUBLE, & NF_EBADDIM, nf_inq_unlimdim use dc_error, only: StoreError, GT_ENOMEM, GT_EOTHERFILE, & GT_EDIMNODIM, GT_EDIMMULTIDIM implicit none type(AN_VARIABLE), intent(inout):: var character(len = *), intent(in):: url character(len = *), intent(in):: xtype type(AN_VARIABLE), intent(in):: dims(:) logical, intent(in), optional:: overwrite logical, intent(out), optional:: err type(VSTRING):: filename, varname integer:: stat, nvdims, i integer:: dimid_growable integer:: nc_xtype intrinsic trim continue ! もし必要ならファイル作成 call UrlSplit(var_str(url), filename, varname) call ANFileOpen(var%fileid, filename, stat=stat, writable=.TRUE., & overwrite=overwrite) if (stat /= NF_NOERR) goto 999 ! 次元にまつわる準備 nvdims = size(dims) allocate(var%dimids(nvdims), var%allcount(nvdims), stat=stat) if (stat /= 0) goto 990 ! もし不定長次元がなければ dimid_growable = -1 となる stat = nf_inq_unlimdim(var%fileid, dimid_growable) if (stat /= NF_NOERR) goto 999 var%growable = 0 do, i = 1, nvdims ! 次元値が使える? if (dims(i)%fileid /= var%fileid) then stat = GT_EOTHERFILE; goto 999 endif if (dims(i)%dimid < 0) then stat = NF_EBADDIM; goto 999 endif var%dimids(i) = dims(i)%dimid ! 不定長次元チェック if (dims(i)%dimid == dimid_growable) var%growable = i ! 次元長を調べるついでに単次元性チェック if (.not. associated(dims(i)%allcount)) then stat = GT_EDIMNODIM; goto 999 endif if (size(dims(i)%allcount) /= 1) then stat = GT_EDIMMULTIDIM; goto 999 endif var%allcount(i) = dims(i)%allcount(1) enddo ! 変数の型の判定 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 = ANFileDefineMode(var%fileid) if (stat /= NF_NOERR) goto 999 stat = nf_def_var(var%fileid, vchar(varname, len(varname)), xtype=nc_xtype, & & ndims=nvdims, dimids=var%dimids, varid=var%varid) if (stat /= NF_NOERR) goto 999 ! イテレータ初期化 allocate(var%start(nvdims), var%count(nvdims), var%stride(nvdims), & & stat=stat) if (stat /= 0) goto 990 var%count(:) = var%allcount(:) var%start(:) = 1 var%stride(:) = 1 ! その他の成分 var%attrid = 0 goto 999 990 continue stat = GT_ENOMEM 999 continue call StoreError(stat, 'ANVarCreate', err) end subroutine