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 57 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 127 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 196 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 268 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 343 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 421 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 502 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1115 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1185 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1254 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1326 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1401 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1479 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1560 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 586 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 656 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 725 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 797 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 872 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 950 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

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 1031 of file gtvargetpointernum.f90.

References dc_trace::dbgmessage(), 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.

  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)

Here is the call graph for this function: