gtvarputnum.f90

Go to the documentation of this file.

! -*- coding: utf-8; mode: f90 -*-
!-------------------------------------------------------------------------------------
! Copyright (c) 2000-2016 Gtool Development Group. All rights reserved.
!-------------------------------------------------------------------------------------
! ** Important**
!
! This file is generated from gtvarputnum.erb by ERB included Ruby 2.3.1.
! Please do not edit this file directly. @see "gtvarputnum.erb"
!-------------------------------------------------------------------------------------
!
!== 変数への数値データの出力
!
! 変数 *var* へ数値データ *value* が出力されます。
! *nvalue* には配列長を代入する必要があります。
!
! 数値データ出力の際にエラーが生じた場合、メッセージを出力
! してプログラムは強制終了します。*err* を与えてある場合には
! の引数に .true. が返り、プログラムは終了しません。
!
! 出力しようとするデータの型が *var* の型と異なる場合、データは *var* の
! 型に変換されます。 この変換は netCDF の機能を用いています。
! 詳しくは {netCDF 日本語版マニュアル}[link:../xref.htm#label-10]
! の 3.3 型変換 を参照してください。
!
! *Get* は複数のサブルーチンの総称名であり、
! *value* に多次元配列を与えることも可能です。上記の
! サブルーチンを参照してください。
!
subroutine gtvarputdouble(var, value, nvalue, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: &
    & var_class, &
    & vtb_class_netcdf, &
    & map_to_internal_specs
  use gtdata_netcdf_generic,  only: put
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error,    only: storeerror, gt_efake
  ! use dc_trace,    only: BeginSub, EndSub
  use dc_types,    only: dp
  implicit none
  type(gt_variable), intent(in)            :: var
  integer,           intent(in)            :: nvalue
  real(DP),          intent(in)            :: value(nvalue)
  logical,           intent(out), optional :: err
  ! Variables for Intenal work
  integer:: class, cid, stat, ndims
  integer, pointer:: specs(:, :)
  character(len = *), parameter:: subname = "GTVarPutDouble"
  continue
  call var_class(var, class, cid)
  call map_to_internal_specs(var, specs, ndims)
  if (class == vtb_class_netcdf) then
    call put(gd_nc_variable(cid), start=specs(:, 1), count=specs(:, 2), &
      & stride=specs(:, 3), imap=specs(:, 4), value=value, &
      & siz=nvalue, iostat=stat)
  else
    stat = gt_efake
  endif
  call storeerror(stat, subname, err=err)
  deallocate(specs)
end subroutine gtvarputdouble

subroutine gtvarputreal(var, value, nvalue, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: &
    & var_class, &
    & vtb_class_netcdf, &
    & map_to_internal_specs
  use gtdata_netcdf_generic,  only: put
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error,    only: storeerror, gt_efake
  ! use dc_trace,    only: BeginSub, EndSub
  use dc_types,    only: sp
  implicit none
  type(gt_variable), intent(in)            :: var
  integer,           intent(in)            :: nvalue
  real(SP),          intent(in)            :: value(nvalue)
  logical,           intent(out), optional :: err
  ! Variables for Intenal work
  integer:: class, cid, stat, ndims
  integer, pointer:: specs(:, :)
  character(len = *), parameter:: subname = "GTVarPutReal"
  continue
  call var_class(var, class, cid)
  call map_to_internal_specs(var, specs, ndims)
  if (class == vtb_class_netcdf) then
    call put(gd_nc_variable(cid), start=specs(:, 1), count=specs(:, 2), &
      & stride=specs(:, 3), imap=specs(:, 4), value=value, &
      & siz=nvalue, iostat=stat)
  else
    stat = gt_efake
  endif
  call storeerror(stat, subname, err=err)
  deallocate(specs)
end subroutine gtvarputreal

subroutine gtvarputint(var, value, nvalue, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: &
    & var_class, &
    & vtb_class_netcdf, &
    & map_to_internal_specs
  use gtdata_netcdf_generic,  only: put
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error,    only: storeerror, gt_efake
  ! use dc_trace,    only: BeginSub, EndSub
  implicit none
  type(gt_variable), intent(in)            :: var
  integer,           intent(in)            :: nvalue
  integer,           intent(in)            :: value(nvalue)
  logical,           intent(out), optional :: err
  ! Variables for Intenal work
  integer:: class, cid, stat, ndims
  integer, pointer:: specs(:, :)
  character(len = *), parameter:: subname = "GTVarPutInt"
  continue
  call var_class(var, class, cid)
  call map_to_internal_specs(var, specs, ndims)
  if (class == vtb_class_netcdf) then
    call put(gd_nc_variable(cid), start=specs(:, 1), count=specs(:, 2), &
      & stride=specs(:, 3), imap=specs(:, 4), value=value, &
      & siz=nvalue, iostat=stat)
  else
    stat = gt_efake
  endif
  call storeerror(stat, subname, err=err)
  deallocate(specs)
end subroutine gtvarputint

subroutine gtvarputchar(var, value, nvalue, err)
  use gtdata_types, only: gt_variable
  use gtdata_internal_map, only: &
    & var_class, &
    & vtb_class_netcdf, &
    & map_to_internal_specs
  use gtdata_netcdf_generic,  only: put
  use gtdata_netcdf_types, only: gd_nc_variable
  use dc_error,    only: storeerror, gt_efake
  ! use dc_trace,    only: BeginSub, EndSub
  implicit none
  type(gt_variable), intent(in)            :: var
  integer,           intent(in)            :: nvalue
  character(*),      intent(in)            :: value(nvalue)
  logical,           intent(out), optional :: err
  ! Variables for Intenal work
  integer:: class, cid, stat, ndims
  integer, pointer:: specs(:, :)
  character(len = *), parameter:: subname = "GTVarPutChar"
  continue
  call var_class(var, class, cid)
  call map_to_internal_specs(var, specs, ndims)
  if (class == vtb_class_netcdf) then
    call put(gd_nc_variable(cid), start=specs(:, 1), count=specs(:, 2), &
      & stride=specs(:, 3), imap=specs(:, 4), value=value, &
      & siz=nvalue, iostat=stat)
  else
    stat = gt_efake
  endif
  call storeerror(stat, subname, err=err)
  deallocate(specs)
end subroutine gtvarputchar


subroutine gtvarputdouble1(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble1

subroutine gtvarputdouble2(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble2

subroutine gtvarputdouble3(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble3

subroutine gtvarputdouble4(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble4

subroutine gtvarputdouble5(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble5

subroutine gtvarputdouble6(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble6

subroutine gtvarputdouble7(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputdouble
  use dc_types,       only: dp
  real(DP), intent(in) :: value(:,:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputdouble(var, value, size(value), err)
end subroutine gtvarputdouble7

subroutine gtvarputreal1(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal1

subroutine gtvarputreal2(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal2

subroutine gtvarputreal3(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal3

subroutine gtvarputreal4(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal4

subroutine gtvarputreal5(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal5

subroutine gtvarputreal6(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal6

subroutine gtvarputreal7(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputreal
  use dc_types,       only: sp
  real(SP), intent(in) :: value(:,:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputreal(var, value, size(value), err)
end subroutine gtvarputreal7

subroutine gtvarputint1(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint1

subroutine gtvarputint2(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint2

subroutine gtvarputint3(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint3

subroutine gtvarputint4(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint4

subroutine gtvarputint5(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint5

subroutine gtvarputint6(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint6

subroutine gtvarputint7(var, value, err)
  use gtdata_types,   only: gt_variable
  use gtdata_generic, only: put, gtvarputint
  integer,  intent(in) :: value(:,:,:,:,:,:,:)
  type(gt_variable), intent(inout):: var
  logical  ,intent(out), optional:: err
  continue
  call gtvarputint(var, value, size(value), err)
end subroutine gtvarputint7