DataImport_TutorialExamples.R 2.83 KiB
DataImport_TutorialExamples <- function(DIR_DATA_INPUT,BasinCode,BasinCharactFile,HypsoDataFile){
    ##File_check
    DataImportFile <- paste(DIR_DATA_INPUT,BasinCode,".txt",sep="");
    FileExists <- file.exists(DataImportFile); if(FileExists==FALSE){ print("Error: DataImportFile not found",quote=FALSE); stop("EXECUTION STOPPED",call.=FALSE); }
    ##Object_initialisation
    BasinData <- list();
    BasinData$BasinCode <- BasinCode;
    ##Basin_Name_and_Surf
    Lines <- read.table(file=DataImportFile,skip=1,header=FALSE,nrow=3,sep=";",comment.char="",stringsAsFactors=FALSE);
    Name  <- as.character(Lines[2,2]); Name <- gsub(pattern="^*[ ]",replacement="",Name); Name <- gsub(pattern="[ ]*$",replacement="",Name); # remove leading and trailing white space
    BasinData$BasinName <- Name;
    BasinData$BasinArea_km2 <- as.numeric(Lines[3,2]);
    ##DataSeries
    TAB_DATA <- read.table(file=DataImportFile,sep=";",header=TRUE,comment.char="#",stringsAsFactors=FALSE);
    BasinData$TabDatesT <- as.character(TAB_DATA[,1]);
    BasinData$TabDatesR <- as.POSIXlt(strptime(TAB_DATA[,1],format="%Y%m%d",tz="UTC"));
    BasinData$TabObsQm3s <- TAB_DATA[,2]/1000;    ### observed runoff (in m3/s)
    BasinData$TabObsQmm <-  TAB_DATA[,3];         ### observed runoff (in mm/d)
    BasinData$TabObsP <- TAB_DATA[,4];   ### precipitation (catchment average in mm)
    BasinData$TabObsT <- TAB_DATA[,5];   ### air temp (catchment average in degre C)
    BasinData$TabObsE <- TAB_DATA[,6];   ### potential evap (catchment average in mm/d)
    BasinData$TabObsTmin <- NULL; ### min air temp (catchment average in degre C)
    BasinData$TabObsTmax <- NULL; ### max air temp (catchment average in degre C)
    rm(TAB_DATA); ### memory clear
    ##Missing_values
    BasinData$TabObsQm3s[BasinData$TabObsQm3s<0]  <- NA;
    BasinData$TabObsQmm[BasinData$TabObsQmm<0]    <- NA;
    BasinData$TabObsP[BasinData$TabObsP<0]        <- NA;
    BasinData$TabObsF[BasinData$TabObsF<0]        <- NA;
    BasinData$TabObsT[BasinData$TabObsT<(-100)]   <- NA;
    BasinData$TabObsE[BasinData$TabObsE<0]        <- NA;
    ##Missing_values
    if("TabObsQmm" %in% names(BasinData)){
    if(sd(BasinData$TabObsQmm[!is.na(BasinData$TabObsQmm)])==0){ cat("Error: runoff values are constant \n"); stop("EXECUTION STOPPED",call.=FALSE); } }
  ##Hypso_Curve
    FileExists <- file.exists(HypsoDataFile); if(FileExists==FALSE){ cat("Error: Hypso file not found "); stop("EXECUTION STOPPED",call.=FALSE); }
    TAB_HYPSO <- read.table(file=HypsoDataFile,header=TRUE,stringsAsFactors=FALSE);
    iR <- which(TAB_HYPSO$CODE==BasinData$BasinCode);
    iC <- which(colnames(TAB_HYPSO)=="Zmin"):which(colnames(TAB_HYPSO)=="Zmax");
    BasinData$HypsoData <- as.numeric(TAB_HYPSO[iR,iC]);  ### min, q01, q02, ... , q98, q99, max
    rm(TAB_HYPSO); ### memory clear
  ##END
  return(BasinData);