gtvarcreated.f90

Go to the documentation of this file.

!> @file gtvarcreated.f90
!>
!> @author Yasuhiro MORIKAWA, Eizi TOYODA
!> @copyright Copyright (C) GFD Dennou Club, 2000-2026. All rights reserved. <br/>
!>            License is BSD-2-Clause. See [COPYRIGHT](@ref COPYRIGHT) in detail
!>
!> @en
!> @brief Create independent variable (dimension)
!>
!> This subroutine is provided through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief 独立変数 (次元) の作成
!>
!> このサブルーチンは gtdata_generic から提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Create dimension variable
!>
!> Creates a variable of GT_VARIABLE type with itself as the dimension
!> at location url with length length, and sets it to var.
!> Like variables opened with Open, var must later be closed with Close.
!>
!> Specifying length == 0 makes the variable an unlimited dimension.
!> If xtype is omitted, it defaults to "float".
!> Creation fails if the variable already exists, but continues by
!> overwriting if overwrite == .true..
!> (Note: overwrite behavior is not yet guaranteed.)
!> Omitting dims means setting a 0-dimensional variable.
!>
!> Since dimension variables are often auto-generated, names are
!> auto-generated for specifications lacking a variable name part.
!>
!> If an error occurs during creation, outputs a message and terminates.
!> If err is provided, returns .true. and program does not terminate.
!> @param[out] var       Variable handle
!> @param[in]  url       Variable URL
!> @param[in]  length    Dimension length (0 for unlimited)
!> @param[in]  xtype     Data type (optional, default "float")
!> @param[in]  long_name Long name attribute (optional)
!> @param[in]  overwrite Allow overwrite (optional)
!> @param[out] err       Error flag (optional)
!> @enden
!>
!> @ja
!> @brief 次元変数の作成
!>
!> 場所 url に長さ length の自分自身を次元とする変数つまり GT_VARIABLE 型
!> の実体を作成し、それを第 1 引数 var にセットします。
!> Open されたものと同様、第1引数 var は後で必ず Close されなければなりません。
!>
!> 長さ length == 0 を指定するとその変数は可変長次元となります。
!> 型 xtype を省略すると "float" とみなされます。既存変数があるとき
!> 失敗しますが、overwrite == .true. であれば上書きして続行します。
!> (まだ overwrite の動作は保障されていません)。
!> dims の省略は 0 次元変数の設定を意味します。
!>
!> 次元変数は自動生成されることが多いため、変数名部を欠く指定に対しては
!> 名前を自動生成します。
!>
!> 作成の際にエラーが生じた場合、メッセージを出力してプログラムは
!> 強制終了します。err を与えてある場合にはこの引数に .true.
!> が返り、プログラムは終了しません。
!> @param[out] var       変数ハンドル
!> @param[in]  url       変数URL
!> @param[in]  length    次元長 (0で可変長)
!> @param[in]  xtype     データ型 (省略可能、デフォルトは "float")
!> @param[in]  long_name 長い名前属性 (省略可能)
!> @param[in]  overwrite 上書き許可 (省略可能)
!> @param[out] err       エラーフラグ (省略可能)
!> @endja
!>
subroutine gtvarcreated(var, url, length, xtype, long_name, overwrite, err)
  use dc_string, only: strhead
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: gtdatatmpnam
  use gtdata_netcdf_generic, only: create, put_attr
  use gtdata_netcdf_types, only: gd_nc_variable
  use gtdata_internal_map, only: map_create, vtb_class_netcdf, gtvar_dump
  use dc_url, only: urlsplit, urlmerge
  use dc_trace, only: beginsub, endsub, dbgmessage
  use dc_error, only: storeerror, dc_noerr
  use dc_types, only: string
  implicit none
  type(gt_variable), intent(out):: var
  character(len = *), intent(in):: url
  integer, intent(in):: length
  character(len = *), intent(in), optional:: xtype
  character(len = *), intent(in), optional:: long_name
  logical, intent(in), optional:: overwrite
  logical, intent(out), optional:: err
  character(len = STRING):: fnam, vnam, new_url, data_class
  type(gd_nc_variable):: gdnc
  integer :: stat, cause_i
  character(len = *),      parameter:: subname = "GTVarCreateD"
  character(len = *),      parameter:: version = &
    & '$Name:  $' // &
    & '$Id: gtvarcreated.f90,v 1.5 2009-05-25 09:55:58 morikawa Exp $'
continue
  call beginsub(subname, 'url=<%c> length=%d', &
    & c1=trim(url), i=(/length/), version=version)
  stat = dc_noerr
  cause_i = 0
  data_class = ''
  ! URL の検査
  call urlsplit(url, file=fnam, var=vnam)
  if (vnam == "") then
    call gtdatatmpnam(file=fnam, base="dim", result=new_url)
  else
    new_url = url
  endif
  ! gdnc 形式が選択される場合は
  call create(var=gdnc, url=new_url, length=length, xtype=xtype, &
    & overwrite=overwrite, err=err)
  if (present(long_name)) then
    call put_attr(gdnc, 'long_name', long_name, err=err)
  endif
  call map_create(var, vtb_class_netcdf, gdnc%id, 1, (/length/), stat)
    if (stat /= dc_noerr) then
      cause_i = 1
      goto 999
    end if
  call gtvar_dump(var)
  data_class = 'netcdf'
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i)
  call endsub(subname, 'class=%c mapid=%d', &
    & c1=trim(data_class), i=(/var%mapid/) )
end subroutine gtvarcreated