gtvaropen.f90

Go to the documentation of this file.

!> @file gtvaropen.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 Open gtool4 data
!>
!> This subroutine is provided through gtdata_generic.
!> @enden
!>
!> @ja
!> @brief gtool4 データのオープン
!>
!> このサブルーチンは gtdata_generic から提供されます。
!> @endja
!>
 
!>
!> @en
!> @brief Open gtool4 variable
!>
!> Opens the gtool variable identified by url and stores it in var.
!> If writable is set to .true., attempts to open for writing.
!> The default is to open read-only.
!> (Note: writable behavior is not yet guaranteed.)
!>
!> Variables opened with Open must always be closed with Close.
!>
!> If an error occurs and err is provided, err returns .true..
!> If err is not provided, the program terminates.
!>
!> Open is a generic name for 2 subroutines; it is also possible
!> to open by specifying a dimension of a variable.
!> @param[out] var      Variable handle
!> @param[in]  url      Variable URL
!> @param[in]  writable Open for writing (optional)
!> @param[out] err      Error flag (optional)
!> @enden
!>
!> @ja
!> @brief gtool4 変数を開く
!>
!> url で識別される gtool 変数を開き、var に格納します。
!> writable を .true. に指定すると書き込み可で開こうとします。
!> デフォルトは書き込み不可で開きます。
!> (まだ writable の動作は保障されていません)。
!>
!> Open された変数は必ず Close されなければなりません。
!>
!> エラーが発生した場合、引数 err が与えられる場合は err が
!> .true. となって返ります。
!> 引数 err を与えなければプログラムは停止します。
!>
!> Open は 2 つのサブルーチンの総称名であり、
!> ある変数の次元を指定することで開くことも可能です。
!> @param[out] var      変数ハンドル
!> @param[in]  url      変数URL
!> @param[in]  writable 書き込み可で開く (省略可能)
!> @param[out] err      エラーフラグ (省略可能)
!> @endja
!>
subroutine gtvaropen(var, url, writable, err)
  use dc_string, only: strhead
  use dc_types, only: string
  use gtdata_types, only: gt_variable
  use gtdata_generic, only: limit
  use gtdata_internal_map, only: map_create, vtb_class_netcdf, gtvar_dump
  use gtdata_netcdf_generic, only: open, inquire
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_url, only: url_chop_iorange
  use dc_error, only: storeerror, dc_noerr, gt_enotvar
  use dc_trace, only: beginsub, endsub
  use dc_present, only: present_and_true
  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
  character(STRING):: cause_c
  integer, allocatable:: dimlen(:)
  type(gd_nc_variable):: gdnc
  character(STRING):: filevar, iorange
  character(*),      parameter:: subname = "GTVarOpen"
  character(*),      parameter:: version = &
    & '$Name:  $' // &
    & '$Id: gtvaropen.f90,v 1.4 2009-05-25 09:55:57 morikawa Exp $'
continue
  call beginsub(subname, fmt='<%c>', c1=trim(url), version=version)
  stat = dc_noerr
  cause_i = 0
  cause_c = ''
  var = gt_variable(-1)
  call url_chop_iorange(url, iorange=iorange, remainder=filevar)
  call open(gdnc, filevar, writable, err)
  if ( present_and_true(err) ) then
    stat = gt_enotvar
    goto 999
  end if
  call inquire(gdnc, ndims=ndims)
  allocate(dimlen(max(1, ndims)))
  call inquire(gdnc, dimlen=dimlen)
  call map_create(var, vtb_class_netcdf, gdnc%id, ndims, dimlen, stat)
  if (stat /= dc_noerr) then
    cause_i = ndims
    goto 999
  end if
  deallocate(dimlen)
  call limit(var, trim(iorange))
  call gtvar_dump(var)
999 continue
  call storeerror(stat, subname, err, cause_c = cause_c, cause_i = cause_i)
  call endsub(subname, 'mapid=%d', i=(/var%mapid/))
end subroutine gtvaropen