| Path: | gtvarcreated.f90 |
| Last Update: | Tue Sep 23 18:56:15 +0900 2008 |
| Authors: | Yasuhiro MORIKAWA, Eizi TOYODA |
| Version: | $Id: gtvarcreated.f90,v 1.1.1.1 2008-09-23 09:56:15 morikawa Exp $ |
| Tag Name: | $Name: gtool5-20081007 $ |
| Copyright: | Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved. |
| License: | See COPYRIGHT |
以下のサブルーチン, 関数は gtdata_generic から提供されます。
| Subroutine : | |
| var : | type(GT_VARIABLE), intent(out) |
| url : | character(len = *), intent(in) |
| length : | integer, intent(in) |
| xtype : | character(len = *), intent(in), optional |
| long_name : | character(len = *), intent(in), optional |
| overwrite : | logical, intent(in), optional |
| err : | logical, intent(out), optional |
場所 url に長さ length の自分自身を次元とする変数つまり GT_VARIABLE 型 の実体を作成し、それを第 1 引数 var にセットします。 Open されたものと同様、第1引数 var は後で必ず Close されなければなりません。
長さ length == 0 を指定するとその変数は可変長次元となります。 型 xtype を省略すると "float" と みなされます。既存変数があるとき失敗しますが、 overwrite == .true. であれば上書きして続行します。 (まだ overwrite の動作は保障されていません)。 dims の省略は 0 次元変数の設定を意味します。
次元変数は自動生成されることが多いため、変数名部を欠く指定に対しては 名前を自動生成します。
作成の際にエラーが生じた場合、メッセージを出力してプログラムは 強制終了します。err を与えてある場合にはこの引数に .true. が返り、プログラムは終了しません。
subroutine GTVarCreateD(var, url, length, xtype, long_name, overwrite, err)
!
!== 独立変数 (次元) の作成
!
! 場所 *url* に長さ *length* の自分自身を次元とする変数つまり GT_VARIABLE 型
! の実体を作成し、それを第 1 引数 *var* にセットします。
! Open されたものと同様、第1引数 *var* は後で必ず
! Close されなければなりません。
!
! 長さ length == 0 を指定するとその変数は可変長次元となります。
! 型 *xtype* を省略すると "+float+" と
! みなされます。既存変数があるとき失敗しますが、
! overwrite == .true. であれば上書きして続行します。
! (まだ *overwrite* の動作は保障されていません)。
! dims の省略は 0 次元変数の設定を意味します。
!
! 次元変数は自動生成されることが多いため、変数名部を欠く指定に対しては
! 名前を自動生成します。
!
! 作成の際にエラーが生じた場合、メッセージを出力してプログラムは
! 強制終了します。*err* を与えてある場合にはこの引数に .true.
! が返り、プログラムは終了しません。
!
use dc_string, only: StrHead
use gtdata_types, only: GT_VARIABLE
use gtdata_generic, only: GtDataTmpNam
use an_generic, only: Create, Put_Attr, an_variable
use gt_mem, only: Create, mem_variable
use gt_map, only: map_create, vtb_class_memory, 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(an_variable):: an
type(mem_variable):: mem
integer :: stat, cause_i
character(len = *), parameter:: subname = "GTVarCreateD"
character(len = *), parameter:: version = '$Name: gtool5-20081007 $' // '$Id: gtvarcreated.f90,v 1.1.1.1 2008-09-23 09:56:15 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 = ''
if (strHead(url, "memory:")) then
call Create(mem, url, length, xtype, long_name, overwrite, err)
call map_create(var, vtb_class_memory, mem%id, 1, (/length/), stat)
if (stat /= DC_NOERR) then
cause_i = 1
goto 999
end if
call gtvar_dump(var)
data_class = 'memory'
goto 999
endif
! 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
! an 形式が選択される場合は
call Create(var=an, url=new_url, length=length, xtype=xtype, overwrite=overwrite, err=err)
if (present(long_name)) then
call put_attr(an, 'long_name', long_name, err=err)
endif
call map_create(var, vtb_class_netcdf, an%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