DataImport_MOPEX_DLY.R 3.79 KiB
DataImport_MOPEX_DLY <- function(DIR_DATA_INPUT,BasinCode,BasinCharactFile,HypsoDataFile){
    ##File_check
    DataImportFile <- paste(DIR_DATA_INPUT,BasinCode,".dly",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_Characteristics
      Bool <- FALSE;
      if(exists("BasinCharactFile")){ FileExists <- file.exists(BasinCharactFile); if(FileExists){ Bool <- TRUE; } }
      if(!Bool){ cat("Warning: BasinCharact file not found \n"); }
      if( Bool){ 
        TAB_CHARACT <- read.csv2(file=BasinCharactFile,header=TRUE,skip=0,stringsAsFactors=FALSE);
        IndBasin <- which(formatC(TAB_CHARACT[,1],format="d",width=8,flag="0")  == BasinCode);
        if(length(IndBasin)!=1){ print("Error: Basin not found in BasinInfoFile",quote=FALSE); stop("EXECUTION STOPPED",call.=FALSE); }
        if(length(IndBasin)==1){ 
        BasinData$StationLong_deg <- as.numeric(TAB_CHARACT[IndBasin, 5]);
        BasinData$StationLat_deg  <- as.numeric(TAB_CHARACT[IndBasin, 6]);
        BasinData$BasinArea_km2   <- as.numeric(TAB_CHARACT[IndBasin,10]);
        BasinData$BasinName       <- TAB_CHARACT[IndBasin,11]; 
                                     for(iChar in 1:nchar(BasinData$BasinName)){
                                       BasinData$BasinName <- gsub(pattern="^* ",replacement="",BasinData$BasinName);
                                       BasinData$BasinName <- gsub(pattern=" *$",replacement="",BasinData$BasinName); }
        rm(TAB_CHARACT); } ### memory clear
    ##DataSeries
    Format <- c("A8","F10.0","F10.0","F10.0","F10.0","F10.0");
    TAB_DATA <- read.fortran(file=DataImportFile,skip=0,header=FALSE,Format);
    TabDatesTxt <- TAB_DATA[,1]; TabDatesTxt <- gsub(pattern=" ",replacement="0",TabDatesTxt);
    BasinData$TabDatesR   <- as.POSIXlt(strptime(TabDatesTxt,format="%Y%m%d",tz="UTC"));
    BasinData$TabObsP     <- as.numeric(TAB_DATA[,2]);
    BasinData$TabObsE0noa <- as.numeric(TAB_DATA[,3]);
    BasinData$TabObsQmm   <- as.numeric(TAB_DATA[,4]);
    BasinData$TabObsTmin  <- as.numeric(TAB_DATA[,6]);
    BasinData$TabObsTmax  <- as.numeric(TAB_DATA[,5]);
    BasinData$TabObsT     <- (BasinData$TabObsTmin+BasinData$TabObsTmax)/2;
    BasinData$TabObsE0oud <- PEdaily_Oudin(BasinData$TabDatesR$yday+1,BasinData$TabObsT,BasinData$StationLat_deg/(180/pi));
    BasinData$TabObsE     <- BasinData$TabObsE0noa;
    rm(TAB_DATA); ### memory clear
    ##Missing_values
    for(iList in 1:length(BasinData)){ if(is.numeric(BasinData[[iList]])){
      if(names(BasinData)[iList] %in% c("TabObsTmin","TabObsT","TabObsTmax")){
        BasinData[[iList]][ BasinData[[iList]]<(-100) ] <- NA; 
      } else {
        BasinData[[iList]][ BasinData[[iList]]<0 ] <- NA; 
    } }
    ##Constant_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
    Bool <- FALSE;
    if(exists("HypsoDataFile")){ FileExists <- file.exists(HypsoDataFile); if(FileExists){ Bool <- TRUE; } }
    if(Bool){
      TAB_HYPSO <- read.csv2(file=HypsoDataFile,header=TRUE,skip=0,stringsAsFactors=FALSE);
71727374757677787980818283848586878889
iR <- which(formatC(TAB_HYPSO$CODE,format="d",width=8,flag="0")==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 } else { cat("Warning: Hypso file not found \n"); } ##END return(BasinData); }