PlotEquiMap <- function(var, lon, lat, varu = NULL, varv = NULL,
                        toptitle = '', sizetit = 1, units = '', 
                        brks = NULL, cols = NULL, square = TRUE, 
                        filled.continents = TRUE, filled.ocean=FALSE, contours = NULL, 
                        brks2 = NULL, dots = NULL, 
                        arr_subsamp = 1, arr_scale = 1,
                        arr_ref_len = 15, arr_units = "m/s",
                        arr_scale_shaft = 1, arr_scale_shaft_angle = 1,
                        axelab = TRUE, labW = FALSE, 
                        intylat = 20, intxlon = 20, drawleg = TRUE, 
                        boxlim = NULL, boxcol = 'purple2', boxlwd = 10,
                        subsampleg = 1, numbfig = 1, colNA = 'white', 
                        fileout = NULL, ...) {
  # Process the user graphical parameters that may be passed in the call
  ## Graphical parameters to exclude
  excludedArgs <- c("cex", "cex.axis", "cex.lab", "cex.main", "col", "din", "fig", "fin", "lab", "las", "lty", "lwd", "mai", "mar", "mgp", "new", "oma", "ps", "tck")
  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
  }

  #library(GEOmap)
  #library(geomapdata)
  #library(maps)
  library(grid)
  library(maptools)
  library(raster)
  library(rgeos)

  data(coastmap, package = 'GEOmap', envir = environment())
  #
  #  Input arguments 
  # ~~~~~~~~~~~~~~~~~
  #
  dims <- dim(var)
   # Tests for arrow plotting
  if (is.null(varu)==FALSE){
    if (is.null(varv)){
      stop("you set a u component of wind/current but not the correponding v component")
    }else if((isTRUE(all.equal(dim(var),dim(varv)))&
         isTRUE((all.equal(dim(var),dim(varv)))))==FALSE){
      stop("var, varu and varv should have the same Dimension")
    }else if(drawleg == TRUE){
      stop("plotting the wind is not compatible with draleg = TRUE")
    }else if(square == FALSE){
      stop("the wind can only be plotted  if square = TRUE")
    }
  }
 
  if (length(dims) > 2) {
    stop("Only 2 dimensions expected for var : (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(varu)==FALSE){varu <- t(varu)}
      if(is.null(varv)==FALSE){varv <- t(varv)}
     dims <- dim(var)
    } else {
      stop("Inconsistent var dimensions / longitudes + latitudes")
    }
  }
  latb <- sort(lat, index.return = TRUE)
  dlon <- lon[2:dims[1]] - lon[1:(dims[1] - 1)]
  wher <- which(dlon > (mean(dlon) + 1))
  if (length(wher) > 0) {
    lon[(wher + 1):dims[1]] <- lon[(wher + 1):dims[1]] - 360
  }
  lonb <- sort(lon, index.return = TRUE)
  latmin <- floor(min(lat) / 10) * 10
  latmax <- ceiling(max(lat) / 10) * 10
  lonmin <- floor(min(lon) / 10) * 10
  lonmax <- ceiling(max(lon) / 10) * 10

  varlim <- signif(c(min(var, na.rm = TRUE), max(var, na.rm = TRUE)), 4)
  if (!is.null(cols)) {
    if (!is.character(cols)) {
      stop("Error: '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("Error: inconsistent number of 'brks' and 'cols'.")
    }
  } else {
    stop("Error: 'brks' must be a numeric vector.")
  }

  if (is.null(brks2) == TRUE ) {
    if (is.null(contours)) { 
      if (square == FALSE) {
        brks2 <- brks
        contours <- var 
      }
    } else {
      ll <- signif(min(contours, na.rm = TRUE), 2)
      ul <- signif(max(contours, na.rm = TRUE), 2)
      brks2 <- signif(seq(ll, ul, length.out = length(brks)), 2)
    }
  }
  #
  #  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 (axelab == TRUE) { 
    ypos <- seq(latmin, latmax, intylat)
    xpos <- seq(lonmin, lonmax, intxlon)
    letters <- array('', length(ypos))
    letters[ypos < 0] <- 'S'
    letters[ypos > 0] <- 'N'
    ylabs <- paste(as.character(abs(ypos)), letters, sep = '')
    letters <- array('', length(xpos))
    if (labW) {
      nlon <- length(xpos)
      xpos2 <- xpos  
      xpos2[xpos2 > 180] <- 360 - xpos2[xpos2 > 180]
    }
    letters[xpos < 0] <- 'W'
    letters[xpos > 0] <- 'E'
    if (labW) {
      letters[xpos == 0] <- ' '
      letters[xpos == 180] <- ' '
      letters[xpos > 180] <- 'W'  
      xlabs <- paste(as.character(abs(xpos2)), letters, sep = '')
    } 
    else{
      xlabs <- paste(as.character(abs(xpos)), letters, sep = '')
    }
    xmargin <- 1.2 - (numbfig ^ 0.2) * 0.05
    ymargin <- 3 - (numbfig ^ 0.2)
    spaceticklab <- 1.3 - (numbfig ^ 0.2) * 0.8
    topmargin <- 0.4
    ymargin2 <- 1.5 - (numbfig ^ 0.2) * 0.9
  } else {
    xmargin <- 0.2 
    ymargin <- 0.2 + switch(as.character(square), 'FALSE' = 1.8, 0) 
    topmargin <- 0.2
    spaceticklab <- 1
    ymargin2 <- 0.2
  }
  if (!is.null(toptitle)) {
    if (!is.na(toptitle) && is.character(toptitle)) {
      if (toptitle != '') {
        topmargin <- 2.5 - (numbfig ^ 0.2) * 0.6
      }
    }
  }
  if (min(lon) < 0) {
    continents <- 'world'
  } else {
    continents <- 'world2'
  }
  # Increase the bottom margin
  # to plot the legend of the arrow plot
  if (is.null(varu)==FALSE){
    if(axelab==FALSE){
      xmargin=xmargin + 2.5/numbfig #(numbfig^(0.3))
    }else{
      xmargin=xmargin+xmargin/numbfig #(numbfig^(0.3))
    }
  }

  if (square) {
    if (drawleg) {
      layout(matrix(1:2, ncol = 1, nrow = 2), heights = c(5, 1))
    }
    par(mar = c(xmargin, ymargin, topmargin, ymargin2), cex = 1.4, 
        mgp = c(3, spaceticklab, 0), las = 0)
    if (colNA != 'white') {
      blanks <- array(0, dim = c(length(lonb$x), length(latb$x)))
      image(lonb$x, latb$x, blanks, col = c(colNA), breaks = c(-1, 1), 
            main = toptitle, cex.main = (1.5 / numbfig ^ (0.2)) * sizetit, 
            axes = FALSE, xlab = "", ylab = "")
      flagadd <- T
    } else {  
      flagadd <- F
    }
    image(lonb$x, latb$x, var[lonb$ix, latb$ix], col = cols, breaks = brks, 
          main = toptitle, axes = FALSE, xlab = "", ylab = "", 
          cex.main = (1.5 / numbfig ^ (0.2)) * sizetit, add = flagadd)
    if (axelab == TRUE) {
      axis(2, at = ypos, labels = ylabs, cex.axis = 1 / (numbfig ^ 0.3), 
           tck = -0.03)
      axis(1, at = xpos, labels = xlabs, cex.axis = 1 / (numbfig ^ 0.3),
           tck = -0.03)
    }
    if (is.null(contours) == FALSE) {
      contour(lonb$x, latb$x, contours[lonb$ix, latb$ix], levels = brks2,
              method = "edge", add = TRUE, labcex = 1 / numbfig, 
              lwd = 0.5 / (numbfig ^ 0.5))
    }
    map(continents, interior = FALSE, add = TRUE, lwd = 1, resolution = 0)
    box()
  } else {
    par(mar = c(xmargin + 5, ymargin + 1.5, topmargin, ymargin2), 
        cex.main = (1.6 * numbfig ^ (0.3)) * sizetit, cex.axis = 1.4, 
        cex.lab = 1.6, mgp = c(3, spaceticklab + 0.5, 0), las = 0)
    if (axelab == TRUE) {
      filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], xlab = "", 
                     levels = brks, col = cols, ylab = "", main = toptitle,
                     key.axes = axis(4, brks[seq(1, length(brks), subsampleg)],
                     cex.axis = 1 / (numbfig ^ 0.3)), 
                     plot.axes = {axis(2, at = ypos, labels = ylabs, 
                                  cex.axis = 1 / (numbfig ^ 0.3), tck = -0.03)
                                  axis(1, at = xpos, labels = xlabs,
                                  cex.axis = 1 / (numbfig ^ 0.3), tck = -0.03)
                                  contour(lonb$x, latb$x, contours[lonb$ix,
                                          latb$ix], levels = brks2, 
                                          method = "edge", add = TRUE,
                                          labcex = 1, lwd = 2)
                                  map(continents, interior = FALSE, 
                                      xlim = c(lonmin, lonmax),
                                      ylim = c(latmin, latmax), add = TRUE,
                                      resolution = 0)},
                     key.title = title(main = units, 
                                 cex.main = (1.2 * numbfig ^ (0.3)) * sizetit))
    } else {
      filled.contour(lonb$x, latb$x, var[lonb$ix, latb$ix], xlab = "",
                     levels = brks, col = cols, ylab = "", main = toptitle,
                     key.axes = axis(4, brks[seq(1, length(brks), subsampleg)],
                     cex.axis = 1 / (numbfig ^ 0.3)), 
                     plot.axes = {contour(lonb$x, latb$x, contours[lonb$ix, 
                                          latb$ix], levels = brks2, 
                                          method = "edge", add = TRUE,
                                          labcex = 1, lwd = 2)
                                  map(continents, interior = FALSE, 
                                      xlim = c(lonmin, lonmax), 
                                      ylim = c(latmin, latmax), add = TRUE,
                                      resolution = 0)},
                     key.title = title(main = units, 
                                 cex.main = (1.2 * numbfig ^ (0.3)) * sizetit))
    }
  } 
  #
  #  Adding black dots  
  # ~~~~~~~~~~~~~~~~~~~
  #
  if (is.null(dots) == FALSE) {
    for (ix in 1:length(lon)) {
      for (jy in 1:length(lat)) {
        if (is.na(var[ix, jy]) == FALSE) {
          if (dots[ix, jy] == TRUE) {
            text(x = lon[ix], y = lat[jy], ".", 
                 cex= 12 / (sqrt(sqrt(length(var))) * numbfig ^ 0.5))
          }
        }
      }
    }
  }
  #
  #  Filling continents
  # ~~~~~~~~~~~~~~~~~~~~
  # 
  if (square == TRUE & filled.continents == TRUE) {
    if (min(lon) >= 0) {
      ylat <- latmin:latmax
      xlon <- lonmin:lonmax
      proj <- GEOmap::setPROJ(1, LON0 = mean(xlon),
                              LAT0 = mean(ylat), LATS = ylat, LONS = xlon)
      coastmap$STROKES$col[which(coastmap$STROKES$col == "blue")] <- "white"
      par(new = TRUE)
      GEOmap::plotGEOmap(coastmap, PROJ = proj, border = 'black', add = TRUE)
      box()
    } else {
      map(continents, interior = FALSE, wrap = TRUE, lwd = 0.7, col = gray(0.5),
          fill = TRUE, add = TRUE, border = gray(0.5), resolution = 0)
    }
  } 

  #
  #  Filling ocean
  # ~~~~~~~~~~~~~~~~~~~~

  if (square == TRUE & filled.ocean == TRUE) {
   data(wrld_simpl)
   xd<-lonmin:lonmax-2; yd<-latmin:latmax
   xl<-length(xd); yl<-length(yd)
   x <- list(x = xd, y = yd, z = outer(1:xl, 1:yl, "+"))
   r <- raster(image2Grid(x))
   p <- as(extent(r), "SpatialPolygons")

   wmap <- gIntersection(wrld_simpl, p)
   oceanmap <- gDifference(p, wmap)
   plot(oceanmap, add = TRUE, col = "gray")
   box()
  }


  

  # 
  # Draw rectangle on the map
  if (is.null(boxlim) == FALSE) {
    boxlimaux <- boxlim
    if(boxlim[1]>boxlim[3]){
      boxlimaux[1] <- boxlim[1]-360
    }
    if (length(boxlimaux)!=4){
      stop('Region to be highlighted is ill defined')
    } else if(boxlimaux[2] < latmin | boxlimaux[4] > latmax | boxlimaux[1]<lonmin | boxlimaux[3]>lonmax){
      stop('Invalid boundaries')
    } else if(boxlimaux[1]<0 && boxlimaux[3]>0){
      #segments south
      segments(boxlimaux[1], boxlimaux[2],0, boxlimaux[2], col=boxcol, lwd=boxlwd)
      segments(0,boxlimaux[2], boxlimaux[3], boxlimaux[2], col=boxcol, lwd=boxlwd) 
      #segments north
      segments(boxlimaux[1], boxlimaux[4],0, boxlimaux[4], col=boxcol, lwd=boxlwd)
      segments(0,boxlimaux[4], boxlimaux[3], boxlimaux[4], col=boxcol, lwd=boxlwd) 
      #segments west
      segments(boxlimaux[1], boxlimaux[2], boxlimaux[1],boxlimaux[4], col=boxcol, lwd=boxlwd )  
      #segments est
      segments(boxlimaux[3], boxlimaux[2], boxlimaux[3],boxlimaux[4], col=boxcol, lwd=boxlwd )          
    } else {
      rect(boxlimaux[1], boxlimaux[2], boxlimaux[3], boxlimaux[4], border=boxcol, col=NULL, lwd=boxlwd, lty='solid')              
    }
  }
  #
  #  PlotWind
  # ~~~~~~~~~~
  #
  if (!is.null(varu)) {
    # Create a two dimention array of longitude and latitude
    lontab <- InsertDim(lonb$x, 2, length( latb$x))
    lattab <- InsertDim(latb$x, 1, length( lonb$x))
    varplotu <- varu[lonb$ix, latb$ix]
    varplotv <- varv[lonb$ix, latb$ix]

    # Select a subsample af the points to an arrow
    #for each "subsample" grid point
    sublon <- seq(1,length(lon), arr_subsamp)
    sublat <- seq(1,length(lat), arr_subsamp)

    uaux <- lontab[sublon, sublat] + varplotu[sublon, sublat] * 0.5 * arr_scale
    vaux <- lattab[sublon, sublat] + varplotv[sublon, sublat] * 0.5 * arr_scale

    lenshaft <- 0.18 * arr_scale * arr_scale_shaft / (numbfig ^ (0.2))
    angleshaft <- 12 * arr_scale_shaft_angle / (numbfig ^ (0.2))
    # Plot Wind
    arrows(lontab[sublon, sublat], lattab[sublon, sublat],
           uaux, vaux,
           angle = angleshaft,
           length = lenshaft)

    # Plotting an arrow at the bottom of the plot for the legend
    posarlon = lonb$x[1] + (lonmax - lonmin) * 0.1
    posarlat = latmin - (latmax - latmin) * 0.035

    arrows(posarlon, posarlat,
           posarlon + 0.5 * arr_scale * arr_ref_len, posarlat,
           length = lenshaft, angle = angleshaft,
           xpd = TRUE)
    #save the parameter value
    xpdsave = par()$xpd
    #desactivate xpd to be able to plot in margen
    par(xpd = NA)
    #plot text
    text(x = posarlon + arr_scale, y = posarlat - (latmax - latmin) * 0.03,
         labels = paste(as.character(arr_ref_len), arr_units, sep = ""),
         cex = (1 * sizetit / numbfig ^ (0.2)) )
    #come back to the previous xpd value
    par(xpd = xpdsave)
  }
  #
  #  Colorbar
  # ~~~~~~~~~~
  #
  if (square & drawleg) {
    par(mar = c(1.5, ymargin + 1.5, 2.5, ymargin2 + 1.5), mgp = c(1.5, 0.3, 0), 
        las = 1, cex = 1.2)
    image(1:length(cols), 1, t(t(1:length(cols))), axes = FALSE, col = cols, 
          xlab = '', ylab = '', main = units, cex.main = 1.1)
    box()
    axis(1, at = seq(0.5, length(brks) - 0.5, subsampleg), 
         labels = brks[seq(1, length(brks), subsampleg)])
    #title(xlab = units)
  }

  # 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))
}
