Project

General

Profile

Download (22.1 KB) Statistics
| Branch: | Revision:
1 147da66d Adam M. Wilson
###################################################################################
2
###  R code to aquire and process MOD06_L2 cloud data from the MODIS platform
3
4
5
## connect to server of choice
6
#system("ssh litoria")
7
#R
8
9
library(sp)
10
library(spgrass6)
11
library(rgdal)
12 44799b5f Adam M. Wilson
library(reshape)
13 147da66d Adam M. Wilson
library(ncdf4)
14
library(geosphere)
15
library(rgeos)
16
library(multicore)
17
library(raster)
18
library(lattice)
19
library(rgl)
20
library(hdf5)
21 0c74b1da Adam M. Wilson
library(rasterVis)
22 c33d3b68 Adam M. Wilson
library(heR.Misc)
23 147da66d Adam M. Wilson
24
X11.options(type="Xlib")
25
ncores=20  #number of threads to use
26
27
setwd("/home/adamw/personal/projects/interp")
28
setwd("/home/adamw/acrobates/projects/interp")
29
30
roi=readOGR("data/regions/Test_sites/Oregon.shp","Oregon")
31 c33d3b68 Adam M. Wilson
roi_geo=as(roi,"SpatialLines")
32 147da66d Adam M. Wilson
roi=spTransform(roi,CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0"))
33 0c74b1da Adam M. Wilson
roil=as(roi,"SpatialLines")
34 147da66d Adam M. Wilson
35 0c74b1da Adam M. Wilson
summarydatadir="data/modis/MOD06_climatologies"
36 147da66d Adam M. Wilson
37
38
39 0c74b1da Adam M. Wilson
##########################
40
#### explore the data
41
42
months=seq(as.Date("2000-01-15"),as.Date("2000-12-15"),by="month")
43 f2b2e7d5 Adam M. Wilson
44
45
## load data
46 0c74b1da Adam M. Wilson
cerfiles=list.files(summarydatadir,pattern="CER_mean_.*tif$",full=T); cerfiles
47
cer=brick(stack(cerfiles))
48
setZ(cer,months,name="time")
49
cer@z=list(months)
50
cer@zname="time"
51
layerNames(cer) <- as.character(format(months,"%b"))
52
#cer=projectRaster(from=cer,crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0",method="ngb")
53
### TODO: change to bilinear!
54
55
cotfiles=list.files(summarydatadir,pattern="COT_mean_.*tif$",full=T); cotfiles
56
cot=brick(stack(cotfiles))
57
setZ(cot,months,name="time")
58
cot@z=list(months)
59
cot@zname="time"
60
layerNames(cot) <- as.character(format(months,"%b"))
61
#cot=projectRaster(from=cot,crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0",method="ngb")
62
cotm=mean(cot,na.rm=T)
63
### TODO: change to bilinear!
64 147da66d Adam M. Wilson
65 c33d3b68 Adam M. Wilson
cldfiles=list.files(summarydatadir,pattern="CLD_mean_.*tif$",full=T); cldfiles
66
cld=brick(stack(cldfiles))
67
cld[cld==0]=NA
68
setZ(cld,months,name="time")
69
cld@z=list(months)
70
cld@zname="time"
71
layerNames(cld) <- as.character(format(months,"%b"))
72
#cot=projectRaster(from=cot,crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0",method="ngb")
73
cldm=mean(cld,na.rm=T)
74 44799b5f Adam M. Wilson
### TODO: change to bilinear if reprojecting!
75
76 f2b2e7d5 Adam M. Wilson
cer20files=list.files(summarydatadir,pattern="CER_P20um_.*tif$",full=T); cer20files
77
cer20=brick(stack(cer20files))
78
setZ(cer20,months,name="time")
79
cer20@z=list(months)
80
cer20@zname="time"
81
layerNames(cer20) <- as.character(format(months,"%b"))
82
#cot=projectRaster(from=cot,crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0",method="ngb")
83
cotm=mean(cot,na.rm=T)
84
### TODO: change to bilinear!
85
86
87 44799b5f Adam M. Wilson
### load PRISM data for comparison
88
prism=brick("data/prism/prism_climate.nc",varname="ppt")
89
## project to sinusoidal
90
projection(prism)=CRS("+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
91
prism=projectRaster(prism,cer)
92
prism[prism<0]=NA  #for some reason NAvalue() wasn't working
93
setZ(prism,months,name="time")
94
prism@z=list(months)
95
prism@zname="time"
96
layerNames(prism) <- as.character(format(months,"%b"))
97
98
####  build a pixel by variable matrix
99 f2b2e7d5 Adam M. Wilson
vars=c("cer","cer20","cld","cot","prism")
100 44799b5f Adam M. Wilson
bd=melt(as.matrix(vars[1]))
101
colnames(bd)=c("cell","month",vars[1])
102
for(v in vars[-1]) {print(v); bd[,v]=melt(as.matrix(get(v)))$value}
103
bd=bd[!is.na(bd$cer)|is.na(bd$prism),]
104
105
## Summarize annual metrics for full rasters
106
107
### get all variables from all months
108
c01=brick(mclapply(vars,function(v) projectRaster(get(v),crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")))
109
layerNames(m01)=paste(vars,months,sep="_")
110
111
m01=brick(mclapply(vars,function(v) mean(get(v))))#mean(cer),mean(cld),mean(cot),mean(prism))
112
layerNames(m01)=vars
113
m01=projectRaster(from=m01,crs="+proj=longlat +datum=WGS84 +ellps=WGS84 +towgs84=0,0,0")
114
m01=crop(m01,extent(-125,-115,41,47))
115 c33d3b68 Adam M. Wilson
### get station data, subset to stations in region, and transform to sinusoidal
116 147da66d Adam M. Wilson
load("data/ghcn/roi_ghcn.Rdata")
117
load("data/allstations.Rdata")
118
119 44799b5f Adam M. Wilson
st2_sin=spTransform(st2,CRS(projection(cer)))
120
121 c33d3b68 Adam M. Wilson
d2=d[d$variable=="ppt"&d$date>=as.Date("2000-01-01"),]
122 147da66d Adam M. Wilson
d2=d2[,-grep("variable",colnames(d2)),]
123
st2=st[st$id%in%d$id,]
124 c33d3b68 Adam M. Wilson
#st2=spTransform(st2,CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0"))
125 147da66d Adam M. Wilson
d2[,c("lon","lat")]=coordinates(st2)[match(d2$id,st2$id),]
126 44799b5f Adam M. Wilson
d2$elev=st2$elev[match(d2$id,st2$id)]
127 0c74b1da Adam M. Wilson
d2$month=format(d2$date,"%m")
128 c33d3b68 Adam M. Wilson
d2$value=d2$value/10 #convert to mm
129 0c74b1da Adam M. Wilson
130
### extract MOD06 data for each station
131
stcer=extract(cer,st2)#;colnames(stcer)=paste("cer_mean_",1:12,sep="")
132 f2b2e7d5 Adam M. Wilson
stcer20=extract(cer20,st2)#;colnames(stcer)=paste("cer_mean_",1:12,sep="")
133 0c74b1da Adam M. Wilson
stcot=extract(cot,st2)#;colnames(stcot)=paste("cot_mean_",1:12,sep="")
134 c33d3b68 Adam M. Wilson
stcld=extract(cld,st2)#;colnames(stcld)=paste("cld_mean_",1:12,sep="")
135 f2b2e7d5 Adam M. Wilson
mod06=cbind.data.frame(id=st2$id,lat=st2$lat,lon=st2$lon,stcer,stcer20,stcot,stcld)
136 0c74b1da Adam M. Wilson
mod06l=melt(mod06,id.vars=c("id","lon","lat"))
137
mod06l[,c("variable","moment","month")]=do.call(rbind,strsplit(as.character(mod06l$variable),"_"))
138 c33d3b68 Adam M. Wilson
mod06l=as.data.frame(cast(mod06l,id+lon+lat+month~variable+moment,value="value"))
139
140
### Identify stations that have < 10 years of data
141
cnts=cast(d2,id~.,fun=function(x) length(x[!is.na(x)]),value="count");colnames(cnts)[colnames(cnts)=="(all)"]="count"
142
summary(cnts)
143
## drop them
144
d2=d2[d2$id%in%cnts$id[cnts$count>=365*10],]
145
146 0c74b1da Adam M. Wilson
147
### generate monthly means of station data
148 44799b5f Adam M. Wilson
dc=cast(d2,id+lon+lat+elev~month,value="value",fun=function(x) mean(x,na.rm=T)*30)
149
dcl=melt(dc,id.vars=c("id","lon","lat","elev"),value="ppt")
150
colnames(dcl)[colnames(dcl)=="value"]="ppt"
151
152 0c74b1da Adam M. Wilson
153 c33d3b68 Adam M. Wilson
154 0c74b1da Adam M. Wilson
## merge station data with mod06
155
mod06s=merge(dcl,mod06l)
156
157
158
### draw some plots
159 c33d3b68 Adam M. Wilson
gq=function(x,n=10,cut=F) {
160 44799b5f Adam M. Wilson
  if(!cut) return(unique(quantile(x,seq(0,1,len=n+1),na.rm=T)))
161
  if(cut)  return(cut(x,unique(quantile(x,seq(0,1,len=n+1),na.rm=T))))
162 c33d3b68 Adam M. Wilson
}
163 0c74b1da Adam M. Wilson
164 44799b5f Adam M. Wilson
### add some additional variables
165
mod06s$month=factor(mod06s$month,labels=format(as.Date(paste("2000",1:12,"15",sep="-")),"%b"))
166
mod06s$lppt=log(mod06s$ppt)
167
mod06s$glon=cut(mod06s$lon,gq(mod06s$lon,n=5),include.lowest=T,ordered=T)#gq(mod06s$lon,n=3))
168
mod06s$glon2=cut(mod06s$lon,breaks=c(-125,-122,-115),labels=c("Coastal","Inland"),include.lowest=T,ordered=T)#gq(mod06s$lon,n=3))
169
mod06s$gelev=cut(mod06s$elev,breaks=gq(mod06s$elev,n=3),labels=c("Low","Mid","High"),include.lowest=T,ordered=T)
170
mod06s$gbin=factor(paste(mod06s$gelev,mod06s$glon2,sep="_"),levels=c("Low_Coastal","Mid_Coastal","High_Coastal","Low_Inland","Mid_Inland","High_Inland"),ordered=T)
171 4f97017d Adam M. Wilson
mod06s$LWP_mean=(2/3)*mod06s$CER_mean*mod06s$COT_mean
172 44799b5f Adam M. Wilson
173
## melt it
174
mod06sl=melt(mod06s[,!grepl("lppt",colnames(mod06s))],id.vars=c("id","lon","lat","elev","month","ppt","glon","glon2","gelev","gbin"))
175 f2b2e7d5 Adam M. Wilson
levels(mod06sl$variable)=c("Effective Radius (um)","Very Cloudy Days (%)","Cloudy Days (%)","Optical Thickness (%)","Liquid Water Path")
176 44799b5f Adam M. Wilson
177
###################################################################
178
###################################################################
179
180 0c74b1da Adam M. Wilson
bgyr=colorRampPalette(c("blue","green","yellow","red"))
181
182 4f97017d Adam M. Wilson
X11.options(type="cairo")
183 0c74b1da Adam M. Wilson
pdf("output/MOD06_summary.pdf",width=11,height=8.5)
184
185 c33d3b68 Adam M. Wilson
# % cloudy maps
186
title="Cloudiness (% cloudy days) "
187
at=unique(quantile(as.matrix(cld),seq(0,1,len=100),na.rm=T))
188
p=levelplot(cld,xlab.top=title,at=at,col.regions=bgyr(length(at)))+layer(sp.lines(roil, lwd=1.2, col='black'))
189
print(p)
190 44799b5f Adam M. Wilson
#bwplot(cer,main=title,ylab="Cloud Effective Radius (microns)")
191 c33d3b68 Adam M. Wilson
192 0c74b1da Adam M. Wilson
# CER maps
193
title="Cloud Effective Radius (microns)"
194
at=quantile(as.matrix(cer),seq(0,1,len=100),na.rm=T)
195
p=levelplot(cer,xlab.top=title,at=at,col.regions=bgyr(length(at)))+layer(sp.lines(roil, lwd=1.2, col='black'))
196
print(p)
197 44799b5f Adam M. Wilson
#bwplot(cer,main=title,ylab="Cloud Effective Radius (microns)")
198 0c74b1da Adam M. Wilson
199
# COT maps
200
title="Cloud Optical Thickness (%)"
201
at=quantile(as.matrix(cot),seq(0,1,len=100),na.rm=T)
202
p=levelplot(cot,xlab.top=title,at=at,col.regions=bgyr(length(at)))+layer(sp.lines(roil, lwd=0.8, col='black'))
203
print(p)
204 44799b5f Adam M. Wilson
#bwplot(cot,xlab.top=title,ylab="Cloud Optical Thickness (%)")
205
206
###########################################
207
#### compare with PRISM data
208
209
at=quantile(as.matrix(subset(m01,subset=1)),seq(0,1,len=100),na.rm=T)
210
p1=levelplot(subset(m01,subset=1),xlab.top="Effective Radius (um)",at=at,col.regions=bgyr(length(at)),margin=F,
211
  )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))
212
at=quantile(as.matrix(subset(m01,subset=2)),seq(0,1,len=100),na.rm=T)
213
p2=levelplot(subset(m01,subset=2),xlab.top="Cloudy days (%)",at=at,col.regions=bgyr(length(at)),margin=F,
214
   )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))
215
at=quantile(as.matrix(subset(m01,subset=3)),seq(0,1,len=100),na.rm=T)
216
p3=levelplot(subset(m01,subset=3),xlab.top="Optical Thickness (%)",at=at,col.regions=bgyr(length(at)),margin=F,
217
   )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))
218
at=quantile(as.matrix(subset(m01,subset=4)),seq(0,1,len=100),na.rm=T)
219
p4=levelplot(subset(m01,subset=4),xlab.top="PRISM MAP",at=at,col.regions=bgyr(length(at)),margin=F,
220
    )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))
221
222
print(p1,split=c(1,1,2,2))
223
print(p2,split=c(1,2,2,2),new=F)
224
print(p3,split=c(2,1,2,2),new=F)
225
print(p4,split=c(2,2,2,2),new=F)
226
227
### compare COT and PRISM
228
print(p3,split=c(1,1,2,1))
229
print(p4,split=c(2,1,2,1),new=F)
230
231
232
### sample to speed up processing
233
s=sample(1:nrow(bd),10000)
234
235
## melt it to ease comparisons
236
bdl=melt(bd[s,],measure.vars=c("cer","cld","cot"))
237
238
combineLimits(useOuterStrips(xyplot(prism~value|variable+month,data=bdl,pch=16,cex=.2,scales=list(y=list(log=T),x=list(relation="free")),
239
                                    ylab="PRISM Monthly mean precipitation (mm)",xlab="MOD06 metric",main="PRISM vs. MOD06 (mean monthly ppt)")))+
240
  layer(panel.abline(lm(y~x),col="red"))+
241
  layer(panel.text(0,2.5,paste("R2=",round(summary(lm(y~x))$r.squared,2))))
242 0c74b1da Adam M. Wilson
243
244
### Comparison at station values
245
at=quantile(as.matrix(cotm),seq(0,1,len=100),na.rm=T)
246
p=levelplot(cotm, layers=1,at=at,col.regions=bgyr(length(at)),main="Mean Annual Cloud Optical Thickness",FUN.margin=function(x) 0)+
247 44799b5f Adam M. Wilson
  layer(sp.lines(roil, lwd=1.2, col='black'))+layer(sp.points(st2_sin, pch=16, col='black'))
248 0c74b1da Adam M. Wilson
print(p)
249
250
### monthly comparisons of variables
251 f2b2e7d5 Adam M. Wilson
#mod06sl=melt(mod06s,measure.vars=c("ppt","COT_mean","CER_mean","CER_P20um"))
252
#bwplot(value~month|variable,data=mod06sl,cex=.5,pch=16,col="black",scales=list(y=list(relation="free")),layout=c(1,3))
253
#splom(mod06s[grep("CER|COT|CLD|ppt",colnames(mod06s))],cex=.2,pch=16,main="Scatterplot matrix of MOD06 products")
254 c33d3b68 Adam M. Wilson
255
### run some regressions
256 44799b5f Adam M. Wilson
#plot(log(ppt)~COT_mean,data=mod06s)
257
#summary(lm(log(ppt)~COT_mean*month,data=mod06s))
258
259
## ppt~metric with longitude bins
260
 xyplot(ppt~value|variable,groups=glon,data=mod06sl,
261 4f97017d Adam M. Wilson
       scales=list(y=list(log=T),x=list(relation="free",log=F)),
262
       par.settings = list(superpose.symbol = list(col=bgyr(5),pch=16,cex=.5)),auto.key=list(space="top",title="Station Longitude"),
263 f2b2e7d5 Adam M. Wilson
       main="Comparison of MOD06_L2 and Precipitation Monthly Climatologies",ylab="Mean Monthly Station Precipitation (mm)",xlab="MOD06_L2 Product",layout=c(5,1))+
264 44799b5f Adam M. Wilson
  layer(panel.text(9,2.5,label="Coastal stations",srt=30,cex=1.3,col="blue"),columns=1)+
265 f2b2e7d5 Adam M. Wilson
  layer(panel.text(13,.9,label="Inland stations",srt=10,cex=1.3,col="red"),columns=1)+
266
  layer(panel.abline(lm(y~x),col="red"))+
267
  layer(panel.text(0,0,paste("R2=",round(summary(lm(y~x))$r.squared,2)),pos=4,cex=.5,col="grey"))
268
269 44799b5f Adam M. Wilson
270 4f97017d Adam M. Wilson
## ppt~metric with longitude bins
271
#CairoPNG("output/COT.png",width=10,height=5,units="in",dpi=300,pointsize=20)
272
#png("output/COT.png",width=10,height=5,units="in",res=150)
273
#trellis.par.set("fontsize",12)
274
at=quantile(as.matrix(subset(m01,subset=3)),seq(0,1,len=100),na.rm=T)
275
p1=levelplot(subset(m01,subset=3),xlab.top="Optical Thickness (%)",at=at,col.regions=bgyr(length(at)),margin=F,
276
   )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))+layer(sp.points(st2, cex=.5,col='black'))
277 f2b2e7d5 Adam M. Wilson
at=quantile(as.matrix(subset(m01,subset=3)),seq(0,1,len=100),na.rm=T)
278
279 4f97017d Adam M. Wilson
at=quantile(as.matrix(subset(m01,subset=4)),seq(0,1,len=100),na.rm=T)
280
p2=levelplot(subset(m01,subset=4),xlab.top="PRISM MAP",at=at,col.regions=bgyr(length(at)),margin=F,
281
    )+layer(sp.lines(roi_geo, lwd=1.2, col='black'))+layer(sp.points(st2, cex=.5, col='black'))
282
283
p3=xyplot(ppt~value,groups=glon,data=mod06sl[mod06sl$variable=="Optical Thickness (%)",],
284
       scales=list(y=list(log=T),x=list(relation="free",log=F)),
285
       par.settings = list(superpose.symbol = list(col=bgyr(5),pch=16,cex=.3)),auto.key=list(space="right",title="Station \n Longitude"),
286
ylab="Mean Monthly Station Precipitation (mm)",xlab="Cloud Optical Thickness from MOD06_L2 (%)",layout=c(1,1))+
287
  layer(panel.text(9,2.6,label="Coastal stations",srt=10,cex=1.3,col="blue"),columns=1)+
288
  layer(panel.text(13,.95,label="Inland stations",srt=10,cex=1.3,col="red"),columns=1)
289
290 f2b2e7d5 Adam M. Wilson
p4=xyplot(ppt~value,groups=glon,data=mod06sl[mod06sl$variable=="Very Cloudy Days (%)",],
291
       scales=list(y=list(log=T),x=list(relation="free",log=F)),
292
       par.settings = list(superpose.symbol = list(col=bgyr(5),pch=16,cex=.3)),auto.key=list(space="right",title="Station \n Longitude"),
293
ylab="Mean Monthly Station Precipitation (mm)",xlab="Proportion days with Cloud Effective Radius >20um from MOD06_L2 (%)",layout=c(1,1))+
294
  layer(panel.text(9,2.6,label="Coastal stations",srt=10,cex=1.3,col="blue"),columns=1)+
295
  layer(panel.text(13,.95,label="Inland stations",srt=10,cex=1.3,col="red"),columns=1)
296
297
#save(p1,p2,p3,file="plotdata.Rdata")
298
#load("plotdata.Rdata")
299 4f97017d Adam M. Wilson
300 f2b2e7d5 Adam M. Wilson
#CairoPDF("output/MOD06_Summaryfig.pdf",width=11,height=8.5)
301 4f97017d Adam M. Wilson
print(p3,position=c(0,0,1,.5),save.object=F)
302 f2b2e7d5 Adam M. Wilson
#print(p4,position=c(0,0,1,.5),save.object=F)
303 4f97017d Adam M. Wilson
print(p1,split=c(1,1,2,2),new=F)
304
print(p2,split=c(2,1,2,2),new=F)
305 f2b2e7d5 Adam M. Wilson
#dev.off()
306
#system("convert output/MOD06_Summaryfig.pdf output/MOD06_Summaryfig.png")
307 4f97017d Adam M. Wilson
                                        #dev.off()
308
309 44799b5f Adam M. Wilson
## with elevation
310
# xyplot(ppt~value|variable,groups=gbin,data=mod06sl,
311
#       scales=list(y=list(log=T),x=list(relation="free")),
312
#       par.settings = list(superpose.symbol = list(col=c(rep("blue",3),rep("red",3)),pch=rep(c(3,4,8),2),cex=.5)),auto.key=list(space="right",title="Station Longitude"),
313
#       main="Comparison of MOD06_L2 and Precipitation Monthly Climatologies",ylab="Precipitation",xlab="MOD06_L2 Product",layout=c(3,1))+
314
#  layer(panel.text(9,2.5,label="Coastal stations",srt=30,cex=1.3,col="blue"),columns=1)+
315
#  layer(panel.text(13,.9,label="Inland stations",srt=10,cex=1.3,col="red"),columns=1)
316
317
## with elevation and longitude bins
318
combineLimits(useOuterStrips(xyplot(ppt~value|variable+gbin,data=mod06sl,
319
       scales=list(y=list(log=T),x=list(relation="free")),col="black",pch=16,cex=.5,type=c("p","r"),
320
       main="Comparison of MOD06_L2 and Precipitation Monthly Climatologies",ylab="Precipitation",xlab="MOD06_L2 Product")))+
321
  layer(panel.xyplot(x,y,type="r",col="red"))
322
323
## *** MOD06 vars vs precipitation by month, colored by longitude
324
combineLimits(useOuterStrips(xyplot(ppt~value|month+variable,groups=glon,data=mod06sl,cex=.5,pch=16,
325
                      scales=list(y=list(log=T),x=list(relation="free")),
326
                      par.settings = list(superpose.symbol = list(pch =16, col=bgyr(5),cex=1)),auto.key=list(space="top",title="Station Longitude"),
327
                      main="Comparison of MOD06_L2 and Precipitation Monthly Climatologies",ylab="Precipitation",xlab="MOD06_L2 Product")),
328
              margin.x=1,adjust.labels=F)+
329
  layer(panel.abline(lm(y~x),col="red"))+
330
  layer(panel.text(0,0,paste("R2=",round(summary(lm(y~x))$r.squared,2)),pos=4,cex=.5,col="grey"))
331
332
333
 xyplot(ppt~CLD_mean|id,data=mod06s,panel=function(x,y,group){
334
  panel.xyplot(x,y,type=c("r"),cex=.5,pch=16,col="red")
335
  panel.xyplot(x,y,type=c("p"),cex=.5,pch=16,col="black")
336
} ,scales=list(y=list(log=T)),strip=F,main="Monthly Mean Precipitation and % Cloudy by station",
337
        sub="Each panel is a station, each point is a monthly mean",
338
        ylab="Precipitation (mm, log axis)",xlab="% of Cloudy Days")+
339
  layer(panel.text(.5,.5,round(summary(lm(y~x))$r.squared,2),pos=4,cex=.75,col="grey"))
340 c33d3b68 Adam M. Wilson
341 44799b5f Adam M. Wilson
 xyplot(ppt~CER_mean|id,data=mod06s,panel=function(x,y,group){
342
  panel.xyplot(x,y,type=c("r"),cex=.5,pch=16,col="red")
343
  panel.xyplot(x,y,type=c("p"),cex=.5,pch=16,col="black")
344
} ,scales=list(y=list(log=T)),strip=F,main="Monthly Mean Precipitation and Cloud Effective Radius by station",sub="Each panel is a station, each point is a monthly mean",ylab="Precipitation (mm, log axis)",xlab="Mean Monthly Cloud Effective Radius (mm)")+
345
  layer(panel.text(10,.5,round(summary(lm(y~x))$r.squared,2),pos=4,cex=.75,col="grey"))
346 c33d3b68 Adam M. Wilson
347
 xyplot(ppt~COT_mean|id,data=mod06s,panel=function(x,y,group){
348
  panel.xyplot(x,y,type=c("r"),cex=.5,pch=16,col="red")
349
  panel.xyplot(x,y,type=c("p"),cex=.5,pch=16,col="black")
350 44799b5f Adam M. Wilson
} ,scales=list(y=list(log=T)),strip=F,main="Monthly Mean Precipitation and Cloud Optical Thickness by station",
351
        sub="Each panel is a station, each point is a monthly mean \n Number in lower right of each panel is R^2",
352
        ylab="Precipitation (mm, log axis)",xlab="Mean Monthly Cloud Optical Thickness (%)")+
353
  layer(panel.text(10,.5,round(summary(lm(y~x))$r.squared,2),pos=4,cex=.75,col="grey"))
354 c33d3b68 Adam M. Wilson
355 4f97017d Adam M. Wilson
 xyplot(ppt~LWP_mean|id,data=mod06s,panel=function(x,y,group){
356
  panel.xyplot(x,y,type=c("r"),cex=.5,pch=16,col="red")
357
  panel.xyplot(x,y,type=c("p"),cex=.5,pch=16,col="black")
358
} ,scales=list(y=list(log=T)),strip=F,main="Monthly Mean Precipitation and Liquid Water Path by station",
359
        sub="Each panel is a station, each point is a monthly mean \n Number in lower right of each panel is R^2",
360
        ylab="Precipitation (mm, log axis)",xlab="Mean Monthly Liquid Water Path")+
361
  layer(panel.text(10,.5,round(summary(lm(y~x))$r.squared,2),pos=4,cex=.75,col="grey"))
362 44799b5f Adam M. Wilson
363
### Calculate the slope of each line
364 c33d3b68 Adam M. Wilson
mod06s.sl=dapply(mod06s,list(id=mod06s$id),function(x){
365
  lm1=lm(log(x$ppt)~x$CER_mean,)
366 44799b5f Adam M. Wilson
  data.frame(lat=x$lat[1],lon=x$lon[1],elev=x$elev[1],intcpt=coefficients(lm1)[1],cer=coefficients(lm1)[2],r2=summary(lm1)$r.squared)
367 c33d3b68 Adam M. Wilson
})
368
mod06s.sl$cex=gq(mod06s.sl$r2,n=5,cut=T)
369
mod06s.sl$cer.s=gq(mod06s.sl$cer,n=5,cut=T)
370
371 44799b5f Adam M. Wilson
###  and plot it on a map
372 c33d3b68 Adam M. Wilson
xyplot(lat~lon,group=cer.s,data=mod06s.sl,par.settings = list(superpose.symbol = list(pch =16, col=bgyr(5),cex=1)),auto.key=list(space="right",title="Slope Coefficient"),asp=1,
373
       main="Slopes of linear regressions {log(ppt)~CloudEffectiveRadius}")+
374
  layer(sp.lines(roi_geo, lwd=1.2, col='black'))
375
376 44799b5f Adam M. Wilson
### look for relationships with longitude
377
xyplot(cer~lon,group=cut(mod06s.sl$elev,gq(mod06s.sl$elev,n=5)),data=mod06s.sl,
378
       par.settings = list(superpose.symbol = list(col=bgyr(5),pch=16,cex=1)),auto.key=list(space="right",title="Station Elevation"),
379
       ylab="Slope of lm(ppt~EffectiveRadius)",xlab="Longitude",main="Precipitation~Effective Radius relationship by latitude")
380
381 c33d3b68 Adam M. Wilson
382
############################################################
383
### simple regression to get spatial residuals
384
m="01"
385
mod06s2=mod06s#[mod06s$month==m,]
386
387 44799b5f Adam M. Wilson
lm1=lm(log(ppt)~CER_mean*month*lon,data=mod06s2); summary(lm1)
388
mod06s2$pred=exp(predict(lm1,mod06s2))
389 c33d3b68 Adam M. Wilson
mod06s2$resid=mod06s2$pred-mod06s2$ppt
390 44799b5f Adam M. Wilson
mod06s2$residg=gq(mod06s2$resid,n=5,cut=T)
391
mod06s2$presid=mod06s2$resid/mod06s2$ppt
392
393
for(l in c(F,T)){
394
## all months
395
  xyplot(pred~ppt,groups=gelev,data=mod06s2,
396
       par.settings = list(superpose.symbol = list(col=bgyr(3),pch=16,cex=.75)),auto.key=list(space="right",title="Station Elevation"),
397
       scales=list(log=l),
398
       ylab="Predicted Mean Monthly Precipitation (mm)",xlab="Observed Mean Monthly Precipitation (mm)",main="Predicted vs. Observed for Simple Model",
399
       sub="Red line is y=x")+
400
  layer(panel.abline(0,1,col="red"))
401
402
## month by month
403
  print(xyplot(pred~ppt|month,groups=gelev,data=mod06s2,
404
       par.settings = list(superpose.symbol = list(col=bgyr(3),pch=16,cex=.75)),auto.key=list(space="right",title="Station Elevation"),
405
       scales=list(log=l),
406
       ylab="Predicted Mean Monthly Precipitation (mm)",xlab="Observed Mean Monthly Precipitation (mm)",main="Predicted vs. Observed for Simple Model",
407
       sub="Red line is y=x")+
408
  layer(panel.abline(0,1,col="red"))
409
)}
410
411
## residuals by month
412
xyplot(lat~lon|month,group=residg,data=mod06s2,
413
       par.settings = list(superpose.symbol = list(pch =16, col=bgyr(5),cex=.5)),
414
       auto.key=list(space="right",title="Residuals"),
415
       main="Spatial plot of monthly residuals")+
416
    layer(sp.lines(roi_geo, lwd=1.2, col='black'))
417 0c74b1da Adam M. Wilson
418
419
dev.off()
420
421
422 44799b5f Adam M. Wilson
####################################
423
#### build table comparing various metrics
424
mods=data.frame(
425
  models=c(
426
    "log(ppt)~CER_mean",
427
    "log(ppt)~CLD_mean",
428
    "log(ppt)~COT_mean",
429
    "log(ppt)~CER_mean*month",
430
    "log(ppt)~CLD_mean*month",
431
    "log(ppt)~COT_mean*month",
432
    "log(ppt)~CER_mean*month*lon",
433
    "log(ppt)~CLD_mean*month*lon",
434
    "log(ppt)~COT_mean*month*lon",
435
    "ppt~CER_mean*month*lon",
436
    "ppt~CLD_mean*month*lon",
437
    "ppt~COT_mean*month*lon"),stringsAsFactors=F)
438
  
439
mods$r2=
440
  do.call(rbind,lapply(1:nrow(mods),function(i){
441
    lm1=lm(as.formula(mods$models[i]),data=mod06s2)
442
    summary(lm1)$r.squared}))
443 0c74b1da Adam M. Wilson
444 44799b5f Adam M. Wilson
mods
445 0c74b1da Adam M. Wilson
446
447
448
449
450
451 147da66d Adam M. Wilson
452
453
load("data/modis/pointsummary.Rdata")
454
455
456
dsl=melt(ds,id.vars=c("id","date","ppt","lon","lat"),measure.vars=  c("Cloud_Water_Path","Cloud_Effective_Radius","Cloud_Optical_Thickness"))
457
458
dsl=dsl[!is.nan(dsl$value),]
459
460
461
462
463
####
464
## mean annual precip
465
dp=d[d$variable=="ppt",]
466
dp$year=format(dp$date,"%Y")
467
dm=tapply(dp$value,list(id=dp$id,year=dp$year),sum,na.rm=T)
468
dms=apply(dm,1,mean,na.rm=T)
469
dms=data.frame(id=names(dms),ppt=dms/10)
470
471
dslm=tapply(dsl$value,list(id=dsl$id,variable=dsl$variable),mean,na.rm=T)
472
dslm=data.frame(id=rownames(dslm),dslm)
473
474
dms=merge(dms,dslm)
475
dmsl=melt(dms,id.vars=c("id","ppt"))
476
477
summary(lm(ppt~Cloud_Effective_Radius,data=dms))
478
summary(lm(ppt~Cloud_Water_Path,data=dms))
479
summary(lm(ppt~Cloud_Optical_Thickness,data=dms))
480
summary(lm(ppt~Cloud_Effective_Radius+Cloud_Water_Path+Cloud_Optical_Thickness,data=dms))
481
482
483
#### draw some plots
484
#pdf("output/MOD06_summary.pdf",width=11,height=8.5)
485
png("output/MOD06_summary_%d.png",width=1024,height=780)
486
487
 ## daily data
488
xyplot(value~ppt/10|variable,data=dsl,
489
       scales=list(relation="free"),type=c("p","r"),
490
       pch=16,cex=.5,layout=c(3,1))
491
492
493
densityplot(~value|variable,groups=cut(dsl$ppt,c(0,50,100,500)),data=dsl,auto.key=T,
494
            scales=list(relation="free"),plot.points=F)
495
496
## annual means
497
498
xyplot(value~ppt|variable,data=dmsl,
499
       scales=list(relation="free"),type=c("p","r"),pch=16,cex=0.5,layout=c(3,1),
500
       xlab="Mean Annual Precipitation (mm)",ylab="Mean value")
501
502
densityplot(~value|variable,groups=cut(dsl$ppt,c(0,50,100,500)),data=dmsl,auto.key=T,
503
            scales=list(relation="free"),plot.points=F)
504
505
506
## plot some swaths
507
508
nc1=raster(fs$path[3],varname="Cloud_Effective_Radius")
509
nc2=raster(fs$path[4],varname="Cloud_Effective_Radius")
510
nc3=raster(fs$path[5],varname="Cloud_Effective_Radius")
511
512
nc1[nc1<=0]=NA
513
nc2[nc2<=0]=NA
514
nc3[nc3<=0]=NA
515
516
plot(roi)
517
plot(nc3)
518
519
plot(nc1,add=T)
520
plot(nc2,add=T)
521
522
523
dev.off()
524