module ncdr_alloc_assert
! Allocate if things aren't allocated, or assert that things are
! all good to go.
!
! Other parts include just assertion functions (e.g. asserting
! that a variable exists).
use ncd_kinds, only: i_byte, i_short, i_long, r_single, r_double
use ncdr_state, only: ncdr_files, current_ncdr_id
use ncdr_climsg, only: ncdr_error
use ncdr_check, only: ncdr_nc_check, ncdr_check_ncdr_id, &
ncdr_check_current_ncdr_id
use netcdf, only: nf90_inquire_attribute, NF90_GLOBAL, NF90_BYTE, &
NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE, NF90_CHAR
implicit none
interface nc_diag_read_assert_var
module procedure nc_diag_read_id_assert_var, &
nc_diag_read_noid_assert_var
end interface nc_diag_read_assert_var
interface nc_diag_read_assert_attr
module procedure nc_diag_read_id_assert_attr, &
nc_diag_read_noid_assert_attr
end interface nc_diag_read_assert_attr
interface nc_diag_read_assert_global_attr
module procedure nc_diag_read_id_assert_global_attr, &
nc_diag_read_noid_assert_global_attr
end interface nc_diag_read_assert_global_attr
interface nc_diag_read_assert_dims
! Note that nc_diag_read_assert_dims_alloc_string is seperate
! since it is rare and conflicts with the non-alloc def.
module procedure &
nc_diag_read_assert_dims_single_byte, &
nc_diag_read_assert_dims_single_short, &
nc_diag_read_assert_dims_single_long, &
nc_diag_read_assert_dims_single_float, &
nc_diag_read_assert_dims_single_double, &
nc_diag_read_assert_dims_string, &
nc_diag_read_assert_dims_1d_byte, &
nc_diag_read_assert_dims_1d_short, &
nc_diag_read_assert_dims_1d_long, &
nc_diag_read_assert_dims_1d_float, &
nc_diag_read_assert_dims_1d_double, &
nc_diag_read_assert_dims_1d_string, &
nc_diag_read_assert_dims_2d_byte, &
nc_diag_read_assert_dims_2d_short, &
nc_diag_read_assert_dims_2d_long, &
nc_diag_read_assert_dims_2d_float, &
nc_diag_read_assert_dims_2d_double, &
nc_diag_read_assert_dims_2d_string
end interface nc_diag_read_assert_dims
contains
function nc_diag_read_id_assert_var(file_ncdr_id, var_name) result(var_index)
integer(i_long), intent(in) :: file_ncdr_id
character(len=*), intent(in) :: var_name
integer(i_long) :: var_index
call ncdr_check_ncdr_id(file_ncdr_id)
do var_index = 1, ncdr_files(file_ncdr_id)%nvars
if (ncdr_files(file_ncdr_id)%vars(var_index)%var_name == var_name) &
return
end do
! If we didn't find anything, show an error!
call ncdr_error("The specified variable '" // var_name // "' does not exist!")
end function nc_diag_read_id_assert_var
function nc_diag_read_noid_assert_var(var_name) result(var_index)
character(len=*), intent(in) :: var_name
integer(i_long) :: var_index
call ncdr_check_current_ncdr_id
var_index = nc_diag_read_id_assert_var(current_ncdr_id, var_name)
end function nc_diag_read_noid_assert_var
subroutine nc_diag_read_id_assert_attr(file_ncdr_id, var_name, attr_name, attr_type, attr_len)
integer(i_long), intent(in) :: file_ncdr_id
character(len=*), intent(in) :: var_name
character(len=*), intent(in) :: attr_name
integer(i_long), intent(out) :: attr_type
integer(i_long), intent(out) :: attr_len
integer(i_long) :: var_id
call ncdr_check_ncdr_id(file_ncdr_id)
var_id = ncdr_files(file_ncdr_id)%vars( &
nc_diag_read_assert_var(file_ncdr_id, var_name) )%var_id
call ncdr_nc_check(nf90_inquire_attribute(ncdr_files(file_ncdr_id)%ncid, &
var_id, &
attr_name, attr_type, attr_len))
end subroutine nc_diag_read_id_assert_attr
subroutine nc_diag_read_noid_assert_attr(var_name, attr_name, attr_type, attr_len)
character(*), intent(in) :: var_name
character(len=*), intent(in) :: attr_name
integer(i_long), intent(out) :: attr_type
integer(i_long), intent(out) :: attr_len
call ncdr_check_current_ncdr_id
call nc_diag_read_id_assert_attr(current_ncdr_id, var_name, attr_name, attr_type, attr_len)
end subroutine nc_diag_read_noid_assert_attr
subroutine nc_diag_read_id_assert_global_attr(file_ncdr_id, attr_name, attr_type, attr_len)
integer(i_long), intent(in) :: file_ncdr_id
character(len=*), intent(in) :: attr_name
integer(i_long), intent(out) :: attr_type
integer(i_long), intent(out) :: attr_len
call ncdr_check_ncdr_id(file_ncdr_id)
call ncdr_nc_check(nf90_inquire_attribute(ncdr_files(file_ncdr_id)%ncid, &
NF90_GLOBAL, &
attr_name, attr_type, attr_len))
end subroutine nc_diag_read_id_assert_global_attr
subroutine nc_diag_read_noid_assert_global_attr(attr_name, attr_type, attr_len)
character(len=*), intent(in) :: attr_name
integer(i_long), intent(out) :: attr_type
integer(i_long), intent(out) :: attr_len
call ncdr_check_current_ncdr_id
call nc_diag_read_id_assert_global_attr(current_ncdr_id, attr_name, attr_type, attr_len)
end subroutine nc_diag_read_noid_assert_global_attr
subroutine nc_diag_read_assert_var_type(var_type, correct_var_type)
integer(i_long) :: var_type
integer(i_long) :: correct_var_type
if (var_type /= correct_var_type) &
call ncdr_error("Mismatched type for variable! Got " // &
nc_diag_read_get_type_str(var_type) // &
" when " // &
nc_diag_read_get_type_str(correct_var_type) // &
" was expected for the variable!")
end subroutine nc_diag_read_assert_var_type
subroutine nc_diag_read_assert_attr_type(attr_type, correct_attr_type)
integer(i_long) :: attr_type
integer(i_long) :: correct_attr_type
if (attr_type /= correct_attr_type) &
call ncdr_error("Mismatched type for attribute! Got " // &
nc_diag_read_get_type_str(attr_type) // &
" when " // &
nc_diag_read_get_type_str(correct_attr_type) // &
" was expected for the attribute!")
end subroutine nc_diag_read_assert_attr_type
subroutine nc_diag_read_assert_global_attr_type(attr_type, correct_attr_type)
integer(i_long) :: attr_type
integer(i_long) :: correct_attr_type
if (attr_type /= correct_attr_type) &
call ncdr_error("Mismatched type for global attribute! Got " // &
nc_diag_read_get_type_str(attr_type) // &
" when " // &
nc_diag_read_get_type_str(correct_attr_type) // &
" was expected for the global attribute!")
end subroutine nc_diag_read_assert_global_attr_type
function nc_diag_read_get_type_str(var_type) result(type_str)
integer(i_long) :: var_type
character(len=:), allocatable :: type_str
if (var_type == NF90_BYTE) then
type_str = "NF90_BYTE"
else if (var_type == NF90_SHORT) then
type_str = "NF90_SHORT"
else if (var_type == NF90_INT) then
type_str = "NF90_INT"
else if (var_type == NF90_FLOAT) then
type_str = "NF90_FLOAT"
else if (var_type == NF90_DOUBLE) then
type_str = "NF90_DOUBLE"
else if (var_type == NF90_CHAR) then
type_str = "NF90_CHAR"
else if (var_type == 12) then
type_str = "NF90_STRING (not supported)"
else
type_str = "(unknown type)"
end if
end function nc_diag_read_get_type_str
subroutine nc_diag_read_assert_var_ndims(var_ndims, correct_var_ndims)
integer(i_long) :: var_ndims
integer(i_long) :: correct_var_ndims
if (var_ndims /= correct_var_ndims) &
call ncdr_error("Mismatched dimensions for variable!")
end subroutine nc_diag_read_assert_var_ndims
!-------------------------------------------------------------
! Variable allocation and assertion subroutines
!-------------------------------------------------------------
subroutine nc_diag_read_assert_dims_string(var_stor, correct_dims)
character(len=*), intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (len(var_stor) < correct_dims(1)) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_string
subroutine nc_diag_read_assert_dims_single_byte(var_stor, correct_dims)
integer(i_byte), intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (correct_dims(1) /= 1) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_single_byte
subroutine nc_diag_read_assert_dims_single_short(var_stor, correct_dims)
integer(i_short), intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (correct_dims(1) /= 1) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_single_short
subroutine nc_diag_read_assert_dims_single_long(var_stor, correct_dims)
integer(i_long), intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (correct_dims(1) /= 1) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_single_long
subroutine nc_diag_read_assert_dims_single_float(var_stor, correct_dims)
real(r_single) , intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (correct_dims(1) /= 1) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_single_float
subroutine nc_diag_read_assert_dims_single_double(var_stor, correct_dims)
real(r_double) , intent(in) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (correct_dims(1) /= 1) &
call ncdr_error("Mismatched dimensions for variable storage!")
end subroutine nc_diag_read_assert_dims_single_double
subroutine nc_diag_read_assert_dims_alloc_string(var_stor, correct_dims)
character(len=:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (len(var_stor) /= correct_dims(1)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(character(len=correct_dims(1)) :: var_stor)
end if
end subroutine nc_diag_read_assert_dims_alloc_string
subroutine nc_diag_read_assert_dims_1d_byte(var_stor, correct_dims)
integer(i_byte),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1)))
end if
end subroutine nc_diag_read_assert_dims_1d_byte
subroutine nc_diag_read_assert_dims_1d_short(var_stor, correct_dims)
integer(i_short),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1)))
end if
end subroutine nc_diag_read_assert_dims_1d_short
subroutine nc_diag_read_assert_dims_1d_long(var_stor, correct_dims)
integer(i_long),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1)))
end if
end subroutine nc_diag_read_assert_dims_1d_long
subroutine nc_diag_read_assert_dims_1d_float(var_stor, correct_dims)
real(r_single),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1)))
end if
end subroutine nc_diag_read_assert_dims_1d_float
subroutine nc_diag_read_assert_dims_1d_double(var_stor, correct_dims)
real(r_double),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 1
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1)))
end if
end subroutine nc_diag_read_assert_dims_1d_double
subroutine nc_diag_read_assert_dims_1d_string(var_stor, correct_dims)
character(len=:),dimension(:),allocatable,intent(inout) :: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (len(var_stor) /= correct_dims(1)) &
call ncdr_error("Mismatched dimensions for variable storage!")
if (size(var_stor) /= correct_dims(2)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(character(len=correct_dims(1)) :: var_stor(correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_1d_string
subroutine nc_diag_read_assert_dims_2d_byte(var_stor, correct_dims)
integer(i_byte),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1), correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_2d_byte
subroutine nc_diag_read_assert_dims_2d_short(var_stor, correct_dims)
integer(i_short),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1), correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_2d_short
subroutine nc_diag_read_assert_dims_2d_long(var_stor, correct_dims)
integer(i_long),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1), correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_2d_long
subroutine nc_diag_read_assert_dims_2d_float(var_stor, correct_dims)
real(r_single),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1), correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_2d_float
subroutine nc_diag_read_assert_dims_2d_double(var_stor, correct_dims)
real(r_double),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 2
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (any(shape(var_stor) /= correct_dims)) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(var_stor(correct_dims(1), correct_dims(2)))
end if
end subroutine nc_diag_read_assert_dims_2d_double
subroutine nc_diag_read_assert_dims_2d_string(var_stor, correct_dims)
character(len=:),dimension(:,:),allocatable,intent(inout):: var_stor
integer(i_long), dimension(:), intent(in) :: correct_dims
integer(i_long), parameter :: correct_ndims = 3
! If allocated, make sure the dimensions are correct.
! If not, go ahead and allocate it ourselves.
if (allocated(var_stor)) then
if (size(correct_dims) /= correct_ndims) &
call ncdr_error("Invalid number of dimensions for variable!")
if (len(var_stor) /= correct_dims(1)) &
call ncdr_error("Mismatched dimensions for variable storage!")
if (any(shape(var_stor) /= correct_dims(2:3))) &
call ncdr_error("Mismatched dimensions for variable storage!")
else
allocate(character(len=correct_dims(1)) :: var_stor(correct_dims(2), correct_dims(3)))
end if
end subroutine nc_diag_read_assert_dims_2d_string
end module ncdr_alloc_assert