[Rodbcext-commits] r34 - pkg/geoclimate/R

[noreply at r-forge.r-project.org]

Author: jaunario
Date: 2013-01-17 04:43:57 +0100 (Thu, 17 Jan 2013)
New Revision: 34

Modified:
   pkg/geoclimate/R/trmm.r
Log:
get.trmm returns an empty weather object when download fails (graceful exit)

Modified: pkg/geoclimate/R/trmm.r
===================================================================
--- pkg/geoclimate/R/trmm.r	2012-12-05 02:17:51 UTC (rev 33)
+++ pkg/geoclimate/R/trmm.r	2013-01-17 03:43:57 UTC (rev 34)
@@ -46,29 +46,37 @@
 	} else {
 		rawtrmm <- withRetry(getBinaryURL(prod.ftp),...)
 	}
-	if (class(rawtrmm)=="try-error") stop(rawtrmm)
 	
-	if (class(savepath)=="character" & !file.exists(paste(savepath,fname,sep="/"))) writeBin(rawtrmm, paste(savepath,fname,sep="/"))
-	
-	baseraster <- raster(extent(-180,180,-50,50))
-	res(baseraster) <- 0.25
-	
-	prec <- matrix(readBin(rawtrmm, double(), endian="big", size=4, n=ncell(baseraster)), ncol=ncol(baseraster), nrow=nrow(baseraster), byrow=TRUE)
-	prec[prec==min(prec)] <- NA
-	prec <- prec[nrow(prec):1,]
-	
-	baseraster[] <- prec
-	cell <- 1:ncell(baseraster)
 	wth <- new("weather")
 	wth at stn <- "Tropical Rainfall Measuring Mission"
-    wth at rmk <- prod.ftp
 	wth at lon <- c(-180,180)
 	wth at lat <- c(-50,50)
-	wth at w <- as.data.frame(cell)
-	wth at w$wdate <- as.character(wdate)
-	wth at w$prec <- values(baseraster)
-	rm(baseraster, prec, cell)
-	gc(verbose=FALSE)
+	
+	if (class(rawtrmm)=="try-error") {
+		wth at rmk <- c(prod.ftp,rawtrmm)
+		wth at w <- data.frame(cell=numeric(0), wdate=character(0), prec=numeric(0), stringsAsFactors=FALSE)
+		warning(rawtrmm)
+	} else {
+		if (class(savepath)=="character" & !file.exists(paste(savepath,fname,sep="/"))) writeBin(rawtrmm, paste(savepath,fname,sep="/"))
+		
+		wth at rmk <- prod.ftp
+		
+		prec <- matrix(readBin(rawtrmm, double(), endian="big", size=4, n=ncell(baseraster)), ncol=ncol(baseraster), nrow=nrow(baseraster), byrow=TRUE)
+		prec[prec==min(prec)] <- NA
+		prec <- prec[nrow(prec):1,]
+		
+		baseraster <- raster(extent(-180,180,-50,50))
+		res(baseraster) <- 0.25
+		cell <- 1:ncell(baseraster)		
+		baseraster[] <- prec
+
+		wth at w <- as.data.frame(cell)
+		wth at w$wdate <- as.character(wdate)
+		wth at w$prec <- values(baseraster)
+		rm(baseraster, prec, cell)
+		gc(verbose=FALSE)		
+	}	
+	
 	return(wth)
 }