ncdr_alloc_assert.f90

Go to the documentation of this file.

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, &
        nf90_string
    
    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 == nf90_string) 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