# | (C) 2006-2019 Potsdam Institute for Climate Impact Research (PIK) # | authors, and contributors see CITATION.cff file. This file is part # | of REMIND and licensed under AGPL-3.0-or-later. Under Section 7 of # | AGPL-3.0, you are granted additional permissions described in the # | REMIND License Exception, version 1.0 (see LICENSE file). # | Contact: remind@pik-potsdam.de ########################################################## #### REMIND Output Generation #### ########################################################## # Version 1.0 # Type "Rscript output.R" to start the script in the command line # Based on the Version 2.2 of same file in the MAgPIE main folder ######################################################################################### #Write dump file when error occurs, see help to dump.frames for more information options(error=quote({dump.frames(to.file=TRUE); traceback(); q()})) #load landuse library library(lucode) ###Define arguments that can be read from command line if(!exists("source_include")) { # if this script is not being sourced by another script but called from the command line via Rscript read the command line arguments and let the user choose the slurm options readArgs("outputdir","output","comp","remind_dir") } #Setting relevant paths if(file.exists('/iplex/01/landuse')) { #run is performed on the cluster pythonpath <- '/iplex/01/landuse/bin/python/bin/' latexpath <- '/iplex/01/sys/applications/texlive/bin/x86_64-linux/' } else { pythonpath <- '' latexpath <- NA } get_line <- function(){ # gets characters (line) from the terminal of from a connection # and stores it in the return object if(interactive()){ s <- readline() } else { con <- file("stdin") s <- readLines(con, 1, warn=FALSE) on.exit(close(con)) } return(s); } choose_folder <- function(folder,title="Please choose a folder") { dirs <- NULL # Detect all output folders containing fulldata.gdx # For coupled runs please use the outcommented text block below dirs <- sub("/fulldata.gdx","",sub("./output/","",Sys.glob(file.path(folder,"*","fulldata.gdx")))) # DK: The following outcommented lines are specially made for listing results of coupled runs #runs <- findCoupledruns(folder) #dirs <- findIterations(runs,modelpath=folder,latest=TRUE) #dirs <- sub("./output/","",dirs) dirs <- c("all",dirs) cat("\n\n",title,":\n\n") cat(paste(1:length(dirs), dirs, sep=": " ),sep="\n") cat(paste(length(dirs)+1, "Search by the pattern.\n", sep=": ")) cat("\nNumber: ") identifier <- get_line() identifier <- strsplit(identifier,",")[[1]] tmp <- NULL for (i in 1:length(identifier)) { if (length(strsplit(identifier,":")[[i]]) > 1) tmp <- c(tmp,as.numeric(strsplit(identifier,":")[[i]])[1]:as.numeric(strsplit(identifier,":")[[i]])[2]) else tmp <- c(tmp,as.numeric(identifier[i])) } identifier <- tmp # PATTERN if(length(identifier==1) && identifier==(length(dirs)+1)){ cat("\nInsert the search pattern or the regular expression: ") pattern <- get_line() id <- grep(pattern=pattern, dirs[-1]) # lists all chosen directories and ask for the confirmation of the made choice cat("\n\nYou have chosen the following directories:\n") cat(paste(1:length(id), dirs[id+1], sep=": "), sep="\n") cat("\nAre you sure these are the right directories?(y/n): ") answer <- get_line() if(answer=="y"){ return(dirs[id+1]) } else choose_folder(folder,title) # } else if(any(dirs[identifier] == "all")){ identifier <- 2:length(dirs) return(dirs[identifier]) } else return(dirs[identifier]) } choose_module <- function(Rfolder,title="Please choose an outputmodule") { module <- gsub("\\.R$","",grep("\\.R$",list.files(Rfolder), value=TRUE)) cat("\n\n",title,":\n\n") cat(paste(1: length(module), module, sep=": " ),sep="\n") cat("\nNumber: ") identifier <- get_line() identifier <- as.numeric(strsplit(identifier,",")[[1]]) if (any(!(identifier %in% 1:length(module)))) stop("This choice (",identifier,") is not possible. Please type in a number between 1 and ",length(module)) return(module[identifier]) } choose_mode <- function(title="Please choose the output mode") { modes <- c("Output for single run ","Comparison across runs") cat("\n\n",title,":\n\n") cat(paste(1:length(modes), modes, sep=": " ),sep="\n") cat("\nNumber: ") identifier <- get_line() identifier <- as.numeric(strsplit(identifier,",")[[1]]) if (identifier==1) { comp<-FALSE } else if (identifier==2) { comp<-TRUE } else { stop("This mode is invalid. Please choose a valid mode") } return(comp) } if(exists("source_include")) { comp <- FALSE } else { if(!exists("comp")) { comp<-choose_mode("Please choose the output mode") } } if (comp==TRUE) { print("comparison") # Select output modules if not defined by readArgs if(!exists("output")) { output <- choose_module("./scripts/output/comparison","Please choose the output module to be used for output generation") } # Select output directories if not defined by readArgs if (!exists("outputdir")) { if (!exists("remind_dir")) { temp <- choose_folder("./output","Please choose the runs to be used for output generation") outputdirs <- temp for (i in 1:length(temp)) outputdirs[i] <- path("output",temp[i]) } else { temp <- choose_folder(remind_dir,"Please choose the runs to be used for output generation") outputdirs <- temp for (i in 1:length(temp)) { last_iteration <- max(as.numeric(sub("magpie_","",grep("magpie_",list.dirs(path(remind_dir,temp[i],"data/results")),value=T)))) outputdirs[i] <- path(remind_dir,temp[i],"data/results/",paste("magpie_",last_iteration,sep="")) } } } else outputdirs <- outputdir #Set value source_include so that loaded scripts know, that they are #included as source (instead of a load from command line) source_include <- TRUE # Execute output scripts over all choosen folders for(rout in output){ name<-paste(rout,".R",sep="") if(file.exists(paste("scripts/output/comparison/",name,sep=""))){ print(paste("Executing",name)) tmp.env <- new.env() tmp.error <- try(sys.source(paste("scripts/output/comparison/",name,sep=""),envir=tmp.env)) rm(tmp.env) gc() if(!is.null(tmp.error)) warning("Script ",name," was stopped by an error and not executed properly!") } } } else { # Select an output directory if not defined by readArgs if(!exists("outputdir")) { if (!exists("remind_dir")) { temp <- choose_folder("./output","Please choose the run(s) to be used for output generation") outputdirs <- temp for (i in 1:length(temp)) outputdirs[i] <- path("output",temp[i]) } else { temp <- choose_folder(remind_dir,"Please choose the runs to be used for output generation") outputdirs <- temp for (i in 1:length(temp)) { last_iteration <- max(as.numeric(sub("magpie_","",grep("magpie_",list.dirs(path(remind_dir,temp[i],"data/results")),value=T)))) outputdirs[i] <- path(remind_dir,temp[i],"data/results/",paste("magpie_",last_iteration,sep="")) } } } else outputdirs <- outputdir # define slurm class or direct execution if(!exists("source_include")) { # if this script is not being sourced by another script but called from the command line via Rscript let the user choose the slurm options source("scripts/start/choose_slurmConfig.R") slurmConfig <- choose_slurmConfig() } else { # if this script is being sourced by another script exectue the output scripts directly without sending them to the cluster slurmConfig <- "direct" } #Execute outputscripts for all choosen folders for (outputdir in outputdirs) { # Select an output module if not defined by readArgs if(!exists("output")) { output <- choose_module("./scripts/output/single","Please choose the output module to be used for output generation") } if(exists("cfg")) { title <- cfg$title gms <- cfg$gms input <- cfg$input revision <- cfg$revision magpie_folder <- cfg$magpie_folder } # Get values of config if output.R is called standalone if(!exists("source_include")) { magpie_folder <- getwd() print(path(outputdir,"config.Rdata")) if(file.exists(path(outputdir,"config.Rdata"))) { load(path(outputdir,"config.Rdata")) title <- cfg$title gms <- cfg$gms input <- cfg$input revision <- cfg$revision } else { config <- grep("\\.cfg$",list.files(outputdir), value=TRUE) l<-readLines(path(outputdir,config)) title <- strsplit(grep("(cfg\\$|)title +<-",l,value=TRUE),"\"")[[1]][2] gms <- list() gms$scenarios <- strsplit(grep("(cfg\\$|)gms\\$scenarios +<-",l,value=TRUE),"\"")[[1]][2] input <- strsplit(grep("(cfg\\$|)input +<-",l,value=TRUE),"\"")[[1]][2] revision <- as.numeric(unlist(strsplit(grep("(cfg\\$|)revision +<-",l,value=TRUE),"<-[ \t]*"))[2]) } } #Set value source_include so that loaded scripts know, that they are #included as source (instead of a load from command line) source_include <- TRUE cat(paste("\nStarting output generation for",outputdir,"\n\n")) ################################################################################### # Execute R scripts ################################################################################### for(rout in output){ name<-paste(rout,".R",sep="") if(file.exists(paste0("scripts/output/single/",name))){ if (slurmConfig == "direct") { # execute output script directly (without sending it to slurm) print(paste("Executing",name)) tmp.env <- new.env() tmp.error <- try(sys.source(paste0("scripts/output/single/",name),envir=tmp.env)) # rm(list=ls(tmp.env),envir=tmp.env) rm(tmp.env) gc() if(!is.null(tmp.error)) warning("Script ",name," was stopped by an error and not executed properly!") } else { # send the output script to slurm slurmcmd <- paste0("sbatch ",slurmConfig," --job-name=",outputdir," --output=",outputdir,".txt --mail-type=END --comment=REMIND --wrap=\"Rscript scripts/output/single/",rout,".R outputdir=",outputdir,"\"") cat("Sending to slurm: ",name,"\n") system(slurmcmd) Sys.sleep(1) } } } # finished cat(paste("\nFinished output generation for",outputdir,"!\n\n")) rm(source_include) if(!is.null(warnings())) print(warnings()) } }