gtvargetpointernum.f90 File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	gtvargetpointerdouble1 (var, value, err)
subroutine	gtvargetpointerdouble2 (var, value, err)
subroutine	gtvargetpointerdouble3 (var, value, err)
subroutine	gtvargetpointerdouble4 (var, value, err)
subroutine	gtvargetpointerdouble5 (var, value, err)
subroutine	gtvargetpointerdouble6 (var, value, err)
subroutine	gtvargetpointerdouble7 (var, value, err)
subroutine	gtvargetpointerreal1 (var, value, err)
subroutine	gtvargetpointerreal2 (var, value, err)
subroutine	gtvargetpointerreal3 (var, value, err)
subroutine	gtvargetpointerreal4 (var, value, err)
subroutine	gtvargetpointerreal5 (var, value, err)
subroutine	gtvargetpointerreal6 (var, value, err)
subroutine	gtvargetpointerreal7 (var, value, err)
subroutine	gtvargetpointerint1 (var, value, err)
subroutine	gtvargetpointerint2 (var, value, err)
subroutine	gtvargetpointerint3 (var, value, err)
subroutine	gtvargetpointerint4 (var, value, err)
subroutine	gtvargetpointerint5 (var, value, err)
subroutine	gtvargetpointerint6 (var, value, err)
subroutine	gtvargetpointerint7 (var, value, err)

Function/Subroutine Documentation

gtvargetpointerdouble1()

subroutine gtvargetpointerdouble1	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 56 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(1), cause_i, data_rank
  logical                         :: invalid_check(1)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble1'
  continue
  cause_i = 0
  cause_c = ''
  n(1) = -1
  stat = dc_noerr
  call map_set_rank(var, 1, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  if (n(1) < 0) then
    ! count_compact ではないので、ゼロ次元化していると n = -1 となる
    n(1) = 1
  endif
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 1'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = array1dim_tmp
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble2()

subroutine gtvargetpointerdouble2	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 126 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(2), cause_i, data_rank
  logical                         :: invalid_check(2)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble2'
  continue
  cause_i = 0
  cause_c = ''
  n(2) = -1
  stat = dc_noerr
  call map_set_rank(var, 2, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 2'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble3()

subroutine gtvargetpointerdouble3	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 195 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(3), cause_i, data_rank
  logical                         :: invalid_check(3)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble3'
  continue
  cause_i = 0
  cause_c = ''
  n(3) = -1
  stat = dc_noerr
  call map_set_rank(var, 3, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 3'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble4()

subroutine gtvargetpointerdouble4	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 267 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:,:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(4), cause_i, data_rank
  logical                         :: invalid_check(4)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble4'
  continue
  cause_i = 0
  cause_c = ''
  n(4) = -1
  stat = dc_noerr
  call map_set_rank(var, 4, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 4'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble5()

subroutine gtvargetpointerdouble5	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 342 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:,:,:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(5), cause_i, data_rank
  logical                         :: invalid_check(5)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble5'
  continue
  cause_i = 0
  cause_c = ''
  n(5) = -1
  stat = dc_noerr
  call map_set_rank(var, 5, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 5'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble6()

subroutine gtvargetpointerdouble6	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 420 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:,:,:,:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(6), cause_i, data_rank
  logical                         :: invalid_check(6)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble6'
  continue
  cause_i = 0
  cause_c = ''
  n(6) = -1
  stat = dc_noerr
  call map_set_rank(var, 6, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 6'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerdouble7()

subroutine gtvargetpointerdouble7	(	type(gt_variable), intent(in)	var,
		real(dp), dimension(:,:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 501 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetdouble
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, dp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(DP), pointer :: value(:,:,:,:,:,:,:) !(out)
  real(DP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(7), cause_i, data_rank
  logical                         :: invalid_check(7)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerDouble7'
  continue
  cause_i = 0
  cause_c = ''
  n(7) = -1
  stat = dc_noerr
  call map_set_rank(var, 7, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 7'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .not. size(value,7) == n(7) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6),  &
      & n(7))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetdouble(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_types::dp, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetdouble(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint1()

subroutine gtvargetpointerint1	(	type(gt_variable), intent(in)	var,
		integer, dimension(:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1114 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(1), cause_i, data_rank
  logical                         :: invalid_check(1)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt1'
  continue
  cause_i = 0
  cause_c = ''
  n(1) = -1
  stat = dc_noerr
  call map_set_rank(var, 1, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  if (n(1) < 0) then
    ! count_compact ではないので、ゼロ次元化していると n = -1 となる
    n(1) = 1
  endif
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 1'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = array1dim_tmp
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint2()

subroutine gtvargetpointerint2	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1184 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(2), cause_i, data_rank
  logical                         :: invalid_check(2)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt2'
  continue
  cause_i = 0
  cause_c = ''
  n(2) = -1
  stat = dc_noerr
  call map_set_rank(var, 2, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 2'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint3()

subroutine gtvargetpointerint3	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1253 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(3), cause_i, data_rank
  logical                         :: invalid_check(3)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt3'
  continue
  cause_i = 0
  cause_c = ''
  n(3) = -1
  stat = dc_noerr
  call map_set_rank(var, 3, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 3'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint4()

subroutine gtvargetpointerint4	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1325 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:,:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(4), cause_i, data_rank
  logical                         :: invalid_check(4)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt4'
  continue
  cause_i = 0
  cause_c = ''
  n(4) = -1
  stat = dc_noerr
  call map_set_rank(var, 4, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 4'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint5()

subroutine gtvargetpointerint5	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1400 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:,:,:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(5), cause_i, data_rank
  logical                         :: invalid_check(5)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt5'
  continue
  cause_i = 0
  cause_c = ''
  n(5) = -1
  stat = dc_noerr
  call map_set_rank(var, 5, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 5'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint6()

subroutine gtvargetpointerint6	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1478 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:,:,:,:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(6), cause_i, data_rank
  logical                         :: invalid_check(6)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt6'
  continue
  cause_i = 0
  cause_c = ''
  n(6) = -1
  stat = dc_noerr
  call map_set_rank(var, 6, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 6'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerint7()

subroutine gtvargetpointerint7	(	type(gt_variable), intent(in)	var,
		integer, dimension(:,:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1559 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetint
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  integer, pointer :: value(:,:,:,:,:,:,:) !(out)
  integer, allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(7), cause_i, data_rank
  logical                         :: invalid_check(7)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerInt7'
  continue
  cause_i = 0
  cause_c = ''
  n(7) = -1
  stat = dc_noerr
  call map_set_rank(var, 7, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 7'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .not. size(value,7) == n(7) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6),  &
      & n(7))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetint(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetint(), gtdata_internal_map::map_set_rank(), dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal1()

subroutine gtvargetpointerreal1	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 585 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(1), cause_i, data_rank
  logical                         :: invalid_check(1)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal1'
  continue
  cause_i = 0
  cause_c = ''
  n(1) = -1
  stat = dc_noerr
  call map_set_rank(var, 1, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  if (n(1) < 0) then
    ! count_compact ではないので、ゼロ次元化していると n = -1 となる
    n(1) = 1
  endif
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 1'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = array1dim_tmp
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal2()

subroutine gtvargetpointerreal2	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 655 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(2), cause_i, data_rank
  logical                         :: invalid_check(2)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal2'
  continue
  cause_i = 0
  cause_c = ''
  n(2) = -1
  stat = dc_noerr
  call map_set_rank(var, 2, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 2'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal3()

subroutine gtvargetpointerreal3	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 724 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(3), cause_i, data_rank
  logical                         :: invalid_check(3)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal3'
  continue
  cause_i = 0
  cause_c = ''
  n(3) = -1
  stat = dc_noerr
  call map_set_rank(var, 3, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 3'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal4()

subroutine gtvargetpointerreal4	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 796 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:,:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(4), cause_i, data_rank
  logical                         :: invalid_check(4)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal4'
  continue
  cause_i = 0
  cause_c = ''
  n(4) = -1
  stat = dc_noerr
  call map_set_rank(var, 4, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 4'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal5()

subroutine gtvargetpointerreal5	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 871 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:,:,:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(5), cause_i, data_rank
  logical                         :: invalid_check(5)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal5'
  continue
  cause_i = 0
  cause_c = ''
  n(5) = -1
  stat = dc_noerr
  call map_set_rank(var, 5, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 5'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal6()

subroutine gtvargetpointerreal6	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 949 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:,:,:,:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(6), cause_i, data_rank
  logical                         :: invalid_check(6)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal6'
  continue
  cause_i = 0
  cause_c = ''
  n(6) = -1
  stat = dc_noerr
  call map_set_rank(var, 6, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 6'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function:

gtvargetpointerreal7()

subroutine gtvargetpointerreal7	(	type(gt_variable), intent(in)	var,
		real(sp), dimension(:,:,:,:,:,:,:), pointer	value,
		logical, intent(out), optional	err
	)

Definition at line 1030 of file gtvargetpointernum.f90.

  use gtdata_types,          only: gt_variable
  use gtdata_generic,        only: get_slice, gtvargetreal
  use gtdata_internal_map,   only: map_set_rank
  use gtdata_netcdf_generic, only: get
  use gtdata_netcdf_types,   only: gd_nc_variable
  use dc_types,              only: string, sp
  use dc_trace,              only: dbgmessage
  use dc_error,              only: storeerror, dc_noerr, &
    & gt_ebadallocatesize, gt_enomoredims, gt_erankmismatch
  use dc_string,             only: tochar
  implicit none
  type(GT_VARIABLE), intent(in):: var
  real(SP), pointer :: value(:,:,:,:,:,:,:) !(out)
  real(SP), allocatable :: array1dim_tmp(:)
  logical, intent(out), optional  :: err
  integer                         :: stat, n(7), cause_i, data_rank
  logical                         :: invalid_check(7)
  character(STRING)               :: cause_c
  character(*), parameter :: subname = 'GTVarGetPointerReal7'
  continue
  cause_i = 0
  cause_c = ''
  n(7) = -1
  stat = dc_noerr
  call map_set_rank(var, 7, stat)
  if (stat /= dc_noerr) goto 999
  call get_slice(var, dimord=1, count=n(1), count_compact=.false.)
  call get_slice(var, dimord=2, count=n(2), count_compact=.false.)
  call get_slice(var, dimord=3, count=n(3), count_compact=.false.)
  call get_slice(var, dimord=4, count=n(4), count_compact=.false.)
  call get_slice(var, dimord=5, count=n(5), count_compact=.false.)
  call get_slice(var, dimord=6, count=n(6), count_compact=.false.)
  call get_slice(var, dimord=7, count=n(7), count_compact=.false.)
  call dbgmessage('n(:)=%*d', i=n, n=(/size(n)/))
  invalid_check = n > 0
  if (.not. all(invalid_check)) then
    stat = gt_erankmismatch
    data_rank = count(invalid_check)
    cause_c = trim(tochar(data_rank)) // ' and 7'
    goto 999
  end if
  ! value が allocate されていなければ allocate する.
  ! value が既に allocate されていてサイズが取得するデータと同じで
  ! あればそのまま取得.
  ! value が allocate されていてサイズが異なる場合はエラー.
  if ( associated(value) ) then
    if ( &
      & .not. size(value,1) == n(1) .or. &
      & .not. size(value,2) == n(2) .or. &
      & .not. size(value,3) == n(3) .or. &
      & .not. size(value,4) == n(4) .or. &
      & .not. size(value,5) == n(5) .or. &
      & .not. size(value,6) == n(6) .or. &
      & .not. size(value,7) == n(7) .or. &
      & .false.                             ) then
      stat = gt_ebadallocatesize
      if (stat /= dc_noerr) goto 999
    else
      call dbgmessage('@ value is already allocated')
    endif
  else
    call dbgmessage('@ allocate value')
    allocate( value(&
      & n(1),  &
      & n(2),  &
      & n(3),  &
      & n(4),  &
      & n(5),  &
      & n(6),  &
      & n(7))  &
      &  )
  endif
  if (allocated(array1dim_tmp)) then
    deallocate(array1dim_tmp)
  end if
  allocate(array1dim_tmp(product(n)))
  call gtvargetreal(var, array1dim_tmp, product(n), err)
  !    call DbgMessage('max=%f min=%f', d=(/maxval(value), minval(value)/))
  value = reshape(array1dim_tmp, n)
999 continue
  call storeerror(stat, subname, err, cause_i=cause_i, cause_c=cause_c)

References dc_error::dc_noerr, dc_error::gt_ebadallocatesize, dc_error::gt_enomoredims, dc_error::gt_erankmismatch, gtvargetreal(), gtdata_internal_map::map_set_rank(), dc_types::sp, dc_error::storeerror(), and dc_types::string.

Here is the call graph for this function: