Skip to content
GitLab
Select Git revision
  • 181-simulation-water-losses-on-routed-flows-based-on-gr-groundwater-exchange-function
  • dev default
  • 183-createcaliboptions-crash-when-all-parameters-are-fixed
  • 180-write-a-vignette-with-exemple-of-use-of-runmodel-griwrmoutputsmodel
  • master
  • v0.7.0
  • v0.6.2
  • v0.6.1
  • v0.5.0
  • v0.4.0
  • v0.3.0
Find file BlameHistoryPermalink
DataImport_Irstea2010.R 4.79 KiB
1
2 
DataImport_Irstea2010 <- function(DIR_DATA_INPUT,BasinCode,BasinCharactFile,HypsoDataFile){
3
4
5 
    ##File_check
6 
    DataImportFile <- paste(DIR_DATA_INPUT,BasinCode,"_BV.txt",sep="");
7 
    FileExists <- file.exists(DataImportFile); if(FileExists==FALSE){ print("Error: DataImportFile not found",quote=FALSE); stop("EXECUTION STOPPED",call.=FALSE); }
8
9 
    ##Object_initialisation
10 
    BasinData <- list();
11 
    BasinData$BasinCode <- BasinCode;
12
13
14 
    ##_Basin_Characteristics
15 
      ### BasinData$BasinName     <- as.character(read.csv2(file=DataImportFile,skip=19,nrows=1,header=FALSE,stringsAsFactors=FALSE)[1,1]);
16 
      ### BasinData$BasinArea_km2 <- as.numeric(  read.csv2(file=DataImportFile,skip=24,nrows=1,header=FALSE,stringsAsFactors=FALSE)[1,3]);
17 
      Bool <- FALSE;
18 
      if(exists("BasinCharactFile")){ FileExists <- file.exists(BasinCharactFile); if(FileExists){ Bool <- TRUE; } }
19 
      if(!Bool){ cat("Warning: BasinCharact file not found \n"); }
20 
      if( Bool){
21 
        TAB_CHARACT <- read.csv2(file=BasinCharactFile,header=TRUE,skip=0,stringsAsFactors=FALSE);
22 
        IndBasin <- which(TAB_CHARACT$Code  == BasinCode);
23 
        if(length(IndBasin)!=1){ print("Error: Basin not found in BasinInfoFile",quote=FALSE); stop("EXECUTION STOPPED",call.=FALSE); }
24 
        if(length(IndBasin)==1){
25 
        BasinData$StationX_l2e   <- as.numeric(TAB_CHARACT$iX_CEM[IndBasin]);
26 
        BasinData$StationY_l2e   <- as.numeric(TAB_CHARACT$iY_CEM[IndBasin]);
27 
        BasinData$StationZ_l2e   <- as.numeric(TAB_CHARACT$iZ_CEM[IndBasin]);
28 
        BasinData$BasinArea_km2  <- as.numeric(TAB_CHARACT$S_CEM[IndBasin]);
29 
        BasinData$BasinName      <- TAB_CHARACT$Nom[IndBasin];
30 
                                    for(iChar in 1:nchar(BasinData$BasinName)){
31 
                                      BasinData$BasinName <- gsub(pattern="^* ",replacement="",BasinData$BasinName);
32 
                                      BasinData$BasinName <- gsub(pattern=" *$",replacement="",BasinData$BasinName); }
33 
        rm(TAB_CHARACT); } ### memory clear
34 
        }
35
36
37 
    ##DataSeries
38 
    Format <- c("A8","X1","I8","X1","A5","X1","A7","X1","F5.0","X1","F5.0","X1","F5.0","X1","F5.0","X1","F5.0");
39 
    TAB_DATA <- read.fortran(file=DataImportFile,skip=51,header=FALSE,Format);
40
41 
    BasinData$TabDatesT <- as.character(TAB_DATA[,1]);
42 
    BasinData$TabDatesR <- as.POSIXlt(strptime(TAB_DATA[,1],format="%Y%m%d",tz="UTC"));
43
44 
    BasinData$TabObsQm3s <- TAB_DATA[,2]/1000;         ### observed runoff (in m3/s)
45 
    BasinData$TabObsQmm  <- BasinData$TabObsQm3s*86.4/BasinData$BasinArea_km2;  ### observed runoff (in mm/d)
46
47 
    BasinData$TabObsP <- TAB_DATA[,5];   ### precipitation (catchment average in mm)
48 
    BasinData$TabObsF <- TAB_DATA[,6];   ### solid fraction precipitation
49 
    BasinData$TabObsT <- TAB_DATA[,7];   ### air temp (catchment average in degre C)
50 
    BasinData$TabObsE <- TAB_DATA[,8];   ### potential evap (catchment average in mm/d)
51
52 
    BasinData$TabObsTmin <- NULL; ### min air temp (catchment average in degre C)
53 
    BasinData$TabObsTmax <- NULL; ### max air temp (catchment average in degre C)
54
55 
    # BasinData$TabObsEou <- TAB_DATA[,8];   ### potential evap oudin (catchment average in mm/d)
56 
    # BasinData$TabObsEpm <- TAB_DATA[,9];   ### potential evap penman (catchment average in mm/d)
57
58 
    # BasinData$TabObsFsafran <- TAB_DATA[,6];
59 
    # USACE_Tmin <- -1.0; USACE_Tmax <-  3.0;
60 
    # SolidFraction <- 1- (BasinData$TabObsT - USACE_Tmin)/(USACE_Tmax - USACE_Tmin);
61 
    # SolidFraction[BasinData$TabObsT > USACE_Tmax] <- 0;
62 
    # SolidFraction[BasinData$TabObsT < USACE_Tmin] <- 1;
63 
    # BasinData$TabObsFusace <- SolidFraction;
64
65 
    rm(TAB_DATA); ### memory clear
66
67
68 
    ##Missing_values
69 
    for(iList in 1:length(BasinData)){ if(is.numeric(BasinData[[iList]])){
70 
      if(names(BasinData)[iList] %in% c("TabObsTmin","TabObsT","TabObsTmax")){
7172737475767778798081828384858687888990919293949596979899100101102103104105106
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); 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); }