[OpenMadrigal-developers] Re: Files -- madrigal loading
William Rideout
brideout at haystack.mit.edu
Tue Oct 14 09:59:57 EDT 2003
Angela and Tony,
This is my bug. Attached is a corrected file Mad.c. To install it, do
the following:
1. Save the attached file Mad.c in $MADROOT/source/madc/madtcl
2. cd $MADROOT
3. make -f Makefile.gnu madtclsh
4. make -f Makefile.gnu binary
Please let me know if this does not fix the problem.
Explanation:
This bug in the madtcl library incorrectly freed memory that wasn't
supposed to be freed. The only way to see this bug was from ffw_print,
which I haven't been testing on a regular basis. This is because ffw
was originally built to print using the Madrigal C library, and avoid
the many problems of the old isprint built on the old Madrigal Fortran
library. The program ffw allowed you to use any measured parameter as a
filter using lower and upper bounds. However, ffw could not derive
parameters the way isprint could.
With Madrigal 2.1, all of Madrigal is built on the greatly expanded C
library, and isprint is built on top of it. Isprint can print both
derived and measured parameters, whereas ffw can only print measured
parameters and a few hard-coded derived parameters. Isprint allows a
wide variety of filters using any measured or derived parameter. So in
other words isprint has a superset of the capabilities of ffw, and I've
been ignoring ffw.
Now, it would be trival to replace ffw with a script that calls isprint,
so that ffw would suddenly work with both derived and measured
parameters. If there's interest in continuing ffw, let me know.
Bill
Angela Li wrote:
> Sorry to forget to attach files int he last mesage.
> Here they are.
>
> Angela Li wrote:
>
>
>>Hi Tony,
>>
>>I'm now runnning madrigal-2.2.1 on transport, and trying to use your
>>loading script to upload data into madrigal. But seems like ffw cannot
>>extract the year and date from the data files. Do you know if your
>>loading scripts will still work under this version of madrigal? Is
>>there a publicly available loading script that works for
>>madrigal-2.2.1?
>>
>>Attached are:
>>DataLoading/Load_Files_to_MADRIG
>>bin/ffw
>>
>>Error Message I got:
>>Processing
>>/data/isr/archive/0300-0399/0330/acport-33020-33040-5m-15s.mrg-1sigma
>>Skipping data load, error message was:
>>Time machine warning: input appears to be for year
>>
>>Processing
>>/data/isr/archive/0300-0399/0330/velbinport-33020-33040-20s.mrg-1sigma
>>Skipping data load, error message was:
>>Time machine warning: input appears to be for year
>>
>>Processing
>>/data/isr/archive/0300-0399/0330/acport-33020-33040-1m-20s.mrg-1sigma
>>Skipping data load, error message was:
>>Time machine warning: input appears to be for year
>>..........
>>
>>Hi Bill, if you know the answer to this problem, please help!
>>
>>thanks,
>>Angela
>>
>>
>>------------------------------------------------------------------------
>>
>>#!/bin/sh
>># The madtclsh path is longer than 32 characters. So, we take advantage
>># of the fact that a backslash continues a comment line in tcl \
>>exec /opt/madrigal-2.2.1/bin/madtclsh "$0" ${1+"$@"}
>>
>># Script to automate loading into MADRIGAL and updating necessary files
>>
>># ***** set MADROOT before running! ******
>>
>>lappend auto_path /opt/madrigal-2.2.1/madtcllib
>>package require cgi
>>package require mtl
>>
>># Stage directory should contain the following set of files for each experiment:
>># acport*sigma analysed data in NCAR format
>># *.txt single line experiment description (optional, but recommended)
>># YYMMDD*.ps matching PostScript plots (optional, but recommended)
>>#
>># handle Sondrestromfjord data only!
>>set siteName "son"
>>set siteCode 80
>>
>>madExperiment experiment
>>set madroot [experiment cget -madroot]
>>set madserver [experiment cget -madserver]
>>set madservercgi [experiment cget -madservercgi]
>>set madserverroot [experiment cget -madserverroot]
>>set htmlstyle [experiment cget -htmlstyle]
>>
>>set StageDirectory "$madroot/experiments/stage"
>>set MADRIGALDirectory "$madroot/experiments"
>>set WWWMADRIGALroot "http://$madserver/$madserverroot/experiments"
>>
>># Read in list of private KINDATS, if it exists, otherwise create an empty list
>>if { ![ catch { exec /bin/cat $madroot/privateKINDATs.txt } privateKINDATsFile ] } {
>> set privateKINDATEntries [ split $privateKINDATsFile "\n" ]
>> foreach privateKINDATEntry $privateKINDATEntries {
>> set privateKINDATs [ lappend privateKINDATs [ string trim $privateKINDATEntry ] ]
>> }
>>} else {
>> set privateKINDATs [ list ]
>>}
>>
>># This script will automatically inform those in the email list (if present)
>>if { ![ catch { exec /bin/cat $madroot/updateMailingList.txt } returnMessage ] } {
>> set emailListEntries [ split $returnMessage "\n" ]
>> foreach emailListEntry $emailListEntries {
>> set emailList [ lappend emailList [ string trim $emailListEntry ] ]
>> }
>>} else {
>> set emailList {}
>>}
>>puts $emailList
>>set mailSubject "Notification of data added to SRI MADRIGAL"
>>
>># Procedure converts a date such as 990823 to the MADRIGAL directory name form 23aug99
>>#
>>proc YYmmDDToMADRIGALDate { YYmmDD } {
>> set monthNames(1) "jan"; set monthNames(2) "feb"; set monthNames(3) "mar"
>> set monthNames(4) "apr"; set monthNames(5) "may"; set monthNames(6) "jun"
>> set monthNames(7) "jul"; set monthNames(8) "aug"; set monthNames(9) "sep"
>> set monthNames(10) "oct"; set monthNames(11) "nov"; set monthNames(12) "dec"
>> set monthNumber [ string range $YYmmDD 2 3 ]
>> if { [ string range $monthNumber 0 0 ] == "0" } {
>> set monthNumber [ string range $monthNumber 1 1 ]
>> }
>> return "[ string range $YYmmDD 4 5 ]$monthNames($monthNumber)[ string range $YYmmDD 0 1 ]"
>>}
>>
>>#
>># Main program starts here
>>#
>>
>>puts "\n================================================================"
>>puts "\nDATA LOAD to the SRI MADRIGAL site...."
>>puts "\nThis script will load data from a specified directory to"
>>puts "http://$madserver/$madserverroot and copy any *sigma analysed files,"
>>puts "PostScript, jpeg, and gif images to the appropriate directories.\n"
>>
>>if { [ info exists env(MADROOT) ] } {
>> puts "MADROOT: $env(MADROOT)"
>>} else {
>> puts "\a\a\a\aPlease set MADROOT (export MADROOT=$madroot) and restart\n"
>> exit
>>}
>>
>># Get a list of the experiments (ie all the *sigma files) to be processed
>>set datafileList {}; set datafilesFound 0
>>set GIFfileList {}; set GIFfilesFound 0
>>set PSfileList {}; set PSfilesFound 0
>>puts "\nIs the data to be loaded in a single directory?"
>>gets stdin userInput
>>if { [ string range $userInput 0 0 ] != "Y" && [ string range $userInput 0 0 ] != "y" } {
>> puts "Please enter the full name of the file containing the data list"
>> gets stdin dataList
>> if { ![ catch { exec /bin/cat $dataList | grep sigma | egrep "acport|velbinport|cwinds|epec|pecport|ewinds|fwinds|veest|peest" } datafileList ] } {
>> set datafilesFound 1
>> set StageDirectory ""
>> }
>> if { ![ catch { exec /bin/cat $dataList | egrep ".jpeg\$|.jpg\|.gif\$" } GIFfileList ] } {
>> set GIFfilesFound 1
>> set StageDirectory ""
>> }
>> if { ![ catch { exec /bin/cat $dataList | grep ".ps\$" } PSfileList ] } {
>> set PSfilesFound 1
>> set StageDirectory ""
>> }
>>} else {
>> puts "Please enter the full path name of the directory containing the data"
>> puts "(hit return to use $StageDirectory)"
>> gets stdin userInput
>> if { [ string length $userInput ] != 0 } {
>> set StageDirectory $userInput
>> }
>> if { ![ catch { exec /bin/ls -1 $StageDirectory | grep sigma | egrep "acport|velbinport|cwinds|epec|pecport|ewinds|fwinds|veest|peest" } datafileList ] } {
>> set datafilesFound 1
>> set i 0
>> foreach fileEntry $datafileList {
>> lreplace $datafileList $i $i $StageDirectory$fileEntry
>> incr i
>> }
>> }
>> if { ![ catch { exec /bin/ls -1 $StageDirectory | egrep ".jpeg\$|.jpg\|.gif\$" } GIFfileList ] } {
>> set GIFfilesFound 1
>> set i 0
>> foreach fileEntry $GIFfileList {
>> lreplace $GIFfileList $i $i $StageDirectory$fileEntry
>> incr i
>> }
>> }
>> if { ![ catch { exec /bin/ls -1 $StageDirectory | ".grep ".ps\$" } PSfileList ] } {
>> set PSfilesFound 1
>> set i 0
>> foreach fileEntry $PSfileList {
>> lreplace $PSfileList $i $i $StageDirectory$fileEntry
>> incr i
>> }
>> }
>>
>>}
>>
>>if { $datafilesFound } {
>> foreach fileEntry $datafileList {
>>
>> puts "\nProcessing $StageDirectory$fileEntry"
>> set errorMessage 0
>> # convert the first record of the file and extract its Year Month and Day
>> set temporaryFile "/tmp/[pid]testOut"
>> if { ![ catch { exec $madroot/bin/mergeCedarFiles -i $StageDirectory/$fileEntry 1 1 -o $temporaryFile -t 1 } returnMessage ] } {
>> if { ![ catch { exec $madroot/bin/ffw -file $temporaryFile -p year } returnMessage ] } {
>> set YYYY [ lindex $returnMessage 0 ]
>> if { [ string range $YYYY 0 0 ] == 1 || [ string range $YYYY 0 0 ] == 2 } {
>> if { ![ catch { exec $madroot/bin/ffw -file $temporaryFile -p month } returnMessage ] } {
>> set MM [ lindex $returnMessage 0 ]
>> if { ![ catch { exec $madroot/bin/ffw -file $temporaryFile -p day } returnMessage ] } {
>> set DD [ lindex $returnMessage 0 ]
>> # construct date in the form YYMMDD
>> set YY [ string range $YYYY 2 3 ]
>> if { [ string length $MM ] != 2 } { set MM "0$MM" }
>> if { [ string length $DD ] != 2 } { set DD "0$DD" }
>> set YYMMDD "$YY$MM$DD"
>> puts "Identified data from $YYMMDD"
>> } else { set errorMessage "ffw: $returnMessage" }
>> } else { set errorMessage "ffw: $returnMessage" }
>> } else { set errorMessage "Time machine warning: input appears to be for year $YYYY" }
>> } else { set errorMessage "ffw: $returnMessage" }
>> } else { set errorMessage "mergeCedarFiles: $returnMessage" }
>> catch { exec /bin/rm $temporaryFile } returnMessage
>>
>> if { $errorMessage == 0 } {
>> # check if experiment already exists in MADRIGAL and get a title line if not
>> set experimentDirectory "$MADRIGALDirectory/$YYYY/$siteName/[ YYmmDDToMADRIGALDate $YYMMDD ]"
>> if { [ catch { exec /bin/cat $experimentDirectory/expTab.txt } returnMessage ] } {
>> set elementsList [ split $returnMessage "," ]
>> if { [ lindex $elementsList 2 ] == "" } {
>> puts "Searching $madroot/MMcatalog.txt for titles...."
>> set expTitle ""
>> # Find all occurences of the date in the catalogue, extract and concatenate titles"
>> if { ![ catch { exec /bin/grep $YYMMDD $madroot/MMcatalog.txt } returnMessage ] } {
>> set catalogEntries [ split $returnMessage "\n" ]
>> foreach catalogEntry $catalogEntries {
>> set catalogFields [ split $catalogEntry "\t" ]
>> if { [ string first $YYMMDD [ lindex $catalogFields 0 ] ] != -1 } {
>> #puts "Found title: [ lindex $catalogFields 5 ]"
>> if { [ string length $expTitle ] == 0 } {
>> set expTitle [ lindex $catalogFields 5 ]
>> } else {
>> set expTitle "$expTitle + [ lindex $catalogFields 5 ]"
>> }
>> }
>> }
>> # Remove any commas, quotes and orphaned close bracket
>> regsub -all {,} $expTitle {} expTitle
>> regsub -all {"} $expTitle {} expTitle
>> if { [ string first "(" $expTitle ] == -1 } {
>> regsub -all {[)]} $expTitle {} expTitle
>> }
>> puts "Title: $expTitle"
>> } else {
>> # no titles found
>> puts "\n$YYYY-$MM-$DD: Enter short title (no commas!) for this day's data"
>> # for major dataload, set title empty
>> set expTitle ""
>> # gets stdin expTitle
>> while { [ string first "," $expTitle ] != -1 } {
>> puts "Please try again without commas!"
>> gets stdin expTitle
>> }
>> }
>> }
>> } else {
>> set expTitle "No need to set title when adding data to existing directory"
>> }
>>
>> # Read input file and create a list of KINDAT entries
>> if { ![ catch { exec $madroot/bin/summarizeCedarFile $StageDirectory/$fileEntry } returnMessage ] } {
>> set recordSummaries [ split $returnMessage "\n" ]
>> set kindatList {}
>> foreach recordSummary $recordSummaries {
>> set newkindat [string trim [string range $recordSummary [string last " " $recordSummary] [string length $recordSummary]]]
>> if { [ lsearch $kindatList $newkindat ] == -1 && $newkindat != "kindat" } {
>> # kludge to handle empty records with illegal KINDAT codes, EOFs?
>> if { $newkindat != "16420" && $newkindat != "2055" && $newkindat != "2056" } {
>> puts " New kindat code found: $newkindat"
>> lappend kindatList $newkindat
>> }
>> }
>> }
>> } else { set errorMessage "summarizeCedarFile: $returnMessage" }
>>
>> if { $errorMessage == 0 } {
>> # For each KINDAT: make a new file containing only that kindat and load it to madrigal
>> foreach kindat $kindatList {
>> puts " ___________________________________________________________________"
>> puts " Processing kindat = $kindat"
>> set fileSplit [file split $fileEntry]
>> set fileName [lindex $fileSplit [expr [llength $fileSplit]-1] ]
>> catch { exec /bin/rm /tmp/$fileName } returnMessage
>> if { ![ catch { exec $madroot/DataLoading/filterCedarFiles -k $kindat -i $StageDirectory/$fileEntry 1 99999 -o /tmp/$fileName -t 1 } returnMessage ] } {
>> if { ![ catch { exec $madroot/DataLoading/genExpFromFile /tmp/$fileName $siteCode $siteName $expTitle $YYMMDD} returnMessage ] } {
>> puts $returnMessage
>> set fileTabTxt "[string trim [string range $returnMessage [string last " " $returnMessage] [string length $returnMessage]]]/fileTab.txt"
>> } else { set errorMessage "genExpFromFile: $returnMessage" }
>> } else { set errorMessage "filterCedarFiles: $returnMessage" }
>> catch { exec /bin/rm -rf /tmp/$fileName } returnMessage
>>
>> if { $errorMessage == 0 } {
>> if { ![ catch { exec /bin/cat $fileTabTxt } fileTabTxtEntries ] } {
>> set newEntry [ lindex $fileTabTxtEntries end ]
>> set fileTabParameters [ split $newEntry "," ]
>> # If kindat is in the list of private codes, update fileTab.txt entry
>> if { [ lsearch $privateKINDATs $kindat ] != -1 } {
>> set fileTabParameters [ lreplace $fileTabParameters 10 10 "1" ]
>> puts " Updated fileTab.txt to make data set private"
>> }
>> # Add original filename in location 09
>> set fileTabParameters [ lreplace $fileTabParameters 9 9 $fileName ]
>> set modifiedEntry [ join $fileTabParameters "," ]
>> # puts $modifiedEntry
>> set fileTabTxtEntries [ lreplace $fileTabTxtEntries end end $modifiedEntry ]
>> set fileTabTxtFile [ open $fileTabTxt "w" ]
>> foreach nextLine $fileTabTxtEntries {
>> puts $fileTabTxtFile $nextLine
>> }
>> close $fileTabTxtFile
>> } else {
>> puts $fileTabTxtEntries
>> }
>>
>> # Copy original data file for this experiment to the
>> # appropriate experiment directory, gzip it, and set file permissions
>> if { [ catch { exec /bin/ls/ $experimentDirectory/$fileName.gz } returnMessage ] } {
>> # Only copy data file if a gzipped copy is not already present
>> # otherwise the gzip stage below will silently hang
>> catch { exec /bin/cp $fileEntry $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/gzip $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/chmod a+r $experimentDirectory/$fileName.gz } returnMessage
>> catch { exec /bin/chmod a-w $experimentDirectory/$fileName.gz } returnMessage
>> puts " Copied $fileEntry to experiment directory"
>> } else {
>> puts " Skipping copy of $fileName - gzip already exists"
>> }
>>
>> # Update the INDEX file and inform the mailing list
>> set mailMessage "[ exec /bin/date ] added: $fileEntry at $YYYY/$siteName/[ YYmmDDToMADRIGALDate $YYMMDD ]"
>> catch { exec /bin/echo $mailMessage >> $madroot/INDEX_of_data_added_to_SRI_MADRIGAL } returnMessage
>>
>> catch { exec /bin/rm /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/echo "SRI MADRIGAL" > /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/echo " " >> /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/echo $mailMessage >> /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/echo " " >> /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/echo "Please direct queries to angela.li at sri.com" >> /tmp/[ pid ]mailMessage } returnMessage
>> foreach emailAddress $emailList {
>> set mailresult [ catch { exec /bin/mail $emailAddress -s $mailSubject < /tmp/[ pid ]mailMessage } returnMessage ]
>> }
>> catch { exec /bin/rm /tmp/[ pid ]mailMessage } returnMessage
>> puts "\a\a\a\a"
>> } else {
>> set errorMessage "Skipping data load, KINDAT = $kindat, error message was:\n$errorMessage"
>> catch { exec /bin/echo $fileEntry >> $madroot/LoadFailures } returnMessage
>> catch { exec /bin/echo $errorMessage >> $madroot/LoadFailures } returnMessage
>> puts $errorMessage
>> }
>> }
>> } else {
>> set errorMessage "Skipping data load, error message was:\n$errorMessage"
>> catch { exec /bin/echo $fileEntry >> $madroot/LoadFailures } returnMessage
>> catch { exec /bin/echo $errorMessage >> $madroot/LoadFailures } returnMessage
>> puts $errorMessage
>> }
>> } else {
>> set errorMessage "Skipping data load, error message was:\n$errorMessage"
>> catch { exec /bin/echo $fileEntry >> $madroot/LoadFailures } returnMessage
>> catch { exec /bin/echo $errorMessage >> $madroot/LoadFailures } returnMessage
>> puts $errorMessage
>> }
>> # try to keep the place tidy, even if failures occured
>> catch { exec /bin/rm /tmp/[ pid ]mailMessage } returnMessage
>> catch { exec /bin/rm /tmp/$fileName } returnMessage
>> catch { exec /bin/rm $temporaryFile } returnMessage
>> }
>>} else {
>> puts "\nNo data files found"
>>}
>>
>>if { $GIFfilesFound } {
>> puts "\nCopying the following gif files into MADRIGAL..."
>> foreach fileEntry $GIFfileList {
>> set fileSplit [file split $fileEntry]
>> set fileName [lindex $fileSplit end ]
>> if { [ string match \[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\] [string range $fileName 0 5] ] } {
>> set YYMMDD [ string range $fileName 0 5 ]
>> if { [ string range $YYMMDD 0 1 ] > 50 } {
>> set YYYY "19[ string range $YYMMDD 0 1 ]"
>> } else {
>> set YYYY "20[ string range $YYMMDD 0 1 ]"
>> }
>> # check if experiment exists in MADRIGAL and copy gif file there if it does
>> # (have to recheck since the plots may not belong to the present experiment)
>> set experimentDirectory "$MADRIGALDirectory/$YYYY/$siteName/[ YYmmDDToMADRIGALDate $YYMMDD ]"
>> if { ![ catch { exec /bin/ls $experimentDirectory } returnMessage ] } {
>> # Copy original data file for this experiment to the appropriate experiment directory
>> # and set file permissions
>> puts $fileEntry
>> catch { exec /bin/cp $fileEntry $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/chmod a+r $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/chmod a-w $experimentDirectory/$fileName } returnMessage
>> }
>> } else {
>> set errorMessage "Skipping copy, $fileEntry is not a dated file"
>> catch { exec /bin/echo $fileEntry >> $madroot/LoadFailures } returnMessage
>> catch { exec /bin/echo $errorMessage >> $madroot/LoadFailures } returnMessage
>> puts $errorMessage
>> }
>> }
>>} else {
>> puts "\nNo gif or jpeg files found"
>>}
>>
>>
>>if { $PSfilesFound } {
>> puts "\nCopying the following PostScript files into MADRIGAL..."
>> foreach fileEntry $PSfileList {
>> set fileSplit [file split $fileEntry]
>> set fileName [lindex $fileSplit end ]
>> if { [ string match \[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\]\[0-9\] [string range $fileName 0 5] ] } {
>> set YYMMDD [ string range $fileName 0 5 ]
>> if { [ string range $YYMMDD 0 1 ] > 50 } {
>> set YYYY "19[ string range $YYMMDD 0 1 ]"
>> } else {
>> set YYYY "20[ string range $YYMMDD 0 1 ]"
>> }
>> # check if experiment exists in MADRIGAL and copy PostScript file there if it does
>> # (have to recheck since the plots may not belong to the present experiment)
>> set experimentDirectory "$MADRIGALDirectory/$YYYY/$siteName/[ YYmmDDToMADRIGALDate $YYMMDD ]"
>> if { ![ catch { exec /bin/ls $experimentDirectory } returnMessage ] } {
>> # Move original data file for this experiment to the appropriate experiment directory
>> # gzip it, and set file permissions
>> if { [ catch { exec /bin/ls/ $experimentDirectory/$fileName.gz } returnMessage ] } {
>> # Only copy postscript file if a gzipped copy is not already present
>> # otherwise the gzip stage below will silently hang
>> puts $fileEntry
>> catch { exec /bin/cp $fileEntry $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/gzip $experimentDirectory/$fileName } returnMessage
>> catch { exec /bin/chmod a+r $experimentDirectory/$fileName.gz } returnMessage
>> catch { exec /bin/chmod a-w $experimentDirectory/$fileName.gz } returnMessage
>> } else {
>> puts "Skipping $fileEntry (gzip already exists)"
>> }
>> }
>> } else {
>> set errorMessage "Skipping copy, $fileEntry is not a dated file"
>> catch { exec /bin/echo $fileEntry >> $madroot/LoadFailures } returnMessage
>> catch { exec /bin/echo $errorMessage >> $madroot/LoadFailures } returnMessage
>> puts $errorMessage
>> }
>> }
>>} else {
>> puts "\nNo PostScript files found"
>>}
>>
>>
>># puts "\nUpdating master tables...."
>>if { [ catch { exec $madroot/bin/updateMaster >@stdout } returnMessage ] } {
>> puts $returnMessage
>>}
>>puts $returnMessage
>>
>>puts "\a\a\a\n"
>>puts "Please run updateMADRIGALAdditions.exp to create JPEGs, etc."
>>puts "Remember to clear stage directories as necessary, and check"
>>puts "$madroot/LoadFailures for files which did not load.\n"
>>puts "A log of added data is at $madroot/INDEX_of_data_added_to_SRI_MADRIGAL"
>>
>>puts "\nThank you for using the automated MADRIGAL data loader!\n"
>>
>>
>>exit
>>
>>
>>
>>
>>
>>
>>------------------------------------------------------------------------
>>
>>#!/bin/sh
>># The madtclsh path is longer than 32 characters. So, we take advantage
>># of the fact that a backslash continues a comment line in tcl \
>>exec /opt/madrigal/bin/madtclsh "$0" ${1+"$@"}
>>
>># $Id: ffw,v 1.6 2002/07/24 19:55:00 brideout Exp $
>>
>># Usage: ffw -file filename -p parameter ... -f parameter minval maxval ...
>>#
>># e.g.: ffw -file mil991102g.001 -p uth -p range -p ti -p tr -f uth 13.4 13.45 -f range 200 400
>>#
>>#
>># yields:
>>#
>># 13.412 287.66 984.0 1.4900
>># 13.412 383.59 1135.0 1.7940
>># 13.431 230.70 922.0 1.4290
>># 13.431 278.66 1023.0 1.5240
>># 13.431 326.63 1053.0 1.8370
>># 13.431 374.60 1078.0 2.0930
>>#
>># and: ffw -file mil980120g.002 -p range -p gdlat -p glon -p gdalt -p ti -p tr -p uth -f uth 15.03 15.07 -f gdalt 300 400
>>#
>># yields:
>>#
>># 503.35 46.09 -71.50 311.73 835.0 1.9400 15.051
>># 551.32 46.40 -71.50 342.68 629.0 2.6810 15.051
>># 599.28 46.72 -71.50 373.82 2349.0 0.6520 15.051
>># 875.10 49.81 -71.51 312.20 922.0 2.1520 15.036
>># 971.03 50.55 -71.51 352.48 1129.0 1.9670 15.036
>># 1066.96 51.28 -71.51 393.50 1108.0 2.1590 15.036
>># 1066.96 51.52 -71.51 329.25 598.0 3.3650 15.057
>># 1162.90 52.28 -71.52 366.37 1285.0 1.0000 15.057
>>
>>source /opt/madrigal/bin/ffw_getargs.tcl
>>source /opt/madrigal/bin/ffw_print.tcl
>>
>>global mad
>>global infile outfile printParmsIn filterParmsIn filterMinsIn filterMaxsIn
>>global cedarCode
>>
>>set debug 0
>>set outfile stdout
>>
>># Get arguments
>>set stat [ffw_getargs $argc $argv]
>>if {$debug == 1} {
>> puts "stat = $stat"
>> puts "infile = $infile"
>> puts "outfile = $outfile"
>> puts "printParmsIn = $printParmsIn"
>> puts "filterParmsIn = $filterParmsIn"
>> puts "filterMinsIn = $filterMinsIn"
>> puts "filterMaxsIn = $filterMaxsIn"
>>}
>>
>># Create madrec object for the input file.
>>mad mad
>>catch [$mad open 1 $infile]
>>if {[$mad get fileType] == -1} {
>> puts "Error: $infile is not a valid Cedar file type"
>> exit
>>}
>>
>># Get parameter codes
>>cedarCode cedarCode
>>
>># Print specified data
>>ffw_print
>>
>># Close file and delete madrec object
>>$mad close
>>$mad destroy
>>
>>exit
>
--
Bill Rideout
MIT Haystack Observatory
Email: brideout at haystack.mit.edu
Phone: 781 981-5624
-------------- next part --------------
/* $Id: Mad.c,v 1.12 2003/10/14 13:35:35 brideout Exp $ */
/*
modification history
0.00a, 23apr95,jmh original
*/
/*
DESCRIPTION
*/
#include <stdlib.h>
#include <string.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <stdio.h>
#include <tcl.h>
#include <cedarIO.h>
#include <madrec.h>
#include <cedar.h>
#include <date.h>
Tcl_HashTable mad_table;
char buf[100000];
char buf1[1024];
int
Mad_Init(interp)
Tcl_Interp *interp; /* Interpreter to add extra commands */
{
int MadCmd(), CedarCodeCmd(), MadGetKey(), MadJday(), MadJdater();
Tcl_CreateCommand(interp, "mad", MadCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "cedarCode", CedarCodeCmd,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "getKey", MadGetKey,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "jday", MadJday,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_CreateCommand(interp, "jdater", MadJdater,
(ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
Tcl_InitHashTable(&mad_table, TCL_STRING_KEYS);
return TCL_OK;
}
/*************************************************************************
Mad Command
*************************************************************************/
int
MadCmd(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
static unsigned int id=1;
int new;
Tcl_HashEntry *entryp;
Madrec *madrecp;
Madrec *madrecCreate();
int Mad_ObjectCmd();
void Mad_DestroyCmd();
/* Check command line arguments */
if (argc != 1 && argc != 2) {
sprintf (interp->result,
"mad requires 0 or 1 arguments");
return TCL_ERROR;
}
/* Create mad object */
madrecp = madrecCreate();
/* Set mad key */
sprintf(interp->result, "mad%u", id);
id++;
/* Create hash table entry */
entryp = Tcl_CreateHashEntry(&mad_table, interp->result, &new);
Tcl_SetHashValue(entryp, madrecp);
/* Create new tcl command */
Tcl_CreateCommand(interp, interp->result, Mad_ObjectCmd,
(ClientData) madrecp, (Tcl_CmdDeleteProc *) Mad_DestroyCmd);
/* If command has argument, set it to the mad key */
if (argc == 2) {
Tcl_SetVar(interp, argv[1], interp->result, 0);
}
return TCL_OK;
}
void Mad_DestroyCmd(ClientData clientData)
{
Madrec *madrecp;
int madrecDestroy(Madrec *);
/* Destroy mad file */
madrecp = (Madrec *) clientData;
(void) madrecDestroy(madrecp);
}
int Mad_ObjectCmd(ClientData clientData, Tcl_Interp *interp,
int argc, char *argv[])
{
Madrec *madrecp;
int status=0, jpar=0, mpar=0, i=0, j=0;
char **pcode1d, **pcode2d;
int parcode1d[32], parcode2d[32];
Ffspec fspec;
int npparm=0, nfparm=0, nfmin=0, nfmax=0, nlines=0;
char **pparm, **fparm, **fmin, **fmax;
double *parp;
Int16 *cedarp=(Int16 *)NULL;
int Mad_CopyCmd(Madrec *madrec1p, char *mad2),
Mad_GetCmd(Tcl_Interp *interp, Madrec *madrecp, int argc, char *argv[]),
Mad_SetCmd(Tcl_Interp *interp, Madrec *madrecp, int argc, char *argv[]);
madrecp = (Madrec *) clientData;
if (argc < 2) {
sprintf(interp->result, "%s requires at least one argument",
argv[0]);
return TCL_ERROR;
}
if (!strcmp(argv[1], "destroy")) {
Tcl_DeleteCommand(interp, argv[0]);
return TCL_OK;
}
else if (!strcmp(argv[1], "open")) {
if (argc != 4) {
sprintf(interp->result,
"%s open requires two arguments", argv[0]);
return TCL_ERROR;
}
status = madrecOpen(madrecp, atoi(argv[2]), argv[3]);
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "close")) {
status = madrecClose(madrecp);
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "checkFile")) {
status = madrecCheckFile(madrecp);
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "getNextRecord")) {
if (argc != 2) {
sprintf(interp->result,
"%s getNextRecord requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = madrecGetNextRec(madrecp);
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "putNextRecord")) {
if (argc != 2) {
sprintf(interp->result,
"%s putNextRecord requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = madrecPutNextRec(madrecp);
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "getPreviousRecord")) {
if (argc != 2) {
sprintf(interp->result,
"%s getPreviousRecord requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = madrecGetPreviousRec(madrecp);
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "getRecordByRecno")) {
if (argc != 3) {
sprintf(interp->result,
"%s getRecordByRecno requires one argument", argv[0]);
return TCL_ERROR;
}
status = madrecGetRecByRecno(madrecp, atoi(argv[2]));
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "getRecordByKey")) {
if (argc != 3) {
sprintf(interp->result,
"%s getRecordByKey requires one argument", argv[0]);
return TCL_ERROR;
}
status = madrecGetRecByKey(madrecp, atoi(argv[2]));
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "rewind")) {
if (argc != 2) {
sprintf(interp->result,
"%s rewind requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = madrecRewind(madrecp);
if (status == 0 || status == -1) {
sprintf(interp->result, "%d", status);
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "copy")) {
status = Mad_CopyCmd(madrecp, argv[2]);
if (status == 100) {
sprintf(interp->result,
"\"%s %s\" has bad source mad - %s",
argv[0],argv[1], argv[2]);
return TCL_ERROR;
}
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "checkRecord")) {
if (argc != 2) {
sprintf(interp->result,
"%s checkRecord requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = cedarCheckRecord(madrecp->recordp);
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
/*
else if (!strcmp(argv[1], "parmCodeArray")) {
if (argc != 1) {
status = 100;
return status;
}
jpar = cedarGetJpar(madrecp->recordp);
mpar = cedarGetMpar(madrecp->recordp);
nrow = cedarGetNrow(madrecp->recordp);
kpar = cedarGetKpar(madrecp->recordp);
outp = cedarGetParmCodeArray(madrecp->recordp);
buf[0] = '\0';
for (i=0; i<jpar+mpar+kpar; i++) {
sprintf(buf1, "%6d ", outp[i]);
strcat(buf, buf1);
}
status = 0;
}
*/
else if (!strcmp(argv[1], "parmArray")) {
if (argc != 6) {
sprintf(interp->result,
"%s parmArray requires four arguments", argv[0]);
return TCL_ERROR;
}
if (Tcl_SplitList(interp, argv[2], &npparm, &pparm) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_SplitList(interp, argv[3], &nfparm, &fparm) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_SplitList(interp, argv[4], &nfmin, &fmin) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_SplitList(interp, argv[5], &nfmax, &fmax) != TCL_OK) {
return TCL_ERROR;
}
if (nfparm != nfmin || nfparm != nfmax) {
sprintf(interp->result,
"%s filter parm, min and max lists must be same length",
argv[0]);
return TCL_ERROR;
}
fspec.nparms = npparm;
fspec.nfilters = nfparm;
fspec.pparms = (int *)malloc(npparm*sizeof(int));
for (i=0; i<npparm; i++) {
fspec.pparms[i] = atoi(pparm[i]);
}
fspec.fparms = (int *)malloc(nfparm*sizeof(int));
for (i=0; i<nfparm; i++) {
fspec.fparms[i] = atoi(fparm[i]);
}
fspec.fmin = (double *)malloc(nfmin*sizeof(double));
for (i=0; i<nfmin; i++) {
fspec.fmin[i] = atof(fmin[i]);
}
fspec.fmax = (double *)malloc(nfmax*sizeof(double));
for (i=0; i<nfmax; i++) {
fspec.fmax[i] = atof(fmax[i]);
}
parp = cedarGetParmArray(madrecp->recordp, &fspec, &nlines);
buf[0] = '\0';
for (i=0; i<nlines; i++) {
for (j=0; j<fspec.nparms; j++) {
sprintf(buf1, "%13.5e", parp[i+nlines*j]);
strcat(buf, buf1);
}
}
sprintf(buf1, "\n");
interp->result = buf;
free((char *)pparm);
free((char *)fparm);
free((char *)fmin);
free((char *)fmax);
free(fspec.pparms);
free(fspec.fparms);
free(fspec.fmin);
free(fspec.fmax);
return TCL_OK;
}
else if (!strcmp(argv[1], "printProlog")) {
if (argc != 2) {
sprintf(interp->result,
"%s printProlog requires zero arguments", argv[0]);
return TCL_ERROR;
}
status = cedarPrintProlog(madrecp->recordp);
if (status != 0) {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_OK;
}
}
else if (!strcmp(argv[1], "createRecord")) {
if (argc != 23) {
sprintf(interp->result,
"%s createRecord requires 21 arguments", argv[0]);
return TCL_ERROR;
}
if (madrecp->recordp != (Int16 *)NULL) {
free(madrecp->recordp);
}
madrecp->recordp =
cedarCreateRecord(
atoi(argv[ 2]),atoi(argv[ 3]),atoi(argv[ 4]),atoi(argv[ 5]),
atoi(argv[ 6]),atoi(argv[ 7]),atoi(argv[ 8]),atoi(argv[ 9]),
atoi(argv[10]),atoi(argv[11]),atoi(argv[12]),atoi(argv[13]),
atoi(argv[14]),atoi(argv[15]),atoi(argv[16]),atoi(argv[17]),
atoi(argv[18]),atoi(argv[19]),atoi(argv[20]),atoi(argv[21]),
atoi(argv[22]));
status = 0;
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "printRecord")) {
if (argc < 2 || argc > 5) {
sprintf(interp->result,
"%s printRecord requires zero or one arguments",
argv[0]);
return TCL_ERROR;
}
if (argc == 2) {
status = cedarPrintRecord(madrecp->recordp);
}
else if (argc == 3) {
printf("argv[2] = %s\n", argv[2]);
if (!strcmp(argv[2], "-d")) {
status = cedarDecimalPrintRecord(madrecp->recordp);
}
else if (!strcmp(argv[2], "-h")) {
status = cedarHexPrintRecord(madrecp->recordp);
}
}
else {
if (argc == 4 || argc == 5) {
if (Tcl_SplitList(interp, argv[argc-2], &jpar,
&pcode1d) != TCL_OK) {
return TCL_ERROR;
}
if (jpar > 32) jpar=32;
for (i=0; i<jpar; i++) {
parcode1d[i] = atoi(pcode1d[i]);
}
if (Tcl_SplitList(interp, argv[argc-1], &mpar,
&pcode2d) != TCL_OK) {
return TCL_ERROR;
}
if (mpar > 32) mpar=32;
for (i=0; i<mpar; i++) {
parcode2d[i] = atoi(pcode2d[i]);
}
/*
madrecp->recordp[16] = (Int16)madrecGetBlockNumber(madrecp);
*/
cedarp = 0;
}
if (argc == 4) {
status = cedarPrintRecord(cedarp);
}
else if (argc == 5) {
if (!strcmp(argv[2], "-d")) {
status = cedarDecimalPrintRecord(cedarp);
}
else if (!strcmp(argv[2], "-h")) {
status = cedarHexPrintRecord(cedarp);
}
}
}
if (status == 0) {
interp->result = "0";
return TCL_OK;
} else {
sprintf(interp->result, madrecGetError(madrecp));
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "get")) {
if (argc < 3) {
sprintf(interp->result,
"%s %s requires at least two arguments",
argv[0], argv[1]);
return TCL_ERROR;
}
status = Mad_GetCmd(interp, madrecp, argc-2, &argv[2]);
if (status == 0) {
interp->result = buf;
return TCL_OK;
}
if (status == 100) {
sprintf(interp->result,
"\"%s %s %s\" has wrong number of arguments",
argv[0],argv[1],argv[2]);
return TCL_ERROR;
}
else if (status == 200) {
sprintf(interp->result,
"Unknown \"%s %s\" argument - %s",
argv[0],argv[1],argv[2]);
return TCL_ERROR;
} else {
return TCL_ERROR;
}
}
else if (!strcmp(argv[1], "set")) {
if (argc < 4) {
sprintf(interp->result,
"%s %s requires at least three arguments",
argv[0], argv[1]);
return TCL_ERROR;
}
status = Mad_SetCmd(interp, madrecp, argc-2, &argv[2]);
if (status == 0) {
interp->result = buf;
return TCL_OK;
}
if (status == 100) {
sprintf(interp->result,
"\"%s %s %s\" has wrong number of arguments",
argv[0],argv[1],argv[2]);
return TCL_ERROR;
}
else if (status == 200) {
sprintf(interp->result,
"Unknown \"%s %s\" argument - %s",
argv[0],argv[1],argv[2]);
return TCL_ERROR;
} else {
return TCL_ERROR;
}
}
else {
sprintf(interp->result, "Unknown %s argument - %s",
argv[0],argv[1]);
return TCL_ERROR;
}
sprintf(interp->result, "Fell off end of Mad_ObjectCmd");
return TCL_ERROR;
}
int
Mad_GetCmd(Tcl_Interp *interp, Madrec *madrecp, int argc, char *argv[])
{
int status, nrow, i, year, month, day,
hour, minute, second, centisecond, jpar, mpar;
Int16 *soutp;
int out, *outp;
double dout, *doutp;
char *cout;
/* Get mad parameters */
if (!strcmp(argv[0], "blockNumber")) {
if (argc != 1) {
status = 100;
return status;
}
/*
out = madrecGetBlockNumber(madrecp);
*/
out = 666;
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "numBlocks")) {
if (argc != 1) {
status = 100;
return status;
}
/*
out = madrecGetNumBlocks(madrecp);
*/
out = 666;
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "fileType")) {
if (argc != 1) {
status = 100;
return status;
}
out = madrecGetFileType(madrecp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "missing")) {
if (argc != 1) {
status = 100;
return status;
}
dout = madrecGetMissing(madrecp);
sprintf(buf, "%e", dout);
status = 0;
}
else if (!strcmp(argv[0], "error")) {
if (argc != 1) {
status = 100;
return status;
}
cout = madrecGetError(madrecp);
sprintf(buf, "%s", cout);
status = 0;
}
else if (!strcmp(argv[0], "numParms")) {
if (argc != 1) {
status = 100;
return status;
}
out = madrecGetNumParms(madrecp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "parmsList")) {
if (argc != 1) {
status = 100;
return status;
}
outp = madrecGetParmsList(madrecp);
buf[0] = '\0';
for (i=0; i<madrecGetNumParms(madrecp); i++) {
sprintf(buf1, "%5d ", outp[i]);
strcat(buf, buf1);
}
status = 0;
}
else if (!strcmp(argv[0], "parmLoc")) {
if (argc != 1) {
status = 100;
return status;
}
outp = madrecGetParmLoc(madrecp);
buf[0] = '\0';
for (i=0; i<madrecGetNumParms(madrecp); i++) {
sprintf(buf1, "%2d ", outp[i]);
strcat(buf, buf1);
}
status = 0;
}
else if (!strcmp(argv[0], "parmMin")) {
if (argc != 1) {
status = 100;
return status;
}
doutp = madrecGetParmMin(madrecp);
buf[0] = '\0';
for (i=0; i<madrecGetNumParms(madrecp); i++) {
sprintf(buf1, "%13.5e ", doutp[i]);
strcat(buf, buf1);
}
status = 0;
}
else if (!strcmp(argv[0], "parmMax")) {
if (argc != 1) {
status = 100;
return status;
}
doutp = madrecGetParmMax(madrecp);
buf[0] = '\0';
for (i=0; i<madrecGetNumParms(madrecp); i++) {
sprintf(buf1, "%13.5e ", doutp[i]);
strcat(buf, buf1);
}
status = 0;
}
else if (!strcmp(argv[0], "sortedRecnoList")) {
if (argc != 1) {
status = 100;
return status;
}
outp = madrecGetSortedRecnoList(madrecp);
buf[0] = '\0';
for (i=0; i<madrecp->nrecords; i++) {
sprintf(buf1, "%5d ", outp[i]);
strcat(buf, buf1);
}
status = 0;
}
else if (!strcmp(argv[0], "startTime")) {
if (argc != 1) {
status = 100;
return status;
}
status = cedarGetStartTime(madrecp->recordp, &year, &month, &day,
&hour, &minute, &second, ¢isecond);
sprintf(buf, "%4d %2d %2d %2d %2d %2d %2d",
year, month, day, hour, minute, second, centisecond);
status = 0;
}
else if (!strcmp(argv[0], "endTime")) {
if (argc != 1) {
status = 100;
return status;
}
status = cedarGetEndTime(madrecp->recordp, &year, &month, &day,
&hour, &minute, &second, ¢isecond);
sprintf(buf, "%4d %2d %2d %2d %2d %2d %2d",
year, month, day, hour, minute, second, centisecond);
status = 0;
}
else if (!strcmp(argv[0], "startIndex")) {
if (argc != 1) {
status = 100;
return status;
}
dout = cedarGetStartIndex(madrecp->recordp);
sprintf(buf, "%f", dout);
status = 0;
}
else if (!strcmp(argv[0], "endIndex")) {
if (argc != 1) {
status = 100;
return status;
}
dout = cedarGetEndIndex(madrecp->recordp);
sprintf(buf, "%f", dout);
status = 0;
}
else if (!strcmp(argv[0], "ltot")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetLtot(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "krec")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetKrec(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "kinst")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetKinst(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "kindat")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetKindat(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "ibyr")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIbyr(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "ibdt")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIbdt(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "ibhm")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIbhm(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "ibcs")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIbcs(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "ieyr")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIeyr(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "iedt")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIedt(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "iehm")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIehm(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "iecs")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetIecs(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "lprol")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetLprol(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "jpar")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetJpar(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "mpar")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetMpar(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "nrow")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetNrow(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "kpar")) {
if (argc != 1) {
status = 100;
return status;
}
out = cedarGetKpar(madrecp->recordp);
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "word")) {
if (argc != 2) {
status = 100;
return status;
}
out = cedarGetWord(madrecp->recordp, atoi(argv[1]));
sprintf(buf, "%d", out);
status = 0;
}
else if (!strcmp(argv[0], "startJday")) {
if (argc != 1) {
status = 100;
return status;
}
dout = cedarGetStartJday(madrecp->recordp);
sprintf(buf, "%.6f", dout);
status = 0;
}
else if (!strcmp(argv[0], "endJday")) {
if (argc != 1) {
status = 100;
return status;
}
dout = cedarGetEndJday(madrecp->recordp);
sprintf(buf, "%.6f", dout);
status = 0;
}
else if (!strcmp(argv[0], "header")) {
if (argc != 1) {
status = 100;
return status;
}
buf[0] = '\0';
nrow = cedarGetNrow(madrecp->recordp);
sprintf(buf1, "%4d", nrow);
strcat(buf, buf1);
out = cedarGetIbyr(madrecp->recordp);
year = out;
sprintf(buf1, "%5d", year);
strcat(buf, buf1);
out = cedarGetIbdt(madrecp->recordp);
month = out/100;
sprintf(buf1, "%3d", month);
strcat(buf, buf1);
day = out - 100*month;
sprintf(buf1, "%3d", day);
strcat(buf, buf1);
out = cedarGetIbhm(madrecp->recordp);
hour = out/100;
sprintf(buf1, "%3d", hour);
strcat(buf, buf1);
minute = out - 100*hour;
sprintf(buf1, "%3d", minute);
strcat(buf, buf1);
out = cedarGetIbcs(madrecp->recordp);
second = out/100;
sprintf(buf1, "%3d", second);
strcat(buf, buf1);
out = cedarGetIeyr(madrecp->recordp);
year = out;
sprintf(buf1, "%5d", year);
strcat(buf, buf1);
out = cedarGetIedt(madrecp->recordp);
month = out/100;
sprintf(buf1, "%3d", month);
strcat(buf, buf1);
day = out - 100*month;
sprintf(buf1, "%3d", day);
strcat(buf, buf1);
out = cedarGetIehm(madrecp->recordp);
hour = out/100;
sprintf(buf1, "%3d", hour);
strcat(buf, buf1);
minute = out - 100*hour;
sprintf(buf1, "%3d", minute);
strcat(buf, buf1);
out = cedarGetIecs(madrecp->recordp);
second = out/100;
sprintf(buf1, "%3d", second);
strcat(buf, buf1);
dout = cedarGet1dParm(madrecp->recordp, 132);
sprintf(buf1, "%7.1f", dout);
strcat(buf, buf1);
dout = cedarGet1dParm(madrecp->recordp, 133);
sprintf(buf1, "%7.1f", dout);
strcat(buf, buf1);
dout = cedarGet1dParm(madrecp->recordp, 142);
sprintf(buf1, "%5.1f", dout);
strcat(buf, buf1);
dout = cedarGet1dParm(madrecp->recordp, 143);
sprintf(buf1, "%5.1f", dout);
strcat(buf, buf1);
status = 0;
}
else if (!strcmp(argv[0], "parcodes1d")) {
if (argc != 1) {
status = 100;
return status;
}
jpar = cedarGetJpar(madrecp->recordp);
outp = cedarGet1dParcodes(madrecp->recordp);
buf[0] = '\0';
for (i=0; i<jpar; i++) {
sprintf(buf1, "%5d ", outp[i]);
strcat(buf, buf1);
}
free(outp);
status = 0;
}
else if (!strcmp(argv[0], "parcodes2d")) {
if (argc != 1) {
status = 100;
return status;
}
mpar = cedarGetMpar(madrecp->recordp);
outp = cedarGet2dParcodes(madrecp->recordp);
buf[0] = '\0';
for (i=0; i<mpar; i++) {
sprintf(buf1, "%5d ", outp[i]);
strcat(buf, buf1);
}
free(outp);
status = 0;
}
else if (!strcmp(argv[0], "parm1d")) {
if (argc != 2) {
status = 100;
return status;
}
dout = cedarGet1dParm(madrecp->recordp, atoi(argv[1]));
sprintf(buf, "%12.5e", dout);
status = 0;
}
else if (!strcmp(argv[0], "parm2d")) {
if (argc != 2) {
status = 100;
return status;
}
nrow = cedarGetNrow(madrecp->recordp);
doutp = cedarGet2dParm(madrecp->recordp, atoi(argv[1]));
buf[0] = '\0';
for (i=0; i<nrow; i++) {
sprintf(buf1, "%12.5e ", doutp[i]);
strcat(buf, buf1);
}
free(doutp);
status = 0;
}
else if (!strcmp(argv[0], "1dInt")) {
if (argc != 2) {
status = 100;
return status;
}
out = cedarGet1dInt(madrecp->recordp, atoi(argv[1]));
sprintf(buf, "%6d", out);
status = 0;
}
else if (!strcmp(argv[0], "2dInt")) {
if (argc != 2) {
status = 100;
return status;
}
nrow = cedarGetNrow(madrecp->recordp);
soutp = cedarGet2dInt(madrecp->recordp, atoi(argv[1]));
buf[0] = '\0';
for (i=0; i<nrow; i++) {
sprintf(buf1, "%6hd ", soutp[i]);
strcat(buf, buf1);
}
free(soutp);
status = 0;
}
else {
status = 200;
}
return status;
}
int
Mad_SetCmd(Tcl_Interp *interp, Madrec *madrecp, int argc, char *argv[])
{
int status, i, nrow, nfparm;
char **fparm;
double *parmp;
Int16 *intp;
/* Set mad parameters */
if (!strcmp(argv[0], "krec")) {
if (argc != 2) {
status = 100;
return status;
}
(void) cedarSetKrec(madrecp->recordp, atoi(argv[1]));
status = 0;
}
else if (!strcmp(argv[0], "kinst")) {
if (argc != 2) {
status = 100;
return status;
}
(void) cedarSetKinst(madrecp->recordp, atoi(argv[1]));
status = 0;
}
else if (!strcmp(argv[0], "kindat")) {
if (argc != 2) {
status = 100;
return status;
}
(void) cedarSetKindat(madrecp->recordp, atoi(argv[1]));
status = 0;
}
else if (!strcmp(argv[0], "startTime")) {
if (argc != 8) {
status = 100;
return status;
}
(void) cedarSetStartTime(madrecp->recordp,
atoi(argv[1]),atoi(argv[2]),atoi(argv[3]),atoi(argv[4]),
atoi(argv[5]),atoi(argv[6]),atoi(argv[7]));
status = 0;
}
else if (!strcmp(argv[0], "endTime")) {
if (argc != 8) {
status = 100;
return status;
}
(void) cedarSetEndTime(madrecp->recordp,
atoi(argv[1]),atoi(argv[2]),atoi(argv[3]),atoi(argv[4]),
atoi(argv[5]),atoi(argv[6]),atoi(argv[7]));
status = 0;
}
else if (!strcmp(argv[0], "1dParm")) {
if (argc != 4) {
status = 100;
return status;
}
(void) cedarSet1dParm(madrecp->recordp,
atoi(argv[1]),atof(argv[2]),atoi(argv[3]));
status = 0;
}
else if (!strcmp(argv[0], "2dParm")) {
if (argc != 4) {
status = 100;
return status;
}
if (Tcl_SplitList(interp, argv[2], &nfparm, &fparm) != TCL_OK) {
sprintf(interp->result,
"Improperly formatted 2d parameter list");
status = -1;
return status;
}
nrow = cedarGetNrow(madrecp->recordp);
if (nfparm != nrow) {
sprintf(interp->result,
"This CEDAR record requires %d 2d parameters - %d were specified",
nrow, nfparm);
status = -1;
return status;
}
parmp = (double *)malloc(nfparm*sizeof(double));
for (i=0; i<nfparm; i++) {
parmp[i] = atof(fparm[i]);
}
(void) cedarSet2dParm(madrecp->recordp,
atoi(argv[1]),parmp,atoi(argv[3]));
free(parmp);
status = 0;
}
else if (!strcmp(argv[0], "1dInt")) {
if (argc != 4) {
status = 100;
return status;
}
(void) cedarSet1dInt(madrecp->recordp,
atoi(argv[1]),atoi(argv[2]),atoi(argv[3]));
status = 0;
}
else if (!strcmp(argv[0], "2dInt")) {
if (argc != 4) {
status = 100;
return status;
}
if (Tcl_SplitList(interp, argv[2], &nfparm, &fparm) != TCL_OK) {
sprintf(interp->result,
"Improperly formatted 2d parameter list");
status = -1;
return status;
}
nrow = cedarGetNrow(madrecp->recordp);
if (nfparm != nrow) {
sprintf(interp->result,
"This CEDAR record requires %d 2d parameters - %d were specified",
nrow, nfparm);
status = -1;
return status;
}
intp = (Int16 *)malloc(nfparm*sizeof(int));
for (i=0; i<nfparm; i++) {
intp[i] = (Int16) atoi(fparm[i]);
}
(void) cedarSet2dInt(madrecp->recordp,
atoi(argv[1]),intp,atoi(argv[3]));
free(intp);
status = 0;
}
else {
status = 200;
}
return status;
}
int Mad_CopyCmd(Madrec *madrec1p, char *mad2)
{
int status;
Tcl_HashEntry *entryp;
Madrec *madrec2p;
int madrec_copy();
/* Get hash table entry for destination mad */
entryp = Tcl_FindHashEntry(&mad_table, mad2);
if (entryp == NULL) {
status = 100;
return status;
}
madrec2p = (Madrec *)Tcl_GetHashValue(entryp);
if (madrec2p == NULL) {
status = 100;
return status;
}
/* Copy mad */
status = madrecCopy(madrec1p, madrec2p);
return status;
}
/*************************************************************************
CedarCode Command
*************************************************************************/
int
CedarCodeCmd(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
static unsigned int id=1;
int cedarCode=0;
int CedarCode_ObjectCmd();
void CedarCode_DestroyCmd();
/* Check command line arguments */
if (argc != 1 && argc != 2) {
sprintf (interp->result,
"cedarCode requires 0 or 1 arguments");
return TCL_ERROR;
}
/* Set cedarCode key */
sprintf(interp->result, "cedarCode%u", id);
id++;
/* Create new tcl command */
Tcl_CreateCommand(interp, interp->result, CedarCode_ObjectCmd,
(ClientData) &cedarCode, (Tcl_CmdDeleteProc *) Mad_DestroyCmd);
/* If command has argument, set it to the cedarCode key */
if (argc == 2) {
Tcl_SetVar(interp, argv[1], interp->result, 0);
}
/* Read the Cedar parameter code table */
if (cedarReadParCodes() == 0)
return TCL_OK;
else
return TCL_ERROR;
}
void CedarCode_DestroyCmd(clientData)
ClientData clientData;
{
return;
}
int CedarCode_ObjectCmd(ClientData clientData, Tcl_Interp *interp,
int argc, char *argv[])
{
char * strp = NULL;
if (argc < 2) {
sprintf(interp->result, "%s requires at least one argument",
argv[0]);
return TCL_ERROR;
}
if (!strcmp(argv[1], "destroy")) {
Tcl_DeleteCommand(interp, argv[0]);
return TCL_OK;
}
else if (!strcmp(argv[1], "numCodes")) {
if (argc != 2) {
sprintf(interp->result,
"%s numCodes requires zero arguments", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%d", cedarGetNumParCodes());
return TCL_OK;
}
else if (!strcmp(argv[1], "code")) {
if (argc != 3) {
sprintf(interp->result,
"%s code requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%d", cedarGetParCode(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "codeIndex")) {
if (argc != 3) {
sprintf(interp->result,
"%s codeIndex requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%d", cedarGetParCodeIndex(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "type")) {
if (argc != 3) {
sprintf(interp->result,
"%s type requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%s", cedarGetParCodeType(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "scaleFactor")) {
if (argc != 3) {
sprintf(interp->result,
"%s scaleFactor requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%e", cedarGetParScaleFactor(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "units")) {
if (argc != 3) {
sprintf(interp->result,
"%s units requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%s", cedarGetParUnits(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "description")) {
if (argc != 3) {
sprintf(interp->result,
"%s description requires one argument", argv[0]);
return TCL_ERROR;
}
strp = cedarGetParDescription(atoi(argv[2]));
sprintf(interp->result, "%s", strp);
free(strp);
return TCL_OK;
}
else if (!strcmp(argv[1], "int16Description")) {
if (argc != 3) {
sprintf(interp->result,
"%s int16Description requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%s", cedarGetParInt16Description(atoi(argv[2])));
return TCL_OK;
}
else if (!strcmp(argv[1], "mnemonic")) {
if (argc != 3) {
sprintf(interp->result,
"%s mnemonic requires one argument", argv[0]);
return TCL_ERROR;
}
strp = cedarGetParMnemonic(atoi(argv[2]));
sprintf(interp->result, "%s", strp);
free(strp);
return TCL_OK;
}
else if (!strcmp(argv[1], "format")) {
if (argc != 3) {
sprintf(interp->result,
"%s format requires one argument", argv[0]);
return TCL_ERROR;
}
strp = cedarGetParFormat(atoi(argv[2]));
sprintf(interp->result, "%s", strp);
return TCL_OK;
}
else if (!strcmp(argv[1], "width")) {
if (argc != 3) {
sprintf(interp->result,
"%s width requires one argument", argv[0]);
return TCL_ERROR;
}
sprintf(interp->result, "%d", cedarGetParWidth(atoi(argv[2])));
return TCL_OK;
} else {
return TCL_ERROR;
}
}
int
MadGetKey(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
int key;
if (argc != 7 && argc != 8) {
sprintf(interp->result,
"getKey requires six or seven arguments");
return TCL_ERROR;
}
key = getKey(atoi(argv[1]),atoi(argv[2]),atoi(argv[3]),
atoi(argv[4]),atoi(argv[5]),atoi(argv[6]));
sprintf(interp->result, "%d", key);
return TCL_OK;
}
int
MadJday(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
int jDay;
if (argc != 4) {
sprintf(interp->result,
"jday requires 3 arguments (day,month,year)");
return TCL_ERROR;
}
jDay = jday(atoi(argv[1]),atoi(argv[2]),atoi(argv[3]));
sprintf(interp->result, "%d", jDay);
return TCL_OK;
}
int
MadJdater(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
int jDater, day, month, year;
if (argc != 2) {
sprintf(interp->result,
"jdater requires 1 arguments (Julian day number)");
return TCL_ERROR;
}
jDater = jdater(atoi(argv[1]),&day,&month,&year);
sprintf(interp->result, "%d %d %d", day, month, year);
return TCL_OK;
}
More information about the OpenMadrigal-developers
mailing list