PlotStereoMap <- function(var, lon, lat, latlims = c(60, 90), 
                          toptitle = NULL, sizetit = 1, units = NULL, 
                          brks = NULL, cols = NULL, colNA = 'white',
                          filled.continents = FALSE, coast_color = NULL, 
                          coast_width = 1,
                          dots = NULL, dot_symbols = '.', dot_sizes = 0.8,
                          intlat = 10, 
                          drawleg = TRUE, subsampleg = 1, 
                          boxlim = NULL, boxcol = "purple2", boxlwd = 5,
                          fileout = NULL, ...) {
  # Process the user graphical parameters that may be passed in the call
  ## Graphical parameters to exclude
  excludedArgs <- c("cex", "cex.main", "col", "fin", "lab", "las", "lwd", "mai", "mar", "mgp", "new", "pch", "ps")
  userArgs <- .FilterUserGraphicArgs(excludedArgs, ...)

  # If there is any filenames to store the graphics, process them
  # to select the right device 
  if (!is.null(fileout)) {
    deviceInfo <- .SelectDevice(fileout)
    saveToFile <- deviceInfo$fun
    fileout <- deviceInfo$files
  }

  # Preliminar check of dots, lon, lat
  if (!is.null(dots)) {
    if (!is.array(dots) || !(length(dim(dots)) %in% c(2, 3))) {
      stop("Parameter 'dots' must be a logical array with two or three dimensions.")
    }
    if (length(dim(dots)) == 2) {
      dim(dots) <- c(1, dim(dots))
    }
  }
  if (!is.numeric(lon) || !is.numeric(lat)) {
    stop("Parameters 'lon' and 'lat' must be numeric vectors.")
  }

  # Check var
  if (!is.array(var)) {
    stop("Parameter 'var' must be a numeric array.")
  }
  if (length(dim(var)) > 2) {
    var <- drop(var)
    dim(var) <- head(c(dim(var), 1, 1), 2)
  }
  if (length(dim(var)) > 2) {
    stop("Parameter 'var' must be a numeric array with two dimensions. See PlotMultiMap() for multi-pannel maps or AnimateMap() for animated maps.")
  } else if (length(dim(var)) < 2) {
    stop("Parameter 'var' must be a numeric array with two dimensions.")
  }
  dims <- dim(var)
  # Transpose the input matrices because the base plot functions work directly 
  # with dimensions c(lon, lat).
  if (dims[1] != length(lon) || dims[2] != length(lat)) {
    if (dims[1] == length(lat) && dims[2] == length(lon)) {
      var <- t(var)
      if (!is.null(dots)) dots <- aperm(dots, c(1, 3, 2))
      dims <- dim(var)
    }
  }


  # Check lon
  if (length(lon) != dims[1]) {
    stop("Parameter 'lon' must have as many elements as the number of cells along longitudes in the input array 'var'.")
  }

  # Check lat
  if (length(lat) != dims[2]) {
    stop("Parameter 'lat' must have as many elements as the number of cells along longitudes in the input array 'var'.")
  }

  # Check latlims
  if (!is.numeric(latlims) || length(latlims) != 2) {
    stop("Parameter 'latlims' must be a numeric vector with two elements.")
  }
  latlims <- sort(latlims)
  center_at <- 90 * sign(latlims[which.max(abs(latlims))])
  if (max(abs(latlims - center_at)) > 90 + 20) {
    stop("The range specified in 'latlims' is too wide. 110 degrees supported maximum.")
  }
  dlon <- median(lon[2:dims[1]] - lon[1:(dims[1] - 1)]) / 2
  dlat <- median(lat[2:dims[2]] - lat[1:(dims[2] - 1)]) / 2
  original_last_lat <- latlims[which.min(abs(latlims))]
  last_lat <- lat[which.min(abs(lat - original_last_lat))] - dlat * sign(center_at)
  latlims[which.min(abs(latlims))] <- last_lat

  # Check toptitle
  if (is.null(toptitle)) {
    toptitle <- ''
  }
  if (!is.character(toptitle)) {
    stop("Parameter 'toptitle' must be a character string.")
  }

  # Check sizetit
  if (!is.numeric(sizetit) || length(sizetit) != 1) {
    stop("Parameter 'sizetit' must be a single numeric value.")
  }

  # Check units
  if (is.null(units)) {
    units <- ''
  }
  if (!is.character(units)) {
    stop("Parameter 'units' must be a character string.")
  } 

  # Check brks and cols
  varlim <- signif(c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)), 4)
  if (!is.null(cols)) {
    if (!is.character(cols)) {
      stop("Parameter 'cols' must be a character vector.")
    }
  }
  if (is.null(brks)) {
    if (!is.null(cols)) {
      brks <- length(cols) + 1
    } else {
      brks <- 21
    }
  }
  if (is.numeric(brks)) {
    if (length(brks) == 1) {
      brks <- seq(varlim[1], varlim[2], length.out = brks)
    }
    if (is.null(cols)) {
      cols <- clim.colors(length(brks) - 1)
    } else if (length(cols) != (length(brks) - 1)) {
      stop("Inconsistent number of 'brks' and 'cols'. There must be one more break than the number of colours.")
    }
  } else {
    stop("Parameter 'brks' must be a numeric vector.")
  }

  # Check colNA
  if (!is.character(colNA)) {
    stop("Parameter 'colNA' must be a character string.")
  }

  # Check filled.continents
  if (!.IsColor(filled.continents) && !is.logical(filled.continents)) {
    stop("Parameter 'filled.continents' must be logical or a colour identifier.")
  } else if (!is.logical(filled.continents)) {
    continent_color <- filled.continents
    filled.continents <- TRUE
  } else if (filled.continents) {
    continent_color <- gray(0.5)
  }

  # Check coast_color
  if (is.null(coast_color)) {
    if (filled.continents) {
      coast_color <- continent_color
    } else {
      coast_color <- 'black'
    }
  }
  if (!.IsColor(coast_color)) {
    stop("Parameter 'coast_color' must be a valid colour identifier.")
  }

  # Check coast_width
  if (!is.numeric(coast_width)) {
    stop("Parameter 'coast_width' must be numeric.")
  }

  # Check dots, dot_symbols and dot_sizes
  if (!is.null(dots)) {
    if (dim(dots)[2] != dims[1] || dim(dots)[3] != dims[2]) {
      stop("Parameter 'dots' must have the same number of longitudes and latitudes as 'var'.")
    }
    if (is.null(dot_symbols)) {
      dot_symbols <- c('.', '/', '*', 'o', 'x', 1:(dim(dots)[1] - 5))
    } else if (length(dot_symbols) == 1) {
      dot_symbols <- rep(dot_symbols, dim(dots)[1])
    } else if (length(dot_symbols) < dim(dots)[1]) {
      stop("Parameter 'dot_symbols' does not contain enough symbols.")
    }
    if (is.null(dot_sizes)) {
      dot_sizes <- rep(1, dim(dots)[1])
    } else if (length(dot_sizes) == 1) {
      dot_sizes <- rep(dot_sizes, length(dot_sizes))
    } else if (length(dot_sizes) < dim(dots)[1]) {
      stop("Parameter 'dot_sizes' does not contain enough sizes.")
    }
  }

  # Check intlat
  if (!is.numeric(intlat)) {
    stop("Parameter 'intlat' must be numeric.")
  }

  # Check legend parameters
  if (!is.logical(drawleg)) {
    stop("Parameter 'drawleg' must be logical.")
  }
  if (!is.numeric(subsampleg)) {
    stop("Parameter 'subsampleg' must be numeric.")
  } else {
    subsampleg <- round(subsampleg)
  }

  # Check box parameters
  if (!is.null(boxlim)) {
    if (!is.list(boxlim)) {
      boxlim <- list(boxlim)
    }
    for (i in 1:length(boxlim)) {
      if (!is.numeric(boxlim[[i]]) || length(boxlim[[i]]) != 4) {
        stop("Parameter 'boxlim' must be a a numeric vector or a list of numeric vectors of length 4 (with W, S, E, N box limits).")
      }
    }
    if (!is.character(boxcol)) {
      stop("Parameter 'boxcol' must be a character string or a vector of character strings.")
    } else {
      if (length(boxlim) != length(boxcol)) {
        if (length(boxcol) == 1) {
          boxcol <- rep(boxcol, length(boxlim))
        } else {
          stop("Parameter 'boxcol' must have a colour for each box in 'boxlim' or a single colour for all boxes.")
        }
      }
    }
    if (!is.numeric(boxlwd)) {
      stop("Parameter 'boxlwd' must be numeric.")
    } else {
      if (length(boxlim) != length(boxlwd)) {
        if (length(boxlwd) == 1) {
          boxlwd <- rep(boxlwd, length(boxlim))
        } else {
          stop("Parameter 'boxlwd' must have a line width for each box in 'boxlim' or a single line width for all boxes.")
        }
      }
    }
  } 

  #
  #  Defining the layout
  # ~~~~~~~~~~~~~~~~~~~~~
  # 
  xmargin <- 0
  ymargin <- 0
  topmargin <- 0.5
  ymargin2 <- 0 
  if (toptitle != '') {
    topmargin <- 1.5 
  }

  #
  #  Plotting the map
  # ~~~~~~~~~~~~~~~~~~
  #

  # Open connection to graphical device
  if (!is.null(fileout)) saveToFile(fileout, width = 11, height = 8)
  # Load the user parameters
  par(userArgs)

  if (drawleg) {
    layout(matrix(1:2, ncol = 2, nrow = 1), widths = c(8.5, 1.5))
  }
  par(mar = c(xmargin, ymargin, topmargin, ymargin2), mgp = c(1, 1, 0) ,cex = 1.4)
  coast <- map("world", interior = FALSE, projection = "stereographic", 
               orientation = c(center_at, 0, 0), fill = filled.continents,
               xlim = c(-180,180), ylim = latlims, wrap = TRUE, plot = FALSE)
  # Compute the bounding circle
  limit <- abs(mapproj::mapproject(0, last_lat, projection = 'stereographic',
                                   orientation = c(center_at, 0, 0))$y)
  for (i in 1:length(coast$x)) {
    distance <- sqrt(coast$x[i]**2 + coast$y[i]**2)
    if (!is.na(distance)) {
      if (distance > limit) {
        coast$x[i] <- coast$x[i] / distance * limit
        coast$y[i] <- coast$y[i] / distance * limit
      }
    }
  }
  xcircle <- c()
  ycircle <- c()
  for (i in 0:500) {
    xcircle <- c(xcircle, sin(2 * pi / 500 * i) * limit)
    ycircle <- c(ycircle, cos(2 * pi / 500 * i) * limit)
  }
  circle <- list(x = xcircle, y = ycircle)
  # Plot circle to set up device
  plot(circle, type= 'l', axes = FALSE, lwd = 1, col = gray(0.2), asp = 1,
       xlab = '', ylab = '')
  # Draw the data polygons
  for (jx in 1:dims[1]) { 
    for (jy in 1:dims[2]) {
      if (lat[jy] >= latlims[1] && latlims[2] >= lat[jy]) {
        coord <- mapproj::mapproject(c(lon[jx] - dlon, lon[jx] + dlon,
                                       lon[jx] + dlon, lon[jx] - dlon),
                                     c(lat[jy] - dlat, lat[jy] - dlat,
                                       lat[jy] + dlat, lat[jy] + dlat))
        ind <- which(brks[-1] > var[jx, jy] & var[jx, jy] > brks[-length(brks)])
        if (is.na(var[jx, jy])) {
          polygon(coord, col = colNA, border = NA)
        } else {
          polygon(coord, col = cols[ind], border = NA)
        }
      }
    }
  }
  # Draw the dots
  if (!is.null(dots)) {
    numbfig <- 1  # for compatibility with PlotEquiMap code
    plot_dot <- function(x, y, symbol, size) {
      text(x = x, y = y, symbol,
           cex = size * 12 / (sqrt(sqrt(length(var))) * numbfig ^ 0.5))
    }
    plot_dots <- Vectorize(plot_dot, vectorize.args = c('x', 'y'))
    dots <- dots[, , which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE]
    data_avail <- !is.na(var[, which(lat >= latlims[1] & lat <= latlims[2]), drop = FALSE])
    for (counter in 1:(dim(dots)[1])) {
      points <- which(dots[counter, , ] & data_avail, arr.ind = TRUE)
      points_proj <- mapproj::mapproject(lon[points[, 1]], lat[points[, 2]])
      plot_dots(points_proj$x, points_proj$y,
                dot_symbols[counter], dot_sizes[counter])
    }
  }

  # Draw the continents, grid and bounding circle
  if (filled.continents) {
    old_lwd <- par('lwd')
    par(lwd = coast_color)
    polygon(coast, col = continent_color, border = coast_color)
    par(lwd = old_lwd)
  } else {
    lines(coast, col = coast_color, lwd = coast_width)
  }
  mapproj::map.grid(lim = c(-180, 180, latlims), nx = 18, 
                    ny = ceiling((latlims[2] - latlims[1]) / intlat),
                    col = 'lightgrey', labels = FALSE) 
  polygon(circle, border = 'black')
  # Draw boxes on the map
  if (!is.null(boxlim)) {
    counter <- 1
    for (box in boxlim) {
      if (box[1] > box[3]) {
        box[1] <- box[1] - 360
      }
      if (length(box) != 4) {
        stop(paste("The", counter, "st box defined in the parameter 'boxlim' is ill defined."))
      } else if (center_at == 90 && (box[2] < original_last_lat || 
                                     box[4] > center_at) ||
                 center_at == -90 && (box[4] > original_last_lat ||
                                      box[2] < center_at)) {
        stop(paste("The limits of the", counter, 
                   "st box defined in the parameter 'boxlim' are invalid."))
      } else {
        mapproj::map.grid(lim = c(box[1], box[3], box[2], box[4]), 
                          nx = 2, ny = 2, pretty = FALSE, 
                          col = boxcol[counter], lty = "solid",
                          lwd = boxlwd[counter], labels = FALSE)
      }
      counter <- counter + 1
    }
  }

  title(toptitle, cex.main = sizetit)

  #
  #  Colorbar
  # ~~~~~~~~~~
  #
  if (drawleg) {
    par(mar = c(xmargin+0.3, 0, topmargin, 3.5), mgp = c(1, 1, 0),
        las = 1, cex = 1.2)
    image(1, c(1:length(cols)), t(c(1:length(cols))), axes = F, col = cols,
          xlab = '', ylab = '', main = units, cex.main = 1.1)
    box()
    axis(4, at = seq(0.5, length(brks) - 0.5, subsampleg),
         labels = brks[seq(1, length(brks), subsampleg)])
  }

  # If the graphic was saved to file, close the connection with the device
  if(!is.null(fileout)) dev.off()

  invisible(list(cols = cols, brks = brks))
}
