Project

General

Profile

Download (13.9 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
roi=readOGR("data/regions/Test_sites/Oregon.shp","Oregon")
33
roi=spTransform(roi,CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0"))
34

    
35
### Downloading data from LAADSWEB
36
# subset by geographic area of interest
37
# subset: 40-47, -115--125
38

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

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

    
43
## specify some working directories
44
gdir="output/"
45
datadir="data/modis/MOD06_L2_hdf"
46
outdir="data/modis/MOD06_L2_hdf2"
47
tifdir="/media/data/MOD06_L2_tif"
48
summarydatadir="data/modis/MOD06_climatologies"
49

    
50

    
51
fs=data.frame(
52
  path=list.files(datadir,full=T,recursive=T,pattern="hdf"),
53
  file=basename(list.files(datadir,full=F,recursive=T,pattern="hdf")))
54
fs$date=as.Date(substr(fs$file,11,17),"%Y%j")
55
fs$month=format(fs$date,"%m")
56
fs$year=format(fs$date,"%Y")
57
fs$time=substr(fs$file,19,22)
58
fs$datetime=as.POSIXct(strptime(paste(substr(fs$file,11,17),substr(fs$file,19,22)), '%Y%j %H%M'))
59
fs$dateid=format(fs$date,"%Y%m%d")
60
fs$path=as.character(fs$path)
61
fs$file=as.character(fs$file)
62

    
63
## output ROI
64
#get bounding box of region in m
65
ge=SpatialPoints(data.frame(lon=c(-125,-115),lat=c(40,47)))
66
projection(ge)=CRS("+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs")
67
ge2=spTransform(ge, CRS(" +proj=sinu +lon_0=0 +x_0=0 +y_0=0"))
68

    
69

    
70
## vars
71
vars=as.data.frame(matrix(c(
72
  "Cloud_Effective_Radius",              "CER",
73
  "Cloud_Effective_Radius_Uncertainty",  "CERU",
74
  "Cloud_Optical_Thickness",             "COT",
75
  "Cloud_Optical_Thickness_Uncertainty", "COTU",
76
  "Cloud_Water_Path",                    "CWP",
77
  "Cloud_Water_Path_Uncertainty",        "CWPU",
78
  "Cloud_Phase_Optical_Properties",      "CPOP",
79
  "Cloud_Multi_Layer_Flag",              "CMLF",
80
  "Cloud_Mask_1km",                      "CM1",
81
  "Quality_Assurance_1km",               "QA"),
82
  byrow=T,ncol=2,dimnames=list(1:10,c("variable","varid"))),stringsAsFactors=F)
83

    
84

    
85
### Installation of hegtool
86
## needed 32-bit libraries and java for program to install correctly
87

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

    
90

    
91
#### Function to generate hegtool parameter file for multi-band HDF-EOS file
92
swath2grid=function(i=1,files,vars,outdir,upleft="47 -125",lowright="41 -115"){
93
  file=fs$path[i]
94
  print(paste("Starting file",basename(file)))
95
  outfile=paste(outdir,"/",fs$file[i],sep="")
96
#  date=fs$date[1]
97
#  origin=as.POSIXct("1970-01-01 00:00:00",tz="GMT")
98
### First write the parameter file (careful, heg is very finicky!)
99
  hdr=paste("NUM_RUNS = ",length(vars),"|MULTI_BAND_HDFEOS:",length(vars),sep="")
100
  grp=paste("
101
BEGIN
102
INPUT_FILENAME=",file,"
103
OBJECT_NAME=mod06
104
FIELD_NAME=",vars,"|
105
BAND_NUMBER = 1
106
OUTPUT_PIXEL_SIZE_X=1000
107
OUTPUT_PIXEL_SIZE_Y=1000
108
SPATIAL_SUBSET_UL_CORNER = ( ",upleft," )
109
SPATIAL_SUBSET_LR_CORNER = ( ",lowright," )
110
#RESAMPLING_TYPE =",ifelse(grepl("Flag|Mask|Quality",vars),"NN","CUBIC"),"
111
RESAMPLING_TYPE =NN
112
OUTPUT_PROJECTION_TYPE = SIN
113
ELLIPSOID_CODE = WGS84
114
OUTPUT_PROJECTION_PARAMETERS = ( 6371007.181 0.0 0.0 0.0 0.0 0.0 0.0 1.0 0.0 0.0 0.0 0.0 86400.0 0.0 0.0 )
115
OUTPUT_TYPE = HDFEOS
116
OUTPUT_FILENAME = ",outfile,"
117
END
118

    
119
",sep="")
120
  ## if any remnants from previous runs remain, delete them
121
  if(length(list.files(tempdir(),pattern=basename(file)))>0)
122
    file.remove(list.files(tempdir(),pattern=basename(file),full=T))
123
  ## write it to a file
124
  cat(c(hdr,grp)    , file=paste(tempdir(),"/",basename(file),"_MODparms.txt",sep=""))
125
  ## now run the swath2grid tool  - must be run as root (argh!)!
126
  ## write the tiff file
127
  log=system(paste("sudo MRTDATADIR=/usr/local/heg/data ",
128
    "PGSHOME=/usr/local/heg/TOOLKIT_MTD PWD=/home/adamw /usr/local/heg/bin/swtif -p ",
129
    paste(tempdir(),"/",basename(file),"_MODparms.txt -d",sep=""),sep=""),intern=T)
130
      print(paste("Finished ", file))
131
}
132
 
133

    
134
### update fs with completed files
135
fs$complete=fs$file%in%list.files(outdir,pattern="hdf$")
136
table(fs$complete)
137

    
138
#### Run the gridding procedure
139

    
140
system("sudo ls")
141

    
142
mclapply(which(!fs$complete),function(fi){
143
  swath2grid(fi,vars=vars$variable,files=fs,
144
             outdir=outdir,
145
             upleft="47 -125",lowright="40 -115")},
146
         mc.cores=24)
147

    
148

    
149
##############################################################
150
### Import to GRASS for processing
151

    
152
#fs$grass=paste(fs$month,fs$year,fs$file,sep="_")
153
td=readGDAL(paste("HDF4_EOS:EOS_GRID:\"",outdir,"/",fs$file[1],"\":mod06:Cloud_Mask_1km_0",sep=""))
154
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 "
155

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

    
161
### create (or connect to) grass location
162
gisDbase="/media/data/grassdata"
163
gisLocation="oregon"
164
gisMapset="mod06"
165
## set Grass to overwrite
166
Sys.setenv(GRASS_OVERWRITE=1)
167
Sys.setenv(DEBUG=0)
168

    
169
## temporary objects to test function below
170
 i=1
171
file=paste(outdir,"/",fs$file[1],sep="")
172
date=as.Date("2000-03-02")
173

    
174

    
175
### Function to extract various SDSs from a single gridded HDF file and use QA data to throw out 'bad' observations
176
loadcloud<-function(date,fs){
177
### set up grass session
178
  tf=paste(tempdir(),"/grass", Sys.getpid(),"/", sep="")
179
 
180
  ## set up tempfile for this PID
181
  initGRASS(gisBase="/usr/lib/grass64",gisDbase=tf,SG=td,override=T,location="mod06",mapset="PERMANENT",home=tf,pid=Sys.getpid())
182
  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=""))
183

    
184
#system("g.mapset PERMANENT")
185
  execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",outdir,"/",fs$file[1],"\":mod06:Cloud_Mask_1km_0",sep=""),
186
            output="modisgrid",flags=c("quiet","overwrite","o"))
187
  system("g.region rast=modisgrid save=roi --overwrite")
188
  system("g.region roi")
189
  system("g.region -p")
190
#  getLocationProj()
191

    
192

    
193
  ## Identify which files to process
194
  tfs=fs$file[fs$date==date]
195
  nfs=length(tfs)
196

    
197
  ### print some summary info
198
  print(date)
199
  ## loop through scenes and process QA flags
200
  for(i in 1:nfs){
201
     file=paste(outdir,"/",tfs[i],sep="")
202
     ## Cloud Mask
203
     execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Mask_1km_0",sep=""),
204
              output=paste("CM1_",i,sep=""),flags=c("overwrite","o")) ; print("")
205
    ## extract cloudy and 'confidently clear' pixels
206
    system(paste("r.mapcalc <<EOF
207
                CM_cloud_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) == 0 
208
                CM_clear_",i," =  ((CM1_",i," / 2^0) % 2) == 1  &&  ((CM1_",i," / 2^1) % 2^2) == 3 
209
EOF",sep=""))
210

    
211
    ## QA
212
    execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Quality_Assurance_1km_0",sep=""),
213
             output=paste("QA_",i,sep=""),flags=c("overwrite","o")) ; print("")
214
   ## QA_CER
215
   system(paste("r.mapcalc <<EOF
216
                 QA_COT_",i,"=   ((QA_",i," / 2^0) % 2^1 )==1
217
                 QA_COT2_",i,"=  ((QA_",i," / 2^1) % 2^2 )==3
218
                 QA_COT3_",i,"=  ((QA_",i," / 2^3) % 2^2 )==0
219
                 QA_CER_",i,"=   ((QA_",i," / 2^5) % 2^1 )==1
220
                 QA_CER2_",i,"=  ((QA_",i," / 2^6) % 2^2 )==3
221
EOF",sep="")) 
222
#                 QA_CWP_",i,"=   ((QA_",i," / 2^8) % 2^1 )==1
223
#                 QA_CWP2_",i,"=  ((QA_",i," / 2^9) % 2^2 )==3
224

    
225
   ## Optical Thickness
226
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Optical_Thickness",sep=""),
227
            output=paste("COT_",i,sep=""),
228
            title="cloud_effective_radius",
229
            flags=c("overwrite","o")) ; print("")
230
   execGRASS("r.null",map=paste("COT_",i,sep=""),setnull="-9999")
231
   ## keep only positive COT values where quality is 'useful' and 'very good' & scale to real units
232
   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=""))   
233
   ## set COT to 0 in clear-sky pixels
234
   system(paste("r.mapcalc \"COT2_",i,"=if(CM_clear_",i,"==0,COT_",i,",0)\"",sep=""))   
235
   
236
   ## Effective radius ##
237
   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Effective_Radius",sep=""),
238
            output=paste("CER_",i,sep=""),
239
            title="cloud_effective_radius",
240
            flags=c("overwrite","o")) ; print("")
241
   execGRASS("r.null",map=paste("CER_",i,sep=""),setnull="-9999")
242
   ## keep only positive CER values where quality is 'useful' and 'very good' & scale to real units
243
   system(paste("r.mapcalc \"CER_",i,"=if(QA_CER_",i,"&&QA_CER2_",i,"&&CER_",i,">=0,CER_",i,"*0.009999999776482582,null())\"",sep=""))   
244
   ## set CER to 0 in clear-sky pixels
245
   system(paste("r.mapcalc \"CER2_",i,"=if(CM_clear_",i,"==0,CER_",i,",0)\"",sep=""))   
246

    
247
   ## Cloud Water Path
248
#   execGRASS("r.in.gdal",input=paste("HDF4_EOS:EOS_GRID:\"",file,"\":mod06:Cloud_Water_Path",sep=""),
249
#            output=paste("CWP_",i,sep=""),title="cloud_water_path",
250
#            flags=c("overwrite","o")) ; print("")
251
#   execGRASS("r.null",map=paste("CWP_",i,sep=""),setnull="-9999")
252
   ## keep only positive CER values where quality is 'useful' and 'very good' & scale to real units
253
#   system(paste("r.mapcalc \"CWP_",i,"=if(QA_CWP_",i,"&&QA_CWP2_",i,"&&CWP_",i,">=0,CWP_",i,"*0.009999999776482582,null())\"",sep=""))   
254
   ## set CER to 0 in clear-sky pixels
255
#   system(paste("r.mapcalc \"CWP2_",i,"=if(CM_clear_",i,"==0,CWP_",i,",0)\"",sep=""))   
256

    
257
     
258
 } #end loop through sub daily files
259

    
260
#### Now generate daily averages (or maximum in case of cloud flag)
261
  
262
  system(paste("r.mapcalc <<EOF
263
         COT_denom=",paste("!isnull(COT2_",1:nfs,")",sep="",collapse="+"),"
264
         COT_numer=",paste("if(isnull(COT2_",1:nfs,"),0,COT2_",1:nfs,")",sep="",collapse="+"),"
265
         COT_daily=COT_numer/COT_denom
266
         CER_denom=",paste("!isnull(CER2_",1:nfs,")",sep="",collapse="+"),"
267
         CER_numer=",paste("if(isnull(CER2_",1:nfs,"),0,CER2_",1:nfs,")",sep="",collapse="+"),"
268
         CER_daily=CER_numer/CER_denom
269
         CLD_daily=max(",paste("if(isnull(CM_cloud_",1:nfs,"),0,CM_cloud_",1:nfs,")",sep="",collapse=","),") 
270
EOF",sep=""))
271

    
272
  #### Write the file to a geotiff
273
  execGRASS("r.out.gdal",input="CER_daily",output=paste(tifdir,"/CER_",format(date,"%Y%m%d"),".tif",sep=""),nodata=-999,flags=c("quiet"))
274
  execGRASS("r.out.gdal",input="COT_daily",output=paste(tifdir,"/COT_",format(date,"%Y%m%d"),".tif",sep=""),nodata=-999,flags=c("quiet"))
275
  execGRASS("r.out.gdal",input="CLD_daily",output=paste(tifdir,"/CLD_",format(date,"%Y%m%d"),".tif",sep=""),nodata=99,flags=c("quiet"))
276

    
277
### delete the temporary files 
278
  unlink_.gislock()
279
  system("/usr/lib/grass64/etc/clean_temp")
280
 system(paste("rm -R ",tf,sep=""))
281
### print update
282
  print(paste(" ###################################################################               Finished ",date,"
283
################################################################"))
284
}
285

    
286

    
287
###########################################
288
### Now run it
289

    
290
tdates=sort(unique(fs$date))
291
done=tdates%in%as.Date(substr(list.files(tifdir),5,12),"%Y%m%d")
292
table(done)
293
tdates=tdates[!done]
294

    
295
mclapply(tdates,function(date) loadcloud(date,fs=fs))
296

    
297
 
298

    
299
#######################################################################################33
300
###  Produce the monthly averages
301

    
302
## get list of daily files
303
fs2=data.frame(
304
  path=list.files(tifdir,full=T,recursive=T,pattern="tif$"),
305
  file=basename(list.files(tifdir,full=F,recursive=T,pattern="tif$")))
306
fs2$type=substr(fs2$file,1,3)
307
fs2$date=as.Date(substr(fs2$file,5,12),"%Y%m%d")
308
fs2$month=format(fs2$date,"%m")
309
fs2$year=format(fs2$date,"%Y")
310
fs2$path=as.character(fs2$path)
311
fs2$file=as.character(fs2$file)
312

    
313

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

    
317
## identify which have been completed
318
#done=
319
#  do.call(rbind,strsplit(list.files(summarydatadir),"_|[.]"))[,3]
320
#table(done)
321
#tdates=tdates[!done]
322

    
323

    
324
## process the summaries using the raster package
325
mclapply(1:nrow(vs),function(i){
326
  print(paste("Loading ",vs$type[i]," for month ",vs$month[i]))
327
  td=stack(fs2$path[which(fs2$month==vs$month[i]&fs2$type==vs$type[i])])
328
  print(paste("Processing Metric ",vs$type[i]," for month ",vs$month[i]))
329
  calc(td,mean,na.rm=T,
330
       filename=paste(summarydatadir,"/",vs$type[i],"_mean_",vs$month[i],".tif",sep=""),
331
       format="GTiff")
332
  calc(td,sd,na.rm=T,
333
       filename=paste(summarydatadir,"/",vs$type[i],"_sd_",vs$month[i],".tif",sep=""),
334
       format="GTiff")
335
  if(vs$type[i]%in%c("CER")) {
336
    ## Calculate number of days with effective radius > 20um, found to be linked to precipitating clouds
337
    ## (Kobayashi 2007)
338
    calc(td,function(x) mean(ifelse(x<20,0,1),na.rm=T),
339
      filename=paste(summarydatadir,"/",vs$type[i],"_P20um_",vs$month[i],".tif",sep=""),
340
      format="GTiff")
341
#    td2[td2<20]=0
342
#    td2[td2>=20]=1
343
#    calc(td2,mean,na.rm=T,
344
#         filename=paste(summarydatadir,"/",vs$type[i],"_P20um_",vs$month[i],".tif",sep=""),
345
#         format="GTiff")
346
  }  
347
  print(paste("Processing missing data for ",vs$type[i]," for month ",vs$month[i]))
348
  calc(td,function(i)
349
       sum(!is.na(i)),filename=paste(summarydatadir,"/",vs$type[i],"_count_",vs$month[i],".tif",sep=""),
350
       format="GTiff")
351
  calc(td,function(i) sum(ifelse(i==0,0,1)),
352
       filename=paste(summarydatadir,"/",vs$type[i],"_clear_",vs$month[i],".tif",sep=""),format="GTiff")
353
  gc()
354
}
355
)
356

    
357

    
(1-1/7)