Project

General

Profile

« Previous | Next » 

Revision 710f7456

Added by Adam Wilson over 11 years ago

Added initial validation via NDP-026D dataset

View differences:

climate/procedures/NDP-026D.R
1 1
#! /bin/R
2 2
### Script to download and process the NDP-026D station cloud dataset
3
setwd("~/acrobates/projects/interp/data/NDP026D")
3
setwd("~/acrobates/adamw/projects/interp/data/NDP026D")
4

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

  
4 13

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

  
......
13 22
st$lon=st$LON/100
14 23
st$lon[st$lon>180]=st$lon[st$lon>180]-360
15 24

  
16
## check a plot
17
plot(lat~lon,data=st,pch=16,cex=.5)
18

  
19

  
20
## get monthly mean cloud amount MMCA
25
## download data
21 26
system("wget -N -nd ftp://cdiac.ornl.gov/pub/ndp026d/cat67_78/* -A '.tc.Z' -P data/")
22 27
system("gunzip data/*.Z")
23 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")
24 32
#f121=c(6,6,6,7,6,7,6,2) #format 121
25 33
#c121=c("StaID","NobD","AvgDy","NobN","AvgNt","NobDN","AvgDN","Acode")
26
f162=c(5,5,4,7,7,7,4) #format 121
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
27 43
c162=c("StaID","YR","Nobs","Amt","Fq","AWP","NC")
28 44

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

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

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

  
44
## calculate means
64
## calculate means and sds
45 65
cldm=do.call(rbind.data.frame,by(cld,list(month=as.factor(cld$month),StaID=as.factor(cld$StaID)),function(x){
46
  data.frame(month=x$month[1],StaID=x$StaID[1],Amt=mean(x$Amt[x$Nobs>20],na.rm=T))}))
47
cldm[,c("lat","lon")]=st[match(st$StaID,cldm$StaID),c("lat","lon")]
48

  
49

  
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
#cldm=foreach(m=unique(cld$month),.combine='rbind')%:%
74
#  foreach(s=unique(cld$StaID),.combine="rbind") %dopar% {
75
#    x=cld[cld$month==m&cld$StaID==s,]
76
#    data.frame(
77
#               month=x$month[1],
78
#               StaID=x$StaID[1],
79
#               Amt=mean(x$Amt[x$Nobs>10],na.rm=T)/100)}
80
 
50 81

  
51 82
## write out the table
52 83
write.csv(cldm,file="cldm.csv")
......
56 87
###
57 88
cldm=read.csv("cldm.csv")
58 89

  
59
## add a color key
60
cldm$col=cut(cldm$Amt/100,quantile(cldm$Amt/100,seq(0,1,len=5),na.rm=T))
61 90

  
62
library(lattice)
63
xyplot(lat~lon|+month,groups=col,data=cldm,pch=16,cex=.2,auto.key=T)
91
##make spatial object
92
cldms=cldm
93
coordinates(cldms)=c("lon","lat")
94
projection(cldms)=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
95

  
96
#### Evaluate MOD35 Cloud data
97
mod35=brick("../modis/mod35/MOD35_h11v08.nc",varname="CLD01")
98
mod35sd=brick("../modis/mod35/MOD35_h11v08.nc",varname="CLD_sd")
99

  
100
projection(mod35)="+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
101
projection(mod35sd)="+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
64 102

  
103
cldms=spTransform(cldms,CRS(projection(mod35)))
104

  
105
mod35v=foreach(m=unique(cldm$month),.combine="rbind") %do% {
106
  dr=subset(mod35,subset=m);projection(dr)=projection(mod35)
107
  dr2=subset(mod35sd,subset=m);projection(dr2)=projection(mod35)
108
  ds=cldms[cldms$month==m,]
109
  ds$mod35=unlist(extract(dr,ds,buffer=10,fun=mean,na.rm=T))
110
#  ds$mod35sd=extract(dr2,ds,buffer=10)
111
  print(m)
112
  return(ds@data[!is.na(ds$mod35),])}
113

  
114
## month factors
115
cldm$month2=factor(cldm$month,labels=month.name)
116
## add a color key
117
breaks=seq(0,100,by=25)
118
cldm$cut=cut(cldm$cld,breaks)
119
cp=colorRampPalette(c("blue","orange","red"))
120
cols=cp(length(at))
121

  
122
## read in global coasts for nice plotting
123
library(maptools)
124

  
125
data(wrld_simpl)
126
coast <- unionSpatialPolygons(wrld_simpl, rep("land",nrow(wrld_simpl)), threshold=5)
127
coast=as(coast,"SpatialLines")
128
#coast=spTransform(coast,CRS(projection(mod35)))
129

  
130

  
131
## write a pdf
132
#dir.create("output")
133
pdf("output/NDP026d.pdf",width=11,height=8.5)
134

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

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

  
145

  
146
## Validation
147
m=10
148
zlim=c(40,100)
149
dr=subset(mod35,subset=m);projection(dr)=projection(mod35)
150
ds=cldms[cldms$month==m,]
151
plot(dr,col=cp(100),zlim=zlim,main="Comparison of MOD35 Cloud Frequency and NDP-026D Station Cloud Climatologies",
152
     ylab="Northing (m)",xlab="Easting (m)",sub="MOD35 is proportion of cloudy days, while NDP-026D is Mean Cloud Coverage")
153
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))))
154
#legend("topright",legend=seq(zlim[1],zlim[2],len=5),pch=16,col=cp(length(breaks)))
155

  
156

  
157
xyplot(mod35~cld,data=mod35v,subscripts=T,auto.key=T,panel=function(x,y,subscripts){
158
   td=mod35v[subscripts,]
159
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
160
   panel.xyplot(x,y,subscripts=subscripts,type=c("p","smooth"),pch=16,col="black")
161
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
162
 },ylab="MOD35 Proportion Cloudy Days",xlab="NDP-026D Mean Monthly Cloud Amount",
163
        main="Comparison of MOD35 Cloud Mask and Station Cloud Climatologies")
164

  
165
#xyplot(mod35~cld|month,data=mod35v,subscripts=T,auto.key=T,panel=function(x,y,subscripts){
166
#   td=mod35v[subscripts,]
167
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
168
#   panel.xyplot(x,y,subscripts=subscripts,type=c("p","smooth"),pch=16,col="black")
169
#   panel.segments(x-td$cldsd[subscripts],y,x+td$cldsd[subscripts],y,subscripts=subscripts)
170
# },ylab="MOD35 Proportion Cloudy Days",xlab="NDP-026D Mean Monthly Cloud Amount",
171
#        main="Comparison of MOD35 Cloud Mask and Station Cloud Climatologies")
172

  
173

  
174
dev.off()
175

  
176
graphics.off()

Also available in: Unified diff