[jdc] 22-jun-2007

**Metar data package**

[METAR] data can be obtained from http://www.noaa.org/ using ftp. This package can query data from the NOAA server and parse METAR data (obtained with this package or otherwise).

----

[KPV] See also [TclWeather] and [A Very Simple Weather App] both of which download and parse METAR data.

----

======
package provide tclmetar 0.1
package require ftp

namespace eval ::tclmetar {
    variable ftpsock
    variable metar_keys {abbrev raw year month day hour minute corrected winddir winddirstr windspeed windgust windvarfrom windvarfromstr windvarto windvartostr temperature dewpoint airpressure cloudstype cloudsheight toweringcumulus cumulonimbus weather visibility}
}

proc ::tclmetar::get_winddirstr { winddir } { 
    if { [string is integer -strict $winddir] } { 
        set wsi [expr {int(($winddir+11.25)/22.5)}]
        return [lindex {N NNE NE ENE E ESE SE SSE S SSW SW WSW W WNW NW NNW N} $wsi]
    }
    return $winddir
}

proc ::tclmetar::parse_wind { f wd winddirnm winddirstrnm ws windspeednm wg windgustnm wu } { 
    upvar $winddirnm    winddir
    upvar $winddirstrnm winddirstr
    upvar $windspeednm  windspeed
    upvar $windgustnm   windgust
    set winddir   [string trimleft $wd "0"]
    if { [string length $winddir] == 0 } { 
        set winddir 0
    }
    set windspeed [string trimleft $ws "0"]
    if { [string length $windspeed] == 0 } { 
        set windspeed 0
    }
    set windgust  [string trimleft [string range $wg 1 end] "0"]
    if { [string length $windgust] == 0 } { 
        set windgust 0
    }
    switch -exact -- $wu {
        "KT" {
            set windspeed [expr {round($windspeed * 1.852)}]
            set windgust  [expr {round($windgust  * 1.852)}]
        }
        "MPS" {
            set windspeed [expr {round($windspeed * 3.6)}]
            set windgust  [expr {round($windgust  * 3.6)}]
        }
        "KMH" {
        }
    }
    set winddirstr [get_winddirstr $winddir]
    return
}

proc ::tclmetar::parse_wind_variability { wvf windvarfromnm windvarfromstrnm wvt windvartonm windvartostrnm } {
    upvar $windvarfromnm    windvarfrom
    upvar $windvartonm      windvarto
    upvar $windvarfromstrnm windvarfromstr
    upvar $windvartostrnm   windvartostr
    set windvarfrom [string trimleft $wvf "0"]
    if { [string length $windvarfrom] == 0 } { 
        set windvarfrom 0
    }
    set windvarfromstr [get_winddirstr $windvarfrom]
    set windvarto   [string trimleft $wvt "0"]
    if { [string length $windvarto] == 0 } { 
        set windvarto 0
    }
    set windvartostr [get_winddirstr $windvarto]
    return
}

proc ::tclmetar::parse_temperature { f tempnm } { 
    upvar $tempnm temp
    if { [string match "M*" $f] } { 
        set temp -[string trimleft [string range $f 1 end] "0"]
        if { [string equal $temp "-"] } { 
            set temp "0"
        }
    } else {
        set temp [string trimleft $f "0"]
        if { [string length $temp] == 0 } {
            set temp "0"
        }
    }
}

proc ::tclmetar::parse_air_pressure { pv airpressurenm pu } {
    upvar $airpressurenm airpressure
    switch -exact -- $pu {
        "A" {
            set airpressure [string trimleft [string range $pv 0 1] "0"].[string range $pv 2 3]
            set airpressure [expr {$airpressure * 0.033864}]
        }
        "Q" {
            set airpressure [expr {[string trimleft $pv "0"] / 1000.0}]
        }
    }
    return
}

proc ::tclmetar::parse_clouds { ct cloudstypenm ch cloudsheightnm cbtcu toweringcumulusnm cumulonimbusnm } {
    upvar $cloudstypenm      cloudstype
    upvar $cloudsheightnm    cloudsheight
    upvar $toweringcumulusnm toweringcumulus
    upvar $cumulonimbusnm    cumulonimbus
    switch -exact -- $ct {
        SKC -
        CLR -
        NSC {
            if { [string equal $cloudstype "<unknown>"] } {
                set cloudstype SKC
            } else {
                lappend cloudstype SKC
            }
        }
        FEW -
        SCT -
        BKN -
        OVC {
            if { [string equal $cloudstype "<unknown>"] } {
                set cloudstype $ct
            } else {
                lappend cloudstype $ct
            }
        }
    }
    set ch [string trimleft $ch "0"]
    if { [string length $ch] == 0 } { 
        set ch "0"
    }
    if { [string equal $cloudsheight "<unknown>"] } {
        set cloudsheight [expr {$ch * 30.48}]
    } else {
        lappend cloudsheight [expr {$ch * 30.48}]
    }
    switch -exact -- $cbtcu {
        CB {
            set toweringcumulus 0 
            set cumulonimbus 1
        }
        TCU {
            set toweringcumulus 1
            set cumulonimbus 0
        }
        default {
            set toweringcumulus 0 
            set cumulonimbus 0
        }
    }
    return
}

proc ::tclmetar::parse_weather { int vic desc wea weathernm } { 
    upvar $weathernm weather 
    set wl [list $int $vic $desc $wea]
    if { [string equal $weather "<unknown>"] } {
        set weather [list $wl]
    } else {
        lappend weather $wl
    }
    return
}

proc ::tclmetar::parse_international_visibility { m visibilitynm } { 
    upvar $visibilitynm visibility
    set visibility [string trimleft $m "0"]
    if { [string length $visibility] == 0 } {
        set visibility 0
    }
    return
}

proc ::tclmetar::parse_american_visibility { v1 v2 prevf visibilitynm } {
    upvar $visibilitynm visibility
    if { ([string length $v2] == 0) || [string equal $v2 "0"] } {
        set v2 1
    }
    append v2 ".0"
    if { ![string is integer -strict $prevf] } {
        set prevf 0
    }
    set visibility [expr {($prevf + $v1/$v2) * 1609.34}]
    return
}

proc ::tclmetar::parse { metarl mi_abbrev } { 

    set ar(abbrev)          $mi_abbrev
    set ar(raw)             $metarl
    set ar(year)            "<unknown>"
    set ar(month)           "<unknown>"
    set ar(day)             "<unknown>"
    set ar(hour)            "<unknown>"
    set ar(minute)          "<unknown>"
    set ar(corrected)       "<unknown>" ;# bool
    set ar(winddir)         "<unknown>" ;# 0 = north, 90 = east
    set ar(winddirstr)      "<unknown>"
    set ar(windspeed)       "<unknown>" ;# in km/h
    set ar(windgust)        "<unknown>" ;# in km/h
    set ar(windvarfrom)     "<unknown>" ;# 0 = north, 90 = east
    set ar(windvarfromstr)  "<unknown>" ;# 0 = north, 90 = east
    set ar(windvarto)       "<unknown>" ;# 0 = north, 90 = east
    set ar(windvartostr)    "<unknown>" ;# 0 = north, 90 = east
    set ar(temperature)     "<unknown>" ;# in degrees Celcius
    set ar(dewpoint)        "<unknown>" ;# in degrees Celcius
    set ar(airpressure)     "<unknown>" ;# in bar
    set ar(cloudstype)      "<unknown>" ;# list of SKC (sky clear) | FEW | SCT (scattered) | BKN (broken) | OVC (overcast) | CAVOK
    set ar(cloudsheight)    "<unknown>" ;# list of heights in meter | CAVOK
    set ar(toweringcumulus) "<unknown>" ;# bool
    set ar(cumulonimbus)    "<unknown>" ;# bool
    set ar(weather)         "<unknown>" ;# in metar abbreviations
    set ar(visibility)      "<unknown>" ;# in meter

    set prevf ""
    set mi_abbrev_found 0

    foreach f $metarl {
        ach f $metarl {
        if { [string equal $mi_abbrev $f] } {
            set mi_abbrev_found 1
            continue
        }
        }
        if { !$mi_abbrev_found && [regexp {([0-9]{4})/([0-9]{2})/([0-9]{2})} $f m y m d] } {
            set ar(year)  [string trimleft $y "0"]
            set ar(month) [string trimleft $m "0"]
            set ar(day)   [string trimleft $d "0"]
        } elseif { !$mi_abbrev_found && [regexp {([0-9]{2}):([0-9]{2})} $f ma h m] } {
            set ar(hour)   [string trimleft $h "0"]
            if { [string length $ar(hour)] == 0 } { 
                set ar(hour) 0
            }
            set ar(minute) [string trimleft $m "0"]
            if { [string length $ar(minute)] == 0 } { 
                set ar(minute) 0
            }       
        } elseif { !$mi_abbrev_found } { 
            continue
        } elseif { [string match "RMK*" $f] || [string match "TEMP*" $f] || [string match "NOSIG*" $f] } {
            break
        } elseif { [regexp {([0-9][0-9])([0-9][0-9])([0-9][0-9])Z} $f ma d h m] } {
            # Date/time field
            set ar(day)    [string trimleft $d "0"]
            set ar(hour)   [string trimleft $h "0"]
            if { [string length $ar(hour)] == 0 } { 
                set ar(hour) 0
            }
            set ar(minute) [string trimleft $m "0"]
            if { [string length $ar(minute)] == 0 } { 
                set ar(minute) 0
            }
        } elseif { [string equal "COR" $f] } { 
            set ar(corrected) 1
        } elseif { [string equal "AUT" $f] } {
            set ar(corrected) 0
        } elseif { [string match {R[0-9][0-9][LCR]*} $f] } { 
            # Runway visibility still to be added
        } elseif { [regexp {([0-9]{3}|VRB)([0-9]{2,3})(G[0-9]{2,3})?(KT|KMH|MPS)} $f m wd ws wg wu] } {
            # Wind field
            parse_wind $f $wd ar(winddir) ar(winddirstr) $ws ar(windspeed) $wg ar(windgust) $wu
        } elseif { [regexp {([0-9]{3})V([0-9]{3})} $f m wvf wvt] } {
            # Wind variability
            parse_wind_variability $wvf ar(windvarfrom) ar(windvarfromstr) $wvt ar(windvarto) ar(windvartostr)
        } elseif { [regexp {^(M?[0-9][0-9])/+(M?[0-9][0-9])$} $f m temp dewp] } {
            # Temperature field
            parse_temperature $temp ar(temperature)
            parse_temperature $dewp ar(dewpoint)
        } elseif { [regexp {(A|Q)([0-9]{4})} $f m pu pv] } {
            # Altimeter settings field
            parse_air_pressure $pv ar(airpressure) $pu
        } elseif { [regexp {(SKC|FEW|SCT|BKN|OVC|CLR|NSC)([0-9]{3})?(CB|TCU)?} $f m ct ch cbtcu] } {
            # Clouds field
            parse_clouds $ct ar(cloudstype) $ch ar(cloudsheight) $cbtcu ar(toweringcumulus) ar(cumulonimbus)
        } elseif { [string equal $f "CAVOK"] } { 
            set ar(cloudstype) "CAVOK"
            set ar(cloudsheight) "CAVOK"
            set ar(cumulonimbus) 0
            set ar(toweringcumulus) 0
            set ar(visibility) 9999
        } elseif { [regexp {([\+\-]?)(VC)?(MI|BC|PR|TS|BL|SH|DR|FZ)?(DZ|RA|SN|SG|IC|PI|GR|GS|UP|BR|FG|FU|VA|SA|HZ|PY|DU|SQ|SS|DU|PO|FC|\+FC)} $f m int vic desc wea] } {
            # Weather field
            parse_weather $int $vic $desc $wea ar(weather)
            while { 1 } {
                set f [string range $f [string length $m] end]
                if { ![regexp {([\+\-]?)(VC)?(MI|BC|PR|TS|BL|SH|DR|FZ)?(DZ|RA|SN|SG|IC|PI|GR|GS|UP|BR|FG|FU|VA|SA|HZ|PY|DU|SQ|SS|DU|PO|FC|\+FC)} $f m int vic desc wea] } {
                    break
                }
                parse_weather $int $vic $desc $wea ar(weather)
            }
        } elseif { [regexp {[0-9]{4}} $f m ] } { 
            # International visibility field
            parse_international_visibility $m ar(visibility)
        } elseif { [regexp {^([0-9]{1,2})/?([0-9]{0,2})SM$} $f m v1 v2] } {
            # American visibility field
            parse_american_visibility $v1 $v2 $prevf ar(visibility)
        }
        # Visibility directions still to be added

        set prevf $f
    }

    return [array get ar]
}

proc ::tclmetar::get_time { arnm } {
    upvar $arnm ar
    set y $ar(year)
    while { [string length $y] < 4 } {
        set y "0$y"
    }
    set M $ar(month)
    while { [string length $M] < 2 } { 
        set M "0$M"
    }
    set d $ar(day)
    while { [string length $d] < 2 } { 
        set d "0$d"
    }
    set h $ar(hour)
    while { [string length $h] < 2 } { 
        set h "0$h"
    }
    set h "T$h"
    set m $ar(minute)
    while { [string length $m] < 2 } { 
        set m "0$m"
    }
    set s "00"
    set mt [clock scan "$y$M$d$h$m$s" -gmt true]
    return $mt
}

proc ::tclmetar::ftpopen { ftpserver ftpuser ftppassword ftpdir } {
    variable ftpsock
    set ftpsock [ftp::Open $ftpserver $ftpuser $ftppassword]
    ftp::Cd $ftpsock $ftpdir
    return
}

proc ::tclmetar::ftpget { mfile } {
    variable ftpsock
    set mdata ""
    set rt [ftp::Get $ftpsock $mfile -variable mdata]
    if { [string length $rt] && $rt } { 
        set mdata [string map {\n " " \r " " \t " "} [string trim $mdata]]
        return [eval list [split $mdata]]
    } else {
        return -code error "Could not download file '$mfile'"
    }
}

proc ::tclmetar::ftpclose { } {
    variable ftpsock
    ftp::Close $ftpsock
}

proc ::tclmetar::get_metar_data { mi_abbrev } {

    set ftpserver tgftp.nws.noaa.gov
    set ftpdir data/observations/metar/stations
    set ftpuser anonymous
    set ftppassword anonymous

    set tVerbose $ftp::VERBOSE
    set ::ftp::VERBOSE 0
    ::log::lvSuppress error
    tclmetar::ftpopen $ftpserver $ftpuser $ftppassword $ftpdir
    set rt [catch {tclmetar::ftpget $mi_abbrev.TXT} mi_data]
    tclmetar::ftpclose
    set ::ftp::VERBOSE $tVerbose

    if { $rt } {
        return -code error $mi_data
    }

    if { [catch {tclmetar::parse $mi_data $mi_abbrev} rl] } { 
        return -code error $rl
    }

    return $rl
}
======

**Initialisation**

After a 

======
package require tclmetar
======

the package is ready for use.

**Available data**

+++
abbrev   METAR station abbreviation          
raw   Unparsed METAR data as obtained from the NOAA server
year   Year part of date on which METAR data was collected
month   Month part of date on which METAR data was collected
day   Day part of date on which METAR data was collected
hour   Hour part of date on which METAR data was collected
minute   Minute part of date on which METAR data was collected
corrected   Indication if METAR data was correct before upload to NOAA server by METAR Station of not
winddir   Wind direction, 0 = north, 90 = east, ...
winddirstr   String representation of wind direction (N, NNE, NE, ENE, E, ESE, SE, SSE, S, SSW, SW, WSW, W, WNW, NW, NNW, N)
windspeed   Wind speed, in km/h
windgust   Wind gusts, in km/h
windvarfrom   Variable wind direction ''from'' this direction, 0 = north, 90 = east, ...
windvarfromstr   String representation of wind variability ''from'' 
windvarto   Variable wind direction ''to'' this direction,  0 = north, 90 = east, ...
windvartostr   String representation of wind variability ''to'' 
temperature   Temperature, in degrees Celcius
dewpoint   Temperatur, in degrees Celcius
airpressure   Air-pressure, in bar
cloudstype   Clouds-type, list of SKC (sky clear), FEW (few), SCT (scattered), BKN (broken), OVC (overcast), CAVOK (ceiling and visibility OK)
cloudsheight   List of clouds-heights in meter or CAVOK
toweringcumulus   Boolean indicating if this type of clouds is present near the METAR station
cumulonimbus    Boolean indicating if this type of clouds is present near the METAR station
weather         Weather in METAR abbreviations
visibility      Horizontal visibility at ground level, in meter
+++

**::tclmetar::get_metar_data**

Command:

===
::tclmetar::get_metar_data ''metarStationCode''
===

This command will query the METAR data for the specified ''metarStationCode'' and return the parsed result as a list of key/value pairs suitable for use with [array set].

The following script will query METAR data for all METAR stations specified on the command line:

======
package require tclmetar
foreach m $argv {
    if { [catch {::tclmetar::get_metar_data $m} wl] } {
        puts "Could not get METAR info for '$m'"
    } else {
        puts "Weather for $m:"
        array set a $wl
        parray a
        unset a
    }
}
======

======
> tclsh test.tcl EBBR KJFK
Weather for EBBR:
a(abbrev)          = EBBR
a(airpressure)     = 1.008
a(cloudsheight)    = 1158.24
a(cloudstype)      = SCT
a(corrected)       = <unknown>
a(cumulonimbus)    = 0
a(day)             = 22
a(dewpoint)        = 10
a(hour)            = 11
a(minute)          = 20
a(month)           = 6
a(raw)             = 2007/06/22 11:20 EBBR 221120Z 20011KT 170V240 9999 SCT038 20/10 Q1008 TEMPO 5000 SHRA FEW020CB BKN030
a(temperature)     = 20
a(toweringcumulus) = 0
a(visibility)      = 9999
a(weather)         = <unknown>
a(winddir)         = 200
a(winddirstr)      = SSW
a(windgust)        = 0
a(windspeed)       = 20
a(windvarfrom)     = 170
a(windvarfromstr)  = S
a(windvarto)       = 240
a(windvartostr)    = WSW
a(year)            = 2007
Weather for KJFK:
a(abbrev)          = KJFK
a(airpressure)     = 1.01016312
a(cloudsheight)    = 3657.6
a(cloudstype)      = FEW
a(corrected)       = <unknown>
a(cumulonimbus)    = 0
a(day)             = 22
a(dewpoint)        = 11
a(hour)            = 10
a(minute)          = 51
a(month)           = 6
a(raw)             = 2007/06/22 10:51 KJFK 221051Z 30016KT 10SM FEW120 19/11 A2983 RMK AO2 SLP102 T01890111 {$}
a(temperature)     = 19
a(toweringcumulus) = 0
a(visibility)      = 16093.4
a(weather)         = <unknown>
a(winddir)         = 300
a(winddirstr)      = WNW
a(windgust)        = 0
a(windspeed)       = 30
a(windvarfrom)     = <unknown>
a(windvarfromstr)  = <unknown>
a(windvarto)       = <unknown>
a(windvartostr)    = <unknown>
a(year)            = 2007
======

----
weather data

<<categories>> Science