├── .gitignore ├── DSSBatch.v45 ├── dssat_batch.R ├── Parallel_clima.R ├── make_wth.R ├── main_functions.R ├── DSSAT_run.R ├── Soil.R ├── parallel_dssat.R ├── Extract_Climate.R ├── DSSAT_maize_parallel.R ├── wfd2wth_files.R ├── potato_xfile.r └── make_xfile.R /.gitignore: -------------------------------------------------------------------------------- 1 | # History files 2 | .Rhistory 3 | .Rapp.history 4 | 5 | # Example code in package build process 6 | *-Ex.R 7 | 8 | # RStudio files 9 | .Rproj.user/ 10 | 11 | # produced vignettes 12 | vignettes/*.html 13 | vignettes/*.pdf 14 | -------------------------------------------------------------------------------- /DSSBatch.v45: -------------------------------------------------------------------------------- 1 | $BATCH(RICE) 2 | ! 3 | @FILEX TRTNO RP SQ OP CO 4 | ./JBID.RIX 1 1 0 1 0 5 | -------------------------------------------------------------------------------- /dssat_batch.R: -------------------------------------------------------------------------------- 1 | ############################################################################################################## 2 | # Create batch file for CSM (.v45 file) 3 | ############################################################################################################## 4 | 5 | # data_xfile <- list() 6 | # data_xfile$crop <- "RICE" 7 | # data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ RICE LAC" 8 | # data_xfile$name <- "./JBID.RIX" 9 | # data_xfile$CR <- "RI" 10 | # data_xfile$INGENO <- "IB0118" 11 | # data_xfile$CNAME <- "IRNA" 12 | # data_xfile$initation <- crop_riego$mirca.start 13 | # data_xfile$final <- crop_riego$mirca.end 14 | # data_xfile$system <- "irrigation" ## Irrigation or rainfed, if is irrigation then automatic irrigation 15 | # data_xfile$year <- years[1] 16 | # data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 17 | # data_xfile$smodel <- "RIXCER" ## Fin Model 18 | # data_xfile$bname <- "DSSBatch.v45" 19 | 20 | 21 | # to test 22 | # CSMbatch(data_xfile$crop, data_xfile$name, data_xfile$bname) 23 | CSMbatch <- function(crop, name, bname) { 24 | 25 | outbatch <- rbind( 26 | rbind( 27 | # Batchfile headers 28 | paste0("$BATCH(", crop, ")"), 29 | "!", 30 | cbind(sprintf("%6s %92s %6s %6s %6s %6s", "@FILEX", "TRTNO", "RP", "SQ", "OP", 31 | "CO"))), 32 | cbind(sprintf("%6s %88s %6i %6i %6i %6i", 33 | paste0(name), 34 | 1, # Variable for treatment number 35 | 1, # Default value for RP element 36 | 0, # Default value for SQ element 37 | 1, # Default value for OP element 38 | 0))) # Default value for CO element 39 | 40 | # Write the batch file to the selected folder 41 | write(outbatch, bname, append = F) 42 | 43 | } 44 | 45 | -------------------------------------------------------------------------------- /Parallel_clima.R: -------------------------------------------------------------------------------- 1 | ################################################# WFD en CIAT ######################################################### 2 | library(snowfall) 3 | sfInit(parallel=TRUE, cpus=6) 4 | sfLibrary(snowfall) 5 | sfLibrary(raster) 6 | sfLibrary(ncdf) 7 | 8 | 9 | setwd("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/wfd") 10 | load("Prec.Rdat") 11 | load("Radt.Rdat") 12 | load("Temp.Rdat") 13 | load("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/coordenadas.RDat") 14 | 15 | Coordenadas[,1]<-Coordenadas[,1]+360 16 | 17 | sfExportAll() 18 | Raster_Prec <- lapply(Raster_Prec,FUN=stack) 19 | Raster_Radt <- lapply(Raster_Radt,FUN=stack) 20 | Raster_TempMax <- lapply(Raster_TempMax,FUN=stack) 21 | Raster_TempMin <- lapply(Raster_TempMin,FUN=stack) 22 | 23 | 24 | Prec <- sfLapply(Raster_Prec, FUN=extract,Coordenadas) 25 | Srad <- sfLapply(Raster_Radt, FUN=extract,Coordenadas) 26 | TempMax <- sfLapply(Raster_TempMax, FUN=extract,Coordenadas) 27 | TempMin <- sfLapply(Raster_TempMin, FUN=extract,Coordenadas) 28 | 29 | 30 | save(TempMax,TempMin,Prec,Srad,file="ValorWFD.RDat") 31 | 32 | 33 | ########################### Extraer Precipitacion y Radiacion ######################################### 34 | 35 | library(snowfall) 36 | sfInit(parallel=TRUE, cpus=6) 37 | sfLibrary(snowfall) 38 | sfLibrary(raster) 39 | sfLibrary (sp) 40 | sfLibrary(ncdf) 41 | 42 | 43 | modelos <- c("bcc_csm1_1","csiro_mk3_6_0","inm_cm4","miroc_esm_chem", 44 | "mpi_esm_mr","bnu_esm","ipsl_cm5a_lr","miroc_miroc5", 45 | "mri_cgcm3","cccma_canesm2","gfld_esm2g","ipsl_cm5a_mr", 46 | "mohc_hadgem2_cc","ncc_noresm1_m","gfld_esm2g", 47 | "ipsl_cm5b_lr","mohc_hadgem2_es","cnrm_cm5","miroc_esm", 48 | "mpi_esm_lr") 49 | 50 | sfExport("modelos") 51 | # sfSource("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/_scripts/ExtraerClima.R",encoding="latin1") 52 | sfSource("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/_scripts/ExtraerClima-CIAT.R",encoding="latin1") 53 | sapply(1:length(modelos), function(i) Extraer_Srad_or_Prec("Presente",modelos[i],"Precipitacion",8000)) 54 | sapply(1:length(modelos), function(i) Extraer_Srad_or_Prec("Futuro",modelos[i],"Precipitacion",8000)) 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | -------------------------------------------------------------------------------- /make_wth.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | ############################### Make Weather .WTH ############################ 3 | ############################################################################## 4 | ## Load Functions Necessary 5 | # source("/home/jeisonmesa/Proyectos/BID/DSSAT-R/main_functions.R") 6 | ## to test 7 | # path <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR" 8 | # modelo <- "bcc_csm1_1" 9 | # 10 | # load(paste0(path, "/", modelo, "/Futuro/", "Temperatura.Rdat")) 11 | # load(paste0(path, "/", modelo, "/Futuro/", "Srad.Rdat")) 12 | # load(paste0(path, "/", modelo, "/Futuro/", "Precipitation.RDat")) 13 | # Tmax <- Tmax[[1]][1, ] 14 | # Tmin <- Tmin[[1]][1, ] 15 | # Srad <- Srad[[1]][[1]] 16 | # Prec <- Prec[[1]][[1]] 17 | # lat <- -72 18 | # long <- 4 19 | # wfd <- "model" ## switch between "wfd" and "model" 20 | 21 | # to WFD 22 | # load(paste0(path, "/wfd/", "ValorWFD.RDat")) 23 | # Tmax <- TempMax[[2]][1, ] ## [[year]][pixel, ] 24 | # Tmin <- TempMin[[2]][1, ] ## [[year]][pixel, ] 25 | # Srad <- Srad[[2]][1, ] ## [[year]][pixel, ] 26 | # Prec <- Prec[[2]][1, ] ## [[year]][pixel, ] 27 | # lat <- -72 ## Latitude 28 | # long <- 4 ## Longitude 29 | # wfd <- "wfd" ## switch between "wfd" and "model" 30 | 31 | # Climate Data Set 32 | # climate_data <- list() 33 | # climate_data$year <- 71:99 ## Years where they will simulate yields 34 | # climate_data$Srad <- Srad ## [[year]][pixel, ] 35 | # climate_data$Tmax <- TempMax ## [[year]][pixel, ] 36 | # climate_data$Tmin <- TempMin ## [[year]][pixel, ] 37 | # climate_data$Prec <- Prec ## [[year]][pixel, ] 38 | # climate_data$lat <- -72 ## You can include a vector of latitude 39 | # climate_data$long <- 4 ## You can include a vector of longitude 40 | # climate_data$wfd <- "wfd" ## Switch between "wfd" and "model" 41 | 42 | ## Proof 43 | ## One WTH 44 | # WriteWTH(, climate_data$Srad[[2]][1, ], climate_data$Tmax[[2]][1, ], climate_data$Tmin[[2]][1, ], 45 | # climate_data$Prec[[2]][1, ], climate_data$lat, climate_data$long, climate_data$wfd) 46 | ## all "WTH" for a pixel 47 | # pixel <- 1 ## Necessarily to first extract the coordinates matches 48 | # sapply(1:length(climate_data$year), function(i) { 49 | # WriteWTH(climate_data$year[i], climate_data$Srad[[i]][pixel, ], climate_data$Tmax[[i]][pixel, ], climate_data$Tmin[[i]][pixel, ], 50 | # climate_data$Prec[[i]][pixel, ], climate_data$lat, climate_data$long, climate_data$wfd) 51 | # 52 | # }) 53 | # i<- 1 54 | # pixel <- 4 55 | # 56 | # year <- climate_data$year[i] 57 | # Prec <- climate_data$Prec[[i]][[pixel]] 58 | # Srad <- climate_data$Srad[[i]][[pixel]] 59 | # Tmax <- climate_data$Tmax[[i]][[pixel]] 60 | # Tmin <- climate_data$Tmin[[i]][[pixel]] 61 | # lat <- climate_data$lat[pixel] 62 | # long <- climate_data$long[pixel] 63 | # wfd <- "modelo" 64 | # 65 | # 66 | # length(Prec) 67 | # length(Srad) 68 | # 69 | # 70 | # leap_year (72) 71 | # 72 | # for(i in 1:26){ 73 | # WriteWTH (climate_data$year[i], climate_data$Srad[[pixel]][[i]], climate_data$Tmax[[pixel]][[i]], climate_data$Tmin[[pixel]][[i]], climate_data$Prec[[pixel]][[i]], climate_data$lat[pixel], climate_data$long[pixel], wfd) 74 | # 75 | # 76 | # } 77 | # 78 | # setwd("/home//jeisonmesa/Proyectos/BID//DSSAT-R/") 79 | # 80 | # 81 | 82 | 83 | WriteWTH <- function(year, Srad, Tmax, Tmin, Prec, lat, long, wfd) { 84 | 85 | years <- leap_year(year) 86 | ## Defining climatic data used (WFD = historical Years (1971, 1999), Model = Climate change models) 87 | 88 | if(wfd == "wfd") { 89 | 90 | Prec <- as.vector(Prec) 91 | # Prec <- Prec*86400 92 | Srad <- as.vector(Srad) 93 | # Srad <- Srad/11.5740741 94 | Tmax <- as.vector(Tmax) 95 | # Tmax <- Tmax-273.15 96 | Tmin <- as.vector(Tmin) 97 | # Tmin <- Tmin-273.15 98 | 99 | 100 | } 101 | 102 | if(wfd == "model") { 103 | 104 | Prec <- as.vector(as.matrix(Prec)) 105 | Srad <- as.vector(as.matrix(Srad)) 106 | Tmax <- Tmax 107 | Tmin <- Tmin 108 | 109 | } 110 | 111 | ## pf <- file(paste("JBID",yrs2[1],".WTH",sep=""),open="a",encoding="latin1") 112 | sink(paste("JBID", years$yrs2[1], ".WTH", sep = ""), append = T) 113 | ##cat(paste("*WEATHER DATA :"),paste(coordenadas[1,1]),paste(coordenadas[1,2])) 114 | cat(paste("*WEATHER DATA :"), paste("BID")) 115 | cat("\n") 116 | cat("\n") 117 | cat(c("@ INSI LAT LONG ELEV TAV AMP REFHT WNDHT")) 118 | cat("\n") 119 | cat(sprintf("%6s %8.3f %8.3f %5.0f %5.1f %5.1f %5.2f %5.2f", "JBID", lat, long, -99,-99, -99.0, 0, 0)) 120 | cat("\n") 121 | cat(c('@DATE SRAD TMAX TMIN RAIN')) 122 | cat("\n") 123 | cat(cbind(sprintf("%5s %5.1f %5.1f %5.1f %5.1f", years$yrs, Srad, Tmax, Tmin, Prec)), sep = "\n") 124 | sink() 125 | 126 | } 127 | 128 | 129 | 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | -------------------------------------------------------------------------------- /main_functions.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | ########################## Condiciones iniciales ############################# 3 | ############################################################################## 4 | 5 | initial_conditions <- function(data, system) { 6 | 7 | if(system == "rainfed"){ 8 | 9 | ## Extraer Condiciones iniciales de los archivos de suelos 10 | SOIL <- readLines(paste(data)) ## Archivo de Suelo 11 | profiles <- grep("SLB", SOIL) ## Posicion en la que coincide con las variables a extraer 12 | imp.head <- scan(paste(data), what = "character", skip = profiles[1] - 1, nlines = 1, quiet = T) # Encabezado (titulo para las columnas) 13 | seps <- c(6, -6, 6) ## Separadores para las variables 14 | Initial_conditions <- read.fwf("SOIL.SOL", width = seps, header = F, skip = profiles[1], n = profiles[2] - profiles[1] - 1) 15 | 16 | pat <- "SLB|SDUL" 17 | headers <- imp.head[grep(pat, imp.head, perl = TRUE)] 18 | ## Borrar easta linea cuando no se corra Papa Secano 19 | #Initial_conditions <- data.frame(Initial_conditions[, 1], rep(-99, dim(Initial_conditions)[1])) 20 | colnames(Initial_conditions) <- headers 21 | 22 | return(Initial_conditions) 23 | 24 | } 25 | 26 | if(system == "irrigation"){ 27 | 28 | ## Extraer Condiciones iniciales de los archivos de suelos 29 | SOIL <- readLines(paste(data)) ## Archivo de Suelo 30 | profiles <- grep("SLB", SOIL) ## Posicion en la que coincide con las variables a extraer 31 | imp.head <- scan(paste(data), what = "character", skip = profiles[1] - 1, nlines = 1, quiet = T) # Encabezado (titulo para las columnas) 32 | seps <- c(6, -6, 6) ## Separadores para las variables 33 | Initial_conditions <- read.fwf("SOIL.SOL", width = seps, header = F, skip = profiles[1], n = profiles[2] - profiles[1] - 1) 34 | 35 | pat <- "SLB|SDUL" 36 | headers <- imp.head[grep(pat, imp.head, perl = TRUE)] 37 | 38 | Initial_conditions <- data.frame(Initial_conditions[, 1], rep(-99, dim(Initial_conditions)[1])) 39 | 40 | colnames(Initial_conditions) <- headers 41 | 42 | return(Initial_conditions) 43 | } 44 | 45 | 46 | } 47 | 48 | 49 | 50 | 51 | 52 | ############################################################################## 53 | ########################## Convert day for DSSAT ############################# 54 | ############################################################################## 55 | 56 | convert_date <- function(date, year) { 57 | ## esta es la funcion que se agrega pero sino sirve 60 dias antes dejar como estaba antes 58 | year_simul <- year 59 | year <- year + 1 60 | if(date <= 0){ 61 | date1 <- 365 + date 62 | date1 <- paste0(year_simul, date1) 63 | } 64 | ############################################# lo que funcionaba 65 | if(date < 10 & date > 0) { 66 | date1 <- paste0(year, "00", date) 67 | } 68 | if(date < 100 & date >= 10 & date > 0) { 69 | date1 <- paste0(year, "0", date) 70 | } 71 | if(date >= 100 & date > 0) { 72 | date1 <- paste0(year, date) 73 | } 74 | return(date1) 75 | } 76 | 77 | 78 | 79 | ############################################################################## 80 | ########################## Settings leap year ################################ 81 | ############################################################################## 82 | 83 | leap_year <- function(year) { 84 | ## Settings leap year 85 | ## yrs to create the label .WTH 86 | ## yrs2 Year Julian days 87 | if((year %% 4) == 0) { 88 | if((year %% 100) == 0) { 89 | if((year %% 400) == 0) { 90 | # print(paste(year,"is a leap year")) 91 | yrs <- year 92 | yrs2 <- (yrs * 100):((yrs * (100)) + 366) 93 | yrs <- (yrs * 1000):((yrs * (1000)) + 366) 94 | 95 | yrs <- yrs[-1] 96 | yrs2 <- yrs2[-1] 97 | 98 | } else { 99 | # print(paste(year,"is not a leap year")) 100 | yrs <- year 101 | yrs2 <- (yrs * 100):((yrs * (100)) + 365) 102 | yrs <- (yrs * 1000):((yrs * (1000)) + 365) 103 | 104 | yrs <- yrs[-1] ## day 00 is not possible 105 | yrs2 <- yrs2[-1] ## day 00 is not possible 106 | 107 | } 108 | } else { 109 | # print(paste(year,"is a leap year")) 110 | yrs <- year 111 | yrs2 <- (yrs * 100):((yrs * (100)) + 366) 112 | yrs <- (yrs * 1000):((yrs * (1000)) + 366) 113 | 114 | yrs <- yrs[-1] ## day 00 is not possible 115 | yrs2 <- yrs2[-1] ## day 00 is not possible 116 | 117 | } 118 | } else { 119 | # print(paste(year,"is not a leap year")) 120 | yrs <- year 121 | yrs2 <- (yrs * 100):((yrs * (100)) + 365) 122 | yrs <- (yrs * 1000):((yrs * (1000)) + 365) 123 | 124 | yrs <- yrs[-1] ## day 00 is not possible 125 | yrs2 <- yrs2[-1] ## day 00 is not possible 126 | } 127 | 128 | years <- list(yrs, yrs2) 129 | names(years) <- c("yrs", "yrs2") 130 | return(years) 131 | 132 | } 133 | 134 | 135 | ############################################################################## 136 | ########################## Leer Summary.OUT DSSAT ############################ 137 | ############################################################################## 138 | 139 | # path <- "/home/jeisonmesa/Proyectos/BID/DSSAT/bin/csm45_1_23_bin_ifort" 140 | # setwd(path) 141 | # 142 | # pat <- "SDAT|PDAT|ADAT|MDAT|IRCM|HWAH|HIAM|EPCM|NICM|NDCH|PRCP|ETCP|CWAM" 143 | # imp.head <- scan("Summary.OUT", what = "character", skip = 3, nlines = 1, quiet = T) 144 | # headers <- imp.head[grep(pat, imp.head, perl = TRUE)] 145 | # 146 | # # Read in main table in fixed width format 147 | # #seps <- c(-92, 8, 8, -8, 8, 8, -30, 8, -36, 6, -30, 6, -315, 7, 7) 148 | # seps <- c(-92, 8, 8, -8, 8, 8, -14, 8, -8, 8, -36, 6, -12, 6, -12, 6, -30, 6, -242, 6, -31, 7, 7) 149 | # 150 | # imp.dat <- read.fwf("Summary.OUT", width = seps, skip = 4, header = F, sep = "") 151 | # colnames(imp.dat) <- headers 152 | 153 | ################## Leer Overview.out ####################################### 154 | 155 | 156 | read.overview <- function(...){ 157 | 158 | overview <- readLines("OVERVIEW.OUT") 159 | stress <- grep("CROP GROWTH", overview) 160 | imp.head <- scan("OVERVIEW.OUT", what = "character", skip = stress[1], nlines = 1, quiet = T) 161 | path <- getwd() 162 | seps <- c(-1, 6, 5, 11, 8, 7, 6, 5, 5, 6, 6, 6, 6, 6) 163 | 164 | length.stress <- function(datos, path){ 165 | 166 | k<-0 167 | test <- try(strsplit(overview[datos + 3],split = path),silent = TRUE) 168 | while(!is.na(length(test)==1 && test[[1]]!="")){ 169 | test <- try(strsplit(overview[datos+k],split = path),silent = TRUE) 170 | k<- k+1 171 | 172 | } 173 | 174 | return(k-2) 175 | 176 | } 177 | 178 | year.overview <- lapply(1:length(stress), function(i) read.fwf("OVERVIEW.OUT", width = seps, skip = stress[i] + 2, header = F, n = length.stress(stress[i], getwd()) - 2)) 179 | 180 | headers <- function(datos){ 181 | 182 | colnames(datos) <- imp.head 183 | return(datos) 184 | 185 | } 186 | 187 | year.overview <- lapply(year.overview, headers) 188 | 189 | return(year.overview) 190 | 191 | } 192 | 193 | ### 194 | 195 | 196 | 197 | 198 | 199 | 200 | 201 | 202 | 203 | 204 | 205 | 206 | 207 | 208 | -------------------------------------------------------------------------------- /DSSAT_run.R: -------------------------------------------------------------------------------- 1 | #################### DSSAT RUN ##################################### 2 | 3 | ########### Load functions necessary 4 | # path_functions <- "/home/jeisonmesa/Proyectos/BID/DSSAT-R/" 5 | # path_project <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/" 6 | # 7 | # # Cargar data frame entradas para DSSAT 8 | # 9 | # load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_riego.Rdat")) 10 | # load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_secano.Rdat")) 11 | # load(paste0(path_project, "14-ObjectsR/Soil.RData")) 12 | # 13 | # source(paste0(path_functions, "main_functions.R")) ## Cargar funciones principales 14 | # source(paste0(path_functions, "make_xfile.R")) ## Cargar funcion para escribir Xfile DSSAT 15 | # source(paste0(path_functions, "make_wth.R")) 16 | # source(paste0(path_functions, "dssat_batch.R")) 17 | 18 | 19 | 20 | # Separacion Aplicacion de Nitrogeno 21 | # Cambiar crop_riego o crop_secano (para cada cultivo cambia la aplicacion de nitrogeno tanto la cantidad como el dia de la aplicacion) 22 | 23 | # day0 <- crop_riego$N.app.0d 24 | # day_aplication0 <- rep(0, length(day0)) 25 | # 26 | # day30 <- crop_riego$N.app.30d 27 | # day_aplication30 <- rep(30, length(day30)) 28 | # 29 | # amount <- data.frame(day0, day30) 30 | # day_app <- data.frame(day_aplication0, day_aplication30) 31 | 32 | 33 | # # Configurando el experimento para WFD (datos Historicos 1971-1999) 34 | # 35 | # years <- 71:99 36 | # data_xfile <- list() 37 | # data_xfile$crop <- "RICE" 38 | # data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ RICE LAC" 39 | # data_xfile$name <- "./JBID.RIX" 40 | # data_xfile$CR <- "RI" 41 | # data_xfile$INGENO <- "IB0118" 42 | # data_xfile$CNAME <- "IRNA" 43 | # data_xfile$initation <- crop_riego$mirca.start 44 | # data_xfile$final <- crop_riego$mirca.end 45 | # data_xfile$system <- "irrigation" ## Irrigation or rainfed, if is irrigation then automatic irrigation 46 | # data_xfile$year <- years[1] 47 | # data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 48 | # data_xfile$smodel <- "RIXCER" ## Fin Model 49 | # data_xfile$bname <- "DSSBatch.v45" 50 | 51 | ## to test 52 | ## Xfile(data_xfile, 1) 53 | 54 | 55 | ## Cargar datos climaticos WFD 56 | 57 | # load(paste0(path_project, "14-ObjectsR/wfd/", "ValorWFD.RDat")) 58 | 59 | # Climate Data Set 60 | # climate_data <- list() 61 | # climate_data$year <- 71:99 ## Years where they will simulate yields 62 | # climate_data$Srad <- Srad ## [[year]][pixel, ] 63 | # climate_data$Tmax <- TempMax ## [[year]][pixel, ] 64 | # climate_data$Tmin <- TempMin ## [[year]][pixel, ] 65 | # climate_data$Prec <- Prec ## [[year]][pixel, ] 66 | # climate_data$lat <- crop_riego[,"y"] ## You can include a vector of latitude 67 | # climate_data$long <- crop_riego[, "x"] ## You can include a vector of longitude 68 | # climate_data$wfd <- "wfd" ## Switch between "wfd" and "model" 69 | # climate_data$id <- crop_riego[, "Coincidencias"] 70 | 71 | ## Entradas para las corridas de DSSAT 72 | 73 | # input_data<- list() 74 | # input_data$xfile <- data_xfile 75 | # Xfile(input_data$xfile, 158) 76 | # input_data$climate <- climate_data 77 | 78 | ## to test 79 | # pixel <- 7 80 | # i <- 1 81 | 82 | # sapply(1:length(input_data$climate$year), function(i) { 83 | # WriteWTH(input_data$climate$year[i], input_data$climate$Srad[[i]][pixel, ], input_data$climate$Tmax[[i]][pixel, ], input_data$climate$Tmin[[i]][pixel, ], 84 | # input_data$climate$Prec[[i]][pixel, ], input_data$climate$lat[pixel], input_data$climate$long[pixel], input_data$climate$wfd) 85 | # 86 | # }) 87 | 88 | # dir_dssat <- "/home/jeisonmesa/Proyectos/BID/DSSAT/bin/csm45_1_23_bin_ifort/" 89 | # dir_base <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/Scratch" 90 | 91 | ## to test 92 | # input <- input_data 93 | # run_dssat(input_data, 50, dir_dssat, dir_base) 94 | 95 | run_dssat <- function(input, pixel, dir_dssat, dir_base) { 96 | #sfCat(pixel, "/n") 97 | print(pixel) 98 | run_id <- round(runif(1,10,2000000)) 99 | 100 | dir_run <- paste0(dir_base, "/", run_id) 101 | 102 | 103 | #gc() 104 | 105 | if(!file.exists(dir_run)) { 106 | 107 | dir.create(dir_run, showWarnings = TRUE, recursive = TRUE, mode = "7777") 108 | system(paste("cp", paste0(dir_dssat, "/*.*"), dir_run)) 109 | 110 | setwd(paste(dir_run)) 111 | } 112 | 113 | setwd(paste(dir_run)) 114 | 115 | ## Listar las salidas de DSSAT .out .soil and .wth 116 | ## para ser eliminados antes de la corrida a fin de poder escribir los nuevos archivos 117 | outList <- list.files(pattern = ".OUT") 118 | wthList <- list.files(pattern = ".WTH") 119 | soilList <- list.files(pattern = ".SOL") 120 | file.remove(outList) 121 | file.remove(wthList) 122 | file.remove(soilList) 123 | 124 | ## Make DSSatbatch 125 | 126 | CSMbatch(input$xfile$crop, input$xfile$name, input$xfile$bname) 127 | 128 | ## Make Soil 129 | Extraer.SoilDSSAT(values[input$climate$id[pixel]],getwd()) 130 | 131 | 132 | 133 | ## Make Xfile 134 | if(input$xfile$system == "rainfed") { 135 | in_conditions <- initial_conditions("SOIL.SOL", input$xfile$system) 136 | Xfile(input$xfile, pixel, in_conditions, initial = T) 137 | 138 | } else { 139 | in_conditions <- initial_conditions("SOIL.SOL", input$xfile$system) 140 | Xfile(input$xfile, pixel, in_conditions, initial = T) 141 | } 142 | 143 | 144 | # if(input$xfile$system == "irrigated") { 145 | # Xfile(input$xfile, pixel, in_conditions = F) 146 | # 147 | # } 148 | 149 | 150 | ## Make WTH 151 | 152 | if(input$climate$wfd == "wfd"){ 153 | 154 | sapply(1:length(input_data$climate$year), function(i) { 155 | WriteWTH(input_data$climate$year[i], input_data$climate$Srad[[i]][input$climate$id[pixel], ], input_data$climate$Tmax[[i]][input$climate$id[pixel], ], input_data$climate$Tmin[[i]][input$climate$id[pixel], ], 156 | input_data$climate$Prec[[i]][input$climate$id[pixel], ], input_data$climate$lat[pixel], input_data$climate$long[pixel], input_data$climate$wfd) 157 | 158 | }) 159 | 160 | gc() 161 | } 162 | 163 | 164 | if(input$climate$wfd == "model"){ 165 | 166 | sapply(1:length(input_data$climate$year), function(i) { 167 | WriteWTH(input_data$climate$year[i], input_data$climate$Srad[[input$climate$id[pixel]]][[i]], input_data$climate$Tmax[[input$climate$id[pixel]]][[i]], input_data$climate$Tmin[[input$climate$id[pixel]]][[i]], 168 | input_data$climate$Prec[[input$climate$id[pixel]]][[i]], input_data$climate$lat[pixel], input_data$climate$long[pixel], input_data$climate$wfd) 169 | 170 | }) 171 | 172 | 173 | } 174 | 175 | 176 | system(paste0("./DSCSM045.EXE " , input$xfile$smodel," B DSSBatch.v45"), ignore.stdout = T) 177 | 178 | pat <- "SDAT|PDAT|ADAT|MDAT|IRCM|HWAH|HIAM|EPCM|NICM|NDCH|PRCP|ETCP|CWAM|YPTM|YPEM|YPNAM|YPNUM" 179 | imp.head <- scan("Summary.OUT", what = "character", skip = 3, nlines = 1, quiet = T) 180 | headers <- imp.head[grep(pat, imp.head, perl = TRUE)] 181 | 182 | seps <- c(-92, 8, 8, -8, 8, 8, -14, 8, -8, 8, -36, 6, -12, 6, -12, 6, -30, 6, -179, 9, 9, -27, 9, 9, 6, -31, 7, 7) 183 | text_summary <- readLines('Summary.OUT', skipNul = T) 184 | imp.dat <- read.fwf(textConnection(text_summary), width = seps, skip = 4) 185 | colnames(imp.dat) <- headers 186 | 187 | return(imp.dat) 188 | ## gc() Tener cuidado de quitar 189 | 190 | #sfCat("Change Dir") 191 | setwd(paste(dir_base)) 192 | 193 | if(getwd() == dir_base){ 194 | 195 | setwd(paste(dir_base)) 196 | 197 | } 198 | 199 | 200 | } 201 | 202 | 203 | 204 | -------------------------------------------------------------------------------- /Soil.R: -------------------------------------------------------------------------------- 1 | # May 2015 2 | # Code to Generate fies .Soil Necessary to Run DSSAT in Latin America (resolution 0.5 degrees) 3 | # Data from The latest version (1.1) of WISE Soil Database for Crop Simulation Models data and maps can be downloaded at: 4 | # https://hc.box.net/shared/0404zn08js (Password: bHddsc) 5 | # Developer layer Soil Jawoo Koo j.koo@cgiar.org 6 | # Developer code R Jeison Mesa j.mesa@cgiar.org; jeison.mesa@correounivalle.edu.co 7 | 8 | ########################################################################################## 9 | ########### write the soil file (SOIL.SOL); make_soilfile function ####################### 10 | ########################################################################################## 11 | 12 | 13 | # Load Libraries Neccesary 14 | library(raster) 15 | library(ncdf) 16 | 17 | source("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/_scripts/mainFunctions.R") ## File Functios Necessary 18 | 19 | path <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/" ## Project Directory 20 | 21 | # Prepare Data 22 | id_soil <- raster(paste0(path, "02-Soil-data/","cell5m.asc")) ## Soil Type Identifier 23 | proj4string(id_soil) <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0") ## Add to the Coordinate System 24 | 25 | 26 | Soil_profile <- read.table(paste0(path, "02-Soil-data/", "data_hc3ksol_5m_global.txt"), header = T) ## Soil Profile for Cell5m (Para utilizar en el QUERY) 27 | wise <- readLines(paste0(path, "02-Soil-data/", "WI.SOL")) ## Soil File Wise 28 | Soil_Generic <- readLines(paste0(path, "02-Soil-data/", "HC.SOL")) ## Soil File Generic 29 | 30 | 31 | 32 | ## Soils Code Data Wise 33 | 34 | ##CodigoSueloWise=TiposSoilinWise(wise,getwd()) 35 | code_soil_wise <- Type_soil_wise(wise, getwd()) 36 | 37 | #head(code_soil_wise) 38 | 39 | #CodigoSueloGeneric=TiposSoilinWise(Soil_Generic,getwd()) ## Suelos Genericos 40 | code_soil_generic <- Type_soil_wise(Soil_Generic, getwd()) 41 | 42 | ## Header Position Wise 43 | 44 | Position_CodigoSueloWise <- which(code_soil_wise != "NA") 45 | Position_CodigoSueloWise <- c(1,(Position_CodigoSueloWise[2:length(Position_CodigoSueloWise)] + 1)) 46 | Position_CodigoSueloWise <- Position_CodigoSueloWise[1:(length(Position_CodigoSueloWise) - 3)] 47 | wise[Position_CodigoSueloWise] ## Header checking the Wise 48 | 49 | 50 | ## Header Position Generic 51 | 52 | Position_CodigoSueloGeneric<-which(code_soil_generic != "NA") 53 | Position_CodigoSueloGeneric<-c(1,(Position_CodigoSueloGeneric[2:length(Position_CodigoSueloGeneric)] + 1)) 54 | Position_CodigoSueloGeneric<-Position_CodigoSueloGeneric[1:(length(Position_CodigoSueloGeneric) - 2)] 55 | Soil_Generic[Position_CodigoSueloGeneric] ## Header checking the Generic 56 | 57 | 58 | 59 | ## Get reference codes Wise 60 | #Cod_Ref<-sapply(1:length(Position_CodigoSueloWise),function(i) SustraerTipoSuelo(wise[Position_CodigoSueloWise[i]])) 61 | Cod_Ref <- sapply(1:length(Position_CodigoSueloWise), function(i) extract_tipe_soil(wise[Position_CodigoSueloWise[i]])) 62 | 63 | Cod_Ref_Generic <- sapply(1:length(Position_CodigoSueloGeneric), function(i) extract_tipe_soil(Soil_Generic[Position_CodigoSueloGeneric[i]])) 64 | 65 | 66 | ## Data frame containing the code for wise and position that this is in the file Wise Soil contains the position in the file WISE 67 | 68 | Cod_Ref_and_Position <- data.frame(Cod_Ref, Position_CodigoSueloWise) 69 | #wise[59933] 70 | Cod_Ref_and_Position_Generic <- data.frame(Cod_Ref_Generic, Position_CodigoSueloGeneric) 71 | #Soil_Generic[473] 72 | 73 | 74 | ## Add to 0.5 degrees spatial resolution 75 | prec <- raster(paste0(path, "02-Soil-data/", "prec_1971_01.nc")) ## Archive for cutting soil types in Latin America (In this case added to the climate archives) 76 | crop_Latin <- crop(id_soil,prec, snap = 'in' ) ## Court for Latin America 77 | crop_Latin <- resample(crop_Latin, prec,method = "ngb" ) ## Resample Resolution climatic Files 78 | crop_Latin <- mask(crop_Latin, prec) ## Mask for Latin America 79 | ##plot(crop_Latin) 80 | 81 | 82 | 83 | Data_Soil_Latin_America <- writeRaster(crop_Latin, filename = 'test', overwrite = T) 84 | rm(crop_Latin) 85 | 86 | Position_Soil_<- which(Data_Soil_Latin_America[] != "NA") ## Position where values are 87 | #valores <- Data_Soil_Latin_America[][Position_Soil_] ## Values 88 | values <- Data_Soil_Latin_America[][Position_Soil_] 89 | 90 | 91 | ## Make Soil files .SOIL 92 | #prepare in_data 93 | in_data <- list() 94 | in_data$general <- data.frame(SITE=-99,COUNTRY="Generic",LAT=-99,LON=-99,SCSFAM="Generic") # Location 95 | 96 | make_soilfile <- function(in_data, data, path) { 97 | 98 | ## Construction header 99 | y <- data 100 | y <- y[5] 101 | write(y,file="x.txt") 102 | y<-read.table("x.txt",sep="") 103 | in_data$properties <- data.frame(SCOM=paste(y[1,1]),SALB=y[1,2],SLU1=y[1,3],SLDR=y[1,4],SLRO=y[1,5],SLNF=y[1,6],SLPF=1,SMHB=y[1,8],SMPX=y[1,9],SMKE=y[1,10]) 104 | 105 | sink("SOIL.SOL") 106 | cat("*SOILS: General DSSAT Soil Input File\n") 107 | cat("\n") 108 | cat("*BID0000001 WISE SCL 140 GENERIC SOIL PROFILE\n") 109 | cat("@SITE COUNTRY LAT LONG SCS Family\n") 110 | 111 | #general 112 | cat(paste(" ",sprintf("%1$-12s%2$-12s%3$8.3f%4$9.3f", 113 | as.character(in_data$general$SITE),as.character(in_data$general$COUNTRY), 114 | in_data$general$LAT, in_data$general$LON)," ", 115 | sprintf("%-12s",as.character(in_data$general$SCSFAM)), 116 | "\n",sep="")) 117 | 118 | 119 | #properties 120 | cat("@ SCOM SALB SLU1 SLDR SLRO SLNF SLPF SMHB SMPX SMKE\n") 121 | cat(paste(sprintf("%1$6s%2$6.2f%3$6.1f%4$6.2f%5$6.2f%6$6.2f%7$6.2f%8$6s%9$6s%10$6s", 122 | as.character(in_data$properties$SCOM),in_data$properties$SALB, 123 | in_data$properties$SLU1, in_data$properties$SLDR, in_data$properties$SLRO, 124 | in_data$properties$SLNF, in_data$properties$SLPF, in_data$properties$SMHB, 125 | in_data$properties$SMPX, in_data$properties$SMKE),"\n",sep="")) 126 | cat(paste(read_oneSoilFile(data[6:length(data)], path)), sep = "\n") 127 | sink() 128 | 129 | } 130 | 131 | ## test 132 | ## make_soilfile(in_data, wise[59933:length(wise)], getwd()) 133 | 134 | ## Extracting Archive Soil 135 | 136 | 137 | 138 | Extraer.SoilDSSAT <- function(Codigo_identificadorSoil,path) { 139 | 140 | position <- Codigo_identificadorSoil + 1 ## Where it coincides with the raster ID 141 | 142 | posicion <- which(Soil_profile[, 1] == position) 143 | 144 | 145 | 146 | if(length(posicion) == 0){ 147 | Wise_Position<-Cod_Ref_and_Position_Generic[11,2] 148 | return(make_soilfile(in_data,Soil_Generic[Wise_Position:length(wise)], path)) 149 | 150 | } 151 | 152 | else { 153 | 154 | celdas_id_Wise <- Soil_profile[posicion, ] ## Cells and percentage of soil File DSSAT 155 | Posicion_Pct <- which(celdas_id_Wise[, "SharePct"] == max(celdas_id_Wise[, "SharePct"])) ## The cell is chosen with the highest percentage 156 | Ref_for_Soil <- celdas_id_Wise[Posicion_Pct,2] 157 | Ref_for_Soil <- celdas_id_Wise[Posicion_Pct,2][1] 158 | condicion <- which(Cod_Ref_and_Position[, 1] == paste(Ref_for_Soil)) 159 | 160 | 161 | if(length(condicion) >= 1){ 162 | Wise_Position <- Cod_Ref_and_Position[which(Cod_Ref_and_Position[, 1] == paste(Ref_for_Soil)), ] 163 | return(make_soilfile(in_data, wise[Wise_Position[, 2]:length(wise)], path)) 164 | 165 | } 166 | 167 | if(length(condicion) == 0){ 168 | Wise_Position <- Cod_Ref_and_Position_Generic[which(Cod_Ref_and_Position_Generic[, 1] == paste(Ref_for_Soil)), 2] 169 | return(make_soilfile(in_data,Soil_Generic[Wise_Position:length(wise)], path)) 170 | 171 | } 172 | 173 | 174 | } 175 | 176 | } 177 | 178 | 179 | ## test 180 | ## the object values matches in the order of the coordinates for climate data for Latin America 181 | ##Extraer.SoilDSSAT(values[972],getwd()) 182 | 183 | save.image(file = paste0(path, "14-ObjectsR/Soil.RData")) ## Save the file Soil 184 | 185 | -------------------------------------------------------------------------------- /parallel_dssat.R: -------------------------------------------------------------------------------- 1 | ############### Parallel DSSAT ############################ 2 | ########### Load functions necessary 3 | path_functions <- "/home/jeisonmesa/Proyectos/BID/DSSAT-R/" 4 | path_project <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/" 5 | 6 | # Cargar data frame entradas para DSSAT 7 | 8 | 9 | load(paste0(path_project, "14-ObjectsR/Soil.RData")) 10 | rm(list=setdiff(ls(), c("Extraer.SoilDSSAT", "values", "Soil_profile", "Cod_Ref_and_Position_Generic", "make_soilfile" 11 | , "Soil_Generic", "wise", "in_data", "read_oneSoilFile", "path_functions", "path_project", "Cod_Ref_and_Position"))) 12 | 13 | 14 | # load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_riego.Rdat")) 15 | # load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_secano.Rdat")) 16 | 17 | load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_secano.RDat")) 18 | load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Rice_riego_myles.RDat")) 19 | 20 | source(paste0(path_functions, "main_functions.R")) ## Cargar funciones principales 21 | source(paste0(path_functions, "make_xfile.R")) ## Cargar funcion para escribir Xfile DSSAT 22 | source(paste0(path_functions, "make_wth.R")) 23 | source(paste0(path_functions, "dssat_batch.R")) 24 | source(paste0(path_functions, "DSSAT_run.R")) 25 | 26 | 27 | # Separacion Aplicacion de Nitrogeno 28 | # Cambiar crop_riego o crop_secano (para cada cultivo cambia la aplicacion de nitrogeno tanto la cantidad como el dia de la aplicacion) 29 | 30 | day0 <- crop_riego$N.app.0d 31 | day_aplication0 <- rep(0, length(day0)) 32 | 33 | day30 <- crop_riego$N.app.30d 34 | day_aplication30 <- rep(30, length(day30)) 35 | 36 | amount <- data.frame(day0, day30) 37 | day_app <- data.frame(day_aplication0, day_aplication30) 38 | 39 | 40 | # Configurando el experimento secano para WFD (datos Historicos 1971-1999) 41 | 42 | years <- 71:99 ## Camabiar entre linea base 71:99 o futuro 69:94 43 | data_xfile <- list() 44 | data_xfile$crop <- "RICE" 45 | data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ RICE LAC" 46 | data_xfile$name <- "./JBID.RIX" 47 | data_xfile$CR <- "RI" 48 | ## data_xfile$INGENO <- "IB0118" 49 | data_xfile$INGENO <- substr(crop_riego[, "variedad.1"], 1, 6) ## Correr Cultivar por region 50 | data_xfile$CNAME <- "IRNA" 51 | data_xfile$initation <- crop_riego$mirca.start 52 | data_xfile$final <- crop_riego$mirca.end 53 | data_xfile$system <- "irrigation" ## Irrigation or rainfed, if is irrigation then automatic irrigation 54 | data_xfile$year <- years[1] 55 | data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 56 | data_xfile$smodel <- "RIXCER" ## Fin Model 57 | data_xfile$bname <- "DSSBatch.v45" 58 | data_xfile$PPOP <- 200 ## Investigar mas acerca de este parametro 59 | data_xfile$PPOE <- 175 ## Investigar mas acerca de este parametro 60 | data_xfile$PLME <- "S" ## to rice S semilla T transplanting 61 | data_xfile$PLDS <- "B" ## Investigar mas acerca de este parametro 62 | data_xfile$PLRD <- 0 ## Investigar mas acerca de este parametro 63 | data_xfile$PLDP <- 2 ## Investigar mas acerca de este parametro 64 | 65 | 66 | 67 | 68 | 69 | ## to test 70 | ## Xfile(data_xfile, 1) 71 | 72 | 73 | ## Cargar datos climaticos WFD 74 | 75 | ## load(paste0(path_project, "14-ObjectsR/wfd/", "ValorWFD.RDat")) 76 | #load(paste0(path_project, "14-ObjectsR/wfd/", "WDF_all_new.Rdat")) 77 | 78 | ## Cargar datos climatico GCM 79 | 80 | modelos <- c("bcc_csm1_1", "bnu_esm","cccma_canesm2", "gfld_esm2g", "inm_cm4", "ipsl_cm5a_lr", "miroc_miroc5", 81 | "mpi_esm_mr", "mri_cgcm3", "ncc_noresm1_m") 82 | 83 | i <- 9 84 | gcm <- paste0("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelos[i],"/Futuro/") 85 | load(paste0(gcm, "Precipitation.RDat")) 86 | load(paste0(gcm, "Srad.Rdat")) 87 | load(paste0(gcm, "Temperatura.Rdat")) 88 | 89 | 90 | 91 | system.time(saveRDS(Prec, paste0(gcm, "Prec.rds"), compress = T)) 92 | Prec <- readRDS(paste0(gcm, "Prec.rds")) 93 | 94 | 95 | ffsave(Prec, file = "/home/jeisonmesa/Proyectos") 96 | 97 | # Climate Data Set 98 | # climate_data <- list() 99 | # climate_data$year <- 71:99 ## Years where they will simulate yields 100 | # climate_data$Srad <- Srad ## [[year]][pixel, ] 101 | # climate_data$Tmax <- TempMax ## [[year]][pixel, ] 102 | # climate_data$Tmin <- TempMin ## [[year]][pixel, ] 103 | # climate_data$Prec <- Prec ## [[year]][pixel, ] 104 | # climate_data$lat <- crop_riego[,"y"] ## You can include a vector of latitude 105 | # climate_data$long <- crop_riego[, "x"] ## You can include a vector of longitude 106 | # climate_data$wfd <- "wfd" ## Switch between "wfd" and "model" 107 | # climate_data$id <- crop_riego[, "Coincidencias"] 108 | 109 | 110 | # Climate Data Set for WFD 111 | climate_data <- list() 112 | climate_data$year <- 71:99 ## Years where they will simulate yields change between 71:99 or 69:94 113 | climate_data$Srad <- Srad ## [[year]][pixel, ] 114 | climate_data$Tmax <- Tmax ## [[year]][pixel, ] 115 | climate_data$Tmin <- Tmin ## [[year]][pixel, ] 116 | climate_data$Prec <- Prec ## [[year]][pixel, ] 117 | climate_data$lat <- crop_riego[,"y"] ## You can include a vector of latitude 118 | climate_data$long <- crop_riego[, "x"] ## You can include a vector of longitude 119 | climate_data$wfd <- "wfd" ## Switch between "wfd" and "model" 120 | climate_data$id <- crop_riego[, "Coincidencias"] 121 | 122 | ## Entradas para las corridas de DSSAT 123 | 124 | input_data <- list() 125 | input_data$xfile <- data_xfile 126 | input_data$climate <- climate_data 127 | # Xfile(input_data$xfile, 158) 128 | 129 | ## Carpetas necesarias donde se encuentra DSSAT compilado y un directorio para las corridas 130 | dir_dssat <- "/home/jeisonmesa/Proyectos/BID/DSSAT/bin/csm45_1_23_bin_ifort/" 131 | dir_base <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/Scratch" 132 | 133 | 134 | 135 | ## to test 136 | # input <- input_data 137 | # run_dssat(input_data, 100, dir_dssat, dir_base) 138 | 139 | for(i in 101:200){ 140 | 141 | run_dssat(input_data, i, dir_dssat, dir_base) 142 | 143 | } 144 | 145 | ### Paralelizacion 146 | 147 | 148 | ## librerias para el trabajo en paralelo 149 | library(foreach) 150 | library(doMC) 151 | 152 | registerDoMC(20) ## procesadores en su servidor 153 | 154 | 155 | ## Ciclo 156 | Run <- foreach(i = 1:dim(crop_riego)[1]) %dopar% { 157 | 158 | run_dssat(input_data, i, dir_dssat, dir_base) 159 | 160 | } 161 | 162 | 163 | tipo <- "Riego_" 164 | cultivo <- "Arroz_" 165 | siembra <- "Semilla_" 166 | # save(Run,file=paste("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/12-Resultados/Arroz/2021-2048/","_",cultivar,"_",tipo,modelos[i],".RDat",sep="")) 167 | #save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo, siembra,tipo,"WFD","_all.RDat",sep="")) 168 | save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo,tipo,"WFD_","IC.RDat",sep="")) 169 | save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo, siembra,tipo,modelos[i],"_4cm_depth.RDat",sep="")) 170 | 171 | rm(list = intersect(ls(), c("Prec", "Tmax" , "Tmin", "Srad"))) 172 | 173 | ### Comienzo de la paralelilzacion 174 | library(snowfall) 175 | sfInit(parallel = T, cpus = 5) 176 | 177 | ##EXportar los datos en cada procesador 178 | sfExport("input_data") 179 | sfExport("crop_riego") 180 | sfExport("amount") 181 | sfExport("day_app") 182 | 183 | ## Exportar los directorios necesarios para corrida en cada procesador 184 | sfExport("dir_dssat") 185 | sfExport("dir_base") 186 | sfExport("path_functions") 187 | sfExport("path_project") 188 | 189 | 190 | ## Exportar las funciones necesarias en cada procesador 191 | sfSource(paste0(path_functions, "main_functions.R")) ## Cargar funciones principales 192 | sfSource(paste0(path_functions, "make_xfile.R")) ## Cargar funcion para escribir Xfile DSSAT 193 | sfSource(paste0(path_functions, "make_wth.R")) 194 | sfSource(paste0(path_functions, "dssat_batch.R")) 195 | sfSource(paste0(path_functions, "DSSAT_run.R")) 196 | sfExport("Soil_Generic") 197 | sfExport("Cod_Ref_and_Position_Generic") 198 | sfExport("read_oneSoilFile") 199 | sfExport("in_data") 200 | sfExport("wise") 201 | sfExport("make_soilfile") 202 | sfExport("Extraer.SoilDSSAT") 203 | sfExport("values") 204 | sfExport("Soil_profile") 205 | sfExport("Cod_Ref_and_Position") 206 | sfLibrary(snowfall,character.only=TRUE) 207 | 208 | # Correr 209 | for(i in 1:dim(crop_riego)[1]){ 210 | Run <- run_dssat(input_data, i, dir_dssat, dir_base) 211 | print(i) 212 | 213 | } 214 | 215 | run_dssat(input_data, 1810, dir_dssat, dir_base) 216 | 217 | Run <- lapply(1:dim(crop_riego)[1], function(i) run_dssat(input_data, i, dir_dssat, dir_base)) 218 | 219 | Run <- sfLapply(1:dim(crop_riego)[1], function(i) run_dssat(input_data, i, dir_dssat, dir_base)) ## Funcion apra correr DSSAT en paralelo 220 | 221 | tipo <- "Riego" 222 | # save(Run,file=paste("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/12-Resultados/Arroz/2021-2048/","_",cultivar,"_",tipo,modelos[i],".RDat",sep="")) 223 | save(Run,file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector","_",tipo,"_WFD",".RDat",sep="")) 224 | 225 | sfStop() 226 | 227 | 228 | 229 | plot(ts(climate_data$Srad[[1]][1810, ] / 11.5740741)) 230 | plot(ts(climate_data$Tmax [[1]][1810, ] - 273.15), ylim = c(15, 40)) 231 | lines(ts(climate_data$Tmin [[1]][1810, ] - 273.15)) 232 | plot(ts(climate_data$Prec[[1]][1810, ]*86400)) 233 | climate_data$lat[1810] ## You can include a vector of latitude 234 | climate_data$long[1810] 235 | 236 | 237 | system(paste0("./DSCSM045.EXE " , data_xfile$smodel," B DSSBatch.v45"), ignore.stdout = T) 238 | 239 | 240 | 241 | 242 | 243 | -------------------------------------------------------------------------------- /Extract_Climate.R: -------------------------------------------------------------------------------- 1 | ## May 2015 2 | ## Climate change vulnerability in the agricultural sector in 3 | ## Latin America and the Caribbean 4 | ## functions necessary to extract climate data for netcdf raster files and files data frame 5 | ## Change the working directory for files and functions necessary 6 | ## Developer code R Jeison Mesa j.mesa@cgiar.org; jeison.mesa@correounivalle.edu.co 7 | 8 | ## Information 9 | ## The object Tiempo indicates that information to extract from baselina (1971-1990) and furutre (2021-2049) 10 | ## The object model indicates that model climate change scenarios to be extracted 11 | ## The object Variable indicates whether you want to extract precipitation or radiation 12 | ## Due to precipitation and radiation are not in raster is required to hace following code to extract data frame 13 | ## The object cantidad indicates that Latin American values to be extracted (0.5 degrees are 8199 values) 14 | 15 | 16 | ## Working Directory 17 | path <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/01-climate-data/bc_0_5deg_lat/" 18 | 19 | # to try 20 | # modelo <- "bcc_csm1_1" 21 | # Tiempo <- "Futuro" 22 | # Variable <- "Precipitacion" 23 | 24 | Extraer_Srad_or_Prec <- function(Tiempo, modelo, Variable, cantidad) { 25 | 26 | cat(modelo, sep = "\n" ) 27 | 28 | 29 | if(Tiempo=="Presente"){ 30 | setwd(paste(path,modelo, "/1971_2000", sep = "")) 31 | años <- c(1971:2000) 32 | if(Variable=="Precipitacion"){ 33 | cat("Cargando Precipitacion....... 1971-2000", "\n", sep = " ") 34 | load("bc_prec_1950_2000_daily.Rdat") 35 | 36 | } 37 | if(Variable=="Radiacion"){ 38 | cat("Cargando Radiacion........ 1971-2000", "\n", sep = " ") 39 | load("bc_rsds_1950_2000_daily.Rdat") 40 | } 41 | 42 | 43 | 44 | } 45 | 46 | if(Tiempo=="Futuro"){ 47 | setwd(paste(path, modelo, "/2020_2049", sep = "")) 48 | años <- c(2021:2049) 49 | if(Variable=="Precipitacion"){ 50 | cat("Cargando Precipitacion....... 2021:2049", "\n",sep = " ") 51 | load("bc_prec_2020_2049_daily.Rdat") 52 | 53 | } 54 | if(Variable=="Radiacion"){ 55 | cat("Cargando Radiacion........ 2021:2049", "\n", sep = " ") 56 | load("bc_rsds_2020_2049_daily.Rdat") 57 | } 58 | 59 | } 60 | 61 | 62 | cat("Cargando Funciones Necesarias", "\n", sep = " ") 63 | 64 | ## Functions to extract pixel values per year 65 | 66 | añosToRun <- function(inicial, final) { 67 | 68 | y <- seq(as.Date(paste(inicial, "-01-01", sep = "")), 69 | as.Date(paste(final, "-12-31", sep = "")), by = 1) 70 | return(y) 71 | 72 | } 73 | 74 | años_mod <- lapply(1:length(años), function(i) añosToRun(años[i], años[i])) 75 | 76 | 77 | ExtractMatrix <- function(data, fecha) { 78 | 79 | fecha <- paste(fecha) 80 | valores <- data[, fecha] 81 | return(valores) 82 | 83 | 84 | } 85 | 86 | ## Load the objects in each of the processors 87 | 88 | cat("Cargando el Cluster", "\n") 89 | sfExportAll() 90 | 91 | if(Tiempo == "Presente"){ 92 | 93 | if(Variable == "Precipitacion"){ 94 | cat("Extrayendo Precipitacion", modelo, "1971_2000", "\n", sep = " ") 95 | Prec <- sfLapply(1:cantidad, function(i) sfLapply(1:30, function(j) ExtractMatrix(dataMatrix[i, ], años_mod[[j]]))) 96 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Presente", sep = "")) 97 | save(Prec, file = "Precipitacion.RDat") 98 | 99 | } 100 | if(Variable=="Radiacion"){ 101 | cat("Extrayendo Radiacion", modelo, "1971_20000", "\n", sep = " ") 102 | Srad <- sfLapply(1:cantidad, function(i) sfLapply(1:30, function(j) ExtractMatrix(dataMatrix[i, ], años_mod[[j]]))) 103 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Presente", sep = "")) 104 | save(Srad, file = "Radiacion.RDat") 105 | } 106 | 107 | 108 | 109 | } 110 | 111 | if(Tiempo=="Futuro"){ 112 | 113 | if(Variable=="Precipitacion"){ 114 | cat("Extrayendo Precipitacion", modelo, "2021_2049", "\n", sep = " ") 115 | Prec <- sfLapply(1:cantidad, function(i) sfLapply(1:29, function(j) ExtractMatrix(dataMatrixFut[i, ], años_mod[[j]]))) 116 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/",modelo,"/Futuro",sep="")) 117 | save(Prec, file = "Precipitacion.RDat") 118 | 119 | } 120 | 121 | if(Variable=="Radiacion"){ 122 | cat("Extrayendo Radiacion", modelo, "2021_2049", "\n", sep = " ") 123 | Srad <- sfLapply(1:cantidad, function(i) sfLapply(1:29, function(j) ExtractMatrix(dataMatrixFut[i, ], años_mod[[j]]))) 124 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Futuro", sep = "")) 125 | save(Srad, file = "Radiacion.RDat") 126 | 127 | } 128 | 129 | 130 | 131 | } 132 | 133 | cat("Proceso Terminado", modelo, "\n", sep = " ") 134 | rm(list=ls()) 135 | 136 | } 137 | 138 | 139 | 140 | ## Function to extract raster maximum and minimum temperature 141 | 142 | Extraer_Temperatura <- function(modelo, Tiempo){ 143 | 144 | 145 | 146 | if(Tiempo=="Presente"){ 147 | 148 | 149 | lecturabandas <- function(data) { 150 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/01-climate-data/bc_0_5deg_lat/", modelo, "/1971_2000", "/by_month", sep = "")) 151 | 152 | data <- paste(data) 153 | lectura <- raster(paste(data), band = T) 154 | dias <- sapply(1:lectura@ file@nbands, function(i) raster(paste(data), band = i) ) 155 | return(stack(dias)) 156 | 157 | } 158 | 159 | sfExport("lecturabandas") 160 | 161 | Meses <- c(paste("_0", sep = "", 1:9, ".nc"), paste("_", sep = "", 10:12, ".nc")) 162 | Años_TemMax <- c(paste("tmax_19", sep = "",71:99), paste("tmax_2000")) 163 | Años_TemMin <- c(paste("tmin_19",sep="", 71:99), paste("tmin_2000")) 164 | 165 | 166 | SerieAnual_Tmax <- lapply(1:30, function(i) paste(Años_TemMax[i], Meses,sep = "")) 167 | SerieAnual_Tmin <- lapply(1:30, function(i) paste(Años_TemMin[i], Meses,sep = "")) 168 | 169 | sfExport("SerieAnual_Tmax","SerieAnual_Tmin") 170 | cat("Cargando Temperatura maxima y minima",modelo, "\n", sep = " ") 171 | Raster_TempMax <- sfLapply(1:30, function(j) sfLapply(1:12, function(i) lecturabandas(SerieAnual_Tmax[[j]][i]))) 172 | Raster_TempMin <- sfLapply(1:30, function(j) sfLapply(1:12, function(i) lecturabandas(SerieAnual_Tmin[[j]][i]))) 173 | 174 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/",modelo,"/Presente",sep="")) 175 | cat("Guardando informacion", "\n", sep = " ") 176 | save(Raster_TempMax, Raster_TempMin, file = "Temp.Rdat") 177 | 178 | rm(list=ls()) 179 | 180 | cat("Load Informacion", "\n", sep = " ") 181 | load("Temp.Rdat") 182 | load("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/coordenadas.RDat") 183 | sfExport("Raster_TempMax", "Raster_TempMin") 184 | sfExport("Coordenadas") 185 | 186 | Raster_TempMax <- lapply(Raster_TempMax, FUN = stack) 187 | Raster_TempMin <- lapply(Raster_TempMin, FUN = stack) 188 | 189 | cat("Extrayendo Temperatura Maxima",modelo, "1971_2000", "\n", sep = " ") 190 | TempMax <- sfLapply(Raster_TempMax, FUN = extract, Coordenadas) 191 | cat("Extrayendo Temperatura Minima",modelo, "1971_2000", "\n", sep = " ") 192 | TempMin <- sfLapply(Raster_TempMin, FUN = extract, Coordenadas) 193 | 194 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Presente", sep = "")) 195 | save(TempMax, TempMin, file = paste(modelo, ".RDat", sep = "")) 196 | 197 | } 198 | 199 | if(Tiempo=="Futuro"){ 200 | 201 | 202 | lecturabandas <- function(data){ 203 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/01-climate-data/bc_0_5deg_lat/", modelo, "/2020_2049", "/by_month", sep = "")) 204 | 205 | data <- paste(data) 206 | lectura <- raster(paste(data), band = T) 207 | dias <- sapply(1:lectura@ file@nbands, function(i) raster(paste(data), band = i) ) 208 | return(stack(dias)) 209 | 210 | } 211 | 212 | sfExport("lecturabandas") 213 | 214 | Meses=c(paste("_0", sep = "", 1:9, ".nc"), paste("_", sep = "",10:12,".nc")) 215 | 216 | Años_TemMax <- paste("tmax_20", sep = "", 21:49) 217 | Años_TemMin <- paste("tmin_20", sep = "", 21:49) 218 | 219 | 220 | 221 | SerieAnual_Tmax <- lapply(1:29, function(i) paste(Años_TemMax[i], Meses, sep = "")) 222 | SerieAnual_Tmin <- lapply(1:29, function(i) paste(Años_TemMin[i], Meses, sep = "")) 223 | 224 | sfExport("SerieAnual_Tmax","SerieAnual_Tmin") 225 | 226 | cat("Cargando Archivos nc", modelo, "2021_2049", "\n", sep = " ") 227 | Raster_TempMax <- sfLapply(1:29, function(j) sfLapply(1:12, function(i) lecturabandas(SerieAnual_Tmax[[j]][i]))) 228 | cat("Cargando Archivos nc",modelo,"2021_2049","\n",sep=" ") 229 | Raster_TempMin <- sfLapply(1:29, function(j) sfLapply(1:12, function(i) lecturabandas(SerieAnual_Tmin[[j]][i]))) 230 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Futuro", sep = "")) 231 | 232 | save(Raster_TempMax, Raster_TempMin, file = "Temp.Rdat") 233 | 234 | 235 | rm(Raster_TempMax, Raster_TempMin, SerieAnual_Tmax, SerieAnual_Tmin) 236 | 237 | cat("Load Informacion Temperatura",modelo,"2021_2049", "\n", sep = " ") 238 | load("Temp.Rdat") 239 | load("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/coordenadas.RDat") 240 | 241 | # sfSource("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/_scripts/mainFunctions.R") 242 | sfExport("Raster_TempMax", "Raster_TempMin") 243 | sfExport("Coordenadas") 244 | 245 | Raster_TempMax <- lapply(Raster_TempMax, FUN = stack) 246 | Raster_TempMin <- lapply(Raster_TempMin, FUN = stack) 247 | 248 | cat("Extrayendo Valores de Temperatura Maxima", modelo, "2021_2049", "\n", sep = " ") 249 | TempMax <- sfLapply(Raster_TempMax, FUN= extract, Coordenadas) 250 | cat("Extrayendo Valores de Temperatura Minima", modelo, "2021_2049", "\n", sep = " ") 251 | TempMin <- sfLapply(Raster_TempMin, FUN = extract, Coordenadas) 252 | 253 | setwd(paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelo, "/Futuro", sep = "")) ## Para guardar los datos 254 | 255 | save(TempMax, TempMin, file = paste(modelo, ".RDat", sep = "")) 256 | 257 | 258 | 259 | } 260 | cat("Proceso Finalizado", modelo, "\n", sep = " ") 261 | rm(list=ls()) 262 | 263 | } 264 | 265 | -------------------------------------------------------------------------------- /DSSAT_maize_parallel.R: -------------------------------------------------------------------------------- 1 | ############### Parallel DSSAT ############################ 2 | ########### Load functions necessary ############### 3 | path_functions <- "/home/jeisonmesa/Proyectos/BID/DSSAT-R/" 4 | path_project <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/" 5 | 6 | # Cargar data frame entradas para DSSAT 7 | 8 | 9 | load(paste0(path_project, "14-ObjectsR/Soil.RData")) 10 | rm(list=setdiff(ls(), c("Extraer.SoilDSSAT", "values", "Soil_profile", "Cod_Ref_and_Position_Generic", "make_soilfile" 11 | , "Soil_Generic", "wise", "in_data", "read_oneSoilFile", "path_functions", "path_project", "Cod_Ref_and_Position"))) 12 | 13 | 14 | load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Maize_riego.RDat")) 15 | 16 | 17 | source(paste0(path_functions, "main_functions.R")) ## Cargar funciones principales 18 | source(paste0(path_functions, "make_xfile.R")) ## Cargar funcion para escribir Xfile DSSAT 19 | source(paste0(path_functions, "make_wth.R")) 20 | source(paste0(path_functions, "dssat_batch.R")) 21 | source(paste0(path_functions, "DSSAT_run.R")) 22 | 23 | day0 <- crop_riego$N.app.0d 24 | day_aplication0 <- rep(0, length(day0)) 25 | 26 | day40 <- crop_riego$N.app.40d 27 | day_aplication40 <- rep(40, length(day40)) 28 | 29 | amount <- data.frame(day0, day40) 30 | day_app <- data.frame(day_aplication0, day_aplication40) 31 | 32 | 33 | ## configuracion Archivo experimental secano 34 | years <- 71:99 ## Camabiar entre linea base 71:99 o futuro 69:94 35 | data_xfile <- list() 36 | data_xfile$crop <- "MAIZE" 37 | data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ MAIZE LAC" 38 | data_xfile$name <- "./JBID.MZX" 39 | data_xfile$CR <- "MZ" 40 | ## data_xfile$INGENO <- "IB0118" 41 | data_xfile$INGENO <- substr(crop_riego[, "variedad.1"], 1, 6) ## Correr Cultivar por region 42 | data_xfile$CNAME <- "MZNA" 43 | data_xfile$initation <- crop_riego$mirca.start 44 | data_xfile$final <- crop_riego$mirca.end 45 | data_xfile$system <- "irrigation" ## Irrigation or rainfed, if is irrigation then automatic irrigation 46 | data_xfile$year <- years[1] 47 | data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 48 | data_xfile$smodel <- "MZCER045" ## Fin Model 49 | data_xfile$bname <- "DSSBatch.v45" 50 | data_xfile$PPOP <- 7 ## Investigar mas acerca de este parametro 51 | data_xfile$PPOE <- 5 ## Investigar mas acerca de este parametro 52 | data_xfile$PLME <- "S" ## to rice S semilla T transplanting 53 | data_xfile$PLDS <- "R" ## Investigar mas acerca de este parametro 54 | data_xfile$PLRD <- 0 55 | data_xfile$PLRS <- 80 56 | data_xfile$PLDP <- 5 57 | 58 | ## load(paste0(path_project, "14-ObjectsR/wfd/", "WDF_all_new.Rdat")) 59 | 60 | modelos <- c("bcc_csm1_1", "bnu_esm","cccma_canesm2", "gfld_esm2g", "inm_cm4", "ipsl_cm5a_lr", "miroc_miroc5", 61 | "mpi_esm_mr", "mri_cgcm3", "ncc_noresm1_m") 62 | 63 | 64 | i<- 10 65 | gcm <- paste0("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelos[i],"/Futuro/") 66 | load(paste0(gcm, "Precipitation.RDat")) 67 | load(paste0(gcm, "Srad.Rdat")) 68 | load(paste0(gcm, "Temperatura.Rdat")) 69 | 70 | # Climate Data Set for WFD or global model of climate change 71 | climate_data <- list() 72 | climate_data$year <- 71:99 ## Years where they will simulate yields change between 71:99 or 69:94 73 | climate_data$Srad <- Srad ## [[year]][pixel, ] 74 | climate_data$Tmax <- Tmax ## [[year]][pixel, ] 75 | climate_data$Tmin <- Tmin ## [[year]][pixel, ] 76 | climate_data$Prec <- Prec ## [[year]][pixel, ] 77 | climate_data$lat <- crop_riego[,"y"] ## You can include a vector of latitude 78 | climate_data$long <- crop_riego[, "x"] ## You can include a vector of longitude 79 | climate_data$wfd <- "wfd" ## Switch between "wfd" and "model" 80 | climate_data$id <- crop_riego[, "Coincidencias"] 81 | 82 | ## Entradas para las corridas de DSSAT 83 | 84 | input_data <- list() 85 | input_data$xfile <- data_xfile 86 | input_data$climate <- climate_data 87 | # Xfile(input_data$xfile, 158) 88 | 89 | ## Carpetas necesarias donde se encuentra DSSAT compilado y un directorio para las corridas 90 | dir_dssat <- "/home/jeisonmesa/Proyectos/BID/DSSAT/bin/csm45_1_23_bin_ifort/" 91 | dir_base <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/Scratch" 92 | 93 | run_dssat(input_data, 100, dir_dssat, dir_base) 94 | ## librerias para el trabajo en paralelo 95 | library(foreach) 96 | library(doMC) 97 | 98 | ## procesadores en su servidor 99 | registerDoMC(20) 100 | Run <- foreach(i = 1:dim(crop_riego)[1]) %dopar% { 101 | 102 | run_dssat(input_data, i, dir_dssat, dir_base) 103 | 104 | } 105 | 106 | tipo <- "Riego_" 107 | cultivo <- "Maize_" 108 | # save(Run,file=paste("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/12-Resultados/Arroz/2021-2048/","_",cultivar,"_",tipo,modelos[i],".RDat",sep="")) 109 | #save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo, siembra,tipo,"WFD","IC.RDat",sep="")) 110 | #save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo,tipo,"WFD_","IC.RDat",sep="")) 111 | save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo,tipo,modelos[i],"_IC_.RDat",sep="")) 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | ############### Parallel DSSAT ############################ 121 | ########### Load functions necessary ############### 122 | path_functions <- "/home/jeisonmesa/Proyectos/BID/DSSAT-R/" 123 | path_project <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/" 124 | 125 | # Cargar data frame entradas para DSSAT 126 | 127 | 128 | load(paste0(path_project, "14-ObjectsR/Soil.RData")) 129 | rm(list=setdiff(ls(), c("Extraer.SoilDSSAT", "values", "Soil_profile", "Cod_Ref_and_Position_Generic", "make_soilfile" 130 | , "Soil_Generic", "wise", "in_data", "read_oneSoilFile", "path_functions", "path_project", "Cod_Ref_and_Position"))) 131 | 132 | 133 | load(paste0(path_project, "/08-Cells_toRun/matrices_cultivo/Maize_secano.RDat")) 134 | 135 | 136 | source(paste0(path_functions, "main_functions.R")) ## Cargar funciones principales 137 | source(paste0(path_functions, "make_xfile.R")) ## Cargar funcion para escribir Xfile DSSAT 138 | source(paste0(path_functions, "make_wth.R")) 139 | source(paste0(path_functions, "dssat_batch.R")) 140 | source(paste0(path_functions, "DSSAT_run.R")) 141 | 142 | day0 <- crop_secano$N.app.0d 143 | day_aplication0 <- rep(0, length(day0)) 144 | 145 | day40 <- crop_secano$N.app.40d 146 | day_aplication40 <- rep(40, length(day40)) 147 | 148 | amount <- data.frame(day0, day40) 149 | day_app <- data.frame(day_aplication0, day_aplication40) 150 | 151 | 152 | ## configuracion Archivo experimental secano 153 | years <- 69:94 ## Camabiar entre linea base 71:99 o futuro 69:94 154 | data_xfile <- list() 155 | data_xfile$crop <- "MAIZE" 156 | data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ MAIZE LAC" 157 | data_xfile$name <- "./JBID.MZX" 158 | data_xfile$CR <- "MZ" 159 | ## data_xfile$INGENO <- "IB0118" 160 | data_xfile$INGENO <- substr(crop_secano[, "variedad.1"], 1, 6) ## Correr Cultivar por region 161 | data_xfile$CNAME <- "MZNA" 162 | data_xfile$initation <- crop_secano$mirca.start 163 | data_xfile$final <- crop_secano$mirca.end 164 | data_xfile$system <- "rainfed" ## Irrigation or rainfed, if is irrigation then automatic irrigation 165 | data_xfile$year <- years[1] 166 | data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 167 | data_xfile$smodel <- "MZCER045" ## Fin Model 168 | data_xfile$bname <- "DSSBatch.v45" 169 | data_xfile$PPOP <- 7 ## Investigar mas acerca de este parametro 170 | data_xfile$PPOE <- 5 ## Investigar mas acerca de este parametro 171 | data_xfile$PLME <- "S" ## to rice S semilla T transplanting 172 | data_xfile$PLDS <- "R" ## Investigar mas acerca de este parametro 173 | data_xfile$PLRD <- 0 174 | data_xfile$PLRS <- 80 175 | data_xfile$PLDP <- 5 176 | 177 | ## load(paste0(path_project, "14-ObjectsR/wfd/", "WDF_all_new.Rdat")) 178 | 179 | modelos <- c("bcc_csm1_1", "bnu_esm","cccma_canesm2", "gfld_esm2g", "inm_cm4", "ipsl_cm5a_lr", "miroc_miroc5", 180 | "mpi_esm_mr", "mri_cgcm3", "ncc_noresm1_m") 181 | 182 | 183 | i<- 10 184 | gcm <- paste0("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/14-ObjectsR/", modelos[i],"/Futuro/") 185 | load(paste0(gcm, "Precipitation.RDat")) 186 | load(paste0(gcm, "Srad.Rdat")) 187 | load(paste0(gcm, "Temperatura.Rdat")) 188 | 189 | # Climate Data Set for WFD or global model of climate change 190 | climate_data <- list() 191 | climate_data$year <- 69:94 ## Years where they will simulate yields change between 71:99 or 69:94 192 | climate_data$Srad <- Srad ## [[year]][pixel, ] 193 | climate_data$Tmax <- Tmax ## [[year]][pixel, ] 194 | climate_data$Tmin <- Tmin ## [[year]][pixel, ] 195 | climate_data$Prec <- Prec ## [[year]][pixel, ] 196 | climate_data$lat <- crop_secano[,"y"] ## You can include a vector of latitude 197 | climate_data$long <- crop_secano[, "x"] ## You can include a vector of longitude 198 | climate_data$wfd <- "model" ## Switch between "wfd" and "model" 199 | climate_data$id <- crop_secano[, "Coincidencias"] 200 | 201 | ## Entradas para las corridas de DSSAT 202 | 203 | input_data <- list() 204 | input_data$xfile <- data_xfile 205 | input_data$climate <- climate_data 206 | # Xfile(input_data$xfile, 158) 207 | 208 | ## Carpetas necesarias donde se encuentra DSSAT compilado y un directorio para las corridas 209 | dir_dssat <- "/home/jeisonmesa/Proyectos/BID/DSSAT/bin/csm45_1_23_bin_ifort/" 210 | dir_base <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/Scratch" 211 | 212 | run_dssat(input_data, 100, dir_dssat, dir_base) 213 | ## librerias para el trabajo en paralelo 214 | library(foreach) 215 | library(doMC) 216 | 217 | ## procesadores en su servidor 218 | registerDoMC(20) 219 | Run <- foreach(i = 1:dim(crop_secano)[1]) %dopar% { 220 | 221 | run_dssat(input_data, i, dir_dssat, dir_base) 222 | 223 | } 224 | 225 | tipo <- "Secano_" 226 | cultivo <- "Maize_" 227 | # save(Run,file=paste("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/12-Resultados/Arroz/2021-2048/","_",cultivar,"_",tipo,modelos[i],".RDat",sep="")) 228 | #save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo, siembra,tipo,"WFD","IC.RDat",sep="")) 229 | #save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo,tipo,"WFD_","IC.RDat",sep="")) 230 | save(Run, file = paste("/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/","_", cultivo,tipo,modelos[i],"_IC_.RDat",sep="")) 231 | 232 | 233 | 234 | 235 | 236 | 237 | 238 | 239 | -------------------------------------------------------------------------------- /wfd2wth_files.R: -------------------------------------------------------------------------------- 1 | # Climate Change Vulnerability In The Agricultural Sector 2 | # WFD to WTH files based in Jeison's code 3 | # H. Achicanoy 4 | # CIAT, 2015 5 | 6 | # Processing information from WFD to WTH files 7 | 8 | # Load directories 9 | wfd_dir <- "/mnt/data_cluster_4/observed/gridded_products/wfd/nc-files/wfd_0_5_deg_lat" 10 | 11 | # Load packages 12 | library(ncdf) 13 | library(raster) 14 | 15 | ## Years to extract (Change if is Baseline or Future) 16 | años <- 1971:2000 17 | 18 | #------------------------------------------------------------------------------------------------------------# 19 | # 1. Function to produce dates sequence 20 | #------------------------------------------------------------------------------------------------------------# 21 | 22 | añosToRun <- function(inicial,final){ 23 | y<-seq(as.Date(paste(inicial,"-01-01",sep="")),as.Date(paste(final,"-12-31",sep="")),by=1) 24 | return(y) 25 | } 26 | 27 | años_mod <- lapply(1:length(años),function(i) añosToRun(años[i],años[i])) 28 | 29 | #------------------------------------------------------------------------------------------------------------# 30 | # 2. Read files in .nc format 31 | #------------------------------------------------------------------------------------------------------------# 32 | 33 | Meses=c(paste("0",sep="",1:9,".nc"),paste(sep="",10:12,".nc")) 34 | Años_Prec <- c(paste0("lat_Rainf_daily_WFD_GPCC_19",71:99),paste0("lat_Rainf_daily_WFD_GPCC_2000")) 35 | Años_Radt <- c(paste0("lat_SWdown_daily_WFD_19",71:99),paste0("lat_SWdown_daily_WFD_2000")) 36 | Años_TemMax <- c(paste0("lat_Tmax_daily_WFD_19",71:99),paste0("lat_Tmax_daily_WFD_2000")) 37 | Años_TemMin <- c(paste0("lat_Tmin_daily_WFD_19",71:99),paste0("lat_Tmin_daily_WFD_2000")) 38 | 39 | SerieAnual_Prec <- lapply(1:30,function(i) paste(Años_Prec[i],Meses,sep="")) 40 | SerieAnual_Radt <- lapply(1:30,function(i) paste(Años_Radt[i],Meses,sep="")) 41 | SerieAnual_Tmax <- lapply(1:30,function(i) paste(Años_TemMax[i],Meses,sep="")) 42 | SerieAnual_Tmin <- lapply(1:30,function(i) paste(Años_TemMin[i],Meses,sep="")) 43 | 44 | #------------------------------------------------------------------------------------------------------------# 45 | # 3. Function to extract bands 46 | #------------------------------------------------------------------------------------------------------------# 47 | 48 | lecturabandas=function(data){ 49 | data=paste(data) 50 | lectura=raster(paste(data),band=T) 51 | dias=sapply(1:lectura@ file@nbands, function(i) raster(paste(data),band=i) ) 52 | return(stack(dias)) 53 | } 54 | 55 | #------------------------------------------------------------------------------------------------------------# 56 | # 4. Parallelize raster reading 57 | #------------------------------------------------------------------------------------------------------------# 58 | 59 | #-----------------------------------------------------# 60 | # Precipitación 61 | #-----------------------------------------------------# 62 | setwd(paste0(wfd_dir,"/Rainf_daily_WFD_GPCC")) 63 | 64 | library(snowfall) 65 | sfInit( parallel=TRUE, cpus=20) 66 | sfLibrary(snowfall) 67 | sfLibrary(raster) 68 | sfLibrary (sp) 69 | sfLibrary (rgdal) 70 | sfLibrary (maps) 71 | sfLibrary (mapproj) 72 | sfLibrary(stringr) ## libreria necesaria para las funciones de tipo caracter 73 | sfLibrary(date) ## configuracion de fecha tipo dia juliano 74 | sfLibrary(ncdf) 75 | sfExportAll() 76 | 77 | Raster_Prec <- sfLapply(1:30,function(j) sfLapply(1:12,function(i) lecturabandas(SerieAnual_Prec[[j]][i]))) 78 | sfStop() 79 | 80 | #-----------------------------------------------------# 81 | # Radiación solar 82 | #-----------------------------------------------------# 83 | setwd(paste0(wfd_dir,"/SWdown_daily_WFD")) 84 | 85 | library(snowfall) 86 | sfInit( parallel=TRUE, cpus=7) 87 | sfLibrary(snowfall) 88 | sfLibrary(raster) 89 | sfLibrary (sp) 90 | sfLibrary (rgdal) 91 | sfLibrary (maps) 92 | sfLibrary (mapproj) 93 | sfLibrary(stringr) ## libreria necesaria para las funciones de tipo caracter 94 | sfLibrary(date) ## configuracion de fecha tipo dia juliano 95 | sfLibrary(ncdf) 96 | sfExportAll() 97 | 98 | Raster_Radt <- sfLapply(1:30,function(j) sfLapply(1:12,function(i) lecturabandas(SerieAnual_Radt[[j]][i]))) 99 | sfStop() 100 | 101 | #-----------------------------------------------------# 102 | # Temperatura máxima 103 | #-----------------------------------------------------# 104 | setwd(paste0(wfd_dir,"/Tmax_daily_WFD")) 105 | 106 | library(snowfall) 107 | sfInit( parallel=TRUE, cpus=7) 108 | sfLibrary(snowfall) 109 | sfLibrary(raster) 110 | sfLibrary (sp) 111 | sfLibrary (rgdal) 112 | sfLibrary (maps) 113 | sfLibrary (mapproj) 114 | sfLibrary(stringr) ## libreria necesaria para las funciones de tipo caracter 115 | sfLibrary(date) ## configuracion de fecha tipo dia juliano 116 | sfLibrary(ncdf) 117 | sfExportAll() 118 | 119 | Raster_TempMax <- sfLapply(1:30,function(j) sfLapply(1:12,function(i) lecturabandas(SerieAnual_Tmax[[j]][i]))) 120 | sfStop() 121 | 122 | #-----------------------------------------------------# 123 | # Temperatura mínima 124 | #-----------------------------------------------------# 125 | setwd(paste0(wfd_dir,"/Tmin_daily_WFD")) 126 | 127 | library(snowfall) 128 | sfInit( parallel=TRUE, cpus=7) 129 | sfLibrary(snowfall) 130 | sfLibrary(raster) 131 | sfLibrary (sp) 132 | sfLibrary (rgdal) 133 | sfLibrary (maps) 134 | sfLibrary (mapproj) 135 | sfLibrary(stringr) ## libreria necesaria para las funciones de tipo caracter 136 | sfLibrary(date) ## configuracion de fecha tipo dia juliano 137 | sfLibrary(ncdf) 138 | sfExportAll() 139 | 140 | Raster_TempMin <- sfLapply(1:30,function(j) sfLapply(1:12,function(i) lecturabandas(SerieAnual_Tmin[[j]][i]))) 141 | sfStop() 142 | 143 | # Save important files 144 | setwd("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/wfd") 145 | save(Raster_Prec,file="Prec.Rdat") 146 | save(Raster_Radt,file="Radt.Rdat") 147 | save(Raster_TempMax,Raster_TempMin,file="Temp.Rdat") 148 | 149 | #------------------------------------------------------------------------------------------------------------# 150 | # 5. Extract values for each pixel by year 151 | #------------------------------------------------------------------------------------------------------------# 152 | 153 | Extraervalores_grilla=function(data,año,grilla){ 154 | tamdias=sfSapply(1:12,function(i) dim(data[[año]][[i]])[3]) 155 | value<-sfSapply(1:length(tamdias),function(j) sfSapply(1:tamdias[j],function(i) as.vector(extract(data[[año]][[j]][[i]],grilla) ))) 156 | return(unlist(value)) 157 | } 158 | 159 | #------------------------------------------------------------------------------------------------------------# 160 | # 6. Parallelize reading for rasters of climate serie 161 | #------------------------------------------------------------------------------------------------------------# 162 | 163 | # Read coordinates 164 | load("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/coordenadas.RDat") 165 | 166 | library(snowfall) 167 | sfInit( parallel=TRUE, cpus=7) 168 | sfLibrary(snowfall) 169 | sfLibrary(raster) 170 | sfExportAll() 171 | 172 | setwd("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/wfd") 173 | load("Prec.Rdat") 174 | load("Radt.Rdat") 175 | load("Temp.Rdat") 176 | 177 | Raster_Prec <- lapply(Raster_Prec,FUN=stack) 178 | Raster_Radt <- lapply(Raster_Radt,FUN=stack) 179 | Raster_TempMax <- lapply(Raster_TempMax,FUN=stack) 180 | Raster_TempMin <- lapply(Raster_TempMin,FUN=stack) 181 | 182 | Raster_Prec <- lapply(Raster_Prec, function(x){r <- x; proj4string(r) <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"); r <- rotate(r); return(r)}) 183 | Raster_Radt <- lapply(Raster_Radt, function(x){r <- x; proj4string(r) <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"); r <- rotate(r); return(r)}) 184 | Raster_TempMax <- lapply(Raster_TempMax, function(x){r <- x; proj4string(r) <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"); r <- rotate(r); return(r)}) 185 | Raster_TempMin <- lapply(Raster_TempMin, function(x){r <- x; proj4string(r) <- CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0"); r <- rotate(r); return(r)}) 186 | 187 | Prec <- sfLapply(Raster_Prec, FUN=extract,Coordenadas) 188 | Radt <- sfLapply(Raster_Radt, FUN=extract,Coordenadas) 189 | TempMax <- sfLapply(Raster_TempMax, FUN=extract,Coordenadas) 190 | TempMin <- sfLapply(Raster_TempMin, FUN=extract,Coordenadas) 191 | 192 | save(Prec,Radt,TempMax,TempMin,file="wfd_data.RDat") # Save data.frames with information for each day and pixel 193 | 194 | sfStop() 195 | 196 | # Create a data frame saving longitude, latitude and ID for each pixel 197 | id_pixel <- as.data.frame(Coordenadas) 198 | id_pixel$ID <- c(paste0("000",1:9),paste0("00",10:99),paste0("0",100:999),1000:8199) 199 | id_pixel <- id_pixel[,c("ID","x","y")] 200 | save(id_pixel, file="/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/id_coordinates.Rdat") 201 | 202 | #------------------------------------------------------------------------------------------------------------# 203 | # 7. Prepare data to run function 204 | #------------------------------------------------------------------------------------------------------------# 205 | 206 | # Define years to run 207 | años <- c(71:99,20) 208 | 209 | # Load climate information 210 | setwd("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/wfd") 211 | load("wfd_data.RDat") 212 | clima <- list() 213 | clima$Radiacion <- Radt 214 | clima$Tmax <- TempMax 215 | clima$Tmin <- TempMin 216 | clima$Prec <- Prec 217 | 218 | # Function to generate WTH files 219 | WriteWTH <- function(años,clima){ 220 | 221 | if(20 %in% años){ 222 | x <- as.data.frame(expand.grid(años*1000,1:365)) 223 | x$ID <- x[,1] + x[,2]; yrs <- x$ID; yrs <- sort(yrs); rm(x) 224 | yrs <- c(yrs[-c(1:365)],yrs[1:365]) 225 | } else{ 226 | x <- as.data.frame(expand.grid(años*1000,1:365)) 227 | x$ID <- x[,1] + x[,2]; yrs <- x$ID; yrs <- sort(yrs); rm(x) 228 | } 229 | 230 | load("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/14-ObjectsR/wfd/coordinates.Rdat") 231 | 232 | library(parallel) 233 | 234 | pixelProcess <- function(i) 235 | { 236 | pixel <- i 237 | 238 | Prec <- lapply(1:length(clima$Prec), function(i){z <- na.omit(as.vector(clima$Prec[[i]][pixel,])); z <- z[1:365]*86400; z <- round(z,1); return(z)}) 239 | Prec <- Reduce(function(...) c(..., recursive=FALSE), Prec) 240 | Srad <- lapply(1:length(clima$Radiacion), function(i){z <- na.omit(as.vector(clima$Radiacion[[i]][pixel,])); z <- z/11.5740741; z <- z[1:365]; z <- round(z,1); return(z)}) 241 | Srad <- Reduce(function(...) c(..., recursive=FALSE), Srad) 242 | Tmax <- lapply(1:length(clima$Tmax), function(i){z <- na.omit(as.vector(clima$Tmax[[i]][pixel,])); z <- z-273.15; z <- z[1:365]; z <- round(z,1); return(z)}) 243 | Tmax <- Reduce(function(...) c(..., recursive=FALSE), Tmax) 244 | Tmin <- lapply(1:length(clima$Tmin), function(i){z <- na.omit(as.vector(clima$Tmin[[i]][pixel,])); z <- z-273.15; z <- z[1:365]; z <- round(z,1); return(z)}) 245 | Tmin <- Reduce(function(...) c(..., recursive=FALSE), Tmin) 246 | 247 | Tav <- mean(c(Tmin,Tmax),na.rm=TRUE) 248 | Amp <- mean(Tmax-Tmin,na.rm=TRUE) 249 | 250 | sink(file=paste0("/mnt/workspace_cluster_3/bid-cc-agricultural-sector/01-climate-data/wth_by_pixel_processed/WFD/",id_pixel$ID[pixel],"7101.WTH"),append=T,type="output") 251 | cat(paste("*WEATHER DATA :"),paste("BID")) 252 | cat("\n") 253 | cat("\n") 254 | cat(c("@ INSI LAT LONG ELEV TAV AMP REFHT WNDHT")) 255 | cat("\n") 256 | cat(sprintf("%6s %8.3f %8.3f %5.0f %5.1f %5.2f %5.2f %5.2f",id_pixel$ID[pixel], id_pixel$y[pixel], id_pixel$x[pixel], -99,Tav, Amp, 0, 0)) 257 | cat("\n") 258 | cat(c('@DATE SRAD TMAX TMIN RAIN')) 259 | cat("\n") 260 | cat(cbind(sprintf("%5s %5.1f %5.1f %5.1f %5.1f",yrs,Srad,Tmax,Tmin,Prec)),sep="\n") 261 | sink() 262 | 263 | return(cat("Done.\n")) 264 | } 265 | 266 | mclapply(1:8199,pixelProcess,mc.cores=15) 267 | 268 | } 269 | 270 | WriteWTH(años=años, clima=clima) 271 | -------------------------------------------------------------------------------- /potato_xfile.r: -------------------------------------------------------------------------------- 1 | Xfile <- function(information, pixel, in_conditions, initial) { 2 | 3 | cultivars <- information$INGENO 4 | PPOP <- information$PPOP 5 | PPOE <- information$PPOE 6 | PLME <- paste(information$PLME) 7 | PLDS <- paste(information$PLDS) 8 | PLRD <- information$PLRD 9 | PLDP <- information$PLDP 10 | PLWT <- information$PLWT 11 | SPRL <- information$SPRL 12 | 13 | information$initation <- information$initation[pixel] 14 | #information$final <- crop_riego$mirca.end[pixel] 15 | information$nitrogen_aplication <- list(amount = amount[pixel, ], day_app = day_app[pixel, ]) 16 | 17 | # if(information$initation > information$final){ 18 | # information$final <- 365 19 | # } 20 | 21 | 22 | #midpoint_window <- round(mean(c(information$initation, information$final))) ## Midpoint planting window 23 | 24 | if( information$system == "irrigation" ){ 25 | 26 | 27 | 28 | 29 | # Initial Conditions 30 | if(information$crop == "RICE"){ 31 | SNH4 <- c(4, 4, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 32 | SNO3 <- c(0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1, 0.1, 0.1) 33 | 34 | } else{ 35 | SNH4 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 36 | SNO3 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 37 | 38 | } 39 | 40 | 41 | # pdate <- convert_date(pmax(midpoint_window, 0), information$year) ## Planting date 42 | IC <- 1 43 | pdate <- convert_date(information$initation, information$year) ## Planting date 44 | # sdate <- convert_date(pmax(information$initation - 60, 0), information$year) ## Simulation Start 45 | # sdate <- convert_date(information$initation - 30, information$year) ## Simulation Start 46 | sdate <- pdate 47 | A <- "PL" ## label name 48 | first <- -99 ## Start planting window 49 | last <- -99 ## End planting window 50 | IRR <- "A" ## Automatic irrigation 51 | plant <- "R" ## On reported date 52 | 53 | } 54 | 55 | #SNH4 <- c(10, 10, 0, 0, 0, 0, 0, 0, 0) 56 | #SNO3 <- c(5, 2, 0, 0, 0, 0, 0, 0, 0) 57 | 58 | if( information$system == "rainfed" ) { 59 | 60 | 61 | # SNH4 <- c(1.1, 1.1, 0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1) 62 | # SNO3 <- c(0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1) 63 | 64 | # SNH4 <- c(10, 10, 0, 0, 0, 0, 0, 0, 0) 65 | # SNO3 <- c(5, 2, 0, 0, 0, 0, 0, 0, 0) 66 | 67 | 68 | # Initial Conditions 13 July in the morning (2015) 69 | 70 | # SNH4 <- c(4, 4, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 71 | # SNO3 <- c(0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1, 0.1, 0.1) 72 | 73 | # Initial Conditions 13 July in the afternoun (2015) 74 | 75 | SNH4 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 76 | SNO3 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 77 | 78 | IC <- 1 79 | pdate <- convert_date(information$initation, information$year) ## Planting date 80 | sdate <- convert_date(information$initation, information$year) ## Simulation Start 81 | A <- "PL" ## Label Name 82 | IRR <- "N" ## No irrigation (rainfed) 83 | plant <-"R" ## Automatic planting seed given window 84 | ### Reconvertir first para que corra con dia de simulacion un año antes 85 | first <- -99 ## Start planting window 86 | last <- -99 87 | 88 | } 89 | 90 | 91 | ## Defining the Experiment 92 | in_data <- list() 93 | 94 | 95 | ## General data of the Experiment 96 | 97 | in_data$general <- list(PEOPLE = "Diego Obando Jeison Mesa", ADDRESS = "CIAT", SITE = "CALI") 98 | 99 | 100 | ## Definition simulate treatment 101 | 102 | # in_data$treatments <- data.frame(N = 1:dim(cultivars)[1], R = rep(1, dim(cultivars)[1]), O = rep(1, dim(cultivars)[1]), C = rep(0, dim(cultivars)[1]), 103 | # TNAME = cultivars[, "Genotype"], CU = rep(1 ,dim(cultivars)[1]), FL = rep(1, dim(cultivars)[1]), SA = rep(0, dim(cultivars)[1]), 104 | # IC = rep(IC, dim(cultivars)[1]), MP = rep(1, dim(cultivars)[1]), 105 | # MI = rep(0, dim(cultivars)[1]), MF = rep(1, dim(cultivars)[1]), MR = rep(0, dim(cultivars)[1]), MC = rep(0, dim(cultivars)[1]), 106 | # MT = rep(0, dim(cultivars)[1]), ME = rep(0, dim(cultivars)[1]), MH = rep(0, dim(cultivars)[1]), SM = rep(0, dim(cultivars)[1])) 107 | # 108 | 109 | in_data$treatments <- data.frame(N = 1, R = 1, O = 1, C = 0, TNAME = "BID001", CU = 1, FL = 1, SA = 0, IC = IC, MP = 1, 110 | MI = 0, MF = 1, MR = 0, MC = 0, MT = 0, ME = 0, MH = 1, SM = 1) 111 | 112 | ## Definition simulate cultivar 113 | 114 | # in_data$cultivars <- data.frame(C = 1:dim(cultivars)[1], CR = rep(information$CR, dim(cultivars)[1]), 115 | # INGENO = cultivars[, "Code"], CNAME = rep(information$CNAME, dim(cultivars)[1])) 116 | 117 | in_data$cultivars <- data.frame(C = 1, CR = information$CR, INGENO = information$INGENO[pixel], CNAME = information$CNAME) 118 | 119 | ## Field 120 | 121 | in_data$fields <- data.frame(L = 1, ID_FIELD = "BID1", WSTA = "JBID", FLSA=-99, FLOB = -99, FLDT = "DR000", 122 | FLDD = -99, FLDS = -99, FLST = -99, SLTX = -99, SLDP = -99, ID_SOIL="BID0000001", 123 | FLNAME = "FIELD01", XCRD = -99, YCRD = -99, ELEV = -99, AREA = -99, SLEN=-99, 124 | FLWR = -99, SLAS = -99, FLHST = -99, FHDUR=-99) 125 | 126 | ## initial conditions of the experiment 127 | ## Aqui investigar acerca de ICDAT 128 | ## Segun el manual Initial Conditions Measurement date, year + days 129 | in_data$ini_cond_properties <- data.frame(C = 1, PCR = information$CR, ICDAT = "50001", ICRT = -99, ICND = -99, ICRN = -99, ICRE = -99, 130 | ICWD = -99, ICRES = -99, ICREN = -99, ICREP = -99, ICRIP = -99, ICRID = -99, 131 | ICNAME = "inicond1") 132 | 133 | #in_data$ini_cond_profile <- data.frame(C=rep(1,5),ICBL=rep(-99,5),SH2O=rep(-99,5),SNH4=rep(-99,5), 134 | # SNO3=rep(-99,5)) 135 | 136 | 137 | ## Planting Details 138 | in_data$planting <- data.frame( P = 1, PDATE = pdate, EDATE = -99, PPOP, PPOE, PLME, 139 | PLDS, PLRS = -99, PLRD, PLDP, 140 | PLWT, PAGE = -99, PENV = -99, PLPH = -99, SPRL) 141 | 142 | ## Harvest Details 143 | 144 | in_data$harvest <- data.frame(H = 1, HADTE = 1, HSTG = "GS000", HCOM = -99, HSIZE = -99, HPC = -99, HBPC = -99) 145 | 146 | ## Simulation Control 147 | in_data$sim_ctrl <- data.frame(N = 1, GENERAL = "GE", NYERS = 25, NREPS = 1, START = "S", SDATE = sdate, 148 | RSEED=2150, SNAME = "simctr1", SMODEL = paste(information$smodel), 149 | OPTIONS = "OP", WATER = "Y", NITRO = "Y", SYMBI = "N", 150 | PHOSP = "N", POTAS = "N", DISES = "N", CHEM = "N", TILL = "N", 151 | CO2 = "D", METHODS = "ME", WTHER = "M", INCON = "M", LIGHT = "E", 152 | EVAPO = "R", INFIL = "S", PHOTO = "C", HYDRO = "R", 153 | NSWIT = 1, MESOM = "G", MESEV = "S", MESOL =2, MANAGEMENT = "MA", 154 | PLANT = plant, IRRIG = IRR, 155 | FERTI = "D", RESID = "R", HARVS = "D", OUTPUTS = "OU", FNAME = "N", 156 | OVVEW = "Y", SUMRY = "Y", FROPT = 1, GROUT = "Y", CAOUT = "Y", 157 | WAOUT = "Y", NIOUT = "Y", MIOUT = "Y", 158 | DIOUT = "Y", VBOSE = "Y", CHOUT = "Y", OPOUT = "Y") 159 | 160 | ## AUTOMATIC MANAGEMENT 161 | 162 | in_data$auto_mgmt <- data.frame(N = 1, PLANTING = A, PFRST = first, PLAST = last, PH2OL = 50, PH2OU = 100, 163 | PH2OD = 30, PSTMX = 40, PSTMN = 10, IRRIGATION = "IR", IMDEP=30, ITHRL = 50, 164 | ITHRU =100, IROFF = "GS000", IMETH = "IR001", IRAMT = 10, IREFF = 1, 165 | NITROGEN = "NI", NMDEP = 30, NMTHR = 50, NAMNT = 25, NCODE = "FE001", 166 | NAOFF = "GS000", RESIDUES = "RE", RIPCN = 100, RTIME = 1, RIDEP = 20, 167 | HARVEST = "HA", HFRST = 0, HLAST = 00001, HPCNP = 100, HPCNR = 0) 168 | 169 | 170 | # Make Xfile 171 | 172 | ## test 173 | ## out_file <- "./JBID.RIX" 174 | # overwrite <- F 175 | 176 | make_xfile <- function(in_data, out_file, overwrite = F) { 177 | #open file in write mode 178 | if (file.exists(out_file)) { 179 | if (overwrite) { 180 | pf <- file(out_file, open = "w") 181 | } else { 182 | rnum <- round(runif(1, 10000, 20000), 0) 183 | tmpvar <- unlist(strsplit(out_file, "/", fixed = T)) 184 | pth_ref <- paste(tmpvar[1:(length(tmpvar) - 1)], collapse = "/") 185 | out_file <- paste(pth_ref, "/copy-", rnum, "_", tmpvar[length(tmpvar)], sep = "") 186 | pf <- file(out_file, open = "w") 187 | } 188 | } else { 189 | pf <- file(out_file,open="w") 190 | } 191 | 192 | #write header and stuff 193 | #pf <- file(out_file,open="w") 194 | cat(paste0(information$exp_details, "\n"), file = pf) 195 | cat("\n",file = pf) 196 | 197 | #general stuff 198 | cat("*GENERAL\n@PEOPLE\n", file = pf) 199 | cat(paste(sprintf("%-12s", as.character(in_data$general$PEOPLE)), "\n", sep = ""), file = pf) 200 | cat("@ADDRESS\n", file = pf) 201 | cat(paste(sprintf("%-12s", as.character(in_data$general$ADDRESS)), "\n", sep = ""), file = pf) 202 | cat("@SITE\n", file = pf) 203 | cat(paste(sprintf("%-12s", as.character(in_data$general$SITE)), "\n", sep = ""), file = pf) 204 | 205 | #treatments 206 | cat("*TREATMENTS -------------FACTOR LEVELS------------\n", file = pf) 207 | cat("@N R O C TNAME.................... CU FL SA IC MP MI MF MR MC MT ME MH SM\n", file = pf) 208 | for (i in 1:nrow(in_data$treatments)) { 209 | cat(paste(sprintf("%1$2d%2$2d%3$2d%4$2d",as.integer(in_data$treatments$N[i]),as.integer(in_data$treatments$R[i]), 210 | as.integer(in_data$treatments$O[i]),as.integer(in_data$treatments$C[i])), 211 | " ",sprintf("%1$-25s%2$3d%3$3d%4$3d%5$3d%6$3d%7$3d%8$3d%9$3d%10$3d%11$3d%12$3d%13$3d%14$3d",in_data$treatments$TNAME[i], 212 | as.integer(in_data$treatments$CU[i]),as.integer(in_data$treatments$FL[i]),as.integer(in_data$treatments$SA[i]), 213 | as.integer(in_data$treatments$IC[i]),as.integer(in_data$treatments$MP[i]),as.integer(in_data$treatments$MI[i]), 214 | as.integer(in_data$treatments$MF[i]),as.integer(in_data$treatments$MR[i]),as.integer(in_data$treatments$MC[i]), 215 | as.integer(in_data$treatments$MT[i]),as.integer(in_data$treatments$ME[i]),as.integer(in_data$treatments$MH[i]), 216 | as.integer(in_data$treatments$SM[i])), 217 | "\n", sep = ""), file = pf) 218 | } 219 | cat("\n", file = pf) 220 | 221 | #cultivars 222 | cat("*CULTIVARS\n", file = pf) 223 | cat("@C CR INGENO CNAME\n", file = pf) 224 | for (i in 1:nrow(in_data$cultivars)) { 225 | cat(paste(sprintf("%2d",as.integer(in_data$cultivars$C[i]))," ",sprintf("%2s", in_data$cultivars$CR[i]), 226 | " ", sprintf("%6s",in_data$cultivars$INGENO[i])," ",sprintf("%-12s",in_data$cultivars$CNAME[i]), 227 | "\n", sep = ""), file = pf) 228 | } 229 | cat("\n", file = pf) 230 | 231 | #fields 232 | cat("*FIELDS\n", file = pf) 233 | cat("@L ID_FIELD WSTA.... FLSA FLOB FLDT FLDD FLDS FLST SLTX SLDP ID_SOIL FLNAME\n", file = pf) 234 | cat(paste(sprintf("%2d",as.integer(in_data$fields$L))," ",sprintf("%-8s",in_data$fields$ID_FIELD), 235 | " ",sprintf("%-8s",in_data$fields$WSTA),sprintf("%6d",as.integer(in_data$fields$FLSA)), 236 | sprintf("%6d",as.integer(in_data$fields$FLOB)),sprintf("%6s",in_data$fields$FLDT), 237 | sprintf("%6d",as.integer(in_data$fields$FLDD)),sprintf("%6s",as.integer(in_data$fields$FLDS)), 238 | sprintf("%6d",as.integer(in_data$fields$FLST))," ",sprintf("%-4d",as.integer(in_data$fields$SLTX)), 239 | sprintf("%6d",as.integer(in_data$fields$SLDP))," ",sprintf("%-10s",in_data$fields$ID_SOIL)," ", 240 | sprintf("%-12s",in_data$fields$FLNAME),"\n",sep=""),file=pf) 241 | cat("@L ..........XCRD ...........YCRD .....ELEV .............AREA .SLEN .FLWR .SLAS FLHST FHDUR\n",file=pf) 242 | cat(paste(sprintf("%2d",as.integer(in_data$fields$L))," ",sprintf("%15.3f",in_data$fields$XCRD)," ", 243 | sprintf("%15.3f",in_data$fields$YCRD)," ",sprintf("%9d",as.integer(in_data$fields$ELEV))," ", 244 | sprintf("%17d",as.integer(in_data$fields$AREA))," ",sprintf("%5d",as.integer(in_data$fields$SLEN))," ", 245 | sprintf("%5d",as.integer(in_data$fields$FLWR))," ",sprintf("%5d",as.integer(in_data$fields$SLAS))," ", 246 | sprintf("%5d",as.integer(in_data$fields$FLHST))," ",sprintf("%5d",as.integer(in_data$fields$FHDUR)), 247 | "\n",sep=""),file=pf) 248 | cat("\n",file=pf) 249 | 250 | #initial conditions 251 | #cat("*INITIAL CONDITIONS\n",file=pf) 252 | #cat("@C PCR ICDAT ICRT ICND ICRN ICRE ICWD ICRES ICREN ICREP ICRIP ICRID ICNAME\n",file=pf) 253 | #cat(paste(sprintf("%2d",as.integer(in_data$ini_cond_properties$C))," ",sprintf("%5s",in_data$ini_cond_properties$PCR), 254 | # " ",sprintf("%5s",in_data$ini_cond_properties$ICDAT)," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRT)), 255 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICND))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRN)), 256 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRE))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICWD)), 257 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRES))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICREN)), 258 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICREP))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRIP)), 259 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRID))," ",sprintf("%-12s",in_data$ini_cond_properties$ICNAME), 260 | # "\n",sep=""),file=pf) 261 | #cat("@C ICBL SH2O SNH4 SNO3\n",file=pf) 262 | #for (i in 1:nrow(in_data$ini_cond_profile)) { 263 | # cat(paste(sprintf("%2d",as.integer(in_data$ini_cond_properties$C))," ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$ICBL[i])), 264 | # " ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SH2O[i]))," ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SNH4[i])), 265 | # " ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SNO3[i])),"\n",sep=""),file=pf) 266 | #} 267 | #cat("\n",file=pf) 268 | 269 | # Initial Conditions 270 | if(exists("in_conditions") & initial == T) { 271 | 272 | cat("*INITIAL CONDITIONS\n", file = pf) 273 | cat("@C PCR ICDAT ICRT ICND ICRN ICRE ICWD ICRES ICREN ICREP ICRIP ICRID ICNAME\n", file = pf) 274 | cat(sprintf("%2d %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %2s", 1, "MZ", sdate, 1, -99, 1, 1, -99, -99, -99, -99, -99, -99, -99), "\n", file = pf) 275 | 276 | cat("@C ICBL SH2O SNH4 SNO3\n", file = pf) 277 | for(i in 1:dim(in_conditions)[1]){ 278 | 279 | if(information$system == "rainfed"){ 280 | cat(paste(sprintf("%2d %5d %5.2f %5.2f %5.2f", 1, in_conditions[i, 1], in_conditions[i, 2], SNH4[i], SNO3[i])), "\n", file = pf) 281 | } 282 | 283 | if(information$system == "irrigation"){ 284 | cat(paste(sprintf("%2d %5d %5.0f %5.2f %5.2f", 1, in_conditions[i, 1], in_conditions[i, 2], SNH4[i], SNO3[i])), "\n", file = pf) 285 | } 286 | 287 | 288 | } 289 | 290 | 291 | } 292 | 293 | cat("\n", file = pf) 294 | #planting details 295 | cat("*PLANTING DETAILS\n",file = pf) 296 | cat("@P PDATE EDATE PPOP PPOE PLME PLDS PLRS PLRD PLDP PLWT PAGE PENV PLPH SPRL PLNAME\n",file=pf) 297 | cat(paste(sprintf("%2d",as.integer(in_data$planting$P))," ",sprintf("%5s",in_data$planting$PDATE), 298 | " ",sprintf("%5s",in_data$planting$EDATE)," ",sprintf("%5d",as.integer(in_data$planting$PPOP)), 299 | " ",sprintf("%5d",as.integer(in_data$planting$PPOE))," ",sprintf("%5s",in_data$planting$PLME), 300 | " ",sprintf("%5s",in_data$planting$PLDS)," ",sprintf("%5d",as.integer(in_data$planting$PLRS)), 301 | " ",sprintf("%5d",as.integer(in_data$planting$PLRD))," ",sprintf("%5d",as.integer(in_data$planting$PLDP)), 302 | " ",sprintf("%5d",as.integer(in_data$planting$PLWT))," ",sprintf("%5d",as.integer(in_data$planting$PAGE)), 303 | " ",sprintf("%5d",as.integer(in_data$planting$PENV))," ",sprintf("%5d",as.integer(in_data$planting$PLPH)), 304 | " ",sprintf("%5d",as.integer(in_data$planting$SPRL))," ",sprintf("%29s",in_data$planting$PLNAME), 305 | "\n", sep = ""), file = pf) 306 | cat("\n", file = pf) 307 | 308 | ## Details Fertilization 309 | cat("*FERTILIZERS (INORGANIC)\n", file = pf) 310 | cat("@F FDATE FMCD FACD FDEP FAMN FAMP FAMK FAMC FAMO FOCD FERNAME \n", file = pf) 311 | for(i in 1:dim(information$nitrogen_aplication$amount)[2]){ 312 | if(!is.na(information$nitrogen_aplication$amount[, i])) { 313 | 314 | 315 | if(i == 1){ 316 | 317 | cat(sprintf("%2s %5s %4s %5s %5i %5.1f %5i %5i %5i %5i %5i %1i", 1, information$nitrogen_aplication$day_app[, i], "FE005", "AP002", 318 | 4, information$nitrogen_aplication$amount[, i], 0, -99, -99, -99, -99, -99), "\n", file = pf) 319 | 320 | } else{ 321 | cat(sprintf("%2s %5s %4s %5s %5i %5.1f %5i %5i %5i %5i %5i %1i", 1, information$nitrogen_aplication$day_app[, i], "FE005", "AP002", 322 | 0, information$nitrogen_aplication$amount[, i], 0, -99, -99, -99, -99, -99), "\n", file = pf) 323 | } 324 | 325 | } 326 | 327 | } 328 | cat("\n", file = pf) 329 | 330 | ## Detalle de Cosecha 331 | 332 | cat("*HARVEST DETAILS\n", file = pf) 333 | cat("@H HDATE HSTG HCOM HZISE HPC HBPC HNAME \n", file = pf) 334 | cat(" 1 180 GS000 -99 -99 -99 -99 \n", file = pf) 335 | 336 | #simulation controls 337 | cat("*SIMULATION CONTROLS\n", file = pf) 338 | cat("@N GENERAL NYERS NREPS START SDATE RSEED SNAME.................... SMODEL\n", file = pf) 339 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$GENERAL), 340 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$NYERS))," ",sprintf("%5d",as.integer(in_data$sim_ctrl$NREPS)), 341 | " ",sprintf("%5s",in_data$sim_ctrl$START)," ",sprintf("%5s",in_data$sim_ctrl$SDATE), 342 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$RSEED))," ",sprintf("%-25s",in_data$sim_ctrl$SNAME), 343 | " ",sprintf("%-6s",in_data$sim_ctrl$SMODEL),"\n",sep=""),file=pf) 344 | cat("@N OPTIONS WATER NITRO SYMBI PHOSP POTAS DISES CHEM TILL CO2\n",file=pf) 345 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$OPTIONS), 346 | " ",sprintf("%5s",in_data$sim_ctrl$WATER)," ",sprintf("%5s",in_data$sim_ctrl$NITRO), 347 | " ",sprintf("%5s",in_data$sim_ctrl$SYMBI)," ",sprintf("%5s",in_data$sim_ctrl$PHOSP), 348 | " ",sprintf("%5s",in_data$sim_ctrl$POTAS)," ",sprintf("%5s",in_data$sim_ctrl$DISES), 349 | " ",sprintf("%5s",in_data$sim_ctrl$CHEM)," ",sprintf("%5s",in_data$sim_ctrl$TILL), 350 | " ",sprintf("%5s",in_data$sim_ctrl$CO2),"\n",sep=""),file=pf) 351 | cat("@N METHODS WTHER INCON LIGHT EVAPO INFIL PHOTO HYDRO NSWIT MESOM MESEV MESOL\n",file=pf) 352 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$METHODS), 353 | " ",sprintf("%5s",in_data$sim_ctrl$WTHER)," ",sprintf("%5s",in_data$sim_ctrl$INCON), 354 | " ",sprintf("%5s",in_data$sim_ctrl$LIGHT)," ",sprintf("%5s",in_data$sim_ctrl$EVAPO), 355 | " ",sprintf("%5s",in_data$sim_ctrl$INFIL)," ",sprintf("%5s",in_data$sim_ctrl$PHOTO), 356 | " ",sprintf("%5s",in_data$sim_ctrl$HYDRO)," ",sprintf("%5d",as.integer(in_data$sim_ctrl$NSWIT)), 357 | " ",sprintf("%5s",in_data$sim_ctrl$MESOM)," ",sprintf("%5s",in_data$sim_ctrl$MESEV), 358 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$MESOL)),"\n",sep=""),file=pf) 359 | cat("@N MANAGEMENT PLANT IRRIG FERTI RESID HARVS\n",file=pf) 360 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$MANAGEMENT), 361 | " ",sprintf("%5s",in_data$sim_ctrl$PLANT)," ",sprintf("%5s",in_data$sim_ctrl$IRRIG), 362 | " ",sprintf("%5s",in_data$sim_ctrl$FERTI)," ",sprintf("%5s",in_data$sim_ctrl$RESID), 363 | " ",sprintf("%5s",in_data$sim_ctrl$HARVS),"\n",sep=""),file=pf) 364 | cat("@N OUTPUTS FNAME OVVEW SUMRY FROPT GROUT CAOUT WAOUT NIOUT MIOUT DIOUT VBOSE CHOUT OPOUT\n",file=pf) 365 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$OUTPUTS), 366 | " ",sprintf("%5s",in_data$sim_ctrl$FNAME)," ",sprintf("%5s",in_data$sim_ctrl$OVVEW), 367 | " ",sprintf("%5s",in_data$sim_ctrl$SUMRY)," ",sprintf("%5s",in_data$sim_ctrl$FROPT), 368 | " ",sprintf("%5s",in_data$sim_ctrl$GROUT)," ",sprintf("%5s",in_data$sim_ctrl$CAOUT), 369 | " ",sprintf("%5s",in_data$sim_ctrl$WAOUT)," ",sprintf("%5s",in_data$sim_ctrl$NIOUT), 370 | " ",sprintf("%5s",in_data$sim_ctrl$MIOUT)," ",sprintf("%5s",in_data$sim_ctrl$DIOUT), 371 | " ",sprintf("%5s",in_data$sim_ctrl$VBOSE)," ",sprintf("%5s",in_data$sim_ctrl$CHOUT), 372 | " ",sprintf("%5s",in_data$sim_ctrl$OPOUT),"\n",sep=""),file=pf) 373 | cat("\n", file = pf) 374 | 375 | #automatic management 376 | cat("@ AUTOMATIC MANAGEMENT\n", file = pf) 377 | cat("@N PLANTING PFRST PLAST PH2OL PH2OU PH2OD PSTMX PSTMN\n", file = pf) 378 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$PLANTING), 379 | " ",sprintf("%5s",in_data$auto_mgmt$PFRST)," ",sprintf("%5s",in_data$auto_mgmt$PLAST), 380 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OL))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OU)), 381 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OD))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$PSTMX)), 382 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PSTMN)),"\n",sep=""),file=pf) 383 | cat("@N IRRIGATION IMDEP ITHRL ITHRU IROFF IMETH IRAMT IREFF\n",file=pf) 384 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$IRRIGATION), 385 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$IMDEP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$ITHRL)), 386 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$ITHRU))," ",sprintf("%5s",in_data$auto_mgmt$IROFF), 387 | " ",sprintf("%5s",in_data$auto_mgmt$IMETH)," ",sprintf("%5d",as.integer(in_data$auto_mgmt$IRAMT)), 388 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$IREFF)),"\n",sep=""),file=pf) 389 | cat("@N NITROGEN NMDEP NMTHR NAMNT NCODE NAOFF\n",file=pf) 390 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$NITROGEN), 391 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$NMDEP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$NMTHR)), 392 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$NAMNT))," ",sprintf("%5s",in_data$auto_mgmt$NCODE), 393 | " ",sprintf("%5s",in_data$auto_mgmt$NAOFF),"\n",sep=""),file=pf) 394 | cat("@N RESIDUES RIPCN RTIME RIDEP\n",file=pf) 395 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$RESIDUES), 396 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$RIPCN))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$RTIME)), 397 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$RIDEP)),"\n",sep=""),file=pf) 398 | cat("@N HARVEST HFRST HLAST HPCNP HPCNR\n",file=pf) 399 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$HARVEST), 400 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$HFRST))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$HLAST)), 401 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$HPCNP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$HPCNR)), 402 | "\n",sep=""),file=pf) 403 | 404 | #close file 405 | close(pf) 406 | 407 | #output 408 | return(out_file) 409 | } 410 | make_xfile(in_data, out_file = information$name, overwrite = T) 411 | } 412 | -------------------------------------------------------------------------------- /make_xfile.R: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | ############################### Make Xfile ################################### 3 | ############################################################################## 4 | 5 | # source("/home/jeisonmesa/Proyectos/BID/DSSAT-R/main_functions.R") 6 | # 7 | # # to test 8 | # # carpeta donde se encuentra la informacion necesaria para correr 9 | # path <- "/home/jeisonmesa/Proyectos/BID/bid-cc-agricultural-sector/08-Cells_toRun/matrices_cultivo/" 10 | # 11 | # # Cargar data frame entradas para DSSAT 12 | # 13 | # load(paste0(path, "Rice_riego.Rdat")) 14 | # load(paste0(path, "Rice_secano.Rdat")) 15 | # 16 | # # Separacion Aplicacion de Nitrogeno 17 | # # Cambiar crop_riego o crop_secano 18 | # 19 | # day0 <- crop_riego$N.app.0d 20 | # day_aplication0 <- rep(0, length(day0)) 21 | # 22 | # day30 <- crop_riego$N.app.30d 23 | # day_aplication30 <- rep(30, length(day30)) 24 | # 25 | # amount <- data.frame(day0, day30) 26 | # day_app <- data.frame(day_aplication0, day_aplication30) 27 | # 28 | # 29 | # # Multiple Experiments 30 | # years <- 68:94 ## Coincide con los años bisiestos a futuro 31 | # ## año <- c(68:94) 32 | # data_xfile <- list() 33 | # data_xfile$crop <- "RICE" 34 | # data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ RICE LAC" 35 | # data_xfile$name <- "./JBID.RIX" 36 | # data_xfile$CR <- "RI" 37 | # data_xfile$INGENO <- "IB0118" 38 | # data_xfile$CNAME <- "IRNA" 39 | # data_xfile$initation <- crop_riego$mirca.start 40 | # data_xfile$final <- crop_riego$mirca.end 41 | # data_xfile$system <- "irrigation" ## Irrigation or rainfed, if is irrigation then automatic irrigation 42 | # data_xfile$year <- years[1] 43 | # data_xfile$nitrogen_aplication <- list(amount = amount, day_app = day_app) 44 | # data_xfile$smodel <- "RIXCER" ## Fin Model 45 | # data_xfile$bname <- "DSSBatch.v45" 46 | 47 | # 48 | 49 | ## Separacion Aplicacion de Nitrogeno 50 | ## Cambiar crop_riego o crop_secano 51 | 52 | # day0 <- crop_secano$N.app.0d 53 | # day_aplication0 <- rep(0, length(day0)) 54 | # 55 | # day30 <- crop_secano$N.app.30d 56 | # day_aplication30 <- rep(30, length(day30)) 57 | # 58 | # mount <- data.frame(day0, day30) 59 | # day_app <- data.frame(day_aplication0, day_aplication30) 60 | 61 | 62 | 63 | ## Multiple Experiments 64 | # years <- 71:99 65 | # pixel <- 1 66 | # data_xfile <- list() 67 | # data_xfile$exp_details <- "*EXP.DETAILS: BID17101RZ RICE LAC" 68 | # data_xfile$name <- "./JBID_dryland.RIX" 69 | # data_xfile$CR <- "RI" 70 | # data_xfile$INGENO <- "IB0118" 71 | # data_xfile$CNAME <- "IRNA" 72 | # data_xfile$initation <- crop_secano$mirca.start[pixel] 73 | # data_xfile$final <- crop_secano$mirca.end[pixel] 74 | # data_xfile$system <- "rainfed" ## Irrigation or rainfed, if is irrigation then automatic irrigation 75 | # data_xfile$year <- years[1] 76 | # data_xfile$nitrogen_aplication <- list(mount = mount[pixel, ], day_app = day_app[pixel, ]) 77 | # data_xfile$smodel <- "RIXCER" ## Fin Model 78 | # Xfile(data_xfile, 1) 79 | 80 | 81 | # information <- data_xfile ## Only used for testing 82 | 83 | 84 | Xfile <- function(information, pixel, in_conditions, initial) { 85 | 86 | 87 | 88 | PPOP <- information$PPOP 89 | PPOE <- information$PPOE 90 | PLME <- paste(information$PLME) 91 | PLDS <- paste(information$PLDS) 92 | PLRD <- information$PLRD 93 | PLDP <- information$PLDP 94 | 95 | information$initation <- information$initation[pixel] 96 | #information$final <- crop_riego$mirca.end[pixel] 97 | information$nitrogen_aplication <- list(amount = amount[pixel, ], day_app = day_app[pixel, ]) 98 | 99 | # if(information$initation > information$final){ 100 | # information$final <- 365 101 | # } 102 | 103 | 104 | #midpoint_window <- round(mean(c(information$initation, information$final))) ## Midpoint planting window 105 | 106 | if( information$system == "irrigation" ){ 107 | 108 | 109 | 110 | 111 | # Initial Conditions 112 | if(information$crop == "RICE"){ 113 | SNH4 <- c(4, 4, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 114 | SNO3 <- c(0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1, 0.1, 0.1) 115 | 116 | } else{ 117 | SNH4 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 118 | SNO3 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 119 | 120 | } 121 | 122 | 123 | # pdate <- convert_date(pmax(midpoint_window, 0), information$year) ## Planting date 124 | IC <- 1 125 | pdate <- convert_date(information$initation, information$year) ## Planting date 126 | # sdate <- convert_date(pmax(information$initation - 60, 0), information$year) ## Simulation Start 127 | # sdate <- convert_date(information$initation - 30, information$year) ## Simulation Start 128 | sdate <- pdate 129 | A <- "PL" ## label name 130 | first <- -99 ## Start planting window 131 | last <- -99 ## End planting window 132 | IRR <- "A" ## Automatic irrigation 133 | plant <- "R" ## On reported date 134 | 135 | } 136 | 137 | #SNH4 <- c(10, 10, 0, 0, 0, 0, 0, 0, 0) 138 | #SNO3 <- c(5, 2, 0, 0, 0, 0, 0, 0, 0) 139 | 140 | if( information$system == "rainfed" ) { 141 | 142 | 143 | # SNH4 <- c(1.1, 1.1, 0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1) 144 | # SNO3 <- c(0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1) 145 | 146 | # SNH4 <- c(10, 10, 0, 0, 0, 0, 0, 0, 0) 147 | # SNO3 <- c(5, 2, 0, 0, 0, 0, 0, 0, 0) 148 | 149 | 150 | # Initial Conditions 13 July in the morning (2015) 151 | 152 | # SNH4 <- c(4, 4, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 153 | # SNO3 <- c(0.7, 0.7, 0.5, 0.3, 0.1, 0.1, 0.1, 0.1, 0.1) 154 | 155 | # Initial Conditions 13 July in the afternoun (2015) 156 | 157 | SNH4 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 158 | SNO3 <- c(3, 3, 2, 1, 0.1, 0.1, 0.1, 0.1, 0.1) 159 | 160 | IC <- 1 161 | first <- information$initation ## First Window 162 | #last <- information$initation + 60 ## Last Window 163 | sdate <- convert_date(first - 15, information$year) ## Simulation Start 164 | pdate <- -99 ## Planting date (you will take the planting window data mirca 2000) 165 | A <- "PL" ## Label Name 166 | IRR <- "N" ## No irrigation (rainfed) 167 | plant <-"A" ## Automatic planting seed given window 168 | ### Reconvertir first para que corra con dia de simulacion un año antes 169 | #first <- convert_date(information$initation , information$year) 170 | last <- convert_date(information$initation + 60, information$year) 171 | 172 | } 173 | 174 | 175 | ## Defining the Experiment 176 | in_data <- list() 177 | 178 | 179 | ## General data of the Experiment 180 | 181 | in_data$general <- list(PEOPLE = "Diego Obando Jeison Mesa", ADDRESS = "CIAT", SITE = "CALI") 182 | 183 | 184 | ## Definition simulate treatment 185 | in_data$treatments <- data.frame(N = 1, R = 1, O = 1, C = 0, TNAME = "BID001", CU = 1, FL = 1, SA = 0, IC = IC, MP = 1, 186 | MI = 0, MF = 1, MR = 0, MC = 0, MT = 0, ME = 0, MH = 0, SM = 1) 187 | 188 | ## Definition simulate cultivar 189 | 190 | in_data$cultivars <- data.frame(C = 1, CR = information$CR, INGENO = information$INGENO[pixel], CNAME = information$CNAME) 191 | 192 | ## Field 193 | 194 | in_data$fields <- data.frame(L = 1, ID_FIELD = "BID1", WSTA = "JBID", FLSA=-99, FLOB = -99, FLDT = "DR000", 195 | FLDD = -99, FLDS = -99, FLST = -99, SLTX = -99, SLDP = -99, ID_SOIL="BID0000001", 196 | FLNAME = "FIELD01", XCRD = -99, YCRD = -99, ELEV = -99, AREA = -99, SLEN=-99, 197 | FLWR = -99, SLAS = -99, FLHST = -99, FHDUR=-99) 198 | 199 | ## initial conditions of the experiment 200 | ## Aqui investigar acerca de ICDAT 201 | ## Segun el manual Initial Conditions Measurement date, year + days 202 | in_data$ini_cond_properties <- data.frame(C = 1, PCR = information$CR, ICDAT = "50001", ICRT = -99, ICND = -99, ICRN = -99, ICRE = -99, 203 | ICWD = -99, ICRES = -99, ICREN = -99, ICREP = -99, ICRIP = -99, ICRID = -99, 204 | ICNAME = "inicond1") 205 | 206 | #in_data$ini_cond_profile <- data.frame(C=rep(1,5),ICBL=rep(-99,5),SH2O=rep(-99,5),SNH4=rep(-99,5), 207 | # SNO3=rep(-99,5)) 208 | 209 | 210 | ## Planting Details 211 | in_data$planting <- data.frame( P = 1, PDATE = pdate, EDATE = -99, PPOP, PPOE, PLME, 212 | PLDS, PLRS = -99, PLRD, PLDP, 213 | PLWT = -99, PAGE = -99, PENV = -99, PLPH = -99, SPRL = -99) 214 | 215 | ## Simulation Control 216 | in_data$sim_ctrl <- data.frame(N = 1, GENERAL = "GE", NYERS = 25, NREPS = 1, START = "S", SDATE = sdate, 217 | RSEED=2150, SNAME = "simctr1", SMODEL = paste(information$smodel), 218 | OPTIONS = "OP", WATER = "Y", NITRO = "Y", SYMBI = "N", 219 | PHOSP = "N", POTAS = "N", DISES = "N", CHEM = "N", TILL = "N", 220 | CO2 = "D", METHODS = "ME", WTHER = "M", INCON = "M", LIGHT = "E", 221 | EVAPO = "R", INFIL = "S", PHOTO = "C", HYDRO = "R", 222 | NSWIT = 1, MESOM = "G", MESEV = "S", MESOL =2, MANAGEMENT = "MA", 223 | PLANT = plant, IRRIG = IRR, 224 | FERTI = "D", RESID = "R", HARVS = "M", OUTPUTS = "OU", FNAME = "N", 225 | OVVEW = "Y", SUMRY = "Y", FROPT = 1, GROUT = "Y", CAOUT = "Y", 226 | WAOUT = "Y", NIOUT = "Y", MIOUT = "Y", 227 | DIOUT = "Y", VBOSE = "Y", CHOUT = "Y", OPOUT = "Y") 228 | 229 | ## AUTOMATIC MANAGEMENT 230 | 231 | in_data$auto_mgmt <- data.frame(N = 1, PLANTING = A, PFRST = first, PLAST = last, PH2OL = 50, PH2OU= 100, 232 | PH2OD = 30, PSTMX = 40, PSTMN = 10, IRRIGATION = "IR", IMDEP=30, ITHRL = 50, 233 | ITHRU =100, IROFF = "GS000", IMETH = "IR001", IRAMT = 10, IREFF = 1, 234 | NITROGEN = "NI", NMDEP = 30, NMTHR = 50, NAMNT = 25, NCODE = "FE001", 235 | NAOFF = "GS000", RESIDUES = "RE", RIPCN = 100, RTIME = 1, RIDEP = 20, 236 | HARVEST = "HA", HFRST = 0, HLAST = 00001, HPCNP = 100, HPCNR = 0) 237 | 238 | 239 | # Make Xfile 240 | 241 | ## test 242 | ## out_file <- "./JBID.RIX" 243 | # overwrite <- F 244 | 245 | make_xfile <- function(in_data, out_file, overwrite = F) { 246 | #open file in write mode 247 | if (file.exists(out_file)) { 248 | if (overwrite) { 249 | pf <- file(out_file, open = "w") 250 | } else { 251 | rnum <- round(runif(1, 10000, 20000), 0) 252 | tmpvar <- unlist(strsplit(out_file, "/", fixed = T)) 253 | pth_ref <- paste(tmpvar[1:(length(tmpvar) - 1)], collapse = "/") 254 | out_file <- paste(pth_ref, "/copy-", rnum, "_", tmpvar[length(tmpvar)], sep = "") 255 | pf <- file(out_file, open = "w") 256 | } 257 | } else { 258 | pf <- file(out_file,open="w") 259 | } 260 | 261 | #write header and stuff 262 | #pf <- file(out_file,open="w") 263 | cat(paste0(information$exp_details, "\n"), file = pf) 264 | cat("\n",file = pf) 265 | 266 | #general stuff 267 | cat("*GENERAL\n@PEOPLE\n", file = pf) 268 | cat(paste(sprintf("%-12s", as.character(in_data$general$PEOPLE)), "\n", sep = ""), file = pf) 269 | cat("@ADDRESS\n", file = pf) 270 | cat(paste(sprintf("%-12s", as.character(in_data$general$ADDRESS)), "\n", sep = ""), file = pf) 271 | cat("@SITE\n", file = pf) 272 | cat(paste(sprintf("%-12s", as.character(in_data$general$SITE)), "\n", sep = ""), file = pf) 273 | 274 | #treatments 275 | cat("*TREATMENTS -------------FACTOR LEVELS------------\n", file = pf) 276 | cat("@N R O C TNAME.................... CU FL SA IC MP MI MF MR MC MT ME MH SM\n", file = pf) 277 | for (i in 1:nrow(in_data$treatments)) { 278 | cat(paste(sprintf("%1$2d%2$2d%3$2d%4$2d",as.integer(in_data$treatments$N[i]),as.integer(in_data$treatments$R[i]), 279 | as.integer(in_data$treatments$O[i]),as.integer(in_data$treatments$C[i])), 280 | " ",sprintf("%1$-25s%2$3d%3$3d%4$3d%5$3d%6$3d%7$3d%8$3d%9$3d%10$3d%11$3d%12$3d%13$3d%14$3d",in_data$treatments$TNAME[i], 281 | as.integer(in_data$treatments$CU[i]),as.integer(in_data$treatments$FL[i]),as.integer(in_data$treatments$SA[i]), 282 | as.integer(in_data$treatments$IC[i]),as.integer(in_data$treatments$MP[i]),as.integer(in_data$treatments$MI[i]), 283 | as.integer(in_data$treatments$MF[i]),as.integer(in_data$treatments$MR[i]),as.integer(in_data$treatments$MC[i]), 284 | as.integer(in_data$treatments$MT[i]),as.integer(in_data$treatments$ME[i]),as.integer(in_data$treatments$MH[i]), 285 | as.integer(in_data$treatments$SM[i])), 286 | "\n", sep = ""), file = pf) 287 | } 288 | cat("\n", file = pf) 289 | 290 | #cultivars 291 | cat("*CULTIVARS\n", file = pf) 292 | cat("@C CR INGENO CNAME\n", file = pf) 293 | for (i in 1:nrow(in_data$cultivars)) { 294 | cat(paste(sprintf("%2d",as.integer(in_data$cultivars$C[i]))," ",sprintf("%2s", in_data$cultivars$CR[i]), 295 | " ", sprintf("%6s",in_data$cultivars$INGENO[i])," ",sprintf("%-12s",in_data$cultivars$CNAME[i]), 296 | "\n", sep = ""), file = pf) 297 | } 298 | cat("\n", file = pf) 299 | 300 | #fields 301 | cat("*FIELDS\n", file = pf) 302 | cat("@L ID_FIELD WSTA.... FLSA FLOB FLDT FLDD FLDS FLST SLTX SLDP ID_SOIL FLNAME\n", file = pf) 303 | cat(paste(sprintf("%2d",as.integer(in_data$fields$L))," ",sprintf("%-8s",in_data$fields$ID_FIELD), 304 | " ",sprintf("%-8s",in_data$fields$WSTA),sprintf("%6d",as.integer(in_data$fields$FLSA)), 305 | sprintf("%6d",as.integer(in_data$fields$FLOB)),sprintf("%6s",in_data$fields$FLDT), 306 | sprintf("%6d",as.integer(in_data$fields$FLDD)),sprintf("%6s",as.integer(in_data$fields$FLDS)), 307 | sprintf("%6d",as.integer(in_data$fields$FLST))," ",sprintf("%-4d",as.integer(in_data$fields$SLTX)), 308 | sprintf("%6d",as.integer(in_data$fields$SLDP))," ",sprintf("%-10s",in_data$fields$ID_SOIL)," ", 309 | sprintf("%-12s",in_data$fields$FLNAME),"\n",sep=""),file=pf) 310 | cat("@L ..........XCRD ...........YCRD .....ELEV .............AREA .SLEN .FLWR .SLAS FLHST FHDUR\n",file=pf) 311 | cat(paste(sprintf("%2d",as.integer(in_data$fields$L))," ",sprintf("%15.3f",in_data$fields$XCRD)," ", 312 | sprintf("%15.3f",in_data$fields$YCRD)," ",sprintf("%9d",as.integer(in_data$fields$ELEV))," ", 313 | sprintf("%17d",as.integer(in_data$fields$AREA))," ",sprintf("%5d",as.integer(in_data$fields$SLEN))," ", 314 | sprintf("%5d",as.integer(in_data$fields$FLWR))," ",sprintf("%5d",as.integer(in_data$fields$SLAS))," ", 315 | sprintf("%5d",as.integer(in_data$fields$FLHST))," ",sprintf("%5d",as.integer(in_data$fields$FHDUR)), 316 | "\n",sep=""),file=pf) 317 | cat("\n",file=pf) 318 | 319 | #initial conditions 320 | #cat("*INITIAL CONDITIONS\n",file=pf) 321 | #cat("@C PCR ICDAT ICRT ICND ICRN ICRE ICWD ICRES ICREN ICREP ICRIP ICRID ICNAME\n",file=pf) 322 | #cat(paste(sprintf("%2d",as.integer(in_data$ini_cond_properties$C))," ",sprintf("%5s",in_data$ini_cond_properties$PCR), 323 | # " ",sprintf("%5s",in_data$ini_cond_properties$ICDAT)," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRT)), 324 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICND))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRN)), 325 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRE))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICWD)), 326 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRES))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICREN)), 327 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICREP))," ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRIP)), 328 | # " ",sprintf("%5d",as.integer(in_data$ini_cond_properties$ICRID))," ",sprintf("%-12s",in_data$ini_cond_properties$ICNAME), 329 | # "\n",sep=""),file=pf) 330 | #cat("@C ICBL SH2O SNH4 SNO3\n",file=pf) 331 | #for (i in 1:nrow(in_data$ini_cond_profile)) { 332 | # cat(paste(sprintf("%2d",as.integer(in_data$ini_cond_properties$C))," ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$ICBL[i])), 333 | # " ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SH2O[i]))," ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SNH4[i])), 334 | # " ",sprintf("%5.0f",as.integer(in_data$ini_cond_profile$SNO3[i])),"\n",sep=""),file=pf) 335 | #} 336 | #cat("\n",file=pf) 337 | 338 | # Initial Conditions 339 | if(exists("in_conditions") & initial == T) { 340 | 341 | cat("*INITIAL CONDITIONS\n", file = pf) 342 | cat("@C PCR ICDAT ICRT ICND ICRN ICRE ICWD ICRES ICREN ICREP ICRIP ICRID ICNAME\n", file = pf) 343 | cat(sprintf("%2d %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %5s %2s", 1, "MZ", sdate, 1, -99, 1, 1, -99, -99, -99, -99, -99, -99, -99), "\n", file = pf) 344 | 345 | cat("@C ICBL SH2O SNH4 SNO3\n", file = pf) 346 | for(i in 1:dim(in_conditions)[1]){ 347 | 348 | if(information$system == "rainfed"){ 349 | cat(paste(sprintf("%2d %5d %5.2f %5.2f %5.2f", 1, in_conditions[i, 1], in_conditions[i, 2], SNH4[i], SNO3[i])), "\n", file = pf) 350 | } 351 | 352 | if(information$system == "irrigation"){ 353 | cat(paste(sprintf("%2d %5d %5.0f %5.2f %5.2f", 1, in_conditions[i, 1], in_conditions[i, 2], SNH4[i], SNO3[i])), "\n", file = pf) 354 | } 355 | 356 | 357 | } 358 | 359 | 360 | } 361 | 362 | cat("\n", file = pf) 363 | #planting details 364 | cat("*PLANTING DETAILS\n",file = pf) 365 | cat("@P PDATE EDATE PPOP PPOE PLME PLDS PLRS PLRD PLDP PLWT PAGE PENV PLPH SPRL PLNAME\n",file=pf) 366 | cat(paste(sprintf("%2d",as.integer(in_data$planting$P))," ",sprintf("%5s",in_data$planting$PDATE), 367 | " ",sprintf("%5s",in_data$planting$EDATE)," ",sprintf("%5d",as.integer(in_data$planting$PPOP)), 368 | " ",sprintf("%5d",as.integer(in_data$planting$PPOE))," ",sprintf("%5s",in_data$planting$PLME), 369 | " ",sprintf("%5s",in_data$planting$PLDS)," ",sprintf("%5d",as.integer(in_data$planting$PLRS)), 370 | " ",sprintf("%5d",as.integer(in_data$planting$PLRD))," ",sprintf("%5d",as.integer(in_data$planting$PLDP)), 371 | " ",sprintf("%5d",as.integer(in_data$planting$PLWT))," ",sprintf("%5d",as.integer(in_data$planting$PAGE)), 372 | " ",sprintf("%5d",as.integer(in_data$planting$PENV))," ",sprintf("%5d",as.integer(in_data$planting$PLPH)), 373 | " ",sprintf("%5d",as.integer(in_data$planting$SPRL))," ",sprintf("%29s",in_data$planting$PLNAME), 374 | "\n", sep = ""), file = pf) 375 | cat("\n", file = pf) 376 | 377 | ## Details Fertilization 378 | cat("*FERTILIZERS (INORGANIC)\n", file = pf) 379 | cat("@F FDATE FMCD FACD FDEP FAMN FAMP FAMK FAMC FAMO FOCD FERNAME \n", file = pf) 380 | for(i in 1:dim(information$nitrogen_aplication$amount)[2]){ 381 | if(!is.na(information$nitrogen_aplication$amount[, i])) { 382 | 383 | 384 | if(i == 1){ 385 | 386 | cat(sprintf("%2s %5s %4s %5s %5i %5.1f %5i %5i %5i %5i %5i %1i", 1, information$nitrogen_aplication$day_app[, i], "FE005", "AP002", 387 | 4, information$nitrogen_aplication$amount[, i], 0, -99, -99, -99, -99, -99), "\n", file = pf) 388 | 389 | } else{ 390 | cat(sprintf("%2s %5s %4s %5s %5i %5.1f %5i %5i %5i %5i %5i %1i", 1, information$nitrogen_aplication$day_app[, i], "FE005", "AP002", 391 | 0, information$nitrogen_aplication$amount[, i], 0, -99, -99, -99, -99, -99), "\n", file = pf) 392 | } 393 | 394 | } 395 | 396 | } 397 | cat("\n", file = pf) 398 | 399 | #simulation controls 400 | cat("*SIMULATION CONTROLS\n", file = pf) 401 | cat("@N GENERAL NYERS NREPS START SDATE RSEED SNAME.................... SMODEL\n", file = pf) 402 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$GENERAL), 403 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$NYERS))," ",sprintf("%5d",as.integer(in_data$sim_ctrl$NREPS)), 404 | " ",sprintf("%5s",in_data$sim_ctrl$START)," ",sprintf("%5s",in_data$sim_ctrl$SDATE), 405 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$RSEED))," ",sprintf("%-25s",in_data$sim_ctrl$SNAME), 406 | " ",sprintf("%-6s",in_data$sim_ctrl$SMODEL),"\n",sep=""),file=pf) 407 | cat("@N OPTIONS WATER NITRO SYMBI PHOSP POTAS DISES CHEM TILL CO2\n",file=pf) 408 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$OPTIONS), 409 | " ",sprintf("%5s",in_data$sim_ctrl$WATER)," ",sprintf("%5s",in_data$sim_ctrl$NITRO), 410 | " ",sprintf("%5s",in_data$sim_ctrl$SYMBI)," ",sprintf("%5s",in_data$sim_ctrl$PHOSP), 411 | " ",sprintf("%5s",in_data$sim_ctrl$POTAS)," ",sprintf("%5s",in_data$sim_ctrl$DISES), 412 | " ",sprintf("%5s",in_data$sim_ctrl$CHEM)," ",sprintf("%5s",in_data$sim_ctrl$TILL), 413 | " ",sprintf("%5s",in_data$sim_ctrl$CO2),"\n",sep=""),file=pf) 414 | cat("@N METHODS WTHER INCON LIGHT EVAPO INFIL PHOTO HYDRO NSWIT MESOM MESEV MESOL\n",file=pf) 415 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$METHODS), 416 | " ",sprintf("%5s",in_data$sim_ctrl$WTHER)," ",sprintf("%5s",in_data$sim_ctrl$INCON), 417 | " ",sprintf("%5s",in_data$sim_ctrl$LIGHT)," ",sprintf("%5s",in_data$sim_ctrl$EVAPO), 418 | " ",sprintf("%5s",in_data$sim_ctrl$INFIL)," ",sprintf("%5s",in_data$sim_ctrl$PHOTO), 419 | " ",sprintf("%5s",in_data$sim_ctrl$HYDRO)," ",sprintf("%5d",as.integer(in_data$sim_ctrl$NSWIT)), 420 | " ",sprintf("%5s",in_data$sim_ctrl$MESOM)," ",sprintf("%5s",in_data$sim_ctrl$MESEV), 421 | " ",sprintf("%5d",as.integer(in_data$sim_ctrl$MESOL)),"\n",sep=""),file=pf) 422 | cat("@N MANAGEMENT PLANT IRRIG FERTI RESID HARVS\n",file=pf) 423 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$MANAGEMENT), 424 | " ",sprintf("%5s",in_data$sim_ctrl$PLANT)," ",sprintf("%5s",in_data$sim_ctrl$IRRIG), 425 | " ",sprintf("%5s",in_data$sim_ctrl$FERTI)," ",sprintf("%5s",in_data$sim_ctrl$RESID), 426 | " ",sprintf("%5s",in_data$sim_ctrl$HARVS),"\n",sep=""),file=pf) 427 | cat("@N OUTPUTS FNAME OVVEW SUMRY FROPT GROUT CAOUT WAOUT NIOUT MIOUT DIOUT VBOSE CHOUT OPOUT\n",file=pf) 428 | cat(paste(sprintf("%2d",as.integer(in_data$sim_ctrl$N))," ",sprintf("%-11s",in_data$sim_ctrl$OUTPUTS), 429 | " ",sprintf("%5s",in_data$sim_ctrl$FNAME)," ",sprintf("%5s",in_data$sim_ctrl$OVVEW), 430 | " ",sprintf("%5s",in_data$sim_ctrl$SUMRY)," ",sprintf("%5s",in_data$sim_ctrl$FROPT), 431 | " ",sprintf("%5s",in_data$sim_ctrl$GROUT)," ",sprintf("%5s",in_data$sim_ctrl$CAOUT), 432 | " ",sprintf("%5s",in_data$sim_ctrl$WAOUT)," ",sprintf("%5s",in_data$sim_ctrl$NIOUT), 433 | " ",sprintf("%5s",in_data$sim_ctrl$MIOUT)," ",sprintf("%5s",in_data$sim_ctrl$DIOUT), 434 | " ",sprintf("%5s",in_data$sim_ctrl$VBOSE)," ",sprintf("%5s",in_data$sim_ctrl$CHOUT), 435 | " ",sprintf("%5s",in_data$sim_ctrl$OPOUT),"\n",sep=""),file=pf) 436 | cat("\n", file = pf) 437 | 438 | #automatic management 439 | cat("@ AUTOMATIC MANAGEMENT\n", file = pf) 440 | cat("@N PLANTING PFRST PLAST PH2OL PH2OU PH2OD PSTMX PSTMN\n", file = pf) 441 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$PLANTING), 442 | " ",sprintf("%5s",in_data$auto_mgmt$PFRST)," ",sprintf("%5s",in_data$auto_mgmt$PLAST), 443 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OL))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OU)), 444 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PH2OD))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$PSTMX)), 445 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$PSTMN)),"\n",sep=""),file=pf) 446 | cat("@N IRRIGATION IMDEP ITHRL ITHRU IROFF IMETH IRAMT IREFF\n",file=pf) 447 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$IRRIGATION), 448 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$IMDEP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$ITHRL)), 449 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$ITHRU))," ",sprintf("%5s",in_data$auto_mgmt$IROFF), 450 | " ",sprintf("%5s",in_data$auto_mgmt$IMETH)," ",sprintf("%5d",as.integer(in_data$auto_mgmt$IRAMT)), 451 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$IREFF)),"\n",sep=""),file=pf) 452 | cat("@N NITROGEN NMDEP NMTHR NAMNT NCODE NAOFF\n",file=pf) 453 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$NITROGEN), 454 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$NMDEP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$NMTHR)), 455 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$NAMNT))," ",sprintf("%5s",in_data$auto_mgmt$NCODE), 456 | " ",sprintf("%5s",in_data$auto_mgmt$NAOFF),"\n",sep=""),file=pf) 457 | cat("@N RESIDUES RIPCN RTIME RIDEP\n",file=pf) 458 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$RESIDUES), 459 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$RIPCN))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$RTIME)), 460 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$RIDEP)),"\n",sep=""),file=pf) 461 | cat("@N HARVEST HFRST HLAST HPCNP HPCNR\n",file=pf) 462 | cat(paste(sprintf("%2d",as.integer(in_data$auto_mgmt$N))," ",sprintf("%-11s",in_data$auto_mgmt$HARVEST), 463 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$HFRST))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$HLAST)), 464 | " ",sprintf("%5d",as.integer(in_data$auto_mgmt$HPCNP))," ",sprintf("%5d",as.integer(in_data$auto_mgmt$HPCNR)), 465 | "\n",sep=""),file=pf) 466 | 467 | #close file 468 | close(pf) 469 | 470 | #output 471 | return(out_file) 472 | } 473 | make_xfile(in_data, out_file = information$name, overwrite = T) 474 | } 475 | ## test 476 | ## make_xfile(in_data, out_file= "./JBID.RIX", overwrite=T) Example Xfile Rice 477 | --------------------------------------------------------------------------------