gdncvaropen.f90

Go to the documentation of this file.

!= netCDF 変数のオープン
!
! Authors::   Yasuhiro MORIKAWA, Eizi TOYODA
! Version::   $Id: gdncvaropen.f90,v 1.2 2009-05-25 09:51:59 morikawa Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2006. All rights reserved.
! License::   See COPYRIGHT[link:../../COPYRIGHT]
!
! 以下のサブルーチン, 関数は gtdata_netcdf_generic から提供されます。
!

recursive subroutine gdncvaropen(var, url, writable, err)
  use dc_types, only: string
  use gtdata_netcdf_types, only: gd_nc_variable, gd_nc_variable_search
  use gtdata_netcdf_internal, only: vtable_add
  use gtdata_netcdf_file_generic, only: gdncfileopen
  use dc_url, only: urlsplit
  use dc_error, only: storeerror
  use dc_trace, only: beginsub, endsub
  use netcdf, only: nf90_noerr, nf90_max_name, nf90_enotvar, nf90_ebaddim, &
    & nf90_inq_varid, nf90_inq_dimid, nf90_inquire_variable, nf90_inquire
  implicit none
  type(gd_nc_variable), intent(out):: var
  character(len = *), intent(in):: url
  logical, intent(in), optional:: writable
  logical, intent(out), optional:: err
  character(len = STRING):: filename, varname
  character(len = NF90_MAX_NAME):: dimname
  integer:: stat, nvars, i
  type(gd_nc_variable_search):: e
  character(len = *), parameter:: subname = 'GDNcVarOpen'
continue
  call beginsub(subname)
  call urlsplit(url, file=filename, var=varname)
  if (filename == "") filename = "gtool.nc"
  call gdncfileopen(e%fileid, trim(filename), stat=stat, writable=writable, err=err )
  if (stat /= 0) goto 999
  !
  ! 名前から変数を探し出す
  !
  if (varname /= '') then
    e%varid = 0
    stat = nf90_inq_varid(e%fileid, trim(varname), e%varid)
    if (stat == nf90_enotvar) then
      e%varid = 0
      stat = nf90_noerr
    endif
  else
    ! 名前が空ならできれば次元変数でない最初の変数をとりだす
    stat = nf90_inquire(e%fileid, nvariables = nvars)
    if (stat /= 0) goto 999
    e%varid = 1
    do, i = 1, nvars
      stat = nf90_inquire_variable(e%fileid, i, name = dimname)
      if (stat /= nf90_noerr) goto 999
      stat = nf90_inq_dimid(e%fileid, dimname, e%dimid)
      if (stat == nf90_noerr) cycle
      if (stat /= nf90_ebaddim) goto 999
      e%varid = i
      stat = nf90_noerr
      exit
    enddo
  endif
  if (stat /= nf90_noerr) goto 999
  !
  ! 次元id を調べる
  !
  stat = nf90_inq_dimid(e%fileid, trim(varname), e%dimid)
  if (stat /= nf90_noerr) then
    if (e%varid <= 0) goto 999
    e%dimid = 0
  endif
  !
  stat = vtable_add(var, e)
  if (stat /= nf90_noerr) goto 999
  call endsub(subname, 'an=%d file=%d var=%d', i=(/var%id, e%fileid, e%varid/))
  call storeerror(stat, subname, err)
  return
  !
  ! エラー処理 (正常完了時も呼ぶ)
  !
999 continue
  var = gd_nc_variable(-1)
  call endsub(subname, 'an=%d err', i=(/var%id/))
  call storeerror(stat, subname, err, cause_c=url)
end subroutine gdncvaropen