!= gtvaropen.f90 - gtool4 データのオープン
!
! Authors:: Yasuhiro MORIKAWA, Eizi TOYODA
! Version:: $Id: gtvaropen.f90,v 1.7 2006/06/16 04:55:09 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20070417 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2005. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! 以下のサブルーチン, 関数は gtdata_generic から提供されます。
!
subroutine GTVarOpen(var, url, writable, err)
!
!== gtool4 データのオープン
!
! *url* で識別される gtool 変数を開き、*var* に格納します。
! *writable* を .true. に指定すると書き込み可で開こうとします。
! デフォルトは書き込み不可で開きます。
! (まだ *writable* の動作は保障されていません)。
!
! Open された変数は必ず Close されなければなりません。
!
! エラーが発生した場合、引数 *err* が与えられる場合は *err* が
! .true. となって返ります。
! 引数 *err* を与えなければプログラムは停止します。
!
! *Open* は 2 つのサブルーチンの総称名であり、
! ある変数の次元を指定することで開くことも可能です。
! 上記のサブルーチンを参照ください。
!
!=== 補足
!
! 上記の Open を参照してください。
!
use dc_string, only: StrHead
use dc_types, only: STRING
use gtdata_types, only: GT_VARIABLE
use gtdata_generic, only: limit
use gt_map, only: map_create, vtb_class_netcdf, vtb_class_memory, gtvar_dump
use an_generic, only: ANVarOpen, an_variable, inquire
use dc_url, only: url_chop_iorange
use dc_error, only: StoreError, GT_EFAKE, DC_NOERR
use dc_trace, only: beginsub, endsub
implicit none
type(GT_VARIABLE), intent(out):: var
character(*), intent(in):: url
logical, intent(in), optional:: writable
logical, intent(out), optional:: err
integer:: ndims, stat, cause_i
integer, allocatable:: dimlen(:)
type(an_variable):: an
character(len = STRING):: filevar, iorange
character(len = *), parameter:: subname = "GTVarOpen"
character(len = *), parameter:: version = &
& '$Name: gt4f90io-20070417 $' // &
& '$Id: gtvaropen.f90,v 1.7 2006/06/16 04:55:09 morikawa Exp $'
continue
call beginsub(subname, fmt='<%c>', c1=trim(url), version=version)
stat = DC_NOERR
cause_i = 0
call url_chop_iorange(url, iorange=iorange, remainder=filevar)
if (StrHead(filevar, "memory:")) then
call StoreError(GT_EFAKE, "GTVarOpen(memory:)", err)
var = gt_variable(-1)
else
call ANVarOpen(an, filevar, writable, err)
call inquire(an, ndims=ndims)
allocate(dimlen(max(1, ndims)))
call inquire(an, dimlen=dimlen)
call map_create(var, vtb_class_netcdf, an%id, ndims, dimlen, stat)
if (stat /= DC_NOERR) then
cause_i = ndims
goto 999
end if
deallocate(dimlen)
endif
call limit(var, trim(iorange))
call gtvar_dump(var)
999 continue
call StoreError(stat, subname, err, cause_i=cause_i)
call endsub(subname, 'mapid=%d', i=(/var%mapid/))
end subroutine GTVarOpen