Project

General

Profile

Download (15.7 KB) Statistics
| Branch: | Revision:
1
###################################################################################
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(rgdal)
11
library(reshape)
12
library(ncdf4)
13
library(geosphere)
14
library(rgeos)
15
library(multicore)
16
library(raster)
17
library(lattice)
18
library(rgl)
19
library(hdf5)
20
library(spgrass6)
21

    
22

    
23
### set options for Raster Package
24
setOptions(progress="text",timer=T)
25

    
26
X11.options(type="Xlib")
27
ncores=20  #number of threads to use
28

    
29
setwd("/home/adamw/personal/projects/interp")
30
setwd("/home/adamw/acrobates/projects/interp")
31

    
32
## read in shapefile as Region of Interest (roi)
33
roi=readOGR("data/regions/Test_sites/Oregon.shp","Oregon")
34
roi=spTransform(roi,CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0"))
35

    
36
### use MODIS tile as ROI instead
37
modt=readOGR("/home/adamw/acrobates/Global/modis_sinusoidal","modis_sinusoidal_grid_world",)
38
tiles=c("H9V4") #oregon
39
tiles=c("H11V8") #Venezuela
40

    
41
roi=modt[modt$HV%in%tiles,]
42

    
43
## Bounding box of region in lat/lon
44
roi_ll=spTransform(roi,CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"))
45
roi_bb=bbox(roi_ll)
46
     
47
### Downloading data from LAADSWEB
48
# subset by geographic area of interest
49

    
50
## download data from ftp site.  Unfortunately the selection has to be selected using the website and orders downloaded via ftp.
51

    
52
#system("wget -r --retr-symlinks ftp://ladsweb.nascom.nasa.gov/orders/500676499/ -P /home/adamw/acrobates/projects/interp/data/modis/MOD06_L2_hdf")
53

    
54
## specify some working directories
55
gdir="output/"
56
#datadir="data/modis/MOD06_L2_hdf"
57
#outdir="data/modis/MOD06_L2_hdf2"
58
#tifdir="/media/data/MOD06_L2_tif"
59
#summarydatadir="data/modis/MOD06_climatologies"
60
datadir="data/modis/Venezuela/MOD06"
61
outdir="data/modis/Venezuela/MOD06_"
62
#tifdir="/media/data/MOD06_L2_tif"
63
summarydatadir="data/modis/MOD06_climatologies"
64

    
65

    
66
fs=data.frame(
67
  path=list.files(datadir,full=T,recursive=T,pattern="hdf"),
68
  file=basename(list.files(datadir,full=F,recursive=T,pattern="hdf")))
69
fs$date=as.Date(substr(fs$file,11,17),"%Y%j")
70
fs$month=format(fs$date,"%m")
71
fs$year=format(fs$date,"%Y")
72
fs$time=substr(fs$file,19,22)
73
fs$datetime=as.POSIXct(strptime(paste(substr(fs$file,11,17),substr(fs$file,19,22)), '%Y%j %H%M'))
74
fs$dateid=format(fs$date,"%Y%m%d")
75
fs$path=as.character(fs$path)
76
fs$file=as.character(fs$file)
77

    
78
## output ROI
79
#get bounding box of region in m
80
#ge=SpatialPoints(data.frame(lon=c(-125,-115),lat=c(40,47)))
81
#projection(ge)=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
82
#ge2=spTransform(ge, CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0"))
83

    
84
## vars
85
vars=as.data.frame(matrix(c(
86
  "Cloud_Effective_Radius",              "CER",
87
  "Cloud_Effective_Radius_Uncertainty",  "CERU",
88
  "Cloud_Optical_Thickness",             "COT",
89
  "Cloud_Optical_Thickness_Uncertainty", "COTU",
90
  "Cloud_Water_Path",                    "CWP",
91
  "Cloud_Water_Path_Uncertainty",        "CWPU",
92
  "Cloud_Phase_Optical_Properties",      "CPOP",
93
  "Cloud_Multi_Layer_Flag",              "CMLF",
94
  "Cloud_Mask_1km",                      "CM1",
95
  "Quality_Assurance_1km",               "QA"),
96
  byrow=T,ncol=2,dimnames=list(1:10,c("variable","varid"))),stringsAsFactors=F)
97

    
98

    
99
### Installation of hegtool
100
## needed 32-bit libraries and java for program to install correctly
101

    
102
# system(paste("hegtool -h ",fs$path[1],sep=""))
103

    
104

    
105
#### Function to generate hegtool parameter file for multi-band HDF-EOS file
106
swath2grid=function(i=1,files,vars,outdir,upleft,lowright){
107
  file=fs$path[i]
108
  print(paste("Starting file",basename(file)))
109
  outfile=paste(outdir,"/",fs$file[i],sep="")
110
### First write the parameter file (careful, heg is very finicky!)
111
  hdr=paste("NUM_RUNS = ",length(vars),"|MULTI_BAND_HDFEOS:",length(vars),sep="")
112
  grp=paste("
113
BEGIN
114
INPUT_FILENAME=",file,"
115
OBJECT_NAME=mod06
116
FIELD_NAME=",vars,"|
117
BAND_NUMBER = 1
118
OUTPUT_PIXEL_SIZE_X=1000
119
OUTPUT_PIXEL_SIZE_Y=1000
120
SPATIAL_SUBSET_UL_CORNER = ( ",upleft," )
121
SPATIAL_SUBSET_LR_CORNER = ( ",lowright," )
122
#RESAMPLING_TYPE =",ifelse(grepl("Flag|Mask|Quality",vars),"NN","CUBIC"),"
123
RESAMPLING_TYPE =NN
124
OUTPUT_PROJECTION_TYPE = UTM
125
UTM_ZONE = 10
126
# OUTPUT_PROJECTION_PARAMETERS = ( 6371007.181 0.0 0.0 0.0 0.0 0.0 0.0 0.0 86400.0 0.0 1.0 0.0 0.0 0.0 0.0 )
127
# projection parameters from http://landweb.nascom.nasa.gov/cgi-bin/QA_WWW/newPage.cgi?fileName=is_gctp
128
ELLIPSOID_CODE = WGS84
129
OUTPUT_TYPE = HDFEOS
130
OUTPUT_FILENAME = ",outfile,"
131
END
132

    
133
",sep="")
134
  
135
  ## if any remnants from previous runs remain, delete them
136
  if(length(list.files(tempdir(),pattern=basename(file)))>0)
137
    file.remove(list.files(tempdir(),pattern=basename(file),full=T))
138
  ## write it to a file
139
  cat(c(hdr,grp)    , file=paste(tempdir(),"/",basename(file),"_MODparms.txt",sep=""))
140
  ## now run the swath2grid tool
141
  ## write the tiff file
142
  log=system(paste("sudo MRTDATADIR=/usr/local/heg/data ",
143
    "PGSHOME=/usr/local/heg/TOOLKIT_MTD PWD=/home/adamw /usr/local/heg/bin/swtif -p ",
144
    paste(tempdir(),"/",basename(file),"_MODparms.txt -d",sep=""),sep=""),intern=T)
145
      print(paste("Finished ", file))
146
}
147
 
148

    
149
### update fs with completed files
150
fs$complete=fs$file%in%list.files(outdir,pattern="hdf$")
151
table(fs$complete)
152

    
153
## must be run as root to access the data directory!  argh!
154
## run sudo once here to enter password before continuing
155
system('sudo ls')
156

    
157
#### Run the gridding procedure
158
mclapply(which(!fs$complete),function(fi){
159
  swath2grid(fi,vars=vars$variable,files=fs,
160
             outdir=outdir,
161
             upleft=paste(roi_bb[2,2],roi_bb[1,1]),
162
             lowright=paste(roi_bb[2,1],roi_bb[1,2]))},
163
         mc.cores=24)
164

    
165

    
166
##############################################################
167
### Import to GRASS for processing
168

    
169
#fs$grass=paste(fs$month,fs$year,fs$file,sep="_")
170
td=readGDAL(paste("HDF4_EOS:EOS_GRID:\"",outdir,"/",fs$file[1],"\":mod06:Cloud_Mask_1km_0",sep=""))
171
#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 "
172
projection(td)="+proj=utm +zone=10 +ellps=WGS84 +datum=WGS84 +units=m +no_defs"
173

    
174
## fucntion to convert binary to decimal to assist in identifying correct values
175
b2d=function(x) sum(x * 2^(rev(seq_along(x)) - 1)) #http://tolstoy.newcastle.edu.au/R/e2/help/07/02/10596.html
176
## for example:
177
b2d(c(T,T))
178

    
179
### create (or connect to) grass location
180
gisDbase="/media/data/grassdata"
181
gisLocation="oregon"
182
gisMapset="mod06"
183
## set Grass to overwrite
184
Sys.setenv(GRASS_OVERWRITE=1)
185
Sys.setenv(DEBUG=0)
186

    
187
## temporary objects to test function below
188
 i=1
189
file=paste(outdir,"/",fs$file[1],sep="")
190
date=as.Date("2000-05-23")
191

    
192

    
193
### Function to extract various SDSs from a single gridded HDF file and use QA data to throw out 'bad' observations
194
loadcloud<-function(date,fs){
195
### set up unique grass session
196
  tf=paste(tempdir(),"/grass", Sys.getpid(),"/", sep="")
197
 
198
  ## set up tempfile for this PID
199
  initGRASS(gisBase="/usr/lib/grass64",gisDbase=tf,SG=td,override=T,location="mod06",mapset="PERMANENT",home=tf,pid=Sys.getpid())
200
#  system(paste("g.proj -c proj4=\"+proj=sinu +lon_0=0 +x_0=0 +y_0=0 +a=6371007.181 +b=6371007.181 +datum=WGS84 +units=m +no_defs\"",sep=""))
201
    system(paste("g.proj -c proj4=\"+proj=utm +zone=10 +ellps=WGS84 +datum=WGS84 +units=m +no_defs\"",sep=""))
202

    
203
  ## Define region by importing one raster.
204
  execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",outdir,"/",fs$file[1],"\":mod06:Cloud_Mask_1km_0",sep=""),
205
            output="modisgrid",flags=c("quiet","overwrite","o"))
206
  system("g.region rast=modisgrid save=roi --overwrite")
207
  system("g.region roi")
208
  system("g.region -p")
209

    
210
  ## Identify which files to process
211
  tfs=fs$file[fs$date==date]
212
  nfs=length(tfs)
213

    
214
  ### print some summary info
215
  print(date)
216
  ## loop through scenes and process QA flags
217
  for(i in 1:nfs){
218
     file=paste(outdir,"/",tfs[i],sep="")
219
     ## Cloud Mask
220
     execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Mask_1km_0",sep=""),
221
              output=paste("CM1_",i,sep=""),flags=c("overwrite","o")) ; print("")
222
    ## extract cloudy and 'confidently clear' pixels
223
    system(paste("r.mapcalc <<EOF
224
                CM_cloud_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) == 0 
225
                CM_clear_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) == 3 
226
EOF",sep=""))
227

    
228
    ## QA
229
    execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Quality_Assurance_1km_0",sep=""),
230
             output=paste("QA_",i,sep=""),flags=c("overwrite","o")) ; print("")
231
   ## QA_CER
232
   system(paste("r.mapcalc <<EOF
233
                 QA_COT_",i,"=   ((QA_",i," / 2^0) % 2^1 )==1
234
                 QA_COT2_",i,"=  ((QA_",i," / 2^1) % 2^2 )==3
235
                 QA_COT3_",i,"=  ((QA_",i," / 2^3) % 2^2 )==0
236
                 QA_CER_",i,"=   ((QA_",i," / 2^5) % 2^1 )==1
237
                 QA_CER2_",i,"=  ((QA_",i," / 2^6) % 2^2 )==3
238
EOF",sep="")) 
239
#                 QA_CWP_",i,"=   ((QA_",i," / 2^8) % 2^1 )==1
240
#                 QA_CWP2_",i,"=  ((QA_",i," / 2^9) % 2^2 )==3
241

    
242
   ## Optical Thickness
243
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Optical_Thickness",sep=""),
244
            output=paste("COT_",i,sep=""),
245
            title="cloud_effective_radius",
246
            flags=c("overwrite","o")) ; print("")
247
   execGRASS("r.null",map=paste("COT_",i,sep=""),setnull="-9999")
248
   ## keep only positive COT values where quality is 'useful' and 'very good' & scale to real units
249
   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=""))   
250
   ## set COT to 0 in clear-sky pixels
251
   system(paste("r.mapcalc \"COT2_",i,"=if(CM_clear_",i,"==0,COT_",i,",0)\"",sep=""))   
252
   
253
   ## Effective radius ##
254
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Effective_Radius",sep=""),
255
            output=paste("CER_",i,sep=""),
256
            title="cloud_effective_radius",
257
            flags=c("overwrite","o")) ; print("")
258
   execGRASS("r.null",map=paste("CER_",i,sep=""),setnull="-9999")
259
   ## keep only positive CER values where quality is 'useful' and 'very good' & scale to real units
260
   system(paste("r.mapcalc \"CER_",i,"=if(QA_CER_",i,"&&QA_CER2_",i,"&&CER_",i,">=0,CER_",i,"*0.009999999776482582,null())\"",sep=""))   
261
   ## set CER to 0 in clear-sky pixels
262
   system(paste("r.mapcalc \"CER2_",i,"=if(CM_clear_",i,"==0,CER_",i,",0)\"",sep=""))   
263

    
264
   ## Cloud Water Path
265
#   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Water_Path",sep=""),
266
#            output=paste("CWP_",i,sep=""),title="cloud_water_path",
267
#            flags=c("overwrite","o")) ; print("")
268
#   execGRASS("r.null",map=paste("CWP_",i,sep=""),setnull="-9999")
269
   ## keep only positive CER values where quality is 'useful' and 'very good' & scale to real units
270
#   system(paste("r.mapcalc \"CWP_",i,"=if(QA_CWP_",i,"&&QA_CWP2_",i,"&&CWP_",i,">=0,CWP_",i,"*0.009999999776482582,null())\"",sep=""))   
271
   ## set CER to 0 in clear-sky pixels
272
#   system(paste("r.mapcalc \"CWP2_",i,"=if(CM_clear_",i,"==0,CWP_",i,",0)\"",sep=""))   
273
     
274
 } #end loop through sub daily files
275

    
276
#### Now generate daily averages (or maximum in case of cloud flag)
277
  
278
  system(paste("r.mapcalc <<EOF
279
         COT_denom=",paste("!isnull(COT2_",1:nfs,")",sep="",collapse="+"),"
280
         COT_numer=",paste("if(isnull(COT2_",1:nfs,"),0,COT2_",1:nfs,")",sep="",collapse="+"),"
281
         COT_daily=COT_numer/COT_denom
282
         CER_denom=",paste("!isnull(CER2_",1:nfs,")",sep="",collapse="+"),"
283
         CER_numer=",paste("if(isnull(CER2_",1:nfs,"),0,CER2_",1:nfs,")",sep="",collapse="+"),"
284
         CER_daily=CER_numer/CER_denom
285
         CLD_daily=max(",paste("if(isnull(CM_cloud_",1:nfs,"),0,CM_cloud_",1:nfs,")",sep="",collapse=","),") 
286
EOF",sep=""))
287

    
288
  #### Write the files to a geotiff
289
  execGRASS("r.out.gdal",input="CER_daily",output=paste(tifdir,"/CER_",format(date,"%Y%m%d"),".tif",sep=""),nodata=-999,flags=c("quiet"))
290
  execGRASS("r.out.gdal",input="COT_daily",output=paste(tifdir,"/COT_",format(date,"%Y%m%d"),".tif",sep=""),nodata=-999,flags=c("quiet"))
291
  execGRASS("r.out.gdal",input="CLD_daily",output=paste(tifdir,"/CLD_",format(date,"%Y%m%d"),".tif",sep=""),nodata=99,flags=c("quiet"))
292

    
293
### delete the temporary files 
294
  unlink_.gislock()
295
  system("/usr/lib/grass64/etc/clean_temp")
296
 system(paste("rm -R ",tf,sep=""))
297
### print update
298
  print(paste(" ###################################################################               Finished ",date,"
299
################################################################"))
300
}
301

    
302

    
303
###########################################
304
### Now run it
305

    
306
tdates=sort(unique(fs$date))
307
done=tdates%in%as.Date(substr(list.files(tifdir),5,12),"%Y%m%d")
308
table(done)
309
tdates=tdates[!done]
310

    
311
mclapply(tdates,function(date) loadcloud(date,fs=fs))
312

    
313
 
314

    
315
#######################################################################################33
316
###  Produce the monthly averages
317

    
318
## get list of daily files
319
fs2=data.frame(
320
  path=list.files(tifdir,full=T,recursive=T,pattern="tif$"),
321
  file=basename(list.files(tifdir,full=F,recursive=T,pattern="tif$")))
322
fs2$type=substr(fs2$file,1,3)
323
fs2$date=as.Date(substr(fs2$file,5,12),"%Y%m%d")
324
fs2$month=format(fs2$date,"%m")
325
fs2$year=format(fs2$date,"%Y")
326
fs2$path=as.character(fs2$path)
327
fs2$file=as.character(fs2$file)
328

    
329

    
330
# Define type/month products
331
vs=expand.grid(type=unique(fs2$type),month=c("01","02","03","04","05","06","07","08","09","10","11","12"))
332

    
333
## identify which have been completed
334
done.vs=unique(do.call(rbind,strsplit(list.files(summarydatadir),"_|[.]"))[,c(1,3)])
335
done.vs=paste(vs$type,vs$month,sep="_")%in%paste(done.vs[,1],done.vs[,2],sep="_")
336
table(done.vs)
337
vs=vs[!done.vs,]
338

    
339
#tfs=fs2$path[which(fs2$month==vs$month[i]&fs2$type==vs$type[i])]
340
#do.call(c,mclapply(2:length(tfs),function(f) #identical(extent(raster(tfs[f-1])),extent(raster(tfs[f])))))
341
#raster(tfs[23])
342

    
343
## process the monthly summaries using the raster package
344
mclapply(1:nrow(vs),function(i){
345
  print(paste("Loading ",vs$type[i]," for month ",vs$month[i]))
346
  td=stack(fs2$path[which(fs2$month==vs$month[i]&fs2$type==vs$type[i])])
347
  print(paste("Processing Metric ",vs$type[i]," for month ",vs$month[i]))
348
  calc(td,mean,na.rm=T,
349
       filename=paste(summarydatadir,"/",vs$type[i],"_mean_",vs$month[i],".tif",sep=""),
350
       format="GTiff",overwrite=T)
351
  calc(td,sd,na.rm=T,
352
       filename=paste(summarydatadir,"/",vs$type[i],"_sd_",vs$month[i],".tif",sep=""),
353
       format="GTiff",overwrite=T)
354
  if(vs$type[i]%in%c("CER")) {
355
    ## Calculate number of days with effective radius > 20um, found to be linked to precipitating clouds
356
    ## (Kobayashi 2007)
357
    calc(td,function(x) mean(ifelse(x<20,0,1),na.rm=T),
358
      filename=paste(summarydatadir,"/",vs$type[i],"_P20um_",vs$month[i],".tif",sep=""),
359
      format="GTiff",overwrite=T)
360
#    td2[td2<20]=0
361
#    td2[td2>=20]=1
362
#    calc(td2,mean,na.rm=T,
363
#         filename=paste(summarydatadir,"/",vs$type[i],"_P20um_",vs$month[i],".tif",sep=""),
364
#         format="GTiff",overwrite=T)
365
  }  
366
  print(paste("Processing missing data for ",vs$type[i]," for month ",vs$month[i]))
367
  calc(td,function(i)
368
       sum(!is.na(i)),filename=paste(summarydatadir,"/",vs$type[i],"_count_",vs$month[i],".tif",sep=""),
369
       format="GTiff",overwrite=T)
370
  calc(td,function(i) sum(ifelse(i==0,0,1)),
371
       filename=paste(summarydatadir,"/",vs$type[i],"_clear_",vs$month[i],".tif",sep=""),format="GTiff",overwrite=T)
372
  gc()
373
}
374
)
375

    
376

    
377
vs[c(10:18,22:24,34:36),]
378

    
379
#### reproject to Oregon state plane for easy comparison with Benoit's data
380
dest=raster("data/regions/oregon/lulc/W_Layer1_ClippedTo_OR83M.rst")  # choose one to match (projection, resolution, extent)
381
projection(dest)=CRS("+proj=lcc +lat_1=43 +lat_2=45.5 +lat_0=41.75 +lon_0=-120.5 +x_0=400000 +y_0=0 +ellps=GRS80 +units=m +no_defs") #define projection
382
tifs=list.files(summarydatadir,pattern="*.tif$",full=T) #get list of files to process
383
mclapply(tifs,function(f) projectRaster(raster(f),dest,filename=paste(dirname(f),"/OR03M_",basename(f),sep=""),overwrite=T))  # warp them
384

    
385

    
386

    
(4-4/18)