| Path: | anvarcreate.f90 |
| Last Update: | Tue Sep 23 18:56:36 +0900 2008 |
| Authors: | Eizi TOYODA, Yasuhiro MORIKAWA |
| Version: | $Id: anvarcreate.f90,v 1.1.1.1 2008-09-23 09:56:36 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20090115 $ |
| 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