Created
September 26, 2018 16:31
-
-
Save wjcapehart/8cdbf2f90d7caf09b2d40b43b357785b to your computer and use it in GitHub Desktop.
Unidata Program to Demonstrate Functions and Subroutines (w/o Modules)
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
program read_unidata2 | |
implicit none | |
! File Control | |
integer, parameter :: MAXREC = 100 | |
character (len=180) :: directory | |
character (len=180) :: filename | |
character (len=180) :: csv_filename | |
integer :: ios | |
! Station Harvesting Variables | |
character (len= 4) :: target_station | |
! Unidata SFLIST Input Variables | |
integer :: yyyy | |
integer :: mm | |
integer :: dd | |
integer :: hh | |
integer :: mn | |
real, parameter :: FILL_VALUE = -9999.0 | |
character (len= 4), dimension(MAXREC) :: station_code = "____" | |
real, dimension(MAXREC) :: longitude = FILL_VALUE | |
real, dimension(MAXREC) :: latitude = FILL_VALUE | |
real, dimension(MAXREC) :: elevation = FILL_VALUE | |
real, dimension(MAXREC) :: tmpf = FILL_VALUE | |
real, dimension(MAXREC) :: dwpf = FILL_VALUE | |
real, dimension(MAXREC) :: drct = FILL_VALUE | |
real, dimension(MAXREC) :: sknt = FILL_VALUE | |
real, dimension(MAXREC) :: pmsl = FILL_VALUE | |
! Derived Variables | |
real, dimension(MAXREC) :: uwnd = FILL_VALUE | |
real, dimension(MAXREC) :: vwnd = FILL_VALUE | |
real, dimension(MAXREC) :: rh = FILL_VALUE | |
! Modified Date-Time for Excel/CSV/R compatability | |
character (len=16), dimension(MAXREC) :: excel_date = "________________" | |
!!!!! Record Counts | |
integer :: i ! index for record count | |
integer :: number_of_records ! counter for number of records | |
!!!!! Functions | |
real :: wjc_degf_to_k_func | |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | |
directory = "/academic/atm_519/data/UNIDATA_ASCII_2014/" | |
filename = "sflist_2018-09-14.txt" | |
write(*,'(A)', advance="no") "Enter Target Station :" | |
read(*,*) target_station | |
open(unit = 1, & | |
file = trim(directory) // trim(filename), & | |
status = "old", & | |
form = "formatted", & | |
iostat = ios) | |
print*, ios | |
!reading headers | |
read(1,*) | |
read(1,*) | |
read(1,*) | |
read(1,*) | |
! read station line | |
i = 1 | |
read(1, 1000, iostat=ios) station_code(i), & | |
yyyy, & | |
mm, & | |
dd, & | |
hh, & | |
mn, & | |
longitude(i), & | |
latitude(i), & | |
elevation(i), & | |
tmpf(i), & | |
dwpf(i), & | |
drct(i), & | |
sknt(i), & | |
pmsl(i) | |
1000 format(3x, a4, 4x, 3(i2), x, 2(i2), x, 6(f9.2), /, 23x, 2(f9.2)) | |
do while (ios .eq. 0) | |
if (trim(adjustL(station_code(i))) .eq. trim(target_station)) then | |
write(excel_date(i), 2000) (2000+yyyy), mm, dd, hh, mn | |
tmpf(i) = wjc_degf_to_k_func( tmpf(i) , & | |
FILL_VALUE ) | |
dwpf(i) = wjc_degf_to_k_func( dwpf(i), & | |
FILL_VALUE ) | |
call wjc_wind_spd_dir_to_u_v_sub(sknt(i), & | |
drct(i), & | |
uwnd(i), & | |
vwnd(i), & | |
FILL_VALUE ) | |
2000 format(i4.4, "-", i2.2, "-", i2.2, " ", i2.2, ":", i2.2) | |
write(*,*) "Record for ", target_station, & | |
" found at ", excel_date(i) | |
i = i + 1 | |
end if | |
!! read for next time step | |
read(1, 1000, iostat=ios) station_code(i), & | |
yyyy, & | |
mm, & | |
dd, & | |
hh, & | |
mn, & | |
longitude(i), & | |
latitude(i), & | |
elevation(i), & | |
tmpf(i), & | |
dwpf(i), & | |
drct(i), & | |
sknt(i), & | |
pmsl(i) | |
end do | |
number_of_records = i - 1 | |
write(*,*) "Total Records for Station ", target_station, & | |
": ", number_of_records | |
close(unit = 1) | |
! Write the CSV File | |
write(csv_filename, 3000) trim(target_station), excel_date(1)(1:10) | |
3000 format(A, "_", A10, ".csv") | |
write(*,*) "writing CSV output to file ", trim(csv_filename) | |
open(unit = 2, & | |
file = "./" // trim(csv_filename), & | |
form = "formatted") | |
write(2,*) "st_id,time,lon,lat,elev,temp,dwpt,drct,uwnd,vwnd,sknt,pmsl" | |
do i = 1, number_of_records | |
write(2,4000) station_code(i), & | |
excel_date(i), & | |
longitude(i), & | |
latitude(i), & | |
elevation(i), & | |
tmpf(i), & | |
dwpf(i), & | |
drct(i), & | |
sknt(i), & | |
uwnd(i), & | |
vwnd(i), & | |
pmsl(i) | |
4000 format( A4, ",", A16, 14(",", F9.2) ) | |
end do | |
close(unit = 2) | |
end program read_unidata2 | |
! | |
!--- Sample Read Line From Unidata SFLIST Command | |
! | |
!12312341234121212112121123456789123456789123456789123456789123456789123456789 | |
! STN YYMMDD/HHMM SLON SLAT SELV TMPF DWPF DRCT | |
!12345678901234567890123123456789123456789 | |
! SKNT PMSL | |
! 2G4 141001/0000 -79.34 39.58 894.00 51.80 -9999.00 210.00 | |
! 4.00 -9999.00 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
real function wjc_degf_to_k_func( temperature , & | |
FillValue ) | |
implicit none | |
real, intent(in) :: temperature | |
real, intent(in) :: FillValue | |
if (temperature .ne. FillValue) then | |
wjc_degf_to_k_func = ( temperature - 32. ) * 5. / 9. + 273.15 | |
else | |
wjc_degf_to_k_func = FillValue | |
end if | |
return | |
end function wjc_degf_to_k_func |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
subroutine wjc_wind_spd_dir_to_u_v_sub( speed, & | |
dirfromdeg, & | |
u_wind, & | |
v_wind, & | |
FillValue ) | |
implicit none | |
real, parameter :: PI = 3.14159265 | |
real, intent(in) :: speed | |
real, intent(in) :: dirfromdeg | |
real, intent(out) :: u_wind | |
real, intent(out) :: v_wind | |
real, intent(in) :: FillValue | |
real :: dir_rad | |
if ( (speed .ne. FillValue) .and. (dirfromdeg .ne. FillValue) ) then | |
dir_rad = dirfromdeg * PI / 180.0 | |
u_wind = - speed * sin( dir_rad ) | |
v_wind = - speed * cos( dir_rad ) | |
else | |
u_wind = FillValue | |
v_wind = FillValue | |
end if | |
return | |
end subroutine wjc_wind_spd_dir_to_u_v_sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment