Path: | anvarcreate.f90 |
Last Update: | Thu Jun 08 01:33:34 JST 2006 |
Authors: | Eizi TOYODA, Yasuhiro MORIKAWA |
Version: | $Id: anvarcreate.f90,v 1.4 2006/06/07 16:33:34 morikawa Exp $ |
Tag Name: | $Name: gt4f90io-20070710 $ |
Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
License: | See COPYRIGHT |
以下のサブルーチン、関数は an_generic から an_generic#Create として提供されます。
Subroutine : | |
var : | type(AN_VARIABLE), intent(out) |
url : | character(len = *), intent(in) |
xtype : | character(len = *), intent(in) |
dims(:) : | type(AN_VARIABLE), intent(in) |
overwrite : | logical, intent(in), optional |
err : | logical, intent(out), optional |
変数 URL url に変数を作成します. 変数が依存する次元を dims に与えます. 返される引数 var には変数 ID などの情報が格納されます.
overwrite に .true. を設定すると上書き可能なモードになります. デフォルトは上書き不可です. err を与える場合, 次元変数生成時にエラーが生じても プログラムを終了せず, err に .false. が返ります.
subroutine ANVarCreate(var, url, xtype, dims, overwrite, err) ! !== 変数作成 ! ! 変数 URL *url* に変数を作成します. ! 変数が依存する次元を *dims* に与えます. ! 返される引数 *var* には変数 ID などの情報が格納されます. ! ! *overwrite* に .true. を設定すると上書き可能なモードになります. ! デフォルトは上書き不可です. ! *err* を与える場合, 次元変数生成時にエラーが生じても ! プログラムを終了せず, *err* に .false. が返ります. ! use an_types, only: AN_VARIABLE, an_variable_entry, an_variable_search use dc_types, only: string use dc_string, only: strieq use an_vartable, only: vtable_add, vtable_lookup use an_file, only: ANFileOpen, ANFileDefineMode use dc_url, only: UrlSplit use dc_trace, only: BeginSub, EndSub, DbgMessage 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(out):: 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(an_variable_search):: ent type(an_variable_entry):: ent_dim character(len = string):: filename, varname integer, allocatable:: dimids(:) integer:: stat, nvdims, i integer:: nc_xtype logical:: clobber intrinsic trim character(len = *), parameter:: subnam = "ANVarCreate" continue clobber = .false. if (present(overwrite)) clobber = overwrite call BeginSub(subnam) call DbgMessage('url=%c', c1=trim(url)) call DbgMessage('xtype=%c', c1=trim(xtype)) call DbgMessage('dims=(/%*d/)', i=(/dims(:)%id/), n=(/size(dims)/)) call DbgMessage('ovwr=%y', L=(/clobber/)) ! もし必要ならファイル作成 call UrlSplit(url, filename, varname) call ANFileOpen(ent%fileid, filename, stat=stat, writable=.TRUE., overwrite=clobber) if (stat /= NF_NOERR) goto 999 ! 次元にまつわる準備 nvdims = size(dims) allocate(dimids(max(1, nvdims)), stat=stat) if (stat /= 0) then stat = GT_ENOMEM goto 999 end if do, i = 1, nvdims stat = vtable_lookup(dims(i), ent_dim) if (stat /= NF_NOERR) then stat = NF_EBADDIM goto 999 endif if (ent%fileid /= ent_dim%fileid) then stat = GT_EOTHERFILE goto 999 endif if (ent_dim%dimid <= 0) then stat = GT_EDIMMULTIDIM goto 999 endif dimids(i) = ent_dim%dimid enddo ent%dimid = 0 ! 変数の型の判定 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(ent%fileid) if (stat /= NF_NOERR) goto 999 stat = nf_def_var(ent%fileid, trim(varname), xtype=nc_xtype, ndims=nvdims, dimids=dimids, varid=ent%varid) if (stat /= NF_NOERR) goto 999 ! 登録 stat = vtable_add(var, ent) 999 continue if (allocated(dimids)) deallocate(dimids) if (stat /= NF_NOERR) var % id = -1 call StoreError(stat, subnam, err, cause_c=url) call EndSub(subnam, 'stat=%d, var.id=%d', i=(/stat, var % id/)) end subroutine