#load libraries and data
library(ncdf4)
library(ggplot2)
require(knitr)


load("NorthAfrica_em.RData")
load("NorthAfrica_od.RData")
load("NorthAfrica_ustar.RData")
load("NorthAfrica_usttsd3.RData")
load("NorthAfrica_ustt3.RData")
load("NorthAfrica_mc.RData")
load("NorthAfrica_rc.RData") 


season <- 2 #season 1=DJF/2=MAM/3=JJA/4=SON/5=Annual
#establish DOD and emission thresholds to compute FoO.
dodthr <- 0.2
emthr <- 0



#selection of only 12 UTC data depending on the season
if (season==1) #DJF
{
    vectorem <-(NorthAfrica_em[seq(2684,2924,by=8),])
    vectorod <- (NorthAfrica_od[seq(2684,2924,by=8),])
    vectorwind <- (NorthAfrica_ustar[seq(2684,2924,by=8),])
    vectorwind2 <- (NorthAfrica_usttsd3[seq(2684,2924,by=8),])
    vectormc <-(NorthAfrica_mc[seq(2684,2924,by=8),])
    vectorrc <- (NorthAfrica_rc[seq(2684,2924,by=8),])
    vectorustt <- (NorthAfrica_ustt3[seq(2684,2924,by=8),])
    vectorod <- rbind(vectorod,((NorthAfrica_od[seq(4,476,by=8),])))
    vectorem <- rbind(vectorem,((NorthAfrica_em[seq(4,476,by=8),])))
    vectorwind <- rbind(vectorwind,((NorthAfrica_ustar[seq(4,476,by=8),])))
    vectorwind2 <- rbind(vectorwind2,((NorthAfrica_usttsd3[seq(4,476,by=8),])))
    vectormc <- rbind(vectormc,((NorthAfrica_mc[seq(4,476,by=8),])))
    vectorrc <- rbind(vectorrc,((NorthAfrica_rc[seq(4,476,by=8),])))
    vectorustt <- rbind(vectorustt,((NorthAfrica_ustt3[seq(4,476,by=8),])))
}
if (season==2) #MAM
{
  vectorod <- (NorthAfrica_od[seq(484,1212,by=8),])
  vectorem <- (NorthAfrica_em[seq(484,1212,by=8),])
  vectorwind <- (NorthAfrica_ustar[seq(484,1212,by=8),])
  vectorwind2 <- (NorthAfrica_usttsd3[seq(484,1212,by=8),])
  vectormc <-(NorthAfrica_mc[seq(484,1212,by=8),])
  vectorrc <- (NorthAfrica_rc[seq(484,1212,by=8),])
  vectorustt <- (NorthAfrica_ustt3[seq(484,1212,by=8),])
}
if (season==3) #JJA
{
  vectorod <- (NorthAfrica_od[seq(1220,1948,by=8),])
  vectorem <- (NorthAfrica_em[seq(1220,1948,by=8),])
  vectorwind <- (NorthAfrica_ustar[seq(1220,1948,by=8),])
  vectorwind2 <- (NorthAfrica_usttsd3[seq(1220,1948,by=8),])
  vectormc <-(NorthAfrica_mc[seq(1220,1948,by=8),])
  vectorrc <- (NorthAfrica_rc[seq(1220,1948,by=8),])
  vectorustt <- (NorthAfrica_ustt3[seq(1220,1948,by=8),])
}
if (season==4) #SON
{
  vectorod <- (NorthAfrica_od[seq(1956,2676,by=8),])
  vectorem <- (NorthAfrica_em[seq(1956,2676,by=8),])
  vectorwind <- (NorthAfrica_ustar[seq(1956,2676,by=8),])
  vectorwind2 <- (NorthAfrica_usttsd3[seq(1956,2676,by=8),])
  vectormc <-(NorthAfrica_mc[seq(1956,2676,by=8),])
  vectorrc <- (NorthAfrica_rc[seq(1956,2676,by=8),])
  vectorustt <- (NorthAfrica_ustt3[seq(1956,2676,by=8),])
}
if (season==5) #Annual
{
  vectorod <- (NorthAfrica_od[seq(4,2924,by=8),])
  vectorem <- (NorthAfrica_em[seq(4,2924,by=8),])
  vectorwind <- (NorthAfrica_ustar[seq(4,2924,by=8),])
  vectorwind2 <- (NorthAfrica_usttsd3[seq(4,2924,by=8),])
  vectormc <-(NorthAfrica_mc[seq(4,2924,by=8),])
  vectorrc <- (NorthAfrica_rc[seq(4,2924,by=8),])
  vectorustt <- (NorthAfrica_ustt3[seq(4,2924,by=8),])
}



#establish temporal (t) and spatial (s) dimensions
dim(vectorod)
dims <- length(vectorod[1,])
dimt <- length(vectorod[,1])

#empty vectors to be filled
FoO_DOD <- replicate(dims,0) #FoO of DOD resulting from the simulation
FoO_em <- replicate(dims,0) #FoO of emissions resulting from the simulation
meanem <- replicate(dims,0) #Mean emission at every grid cell
winds <- matrix(0,dims,dimt)
winds2 <- matrix(0,dims,dimt)

#loop to compute FoOs,sort winds at every grid cell from lower to higher and 
#compute mean emission at every grid cell
for (s in 1:dims)
{
  for (t in 1:dimt)
  {
    if (vectorod[t,s]>dodthr)
    {
      FoO_DOD[s] <- FoO_DOD[s] + 1
    }
    if (vectorem[t,s]>emthr)
    {
      FoO_em[s] <- FoO_em[s] + 1
    }
    winds[s,t] <- vectorwind[t,s] # u*
    winds2[s,t] <- (winds[s,t])/(vectormc[t,s]*vectorrc[t,s]) # u*sd
  }
  winds[s,] <- sort(winds[s,])
  meanem[s] <- mean(vectorem[,s])
  winds2[s,] <- sort(winds2[s,])
}

#empty vectors for wind threshold calculations
windthr <- vector(length=dims) #u*t retrieved through the FoO method
windthr2 <- vector(length=dims) #u*tsd retrieved through the FoO method with u* values corrected to u*sd
windthrreal <- vector(length=dims) #mean u*tsd used by the model
windthrsd <- vector(length=dims) #u*tsd retrieved through the FoO method from u*t dividing 
#by the mean of the correction factors
ustt <- vector(length=dims)
counter <- 0 #counts grid cells in which FoO of DOD is 0
FoO2 <- vector(length=length(FoO_DOD))
FoO2 <- FoO_DOD
for (s in 1:dims)
{
  windthrreal[s] <- mean(vectorwind2[,s])
  if (FoO_DOD[s]==0)
  {
    windthr[s] <- NaN
    windthr2[s] <- NaN
    FoO_DOD[s] <- NaN
    windthrreal[s] <- NaN
    counter <- counter +1 
  }
  else{
    vector_vientos <- winds[s,] 
    indice <- dimt-FoO_DOD[s]+1
    windthr[s] <- vector_vientos[indice]
    
    vector_vientos2 <- winds2[s,]
    indice <- dimt-FoO_DOD[s]+1
    windthr2[s] <- vector_vientos2[indice]
    
  }
}

rc <- vector(length=dims)
mc <- vector(length=dims)
for (s in 1:dims)
{
  windthrsd[s] <- (windthr[s])/(mean(vectormc[,s])*mean(vectorrc[,s]))
  ustt[s] <- mean(vectorustt[,s])
  rc[s] <- mean(vectorrc[,s])
  mc[s] <- mean(vectormc[,s])
  if (is.na(FoO_DOD[s]))
  {
    ustt[s] <- NaN
  }
}
save(ustt, file= "ustt.RData")

#___________________________________________________________________________
# calculation of BIAS, RMSE and correlation coeff.

#compare:
#windthr2 (u*tsd retrieved through the FoO method with u* values corrected to u*sd)
#windthrreal (mean u*tsd used by the model)
print("u*tsd:")
bias <- sum(windthr2[!is.na(windthr2)])/sum(windthrreal[!is.na(windthrreal)])
RMSE <- (sqrt(sum((windthrreal[!is.na(windthrreal)]-windthr2[!is.na(windthr2)])^(2))/(dims-counter)))/mean(windthrreal[!is.na(windthrreal)])
cor <- (cor(windthrreal[!is.na(windthrreal)],windthr2[!is.na(windthr2)]))
df <- cbind(bias,RMSE,cor)
print(kable(df))

#compare:
#windthr (u*t retrieved through the FoO method)
#ustt (mean u*t used by the model)
print("u*t:")
bias <- sum(windthr[!is.na(windthr)])/sum(ustt[!is.na(ustt)])
RMSE <- (sqrt(sum((ustt[!is.na(ustt)]-windthr[!is.na(windthr)])^(2))/(dims-counter)))/mean(ustt[!is.na(ustt)])
cor <- (cor(ustt[!is.na(ustt)],windthr[!is.na(windthr)]))
df <- cbind(bias,RMSE,cor)
print(kable(df))

#Computes the relative error of u*t retrieved through the FoO method with respect to the used by the model
relative_error <- vector(length=dims)
for (s in 1:dims)
{
  if (is.na(ustt[s]))
  {
    relative_error[s] <- NaN
  }
  else if (ustt[s]==0)
  {
    relative_error[s] <- NaN
  }
  else
  {
    relative_error[s] <- (windthr[s]-ustt[s])/ustt[s]
  }
  
}
#______plots an histogram (number of grid cells .vs. relative error) separating 0-emission and emission sources____________
#keeps only values in which FoO is computed and separates relative error vector between 
#0 emission sources (relative_error3) and emission sources (relative_error4)

relative_error2<- relative_error[!is.na(relative_error)]
meanem2 <- meanem[!is.na(relative_error)]
relative_error3 <- relative_error2[meanem2==0]*100
relative_error4 <- relative_error2[meanem2>0]*100

data10 <- data.frame(relative_error3)
data11 <- data.frame(relative_error4)
png("histo_northafrica_relative_error.png")
myplot <- ggplot(data = data10, aes(x=relative_error3, y=..count.., colour = "Non-dust emission sources", fill = "Non-dust emission sources" )) + geom_histogram(binwidth = 5, alpha=.35) +
  geom_histogram(data = data11, aes(x=relative_error4, y=..count..,  colour= "Dust emission sources", fill = "Dust emission sources"), binwidth = 5, alpha=.35) +
  scale_colour_manual("", 
                      breaks = c("Non-dust emission sources", "Dust emission sources"),
                      values = c("#0072B2", "#D55E00")) + scale_fill_manual("",breaks = c("Non-dust emission sources", "Dust emission sources"), values=c("#0072B2", "#D55E00")) +
  labs(x="U*t relative error [%]", y="nº grid cells") +
  theme_bw() + theme(axis.text.x=element_text(size=14, angle=0, vjust=0.3),
                     axis.text.y=element_text(size=14),
                     axis.title=element_text(size=15),
                     legend.text=element_text(size=15), legend.position="bottom")

print(myplot)
dev.off()

#______plots two histograms used to have an example of how the method works_______

dod_vector <- vectorod[,241]
breaks_dod = seq(0, 2, by=0.1) 
dod_vector.cut = cut(dod_vector, breaks_dod, right=FALSE) 
dod_vector.freq = table(dod_vector.cut)
dod_vector.cumfreq = 100*(dimt-cumsum(dod_vector.freq))/dimt
breaks_dod <- breaks_dod[1:(length(breaks_dod)-1)]+0.05


#in this first histogram the inverse cumulative frequency of DOD is plotted
dades <- data.frame(breaks_dod, dod_vector.cumfreq)
png("histo_FoO_method.png")
myplot <- ggplot(data=dades,aes(x=breaks_dod, y=dod_vector.cumfreq)) +
  geom_bar(aes(fill=dod_vector.cumfreq), stat="identity", fill = "#009E73" ) +
  geom_hline(yintercept=85.714286, linetype="dashed", color = "red") +
  geom_vline(xintercept=0.2, linetype="dashed", color = "red") +
  scale_y_continuous(limits = c(0, 100)) +
  #scale_x_discrete(breaks = c("0","1e-14","1e-13","1") ) + 
  labs(x="DOD", y="%") + ggtitle("Grid point [24N, 2.8W]" , subtitle = "Inverse cumulative frequency of DOD") +
  theme_bw() + theme(axis.text.x=element_text(size=16, angle=0, vjust=0.3),
                     axis.text.y=element_text(size=16),
                     axis.title=element_text(size=17),
                     plot.title = element_text(hjust = 0.5,size=21),
                     plot.subtitle = element_text(size=18),
                     legend.text=element_text(size=17), legend.position="bottom")
print(myplot)
dev.off()

dod_vector <- vectorwind[,241]
breaks_dod = seq(0, 1, by=0.01) 
dod_vector.cut = cut(dod_vector, breaks_dod, right=FALSE) 
dod_vector.freq = table(dod_vector.cut)
dod_vector.cumfreq = 100*(dimt-cumsum(dod_vector.freq))/dimt
breaks_dod <- breaks_dod[1:(length(breaks_dod)-1)]+0.005

#in this second histogram the inverse cumulative frequency of u* is plotted
dades <- data.frame(breaks_dod, dod_vector.cumfreq)
png("histo_FoO_method_winds.png")
myplot <- ggplot(data=dades,aes(x=breaks_dod, y=dod_vector.cumfreq)) +
  geom_line(aes(fill=dod_vector.cumfreq), stat="identity", colour = "#009E73" ) +
  geom_hline(yintercept=85.714286, linetype="dashed", color = "red") +
  geom_vline(xintercept=windthr[241], linetype="dashed", color = "red") +
  scale_y_continuous(limits = c(0, 100)) +
  #scale_x_discrete(breaks = c("0","1e-14","1e-13","1") ) + 
  labs(x="Wind Friction Velocity [m/s]", y="%") + ggtitle("",subtitle = "Inverse cumulative frequency of U*") +
  theme_bw() + theme(axis.text.x=element_text(size=16, angle=0, vjust=0.3),
                     axis.text.y=element_text(size=16),
                     axis.title=element_text(size=17),
                     plot.title = element_text(hjust = 0.5,size=21),
                     plot.subtitle = element_text(size=18),
                     legend.text=element_text(size=17), legend.position="bottom")
print(myplot)
dev.off()

#________________adaptation of the data to convert it to netcdf__________________________________

#file for mask the sea
ncpathsm <- "/esarchive/exp/nmmb-bsc-ctm/b051/"
ncnamesm <- "seamask"  
ncseamask <- paste(ncpathsm, ncnamesm, ".nc", sep="")
nsm <- nc_open(ncseamask)
# get seamask
seamask_array <- ncvar_get(nsm,"seamask")
fillvalue <- ncatt_get(nsm,"seamask","_FillValue")
lat <- length(seamask_array[1,])
lon <- length(seamask_array[,1])


seamask_array_NorthAfrica <- matrix(0,47,41)
lon <- 47
lat <- 41
for (l in 1:lat)
{
  for (n in 1:lon)
  {
    seamask_array_NorthAfrica[n,l] <- seamask_array[107+n,89+l]
  }
}


FoO_DOD_matrix <- matrix(0,lon,lat) 
FoO_em_matrix <- matrix(0,lon,lat)
windthr_matrix <- matrix(0,lon,lat)
meanem_matrix <- matrix(0,lon,lat)
windthrreal_matrix <- matrix(0,lon,lat)
windthrsd_matrix <- matrix(0,lon,lat)
windthr2_matrix <- matrix(0,lon,lat)
ustt_matrix <- matrix(0,lon,lat)
rc_matrix <- matrix(0,lon,lat)
mc_matrix <- matrix(0,lon,lat)
relative_error_matrix <- matrix(0,lon,lat)

k <- 1
for (n in 1:lon)
{
  
  for (l in 1:lat)
  {
    if(seamask_array_NorthAfrica[n,l]==1)
    {
      
      FoO_DOD_matrix[n,l] <- NaN
      FoO_em_matrix[n,l] <- NaN
      windthr_matrix[n,l] <- NaN
      meanem_matrix[n,l] <- NaN
      windthrreal_matrix[n,l] <- NaN
      windthrsd_matrix[n,l] <- NaN
      windthr2_matrix[n,l] <- NaN
      ustt_matrix[n,l] <- NaN
      rc_matrix[n,l] <- NaN
      mc_matrix[n,l] <- NaN
      relative_error_matrix[n,l] <- NaN
      
    }
    else
    {
      
      FoO_DOD_matrix[n,l] <- 100*FoO2[k]/dimt
      FoO_em_matrix[n,l] <- 100*FoO_em[k]/dimt
      windthr_matrix[n,l] <- windthr[k] 
      meanem_matrix[n,l] <- meanem[k]
      windthrreal_matrix[n,l] <- windthrreal[k]
      windthrsd_matrix[n,l] <- windthrsd[k]
      relative_error_matrix[n,l] <- relative_error[k]*100
      if (!is.na(windthrreal[k])&windthrreal[k]==0)
      { 
        windthr2_matrix[n,l] <- NaN
        windthrreal_matrix[n,l] <- NaN
      }
      else
      {
        windthr2_matrix[n,l] <- windthr2[k]
      }
      ustt_matrix[n,l] <- ustt[k]
      rc_matrix[n,l] <- rc[k]
      mc_matrix[n,l] <- mc[k]
      k <- k + 1
    }
  }
}

#-----------------creation of netcdf file--------------------------

# path and file name, set dname
ncpath <- "/Documents/sct_plots/"
ncname <- "2012means"  
ncfname <- paste(ncpath, ncname, ".nc", sep="")
dname <- "correlation"  # note: tmp means temperature (not temporary)


lon3 <- seq(-29.53, 35.16, by=(360/256))
lat3 <- seq(-1, 39, by=(1))
time3 <- c(2012)
# create and write the netCDF file -- ncdf4 version
# define dimensions
londim <- ncdim_def("lon","degrees_east",as.double(lon3)) 
latdim <- ncdim_def("lat","degrees_north",as.double(lat3)) 
timedim <- ncdim_def("time","year",as.double(time3))

# define variables
fillvalue <- 1e32
dlname <- "FoO_DOD"
mod_def <- ncvar_def("FoO_DOD","",list(londim,latdim,timedim),fillvalue,dlname,prec="single")
dlname2 <- "u*t_FoO_method"
mod_def2 <- ncvar_def("u*t_FoO_method","",list(londim,latdim,timedim),fillvalue,dlname2,prec="single")
dlname3 <- "FoO_em"
mod_def3 <- ncvar_def("FoO_em","",list(londim,latdim,timedim),fillvalue,dlname3,prec="single")
dlname4 <- "mean_em"
mod_def4 <- ncvar_def("mean_em","",list(londim,latdim,timedim),fillvalue,dlname4,prec="single")
dlname5 <- "u*tsd_model"
mod_def5 <- ncvar_def("u*tsd_model","",list(londim,latdim,timedim),fillvalue,dlname5,prec="single")
dlname6 <- "u*tsd_FoO_method_(resulting u*t dividing by mean rougness and moisture correction)"
mod_def6 <- ncvar_def("u*tsd_FoO_method_a","",list(londim,latdim,timedim),fillvalue,dlname6,prec="single")
dlname7 <- "u*tsd_FoO_method_(using tranformed u* to u*sd)"
mod_def7 <- ncvar_def("u*tsd_FoO_method_b","",list(londim,latdim,timedim),fillvalue,dlname7,prec="single")
dlname8 <- "u*t_model"
mod_def8 <- ncvar_def("u*t_model","",list(londim,latdim,timedim),fillvalue,dlname8,prec="single")
dlname9 <- "roughness_correction"
mod_def9 <- ncvar_def("rc","",list(londim,latdim,timedim),fillvalue,dlname9,prec="single")
dlname10 <- "moisture_correction"
mod_def10 <- ncvar_def("mc","",list(londim,latdim,timedim),fillvalue,dlname10,prec="single")
dlname11 <- "rel_error_u*t"
mod_def11 <- ncvar_def("rel_error","",list(londim,latdim,timedim),fillvalue,dlname11,prec="single")

# create netCDF file and put arrays
if (season==1)
{
  ncfname <- "FoO_windthr_DJF.nc"
}
if (season==2)
{
  ncfname <- "FoO_windthr_MAM.nc"
}
if (season==3)
{
  ncfname <- "FoO_windthr_JJA.nc"
}
if (season==4)
{
  ncfname <- "FoO_windthr_SON.nc"
}
if (season==5)
{
  ncfname <- "FoO_windthr_Annual.nc"
}

ncout <- nc_create(ncfname,list(mod_def,mod_def2,mod_def3,mod_def4,mod_def5,
                                mod_def6,mod_def7,mod_def8,mod_def9,mod_def10,mod_def11), force_v4=TRUE)
dim(seamask_array_NorthAfrica)
x <- array(0, dim=c(2,47,41))
x[2,,] <- seamask_array_NorthAfrica
# put variables
ncvar_put(ncout,mod_def,FoO_DOD_matrix)
ncvar_put(ncout,mod_def2,windthr_matrix)
ncvar_put(ncout,mod_def3,FoO_em_matrix)
ncvar_put(ncout,mod_def4,meanem_matrix)
ncvar_put(ncout,mod_def5,windthrreal_matrix)
ncvar_put(ncout,mod_def6,windthrsd_matrix)
ncvar_put(ncout,mod_def7,windthr2_matrix)
ncvar_put(ncout,mod_def8,ustt_matrix)
ncvar_put(ncout,mod_def9,rc_matrix)
ncvar_put(ncout,mod_def10,mc_matrix)
ncvar_put(ncout,mod_def11,relative_error_matrix)



# put additional attributes into dimension and data variables
ncatt_put(ncout,"lon","axis","X") #,verbose=FALSE) #,definemode=FALSE)
ncatt_put(ncout,"lat","axis","Y")
ncatt_put(ncout,"time","axis","T")

# add global attributes
ncatt_put(ncout,0,"title","2012-Mean od550ducoarse and emidu")
ncatt_put(ncout,0,"institution","Barcelona Supercomputing Center")
ncatt_put(ncout,0,"source","nmmb")

# Get a summary of the created file:
ncout

# close the file, writing data to disk
nc_close(ncout)



