R/getgmisdataseries.R

#' This function downloads a time series of a variable from GMIS for a period of time on a spatial area
#' using the wcs-t service
#'
#' @param name A character vector of the shortname of the variable
#' @param resolution A character vector giving the spatial resolution of the data: "4km" or "9km"
#' @param startdate A character vector of the month who begins the series("YYYY-MM")
#' @param enddate A character vector of the month who ends the series("YYYY-MM")
#' @param xmin A numeric vector of the lower longitude of the spatial area
#' @param xmax A numeric vector of the max longitude of the spatial area
#' @param ymin A numeric vector of the lower latitude of the spatial area
#' @param ymax A numeric vector of the max latitude of the spatial area
#' 
#' @export
#' @return A rasterstack object of the variable for the given period
#' @keywords GMIS
#' @keywords wcs-t
#' @examples
#'   \dontrun{
#'      #extraction of the MODIS chlorophyll a concentration for 2008 and 2010 in the vicinity of the Bird Island area (South Africa)
#'      img<-getgmisdataseries("GMIS_A_CHLA","4km","2008-01","2010-12",xmin=26.1,xmax=26.5,ymin=-34,ymax=-33.5)
#'      plot(img)
#'   } 
#'
getgmisdataseries<-function(name="GMIS_A_CHLA",resolution="4km",startdate="2005-09",enddate="2005-10",xmin=15,xmax=20.5,ymin=30,ymax=32.5){

 checkparameter<-data.frame(name=FALSE,resolution=FALSE,startdate=FALSE,enddate=FALSE,bbox=FALSE)
  #check the spatial resolution
  if(resolution%in%c("9km","4km")){
	checkparameter$resolution<-TRUE
   	if(resolution=="4km"){data_gmis<-data_gmis_4km}
   	if(resolution=="9km"){data_gmis<-data_gmis_9km}
   	#check variable name
   	idvar<-grep(name,data_gmis$shortname)
   	if(length(idvar)==0){
    		checkparameter$name<-FALSE
    		print("Variable name do not exist on GMIS")
        }else{
    		checkparameter$name<-TRUE
        }
  }else{
   	print("Spatial resolution should be 9km or 4km")
  }

  #check time format for startdate
  n0<-nchar(startdate)==7
  n1<-substr(startdate,1,1)%in%1:2
  n2<-substr(startdate,2,2)%in%c(9,0)
  n3<-substr(startdate,3,3)%in%0:9
  n4<-substr(startdate,4,4)%in%0:9
  n5<-substr(startdate,5,5)=="-"
  n6<-substr(startdate,6,6)%in%c(0,1)
  n7<-substr(startdate,7,7)%in%0:9
  if(!(n0&n1&n2&n3&n4&n5&n6&n7)){
     checkparameter$startdate<-FALSE
     print("Start date format is not correct (YYYY-MM)")
  }else{
     checkparameter$startdate<-TRUE
  }
  #check time format for enddate
  n0<-nchar(enddate)==7
  n1<-substr(enddate,1,1)%in%1:2
  n2<-substr(enddate,2,2)%in%c(9,0)
  n3<-substr(enddate,3,3)%in%0:9
  n4<-substr(enddate,4,4)%in%0:9
  n5<-substr(enddate,5,5)=="-"
  n6<-substr(enddate,6,6)%in%c(0,1)
  n7<-substr(enddate,7,7)%in%0:9
  if(!(n0&n1&n2&n3&n4&n5&n6&n7)){
     checkparameter$enddate<-FALSE
     print("End date format is not correct (YYYY-MM)")
  }else{
     checkparameter$enddate<-TRUE
  }

  #check bbox format
  n1<-is.numeric(xmin)
  n2<-length(xmin)==1
  n3<-is.numeric(xmax)
  n4<-length(xmax)==1
  n5<-is.numeric(ymin)
  n6<-length(ymin)==1
  n7<-is.numeric(ymax)
  n8<-length(ymax)==1
  n9<-xmin<xmax
  n10<-ymin<ymax
  if(!(n1&n2&n3&n4&n5&n6&n7&n8)){
     checkparameter$bbox<-FALSE
     print("Spatial limits are not correct (1 numeric vector for xmin, xmax, ymin and ymax)")
  }else{
     checkparameter$bbox<-TRUE
  }
  if(!(n9&n10)){
      checkparameter$bbox<-FALSE
      print("Spatial limits are not ordered correctly (xmin<xmax AND ymin<ymax)")
  }
  
  if(apply(checkparameter,1,sum)==5){
     #check date on GMIS time range
     mindate<-strptime(paste(data_gmis$startdate[idvar],"15",sep="-"),"%Y-%m-%d")
     maxdate<-strptime(paste(data_gmis$enddate[idvar],"15",sep="-"),"%Y-%m-%d")
     askedstartdate<-strptime(paste(startdate,"15",sep="-"),"%Y-%m-%d")
     if((mindate<=askedstartdate)&(askedstartdate<=maxdate)){
     	checkparameter$startdate<-TRUE
	}else{
     	checkparameter$startdate<-FALSE
     	print(paste(name,"is not available on GMIS for the",askedstartdate))
     }
     askedenddate<-strptime(paste(enddate,"15",sep="-"),"%Y-%m-%d")
     if((mindate<=askedenddate)&(askedenddate<=maxdate)){
     	checkparameter$enddate<-TRUE
	}else{
     	checkparameter$enddate<-FALSE
     	print(paste(name,"is not available on GMIS for the",askedenddate))
     }
     if((askedenddate>=askedstartdate)){
     	checkparameter$enddate<-TRUE
	}else{
     	checkparameter$enddate<-FALSE
     	print(paste(startdate,"is older than", enddate))
     }
     #check the bounding box
     bboxgmis<-unlist(strsplit(data_gmis$bbox[idvar]," "))
     xmingmis<-as.numeric(bboxgmis[1])
     xmaxgmis<-as.numeric(bboxgmis[3])
     ymingmis<-as.numeric(bboxgmis[2])
     ymaxgmis<-as.numeric(bboxgmis[4])
     n1<-xmingmis<=xmin
     n2<-xmax<=xmaxgmis
     n3<-ymingmis<=ymin
     n4<-ymax<=ymaxgmis
     if(n1&n2&n3&n4){
     	checkparameter$bbox<-TRUE
     }else{
     	checkparameter$bbox<-FALSE
     	print(paste("The selected area is not strickly inside the spatial extent of", name,"in gmis"))
     }
  }

  if(apply(checkparameter,1,sum)==5){
 	# define timeindex"
   	startyear<-as.numeric(substr(startdate,1,4))
   	startmonth<-as.numeric(substr(startdate,6,7))
   	endyear<-as.numeric(substr(enddate,1,4))
   	endmonth<-as.numeric(substr(enddate,6,7))
        if(startyear<endyear){  
 	 timeindex1<-paste(startyear,sprintf("%02d",startmonth:12),sep="-")
 	 timelist<-expand.grid(1:12,(startyear+1):(endyear-1))
	 timeindex2<-paste(timelist[,2],sprintf("%02d",timelist[,1]),sep="-")
 	 timeindex3<-paste(endyear,sprintf("%02d",1:endmonth),sep="-")
  	 if((endyear-startyear)==1){
 	 	timeindex<-c(timeindex1,timeindex3)
         }else{
 	 	timeindex<-c(timeindex1,timeindex2,timeindex3)
         }
        }else{
 	 timeindex<-paste(startyear,sprintf("%02d",startmonth:endmonth),sep="-")
        }
 	# loop on timeindex and create a brick raster object"
         pb<-txtProgressBar(min=0,max=length(timeindex))
	 for(i in 1:length(timeindex)){
  		if(i<=1){
   		imgs<-getgmisdata(name=name,resolution=resolution,date=timeindex[i],xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax)
   		names(imgs)<-timeindex[i]
  		}else{
   		img<-getgmisdata(name=name,resolution=resolution,date=timeindex[i],xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax)
   		names(img)<-timeindex[i]
   		imgs<-stack(imgs,img)
  		}	
         	setTxtProgressBar(pb, i)
 	}
        close(pb)
  	return(imgs)
 }

}
ldbk/EMISR documentation built on May 20, 2019, 11:28 p.m.