Project

General

Profile

Download (8.85 KB) Statistics
| Branch: | Revision:
1
#! /bin/R
2
### Script to download and process the NDP-026D station cloud dataset
3
setwd("~/acrobates/adamw/projects/interp/data/NDP026D")
4

    
5
library(multicore)
6
library(latticeExtra)
7
library(doMC)
8
library(rasterVis)
9
library(rgdal)
10
## register parallel processing
11
registerDoMC(20)
12

    
13

    
14
## available here http://cdiac.ornl.gov/epubs/ndp/ndp026d/ndp026d.html
15

    
16

    
17
## Get station locations
18
system("wget -N -nd http://cdiac.ornl.gov/ftp/ndp026d/cat01/01_STID -P data/")
19
st=read.table("data/01_STID",skip=1)
20
colnames(st)=c("StaID","LAT","LON","ELEV","ny1","fy1","ly1","ny7","fy7","ly7","SDC","b5c")
21
st$lat=st$LAT/100
22
st$lon=st$LON/100
23
st$lon[st$lon>180]=st$lon[st$lon>180]-360
24

    
25
## download data
26
system("wget -N -nd ftp://cdiac.ornl.gov/pub/ndp026d/cat67_78/* -A '.tc.Z' -P data/")
27
system("gunzip data/*.Z")
28

    
29
## get monthly mean cloud amount MMCF
30
#system("wget -N -nd ftp://cdiac.ornl.gov/pub/ndp026d/cat08_09/* -A '.tc.Z' -P data/")
31
#system("gunzip data/*.Z")
32
#f121=c(6,6,6,7,6,7,6,2) #format 121
33
#c121=c("StaID","NobD","AvgDy","NobN","AvgNt","NobDN","AvgDN","Acode")
34
#cld=do.call(rbind.data.frame,lapply(sprintf("%02d",1:12),function(m) {
35
#  d=read.fwf(list.files("data",pattern=paste("MMCA.",m,".tc",sep=""),full=T),skip=1,widths=f162)
36
#  colnames(d)=c121
37
#  d$month=as.numeric(m)
38
#  return(d)}
39
#  ))
40

    
41
## define FWF widths
42
f162=c(5,5,4,7,7,7,4) #format 162
43
c162=c("StaID","YR","Nobs","Amt","Fq","AWP","NC")
44

    
45
## use monthly timeseries
46
cld=do.call(rbind.data.frame,mclapply(sprintf("%02d",1:12),function(m) {
47
  d=read.fwf(list.files("data",pattern=paste("MNYDC.",m,".tc",sep=""),full=T),skip=1,widths=f162)
48
  colnames(d)=c162
49
  d$month=as.numeric(m)
50
  print(m)
51
  return(d)}
52
  ))
53

    
54
## add lat/lon
55
cld[,c("lat","lon")]=st[match(cld$StaID,st$StaID),c("lat","lon")]
56

    
57
## drop missing values
58
cld$Amt[cld$Amt<0]=NA
59
cld$Fq[cld$Fq<0]=NA
60
cld$AWP[cld$AWP<0]=NA
61
cld$NC[cld$NC<0]=NA
62
cld=cld[cld$Nobs>0,]
63

    
64
## calculate means and sds
65
cldm=do.call(rbind.data.frame,by(cld,list(month=as.factor(cld$month),StaID=as.factor(cld$StaID)),function(x){
66
  data.frame(
67
             month=x$month[1],
68
             StaID=x$StaID[1],
69
             cld=mean(x$Amt[x$Nobs>10]/100,na.rm=T),
70
             cldsd=sd(x$Amt[x$Nobs>10]/100,na.rm=T))}))
71
cldm[,c("lat","lon")]=st[match(cldm$StaID,st$StaID),c("lat","lon")]
72

    
73
## means by year
74
cldy=do.call(rbind.data.frame,by(cld,list(year=as.factor(cld$YR),StaID=as.factor(cld$StaID)),function(x){
75
  data.frame(
76
             year=x$YR[1],
77
             StaID=x$StaID[1],
78
             cld=mean(x$Amt[x$Nobs>10]/100,na.rm=T),
79
             cldsd=sd(x$Amt[x$Nobs>10]/100,na.rm=T))}))
80
cldy[,c("lat","lon")]=st[match(cldy$StaID,st$StaID),c("lat","lon")]
81

    
82

    
83
#cldm=foreach(m=unique(cld$month),.combine='rbind')%:%
84
#  foreach(s=unique(cld$StaID),.combine="rbind") %dopar% {
85
#    x=cld[cld$month==m&cld$StaID==s,]
86
#    data.frame(
87
#               month=x$month[1],
88
#               StaID=x$StaID[1],
89
#               Amt=mean(x$Amt[x$Nobs>10],na.rm=T)/100)}
90
 
91

    
92
## write out the tables
93
write.csv(cldy,file="cldy.csv")
94
write.csv(cldm,file="cldm.csv")
95

    
96

    
97
##################
98
###
99
cldm=read.csv("cldm.csv")
100
cldy=read.csv("cldy.csv")
101

    
102

    
103
##make spatial object
104
cldms=cldm
105
coordinates(cldms)=c("lon","lat")
106
projection(cldms)=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
107

    
108
##make spatial object
109
cldys=cldy
110
coordinates(cldys)=c("lon","lat")
111
projection(cldys)=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
112

    
113
#### Evaluate MOD35 Cloud data
114
mod35=brick("../modis/mod35/MOD35_h11v08.nc",varname="CLD01")
115
mod35sd=brick("../modis/mod35/MOD35_h11v08.nc",varname="CLD_sd")
116
projection(mod35)="+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
117

    
118

    
119
### use data from google earth engine
120
mod35=raster("../modis/mod09/global_2009/MOD35_2009.tif")
121
mod09=raster("../modis/mod09/global_2009/MOD09_2009.tif")
122

    
123
## LULC
124
system(paste("gdalwarp -r near -co \"COMPRESS=LZW\" -tr ",paste(res(mod09),collapse=" ",sep=""),
125
             "-tap -multi -t_srs \"",   projection(mod09),"\" /mnt/data/jetzlab/Data/environ/global/landcover/MODIS/MCD12Q1_IGBP_2005_v51.tif ../modis/mod12/MCD12Q1_IGBP_2005_v51.tif"))
126
lulc=raster("../modis/mod12/MCD12Q1_IGBP_2005_v51.tif")
127
lulc=ratify(lulc)
128
require(plotKML); data(worldgrids_pal)  #load IGBP palette
129
IGBP=data.frame(ID=0:16,col=worldgrids_pal$IGBP[-c(18,19)],stringsAsFactors=F)
130
IGBP$class=rownames(IGBP);rownames(IGBP)=1:nrow(IGBP)
131
levels(lulc)=list(IGBP)
132
lulc=crop(lulc,mod09)
133

    
134
n=100
135
at=seq(0,100,length=n)
136
colr=colorRampPalette(c("black","green","red"))
137
cols=colr(n)
138

    
139
dif=mod35-mod09
140
bwplot(dif~as.factor(lulc))
141

    
142
levelplot(mod35,col.regions=cols,at=at,margins=F,maxpixels=1e6)#,xlim=c(-100,-50),ylim=c(0,10))
143
levelplot(lulc,att="class",col.regions=levels(lulc)[[1]]$col,margin=F,maxpixels=1e6)
144

    
145
#cldys=spTransform(cldys,CRS(projection(mod35)))
146

    
147
mod35v=foreach(m=unique(cldm$month),.combine="rbind") %do% {
148
  dr=subset(mod35,subset=m);projection(dr)=projection(mod35)
149
  dr2=subset(mod35sd,subset=m);projection(dr2)=projection(mod35)
150
  ds=cldms[cldms$month==m,]
151
  ds$mod35=unlist(extract(dr,ds,buffer=10,fun=mean,na.rm=T))
152
#  ds$mod35sd=extract(dr2,ds,buffer=10)
153
  print(m)
154
  return(ds@data[!is.na(ds$mod35),])}
155

    
156
y=2009
157
d=cldys[cldys$year==y,]
158

    
159
d$mod35_10=unlist(extract(mod35,d,buffer=10000,fun=mean,na.rm=T))
160
d$mod09_10=unlist(extract(mod09,d,buffer=10000,fun=mean,na.rm=T))
161
d$dif=d$mod35_10-d$mod09_10
162
d$dif2=d$mod35_10-d$cld
163

    
164
d$lulc=unlist(extract(lulc,d))
165
d$lulc_10=unlist(extract(lulc,d,buffer=10000,fun=mode,na.rm=T))
166
d$lulc=factor(d$lulc,labels=IGBP$class)
167

    
168
save(d,file="annualsummary.Rdata")
169

    
170
## quick model to explore fit
171
plot(cld~mod35,groups=lulc,data=d)
172
summary(lm(cld~mod35+as.factor(lulc),data=d))
173
summary(lm(cld~mod09_10,data=d))
174
summary(lm(cld~mod09_10+as.factor(lulc),data=d))
175
summary(lm(cld~mod09_10+as.factor(lulc),data=d))
176

    
177
### exploratory plots
178
xyplot(cld~mod09_10,groups=lulc,data=d@data,pch=16,cex=.5)+layer(panel.abline(0,1,col="red"))
179
xyplot(cld~mod09_10+mod35_10|as.factor(lulc),data=d@data,type=c("p","r"),pch=16,cex=.25,auto.key=T)+layer(panel.abline(0,1,col="green"))
180
xyplot(cld~mod35_10|as.factor(lulc),data=d@data,pch=16,cex=.5)+layer(panel.abline(0,1,col="red"))
181
xyplot(mod35_10~mod09_10|as.factor(lulc),data=d@data,pch=16,cex=.5)+layer(panel.abline(0,1,col="red"))
182

    
183
densityplot(stack(mod35,mod09))
184
boxplot(mod35,lulc)
185

    
186
bwplot(mod09~mod35|cut(y,5),data=stack(mod09,mod35))
187

    
188
## month factors
189
cldm$month2=factor(cldm$month,labels=month.name)
190
## add a color key
191
breaks=seq(0,100,by=25)
192
cldm$cut=cut(cldm$cld,breaks)
193
cp=colorRampPalette(c("blue","orange","red"))
194
cols=cp(length(at))
195

    
196
## read in global coasts for nice plotting
197
library(maptools)
198

    
199
data(wrld_simpl)
200
coast <- unionSpatialPolygons(wrld_simpl, rep("land",nrow(wrld_simpl)), threshold=5)
201
coast=as(coast,"SpatialLines")
202
#coast=spTransform(coast,CRS(projection(mod35)))
203

    
204

    
205
## write a pdf
206
#dir.create("output")
207
pdf("output/NDP026d.pdf",width=11,height=8.5)
208

    
209
## map of stations
210
 xyplot(lat~lon,data=st,pch=16,cex=.5,col="black",auto.key=T,
211
       main="NDP-026D Cloud Climatology Stations",ylab="Latitude",xlab="Longitude")+
212
  layer(sp.lines(coast,col="grey"),under=T)
213

    
214
xyplot(lat~lon|month2,groups=cut,data=cldm,pch=".",cex=.2,auto.key=T,
215
       main="Mean Monthly Cloud Coverage",ylab="Latitude",xlab="Longitude",
216
        par.settings = list(superpose.symbol= list(pch=16,col=c("blue","green","yellow","red"))))+
217
  layer(sp.lines(coast,col="grey"),under=T)
218

    
219

    
220
## Validation
221
m=10
222
zlim=c(40,100)
223
dr=subset(mod35,subset=m);projection(dr)=projection(mod35)
224
ds=cldms[cldms$month==m,]
225
plot(dr,col=cp(100),zlim=zlim,main="Comparison of MOD35 Cloud Frequency and NDP-026D Station Cloud Climatologies",
226
     ylab="Northing (m)",xlab="Easting (m)",sub="MOD35 is proportion of cloudy days, while NDP-026D is Mean Cloud Coverage")
227
plot(ds,add=T,pch=21,cex=3,lwd=2,fg="black",bg=as.character(cut(ds$cld,breaks=seq(zlim[1],zlim[2],len=5),labels=cp(4))))
228
#legend("topright",legend=seq(zlim[1],zlim[2],len=5),pch=16,col=cp(length(breaks)))
229

    
230

    
231
xyplot(mod35~cld,data=mod35v,subscripts=T,auto.key=T,panel=function(x,y,subscripts){
232
   td=mod35v[subscripts,]
233
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
234
   panel.xyplot(x,y,subscripts=subscripts,type=c("p","smooth"),pch=16,col="black")
235
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
236
 },ylab="MOD35 Proportion Cloudy Days",xlab="NDP-026D Mean Monthly Cloud Amount",
237
        main="Comparison of MOD35 Cloud Mask and Station Cloud Climatologies")
238

    
239
#xyplot(mod35~cld|month,data=mod35v,subscripts=T,auto.key=T,panel=function(x,y,subscripts){
240
#   td=mod35v[subscripts,]
241
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
242
#   panel.xyplot(x,y,subscripts=subscripts,type=c("p","smooth"),pch=16,col="black")
243
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
244
# },ylab="MOD35 Proportion Cloudy Days",xlab="NDP-026D Mean Monthly Cloud Amount",
245
#        main="Comparison of MOD35 Cloud Mask and Station Cloud Climatologies")
246

    
247

    
248
dev.off()
249

    
250
graphics.off()
(27-27/33)