gtvarcreate.f90

Path: gtvarcreate.f90
Last Update: Fri Jun 16 13:55:09 JST 2006

従属変数の作成

Authors:Yasuhiro MORIKAWA, Eizi TOYODA
Version:$Id: gtvarcreate.f90,v 1.8 2006/06/16 04:55:09 morikawa Exp $
Tag Name:$Name: gt4f90io-20060618 $
Copyright:Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
License:See COPYRIGHT

以下のサブルーチン, 関数は gtdata_generic から提供されます。

Methods

Included Modules

gtdata_types gt_map an_generic an_types netcdf_f77 dc_string dc_error dc_types dc_trace

Public Instance methods

Subroutine :
var :type(GT_VARIABLE), intent(out)
url :character(len = *), intent(in)
dims(:) :type(GT_VARIABLE), intent(in), optional
xtype :character(len = *), intent(in), optional
long_name :character(len = *), intent(in), optional
overwrite :logical, intent(in), optional
err :logical, intent(out), optional

従属変数の作成

場所 url に次元 dims を持った変数つまり GT_VARIABLE 型 の実体を作成し、それを第 1 引数 var にセットします。 Open されたものと同様、第1引数 var は後で必ず Close されなければなりません。

xtype を省略すると "float" と みなされます。既存変数があるとき失敗しますが、 overwrite == .true. であれば上書きして続行します。 (まだ overwrite の動作は保障されていません)。 dims の省略は 0 次元変数の設定を意味します。

作成の際にエラーが生じた場合、メッセージを出力してプログラムは 強制終了します。err を与えてある場合にはこの引数に .true. が返り、プログラムは終了しません。

[Source]

subroutine GTVarCreate(var, url, dims, xtype, long_name, overwrite, err)
  !
  !== 従属変数の作成
  !
  ! 場所 *url* に次元 *dims* を持った変数つまり GT_VARIABLE 型
  ! の実体を作成し、それを第 1 引数 *var* にセットします。
  ! Open されたものと同様、第1引数 *var* は後で必ず
  ! Close されなければなりません。
  !
  ! 型 *xtype* を省略すると "+float+" と
  ! みなされます。既存変数があるとき失敗しますが、
  ! overwrite == .true. であれば上書きして続行します。
  ! (まだ *overwrite* の動作は保障されていません)。
  ! dims の省略は 0 次元変数の設定を意味します。
  !
  ! 作成の際にエラーが生じた場合、メッセージを出力してプログラムは
  ! 強制終了します。*err* を与えてある場合にはこの引数に .true.
  ! が返り、プログラムは終了しません。
  !
  !
  use gtdata_types, only: GT_VARIABLE
  use gt_map, only: var_class, vtb_class_netcdf, vtb_class_memory,  map_create, gtvar_dump
  use an_generic, only: create, put_attr, inquire
  use an_types, only: an_variable
  use netcdf_f77, only: nf_real, nf_int
  use dc_string, only: strhead
  use dc_error, only: StoreError, DC_NOERR, GT_EFAKE 
  use dc_types, only: TOKEN
  use dc_trace, only: BeginSub, EndSub, DbgMessage
  implicit none
  type(GT_VARIABLE), intent(out):: var
  character(len = *), intent(in):: url
  type(GT_VARIABLE), intent(in), optional:: dims(:)
  character(len = *), intent(in), optional:: xtype
  character(len = *), intent(in), optional:: long_name
  logical, intent(in), optional:: overwrite
  logical, intent(out), optional:: err
  type(an_variable), allocatable:: an_dims(:)
  type(an_variable):: an
  integer, allocatable:: allcount(:)
  integer:: i, ndims, stat, cause_i
  character(len = TOKEN):: myxtype
  character(len = *),      parameter:: subname = "GTVarCreate"
  character(len = *),      parameter:: version =  '$Name: gt4f90io-20060618 $' //  '$Id: gtvarcreate.f90,v 1.8 2006/06/16 04:55:09 morikawa Exp $'
continue
  stat = DC_NOERR
  ndims = 0
  cause_i = 0
  if (present(dims)) ndims = size(dims)
  call BeginSub(subname, 'url=%c ndims=%d', c1=trim(url), i=(/ndims/),  version=version)
  if (strhead(url, "memory:")) then
    ! メモリ変数の作成
    stat = GT_EFAKE
    goto 999
  else
    ! an 変数の作成
    if (present(err)) err = .false.
    if (present(xtype)) then
      myxtype = xtype
    else
      myxtype = "float"
    endif
    if (present(dims)) then
      allocate(an_dims(ndims), allcount(ndims))
      do, i = 1, ndims
        call var_class(dims(i), cid=an_dims(i)%id)
        call DbgMessage('dim=%d mapid=%d -> cid=%d', i=(/i, dims(i)%mapid, an_dims(i)%id/))
        call inquire(an_dims(i), dimlen=allcount(i))
      enddo
      call create(var=an, url=url, dims=an_dims, xtype=myxtype,  overwrite=overwrite, err=err)
    else
      ndims = 0
      allocate(an_dims(1), allcount(1)) ! dummy
      call create(var=an, url=url, dims=an_dims(1:0),  xtype=myxtype, overwrite=overwrite, err=err)
    endif
    call map_create(var, vtb_class_netcdf, an%id, ndims, allcount, stat)
    if (stat /= DC_NOERR) then
      cause_i = ndims
      goto 999
    end if
    deallocate(an_dims, allcount)
    if (present(long_name)) then
      call put_attr(an, 'long_name', long_name, err=err)
    endif
  endif
  call gtvar_dump(var)
  call DbgMessage('var%%mapid=%d', i=(/var % mapid/))
999 continue
  call StoreError(stat, subname, err, cause_i=cause_i)
  call EndSub(subname)
end subroutine GTVarCreate

[Validate]