added functions/functionMakeSelection.R

SCRIPTS/functions/functionMakeSelection.R

+rm(list=ls())
+
+subsetRData<-function(RData, dates = NULL, lons = NULL, lats = NULL, members = NULL){
+  RData_subset <- RData
+  
+  ## Define Dates
+  dates1<-as.POSIXct(RData$Dates$start, tz = "GMT")
+  dates2<-as.POSIXct(dates, tz = "GMT")
+  iDates<-match(dates2, dates1)
+  iDates<-iDates[!is.na(iDates)]
+  
+  print(sprintf("Select: %s till %s ",RData$Dates$start[iDates[1]], RData$Dates$start[iDates[length(iDates)]]))
+  
+  attrs<-attributes(RData$Data)
+  iDimTime<-match("time",attrs$dimensions)
+  #iDimLon<-match("lon",attrs$dimensions)
+  #iDimLat<-match("lat",attrs$dimensions)
+  #iDimMember<-match("member",attrs$dimensions)
+  
+  nTimes<-length(iDates)
+  attrs$dim[iDimTime]<-nTimes
+  #attrs$dim[iDimLon]<-attrs$dim[iDimLon]
+  #attrs$dim[iDimLat]<-attrs$dim[iDimLat]
+  #attrs$dim[iDimMembers]<-attrs$dim[iDimMembers]
+  
+  ## Select Dates
+  RData_subset$Dates$start<-RData$Dates$start[iDates]
+  RData_subset$Dates$end<-RData$Dates$end[iDates]
+  if (length(attrs$dim) == 3) {
+    RData_subset$Data<-RData$Data[iDates,,]
+  }
+  if (length(attrs$dim) == 4) {
+    RData_subset$Data<-RData$Data[,iDates,,]
+  }
+  attributes(RData_subset$Data)<-attrs
+  dates<-RData$Dates$start[iDates]
+  
+  return(RData_subset) 
+}
+
+# load("/home/wietse/rsds_forcing_seas15_EU_BC_E01-15_TAR1982-2011_01_LM1.RData")
+# RData_noBC<-RData
+# load("/home/wietse/rsds_wfdei_EU_1981-2010_01.RData")
+# RData_obs<-RData
+# rm(RData)
+# 
+# ## Make uniform and match the selections
+# dates1<-as.character(as.POSIXct(RData_obs$Dates$start, tz = "GMT"))
+# dates2<-as.character(as.POSIXct(RData_noBC$Dates$start, tz = "GMT"))
+# overlapping_dates<-as.Date(intersect(dates1, dates2))
+# rm(dates2,dates1)
+# 
+# obs <- subsetRData(RData_obs, dates = overlapping_dates)
+# pred <- subsetRData(RData_noBC, dates = overlapping_dates)