Skip to content
Snippets Groups Projects
Commit f024fd2a authored by Marianna Rottoli's avatar Marianna Rottoli
Browse files

Merge branch 'develop' of github.com:remindmodel/remind into REMIND_new_transp_esm

parents f02f41f6 26757d4b
No related branches found
No related tags found
1 merge request!67Request to merge the new transport module EDGE-T
Showing
with 942 additions and 1212 deletions
......@@ -66,7 +66,7 @@ compareScenTable <- function(listofruns){
if(system("hash sbatch 2>/dev/null") == 0){
cat("Submitting comparison Jobs:\n")
system("sbatch scripts/run_submit/submit_compare.cmd")
system(paste0("sbatch --job-name=rem-compare --output=log-%j.out --mail-type=END --cpus-per-task=2 --qos=priority --wrap=\"Rscript scripts/utils/compareParallel.R \""))
}else{
source("scripts/utils/compareParallel.R")
}
......
# | (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
source("scripts/start_functions.R")
performance_start <- function(cfg="default.cfg",modulepath="modules/",id="performance",sequential=NULL) {
require(lucode)
if(!is.list(cfg)) {
if(is.character(cfg)) {
source(path("config",cfg),local=TRUE)
if(!is.list(cfg)) stop("Wrong input file format: config file does not contain a cfg list!")
} else {
stop("Wrong input format: cfg is neither a list nor a character!")
}
}
cfg$results_folder <- "output/:title:"
cfg$sequential <- sequential
cfg$logoption <- 2
#LB# funzt erstmal nicht in REMIND
#svn <- system("svn info",intern=TRUE)
#save(svn,file="svn.rda")
#cfg$files2export$start <- c(cfg$files2export$start,"svn.rda")
#start default run
cfg$title <- paste(id,"default",sep="__")
cat(cfg$title,"\n")
start_run(cfg)
m <- getModules(modulepath)
for(i in 1:dim(m)[1]) {
#for(i in c(1,3,4)) {
default <- cfg$gms[[m[i,"name"]]]
r <- strsplit(m[i,"realizations"],",")[[1]]
r <- r[r!=default] #remove default case
for(j in r) {
cfg$gms[[m[i,"name"]]] <- j
cfg$title <- paste(id,m[i,"name"],j,sep="__")
cat(cfg$title,"\n")
start_functions(cfg) # for REMIND
# start_run(cfg) # for MAGPIE
}
cfg$gms[[m[i,"name"]]] <- default
}
}
performance_collect <- function(id="performance",results_folder="output/",plot=TRUE) {
require(magpie)
require(lucode)
maindir <- getwd()
cat("\n wir sind in ", maindir,"\n")
on.exit(setwd(maindir))
setwd(results_folder)
cat("\n wir sind in ",results_folder,"\n")
folders <- grep(paste("^",id,"__",sep=""),list.dirs(),value=TRUE)
tmp <- grep(paste("^",id,"__default",sep=""),folders)
default <- folders[tmp]
if(length(default)==0) stop("No default folder found which fits to the given id (",id,")")
folders <- folders[-tmp]
if(length(folders)==0) stop("No folders found which fit to the given id (",id,")")
.modelstats <- function(f,colMeans=TRUE) {
# logfile <- path(f,"log.txt") # for MAGPIE
logfile <- path(f,"full.log") # for REMIND
tmp <- readLines(logfile)
l1 <- grep("rows",tmp,value=TRUE)
l2 <- grep("nl-code",tmp,value=TRUE)
if(length(l1)==0 & length(l2)==0) return(NA)
p1 <- "--- ([^ ]*) rows ([^ ]*) columns ([^ ]*) non-zeroes"
rows <- as.integer(gsub(",","",gsub(p1,"\\1",l1)))
columns <- as.integer(gsub(",","",gsub(p1,"\\2",l1)))
nonzeroes <- as.integer(gsub(",","",gsub(p1,"\\3",l1)))
p2 <- "--- ([^ ]*) nl-code ([^ ]*) nl-non-zeroes"
nlcode <- as.integer(gsub(",","",gsub(p2,"\\1",l2)))
nlnonzeroes <- as.integer(gsub(",","",gsub(p2,"\\2",l2)))
out <- cbind(rows,columns,nonzeroes,nlcode,nlnonzeroes)
rownames(out) <- paste("t",1:dim(out)[1],sep="")
if(colMeans) out <- colMeans(out)
return(out)
}
.infescheck <- function(gdx) {
if(!file.exists(gdx)) return(3)
tmp <- modelstat(gdx)
if(any(tmp!=2 & tmp!=7)) {
x <- 2
} else if(any(tmp!=2 & tmp==7)) {
x <- 1
} else {
x <- 0
}
return(x)
}
.gettime <- function(rdata) {
load(rdata)
# tmp <- as.double(validation$technical$time$magpie.gms,unit="mins") # for MAGPIE
tmp <- as.double(validation$technical$time$full.gms,unit="mins") # for REMIND
return(tmp)
}
results <- NULL
infes <- list()
cat("\n folgende folder werden gleich bearbeitet ",folders,"\n")
for(f in folders){
tmp <- strsplit(f,"__")[[1]]
ms <- .modelstats(f,colMeans=TRUE)
cat("\n module ",tmp[2],"\n")
cat("\n realization ",tmp[3],"\n")
# for MAGPIE
#tmp2 <- data.frame(module=tmp[2],realization=tmp[3],default=FALSE,runtime=.gettime(path(f,f,ftype="RData")),infes=.infescheck(path(f,"fulldata.gdx")),
# rows=ms["rows"],columns=ms["columns"],nonzeroes=ms["nonzeroes"],nlcode=ms["nlcode"],nlnonzeroes=ms["nlnonzeroes"])
# for REMIND
tmp2 <- data.frame(module=tmp[2],realization=tmp[3],default=FALSE,runtime=.gettime(path(f,f,ftype="RData")),infes=.infescheck(path(f,"optim.gdx")),
rows=ms["rows"],columns=ms["columns"],nonzeroes=ms["nonzeroes"],nlcode=ms["nlcode"],nlnonzeroes=ms["nlnonzeroes"])
results <- rbind(results,tmp2)
}
load(path(default,"config.Rdata"))
for(n in unique(results$module)) {
ms <- .modelstats(default,colMeans=TRUE)
# for MAGPIE
# tmp <- data.frame(module=n,realization=cfg$gms[[n]],default=TRUE,runtime=.gettime(path(default,default,ftype="RData")),infes=.infescheck(path(default,"fulldata.gdx")),
# rows=ms["rows"],columns=ms["columns"],nonzeroes=ms["nonzeroes"],nlcode=ms["nlcode"],nlnonzeroes=ms["nlnonzeroes"])
# for REMIND
tmp <- data.frame(module=n,realization=cfg$gms[[n]],default=TRUE,runtime=.gettime(path(default,default,ftype="RData")),infes=.infescheck(path(default,"optim.gdx")),
rows=ms["rows"],columns=ms["columns"],nonzeroes=ms["nonzeroes"],nlcode=ms["nlcode"],nlnonzeroes=ms["nlnonzeroes"])
results <- rbind(results,tmp)
}
results$info <- paste(results$module,results$realization,sep=": ")
results$relative_runtime <- results$runtime/results[results$default,"runtime"][1] - 1
results$more_info[results$default] <- "default"
results$more_info[results$infes==0 & !results$default] <- paste(round(results$relative_runtime[results$infes==0 & !results$default]*100),"%",sep="")
results$more_info[results$infes==1] <- "non-optimal solution"
results$more_info[results$infes==2] <- "infeasible solution"
results$more_info[results$infes==3] <- "compilation error"
results$relative_rows <- results$rows/results[results$default,"rows"][1] - 1
results$relative_columns <- results$columns/results[results$default,"columns"][1] - 1
results$relative_nonzeroes <- results$nonzeroes/results[results$default,"nonzeroes"][1] - 1
results$relative_nlcode <- results$nlcode/results[results$default,"nlcode"][1] - 1
results$relative_nlnonzeroes <- results$nlnonzeroes/results[results$default,"nlnonzeroes"][1] - 1
attr(results,"default_cfg") <- cfg
attr(results,"id") <- id
#if(file.exists(path(default,"svn.rda"))) {
# load(path(default,"svn.rda"))
# attr(results,"svn") <- svn
#}
setwd(maindir)
if(plot) performance_plot(results)
return(results)
}
performance_plot <- function(x) {
require(ggplot2)
require(lusweave)
.create_plot <- function(x,weight="relative_runtime",label="runtime/default_runtime2") {
p <- ggplot(x, aes_string(x="info",weight=weight,fill="module")) + geom_bar(position="dodge")+coord_flip()+labs(y=label,x="",size=2)
p <- p + geom_text(aes(y=0,label=more_info), hjust=0, size = 3) + theme(legend.position="none")
print(p)
}
.tmptable <- function(sw,tmp) {
nrow <- ceiling(length(tmp)/2)
if(nrow*2 > length(tmp)) tmp <- c(tmp,"")
swtable(sw,matrix(tmp,nrow),align="l",include.colnames=FALSE,include.rownames=FALSE,vert.lines=0,hor.lines=0)
return(sw)
}
sw_option <- "width=11,height=12"
sw <- swopen(paste("performance_check_",attr(x,"id"),".pdf",sep=""))
swlatex(sw,c("\\title{Performance test results}","\\author{Model Operations Group}","\\maketitle","\\tableofcontents"))
swlatex(sw,"\\newpage")
swlatex(sw,"\\section{General information}")
swlatex(sw,"\\subsection{Settings default run}")
sw <- .tmptable(sw,x$info[x$more_info =="default"])
swlatex(sw,"\\subsection{Run information default run}")
tmp <- x[x$more_info=="default",][1,c("runtime","rows","columns","nonzeroes","nlcode","nlnonzeroes")]
tmp2 <- cbind(format(round(as.vector(as.matrix(tmp)),2),nsmall=2),names(tmp))
rownames(tmp2) <- names(tmp)
colnames(tmp2) <- c("data","description")
tmp2[,"description"] <- c(" minutes (total runtime)",
" (average over all optimizations)",
" (average over all optimizations)",
" (average over all optimizations)",
" (average over all optimizations)",
" (average over all optimizations)")
swtable(sw,tmp2,align="r")
swlatex(sw,"\\newpage")
#remove default run from results
x <- x[x$more_info!="default",]
tmp <- x$info[x$more_info =="compilation error"]
if(length(tmp)>0){
swlatex(sw,"\\subsection{Compilation errors}")
sw <- .tmptable(sw,tmp)
#remove runs with compilation error from results
x <- x[x$more_info!="compilation error",]
}
tmp <- x$info[x$more_info =="infeasible solution"]
if(length(tmp)>0){
swlatex(sw,"\\subsection{Infeasible solutions}")
sw <- .tmptable(sw,tmp)
}
.tmp <- function(sw,x) {
swlatex(sw,"\\subsection{relative runtime}")
swfigure(sw,.create_plot,x,weight="relative_runtime",label="runtime relative to default run",sw_option=sw_option)
swlatex(sw,"\\subsection{relative number of rows}")
swfigure(sw,.create_plot,x,weight="relative_rows",label="No. of rows relative to default",sw_option=sw_option)
swlatex(sw,"\\subsection{relative number of columns}")
swfigure(sw,.create_plot,x,weight="relative_columns",label="No. of columns relative to default",sw_option=sw_option)
swlatex(sw,"\\subsection{relative number of nonzeroes}")
swfigure(sw,.create_plot,x,weight="relative_nonzeroes",label="No. of nonzeroes relative to default",sw_option=sw_option)
swlatex(sw,"\\subsection{relative number of nl code}")
swfigure(sw,.create_plot,x,weight="relative_nlcode",label="Lines of NL code relative to default",sw_option=sw_option)
swlatex(sw,"\\subsection{relative number of nl nonzeroes}")
swfigure(sw,.create_plot,x,weight="relative_nlnonzeroes",label="No. of NL nonzeroes relative to default",sw_option=sw_option)
return(sw)
}
swlatex(sw,"\\section{Results sorted by module}")
sw <- .tmp(sw,x)
x <- x[order(x$runtime,decreasing=TRUE),]
x$info <- factor(x$info,x$info)
swlatex(sw,"\\section{Results sorted by runtime}")
sw <- .tmp(sw,x)
if(!is.null(attr(x,"svn"))){
swlatex(sw,"\\section{SVN info}")
sw <- .tmptable(sw,c(attr(x,"svn"),rep("",length(attr(x,"svn")))))
}
swlatex(sw,"\\newpage\\section{Full default config}")
tmp <- unlist(attr(x,"default_cfg"))
n <- 35
while(length(tmp)>n) {
sw <- .tmptable(sw,c(names(tmp)[1:n],tmp[1:n]))
tmp <- tmp[-(1:n)]
}
sw <- .tmptable(sw,c(names(tmp),tmp))
swclose(sw)
}
# | (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
library(lucode, quietly = TRUE,warn.conflicts =FALSE)
library(dplyr, quietly = TRUE,warn.conflicts =FALSE)
require(gdx)
# Function to create the levs.gms, fixings.gms, and margs.gms files, used in
# delay scenarios.
create_fixing_files <- function(cfg, input_ref_file = "input_ref.gdx") {
# Start the clock.
begin <- Sys.time()
# Extract data from input_ref.gdx file and store in levs_margs_ref.gms.
system(paste("gdxdump",
input_ref_file,
"Format=gamsbas Delim=comma FilterDef=N Output=levs_margs_ref.gms",
sep = " "))
# Read data from levs_margs_ref.gms.
ref_gdx_data <- suppressWarnings(readLines("levs_margs_ref.gms"))
# Create fixing files.
cat("\n")
create_standard_fixings(cfg, ref_gdx_data)
# Stop the clock.
cat("Time it took to create the fixing files: ")
manipulate_runtime <- Sys.time()-begin
print(manipulate_runtime)
cat("\n")
# Delete file.
file.remove("levs_margs_ref.gms")
}
# Function to create the levs.gms, fixings.gms, and margs.gms files, used in
# the standard (i.e. the non-macro stand-alone) delay scenarios.
create_standard_fixings <- function(cfg, ref_gdx_data) {
# Declare empty lists to hold the strings for the 'manipulateFile' functions.
full_manipulateThis <- NULL
levs_manipulateThis <- NULL
fixings_manipulateThis <- NULL
margs_manipulateThis <- NULL
str_years <- c()
no_years <- (cfg$gms$cm_startyear - 2005) / 5
# Write level values to file
levs <- c()
for (i in 1:no_years) {
str_years[i] <- paste("L \\('", 2000 + i * 5, sep = "")
levs <- c(levs, grep(str_years[i], ref_gdx_data, value = TRUE))
}
writeLines(levs, "levs.gms")
# Replace fixing.gms with level values
file.copy("levs.gms", "fixings.gms", overwrite = TRUE)
fixings_manipulateThis <- c(fixings_manipulateThis, list(c(".L ", ".FX ")))
#cb q_co2eq is only "static" equation to be active before cm_startyear, as multigasscen could be different from a scenario to another that is fixed on the first
#cb therefore, vm_co2eq cannot be fixed, otherwise infeasibilities would result. vm_co2eq.M is meaningless, is never used in the code (a manipulateFile delete line command would be even better)
# manipulateFile("fixings.gms", list(c("vm_co2eq.FX ", "vm_co2eq.M ")))
# Write marginal values to file
margs <- c()
str_years <- c()
for (i in 1:no_years) {
str_years[i] <- paste("M \\('", 2000 + i * 5, sep = "")
margs <- c(margs, grep(str_years[i], ref_gdx_data, value = TRUE))
}
writeLines(margs, "margs.gms")
# temporary fix so that you can use older gdx for fixings - will become obsolete in the future and can be deleted once the next variable name change is done
margs_manipulateThis <- c(margs_manipulateThis, list(c("q_taxrev","q21_taxrev")))
# fixing for SPA runs based on ModPol input data
margs_manipulateThis <- c(margs_manipulateThis,
list(c("q41_emitrade_restr_mp.M", "!!q41_emitrade_restr_mp.M")),
list(c("q41_emitrade_restr_mp2.M", "!!q41_emitrade_restr_mp2.M")))
#AJS this symbol is not known and crashes the run - is it depreciated? TODO
levs_manipulateThis <- c(levs_manipulateThis,
list(c("vm_pebiolc_price_base.L", "!!vm_pebiolc_price_base.L")))
#AJS filter out nash marginals in negishi case, as they would lead to a crash when trying to fix on them:
if(cfg$gms$optimization == 'negishi'){
margs_manipulateThis <- c(margs_manipulateThis, list(c("q80_costAdjNash.M", "!!q80_costAdjNash.M")))
}
if(cfg$gms$subsidizeLearning == 'off'){
levs_manipulateThis <- c(levs_manipulateThis,
list(c("v22_costSubsidizeLearningForeign.L",
"!!v22_costSubsidizeLearningForeign.L")))
margs_manipulateThis <- c(margs_manipulateThis,
list(c("q22_costSubsidizeLearning.M", "!!q22_costSubsidizeLearning.M")),
list(c("v22_costSubsidizeLearningForeign.M",
"!!v22_costSubsidizeLearningForeign.M")),
list(c("q22_costSubsidizeLearningForeign.M",
"!!q22_costSubsidizeLearningForeign.M")))
fixings_manipulateThis <- c(fixings_manipulateThis,
list(c("v22_costSubsidizeLearningForeign.FX",
"!!v22_costSubsidizeLearningForeign.FX")))
}
#JH filter out negishi marginals in nash case, as they would lead to a crash when trying to fix on them:
if(cfg$gms$optimization == 'nash'){
margs_manipulateThis <- c(margs_manipulateThis,
list(c("q80_balTrade.M", "!!q80_balTrade.M")),
list(c("q80_budget_helper.M", "!!q80_budget_helper.M")))
}
#RP filter out module 40 techpol fixings
if(cfg$gms$techpol == 'none'){
margs_manipulateThis <- c(margs_manipulateThis,
list(c("q40_NewRenBound.M", "!!q40_NewRenBound.M")),
list(c("q40_CoalBound.M", "!!q40_CoalBound.M")),
list(c("q40_LowCarbonBound.M", "!!q40_LowCarbonBound.M")),
list(c("q40_FE_RenShare.M", "!!q40_FE_RenShare.M")),
list(c("q40_trp_bound.M", "!!q40_trp_bound.M")),
list(c("q40_TechBound.M", "!!q40_TechBound.M")),
list(c("q40_ElecBioBound.M", "!!q40_ElecBioBound.M")),
list(c("q40_PEBound.M", "!!q40_PEBound.M")),
list(c("q40_PEcoalBound.M", "!!q40_PEcoalBound.M")),
list(c("q40_PEgasBound.M", "!!q40_PEgasBound.M")),
list(c("q40_PElowcarbonBound.M", "!!q40_PElowcarbonBound.M")),
list(c("q40_EV_share.M", "!!q40_EV_share.M")),
list(c("q40_TrpEnergyRed.M", "!!q40_TrpEnergyRed.M")),
list(c("q40_El_RenShare.M", "!!q40_El_RenShare.M")),
list(c("q40_BioFuelBound.M", "!!q40_BioFuelBound.M")))
}
if(cfg$gms$techpol == 'NPi2018'){
margs_manipulateThis <- c(margs_manipulateThis,
list(c("q40_El_RenShare.M", "!!q40_El_RenShare.M")),
list(c("q40_CoalBound.M", "!!q40_CoalBound.M")))
}
# Include fixings (levels) and marginals in full.gms at predefined position
# in core/loop.gms.
full_manipulateThis <- c(full_manipulateThis,
list(c("cb20150605readinpositionforlevelfile",
paste("first offlisting inclusion of levs.gms so that level value can be accessed",
"$offlisting",
"$include \"levs.gms\";",
"$onlisting", sep = "\n"))))
full_manipulateThis <- c(full_manipulateThis, list(c("cb20140305readinpositionforfinxingfiles",
paste("offlisting inclusion of levs.gms, fixings.gms, and margs.gms",
"$offlisting",
"$include \"levs.gms\";",
"$include \"fixings.gms\";",
"$include \"margs.gms\";",
"$onlisting", sep = "\n"))))
# Perform actual manipulation on levs.gms, fixings.gms, and margs.gms in
# single, respective, parses of the texts.
manipulateFile("levs.gms", levs_manipulateThis)
manipulateFile("fixings.gms", fixings_manipulateThis)
manipulateFile("margs.gms", margs_manipulateThis)
# Perform actual manipulation on full.gms, in single parse of the text.
manipulateFile("full.gms", full_manipulateThis)
}
# Set value source_include so that loaded scripts know, that they are
# included as source (instead a load from command line)
source_include <- TRUE
# unzip all .gz files
system("gzip -d -f *.gz")
# Load REMIND run configuration
load("config.Rdata")
#AJS set MAGCFG file
magcfgFile = paste0('./magicc/MAGCFG_STORE/','MAGCFG_USER_',toupper(cfg$gms$cm_magicc_config),'.CFG')
if(!file.exists(magcfgFile)){
stop(paste('ERROR in MAGGICC configuration: Could not find file ',magcfgFile))
}
system(paste0('cp ',magcfgFile,' ','./magicc/MAGCFG_USER.CFG'))
# Change flag "cm_compile_main" from TRUE to FALSE since we are not compiling
# main.gms but executing full.gms and therefore want to load some data from the
# input.gdx files.
manipulateFile("full.gms", list(c("\\$setglobal cm_compile_main *TRUE",
"\\$setglobal cm_compile_main FALSE")))
# Prepare the files containing the fixings for delay scenarios (for fixed runs)
if ( cfg$gms$cm_startyear > 2005 & (!file.exists("levs.gms.gz") | !file.exists("levs.gms"))) {
create_fixing_files(cfg = cfg, input_ref_file = "input_ref.gdx")
}
# Store REMIND directory and output file names
maindir <- cfg$remind_folder
REMIND_mif_name <- paste("REMIND_generic_", cfg$title, ".mif", sep = "")
# Print message
cat("\nStarting REMIND...\n")
# Save start time
begin <- Sys.time()
# Call GAMS
if (cfg$gms$CES_parameters == "load") {
system(paste0(cfg$gamsv, " full.gms -errmsg=1 -a=", cfg$action,
" -ps=0 -pw=185 -gdxcompress=1 -logoption=", cfg$logoption))
} else if (cfg$gms$CES_parameters == "calibrate") {
# Remember file modification time of fulldata.gdx to see if it changed
fulldata_m_time <- Sys.time();
# Save original input
file.copy("input.gdx", "input_00.gdx", overwrite = TRUE)
# Iterate calibration algorithm
for (cal_itr in 1:cfg$gms$c_CES_calibration_iterations) {
cat("CES calibration iteration: ", cal_itr, "\n")
# Update calibration iteration in GAMS file
system(paste0("sed -i 's/^\\(\\$setglobal c_CES_calibration_iteration ",
"\\).*/\\1", cal_itr, "/' full.gms"))
system(paste0(cfg$gamsv, " full.gms -errmsg=1 -a=", cfg$action,
" -ps=0 -pw=185 -gdxcompress=1 -logoption=", cfg$logoption))
# If GAMS found a solution
if ( file.exists("fulldata.gdx")
&& file.info("fulldata.gdx")$mtime > fulldata_m_time) {
#create the file to be used in the load mode
getLoadFile <- function(){
file_name = paste0(cfg$gms$cm_CES_configuration,"_ITERATION_",cal_itr,".inc")
ces_in = system("gdxdump fulldata.gdx symb=in NoHeader Format=CSV", intern = TRUE) %>% gsub("\"","",.) #" This comment is just to obtain correct syntax highlighting
expr_ces_in = paste0("(",paste(ces_in, collapse = "|") ,")")
tmp = system("gdxdump fulldata.gdx symb=pm_cesdata", intern = TRUE)[-(1:2)] %>%
grep("(quantity|price|eff|effgr|xi|rho|offset_quantity|compl_coef)", x = ., value = TRUE)
tmp = tmp %>% grep(expr_ces_in,x = ., value = T)
tmp %>%
sub("'([^']*)'.'([^']*)'.'([^']*)'.'([^']*)' (.*)[ ,][ /];?",
"pm_cesdata(\"\\1\",\"\\2\",\"\\3\",\"\\4\") = \\5;", x = .) %>%
write(file_name)
pm_cesdata_putty = system("gdxdump fulldata.gdx symb=pm_cesdata_putty", intern = TRUE)
if (length(pm_cesdata_putty) == 2){
tmp_putty = gsub("^Parameter *([A-z_(,)])+cesParameters\\).*$",'\\1"quantity") = 0;', pm_cesdata_putty[2])
} else {
tmp_putty = pm_cesdata_putty[-(1:2)] %>%
grep("quantity", x = ., value = TRUE) %>%
grep(expr_ces_in,x = ., value = T)
}
tmp_putty %>%
sub("'([^']*)'.'([^']*)'.'([^']*)'.'([^']*)' (.*)[ ,][ /];?",
"pm_cesdata_putty(\"\\1\",\"\\2\",\"\\3\",\"\\4\") = \\5;", x = .)%>% write(file_name,append =T)
}
getLoadFile()
# Store all the interesting output
file.copy("full.lst", sprintf("full_%02i.lst", cal_itr), overwrite = TRUE)
file.copy("full.log", sprintf("full_%02i.log", cal_itr), overwrite = TRUE)
file.copy("fulldata.gdx", "input.gdx", overwrite = TRUE)
file.copy("fulldata.gdx", sprintf("input_%02i.gdx", cal_itr),
overwrite = TRUE)
# Update file modification time
fulldata_m_time <- file.info("fulldata.gdx")$mtime
} else {
break
}
}
} else {
stop("unknown realisation of 29_CES_parameters")
}
# Calculate run time
gams_runtime <- Sys.time() - begin
# If REMIND actually did run
if (cfg$action == "ce" && cfg$gms$c_skip_output != "on") {
# Print Message
cat("\nREMIND run finished!\n")
# Create solution report for Nash runs
if (cfg$gms$optimization == "nash" && cfg$gms$cm_nash_mode != "debug" && file.exists("fulldata.gdx")) {
system("gdxdump fulldata.gdx Format=gamsbas Delim=comma Output=output_nash.gms")
file.append("full.lst", "output_nash.gms")
file.remove("output_nash.gms")
}
}
# Collect and submit run statistics to central data base
lucode::runstatistics(file = "runstatistics.rda",
modelstat = readGDX(gdx="fulldata.gdx","o_modelstat", format="first_found"),
config = cfg,
runtime = gams_runtime,
setup_info = lucode::setup_info(),
submit = cfg$runstatistics)
# Compress files with the fixing-information
if (cfg$gms$cm_startyear > 2005)
system("gzip -f levs.gms margs.gms fixings.gms")
# go up to the main folder, where the cfg files for subsequent runs are stored
setwd(cfg$remind_folder)
#====================== Subsequent runs ===========================
# 1. Save the path to the fulldata.gdx of the current run to the cfg files
# of the runs that use it as 'input_bau.gdx'
# Use the name to check whether it is a coupled run (TRUE if the name ends with "-rem-xx")
coupled_run <- grepl("-rem-[0-9]{1,2}$",cfg$title)
no_ref_runs <- identical(cfg$RunsUsingTHISgdxAsBAU,character(0)) | all(is.na(cfg$RunsUsingTHISgdxAsBAU)) | coupled_run
if(!no_ref_runs) {
source("scripts/start_functions.R")
# Save the current cfg settings into a different data object, so that they are not overwritten
cfg_main <- cfg
for(run in seq(1,length(cfg_main$RunsUsingTHISgdxAsBAU))){
# for each of the runs that use this gdx as bau, read in the cfg, ...
cat("Writing the path for input_bau.gdx to ",paste0(cfg_main$RunsUsingTHISgdxAsBAU[run],".RData"),"\n")
load(paste0(cfg_main$RunsUsingTHISgdxAsBAU[run],".RData"))
# ...change the path_gdx_bau field of the subsequent run to the fulldata gdx of the current run ...
cfg$files2export$start['input_bau.gdx'] <- paste0(cfg_main$remind_folder,"/",cfg_main$results_folder,"/fulldata.gdx")
save(cfg, file = paste0(cfg_main$RunsUsingTHISgdxAsBAU[run],".RData"))
}
# Set cfg back to original
cfg <- cfg_main
}
# 2. Save the path to the fulldata.gdx of the current run to the cfg files
# of the subsequent runs that use it as 'input_ref.gdx' and start these runs
no_subsequent_runs <- identical(cfg$subsequentruns,character(0)) | identical(cfg$subsequentruns,NULL) | coupled_run
if(no_subsequent_runs){
cat('\nNo subsequent run was set for this scenario\n')
} else {
# Save the current cfg settings into a different data object, so that they are not overwritten
cfg_main <- cfg
source("scripts/start_functions.R")
for(run in seq(1,length(cfg_main$subsequentruns))){
# for each of the subsequent runs, read in the cfg, ...
cat("Writing the path for input_ref.gdx to ",paste0(cfg_main$subsequentruns[run],".RData"),"\n")
load(paste0(cfg_main$subsequentruns[run],".RData"))
# ...change the path_gdx_ref field of the subsequent run to the fulldata gdx of the current (preceding) run ...
cfg$files2export$start['input_ref.gdx'] <- paste0(cfg_main$remind_folder,"/",cfg_main$results_folder,"/fulldata.gdx")
save(cfg, file = paste0(cfg_main$subsequentruns[run],".RData"))
# Subsequent runs will be started in submit.R using the RData files written above
# after the current run has finished.
cat("Starting subsequent run ",cfg_main$subsequentruns[run],"\n")
start_run(cfg)
}
# Set cfg back to original
cfg <- cfg_main
}
# 3. Create script file that can be used later to restart the subsequent runs manually.
# In case there are no subsequent runs (or it's coupled runs), the file contains only
# a small message.
subseq_start_file <- paste0(cfg$results_folder,"/start_subsequentruns.R")
if(no_subsequent_runs){
write("cat('\nNo subsequent run was set for this scenario\n')",file=subseq_start_file)
} else {
# go up to the main folder, where the cfg. files for subsequent runs are stored
filetext <- paste0("setwd('",cfg$remind_folder,"')\n")
filetext <- paste0(filetext,"source('scripts/start_functions.R')\n")
for(run in seq(1,length(cfg$subsequentruns))){
filetext <- paste0(filetext,"\n")
filetext <- paste0(filetext,"load('",cfg$subsequentruns[run],".RData')\n")
filetext <- paste0(filetext,"cat('",cfg$subsequentruns[run],"')\n")
filetext <- paste0(filetext,"start_run(cfg)\n")
}
# Write the text to the file
write(filetext,file=subseq_start_file)
}
#=================== END - Subsequent runs ========================
# Print REMIND runtime
cat("\n gams_runtime is ", gams_runtime, "\n")
# Copy important files into output_folder (after REMIND execution)
for (file in cfg$files2export$end)
file.copy(file, cfg$results_folder, overwrite = TRUE)
# Postprocessing / Output Generation
output <- cfg$output
outputdir <- cfg$results_folder
sys.source("output.R",envir=new.env())
#!/bin/bash
#--- Job Submission parameters ------
#SBATCH --qos=medium
#SBATCH --job-name=__JOB_NAME__
#SBATCH --output=log.txt
#SBATCH --tasks-per-node=2
#SBATCH --mail-type=END
#------------------------------------------------
# report git revision info and changes in the files
git rev-parse --short HEAD
git status
# start gams job
Rscript submit.R
#!/bin/bash
#SBATCH --qos=priority
#SBATCH --job-name=rem-compare
#SBATCH --output=log-%j.out
#SBATCH --mail-type=END
#SBATCH --mem=32000
#SBATCH --cpus-per-task=2
Rscript scripts/utils/compareParallel.R
#!/bin/bash
#--- Job Submission parameters ------
#SBATCH --qos=short
#SBATCH --job-name=__JOB_NAME__
#SBATCH --output=log.txt
#SBATCH --nodes=1
#SBATCH --tasks-per-node=12
#SBATCH --mail-type=END
#------------------------------------------------
# report git revision info and changes in the files
git rev-parse --short HEAD
git status
# start gams job
Rscript submit.R
#!/bin/bash
#--- Job Submission parameters ------
#SBATCH --qos=short
#SBATCH --job-name=__JOB_NAME__
#SBATCH --output=log.txt
#SBATCH --nodes=1
#SBATCH --tasks-per-node=16
#SBATCH --mail-type=END
#------------------------------------------------
# report git revision info and changes in the files
git rev-parse --short HEAD
git status
# start gams job
Rscript submit.R
#!/bin/bash
#--- Job Submission parameters ------
#SBATCH --qos=short
#SBATCH --job-name=__JOB_NAME__
#SBATCH --output=log.txt
#SBATCH --mail-type=END
#------------------------------------------------
# report git revision info and changes in the files
git rev-parse --short HEAD
git status
# start gams job
Rscript submit.R
#######################################################################
############### Select slurm partitiion ###############################
#######################################################################
get_line <- function(){
# gets characters (line) from the terminal or from a connection
# and returns it
if(interactive()){
s <- readline()
} else {
con <- file("stdin")
s <- readLines(con, 1, warn=FALSE)
on.exit(close(con))
}
return(s);
}
choose_slurmConfig <- function() {
slurm <- suppressWarnings(ifelse(system2("srun",stdout=FALSE,stderr=FALSE) != 127, TRUE, FALSE))
if (slurm) {
modes <- c(" SLURM standby - task per node: 12 (nash H12) [recommended]",
" SLURM standby - task per node: 13 (nash H12 coupled)",
" SLURM standby - task per node: 16 (nash H12+)",
" SLURM standby - task per node: 1 (nash debug, test one regi)",
" SLURM priority - task per node: 12 (nash H12) [recommended]",
" SLURM priority - task per node: 13 (nash H12 coupled)",
" SLURM priority - task per node: 16 (nash H12+)",
" SLURM priority - task per node: 1 (nash debug, test one regi)",
" SLURM short - task per node: 12 (nash H12)",
"SLURM short - task per node: 16 (nash H12+)",
"SLURM short - task per node: 1 (nash debug, test one regi)",
"SLURM medium - task per node: 1 (negishi)",
"SLURM long - task per node: 1 (negishi)")
cat("\nCurrent cluster utilization:\n")
system("sclass")
cat("\n")
cat("\nPlease choose run submission type:\n")
cat(paste(1:length(modes), modes, sep=": " ),sep="\n")
cat("Number: ")
identifier <- get_line()
identifier <- as.numeric(strsplit(identifier,",")[[1]])
comp <- switch(identifier,
"1" = "--qos=standby --nodes=1 --tasks-per-node=12" , # SLURM standby - task per node: 12 (nash H12) [recommended]
"2" = "--qos=standby --nodes=1 --tasks-per-node=13" , # SLURM standby - task per node: 13 (nash H12 coupled)
"3" = "--qos=standby --nodes=1 --tasks-per-node=16" , # SLURM standby - task per node: 16 (nash H12+)
"4" = "--qos=standby --nodes=1 --tasks-per-node=1" , # SLURM standby - task per node: 1 (nash debug, test one regi)
"5" = "--qos=priority --nodes=1 --tasks-per-node=12" , # SLURM priority - task per node: 12 (nash H12) [recommended]
"6" = "--qos=priority --nodes=1 --tasks-per-node=13" , # SLURM priority - task per node: 13 (nash H12 coupled)
"7" = "--qos=priority --nodes=1 --tasks-per-node=16" , # SLURM priority - task per node: 16 (nash H12+)
"8" = "--qos=priority --nodes=1 --tasks-per-node=1" , # SLURM priority - task per node: 1 (nash debug, test one regi)
"9" = "--qos=short --nodes=1 --tasks-per-node=12" , # SLURM short - task per node: 12 (nash H12)
"10" = "--qos=short --nodes=1 --tasks-per-node=16" , # SLURM short - task per node: 16 (nash H12+)
"11" = "--qos=short --nodes=1 --tasks-per-node=1" , # SLURM short - task per node: 1 (nash debug, test one regi)
"12" = "--qos=medium --nodes=1 --tasks-per-node=1" , # SLURM medium - task per node: 1 (negishi)
"13" = "--qos=long --nodes=1 --tasks-per-node=1" ) # SLURM long - task per node: 1 (negishi)
if(is.null(comp)) stop("This type is invalid. Please choose a valid type")
} else {
comp <- "direct"
}
return(comp)
}
Documentation of the new procedure of starting REMIND runs (DK, LB, January 2020)
Why did we redesign the procedure?
The old code was spread across more files, the user needed to edit files in order to provide the SLURM options, and a substantial part of the code was run on the login node before finally submiting the job to SLURM. The new structure lets the user choose the SLURM options interactively when starting the runs. The amount of code that is executed on the login node was minimized. Most of the work load that is required to set up a run is included in the SLURM batch job. Finally, the code is strucutred more clearly and spread across less files.
To start a run type in the main directory of REMIND:
Rscript start.R [path to a config file]
optionally providing a path to a config file, e.g. config/scenario_config.csv. If no config file is provided REMIND will use the settings in the default.cfg
The procedure in short:
start.R -------> submit(cfg) ----------------------------------------------> prepare_and_run()
- create output folder - fetch input data
- copy config and prepare_and_run.R into output folder - prepare NDCs
- send slurm job to cluster - create single GAMS file
- run GAMS
- reporting
|---------------------------------------------------------------------------|--------------------------|
login node slurm job
The procedure in detail:
Rscript start.R -----> choose_slurmConfig() [scripts/start/choose_slurmConfig.R]
configure_cfg(cfg, scenario, ...) [start.R]
submit(cfg) [scripts/start/submit.R]
- create output folder
- save cfg to runtitlte.RData
- copy scripts/start/prepare_and_run.R into results folder
- move runtitle.RData into results folder
- change to results folder
- send job to cluster: sbatch Rscript prepare_and_run.R -----> prepare_and_run() [scripts/start/prepare_and_run.R]
- change to main folder - load config.RData
- cd mainfolder
- prepare NDC [scripts/input/prepareNDC2018.R]
- prepare calibration
- LOCK model
- download and distribute input data
- if coupled get MAgPIE data
- put together single GAMS file
- UNLOCK
- cd resultsfolder
- create fixings
- call GAMS full.gms
- submit runstatistics
- cd mainfolder
- start subsequent runs submit(cfg) [scripts/start/submit.R]
- reporting [output.R]
- cd resultsfolder
############## Define function: .copy.fromlist #########################
.copy.fromlist <- function(filelist,destfolder) {
if(is.null(names(filelist))) names(filelist) <- rep("",length(filelist))
for(i in 1:length(filelist)) {
if(!is.na(filelist[i])) {
to <- paste0(destfolder,"/",names(filelist)[i])
if(!file.copy(filelist[i],to=to,recursive=dir.exists(to),overwrite=T))
cat(paste0("Could not copy ",filelist[i]," to ",to,"\n"))
}
}
}
############## Define function: runsubmit #########################
submit <- function(cfg) {
# Create name of output folder and output folder itself
date <- format(Sys.time(), "_%Y-%m-%d_%H.%M.%S")
cfg$results_folder <- gsub(":date:", date, cfg$results_folder, fixed = TRUE)
cfg$results_folder <- gsub(":title:", cfg$title, cfg$results_folder, fixed = TRUE)
# Create output folder
if (!file.exists(cfg$results_folder)) {
dir.create(cfg$results_folder, recursive = TRUE, showWarnings = FALSE)
} else if (!cfg$force_replace) {
stop(paste0("Results folder ",cfg$results_folder," could not be created because it already exists."))
} else {
cat("Deleting results folder because it alreay exists:",cfg$results_folder,"\n")
unlink(cfg$results_folder, recursive = TRUE)
dir.create(cfg$results_folder, recursive = TRUE, showWarnings = FALSE)
}
# save main folder
cfg$remind_folder <- getwd()
# save the cfg data before moving it into the results folder
cat("Writing cfg to file\n")
save(cfg,file=paste0(cfg$title,".RData"))
# Copy files required to confiugre and start a run
filelist <- c("config.Rdata" = paste0(cfg$title,".RData"),
"prepare_and_run.R" = "scripts/start/prepare_and_run.R")
.copy.fromlist(filelist,cfg$results_folder)
# remove config in main folder (after copying into results folder)
file.remove(paste0(cfg$title,".RData"))
# change to run folder
setwd(cfg$results_folder)
on.exit(setwd(cfg$remind_folder))
# send prepare_and_run.R to cluster
cat("Executing prepare_and_run.R for",cfg$title,"\n")
if(cfg$slurmConfig=="direct") {
log <- format(Sys.time(), paste0(cfg$title,"-%Y-%H-%M-%S-%OS3.log"))
system("Rscript prepare_and_run.R")
} else {
system(paste0("sbatch --job-name=",cfg$title," --output=log.txt --mail-type=END --comment=REMIND --wrap=\"Rscript prepare_and_run.R \" ",cfg$slurmConfig))
Sys.sleep(1)
}
return(cfg$results_folder)
}
......@@ -85,7 +85,7 @@ if (length(args) == 1) {
p_nw = 'p80_nw',
c_nucscen = 'cm_nucscen',
q_co2eq = 'q_co2eq',
pm_costsPEtradeMp = 'p_costsPEtradeMp',
pm_costsPEtradeMp = 'pm_costsPEtradeMp',
vm_welfare = 'v_welfare',
pm_tau_fe_sub = 'p21_tau_fe_sub',
pm_tau_fe_tax = 'p21_tau_fe_tax',
......
......@@ -131,8 +131,8 @@ cm_CCS_steel "CCS for steel sub-sector"
c_solscen "solar option choice"
cm_bioenergy_tax "level of bioenergy tax in fraction of bioenergy price"
cm_bioenergymaxscen "bound on global pebiolc production excluding residues"
c_tradecost_bio "choose financal tradecosts for biomass (purpose grown pebiolc)"
c_1stgen_phaseout "choose if 1st generation biofuels should phase out after 2030 (vm_deltaCap=0)"
cm_tradecost_bio "choose financal tradecosts for biomass (purpose grown pebiolc)"
cm_1stgen_phaseout "choose if 1st generation biofuels should phase out after 2030 (vm_deltaCap=0)"
cm_startyear "first optimized modelling time step"
c_start_budget "start of GHG budget limit"
cm_prtpScen "pure rate of time preference standard values"
......@@ -170,7 +170,7 @@ c_abtrdy "first year in which advanced bio-energy technology are re
c_abtcst "scaling of the cost of advanced bio-energy technologies (no unit, 50% increase means 1.5)"
c_budgetCO2 "carbon budget for all CO2 emissions (in GtCO2)"
c_trdcst "parameter to scale trade export cost for gas"
cm_trdcst "parameter to scale trade export cost for gas"
cm_trdadj "parameter scale the adjustment cost parameter for increasing gas trade export"
c_refcapbnd "switch for fixing refinery capacities to the SSP2 levels in 2010 (if equal zero then no fixing)"
......@@ -217,9 +217,9 @@ cm_CCS_steel = 1; !! def = 1
cm_bioenergy_tax = 1.5; !! def = 1.5
cm_bioenergymaxscen = 0; !! def = 0
c_tradecost_bio = 2; !! def = 2
cm_tradecost_bio = 2; !! def = 2
$setglobal cm_LU_emi_scen SSP2 !! def = SSP2
c_1stgen_phaseout = 0; !! def = 0
cm_1stgen_phaseout = 0; !! def = 0
$setglobal cm_POPscen pop_SSP2 !! def = pop_SSP2
$setglobal cm_GDPscen gdp_SSP2 !! def = gdp_SSP2
......@@ -271,7 +271,7 @@ c_budgetCO2 = 0; !! def = 1300
$setGlobal cm_regiCO2target off !! def = off
cm_trdadj = 2; !! def = 2.0
c_trdcst = 1.5; !! def = 1.5
cm_trdcst = 1.5; !! def = 1.5
c_refcapbnd = 0; !! def = 0
cm_frac_CCS = 10; !! def = 10
cm_frac_NetNegEmi = 0.5; !! def = 0.5
......@@ -305,8 +305,6 @@ $setGlobal cm_magicc_temperatureImpulseResponse off !! def = off
$setGlobal cm_damage_DiceLike_specification HowardNonCatastrophic !! def = HowardNonCatastrophic
$setglobal cm_compile_main TRUE !! this will be changed by submit.R
$setglobal cm_CES_configuration stat_off-indu_fixed_shares-buil_simple-tran_complex-POP_pop_SSP2-GDP_gdp_SSP2-Kap_perfect-Reg_ccd632d33a !! this will be changed by start_run()
$setglobal c_CES_calibration_new_structure 0 !! def = 0
......
......@@ -139,8 +139,8 @@ cm_CCS_steel "CCS for steel sub-sector"
c_solscen "solar option choice"
cm_bioenergy_tax "level of bioenergy tax in fraction of bioenergy price"
cm_bioenergymaxscen "bound on global pebiolc production excluding residues"
c_tradecost_bio "choose financal tradecosts for biomass (purpose grown pebiolc)"
c_1stgen_phaseout "choose if 1st generation biofuels should phase out after 2030 (vm_deltaCap=0)"
cm_tradecost_bio "choose financal tradecosts for biomass (purpose grown pebiolc)"
cm_1stgen_phaseout "choose if 1st generation biofuels should phase out after 2030 (vm_deltaCap=0)"
cm_startyear "first optimized modelling time step"
c_start_budget "start of GHG budget limit"
cm_prtpScen "pure rate of time preference standard values"
......@@ -178,7 +178,7 @@ c_abtrdy "first year in which advanced bio-energy technology are re
c_abtcst "scaling of the cost of advanced bio-energy technologies (no unit, 50% increase means 1.5)"
c_budgetCO2 "carbon budget for all CO2 emissions (in GtCO2)"
c_trdcst "parameter to scale trade export cost for gas"
cm_trdcst "parameter to scale trade export cost for gas"
cm_trdadj "parameter scale the adjustment cost parameter for increasing gas trade export"
c_refcapbnd "switch for fixing refinery capacities to the SSP2 levels in 2010 (if equal zero then no fixing)"
......@@ -225,9 +225,9 @@ cm_CCS_steel = 1; !! def = 1
cm_bioenergy_tax = 1.5; !! def = 1.5
cm_bioenergymaxscen = 0; !! def = 0
c_tradecost_bio = 2; !! def = 2
cm_tradecost_bio = 2; !! def = 2
$setglobal cm_LU_emi_scen SSP2 !! def = SSP2
c_1stgen_phaseout = 0; !! def = 0
cm_1stgen_phaseout = 0; !! def = 0
$setglobal cm_POPscen pop_SSP2 !! def = pop_SSP2
$setglobal cm_GDPscen gdp_SSP2 !! def = gdp_SSP2
......@@ -279,7 +279,7 @@ c_budgetCO2 = 1350; !! def = 1300
$setGlobal cm_regiCO2target off !! def = off
cm_trdadj = 2; !! def = 2.0
c_trdcst = 1.5; !! def = 1.5
cm_trdcst = 1.5; !! def = 1.5
c_refcapbnd = 0; !! def = 0
cm_frac_CCS = 10; !! def = 10
cm_frac_NetNegEmi = 0.5; !! def = 0.5
......@@ -313,8 +313,6 @@ $setGlobal cm_magicc_temperatureImpulseResponse off !! def = off
$setGlobal cm_damage_DiceLike_specification HowardNonCatastrophic !! def = HowardNonCatastrophic
$setglobal cm_compile_main TRUE !! this will be changed by submit.R
$setglobal cm_CES_configuration stat_off-indu_fixed_shares-buil_simple-tran_complex-POP_pop_SSP2-GDP_gdp_SSP2-Kap_perfect-Reg_690d3718e1 !! this will be changed by start_run()
$setglobal c_CES_calibration_new_structure 0 !! def = 0
......
# | (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
##########################################################
#### Script to start a REMIND run ####
##########################################################
library(lucode, quietly = TRUE,warn.conflicts =FALSE)
library(magclass, quietly = TRUE,warn.conflicts =FALSE)
#Here the function start_run(cfg) is loaded which is needed to start REMIND runs
#The function needs information about the configuration of the run. This can be either supplied as a list of settings or as a file name of a config file
source("scripts/start_functions.R")
#Load config-file
cfg_REMIND <- "default.cfg"
readArgs("cfg_REMIND")
#start REMIND run
start_run(cfg_REMIND)
#rep = read.report("coupling.mif")
#start_reportrun(rep)
library(lucode)
source("scripts/start/submit.R")
source("scripts/start/choose_slurmConfig.R")
############## Define function: configure_cfg #########################
configure_cfg <- function(icfg, iscen, iscenarios, isettings) {
.setgdxcopy <- function(needle, stack, new) {
# delete entries in stack that contain needle and append new
out <- c(stack[-grep(needle, stack)], new)
return(out)
}
# Edit run title
icfg$title <- iscen
cat("\n", iscen, "\n")
# Edit main file of model
if( "model" %in% names(iscenarios)){
icfg$model <- iscenarios[iscen,"model"]
}
# Edit regional aggregation
if( "regionmapping" %in% names(iscenarios)){
icfg$regionmapping <- iscenarios[iscen,"regionmapping"]
}
# Edit input data revision
if( "revision" %in% names(iscenarios)){
icfg$revision <- iscenarios[iscen,"revision"]
}
# Edit switches in default.cfg according to the values given in the scenarios table
for (switchname in intersect(names(icfg$gms), names(iscenarios))) {
icfg$gms[[switchname]] <- iscenarios[iscen,switchname]
}
# Set reporting script
if( "output" %in% names(iscenarios)){
icfg$output <- paste0("c(\"",gsub(",","\",\"",gsub(", ",",",iscenarios[iscen,"output"])),"\")")
}
# check if full input.gdx path is provided and, if not, search for correct path
if (!substr(isettings[iscen,"path_gdx"], nchar(isettings[iscen,"path_gdx"])-3, nchar(isettings[iscen,"path_gdx"])) == ".gdx"){
#if there is no correct scenario folder within the output folder path provided, take the config/input.gdx
if(length(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T))==0){
isettings[iscen,"path_gdx"] <- "config/input.gdx"
#if there is only one instance of an output folder with that name, take the fulldata.gdx from this
} else if (length(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T))==1){
isettings[iscen,"path_gdx"] <- paste0(isettings[iscen,"path_gdx"],"/",
grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T),"/fulldata.gdx")
} else {
#if there are multiple instances, take the newest one
isettings[iscen,"path_gdx"] <- paste0(isettings[iscen,"path_gdx"],"/",
substr(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T),1,
nchar(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T))-19)[1],
max(substr(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T),
nchar(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T))-18,
nchar(grep(iscen,list.files(path=isettings[iscen,"path_gdx"]),value=T)))),"/fulldata.gdx")
}
}
# if the above has not created a path to a valid gdx, take config/input.gdx
if (!file.exists(isettings[iscen,"path_gdx"])){
isettings[iscen,"path_gdx"] <- "config/input.gdx"
#if even this is not existent, stop
if (!file.exists(isettings[iscen,"path_gdx"])){
stop("Cant find a gdx under path_gdx, please specify full path to gdx or else location of output folder that contains previous run")
}
}
# Define path where the GDXs will be taken from
gdxlist <- c(input.gdx = isettings[iscen, "path_gdx"],
input_ref.gdx = isettings[iscen, "path_gdx_ref"],
input_bau.gdx = isettings[iscen, "path_gdx_bau"])
# Remove potential elements that contain ".gdx" and append gdxlist
icfg$files2export$start <- .setgdxcopy(".gdx", icfg$files2export$start, gdxlist)
# add gdx information for subsequent runs
icfg$subsequentruns <- rownames(isettings[isettings$path_gdx_ref == iscen & !is.na(isettings$path_gdx_ref) & isettings$start == 1,])
icfg$RunsUsingTHISgdxAsBAU <- rownames(isettings[isettings$path_gdx_bau == iscen & !is.na(isettings$path_gdx_bau) & isettings$start == 1,])
return(icfg)
}
###################### Choose submission type #########################
slurmConfig <- choose_slurmConfig()
###################### Load csv if provided ##########################
# If testOneRegi was selected, set up a testOneRegi run. IF a
# scenario_config.csv file was provided, set cfg according to it (copy from
# start_bundle).
# check command-line arguments for testOneRegi and scenario_config file
argv <- commandArgs(trailingOnly = TRUE)
config.file <- argv[1]
if ('--testOneRegi' %in% argv) {
testOneRegi <- TRUE
config.file <- NA
} else {
testOneRegi <- FALSE
}
if (!is.na(config.file)) {
cat(paste("reading config file", config.file, "\n"))
# Read-in the switches table, use first column as row names
settings <- read.csv2(config.file, stringsAsFactors = FALSE, row.names = 1, comment.char = "#", na.strings = "")
# Select scenarios that are flagged to start
scenarios <- settings[settings$start==1,]
if (length(grep("\\.",rownames(scenarios))) > 0) stop("One or more titles contain dots - GAMS would not tolerate this, and quit working at a point where you least expect it. Stopping now. ")
} else {
# if no csv was provided create dummy list with default as the only scenario
scenarios <- data.frame("default" = "default",row.names = "default")
}
###################### Loop over csv ###############################
# Modify and save cfg for all runs
for (scen in rownames(scenarios)) {
#source cfg file for each scenario to avoid duplication of gdx entries in files2export
source("config/default.cfg")
# Have the log output written in a file (not on the screen)
cfg$slurmConfig <- slurmConfig
cfg$logoption <- 2
start_now <- TRUE
# testOneRegi settings
if (testOneRegi) {
cfg$title <- 'testOneRegi'
cfg$gms$optimization <- 'testOneRegi'
cfg$output <- NA
cfg$results_folder <- 'output/testOneRegi'
# delete existing Results directory
cfg$force_replace <- TRUE
}
# configure cfg based on settings from csv if provided
if (!is.na(config.file)) {
cfg <- configure_cfg(cfg, scen, scenarios, settings)
# Directly start runs that have a gdx file location given as path_gdx_ref or where this field is empty
start_now <- (substr(scenarios[scen,"path_gdx_ref"], nchar(scenarios[scen,"path_gdx_ref"])-3, nchar(scenarios[scen,"path_gdx_ref"])) == ".gdx"
| is.na(scenarios[scen,"path_gdx_ref"]))
}
# save the cfg data for later start of subsequent runs (after preceding run finished)
cat("Writing cfg to file\n")
save(cfg,file=paste0(scen,".RData"))
if (start_now){
cat("Creating and starting: ",cfg$title,"\n")
submit(cfg)
}
}
# | (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
source("scripts/start_functions.R")
require(lucode, quietly = TRUE, warn.conflicts = FALSE)
.setgdxcopy <- function(needle, stack, new) {
# delete entries in stack that contain needle and append new
out <- c(stack[-grep(needle, stack)], new)
return(out)
}
# check for config file parameter
config.file <- commandArgs(trailingOnly = TRUE)[1]
if ( is.na(config.file) # no parameter given
| -1 == file.access(config.file, mode = 4)) # if file can't be read
config.file <- "config/scenario_config.csv"
cat(paste("reading config file", config.file, "\n"))
# Read-in the switches table, use first column as row names
settings <- read.csv2(config.file, stringsAsFactors = FALSE, row.names = 1,
comment.char = "#", na.strings = "")
# Select scenarios that are flagged to start
scenarios <- settings[settings$start==1,]
if (length(grep("\\.",rownames(scenarios))) > 0) stop("One or more titles contain dots - GAMS would not tolerate this, and quit working at a point where you least expect it. Stopping now. ")
# Modify and save cfg for all runs
for (scen in rownames(scenarios)) {
#source cfg file for each scenario to avoid duplication of gdx entries in files2export
source("config/default.cfg")
# Have the log output written in a file (not on the screen)
cfg$logoption <- 2
cfg$sequential <- NA
# Edit run title
cfg$title <- scen
cat("\n", scen, "\n")
# Edit main file of model
if( "model" %in% names(scenarios)){
cfg$model <- scenarios[scen,"model"]
}
# Edit regional aggregation
if( "regionmapping" %in% names(scenarios)){
cfg$regionmapping <- scenarios[scen,"regionmapping"]
}
# Edit input data revision
if( "revision" %in% names(scenarios)){
cfg$revision <- scenarios[scen,"revision"]
}
# Edit switches in default.cfg according to the values given in the scenarios table
for (switchname in intersect(names(cfg$gms), names(scenarios))) {
cfg$gms[[switchname]] <- scenarios[scen,switchname]
}
# Set reporting script
if( "output" %in% names(scenarios)){
cfg$output <- paste0("c(\"",gsub(",","\",\"",gsub(", ",",",scenarios[scen,"output"])),"\")")
}
# check if full input.gdx path is provided and, if not, search for correct path
if (!substr(settings[scen,"path_gdx"], nchar(settings[scen,"path_gdx"])-3, nchar(settings[scen,"path_gdx"])) == ".gdx"){
#if there is no correct scenario folder within the output folder path provided, take the config/input.gdx
if(length(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T))==0){
settings[scen,"path_gdx"] <- "config/input.gdx"
#if there is only one instance of an output folder with that name, take the fulldata.gdx from this
} else if (length(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T))==1){
settings[scen,"path_gdx"] <- paste0(settings[scen,"path_gdx"],"/",
grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T),"/fulldata.gdx")
} else {
#if there are multiple instances, take the newest one
settings[scen,"path_gdx"] <- paste0(settings[scen,"path_gdx"],"/",
substr(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T),1,
nchar(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T))-19)[1],
max(substr(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T),
nchar(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T))-18,
nchar(grep(scen,list.files(path=settings[scen,"path_gdx"]),value=T)))),"/fulldata.gdx")
}
}
# if the above has not created a path to a valid gdx, take config/input.gdx
if (!file.exists(settings[scen,"path_gdx"])){
settings[scen,"path_gdx"] <- "config/input.gdx"
#if even this is not existent, stop
if (!file.exists(settings[scen,"path_gdx"])){
stop("Cant find a gdx under path_gdx, please specify full path to gdx or else location of output folder that contains previous run")
}
}
# Define path where the GDXs will be taken from
gdxlist <- c(input.gdx = settings[scen, "path_gdx"],
input_ref.gdx = settings[scen, "path_gdx_ref"],
input_bau.gdx = settings[scen, "path_gdx_bau"])
# Remove potential elements that contain ".gdx" and append gdxlist
cfg$files2export$start <- .setgdxcopy(".gdx", cfg$files2export$start, gdxlist)
# add gdx information for subsequent runs
cfg$subsequentruns <- rownames(settings[settings$path_gdx_ref == scen & !is.na(settings$path_gdx_ref) & settings$start == 1,])
cfg$RunsUsingTHISgdxAsBAU <- rownames(settings[settings$path_gdx_bau == scen & !is.na(settings$path_gdx_bau) & settings$start == 1,])
# save the cfg data for later start of subsequent runs (after preceding run finished)
cat("Writing cfg to file\n")
save(cfg,file=paste0(scen,".RData"))
}
# Directly start runs that have a gdx file location given as path_gdx_ref or where this field is empty
for (scen in rownames(scenarios)) {
if (substr(settings[scen,"path_gdx_ref"], nchar(settings[scen,"path_gdx_ref"])-3, nchar(settings[scen,"path_gdx_ref"])) == ".gdx"
| is.na(settings[scen,"path_gdx_ref"])){
cat("Starting: ",scen,"\n")
load(paste0(scen,".RData"))
start_run(cfg)
}
}
......@@ -4,10 +4,15 @@
# | 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
source("scripts/start_functions.R")
require(lucode, quietly = TRUE, warn.conflicts = FALSE)
source("scripts/start/submit.R")
source("scripts/start/choose_slurmConfig.R")
# Choose submission type
slurmConfig <- choose_slurmConfig()
.setgdxcopy <- function(needle, stack, new) {
# delete entries in stack that contain needle and append new
out <- c(stack[-grep(needle, stack)], new)
......@@ -55,6 +60,7 @@ for (scen in rownames(scenarios)) {
source("config/default.cfg")
# Have the log output written in a file (not on the screen)
cfg$slurmConfig <- slurmConfig
cfg$logoption <- 2
cfg$sequential <- NA
......@@ -124,6 +130,6 @@ for (scen in rownames(scenarios)) {
| is.na(settings[scen,"path_gdx_ref"])){
cat("Starting: ",scen,"\n")
load(paste0(scen,".RData"))
start_run(cfg)
submit(cfg)
}
}
......@@ -95,7 +95,7 @@ if (!identical(common,character(0))) {
for(scen in common){
cat(paste0("\n################################\nPreparing run ",scen,"\n"))
prefix_runname <- strsplit(path_remind,"/")[[1]][length(strsplit(path_remind,"/")[[1]])]
prefix_runname <- "C" #strsplit(path_remind,"/")[[1]][length(strsplit(path_remind,"/")[[1]])]
prefix_runname <- paste0(prefix_runname,"_")
runname <- paste0(prefix_runname,scen) # name of the run that is used for the folder names
......@@ -239,11 +239,6 @@ for(scen in common){
settings_remind[scen, "path_gdx_ref"] <- scenarios_coupled[scen, "path_gdx_ref"]
cat("Replacing gdx_ref information with those specified in\n ",path_settings_coupled,"\n ",settings_remind[scen, "path_gdx_ref"],"\n")
}
if (!is.na(scenarios_coupled[scen, "path_gdx_opt"])) {
settings_remind[scen, "path_gdx_opt"] <- scenarios_coupled[scen, "path_gdx_opt"]
cat("Replacing gdx_opt information with those specified in\n ",path_settings_coupled,"\n ",settings_remind[scen, "path_gdx_opt"],"\n")
}
# Create list of previously defined paths to gdxs
gdxlist <- c(input.gdx = settings_remind[scen, "path_gdx"], # eventually this was updated if older runs exists in this folder (see above)
......@@ -255,7 +250,7 @@ for(scen in common){
# add information on subsequent runs to start after the current run is finished
# take rownames (which is the runname) of that row, that has the current scenario in its gdx_ref
cfg_rem$subsequentruns <- intersect(rownames(settings_remind[settings_remind$path_gdx_ref == scen & !is.na(settings_remind$path_gdx_ref),]),common)
cfg_rem$subsequentruns <- intersect(rownames(settings_remind[settings_remind$path_gdx_ref == scen & !is.na(settings_remind$path_gdx_ref),]),common)
# immediately start run if it has a real gdx file (not a runname) given (last four letters are ".gdx") in path_gdx_ref or where this field is empty (NA)
start_now <- (substr(settings_remind[scen,"path_gdx_ref"], nchar(settings_remind[scen,"path_gdx_ref"])-3, nchar(settings_remind[scen,"path_gdx_ref"])) == ".gdx"
......@@ -298,24 +293,16 @@ for(scen in common){
cat("path_report : ",ifelse(file.exists(path_report),green,red), path_report, NC, "\n",sep="")
cat("LU_pricing :",LU_pricing,"\n")
# create cluster_start_coupled_scen.cmd file
# 1. copy general cluster_start_coupled file
system(paste0("cp cluster_start_coupled.cmd cluster_start_coupled_",scen,".cmd"))
# 2. modify accordingly
manipulateConfig(paste0("cluster_start_coupled_",scen,".cmd"),coupled_config=paste0(runname,".RData"),line_endings = "NOTwin")
manipulateConfig(paste0("cluster_start_coupled_",scen,".cmd"),"--job-name"=runname,line_endings = "NOTwin")
manipulateConfig(paste0("cluster_start_coupled_",scen,".cmd"),"--output"=paste0(runname,".log"),line_endings = "NOTwin")
if (cfg_rem$gms$optimization == "nash" && cfg_rem$gms$cm_nash_mode == "parallel") {
# for nash: set the number of CPUs per node to number of regions + 1
nr_of_regions <- length(levels(read.csv2(cfg_rem$regionmapping)$RegionCode)) + 1
manipulateConfig(paste0("cluster_start_coupled_",scen,".cmd"),"--tasks-per-node"=nr_of_regions,line_endings = "NOTwin")
} else {
# for negishi: use only one CPU
manipulateConfig(paste0("cluster_start_coupled_",scen,".cmd"),"--tasks-per-node"=1,line_endings = "NOTwin")
nr_of_regions <- 1
}
if (start_now){
if (!exists("test")) system(paste0("sbatch cluster_start_coupled_",scen,".cmd"))
if (!exists("test")) system(paste0("sbatch --qos=standby --job-name=",runname," --output=",runname,".log --mail-type=END --comment=REMIND-MAgPIE --tasks-per-node=",nr_of_regions," --wrap=\"Rscript start_coupled.R coupled_config=",runname,".RData\""))
else cat("Test mode: run NOT submitted to the cluster\n")
} else {
cat(paste0("Run ",runname," will start after preceding run ",prefix_runname,settings_remind[scen,"path_gdx_ref"]," has finished\n"))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment