Project

General

Profile

« Previous | Next » 

Revision 4ef959c2

Added by Adam Wilson almost 12 years ago

Adding intial code to process the NDP-026D station cloud climatology dataset

View differences:

climate/procedures/MOD06_L2_process_explore.r
1
###################################################################################
2
###  R code to aquire and process MOD06_L2 cloud data from the MODIS platform
3
## minor modification of the MOD06_L2_process.r script to explore data locally
4

  
5
# Redirect all warnings to stderr()
6
#options(warn = -1)
7
#write("2) write() to stderr", stderr())
8
#write("2) write() to stdout", stdout())
9
#warning("2) warning()")
10

  
11

  
12

  
13
date="20030301"
14
tile="h11v08"
15
outdir=paste("daily/",tile,"/",sep="")  #directory for separate daily files
16

  
17
## location of MOD06 files
18
datadir="~/acrobates/projects/interp/data/modis/Venezuela/MOD06"
19

  
20
### print some status messages
21
print(paste("Processing tile",tile," for date",date))
22

  
23
## load libraries
24
require(reshape)
25
require(geosphere)
26
require(raster)
27
require(rgdal)
28
require(spgrass6)
29
require(RSQLite)
30

  
31
## specify working directory
32
setwd(datadir)
33
## load tile information
34
load(file="../../../../modlandTiles.Rdata")
35

  
36
## path to MOD11A1 file for this tile to align grid/extent
37
gridfile=list.files("/nobackupp4/datapool/modis/MOD11A1.005/2006.01.27",pattern=paste(tile,".*[.]hdf$",sep=""),recursive=T,full=T)[1]
38
td=readGDAL(paste("HDF4_EOS:EOS_GRID:\"",gridfile,"\":MODIS_Grid_Daily_1km_LST:Night_view_angl",sep=""))
39
td=raster("~/acrobates/projects/interp/data/modis/mod06/summary/MOD06_h11v08.nc",varname="CER")
40
projection(td)="+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs +datum=WGS84 +ellps=WGS84 "
41

  
42
## vars to process
43
vars=as.data.frame(matrix(c(
44
  "Cloud_Effective_Radius",              "CER",
45
  "Cloud_Effective_Radius_1621",         "CER1621",
46
  "Cloud_Effective_Radius_Uncertainty",  "CERU",
47
  "Cloud_Effective_Radius_Uncertainty_1621",  "CERU1621",
48
  "Cloud_Optical_Thickness",             "COT",
49
  "Cloud_Optical_Thickness_Uncertainty", "COTU",
50
  "Cloud_Water_Path",                    "CWP",
51
  "Cloud_Water_Path_Uncertainty",        "CWPU",
52
  "Cloud_Phase_Optical_Properties",      "CPOP",
53
  "Cloud_Multi_Layer_Flag",              "CMLF",
54
  "Cloud_Mask_1km",                      "CM1",
55
  "Quality_Assurance_1km",               "QA"),
56
  byrow=T,ncol=2,dimnames=list(1:12,c("variable","varid"))),stringsAsFactors=F)
57

  
58
## vector of variables expected to be in final netcdf file.  If these are not present, the file will be deleted at the end.
59
finalvars=c("CER","COT","CLD")
60

  
61
############################################################################
62
############################################################################
63
### Define functions to process a particular date-tile
64

  
65
swath2grid=function(file,vars,upleft,lowright){
66
  ## Function to generate hegtool parameter file for multi-band HDF-EOS file
67
  print(paste("Starting file",basename(file)))
68
  outfile=paste(tempdir(),"/",basename(file),sep="")
69
  ## First write the parameter file (careful, heg is very finicky!)
70
  hdr=paste("NUM_RUNS = ",length(vars$varid),"|MULTI_BAND_HDFEOS:",length(vars$varid),sep="")
71
  grp=paste("
72
BEGIN
73
INPUT_FILENAME=",file,"
74
OBJECT_NAME=mod06
75
FIELD_NAME=",vars$variable,"|
76
BAND_NUMBER = 1
77
OUTPUT_PIXEL_SIZE_X=1000
78
OUTPUT_PIXEL_SIZE_Y=1000
79
SPATIAL_SUBSET_UL_CORNER = ( ",upleft," )
80
SPATIAL_SUBSET_LR_CORNER = ( ",lowright," )
81
#RESAMPLING_TYPE =",ifelse(grepl("Flag|Mask|Quality",vars),"NN","CUBIC"),"
82
RESAMPLING_TYPE =NN
83
OUTPUT_PROJECTION_TYPE = SIN
84
OUTPUT_PROJECTION_PARAMETERS = ( 6371007.181 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0 )
85
# projection parameters from http://landweb.nascom.nasa.gov/cgi-bin/QA_WWW/newPage.cgi?fileName=sn_gctp
86
ELLIPSOID_CODE = WGS84
87
OUTPUT_TYPE = HDFEOS
88
OUTPUT_FILENAME = ",outfile,"
89
END
90

  
91
",sep="")
92

  
93
  ## if any remnants from previous runs remain, delete them
94
  if(length(list.files(tempdir(),pattern=basename(file)))>0)
95
    file.remove(list.files(tempdir(),pattern=basename(file),full=T))
96
  ## write it to a file
97
  cat(c(hdr,grp)    , file=paste(tempdir(),"/",basename(file),"_MODparms.txt",sep=""))
98
  ## now run the swath2grid tool
99
  ## write the gridded file and save the log including the pid of the parent process
100
#  log=system(paste("( /nobackupp1/awilso10/software/heg/bin/swtif -p ",tempdir(),"/",basename(file),"_MODparms.txt -d ; echo $$)",sep=""),intern=T)
101
  log=system(paste("(sudo MRTDATADIR=\"/usr/local/heg/data\" ",
102
        "PGSHOME=/usr/local/heg/TOOLKIT_MTD PWD=/home/adamw /usr/local/heg/bin/swtif -p ",tempdir(),"/",basename(file),"_MODparms.txt)",sep=""),intern=T,ignore.stderr=F)
103
  ## clean up temporary files in working directory
104
#  file.remove(list.files(pattern=
105
#              paste("filetable.temp_",
106
#              as.numeric(log[length(log)]):(as.numeric(log[length(log)])+3),sep="",collapse="|")))  #Look for files with PID within 3 of parent process
107
  if(verbose) print(log)
108
  print(paste("Finished ", file))
109
}
110

  
111

  
112
##############################################################
113
### Import to GRASS for processing
114

  
115
## function to convert binary to decimal to assist in identifying correct values
116
## this is helpful when defining QA handling below, but isn't used in processing
117
## b2d=function(x) sum(x * 2^(rev(seq_along(x)) - 1)) #http://tolstoy.newcastle.edu.au/R/e2/help/07/02/10596.html
118
## for example:
119
## b2d(c(T,T))
120

  
121
  ## set Grass to overwrite
122
  Sys.setenv(GRASS_OVERWRITE=1)
123
  Sys.setenv(DEBUG=1)
124
  Sys.setenv(GRASS_GUI="txt")
125

  
126
### Function to extract various SDSs from a single gridded HDF file and use QA data to throw out 'bad' observations
127
loadcloud<-function(date,swaths,ncfile){
128
  ## make temporary working directory
129
  tf=paste(tempdir(),"/grass", Sys.getpid(),"/", sep="")  #temporar
130
  if(!file.exists(tf)) dir.create(tf)
131
  ## create output directory if needed
132
  if(!file.exists(dirname(ncfile))) dir.create(dirname(ncfile))
133
  
134
  ## set up temporary grass instance for this PID
135
  if(verbose) print(paste("Set up temporary grass session in",tf))
136
#  initGRASS(gisBase="/u/armichae/pr/grass-6.4.2/",gisDbase=tf,SG=td,override=T,location="mod06",mapset="PERMANENT",home=tf,pid=Sys.getpid())
137
  initGRASS(gisBase="/usr/lib/grass64/",gisDbase=tf,SG=as(td,"SpatialGridDataFrame"),override=T,location="mod06",mapset="PERMANENT",home=tf,pid=Sys.getpid())
138

  
139
  system(paste("g.proj -c proj4=\"",projection(td),"\"",sep=""),ignore.stdout=T,ignore.stderr=T)
140

  
141
  ## Define region by importing one MOD11A1 raster.
142
  print("Import one MOD11A1 raster to define grid")
143
  execGRASS("r.in.gdal",input="NETCDF:\"/home/adamw/acrobates/projects/interp/data/modis/mod06/summary/MOD06_h11v08.nc\":CER",output="modisgrid",flags=c("quiet","overwrite","o"))
144

  
145
  system("g.region rast=modisgrid.1 save=roi --overwrite",ignore.stdout=T,ignore.stderr=T)
146

  
147
  ## Identify which files to process
148
  tfs=basename(swaths)
149
  ## drop swaths that did not produce an output file (typically due to not overlapping the ROI)
150
  tfs=tfs[tfs%in%list.files(tempdir())]
151
  nfs=length(tfs)
152

  
153
  ## loop through scenes and process QA flags
154
  for(i in 1:nfs){
155
     file=paste(tempdir(),"/",tfs[i],sep="")
156
     ## Cloud Mask
157
     execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Mask_1km_0",sep=""),
158
              output=paste("CM1_",i,sep=""),flags=c("overwrite","o")) ; print("")
159
    ## extract cloudy and 'probably/confidently clear' pixels
160
    system(paste("r.mapcalc <<EOF
161
                CM_cloud_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) == 0 
162
                CM_clear_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) >  2 
163
                CM_uncertain_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) ==  1 
164
EOF",sep=""))
165
    ## QA
166
     execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Quality_Assurance_1km_0",sep=""),
167
             output=paste("QA_",i,sep=""),flags=c("overwrite","o")) ; print("")
168
   ## QA_CER
169
   system(paste("r.mapcalc <<EOF
170
                 QA_COT_",i,"=   ((QA_",i," / 2^0) % 2^1 )==1
171
                 QA_COT2_",i,"=  ((QA_",i," / 2^1) % 2^2 )>=2
172
                 QA_COT3_",i,"=  ((QA_",i," / 2^3) % 2^2 )==0
173
                 QA_CER_",i,"=   ((QA_",i," / 2^5) % 2^1 )==1
174
                 QA_CER2_",i,"=  ((QA_",i," / 2^6) % 2^2 )>=2
175

  
176
EOF",sep="")) 
177
#                 QA_CWP_",i,"=   ((QA_",i," / 2^8) % 2^1 )==1
178
#                 QA_CWP2_",i,"=  ((QA_",i," / 2^9) % 2^2 )==3
179

  
180
   ## Optical Thickness
181
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Optical_Thickness",sep=""),
182
            output=paste("COT_",i,sep=""),
183
            title="cloud_effective_radius",
184
            flags=c("overwrite","o")) ; print("")
185
   execGRASS("r.null",map=paste("COT_",i,sep=""),setnull="-9999")
186
   ## keep only positive COT values where quality is 'useful' and '>= good' & scale to real units
187
   system(paste("r.mapcalc \"COT_",i,"=if(QA_COT_",i,"&&QA_COT2_",i,"&&QA_COT3_",i,"&&COT_",i,">=0,COT_",i,"*0.009999999776482582,null())\"",sep=""))   
188
   ## set COT to 0 in clear-sky pixels
189
   system(paste("r.mapcalc \"COT2_",i,"=if(CM_clear_",i,"==0,COT_",i,",0)\"",sep=""))   
190

  
191
        execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Effective_Radius_1621",sep=""),
192
            output=paste("CER1621_",i,sep=""),
193
            title="cloud_effective_radius",
194
            flags=c("overwrite","o")) ; print("")
195
   execGRASS("r.null",map=paste("CER1621_",i,sep=""),setnull="-9999")
196
  ## keep only positive CER values where quality is 'useful' and '>= good' & scale to real units
197
   system(paste("r.mapcalc \"CER1621_",i,"=if(QA_CER_",i,"&&QA_CER2_",i,"&&CER_",i,">=0,CER1621_",i,"*0.009999999776482582,null())\"",sep=""))   
198
 
199
   ## Effective radius ##
200
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Effective_Radius",sep=""),
201
            output=paste("CER_",i,sep=""),
202
            title="cloud_effective_radius",
203
            flags=c("overwrite","o")) ; print("")
204
   execGRASS("r.null",map=paste("CER_",i,sep=""),setnull="-9999")
205
   ## keep only positive CER values where quality is 'useful' and '>= good' & scale to real units
206
   system(paste("r.mapcalc \"CER_",i,"=if(QA_CER_",i,"&&QA_CER2_",i,"&&CER_",i,">=0,CER_",i,"*0.009999999776482582,null())\"",sep=""))   
207
   ## set CER to 0 in clear-sky pixels
208
   system(paste("r.mapcalc \"CER2_",i,"=if(CM_clear_",i,"==0,CER_",i,",0)\"",sep=""))   
209

  
210
   ## Cloud Water Path
211
#   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Water_Path",sep=""),
212
#            output=paste("CWP_",i,sep=""),title="cloud_water_path",
213
#            flags=c("overwrite","o")) ; print("")
214
#   execGRASS("r.null",map=paste("CWP_",i,sep=""),setnull="-9999")
215
   ## keep only positive CER values where quality is 'useful' and 'very good' & scale to real units
216
#   system(paste("r.mapcalc \"CWP_",i,"=if(QA_CWP_",i,"&&QA_CWP2_",i,"&&CWP_",i,">=0,CWP_",i,"*0.009999999776482582,null())\"",sep=""))   
217
   ## set CER to 0 in clear-sky pixels
218
#   system(paste("r.mapcalc \"CWP2_",i,"=if(CM_clear_",i,"==0,CWP_",i,",0)\"",sep=""))   
219
     
220
 } #end loop through sub daily files
221

  
222
#### Now generate daily averages (or maximum in case of cloud flag)
223
  
224
  system(paste("r.mapcalc <<EOF
225
         COT_denom=",paste("!isnull(COT2_",1:nfs,")",sep="",collapse="+"),"
226
         COT_numer=",paste("if(isnull(COT2_",1:nfs,"),0,COT2_",1:nfs,")",sep="",collapse="+"),"
227
         COT_daily=int((COT_numer/COT_denom)*100)
228
         CER_denom=",paste("!isnull(CER2_",1:nfs,")",sep="",collapse="+"),"
229
         CER_numer=",paste("if(isnull(CER2_",1:nfs,"),0,CER2_",1:nfs,")",sep="",collapse="+"),"
230
         CER_daily=int(100*(CER_numer/CER_denom))
231
         CLD_daily=int((max(",paste("if(isnull(CM_cloud_",1:nfs,"),0,CM_cloud_",1:nfs,")",sep="",collapse=","),"))*100) 
232
EOF",sep=""))
233

  
234

  
235
  ### Write the files to a netcdf file
236
  ## create image group to facilitate export as multiband netcdf
237
    execGRASS("i.group",group="mod06",input=c("CER_daily","COT_daily","CLD_daily")) ; print("")
238
   
239
  if(file.exists(ncfile)) file.remove(ncfile)  #if it exists already, delete it
240
  execGRASS("r.out.gdal",input="mod06",output=ncfile,type="Int16",nodata=-32768,flags=c("quiet"),
241
#      createopt=c("FORMAT=NC4","ZLEVEL=5","COMPRESS=DEFLATE","WRITE_GDAL_TAGS=YES","WRITE_LONLAT=NO"),format="netCDF")  #for compressed netcdf
242
      createopt=c("FORMAT=NC","WRITE_GDAL_TAGS=YES","WRITE_LONLAT=NO"),format="netCDF")
243

  
244
  ncopath="/nasa/sles11/nco/4.0.8/gcc/mpt/bin/"
245
  system(paste(ncopath,"ncecat -O -u time ",ncfile," ",ncfile,sep=""))
246
## create temporary nc file with time information to append to MOD06 data
247
  cat(paste("
248
    netcdf time {
249
      dimensions:
250
        time = 1 ;
251
      variables:
252
        int time(time) ;
253
      time:units = \"days since 2000-01-01 00:00:00\" ;
254
      time:calendar = \"gregorian\";
255
      time:long_name = \"time of observation\"; 
256
    data:
257
      time=",as.integer(as.Date(date,"%Y%m%d")-as.Date("2000-01-01")),";
258
    }"),file=paste(tempdir(),"/time.cdl",sep=""))
259
system(paste("ncgen -o ",tempdir(),"/time.nc ",tempdir(),"/time.cdl",sep=""))
260
system(paste(ncopath,"ncks -A ",tempdir(),"/time.nc ",ncfile,sep=""))
261
## add other attributes
262
  system(paste(ncopath,"ncrename -v Band1,CER -v Band2,COT -v Band3,CLD ",ncfile,sep=""))
263
  system(paste(ncopath,"ncatted -a scale_factor,CER,o,d,0.01 -a units,CER,o,c,\"micron\" -a missing_value,CER,o,d,-32768 -a long_name,CER,o,c,\"Cloud Particle Effective Radius\" ",ncfile,sep=""))
264
  system(paste(ncopath,"ncatted -a scale_factor,COT,o,d,0.01 -a units,COT,o,c,\"none\" -a missing_value,COT,o,d,-32768 -a long_name,COT,o,c,\"Cloud Optical Thickness\" ",ncfile,sep=""))
265
  system(paste(ncopath,"ncatted -a scale_factor,CLD,o,d,0.01 -a units,CLD,o,c,\"none\" -a missing_value,CLD,o,d,-32768 -a long_name,CLD,o,c,\"Cloud Mask\" ",ncfile,sep=""))
266
   
267
  
268
### delete the temporary files 
269
  unlink_.gislock()
270
  system(paste("rm -frR ",tf,sep=""))
271
}
272

  
273

  
274
###########################################
275
### Define a wrapper function that will call the two functions above (gridding and QA-handling) for a single tile-date
276

  
277
mod06<-function(date,tile){
278
  print(paste("Processing date ",date," for tile",tile))
279
  #####################################################
280
  ## Run the gridding procedure
281
  tile_bb=tb[tb$tile==tile,] ## identify tile of interest
282
  
283
  ##find swaths in region from sqlite database for the specified date/tile
284
  if(verbose) print("Accessing swath ID's from database")
285
  con=dbConnect("SQLite", dbname = db)
286
  fs=dbGetQuery(con,paste("SELECT * from swath_geo
287
            WHERE east>=",tile_bb$lon_min," AND
288
                  west<=",tile_bb$lon_max," AND
289
                  north>=",tile_bb$lat_min," AND
290
                  south<=",tile_bb$lat_max," AND
291
                  year==",format(as.Date(date,"%Y%m%d"),"%Y")," AND
292
                  day==",as.numeric(format(as.Date(date,"%Y%m%d"),"%j"))
293
    ))
294
  con=dbDisconnect(con)
295
  fs$id=substr(fs$id,7,19)
296
  if(verbose) print(paste("###############",nrow(fs)," swath IDs recieved from database"))
297

  
298
  fs=data.frame(path=basename(list.files(datadir, recursive=T,pattern="hdf$",full=F)))
299
  fs$id=substr(fs$path,8,26)
300
  fs=fs[1:50,]
301
  
302
  ## find the swaths on disk (using datadir)
303
  dateid="20011365"
304
  swaths=list.files(datadir,recursive=T,pattern="hdf$",full=T)
305

  
306
  ## Run the gridding procedure
307
  lapply(swaths[1:10],swath2grid,vars=vars,upleft=paste(tile_bb$lat_max,tile_bb$lon_min),lowright=paste(tile_bb$lat_min,tile_bb$lon_max))
308
swaths=list.files(tempdir(),pattern="hdf$")
309
  ## confirm at least one file for this date is present
310
    outfiles=paste(tempdir(),"/",basename(swaths),sep="")
311
    if(!any(file.exists(outfiles))) {
312
      print(paste("########################################   No gridded files for region exist for tile",tile," on date",date))
313
      q("no",status=0)
314
    }
315

  
316
#####################################################
317
  ## Process the gridded files
318
  
319
  ## run the mod06 processing for this date
320
  ncfile=paste(outdir,"/MOD06_",tile,"_",date,".nc",sep="")  #this is the 'final' daily output file
321
  loadcloud(date,swaths=swaths,ncfile=ncfile)
322
  
323
  ## Confirm that the file has the correct attributes, otherwise delete it
324
  ntime=as.numeric(system(paste("cdo -s ntime ",ncfile),intern=T))
325
  ## confirm it has all 'final variables as specified above"
326
  fvar=all(finalvars%in%do.call(c,strsplit(system(paste("cdo -s showvar ",ncfile),intern=T)," ")))
327

  
328
  if(!ntime==1&fvar) {
329
      print(paste("FILE ERROR:  tile ",tile," and date ",date," was not outputted correctly, deleting... "))
330
      file.remove(ncfile)
331
    }
332
    
333
  ## print out some info
334
  print(paste(" ###################################################################               Finished ",date,"
335
################################################################"))
336
}
337
 
338
## test it
339
##date=notdone[1]
340
mod06(date,tile)
341

  
342
## run it for all dates  - Use this if running on a workstation/server (otherwise use qsub)
343
#mclapply(notdone,mod06,tile,mc.cores=ncores) # use ncores/2 because system() commands can add second process for each spawned R
344
#foreach(i=notdone[1:3],.packages=(.packages())) %dopar% mod06(i,tile)
345
#foreach(i=1:20) %dopar% print(i)
346

  
347

  
348
#######################################
349
#######################################
350
library(rasterVis)
351

  
352
### explore %missing and landcover data
353
lulc=raster("~/acrobatesroot/data/environ/global/landcover/MODIS/MCD12Q1_IGBP_2005_v51.tif")
354
lulc=as.factor(tlulc)
355
lulc_levels=c("Water","Evergreen Needleleaf forest","Evergreen Broadleaf forest","Deciduous Needleleaf forest","Deciduous Broadleaf forest","Mixed forest","Closed shrublands","Open shrublands","Woody savannas","Savannas","Grasslands","Permanent wetlands","Croplands","Urban and built-up","Cropland/Natural vegetation mosaic","Snow and ice","Barren or sparsely vegetated")
356
levels(lulc)=list(data.frame(ID=0:16,levels=lulc_levels))
357

  
358
tiles=c("h21v09","h09v04","h21v11","h31v11")
359

  
360
tile=tiles[1]
361
month=1
362
#mod06summary<-function(tile,month=1){
363
  mod06=brick(
364
    subset(brick(paste("../../mod06/summary/MOD06_",tile,".nc",sep=""),varname="CER"),subset=month),
365
    subset(brick(paste("../../mod06/summary/MOD06_",tile,".nc",sep=""),varname="CER_pmiss"),subset=month),
366
    subset(brick(paste("../../mod06/summary/MOD06_",tile,".nc",sep=""),varname="CLD"),subset=month)
367
    )
368
  projection(mod06)=projection(lulc)
369
  ## get land cover
370
  ## align lulc with nc
371
  tlulc=crop(lulc,mod06)
372
  tlulc=resample(tlulc,mod06,method="ngb")
373
  plot(tlulc)
374

  
375
plot(mod06)
376
plot(tlulc,add=T)
377
  
378
levelplot(mod06)
379
lulcl=cbind(melt(as.matrix(nc)),melt(as.matrix(lulc))[,3])
380
colnames(lulcl)=c("x","y","CER_Pmiss","LULC")
381
lulcl$LULC=factor(lulcl$LULC,labels=lulc_levels)
382

  
383
top4=names(sort(table(lulcl$LULC),dec=T)[1:4])
384
tapply(lulcl$CER_Pmiss,lulcl$LULC,summary)
385
bwplot(LULC~CER_Pmiss,data=lulcl[lulcl$LULC%in%top4,],horizontal=T,main="Missing data in MOD06_L2 for tile H11V08 (Venezuela)",xlab="% missing data across all January swaths 2000-2011",sub="Showing only 4 most common LULC classes in tile from MCD12Q1")
386

  
387

  
388
levelplot(LULC~x*y,data=lulcl,auto.key=T)
389

  
390
## delete old files
391
system("cleartemp")
392

  
393
q("no",status=0)
climate/procedures/MOD44W.R
1
### Script to download and process the MOD44W water mask from the USGS
2

  
3
setwd("/home/adamw/acrobates/Global/land")
4
url="http://e4ftl01.cr.usgs.gov/MOLT/MOD44W.005/2000.02.24/"
5

  
6

  
7
### download the 250m land tiles
8
system(paste("wget -np -nd --no-clobber -r ",url," -P tiles -R html -A hdf"))
9

  
10
## modis projection
11
mproj="+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +units=m +no_defs"
12

  
13
## destination projection
14
dproj="+proj=cea +ellps=WGS84 +lat_ts=30"
15

  
16
### Get list of tiles
17
files=list.files("tiles",recursive=T,full=T)
18
maskfiles=paste("HDF4_EOS:EOS_GRID:\"",files,"\":MOD44W_250m_GRID:water_mask",sep="")
19
## write out a table of files to process into VRT
20
write.table(maskfiles,file="tiles.txt",row.names=F,col.names=F,quote=F)
21
## how many are there?
22
length(files)
23

  
24
## check them out
25
system(paste("gdalinfo ",files[1]))
26
system(paste("gdalinfo ",maskfiles[1]))
27

  
28
## test conversion of one tile
29
system(paste("gdalwarp -overwrite -multi -s_srs \"",mproj,"\" -t_srs \"",dproj,"\" -co COMPRESS=LZW -r near ",maskfiles[307]," land_behrmann.tif"))
30

  
31
### create VRT
32
system(paste("gdalbuildvrt -overwrite -input_file_list tiles.txt land.vrt"))
33
system(paste("gdalwarp -overwrite -multi -s_srs \"",mproj,"\" -t_srs \"",dproj,"\" -of GTiff -co COMPRESS=LZW land.vrt land.tif"))
34

  
35
## mosaic directly from tiles to tif
36
system(paste("gdal_merge.py -of GTiff -co COMPRESS=LZW -o land.tif ",paste(maskfiles,collapse=" ")))
37

  
38
system(paste("gdalwarp -overwrite -multi -s_srs \"",mproj,"\" -t_srs \"",dproj,"\" -of vrt -r near land.vrt land_behrmann.vrt"))
39
system(paste("gdal_translate -of GTiff -co COMPRESS=LZW land_behrmann.vrt land_behrmann.tif"))
40

  
41
system("gdalinfo land_behrmann.vrt")
climate/procedures/MODLANDtile_BoundingBox.R
1
### script to return bounding box for a list of tiles
2

  
3
## import commandline arguments
4
library(getopt)
5
## get options
6
opta <- getopt(matrix(c(
7
                        'tile', 't', 1, 'character'
8
                        ), ncol=4, byrow=TRUE))
9
if(is.null(opta$tile)) stop("Please provide a list of tiles.  For example, -t \"h11v08,h12v09\"")
10

  
11
tiles=sub(" ","",tolower(do.call(c,strsplit(opta$tile,split=","))))
12

  
13
### get tile boundaries
14
tb=read.table("http://landweb.nascom.nasa.gov/developers/sn_tiles/sn_bound_10deg.txt",skip=6,nrows=648,header=T)
15
tb$tile=paste("h",sprintf("%02d",tb$ih),"v",sprintf("%02d",tb$iv),sep="")
16

  
17

  
18
## get minmax for all tiles
19
tb2=tb[tb$tile%in%tiles,]
20

  
21
print(tb2)
22

  
23
## print summary
24
print(paste("Getting bounding box for tiles: ",paste(tb2$tile,collapse=", ")))
25
print(paste("lon[",min(tb2$lon_min),",",max(tb2$lon_max),"]  lat[",min(tb2$lat_min),",",max(tb2$lat_max),"]"))
26

  
27

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

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

  
7

  
8
## Get station locations
9
system("wget -nd http://cdiac.ornl.gov/ftp/ndp026d/cat01/01_STID -P data/")
10
st=read.table("data/01_STID",skip=1)
11
colnames(st)=c("StaID","LAT","LON","ELEV","ny1","fy1","ly1","ny7","fy7","ly7","SDC","b5c")
12
st$lat=st$LAT/100
13
st$lon=st$LON/100
14
st$lon[st$lon>180]=st$lon[st$lon>180]-360
15

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

  
19

  
20
## get monthly mean cloud amount MMCA
21
system("wget -N -nd ftp://cdiac.ornl.gov/pub/ndp026d/cat67_78/* -A '.tc.Z' -P data/")
22
system("gunzip data/*.Z")
23

  
24
#f121=c(6,6,6,7,6,7,6,2) #format 121
25
#c121=c("StaID","NobD","AvgDy","NobN","AvgNt","NobDN","AvgDN","Acode")
26
f162=c(5,5,4,7,7,7,4) #format 121
27
c162=c("StaID","YR","Nobs","Amt","Fq","AWP","NC")
28

  
29
cld=do.call(rbind.data.frame,lapply(sprintf("%02d",1:12),function(m) {
30
  d=read.fwf(list.files("data",pattern=paste("MNYDC.",m,".tc",sep=""),full=T),skip=1,widths=f162)
31
  colnames(d)=c162
32
  d$month=as.numeric(m)
33
  return(d)}
34
  ))
35

  
36
cld[,c("lat","lon")]=st[match(st$StaID,cld$StaID),c("lat","lon")]
37

  
38
## calculate means
39
cldm=by(cld,list(as.factor(cld$month),as.factor(cld$StaID)),function(x){
40
  data.frame(Amt=mean(x$Amt[x$Nobs>20],na.rm=T))})
41

  
42

  
43
## add color val
44
cld$Amt[cld$Amt<0]=NA
45
cld$Fq[cld$Fq<0]=NA
46
cld$AWP[cld$AWP<0]=NA
47
cld$NC[cld$NC<0]=NA
48

  
49
cld$col=cut(cld$Amt/100,quantile(cld$Amt/100,seq(0,1,len=5),na.rm=T))
50

  
51
library(lattice)
52
xyplot(lat~lon|as.factor(YR)+as.factor(month),groups=col,data=cld,pch=16,cex=.2,auto.key=T)

Also available in: Unified diff