OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
viirs_ancillary.f95
Go to the documentation of this file.
1 !-----------------------------------------------------------------
2 ! Module with a subroutine to read in wind speed, total ozone,
3 ! and precipitable water from an ncep GDAS grib file and
4 ! functions to get values from these fields at input lat and lon
5 !-----------------------------------------------------------------
7  implicit none
8 
9  private
10 
11  public :: load_ncep_data
12  public :: load_geos5_data
13  public :: get_winds
14  public :: get_pwat
15  public :: get_tozne
16  public :: get_wind_dir
17 
18  integer, parameter :: rdbl = selected_real_kind(p=13)
19 
20  type :: ncep_gdas_grib
21  integer :: ni
22  integer :: nj
23  real(kind=rdbl), dimension(:,:), allocatable :: tozne
24  real(kind=rdbl), dimension(:,:), allocatable :: pwat
25  real(kind=rdbl), dimension(:,:), allocatable :: wndspd
26  real(kind=rdbl), dimension(:,:), allocatable :: u_wndspd
27  real(kind=rdbl), dimension(:,:), allocatable :: v_wndspd
28  end type ncep_gdas_grib
29 
30  type(ncep_gdas_grib) :: gdas
31 
32  contains
33 
34 !
35 ! Load input GRIB files, filename1 and filename2, and interpolate in time.
36 !---------------------------------------------------------------------------------------------------
37  integer function load_ncep_data(filename1, filename2, hr, min) result(status)
38  implicit none
39 
40  character(len=255), intent(in) :: filename1
41  character(len=255), intent(in) :: filename2
42  integer, intent(in) :: hr
43  integer, intent(in) :: min
44 
45  type(ncep_gdas_grib) :: gdas1
46  type(ncep_gdas_grib) :: gdas2
47 
48  real :: hrs
49  real :: t1
50 
51  integer, dimension(2) :: dims
52 
53 ! -- read in both pre-granule and post-granule NCEP GDAS GFS data.
54 ! -- read_ncep_gdas converts GDAS 1D GRIB data into 2D lat/lon array.
55  gdas1 = read_ncep_gdas(filename1, status)
56  if (status /= 0) then
57  print *, "ERROR: Failed to read NCEP GDAS ancillary data: ", status
58  print *, "File: ", trim(filename1)
59  return
60  end if
61 
62  gdas2 = read_ncep_gdas(filename2, status)
63  if (status /= 0) then
64  print *, "ERROR: Failed to read NCEP GDAS ancillary data: ", status
65  print *, "File: ", trim(filename2)
66  return
67  end if
68 
69 ! -- interpolate between the pre- and post-granule data based on hr and min values.
70  hrs = hr + (min / 60.0)
71  select case (hr)
72  case (0:5)
73  t1 = 0
74  case (6:11)
75  t1 = 6
76  case (12:17)
77  t1 = 12
78  case (18:23)
79  t1 = 18
80  case default
81  print *, "ERROR: Invalid hour detected: ", hr
82  status = -1
83  return
84  end select
85 
86  allocate(gdas%u_wndspd(gdas1%ni, gdas1%nj), gdas%v_wndspd(gdas1%ni, gdas1%nj), &
87  & gdas%wndspd(gdas1%ni, gdas1%nj), stat=status)
88  if (status /= 0) then
89  print *, "ERROR: Failed to allocate interpolated windspeed arrays: ", status
90  return
91  end if
92 
93  allocate(gdas%tozne(gdas1%ni, gdas1%nj), stat=status)
94  if (status /= 0) then
95  print *, "ERROR: Failed to allocate interpolated ozone array: ", status
96  return
97  end if
98 
99  allocate(gdas%pwat(gdas1%ni, gdas1%nj), stat=status)
100  if (status /= 0) then
101  print *, "ERROR: Failed to allocate interpolated preciptable water array: ", status
102  return
103  end if
104 
105  gdas%ni = gdas1%ni
106  gdas%nj = gdas1%nj
107  gdas%tozne = gdas1%tozne + (gdas2%tozne-gdas1%tozne) * (hrs-t1)/6.0
108  gdas%pwat = gdas1%pwat + (gdas2%pwat-gdas1%pwat) * (hrs-t1)/6.0
109  gdas%u_wndspd = gdas1%u_wndspd + (gdas2%u_wndspd-gdas1%u_wndspd) * (hrs-t1)/6.0
110  gdas%v_wndspd = gdas1%v_wndspd + (gdas2%v_wndspd-gdas1%v_wndspd) * (hrs-t1)/6.0
111  gdas%wndspd = gdas1%wndspd + (gdas2%wndspd-gdas1%wndspd) * (hrs-t1)/6.0
112 
113  return
114 
115  end function load_ncep_data
116 
117  integer function load_geos5_data(filename1, filename2, hr, min) result(status)
118  implicit none
119 
120  character(len=255), intent(in) :: filename1
121  character(len=255), intent(in) :: filename2
122  integer, intent(in) :: hr
123  integer, intent(in) :: min
124 
125  type(ncep_gdas_grib) :: gdas1
126  type(ncep_gdas_grib) :: gdas2
127 
128  real :: hrs
129  real :: t1
130 
131  integer :: tmp
132 
133  status = -1
134 ! -- read in both pre-granule and post-granule NCEP GDAS GFS data.
135 ! -- read_ncep_gdas converts GDAS 1D GRIB data into 2D lat/lon array.
136  gdas1 = read_geos5(filename1, status)
137  if (status /= 0) then
138  print *, "ERROR: Failed to read GEOS5 ancillary data: ", status
139  print *, "File: ", trim(filename1)
140  return
141  end if
142 
143  gdas2 = read_geos5(filename2, status)
144  if (status /= 0) then
145  print *, "ERROR: Failed to read GEOS5 ancillary data: ", status
146  print *, "File: ", trim(filename2)
147  return
148  end if
149 
150 ! -- interpolate between the pre- and post-granule data based on hr and min values.
151  hrs = hr + (min / 60.0)
152  select case (hr)
153  case (0:5)
154  t1 = 0
155  case (6:11)
156  t1 = 6
157  case (12:17)
158  t1 = 12
159  case (18:23)
160  t1 = 18
161  case default
162  print *, "ERROR: Invalid hour detected: ", hr
163  status = -1
164  return
165  end select
166 
167  allocate(gdas%u_wndspd(gdas1%ni, gdas1%nj), gdas%v_wndspd(gdas1%ni, gdas1%nj), &
168  & gdas%wndspd(gdas1%ni, gdas1%nj), stat=status)
169  if (status /= 0) then
170  print *, "ERROR: Failed to allocate interpolated windspeed arrays: ", status
171  return
172  end if
173 
174  allocate(gdas%tozne(gdas1%ni, gdas1%nj), stat=status)
175  if (status /= 0) then
176  print *, "ERROR: Failed to allocate interpolated ozone array: ", status
177  return
178  end if
179 
180  allocate(gdas%pwat(gdas1%ni, gdas1%nj), stat=status)
181  if (status /= 0) then
182  print *, "ERROR: Failed to allocate interpolated preciptable water array: ", status
183  return
184  end if
185 
186  gdas%ni = gdas1%ni
187  gdas%nj = gdas1%nj
188  gdas%tozne = gdas1%tozne + (gdas2%tozne-gdas1%tozne) * (hrs-t1)/6.0
189  gdas%pwat = gdas1%pwat + (gdas2%pwat-gdas1%pwat) * (hrs-t1)/6.0
190  gdas%u_wndspd = gdas1%u_wndspd + (gdas2%u_wndspd-gdas1%u_wndspd) * (hrs-t1)/6.0
191  gdas%v_wndspd = gdas1%v_wndspd + (gdas2%v_wndspd-gdas1%v_wndspd) * (hrs-t1)/6.0
192  gdas%wndspd = gdas1%wndspd + (gdas2%wndspd-gdas1%wndspd) * (hrs-t1)/6.0
193 
194  return
195 
196  end function load_geos5_data
197 
198 !
199 ! Getter method to fetch windspeed from GRIB data for given latitude and longitude, lat and lon.
200 ! Data is interpolated linearly from the surrounding 4 points from the GRIB sample data.
201 !
202 ! Returns the windspeed, status: -1 = fail, 0 = success.
203 !---------------------------------------------------------------------------------------------------
204  real function get_winds(rlat, rlon, status) result(ws)
205  implicit none
206 
207  real, intent(in) :: rlat
208  real, intent(in) :: rlon
209  integer, intent(out) :: status
210 
211  real, dimension(4) :: f
212  real :: x1, x2
213  real :: y1, y2
214 
215  integer :: i1, i2
216  integer :: j1, j2
217 
218  status = -1
219  if(rlat > 90.0 .or. rlat < -90.0) then
220  print*, 'ERROR: lat out of range must be 90 to -90:', rlat
221  return
222  end if
223  if (rlon < -180.0 .OR. rlon > 180.0) then
224  print*, 'ERROR: lon out of range must be [-180,180):', rlon
225  return
226  end if
227 
228  status = get_interp_indexes(rlat, rlon, i1, i2, j1, j2)
229  if (status /= 0) then
230  print *, "ERROR: Failed to get indexes of surrounding data for interpolation: ", status
231  return
232  end if
233 
234 ! -- perform 2D bilinear interpolation (http://en.wikipedia.org/wiki/Bilinear_interpolation)
235  f = (/gdas%wndspd(i1,j1), gdas%wndspd(i2,j1), gdas%wndspd(i2,j2), gdas%wndspd(i1,j2)/)
236  x1 = index2lon(i1, status)
237  x2 = index2lon(i2, status)
238  y1 = index2lat(j1, status)
239  y2 = index2lat(j2, status)
240 
241  ws = f(1)*(x2-rlon)*(y2-rlat) + f(2)*(rlon-x1)*(y2-rlat) + &
242  & f(3)*(rlon-x1)*(rlat-y1) + f(4)*(x2-rlon)*(rlat-y1)
243  ws = 1.0 / ((x2-x1)*(y2-y1)) * ws
244 
245  status = 0
246  return
247 
248  end function get_winds
249 
250 !
251 ! Getter method to calculate windspeed directions from windspeed u/v data for given
252 ! latitude and longitude, lat and lon.
253 !
254 ! Data is interpolated linearly from the surrounding 4 points from the GRIB sample data.
255 !
256 ! Returns the windspeed, status: -1 = fail, 0 = success.
257 !---------------------------------------------------------------------------------------------------
258  real function get_wind_dir(rlat, rlon, status) result(wd)
259  implicit none
260 
261  real, intent(in) :: rlat
262  real, intent(in) :: rlon
263  integer, intent(out) :: status
264 
265  real, dimension(4) :: f
266  real :: x1, x2
267  real :: y1, y2
268 
269  real :: u, v
270  integer :: i1, i2
271  integer :: j1, j2
272 
273  status = -1
274  if(rlat >= 90.0 .or. rlat < -90.0) then
275  print*, 'ERROR: lat out of range must be 90 to -90:', rlat
276  return
277  end if
278  if (rlon < -180.0 .OR. rlon >= 180.0) then
279  print*, 'ERROR: lon out of range must be [-180,180):', rlon
280  return
281  end if
282 
283  status = get_interp_indexes(rlat, rlon, i1, i2, j1, j2)
284  if (status /= 0) then
285  print *, "ERROR: Failed to get indexes of surrounding data for interpolation: ", status
286  return
287  end if
288 
289 ! -- perform 2D bilinear interpolation (http://en.wikipedia.org/wiki/Bilinear_interpolation)
290 ! -- u-direction
291  f = (/gdas%u_wndspd(i1,j1), gdas%u_wndspd(i2,j1), gdas%u_wndspd(i2,j2), gdas%u_wndspd(i1,j2)/)
292  x1 = index2lon(i1, status)
293  x2 = index2lon(i2, status)
294  y1 = index2lat(j1, status)
295  y2 = index2lat(j2, status)
296 
297  u = f(1)*(x2-rlon)*(y2-rlat) + f(2)*(rlon-x1)*(y2-rlat) + &
298  & f(3)*(rlon-x1)*(rlat-y1) + f(4)*(x2-rlon)*(rlat-y1)
299  u = 1.0 / ((x2-x1)*(y2-y1)) * u
300 
301 ! -- v-direction
302  f = (/gdas%v_wndspd(i1,j1), gdas%v_wndspd(i2,j1), gdas%v_wndspd(i2,j2), gdas%v_wndspd(i1,j2)/)
303  x1 = index2lon(i1, status)
304  x2 = index2lon(i2, status)
305  y1 = index2lat(j1, status)
306  y2 = index2lat(j2, status)
307 
308  v = f(1)*(x2-rlon)*(y2-rlat) + f(2)*(rlon-x1)*(y2-rlat) + &
309  & f(3)*(rlon-x1)*(rlat-y1) + f(4)*(x2-rlon)*(rlat-y1)
310  v = (1 / (x2-x1)*(y2-y1)) * v
311 
312  wd = (atan2(-1.0*u,-1.0*v) * 180.0/3.1415926535)
313  if (wd < 0) wd = wd + 360.0
314 
315  status = 0
316  return
317 
318  end function get_wind_dir
319 
320 ! Getter method to fetch preciptable water from GRIB data for given latitude and longitude, lat and lon.
321 ! Data is interpolated linearly from the surrounding 4 points from the GRIB sample data.
322 !
323 ! Returns the precipitable water value, status: -1 = fail, 0 = success.
324 !---------------------------------------------------------------------------------------------------
325  real(8) function get_pwat(rlat, rlon, status) result(pw)
326  implicit none
327 
328  real, intent(in) :: rlat
329  real, intent(in) :: rlon
330  integer, intent(out) :: status
331 
332  real, dimension(4) :: f
333  real :: x1, x2
334  real :: y1, y2
335 
336  integer :: i1, i2
337  integer :: j1, j2
338 
339  status = -1
340  if(rlat >= 90.0 .or. rlat < -90.0) then
341  print*, 'ERROR: lat out of range must be 90 to -90:', rlat
342  return
343  end if
344  if (rlon < -180.0 .OR. rlon >= 180.0) then
345  print*, 'ERROR: lon out of range must be [-180,180):', rlon
346  return
347  end if
348 
349 ! -- perform 2D bilinear interpolation (http://en.wikipedia.org/wiki/Bilinear_interpolation)
350  status = get_interp_indexes(rlat, rlon, i1, i2, j1, j2)
351  if (status /= 0) then
352  print *, "ERROR: Failed to get indexes of surrounding data for interpolation: ", status
353  return
354  end if
355 
356  f = (/gdas%pwat(i1,j1), gdas%pwat(i2,j1), gdas%pwat(i2,j2), gdas%pwat(i1,j2)/)
357  x1 = index2lon(i1, status)
358  x2 = index2lon(i2, status)
359  y1 = index2lat(j1, status)
360  y2 = index2lat(j2, status)
361 
362  pw = f(1)*(x2-rlon)*(y2-rlat) + f(2)*(rlon-x1)*(y2-rlat) + &
363  & f(3)*(rlon-x1)*(rlat-y1) + f(4)*(x2-rlon)*(rlat-y1)
364  pw = 1.0 / ((x2-x1)*(y2-y1)) * pw
365 
366  status = 0
367  return
368 
369  end function get_pwat
370 
371 ! Getter method to fetch total column ozone from GRIB data for given latitude and longitude, lat and lon.
372 ! Data is interpolated linearly from the surrounding 4 points from the GRIB sample data.
373 !
374 ! Returns the total colum ozone, status: -1 = fail, 0 = success.
375 !---------------------------------------------------------------------------------------------------
376  real(8) function get_tozne(rlat, rlon, status) result(oz)
377  implicit none
378 
379  real, intent(in) :: rlat
380  real, intent(in) :: rlon
381  integer, intent(out) :: status
382 
383  real, dimension(4) :: f
384  real :: x1, x2
385  real :: y1, y2
386 
387  integer :: i1, i2
388  integer :: j1, j2
389 
390  status = -1
391  if(rlat >= 90.0 .or. rlat < -90.0) then
392  print*, 'ERROR: lat out of range must be 90 to -90:', rlat
393  return
394  end if
395  if (rlon < -180.0 .OR. rlon >= 180.0) then
396  print*, 'ERROR: lon out of range must be [-180,180):', rlon
397  return
398  end if
399 
400  status = get_interp_indexes(rlat,rlon, i1, i2, j1, j2)
401  if (status /= 0) then
402  print *, "ERROR: Failed to get indexes of surrounding data for interpolation: ", status
403  return
404  end if
405 
406 ! -- perform 2D bilinear interpolation (http://en.wikipedia.org/wiki/Bilinear_interpolation)
407  f = (/gdas%tozne(i1,j1), gdas%tozne(i2,j1), gdas%tozne(i2,j2), gdas%tozne(i1,j2)/)
408  x1 = index2lon(i1, status)
409  x2 = index2lon(i2, status)
410  y1 = index2lat(j1, status)
411  y2 = index2lat(j2, status)
412 
413  oz = f(1)*(x2-rlon)*(y2-rlat) + f(2)*(rlon-x1)*(y2-rlat) + &
414  & f(3)*(rlon-x1)*(rlat-y1) + f(4)*(x2-rlon)*(rlat-y1)
415  oz = 1.0 / ((x2-x1)*(y2-y1)) * oz
416 
417  status = 0
418  return
419 
420  end function get_tozne
421 
422 
423 !---------------------------------------------------------------------------------------------------
424 !---------------------------------------------------------------------------------------------------
425 !---------------------------------------------------------------------------------------------------
426 ! -- PRIVATE FUNCTIONS
427 !---------------------------------------------------------------------------------------------------
428 !---------------------------------------------------------------------------------------------------
429 !---------------------------------------------------------------------------------------------------
430 
431 !
432 ! Use GRIB-API to read 10u surface winds, total column ozone, and precipitable water
433 ! from NCEP GDAS GRIB file, filename1. Function also converts GRIB 1D data arrays to
434 ! 2D lat/lon arrays of size (ni,nj) (from GRIB keys Ni,Nj). Also reverses the 2D array so
435 ! row 1 is -90.0 rather than 90.0. And shifts lons so that column 1 is -180 rather than 0 so
436 ! arrays conform to conventions elsewhere.
437 !
438 ! Returns a ncep_gdas_grib object.
439 !---------------------------------------------------------------------------------------------------
440  type(ncep_gdas_grib) function read_ncep_gdas(filename1, status) result(gdas0)
441  ! load the wind speed, precip water, and total ozone data from the
442  ! file into arrays
443  use grib_api
444  implicit none
445 
446  character(len=255),intent(in) :: filename1
447  integer, intent(out) :: status
448 
449  integer :: ni, nj, nval
450  integer :: iret, igrib, ifile
451  character(len=8) :: name
452 
453  !Open file and turn multi support on to find v winds
454  call grib_open_file(ifile, filename1,'R',status)
455  if(status/=0) then
456  print*,'ERROR:',filename1, 'not found'
457  status = -1
458  return
459  end if
460  call grib_multi_support_on()
461 
462  ! Loop on all the messages in a file.
463  call grib_new_from_file(ifile,igrib,iret)
464 
465  do while (iret /= grib_end_of_file)
466  call grib_get(igrib,'shortName',name)
467  if(name=='10u') then !u winds (m/s)
468  call grib_get(igrib,'Ni',gdas0%ni)
469  call grib_get(igrib,'Nj',gdas0%nj)
470  allocate(gdas0%u_wndspd(gdas0%ni,gdas0%nj), stat=status)
471  if (status /= 0) then
472  print *, "ERROR: Failed to allocate array for u-windspeeds: ", status
473  return
474  end if
475 
476  status = read_and_reshape_grib_message(igrib, gdas0%u_wndspd)
477  if (status /= 0) then
478  print *, "ERROR: Failed to read "//trim(name)//": ", status
479  return
480  end if
481 
482  elseif(name=='10v') then !v winds (m/s)
483  call grib_get(igrib,'Ni',gdas0%ni)
484  call grib_get(igrib,'Nj',gdas0%nj)
485 
486  allocate(gdas0%v_wndspd(gdas0%ni,gdas0%nj), stat=status)
487  if (status /= 0) then
488  print *, "ERROR: Failed to allocate array for v-windspeeds: ", status
489  return
490  end if
491 
492  status = read_and_reshape_grib_message(igrib, gdas0%v_wndspd)
493  if (status /= 0) then
494  print *, "ERROR: Failed to read "//trim(name)//": ", status
495  return
496  end if
497  elseif(name=='pwat') then !precip water (kg/m^2)
498  call grib_get(igrib,'Ni',gdas0%ni)
499  call grib_get(igrib,'Nj',gdas0%nj)
500 
501  allocate(gdas0%pwat(gdas0%ni,gdas0%nj), stat=status)
502  if (status /= 0) then
503  print *, "ERROR: Failed to allocate array for v-windspeeds: ", status
504  return
505  end if
506 
507  status = read_and_reshape_grib_message(igrib, gdas0%pwat)
508  if (status /= 0) then
509  print *, "ERROR: Failed to read "//trim(name)//": ", status
510  return
511  end if
512 
513  elseif(name=='tozne'.or.name=='tco3') then !total ozone (Dobson)
514  call grib_get(igrib,'Ni',gdas0%ni)
515  call grib_get(igrib,'Nj',gdas0%nj)
516 
517  allocate(gdas0%tozne(gdas0%ni,gdas0%nj), stat=status)
518  if (status /= 0) then
519  print *, "ERROR: Failed to allocate array for tozne: ", status
520  return
521  end if
522 
523  status = read_and_reshape_grib_message(igrib, gdas0%tozne)
524  if (status /= 0) then
525  print *, "ERROR: Failed to read "//trim(name)//": ", status
526  return
527  end if
528 
529  end if
530  !Release current message memory
531  call grib_release(igrib)
532 
533  !Open next message
534  call grib_new_from_file(ifile,igrib, iret)
535  end do
536 
537  call grib_close_file(ifile)
538 
539 ! -- check that all we read all of data that we need.
540  if (.NOT. allocated(gdas0%u_wndspd)) then
541  print *, 'ERROR: No u wind read from file.'
542  status = -1
543  return
544  end if
545  if (.NOT. allocated(gdas0%v_wndspd)) then
546  print *, 'ERROR: No v wind read from file.'
547  status = -1
548  return
549  end if
550  if (.NOT. allocated(gdas0%pwat)) then
551  print *, 'ERROR: No preciptable water read from file.'
552  status = -1
553  return
554  end if
555  if (.NOT. allocated(gdas0%tozne)) then
556  print *, 'ERROR: No ozone read from file.'
557  status = -1
558  return
559  end if
560 
561 ! -- all data exists, so let's calculate actual total windspeed.
562  allocate(gdas0%wndspd(gdas0%ni,gdas0%nj), stat=status)
563  if (status /= 0) then
564  print *, 'ERROR: Failed to allocate array for GDAS windspeeds: ', status
565  return
566  end if
567 
568  gdas0%wndspd = sqrt(gdas0%v_wndspd**2 + gdas0%u_wndspd**2)
569 
570  status = 0
571  return
572 
573  end function read_ncep_gdas
574 
575 !
576 ! Returns a ncep_gdas_grib object.
577 !---------------------------------------------------------------------------------------------------
578  type(ncep_gdas_grib) function read_geos5(filename1, status) result(gdas0)
579  ! load the wind speed, precip water, and total ozone data from the
580  ! file into arrays
581  use netcdf
582 
583  implicit none
584 
585  character(len=255),intent(in) :: filename1
586  integer, intent(inout) :: status
587 
588  character(len=255) :: dset_name
589 
590  integer :: nc_id
591  integer :: dim_id
592  integer :: dset_id
593 
594  integer :: nlat
595  integer :: nlon
596  integer :: ntime
597 
598  real,dimension(:,:,:), allocatable :: tmp_anc
599 
600  status = -1
601 
602  status = nf90_open(filename1, nf90_nowrite, nc_id)
603  if (status /= nf90_noerr) then
604  print *, "ERROR: Failed to open geolocation file: ", status
605  return
606  end if
607 
608  dset_name = 'lat'
609  status = nf90_inq_dimid(nc_id, dset_name, dim_id)
610  if (status /= nf90_noerr) then
611  print *, "ERROR: Failed to get size of dimension "//trim(dset_name)//": ", status
612  return
613  end if
614 
615  status = nf90_inquire_dimension(nc_id, dim_id, len=nlat)
616  if (status /= nf90_noerr) then
617  print *, "ERROR: Failed to size of dimension "//trim(dset_name)//": ", status
618  return
619  end if
620  gdas0%nj = nlat
621 
622  dset_name = 'lon'
623  status = nf90_inq_dimid(nc_id, dset_name, dim_id)
624  if (status /= nf90_noerr) then
625  print *, "ERROR: Failed to get size of dimension "//trim(dset_name)//": ", status
626  return
627  end if
628 
629  status = nf90_inquire_dimension(nc_id, dim_id, len=nlon)
630  if (status /= nf90_noerr) then
631  print *, "ERROR: Failed to size of dimension "//trim(dset_name)//": ", status
632  return
633  end if
634  gdas0%ni = nlon
635 
636  dset_name = 'time'
637  status = nf90_inq_dimid(nc_id, dset_name, dim_id)
638  if (status /= nf90_noerr) then
639  print *, "ERROR: Failed to get size of dimension "//trim(dset_name)//": ", status
640  return
641  end if
642 
643  status = nf90_inquire_dimension(nc_id, dim_id, len=ntime)
644  if (status /= nf90_noerr) then
645  print *, "ERROR: Failed to size of dimension "//trim(dset_name)//": ", status
646  return
647  end if
648 
649  allocate(gdas0%u_wndspd(nlon,nlat), gdas0%v_wndspd(nlon,nlat), &
650  & gdas0%pwat(nlon,nlat), gdas0%tozne(nlon,nlat), stat=status)
651  if (status /= 0) then
652  print *, "ERROR: Failed to allocate GEOS5 data arrays: ", status
653  return
654  end if
655 
656  allocate(tmp_anc(nlon,nlat,ntime), stat=status)
657  if (status /= 0) then
658  print *, "ERROR: Failed to allocate tmp data arrays: ", status
659  return
660  end if
661 
662  dset_name = 'U10M'
663  status = nf90_inq_varid(nc_id, dset_name, dset_id)
664  if (status /= nf90_noerr) then
665  print *, "ERROR: Failed to get ID of dataset "//trim(dset_name)//": ", status
666  return
667  end if
668 
669  status = nf90_get_var(nc_id, dset_id, tmp_anc)
670  if (status /= nf90_noerr) then
671  print *, "ERROR: Failed to read dataset "//trim(dset_name)//": ", status
672  return
673  end if
674 
675  gdas0%u_wndspd = tmp_anc(:,:,1)
676 
677  dset_name = 'V10M'
678  status = nf90_inq_varid(nc_id, dset_name, dset_id)
679  if (status /= nf90_noerr) then
680  print *, "ERROR: Failed to get ID of dataset "//trim(dset_name)//": ", status
681  return
682  end if
683 
684  status = nf90_get_var(nc_id, dset_id, tmp_anc)
685  if (status /= nf90_noerr) then
686  print *, "ERROR: Failed to read dataset "//trim(dset_name)//": ", status
687  return
688  end if
689 
690  gdas0%v_wndspd = tmp_anc(:,:,1)
691 
692  dset_name = 'TQV'
693  status = nf90_inq_varid(nc_id, dset_name, dset_id)
694  if (status /= nf90_noerr) then
695  print *, "ERROR: Failed to get ID of dataset "//trim(dset_name)//": ", status
696  return
697  end if
698 
699  status = nf90_get_var(nc_id, dset_id, tmp_anc)
700  if (status /= nf90_noerr) then
701  print *, "ERROR: Failed to read dataset "//trim(dset_name)//": ", status
702  return
703  end if
704 
705  gdas0%pwat = tmp_anc(:,:,1)
706 
707  dset_name = 'TO3'
708  status = nf90_inq_varid(nc_id, dset_name, dset_id)
709  if (status /= nf90_noerr) then
710  print *, "ERROR: Failed to get ID of dataset "//trim(dset_name)//": ", status
711  return
712  end if
713 
714  status = nf90_get_var(nc_id, dset_id, tmp_anc)
715  if (status /= nf90_noerr) then
716  print *, "ERROR: Failed to read dataset "//trim(dset_name)//": ", status
717  return
718  end if
719 
720  gdas0%tozne = tmp_anc(:,:,1)
721 
722  deallocate(tmp_anc, stat=status)
723  if (status /= 0) then
724  print *, "WARNING: Failed to deallocate tmp data array: ", status
725  end if
726 
727  status = nf90_close(nc_id)
728  if (status /= nf90_noerr) then
729  print *, 'ERROR: Failed to close GEOS-5 ancillary data file: ', status
730  return
731  end if
732 
733 ! -- check that all we read all of data that we need.
734  if (.NOT. allocated(gdas0%u_wndspd)) then
735  print *, 'ERROR: No u wind read from file.'
736  status = -1
737  return
738  end if
739  if (.NOT. allocated(gdas0%v_wndspd)) then
740  print *, 'ERROR: No v wind read from file.'
741  status = -1
742  return
743  end if
744  if (.NOT. allocated(gdas0%pwat)) then
745  print *, 'ERROR: No preciptable water read from file.'
746  status = -1
747  return
748  end if
749  if (.NOT. allocated(gdas0%tozne)) then
750  print *, 'ERROR: No ozone read from file.'
751  status = -1
752  return
753  end if
754 
755 ! -- all data exists, so let's calculate actual total windspeed.
756  allocate(gdas0%wndspd(nlon, nlat), stat=status)
757  if (status /= 0) then
758  print *, 'ERROR: Failed to allocate array for GDAS windspeeds: ', status
759  return
760  end if
761 
762  gdas0%wndspd = sqrt(gdas0%v_wndspd**2 + gdas0%u_wndspd**2)
763 
764  status = 0
765  return
766 
767  end function read_geos5
768 
769 !
770 ! Helper function that uses GRIB-API to read a message and reshape the GRIB 1D data array
771 ! to a 2D lat/lon array based on values of GRIB keys Ni and Nj. Also reverses the array so that row
772 ! 1 is -90.0 degrees and shifts the lons so that column 1 is -180 degrees.
773 !
774 ! Returns status: -1 = fail, 0 = success
775 !---------------------------------------------------------------------------------------------------
776  integer function read_and_reshape_grib_message(grib_id, out_data) result(status)
777  use grib_api
778 
779  implicit none
780 
781 
782  integer, intent(in) :: grib_id
783  character(len=255) :: grib_key
784  real(kind=rdbl), dimension(:,:), intent(out) :: out_data
785 
786  integer :: ni
787  integer :: nj
788 
789  real(kind=rdbl), dimension(:), allocatable :: tmp1
790  real(kind=rdbl), dimension(:,:), allocatable :: tmp2
791  real(kind=rdbl), dimension(:), allocatable :: lats
792  real(kind=rdbl), dimension(:), allocatable :: lons
793 
794  status = -1
795 
796  grib_key = "Ni"
797  call grib_get(grib_id,trim(grib_key),ni, status)
798  if (status /= 0) then
799  print *, "ERROR: Failed to read grib key "//trim(grib_key)//": ", status
800  return
801  end if
802 
803  grib_key = "Nj"
804  call grib_get(grib_id,trim(grib_key),nj, status)
805  if (status /= 0) then
806  print *, "ERROR: Failed to read grib key "//trim(grib_key)//": ", status
807  return
808  end if
809 
810  allocate(tmp1(ni*nj), lats(ni*nj), lons(ni*nj), stat=status)
811  if (status /= 0) then
812  print *, "ERROR: Failed to allocate tmp array for grib message data: ", status
813  return
814  end if
815 
816  call grib_get_data_real8(grib_id,lats,lons,tmp1)
817 
818  out_data = reshape(tmp1, (/ni,nj/))
819 
820  out_data = out_data(:,ubound(out_data,2):lbound(out_data,2):-1)
821 
822  allocate(tmp2(ni/2, nj), stat=status)
823  if (status /= 0) then
824  print *, "ERROR: Failed to allocate tmp array for longitude translation: ", status
825  return
826  end if
827 
828  tmp2 = out_data(1:ni/2,:)
829  out_data(1:ni/2,:) = out_data((ni/2)+1:,:)
830  out_data((ni/2)+1:,:) = tmp2
831 
832  deallocate(tmp1, lats, lons, tmp2, stat=status)
833  if (status /= 0) then
834  print *, "WARNING: Failed to deallocate tmp arrays from grib file: ", status
835  end if
836 
837  status = 0
838  return
839 
840  end function read_and_reshape_grib_message
841 
842 !
843 ! Helper function converts latitudes into indexes into the 2D lat/lon data arrays.
844 ! Assumes a 1x1 degree resolution. Index returned is for the lower-left corner of the grid box
845 ! containing the location specified.
846 !
847 ! Returns the index, status: -1 = fail, 0 = success.
848 !---------------------------------------------------------------------------------------------------
849  integer function lat2index(lat, status) result(index)
850  implicit none
851 
852  real, intent(in) :: lat
853  integer, intent(out) :: status
854 
855  if (lat < -90.0 .OR. lat > 90.0) then
856  print *, "ERROR: Invalid latitude: ", lat
857  status = -1
858  return
859  end if
860 
861  index = floor((lat + 90.0) / 0.5) + 1
862 
863  status = 0
864  return
865 
866  end function lat2index
867 
868 !
869 ! Helper function converts indexes into longitudes. Assumes a 1x1 degree resolution.
870 !
871 ! Returns the latitude, status: -1 = fail, 0 = success.
872 !---------------------------------------------------------------------------------------------------
873  real function index2lat(index, status) result(lat)
874  implicit none
875 
876  integer, intent(in) :: index
877  integer, intent(out) :: status
878 
879  if (index < 1 .OR. index > gdas%nj) then
880  print *, 'ERROR: Index is out of bounds of windspeed array: ', index, gdas%nj
881  status = -1
882  return
883  end if
884 
885  lat = -90.0 + 0.5*(index-1)
886 
887  status = 0
888  return
889 
890  end function index2lat
891 
892 !
893 ! Helper function converts longitude into indexes into the 2D lat/lon data arrays.
894 ! Assumes a 1x1 degree resolution. Index returned is for the lower-left corner of the grid box
895 ! containing the location specified.
896 !
897 ! Returns the index, status: -1 = fail, 0 = success.
898 !---------------------------------------------------------------------------------------------------
899  integer function lon2index(lon, status) result(index)
900  implicit none
901 
902  real, intent(in) :: lon
903  integer, intent(out) :: status
904 
905  if (lon < -180.0 .OR. lon >= 180.0) then
906  print *, "ERROR: Invalid longitude: ", lon
907  status = -1
908  return
909  end if
910 
911  index = floor((lon + 180.0)/0.625) + 1
912 
913  status = 0
914  return
915 
916  end function lon2index
917 
918 !
919 ! Helper function converts index into longitudes. Assumes a 1x1 degree resolution.
920 !
921 ! Returns the index, status: -1 = fail, 0 = success.
922 !---------------------------------------------------------------------------------------------------
923  real function index2lon(index, status) result(lon)
924  implicit none
925 
926  integer, intent(in) :: index
927  integer, intent(out) :: status
928 
929  if (index < 1 .OR. index > gdas%ni) then
930  print *, 'ERROR: Index is out of bounds of windspeed array: ', index, gdas%ni
931  status = -1
932  return
933  end if
934 
935  lon = -180.0 + 0.625*(index-1)
936 
937  status = 0
938  return
939 
940  end function index2lon
941 
942 !
943 ! Based on values of lat and lon, returns indexes of surrounding points for 2D linear interpolation.
944 ! i1 and i2 are the indexes to the west and east of the given longitude, lon.
945 ! j1 and j2 are the indexes to the south and north of the given latitude, lat.
946 ! Corner cases involving dateline and north pole (exactly 90.0N) should be handled correctly. :D
947 !
948 ! Returns status: -1 = fail, 0 = success.
949 !---------------------------------------------------------------------------------------------------
950  integer function get_interp_indexes(lat, lon, i1, i2, j1, j2) result(status)
951  implicit none
952 
953  real, intent(in) :: lat
954  real, intent(in) :: lon
955  integer, intent(out) :: i1
956  integer, intent(out) :: i2
957  integer, intent(out) :: j1
958  integer, intent(out) :: j2
959 
960  status = -1
961 
962 ! -- specifically exclude locations where lat==90.0 exactly. This would break
963 ! -- the interpolation below.
964  if(lat >= 90.0 .or. lat < -90.0) then
965  print*, 'ERROR: lat out of range must be [-90,90):', lat
966  return
967  end if
968  if (lon < -180.0 .OR. lon >= 180.0) then
969  print*, 'ERROR: lon out of range must be [-180,180):', lon
970  return
971  end if
972 
973  ! -- get indexes into the windspeed table for lower left point.
974  i1 = lon2index(lon, status)
975  if (status /= 0) then
976  print *, "ERROR: Failed to convert longitude to index into ancillary data array: ", status
977  return
978  end if
979 
980  j1 = lat2index(lat, status)
981  if (status /= 0) then
982  print *, "ERROR: Failed to convert latitude to index into ancillary data array: ", status
983  return
984  end if
985 
986 ! -- simply calculate the next indexes. Watch for instances where we're
987 ! -- crossing the dateline (i2 == gdas%ni+1) and circle back to index 1.
988  i2 = i1 + 1
989  if (i2 == gdas%ni+1) i2 = 1
990  j2 = j1 + 1
991 
992  status = 0
993  return
994 
995  end function get_interp_indexes
996 
997  end module viirs_ancillary
an array had not been initialized Several spelling and grammar corrections were which is read from the appropriate MCF the above metadata values were hard coded A problem calculating the average background DN for SWIR bands when the moon is in the space view port was corrected The new algorithm used to calculate the average background DN for all reflective bands when the moon is in the space view port is now the same as the algorithm employed by the thermal bands For non SWIR changes in the averages are typically less than Also for non SWIR the black body DNs remain a backup in case the SV DNs are not available For SWIR the changes in computed averages were larger because the old which used the black body suffered from contamination by the micron leak As a consequence of the if SV DNs are not available for the SWIR the EV pixels will not be the granule time is used to identify the appropriate tables within the set given for one LUT the first two or last two tables respectively will be used for the interpolation If there is only one LUT in the set of it will be treated as a constant LUT The manner in which Earth View data is checked for saturation was changed Previously the raw Earth View DNs and Space View DNs were checked against the lookup table values contained in the table dn_sat The change made is to check the raw Earth and Space View DNs to be sure they are less than the maximum saturation value and to check the Space View subtracted Earth View dns against a set of values contained in the new lookup table dn_sat_ev The metadata configuration and ASSOCIATEDINSTRUMENTSHORTNAME from the MOD02HKM product The same metatdata with extensions and were removed from the MOD021KM and MOD02OBC products ASSOCIATEDSENSORSHORTNAME was set to MODIS in all products These changes are reflected in new File Specification which users may consult for exact the pow functions were eliminated in Emissive_Cal and Emissive bands replaced by more efficient code Other calculations throughout the code were also made more efficient Aside from a few round off there was no difference to the product The CPU time decreased by about for a day case and for a night case A minor bug in calculating the uncertainty index for emissive bands was corrected The frame index(0-based) was previously being used the frame number(1-based) should have been used. There were only a few minor changes to the uncertainty index(maximum of 1 digit). 3. Some inefficient arrays(Sigma_RVS_norm_sq) were eliminated and some code lines in Preprocess_L1A_Data were moved into Process_OBCEng_Emiss. There were no changes to the product. Required RAM was reduced by 20 MB. Now
real function, public get_winds(rlat, rlon, status)
integer function, public load_geos5_data(filename1, filename2, hr, min)
integer function lat2index(lat, status)
real(8) function, public get_pwat(rlat, rlon, status)
real(8) function, public get_tozne(rlat, rlon, status)
integer function read_and_reshape_grib_message(grib_id, out_data)
string & trim(string &s, const string &delimiters)
Definition: EnvsatUtil.cpp:29
#define min(A, B)
Definition: main_biosmap.c:62
type(ncep_gdas_grib) function read_geos5(filename1, status)
#define f
Definition: l1_czcs_hdf.c:702
integer function, public load_ncep_data(filename1, filename2, hr, min)
real function, public get_wind_dir(rlat, rlon, status)