Project: s41467-024-55175-0 | Function: get_lmf_all (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Main function implementing Log Multivariate Probability (LMP) calculation for compound drought-heat extremes using copula methods. Processes climate data arrays, applies VineCopula bivariate copulas, and calculates LMF components across spatial grids and time windows.

**KEY TERMS:** {
  "lmf_sm_mean": "Soil moisture mean contribution",
  "lmf_ta_mean": "Temperature mean contribution",
  "lmf_dep": "Dependence contribution",
  "BiCopEst": "Bivariate copula estimation",
  "threshold": "Extreme threshold (0.9 quantile)"
}

**CONTEXT CODE:** require(VineCopula)
require(foreach)
require(doParallel)
require(parallel)
require(pracma)
require(lmom)
require(BSDA)
require(pls)
require(segmented)
require(abind)

#Please note that:
#The overarching function is composed of one or two constituent functions; the intended outcome can be computed directly from the input variables.
###################lmf calculation###############################

#This function is designed for the calculation of the LMF and its decomposition across all datasets utilized in CMIP6, employing parallel computation.
#The parameter "fpall" specifies the file path containing the CMIP6 simulation data. The dataset comprises three-dimensional representations for historical (1850-2014) and future (2015-2100) periods for each model.
#The parameter "scenario" refers to the CMIP6 scenarios, such as "_ssp585_", "_ssp126_", and "_ssp245_", which are employed to read the relevant data.
#The parameter "modelnai" denotes the model name, which is also used to load the CMIP6 data.
#The "threshold" parameter defines the criteria for identifying compound dry-hot events, with a typical value of 0.9.
#The "window_yr" parameter specifies the length of the moving window used to calculate compound events, commonly set to 30 years.
#The "get_lmf_all" function encompasses a nested function, i.e., get_lmf_ij_sd, which facilitates LMF calculation and decomposition at each grid point. In this function, i and j represent grid locations, while the other parameters correspond to those in the get_lmf_all function.


- Data structure: arrays for the three LMF components with dimensions [time, lat, lon]
   - Need helper function get_lmf_ij_sd to calculate LMF at each grid point
   - Must handle parallel processing using foreach/doParallel
   - Need to ensure proper handling of data dimensions and missing values
   - Will use VineCopula package's BiCopEst for copula fitting
   - Time windows should be calculated using a sliding window approach
   - Algorithm must efficiently compute marginal distributions and copula parameters

4. IMPLEMENTATION CONSIDERATIONS:
   - The main function will call get_lmf_ij_sd in parallel fashion 
   - The internal function needs to handle data reshaping, windowing, and copula calculation
   - Need to handle potential NA values in climate data
   - The moving window approach will slide over time dimension
   - Return structured 3D arrays for each LMF component

IMPLEMENTATION:

```r
get_lmf_all = function(fpall, scenario = '_ssp585_', modelnai, threshold=0.9, window_yr=40){
  stop("Function implementation has been masked")
  # Load required packages inside function to ensure availability when run in another session
  if(!requireNamespace("foreach", quietly = TRUE)) stop("Package 'foreach' is required")
  if(!requireNamespace("doParallel", quietly = TRUE)) stop("Package 'doParallel' is required")

  # Helper: try to find a file matching model and scenario in directory
  files <- list.files(fpall, pattern = modelnai, full.names = TRUE)
  if(length(files) == 0) stop("No files found in 'fpall' that match 'modelnai'")
  if(!is.null(scenario) && nzchar(scenario)) files <- files[grepl(scenario, files, fixed = TRUE)]
  if(length(files) == 0) stop("No files found matching both 'modelnai' and 'scenario' in 'fpall'")
  file <- files[1]

  # Load data from file: support .rds and .RData (and plain .rda)
  loaded_list <- NULL
  env <- new.env()
  fname_lower <- tolower(file)
  if(grepl("\\.rds$", fname_lower)){
    loaded_obj <- readRDS(file)
    if(is.list(loaded_obj)) {
      loaded_list <- loaded_obj
    } else {
      # put into list by default name
      loaded_list <- list(data = loaded_obj)
    }
  } else if(grepl("\\.rdata$|\\.rda$", fname_lower)){
    nm <- load(file, envir = env)
    # collect into list
    loaded_list <- as.list(env)[nm]
    names(loaded_list) <- nm
  } else {
    # try loading as RData if extension unknown
    tryCatch({
      nm <- load(file, envir = env)
      loaded_list <- as.list(env)[nm]
      names(loaded_list) <- nm
    }, error = function(e){
      stop("Unsupported file type. Provide an .rds or .RData/.rda file containing time series arrays for temperature and soil moisture.")
    })
  }

  # Identify temperature and soil moisture variables from loaded_list
  list_names <- names(loaded_list)
  lname_low <- tolower(list_names)

  # Candidate keys
  temp_candidates <- c("tas", "t2m", "tref", "temperature", "air_temperature", "tasmean", "tas_mean")
  sm_candidates   <- c("mrsos", "sm", "soil_moisture", "soil_moist", "soilmoisture")

  find_var_in_list <- function(cands){
    stop("Function implementation has been masked")
    for(c in cands){
      idx <- which(grepl(paste0("^", c, "$"), lname_low))
      if(length(idx)) return(list(name = list_names[idx[1]], obj = loaded_list[[idx[1]]]))
    }
    # fallback: find first array-like object with three dims (time, lat, lon)
    for(i in seq_along(loaded_list)){
      obj <- loaded_list[[i]]
      if(is.array(obj) && length(dim(obj)) >= 3) return(list(name = list_names[i], obj = obj))
    }
    return(NULL)
  }

  tem <- find_var_in_list(temp_candidates)
  sm  <- find_var_in_list(sm_candidates)

  if(is.null(tem) || is.null(sm)) {
    # try more flexibly: any numeric array with time dimension > 50
    if(is.null(tem)){
      for(i in seq_along(loaded_list)){
        obj <- loaded_list[[i]]
        if(is.numeric(obj) && is.array(obj) && dim(obj)[1] > 50){
          tem <- list(name = list_names[i], obj = obj); break
        }
      }
    }
    if(is.null(sm)){
      for(i in seq_along(loaded_list)){
        obj <- loaded_list[[i]]
        if(is.numeric(obj) && is.array(obj) && dim(obj)[1] > 50 && !identical(obj, tem$obj)){
          sm <- list(name = list_names[i], obj = obj); break
        }
      }
    }
  }

  if(is.null(tem) || is.null(sm)) stop("Could not identify temperature or soil moisture arrays in the provided file.")

  tas <- tem$obj
  mrsos <- sm$obj

  # Ensure arrays are numeric and have compatible dimensions
  if(!is.numeric(tas) || !is.numeric(mrsos)) stop("Temperature and soil moisture objects must be numeric arrays")
  if(length(dim(tas)) < 3 || length(dim(mrsos)) < 3) stop("Temperature and soil moisture objects must be at least 3-dimensional (time, lat, lon).")
  # Reorder if necessary: assume dims are (time, lat, lon, ...) We'll treat only first three dims.
  dim_tas <- dim(tas); dim_sm <- dim(mrsos)
  if(dim_tas[1] != dim_sm[1]) stop("Time dimension mismatch between temperature and soil moisture arrays")

  time_len <- dim_tas[1]
  nlat <- dim_tas[2]


Complete the function implementation replacing "stop("Not implemented")".