module ncdr_dims use ncd_kinds, only: i_long 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_dimension, NF90_MAX_NAME use netcdf_unlimdims, only: pf_nf90_inq_unlimdims implicit none interface nc_diag_read_lookup_dim module procedure nc_diag_read_id_lookup_dim, & nc_diag_read_noid_lookup_dim end interface nc_diag_read_lookup_dim interface nc_diag_read_assert_dim module procedure nc_diag_read_id_assert_dim, & nc_diag_read_noid_assert_dim end interface nc_diag_read_assert_dim interface nc_diag_read_check_dim module procedure nc_diag_read_id_check_dim, & nc_diag_read_noid_check_dim end interface nc_diag_read_check_dim interface nc_diag_read_get_dim module procedure nc_diag_read_id_get_dim, & nc_diag_read_noid_get_dim end interface nc_diag_read_get_dim interface nc_diag_read_check_dim_unlim module procedure nc_diag_read_id_check_dim_unlim, & nc_diag_read_noid_check_dim_unlim end interface nc_diag_read_check_dim_unlim interface nc_diag_read_get_dim_names module procedure nc_diag_read_id_get_dim_names end interface nc_diag_read_get_dim_names interface nc_diag_read_noid_get_dim_names module procedure nc_diag_read_noid_get_dim_names end interface nc_diag_read_noid_get_dim_names contains subroutine nc_diag_read_parse_file_dims(file_ncid, file_index, num_dims) integer(i_long), intent(in) :: file_ncid integer(i_long), intent(in) :: file_index integer(i_long), intent(in) :: num_dims integer(i_long), dimension(:), allocatable :: unlim_dims integer(i_long) :: num_unlims integer(i_long) :: i, j character(len=NF90_MAX_NAME) :: dim_name ncdr_files(file_index)%ndims = num_dims allocate(ncdr_files(file_index)%dims(num_dims)) ! Get unlimited dimension information call ncdr_nc_check(pf_nf90_inq_unlimdims(file_ncid, num_unlims)) allocate(unlim_dims(num_unlims)) call ncdr_nc_check(pf_nf90_inq_unlimdims(file_ncid, num_unlims, unlim_dims)) do i = 1, num_dims ncdr_files(file_index)%dims(i)%dim_id = i call ncdr_nc_check(nf90_inquire_dimension(file_ncid, i, & dim_name, & ncdr_files(file_index)%dims(i)%dim_size)) ncdr_files(file_index)%dims(i)%dim_name = trim(dim_name) ncdr_files(file_index)%dims(i)%dim_unlim = .FALSE. do j = 1, num_unlims if (i == unlim_dims(j)) then ncdr_files(file_index)%dims(i)%dim_unlim = .TRUE. exit end if end do end do end subroutine nc_diag_read_parse_file_dims function nc_diag_read_id_lookup_dim(file_ncdr_id, dim_name) result(dim_index) integer(i_long), intent(in) :: file_ncdr_id character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index call ncdr_check_ncdr_id(file_ncdr_id) do dim_index = 1, ncdr_files(file_ncdr_id)%ndims if (ncdr_files(file_ncdr_id)%dims(dim_index)%dim_name == dim_name) & return end do ! Otherwise, return -1! dim_index = -1 end function nc_diag_read_id_lookup_dim function nc_diag_read_noid_lookup_dim(dim_name) result(dim_index) character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index call ncdr_check_current_ncdr_id dim_index = nc_diag_read_id_lookup_dim(current_ncdr_id, dim_name) end function nc_diag_read_noid_lookup_dim function nc_diag_read_id_assert_dim(file_ncdr_id, dim_name) result(dim_index) integer(i_long), intent(in) :: file_ncdr_id character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index call ncdr_check_ncdr_id(file_ncdr_id) ! Otherwise, return -1! dim_index = nc_diag_read_id_lookup_dim(file_ncdr_id, dim_name) ! ...except don't, since we're asserting! if (dim_index == -1) & call ncdr_error("The specified dimension '" // dim_name // "' does not exist!") end function nc_diag_read_id_assert_dim function nc_diag_read_noid_assert_dim(dim_name) result(dim_index) character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index call ncdr_check_current_ncdr_id dim_index = nc_diag_read_id_assert_dim(current_ncdr_id, dim_name) end function nc_diag_read_noid_assert_dim function nc_diag_read_id_check_dim(file_ncdr_id, dim_name) result(dim_exists) integer(i_long), intent(in) :: file_ncdr_id character(len=*), intent(in) :: dim_name logical :: dim_exists call ncdr_check_ncdr_id(file_ncdr_id) if (nc_diag_read_id_lookup_dim(file_ncdr_id, dim_name) == -1) then dim_exists = .FALSE. return end if dim_exists = .TRUE. end function nc_diag_read_id_check_dim function nc_diag_read_noid_check_dim(dim_name) result(dim_exists) character(len=*), intent(in) :: dim_name logical :: dim_exists call ncdr_check_current_ncdr_id if (nc_diag_read_lookup_dim(dim_name) == -1) then dim_exists = .FALSE. return end if dim_exists = .TRUE. end function nc_diag_read_noid_check_dim function nc_diag_read_id_get_dim(file_ncdr_id, dim_name) result(dim_size) integer(i_long), intent(in) :: file_ncdr_id character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index, dim_size call ncdr_check_ncdr_id(file_ncdr_id) dim_index = nc_diag_read_id_assert_dim(file_ncdr_id, dim_name) dim_size = ncdr_files(file_ncdr_id)%dims(dim_index)%dim_size end function nc_diag_read_id_get_dim function nc_diag_read_noid_get_dim(dim_name) result(dim_size) character(len=*), intent(in) :: dim_name integer(i_long) :: dim_size call ncdr_check_current_ncdr_id dim_size = nc_diag_read_id_get_dim(current_ncdr_id, dim_name) end function nc_diag_read_noid_get_dim function nc_diag_read_id_check_dim_unlim(file_ncdr_id, dim_name) result(dim_isunlim) integer(i_long), intent(in) :: file_ncdr_id character(len=*), intent(in) :: dim_name integer(i_long) :: dim_index logical :: dim_isunlim call ncdr_check_ncdr_id(file_ncdr_id) dim_index = nc_diag_read_id_assert_dim(file_ncdr_id, dim_name) dim_isunlim = ncdr_files(file_ncdr_id)%dims(dim_index)%dim_unlim end function nc_diag_read_id_check_dim_unlim function nc_diag_read_noid_check_dim_unlim(dim_name) result(dim_isunlim) character(len=*), intent(in) :: dim_name logical :: dim_isunlim call ncdr_check_current_ncdr_id dim_isunlim = nc_diag_read_id_check_dim_unlim(current_ncdr_id, dim_name) end function nc_diag_read_noid_check_dim_unlim subroutine nc_diag_read_id_get_dim_names(file_ncdr_id, num_dims, dim_name_mlen, dim_names) integer(i_long), intent(in) :: file_ncdr_id integer(i_long), intent(out), optional :: num_dims integer(i_long), intent(out), optional :: dim_name_mlen character(len=:), intent(inout), dimension(:), allocatable, optional:: dim_names integer(i_long) :: dim_index, ndims, max_dim_name_len max_dim_name_len = 0 call ncdr_check_ncdr_id(file_ncdr_id) ndims = ncdr_files(file_ncdr_id)%ndims if (present(num_dims)) & num_dims = ndims ! Figure out character max length do dim_index = 1, ndims if (len(ncdr_files(file_ncdr_id)%dims(dim_index)%dim_name) > max_dim_name_len) & max_dim_name_len = len(ncdr_files(file_ncdr_id)%dims(dim_index)%dim_name) end do if (present(dim_name_mlen)) & dim_name_mlen = max_dim_name_len if (present(dim_names)) then if (.NOT. allocated(dim_names)) then allocate(character(max_dim_name_len) :: dim_names(ndims)) else if (size(dim_names) /= ndims) & call ncdr_error("Invalid allocated array size for dimension names storage!") if (len(dim_names) < max_dim_name_len) & call ncdr_error("Invalid allocated array size for dimension names storage! (String length does not match!)") end if do dim_index = 1, ndims dim_names(dim_index) = ncdr_files(file_ncdr_id)%dims(dim_index)%dim_name end do end if end subroutine nc_diag_read_id_get_dim_names subroutine nc_diag_read_noid_get_dim_names(num_dims, dim_name_mlen, dim_names) integer(i_long), intent(out), optional :: num_dims integer(i_long), intent(out), optional :: dim_name_mlen character(len=:), intent(inout), dimension(:), allocatable, optional:: dim_names call ncdr_check_current_ncdr_id if (present(num_dims)) then if (present(dim_name_mlen)) then if (present(dim_names)) then call nc_diag_read_id_get_dim_names(current_ncdr_id, num_dims, dim_name_mlen, dim_names) else call nc_diag_read_id_get_dim_names(current_ncdr_id, num_dims, dim_name_mlen) end if else if (present(dim_names)) then call nc_diag_read_id_get_dim_names(current_ncdr_id, num_dims, dim_names = dim_names) else call nc_diag_read_id_get_dim_names(current_ncdr_id, num_dims) end if end if else if (present(dim_name_mlen)) then if (present(dim_names)) then call nc_diag_read_id_get_dim_names(current_ncdr_id, dim_name_mlen = dim_name_mlen, & dim_names = dim_names) else call nc_diag_read_id_get_dim_names(current_ncdr_id, dim_name_mlen = dim_name_mlen) end if else if (present(dim_names)) then call nc_diag_read_id_get_dim_names(current_ncdr_id, dim_names = dim_names) else ! Why would you do this? call nc_diag_read_id_get_dim_names(current_ncdr_id) end if end if end if end subroutine nc_diag_read_noid_get_dim_names end module ncdr_dims