Add codes to extract SoilGrids soil texture data and derive ensemble …

models/sipnet/R/write.configs.SIPNET.R

@@ -20,7 +20,6 @@ write.config.SIPNET <- function(defaults, trait.values, settings, run.id, inputs
 
   ### WRITE *.clim
   template.clim <- settings$run$inputs$met$path  ## read from settings
-
   if (!is.null(inputs)) {
     ## override if specified in inputs
     if ("met" %in% names(inputs)) {
@@ -490,22 +489,36 @@ write.config.SIPNET <- function(defaults, trait.values, settings, run.id, inputs
     }
   } ## end loop over PFTS
   ####### end parameter update
-  #working on reading soil file (only working for 1 soil file)
-  if(length(settings$run$inputs$soilinitcond$path)==1){
-    soil_IC_list <- PEcAn.data.land::pool_ic_netcdf2list(settings$run$inputs$soilinitcond$path)
-    #SoilWHC and LitterWHC
-    if("volume_fraction_of_water_in_soil_at_saturation"%in%names(soil_IC_list$vals)){
-      #SoilWHC
-      param[which(param[, 1] == "soilWHC"), 2] <- mean(unlist(soil_IC_list$vals["volume_fraction_of_water_in_soil_at_saturation"]))*100
-
-      #LitterWHC
-      #param[which(param[, 1] == "litterWHC"), 2] <- unlist(soil_IC_list$vals["volume_fraction_of_water_in_soil_at_saturation"])[1]*100
-    }
-    if("soil_hydraulic_conductivity_at_saturation"%in%names(soil_IC_list$vals)){
-      #litwaterDrainrate
-      param[which(param[, 1] == "litWaterDrainRate"), 2] <- unlist(soil_IC_list$vals["soil_hydraulic_conductivity_at_saturation"])[1]*100/(3600*24)
+  #working on reading soil file
+  if (length(settings$run$inputs$soilinitcond$path) > 0) {
+    template.soilinit <- settings$run$inputs$soilinitcond$path  ## read from settings
+
+    if (!is.null(inputs)) {
+      ## override if specified in inputs
+      if ("soilinitcond" %in% names(inputs)) {
+        template.soilinit <- inputs$soilinitcond$path
+      }
     }
-  }
+    soil_IC_list <- PEcAn.data.land::pool_ic_netcdf2list(template.soilinit)
+    # Calculate the thickness of soil layers based on the assumption that the depth values are at bottoms and the first layer top is at 0
+    if ("depth" %in% names(soil_IC_list$dims)) {
+      thickness<-c(soil_IC_list$dims$depth[1],diff(soil_IC_list$dims$depth))
+      #SoilWHC
+      if ("volume_fraction_of_water_in_soil_at_saturation" %in% names(soil_IC_list$vals)) {
+         # Calculate the soilWHC for the whole soil profile in cm
+         soilWHC_total <- sum(unlist(soil_IC_list$vals["volume_fraction_of_water_in_soil_at_saturation"])*thickness)
+         param[which(param[, 1] == "soilWHC"), 2] <- soilWHC_total
+         #LitterWHC in cm (top soil layer)
+         param[which(param[, 1] == "litterWHC"), 2] <- unlist(soil_IC_list$vals["volume_fraction_of_water_in_soil_at_saturation"])[1]*thickness[1]
+       }
+      if ("soil_hydraulic_conductivity_at_saturation" %in% names(soil_IC_list$vals)) {
+         #litwaterDrainrate in cm/day
+         param[which(param[, 1] == "litWaterDrainRate"), 2] <- unlist(soil_IC_list$vals["soil_hydraulic_conductivity_at_saturation"])[1]*100/(3600*24)
+       }
+    }else{
+      PEcAn.logger::logger.warn("No depth info was found in the soil file. Please check whether the parameters are for the whole profile")
+       }
+  }   
   if (!is.null(IC)) {
     ic.names <- names(IC)
     ## plantWoodInit gC/m2

modules/assim.sequential/R/metSplit.R

@@ -31,7 +31,7 @@ metSplit <- function(conf.settings, inputs, settings, model, no_split = FALSE, o
     furrr::future_pmap(list(conf.settings %>% `class<-`(c("list")), inputs, model), function(settings, inputs, model) {
       # Loading the model package - this is required bc of the furrr
       library(paste0("PEcAn.",model), character.only = TRUE)
-      
+
       inputs.split <- list()
       if (!no_split) {
         for (i in seq_len(nens)) {

modules/assim.sequential/R/sda.enkf_MultiSite.R

@@ -355,17 +355,33 @@ sda.enkf.multisite <- function(settings,
       #reformatting params
       new.params <- sda_matchparam(settings, ensemble.samples, site.ids, nens)
     }
-      #sample met ensemble members
-      #TODO: incorporate Phyllis's restart work
-      #      sample all inputs specified in the settings$ensemble not just met
-      inputs <- PEcAn.settings::papply(conf.settings,function(setting) {
-        PEcAn.uncertainty::input.ens.gen(
-          settings = setting,
-          input = "met",
-          method = setting$ensemble$samplingspace$met$method,
-          parent_ids = NULL 
-        )
-       })
+
+   #sample all inputs specified in the settings$ensemble
+   #now looking into the xml
+   samp <- conf.settings$ensemble$samplingspace
+   #finding who has a parent
+   parents <- lapply(samp,'[[', 'parent')
+   #order parents based on the need of who has to be first
+   order <- names(samp)[lapply(parents, function(tr) which(names(samp) %in% tr)) %>% unlist()] 
+   #new ordered sampling space
+   samp.ordered <- samp[c(order, names(samp)[!(names(samp) %in% order)])]
+   #performing the sampling
+   inputs <- vector("list", length(conf.settings))
+   # For the tags specified in the xml I do the sampling
+   for (s in seq_along(conf.settings)){
+      if (is.null(inputs[[s]])) {
+        inputs[[s]] <- list() 
+      }
+     for (i in seq_along(samp.ordered)){
+         #call the function responsible for generating the ensemble
+        inputs[[s]][[names(samp.ordered)[i]]] <- input.ens.gen(settings=conf.settings[[s]],
+                                                             input=names(samp.ordered)[i],
+                                                             method=samp.ordered[[i]]$method,
+                                                             parent_ids=NULL)
+      }
+    }
+
+
   ###------------------------------------------------------------------------------------------------###
   ### loop over time                                                                                 ###
   ###------------------------------------------------------------------------------------------------###
@@ -379,7 +395,42 @@ sda.enkf.multisite <- function(settings,
       if (t>1){
         #for next time step split the met if model requires
         #-Splitting the input for the models that they don't care about the start and end time of simulations and they run as long as their met file.
-        inputs.split <- metSplit(conf.settings, inputs, settings, model, no_split = FALSE, obs.times, t, nens, restart_flag = FALSE, my.split_inputs)
+        #set start and end date for splitting met
+        start.time = obs.times[t - 1] #always start timestep before
+
+        if(restart_flag){
+          stop.time = settings$run$site$met.end
+        }else{
+          stop.time = obs.times[t]
+        }
+
+
+        #-Splitting the input for the models that they don't care about the start and end time of simulations and they run as long as their met file.
+        inputs.split <- 
+          furrr::future_pmap(list(conf.settings %>% `class<-`(c("list")), inputs, model), function(settings, inputs, model) {
+            # Loading the model package - this is required bc of the furrr
+            library(paste0("PEcAn.",model), character.only = TRUE)
+
+            inputs.split <- inputs
+            if (!no_split) {
+              for (i in seq_len(nens)) {
+                #---------------- model specific split inputs
+                inputs.split$met$samples[i] <- do.call(
+                  my.split_inputs,
+                  args = list(
+                    settings = settings,
+                    start.time = (lubridate::ymd_hms(start.time, truncated = 3) + lubridate::second(lubridate::hms("00:00:01"))),
+                    stop.time =   lubridate::ymd_hms(stop.time, truncated = 3),
+                    inputs = inputs$met$samples[[i]])
+                )
+              }
+            } else{
+              inputs.split <- inputs
+            }
+            inputs.split
+          })
+
+
 
         #---------------- setting up the restart argument for each site separately and keeping them in a list
         restart.list <-
@@ -412,9 +463,8 @@ sda.enkf.multisite <- function(settings,
         X <- X
       }else{
         if (control$debug) browser()
-        out.configs <- conf.settings %>%
-          `class<-`(c("list")) %>%
-          furrr::future_map2(restart.list, function(settings, restart.arg) {
+
+        out.configs <-furrr::future_pmap(list(conf.settings %>% `class<-`(c("list")),restart.list, inputs), function(settings, restart.arg, inputs) {
             # Loading the model package - this is required bc of the furrr
             library(paste0("PEcAn.",settings$model$type), character.only = TRUE)
             # wrtting configs for each settings - this does not make a difference with the old code
@@ -425,6 +475,7 @@ sda.enkf.multisite <- function(settings,
               model = settings$model$type,
               write.to.db = settings$database$bety$write,
               restart = restart.arg,
+              samples=inputs,
               rename = TRUE
             )
           }) %>%
@@ -768,4 +819,5 @@ sda.enkf.multisite <- function(settings,
 #    }
       ## MCD: I commented the above "if" out because if you are restarting from a previous forecast, this might delete the files in that earlier folder
   } ### end loop over time
-} # sda.enkf
+} # sda.enkf
+

modules/assim.sequential/inst/MultiSite-Exs/SDA/Create_Multi_settings.R

@@ -225,6 +225,7 @@ template <- PEcAn.settings::Settings(list(
   ensemble = structure(list(size = 25, variable = "NPP", 
                             samplingspace = structure(list(
                               parameters = structure(list(method = "lhc")),
+                              soilinitcond = structure(list(method = "sampling")),
                               met = structure(list(method = "sampling"))
                             ))
   )),

modules/data.land/NAMESPACE

@@ -54,6 +54,7 @@ export(soil2netcdf)
 export(soil_params)
 export(soil_process)
 export(soilgrids_soilC_extract)
+export(soilgrids_texture_extraction)
 export(subset_layer)
 export(to.Tag)
 export(to.TreeCode)

modules/data.land/R/extract_soil_nc.R

@@ -348,6 +348,7 @@ extract_soil_nc <- function(in.file,outdir,lat,lon){
 #'  * `soil_thermal_conductivity_at_saturation`
 #'  * `soil_thermal_capacity`
 #'  * `soil_albedo`
+
 #'
 #' @param varname character vector. See details
 #'
@@ -383,6 +384,7 @@ soil.units <- function(varname = NA){
                                       "soil_thermal_conductivity_at_saturation","W m-1 K-1", 
                                       "soil_thermal_capacity","J kg-1 K-1",
                                       "soil_albedo","1"
+
   ),
   ncol=2,byrow = TRUE))
   colnames(variables) <- c('var','unit')