!
!= gtdata の内部用サブルーチン格納モジュール
!
! Authors:: Eizi TOYODA, Yasuhiro MORIKAWA
! Version:: $Id: gtdata_internal.f90,v 1.2 2006/03/10 03:18:11 morikawa Exp $
! Tag Name:: $Name: gt4f90io-20060627 $
! Copyright:: Copyright (C) GFD Dennou Club, 2000-2006. All rights reserved.
! License:: See COPYRIGHT[link:../../COPYRIGHT]
!
! This file provides gtdata_internal
!
module gtdata_internal 3,2
use gt_vartable
, only: VTB_CLASS_MEMORY, VTB_CLASS_NETCDF, VarTableLookup
implicit none
interface dimrange 4
module procedure dimrange_direct
end interface
contains
subroutine dimrange_direct(vid, dimlo, dimhi) 1,6
use an_types
, only: an_variable
use an_generic
, only: an_inquire => inquire
use dc_error
, only: storeerror, nf_einval, gt_efake
integer, intent(in):: vid
integer, intent(out):: dimlo, dimhi
integer:: class, cid
call VarTableLookup
(vid, class, cid)
select case(class)
case(VTB_CLASS_MEMORY)
call storeerror
(gt_efake, 'gtdata::dimrange')
case(VTB_CLASS_NETCDF)
dimlo = 1
call an_inquire(an_variable(cid), dimlen=dimhi)
case default
call storeerror
(nf_einval, 'gtdata::dimrange')
end select
end subroutine dimrange_direct
integer function ndims(vid) result(result),5
use an_types
, only: an_variable
use an_generic
, only: an_inquire => inquire
use dc_error
, only: storeerror, nf_einval
integer, intent(in):: vid
integer:: class, cid
call VarTableLookup
(vid, class, cid)
select case(class)
case(VTB_CLASS_MEMORY)
result = 1
case(VTB_CLASS_NETCDF)
call an_inquire(an_variable(cid), ndims=result)
case default
call storeerror
(nf_einval, 'gtdata::ndims')
end select
end function ndims
subroutine query_growable(vid, result) 1,6
use an_types
, only: an_variable
use an_generic
, only: inquire
use dc_error
, only: storeerror, nf_einval
integer, intent(in):: vid
logical, intent(out):: result
integer:: class, cid
call vartablelookup
(vid, class, cid)
select case(class)
case(vtb_class_memory)
result = .false.
case(vtb_class_netcdf)
call inquire
(an_variable(cid), growable=result)
case default
call storeerror
(nf_einval, 'gtdata::ndims')
end select
end subroutine query_growable
end module gtdata_internal