ncdc_dims.F90

Go to the documentation of this file.

module ncdc_dims
    use ncd_kinds, only: i_long
    use ncdc_state, only: dim_names, dim_sizes, dim_unlim_sizes, &
        dim_counters, dim_output_ids, dim_arr_total, dim_arr_size
    use ncdc_realloc, only: nc_diag_realloc
    use ncdc_climsg, only: ncdc_error, ncdc_warning
    
    implicit none
    
    integer(i_long), parameter                 :: dim_start_size = 256
    
    contains
        function nc_diag_cat_lookup_dim(dim_name) result(ind)
            character(len=*), intent(in)    :: dim_name
            integer(i_long)                 :: i, ind
            
            ind = -1
            
            if (allocated(dim_names)) then
                do i = 1, dim_arr_total
                    if (dim_names(i) == dim_name) then
                        ind = i
                        exit
                    end if
                end do
            end if
        end function nc_diag_cat_lookup_dim
        
        subroutine nc_diag_cat_metadata_add_dim(dim_name, dim_size, dim_ul_size)
            character(len=*),         intent(in) :: dim_name
            integer(i_long) ,         intent(in) :: dim_size
            integer(i_long),optional, intent(in) :: dim_ul_size
            
            integer(i_long)                 :: dim_index
            character(len=1000)             :: err_string
            
            dim_index = nc_diag_cat_lookup_dim(dim_name)
            
            ! If we can't find it, it's new! Make sure we have enough
            ! space for it...
            if (dim_index == -1) then
#ifdef DEBUG
                print *, "NEW DIM!"
#endif
                dim_arr_total = dim_arr_total + 1
                
                if (dim_arr_total >= dim_arr_size) then
                    if (allocated(dim_names)) then
                        call nc_diag_realloc(dim_names, dim_start_size)
                        call nc_diag_realloc(dim_sizes, dim_start_size)
                        call nc_diag_realloc(dim_counters, dim_start_size)
                        call nc_diag_realloc(dim_output_ids, dim_start_size)
                        call nc_diag_realloc(dim_unlim_sizes, dim_start_size)
                        dim_arr_size = dim_arr_size + dim_start_size
                    else
                        allocate(dim_names(dim_start_size))
                        allocate(dim_sizes(dim_start_size))
                        allocate(dim_counters(dim_start_size))
                        allocate(dim_output_ids(dim_start_size))
                        allocate(dim_unlim_sizes(dim_start_size))
                        dim_arr_size = dim_start_size
                    end if
                end if
                
                dim_index = dim_arr_total
                
                ! Add name
                dim_names(dim_index) = dim_name
                dim_sizes(dim_index) = 0
                dim_unlim_sizes(dim_index) = 0
                
                ! Set counter to 0
                dim_counters(dim_index) = 0
                dim_output_ids(dim_index) = -1
            end if
            
            if (dim_size /= -1) then
                ! Add/update size
                if ((index(dim_name, "_maxstrlen") /= 0) .OR. (index(dim_name, "_str_dim") /= 0)) then
                    ! Use the maximum as the new size... and skip the check.
                    if (dim_size > dim_sizes(dim_index)) dim_sizes(dim_index) = dim_size
                else
                    if ((dim_sizes(dim_index) /= 0) .AND. (dim_size /= dim_sizes(dim_index))) then
                        write (err_string, "(A, I0, A, I0, A)") &
                            "Fixed dimension length changed between files!" // &
                            char(10) // "             " // &
                            "(Fixed dimension '" // dim_name // "' changed from length ", &
                            dim_sizes(dim_index), &
                            char(10) // "             " // &
                            "to ", &
                            dim_size, &
                            "!)"
                        call ncdc_error(trim(err_string))
                    end if
                    dim_sizes(dim_index) = dim_size
                end if
            else
                if ((dim_sizes(dim_index) /= -1) .AND. (dim_sizes(dim_index) /= 0)) then
                    write (err_string, "(A, I0, A)") &
                        "Changed from a fixed dimension length to unlimited" // &
                        char(10) // "             " // &
                        "dimension length. (Fixed dimension '" // &
                        trim(dim_name) // &
                        "' had a fixed" // &
                        char(10) // "             " // &
                        "length of ", &
                        dim_sizes(dim_index), &
                        "!)"
                    call ncdc_error(trim(err_string))
                end if
                dim_sizes(dim_index) = -1
                
                if (present(dim_ul_size)) then
                    dim_unlim_sizes(dim_index) = dim_unlim_sizes(dim_index) + dim_ul_size
                else
                    call ncdc_warning("Call made for unlimited dimension without specifying unlimited size!")
                end if
            end if
        end subroutine nc_diag_cat_metadata_add_dim
end module ncdc_dims