18 integer,
parameter :: rdbl = selected_real_kind(p=13)
20 type :: ncep_gdas_grib
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
30 type(ncep_gdas_grib) :: gdas
37 integer function load_ncep_data(filename1, filename2, hr, min)
result(status)
40 character(len=255),
intent(in) :: filename1
41 character(len=255),
intent(in) :: filename2
42 integer,
intent(in) :: hr
43 integer,
intent(in) ::
min
45 type(ncep_gdas_grib) :: gdas1
46 type(ncep_gdas_grib) :: gdas2
51 integer,
dimension(2) :: dims
55 gdas1 = read_ncep_gdas(filename1, status)
57 print *,
"ERROR: Failed to read NCEP GDAS ancillary data: ", status
58 print *,
"File: ",
trim(filename1)
62 gdas2 = read_ncep_gdas(filename2, status)
64 print *,
"ERROR: Failed to read NCEP GDAS ancillary data: ", status
65 print *,
"File: ",
trim(filename2)
70 hrs = hr + (
min / 60.0)
81 print *,
"ERROR: Invalid hour detected: ", hr
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)
89 print *,
"ERROR: Failed to allocate interpolated windspeed arrays: ", status
93 allocate(gdas%tozne(gdas1%ni, gdas1%nj), stat=status)
95 print *,
"ERROR: Failed to allocate interpolated ozone array: ", status
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
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
117 integer function load_geos5_data(filename1, filename2, hr, min)
result(status)
120 character(len=255),
intent(in) :: filename1
121 character(len=255),
intent(in) :: filename2
122 integer,
intent(in) :: hr
123 integer,
intent(in) ::
min
125 type(ncep_gdas_grib) :: gdas1
126 type(ncep_gdas_grib) :: gdas2
137 if (status /= 0)
then
138 print *,
"ERROR: Failed to read GEOS5 ancillary data: ", status
139 print *,
"File: ",
trim(filename1)
144 if (status /= 0)
then
145 print *,
"ERROR: Failed to read GEOS5 ancillary data: ", status
146 print *,
"File: ",
trim(filename2)
151 hrs = hr + (
min / 60.0)
162 print *,
"ERROR: Invalid hour detected: ", hr
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
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
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
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
204 real function
get_winds(rlat, rlon, status) result(ws)
207 real,
intent(in) :: rlat
208 real,
intent(in) :: rlon
209 integer,
intent(out) :: status
211 real,
dimension(4) ::
f
219 if(rlat > 90.0 .or. rlat < -90.0)
then
220 print*,
'ERROR: lat out of range must be 90 to -90:', rlat
223 if (rlon < -180.0 .OR. rlon > 180.0)
then
224 print*,
'ERROR: lon out of range must be [-180,180):', rlon
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
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)
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
258 real function
get_wind_dir(rlat, rlon, status) result(wd)
261 real,
intent(in) :: rlat
262 real,
intent(in) :: rlon
263 integer,
intent(out) :: status
265 real,
dimension(4) ::
f
274 if(rlat >= 90.0 .or. rlat < -90.0)
then
275 print*,
'ERROR: lat out of range must be 90 to -90:', rlat
278 if (rlon < -180.0 .OR. rlon >= 180.0)
then
279 print*,
'ERROR: lon out of range must be [-180,180):', rlon
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
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)
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
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)
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
312 wd = (atan2(-1.0*u,-1.0*v) * 180.0/3.1415926535)
313 if (wd < 0) wd = wd + 360.0
325 real(8) function
get_pwat(rlat, rlon, status) result(pw)
328 real,
intent(in) :: rlat
329 real,
intent(in) :: rlon
330 integer,
intent(out) :: status
332 real,
dimension(4) ::
f
340 if(rlat >= 90.0 .or. rlat < -90.0)
then
341 print*,
'ERROR: lat out of range must be 90 to -90:', rlat
344 if (rlon < -180.0 .OR. rlon >= 180.0)
then
345 print*,
'ERROR: lon out of range must be [-180,180):', rlon
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
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)
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
376 real(8) function
get_tozne(rlat, rlon, status) result(oz)
379 real,
intent(in) :: rlat
380 real,
intent(in) :: rlon
381 integer,
intent(out) :: status
383 real,
dimension(4) ::
f
391 if(rlat >= 90.0 .or. rlat < -90.0)
then
392 print*,
'ERROR: lat out of range must be 90 to -90:', rlat
395 if (rlon < -180.0 .OR. rlon >= 180.0)
then
396 print*,
'ERROR: lon out of range must be [-180,180):', rlon
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
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)
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
440 type(ncep_gdas_grib) function read_ncep_gdas(filename1, status) result(gdas0)
446 character(len=255),
intent(in) :: filename1
447 integer,
intent(out) :: status
449 integer :: ni, nj, nval
450 integer :: iret, igrib, ifile
451 character(len=8) :: name
454 call grib_open_file(ifile, filename1,
'R',status)
456 print*,
'ERROR:',filename1,
'not found'
460 call grib_multi_support_on()
463 call grib_new_from_file(ifile,igrib,iret)
465 do while (iret /= grib_end_of_file)
466 call grib_get(igrib,
'shortName',name)
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
477 if (status /= 0)
then
478 print *,
"ERROR: Failed to read "//
trim(name)//
": ", status
482 elseif(name==
'10v')
then
483 call grib_get(igrib,
'Ni',gdas0%ni)
484 call grib_get(igrib,
'Nj',gdas0%nj)
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
493 if (status /= 0)
then
494 print *,
"ERROR: Failed to read "//
trim(name)//
": ", status
497 elseif(name==
'pwat')
then
498 call grib_get(igrib,
'Ni',gdas0%ni)
499 call grib_get(igrib,
'Nj',gdas0%nj)
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
508 if (status /= 0)
then
509 print *,
"ERROR: Failed to read "//
trim(name)//
": ", status
513 elseif(name==
'tozne'.or.name==
'tco3')
then
514 call grib_get(igrib,
'Ni',gdas0%ni)
515 call grib_get(igrib,
'Nj',gdas0%nj)
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
524 if (status /= 0)
then
525 print *,
"ERROR: Failed to read "//
trim(name)//
": ", status
531 call grib_release(igrib)
534 call grib_new_from_file(ifile,igrib, iret)
537 call grib_close_file(ifile)
540 if (.NOT.
allocated(gdas0%u_wndspd))
then
541 print *,
'ERROR: No u wind read from file.'
545 if (.NOT.
allocated(gdas0%v_wndspd))
then
546 print *,
'ERROR: No v wind read from file.'
550 if (.NOT.
allocated(gdas0%pwat))
then
551 print *,
'ERROR: No preciptable water read from file.'
555 if (.NOT.
allocated(gdas0%tozne))
then
556 print *,
'ERROR: No ozone read from file.'
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
568 gdas0%wndspd = sqrt(gdas0%v_wndspd**2 + gdas0%u_wndspd**2)
573 end function read_ncep_gdas
578 type(ncep_gdas_grib) function
read_geos5(filename1, status) result(gdas0)
585 character(len=255),
intent(in) :: filename1
586 integer,
intent(inout) :: status
588 character(len=255) :: dset_name
598 real,
dimension(:,:,:),
allocatable :: tmp_anc
602 status = nf90_open(filename1, nf90_nowrite, nc_id)
603 if (status /= nf90_noerr)
then
604 print *,
"ERROR: Failed to open geolocation file: ", status
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
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
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
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
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
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
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
656 allocate(tmp_anc(nlon,nlat,ntime), stat=status)
657 if (status /= 0)
then
658 print *,
"ERROR: Failed to allocate tmp data arrays: ", status
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
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
675 gdas0%u_wndspd = tmp_anc(:,:,1)
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
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
690 gdas0%v_wndspd = tmp_anc(:,:,1)
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
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
705 gdas0%pwat = tmp_anc(:,:,1)
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
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
720 gdas0%tozne = tmp_anc(:,:,1)
722 deallocate(tmp_anc, stat=status)
723 if (status /= 0)
then
724 print *,
"WARNING: Failed to deallocate tmp data array: ", status
727 status = nf90_close(nc_id)
728 if (status /= nf90_noerr)
then
729 print *,
'ERROR: Failed to close GEOS-5 ancillary data file: ', status
734 if (.NOT.
allocated(gdas0%u_wndspd))
then
735 print *,
'ERROR: No u wind read from file.'
739 if (.NOT.
allocated(gdas0%v_wndspd))
then
740 print *,
'ERROR: No v wind read from file.'
744 if (.NOT.
allocated(gdas0%pwat))
then
745 print *,
'ERROR: No preciptable water read from file.'
749 if (.NOT.
allocated(gdas0%tozne))
then
750 print *,
'ERROR: No ozone read from file.'
756 allocate(gdas0%wndspd(nlon, nlat), stat=status)
757 if (status /= 0)
then
758 print *,
'ERROR: Failed to allocate array for GDAS windspeeds: ', status
762 gdas0%wndspd = sqrt(gdas0%v_wndspd**2 + gdas0%u_wndspd**2)
782 integer,
intent(in) :: grib_id
783 character(len=255) :: grib_key
784 real(kind=rdbl),
dimension(:,:),
intent(out) :: out_data
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
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
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
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
816 call grib_get_data_real8(grib_id,lats,lons,tmp1)
818 out_data = reshape(tmp1, (/ni,nj/))
820 out_data = out_data(:,ubound(out_data,2):lbound(out_data,2):-1)
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
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
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
849 integer function lat2index(lat, status)
result(index)
852 real,
intent(in) :: lat
853 integer,
intent(out) :: status
855 if (lat < -90.0 .OR. lat > 90.0)
then
856 print *,
"ERROR: Invalid latitude: ", lat
861 index = floor((lat + 90.0) / 0.5) + 1
873 real function index2lat(
index, status) result(lat)
876 integer,
intent(in) ::
index
877 integer,
intent(out) :: status
880 print *,
'ERROR: Index is out of bounds of windspeed array: ',
index, gdas%nj
885 lat = -90.0 + 0.5*(
index-1)
890 end function index2lat
899 integer function lon2index(lon, status)
result(index)
902 real,
intent(in) :: lon
903 integer,
intent(out) :: status
905 if (lon < -180.0 .OR. lon >= 180.0)
then
906 print *,
"ERROR: Invalid longitude: ", lon
911 index = floor((lon + 180.0)/0.625) + 1
916 end function lon2index
923 real function index2lon(
index, status) result(lon)
926 integer,
intent(in) ::
index
927 integer,
intent(out) :: status
930 print *,
'ERROR: Index is out of bounds of windspeed array: ',
index, gdas%ni
935 lon = -180.0 + 0.625*(
index-1)
940 end function index2lon
950 integer function get_interp_indexes(lat, lon, i1, i2, j1, j2)
result(status)
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
964 if(lat >= 90.0 .or. lat < -90.0)
then
965 print*,
'ERROR: lat out of range must be [-90,90):', lat
968 if (lon < -180.0 .OR. lon >= 180.0)
then
969 print*,
'ERROR: lon out of range must be [-180,180):', lon
974 i1 = lon2index(lon, status)
975 if (status /= 0)
then
976 print *,
"ERROR: Failed to convert longitude to index into ancillary data array: ", status
981 if (status /= 0)
then
982 print *,
"ERROR: Failed to convert latitude to index into ancillary data array: ", status
989 if (i2 == gdas%ni+1) i2 = 1
995 end function get_interp_indexes