anvarcreate.f90

Path: anvarcreate.f90
Last Update: Thu Jun 08 01:33:34 +0900 2006

netCDF ファイルへ変数作成

Authors:Eizi TOYODA, Yasuhiro MORIKAWA
Version:$Id: anvarcreate.f90,v 1.4 2006-06-07 16:33:34 morikawa Exp $
Tag Name:$Name: gt4f90io-20080810 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン、関数は an_generic から an_generic#Create として提供されます。

Methods

Included Modules

an_types dc_types dc_string an_vartable an_file dc_url dc_trace an_generic netcdf_f77 dc_error

Public Instance methods

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. が返ります.

[Source]

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

[Validate]