program sod C***************************************************** C This FORTRAN program is a user interface C for requesting SOD data for one or more individual C stations, WMO blocks, and/or countries for a C user-selected period of time. The user may C select up to 5,000 stations/100 blocks/ C 50 countries/50 states to be processed C at any one time. Data are extracted for only C one calendar month at a time, but multiple C months can be chosen during just one run of C the program. In addition multiple stations, C countries, and blocks or any combination thereof C can be selected at one time for a desired month, C thus making the program faster. C C The file 'stnlist.txt' is needed for the program C to access the station ID numbers to be C extracted from the monthly SOD data files. C The desired monthly SOD data files must also C be accessible by this program. The file names C given to each monthly file are the 3-letter month C abbreviation followed by the 4 digits of the C year of the data, plus a '.txt' extension. Thus, C the data file for July 1995 should be named 'jul1995.txt' C for this version of the program to run correctly. C The user may change this if so desired. C It is recommended that a copy of the Air Weather C Service Master Station Catalog is readily accessible to C double-check country abbreviations or block numbers. C C Care should be used while entering all values. C While there are checks for out-of-range values, C selecting a monthly SOD data file that is not C present, for example, will halt execution of C the program. C***************************************************** C***************************************************** C Matthew C. Sittel, ORKAND, November 20, 1995 C***************************************************** C***************************************************** C C Variable declarations C --------------------- C C Integer Variables/Arrays: C ------------------------ C i, ct: counters C j, m, q: do-loop counters C nv: a 'switch' set to 1 after entering C an output inventory file name so that C additional requests of stations will C not force the prompting of new inventory files C for those additions C stnmsc: refers to the 6-digit station ID C number read in from stnlist.txt C stnch: an array containing user-entered C station ID numbers (option A from the main C menu). These values are transferred to the C array stn when the stations are located C in stnlist.txt C stn: an array containing station ID numbers C (can consist of single ID numbers entered C by the user or entire countries, WMO C blocks, or states) for which SOD data are C to be extracted C hdrct: a counter that directs the program C to write out header information only once, C at the start of the data output file C obsct: a counter of the number of daily SOD C records that are written to the data C output file C blkch: (blkch=BLocK CHosen) an array of the 2-digit C WMO block numbers selected by the user C when requesting all data from a WMO block C (option C) C days: the first day for which data are requested C dayf: the last day for which data are requested C dayrun: the current day of data being examined C ranglo: defines lowest station ID number of station C for which data will be written out C ranghi: defines highest station ID number of station C for which data will be written out C stnf: the station ID number of a monthly SOD entry C that is written to the data output file C yrf: the year of a monthly SOD entry that is C written to the data output file C mof: the month of the year of a monthly SOD C entry that is written to the data output file. C daf: the day of the month of a monthly SOD entry C that is written to the data output file C pckyrs: the user-defined starting year of C data to be output C pckmos: the user-defined starting month of C data to be output C pckdas: the user-defined starting day of C data to be output C pckyrf: the user-defined ending year of C data to be output C pckmof: the user-defined ending month of C data to be output C pckdaf: the user-defined ending day of C data to be output C done: a variable equal to 0 except when the last C day of data is read in, when this value is C changed to 1 so the files close after C writing out all of the desired data. C C C Character Variables/Arrays: C -------------------------- C ch: the choice of main menu option as entered C by the user (A,B,C,D, or X) C invch: a yes/no variable, corresponding C to the choice of writing out an inventory file C from stnlist.txt of the selected stations C morech: a yes/no variable, corresponding C to the choice of selecting more stations C from the main menu options C limch: a yes/no variable, corresponding to the C choice of changing the station ID limits C to exclude unwanted stations with the desired C country abbreviation C yrpick: used to open the selected monthly SOD C data file; this is set equal to the C array element yrabb that is selected by the user C yrpick: the user-defined year C cntry: the country/state abbreviation as it C appears in stnlist.txt C ctrych: an array of the country abbreviations as C selected by the user (option B). This is compared C to cntry to locate desired stations. C statch: an array of the state abbreviations as C selected by the user (option D). If this matches C with cntry, the station is selected for C the data output. C moabb: an array containing the 3-letter C abbreviations of each month of the year C mopick: used to open the selected monthly SOD C data file; this is set equal to the C array element moabb that is selected by the user C call: the station call letters as listed in C stnlist.txt C lat: the station's latitude as listed in C stnlist.txt C elev: the station's elevation as listed in C stnlist.txt C lon: the station's longitude as listed in C stnlist.txt C city: the station's name as listed in C stnlist.txt C filler: header information in stnlist.txt C that is not needed to select stations; C this is skipped at the start of the file C before the station search begins C invfile: the user-defined name of the C inventory output file C datfile: the user-defined name of the C data output file C dataf: the climate data of a monthly SOD C entry that is written to the data output file C header: the header information at the C beginning of a monthly SOD data file; C this information is written out only once C to the data output file C C***************************************************** integer i, j, m, q, ct, nv, stnmsc integer stnch(5000), stn(5000), hdrct, obsct, blkch(100) integer days, dayf, dayrun, ranglo, ranghi integer stnf, yrf, mof, daf integer pckyrs, pckmos, pckdas, pckyrf, pckmof, pckdaf, done character*1 ch, invch, morech, limch character*2 cntry, ctrych(50), statch(50) character*3 moabb(12), mopick character*4 call, yrabb(15), yrpick character*5 lat, elev character*6 lon character*19 city character*80 filler, invfile, datfile character*116 dataf character*132 header data moabb /'jan','feb','mar','apr','may','jun', + 'jul','aug','sep','oct','nov','dec'/ data yrabb /'1994','1995','1996','1997','1998','1999','2000'/ + '2001','2002','2003','2004','2005','2006','2007','2008'/ obsct=0 i=0 done=0 ranglo=000001 ranghi=999999 C***************************************************** C The main menu is printed to the screen here C***************************************************** 200 print * print *, 'Summary of Day Data Acquisition Menu:' print *, '-------------------------------------' print *, 'A. One or more INDIVIDUAL STATIONS' print *, 'B. All stations in one or more COUNTRIES' print *, 'C. All stations in one or more WMO BLOCKS' print *, 'D. All stations in one or more US STATES' print *, 'X. Exit program' print * C***************************************************** C The station inventory file is opened here, and C the introductory lines are skipped before the C actual stations are read in. C***************************************************** open (unit=10, file='stnlist.txt', form='formatted', + access='sequential', status='old') do 15 j=1,14 read (unit=10, fmt=5010) filler 5010 format(A80) 15 continue C***************************************************** C The user selects an option from the menu here. C***************************************************** 210 print *, 'Enter your selection: ' read (*, fmt=5020) ch if ((ch .ne. 'A') .and. (ch .ne. 'a') .and. + (ch .ne. 'B') .and. (ch .ne. 'b') .and. + (ch .ne. 'C') .and. (ch .ne. 'c') .and. + (ch .ne. 'D') .and. (ch .ne. 'd') .and. + (ch .ne. 'X') .and. (ch .ne. 'x')) then print *, 'Invalid entry. Please re-enter your choice.' goto 210 else endif 5020 format(A1) C***************************************************** C The introductory messages are not printed if C the user asks to select more data after the C first run-through. C***************************************************** if ((morech .eq. 'Y') .or. (morech .eq. 'y')) then goto 220 else endif C***************************************************** C The user can choose to have an inventory file of C the stations from 'stnlist.txt' written out. C If an inventory file is desired, the user is C prompted for the desired name of the file. C***************************************************** print * print *, 'Would you like an inventory file' print *, 'of the selected stations? (Y/N)' read (*, fmt=5020) invch if ((invch .eq. 'Y') .or. (invch .eq. 'y')) then print *, 'Please enter the name for the' print *, 'output inventory file:' read (*, fmt=5010) invfile nv=1 C***************************************************** C The inventory file is opened here C***************************************************** open (unit=30, file=invfile, form='formatted', + access='sequential', status='unknown') C***************************************************** C This is the selection routine for option A. C Individual stations. C***************************************************** else endif 220 print * chs=0 if ((ch .eq. 'A') .or. (ch .eq. 'a')) then print *, 'Please enter the six digit identifiers for the' print *, 'desired stations, one per line. Enter -1 when' print *, 'you have finished entering stations.' ct=1 230 read (*, fmt=5030, err=230) stnch(ct) 5030 format(I6) C***************************************************** C The user's last desired station is indicated by C entering a '-1'. This loop checks for that value. C The nested-if statement checks to see that the C first value entered is '-1'; if so the search is C not run. C***************************************************** if (stnch(ct) .eq. -1) then if (ct .eq. 1) then goto 999 else goto 240 endif else ct=ct+1 goto 230 endif 240 print * print *, 'Searching...' print * C***************************************************** C The inventory file is read here. If a match in C station ID numbers is found, the number is C written to a file for later selection of stations C from the SOD data files. The information from C 'stnlist.txt' is also written to the inventory file C when an ID match is made. C***************************************************** 110 read (unit=10, fmt=5040, end=999) stnmsc, call, city, + cntry, lat, lon, elev 5040 format(I6.6,1X,A4,3X,A19,1X,A2,1X,A5,1X,A6,1X,A5) do 25 m=1,ct if (stnmsc .eq. stnch(m)) then i=i+1 stn(i)=stnmsc if (nv .eq. 1) then write (unit=30, fmt=5040) stnmsc, call, city, + cntry, lat, lon, elev else endif else endif 25 continue goto 110 999 continue C***************************************************** C The number of selected stations is displayed here. C***************************************************** if (i .eq. 0) then print *, ' No matching stations found.' else print *, ' Total number of stations selected: ', i endif else endif C***************************************************** C This is the selection routine for option B. C One country. C***************************************************** if ((ch .eq. 'B') .or. (ch .eq. 'b')) then print *, 'Please enter the 2-letter AWSMSC' print *, 'country abbreviations (in CAPITAL LETTERS),' print *, 'one country at a time. Enter ZZ when' print *, 'you have finished your selections.' ct=1 400 read (*, fmt=5050) ctrych(ct) 5050 format (A2) if (ctrych(ct) .eq. 'ZZ') then if (ct .eq. 1) then goto 989 else endif else ct=ct+1 goto 400 endif 420 print * print *, 'Searching...' print * C***************************************************** C If the station matches the chosen country code, the C station code is written out, as well as the C inventory information. C***************************************************** 120 read (unit=10, fmt=5040, end=989) stnmsc, call, city, + cntry, lat, lon, elev do 45 m=1,ct if (((stnmsc .ge. 699000) .and. (stnmsc .le. 709999)) .or. + ((stnmsc .ge. 720000) .and. (stnmsc .le. 729999)) .or. + ((stnmsc .ge. 740000) .and. (stnmsc .le. 749999))) then us=1 else us=0 endif if ((cntry .eq. ctrych(m)) .and. (us .eq. 0)) then i=i+1 stn(i)=stnmsc if (nv .eq. 1) then write (unit=30, fmt=5040) stnmsc, call, city, + cntry, lat, lon, elev else endif else endif 45 continue goto 120 989 continue if (i .eq. 0) then print *, ' No matching stations found.' else print *, ' Total number of stations selected: ', i endif else endif C***************************************************** C This is the selection routine for option C. C One WMO block. C***************************************************** if ((ch .eq. 'C') .or. (ch .eq. 'c')) then print *, 'Please enter the 2-digit block numbers.' print *, 'Enter -1 when you have completed' print *, 'your selections.' ct=1 600 read (*, fmt=5060, err=600) blkch(ct) 5060 format (I2) if (blkch(ct) .eq. -1) then if (ct .eq. 1) then goto 979 else goto 620 endif else ct=ct+1 goto 600 endif 620 print * print *, 'Searching...' print * C***************************************************** C If the block number matches the station from the C 'stnlist.txt' file the ID number is written out, C along with the inventory information if desired. C The block number is multiplied by 10,000 and then C is subtracted from each ID. If the difference is C below 10,000 but greater than 0 then the block C numbers agree. C***************************************************** 130 read (unit=10, fmt=5040, end=979) stnmsc, call, city, + cntry, lat, lon, elev do 55 m=1, ct if (((stnmsc-(blkch(m)*10000)) .ge. 0) .and. + ((stnmsc-(blkch(m)*10000)) .lt. 10000)) then i=i+1 stn(i)=stnmsc if (nv .eq. 1) then write (unit=30, fmt=5040) stnmsc, call, city, + cntry, lat, lon, elev else endif else endif 55 continue goto 130 979 continue if (i .eq. 0) then print *, ' No matching stations found.' else print *, ' Total number of stations selected: ', i endif else endif C**************************************************** C This is the selection routine for option D. C One US state. C**************************************************** if ((ch .eq. 'D') .or. (ch .eq. 'd')) then print *, 'Please enter the 2-letter state' print *, 'identifiers (in CAPITAL LETTERS).' print *, 'Enter ZZ when you have finished' print *, 'your selections.' ct=1 700 read (*, fmt=5050) statch(ct) if (statch(ct) .eq. 'ZZ') then if (ct .eq. 1) then goto 969 else goto 720 endif else ct=ct+1 goto 700 endif 720 print * print *, 'Searching...' print * C**************************************************** C As each station is read in, if the abbreviation C is matched along with the ID number being within C the prescribed bounds for US stations C then the pertinent information is output. C**************************************************** 140 read (unit=10, fmt=5040, end=969) stnmsc, call, city, + cntry, lat, lon, elev if (((stnmsc .ge. 699000) .and. (stnmsc .le. 709999)) .or. + ((stnmsc .ge. 720000) .and. (stnmsc .le. 729999)) .or. + ((stnmsc .ge. 740000) .and. (stnmsc .le. 749999)) .or. + ((stnmsc .ge. 910000) .and. (stnmsc .le. 912999)) .or. + ((stnmsc .ge. 994000) .and. (stnmsc .le. 994999))) then us=1 else us=0 endif do 65 m=1, ct if ((cntry .eq. statch(m)) .and. (us .eq. 1)) then i=i+1 stn(i)=stnmsc if (nv .eq. 1) then write (unit=30, fmt=5040) stnmsc, call, city, + cntry, lat, lon, elev else endif else endif 65 continue goto 140 969 continue if (i .eq. 0) then print *, ' No matching stations found.' else print *, ' Total number of stations selected :', i endif else endif C**************************************************** C If the user chooses option X the program is terminated. C**************************************************** if ((ch .eq. 'X') .or. (ch .eq. 'x')) then goto 250 else endif C*************************************************** C The user can select more stations by entering 'Y' here. C*************************************************** print * print *, 'Would you like to select more stations? (Y/N)' read (*, fmt=5020) morech C*************************************************** C If the user chooses 'yes' then the program returns C to the main menu to allow for another selection to be C made. C*************************************************** if ((morech .eq. 'Y') .or. (morech .eq. 'y')) then close (unit=10) goto 200 else endif C*************************************************** C The files are closed here. C*************************************************** close (unit=10) close (unit=30) 250 print * print *, 'Thank you.' print * C*************************************************** C The user inputs the name of the output data C file, month and year of data desired, and range C of days within that month. C*************************************************** print *, 'Please enter the name of the data output file.' read (*, fmt=5010) datfile hdrct=0 open (unit=40, file=datfile, form='formatted', access= + 'sequential', status='unknown') print * 260 print *, 'Enter dates of the data you are' print *, 'requesting. Enter as YYYYMMDD.' print *, 'for example, July 31, 1994= 19940731' print * print *, 'To end this program enter a FINISH date of 99999999.' 150 print *, 'Start date:' read (*, fmt=5260) pckyrs, pckmos, pckdas days=(pckyrs*10000)+(pckmos*100)+pckdas 5260 format(I4,2(I2)) print *, 'Finish date:' read (*, fmt=5260) pckyrf, pckmof, pckdaf dayf=(pckyrf*10000)+(pckmof*100)+pckdaf if ((pckyrf .eq. 9999) .and. (pckmof .eq. 99) .and. + (pckdaf .eq. 99)) then goto 280 else if ((pckmos .gt. 12) .or. (pckmos .le. 0) .or. + (pckmof .gt. 12) .or. (pckmof .le. 0)) then print *, 'Invalid month entered. Re-enter.' goto 150 else if ((pckdas .gt. 31) .or. (pckdas .lt. 1) .or. + (pckdaf .gt. 31) .or. (pckdaf .lt. 1)) then print *, 'Invalid day entered. Re-enter.' goto 150 else if (days .gt. dayf) then print *, 'Finish date is before start date. Re-enter.' goto 150 else endif 270 print * mopick=moabb(pckmos) yrpick=yrabb(pckyrs-1993) C*************************************************** C An output file for the data is entered here. C*************************************************** print * print *, 'NOTE: All stations with ID numbers between' print *, '000001 and 999999 for these stations' print *, 'will be selected. If you would like to' print *, 'limit the ranges to exclude some stations' print *, 'Enter Y. Otherwise, enter N.' print * read (*, fmt=5020) limch if ((limch .eq. 'Y') .or. (limch .eq. 'y')) then 410 print *, 'Enter new LOWER bound. (currently=000001)' read (*, fmt=5030) ranglo print *, 'Enter new UPPER bound. (currently=999999)' read (*, fmt=5030) ranghi if ((ranghi .lt. ranglo) .or. (ranglo .lt. 1) + .or. (ranghi .lt. 1)) then print *, 'Invalid entry. Please re-enter.' goto 410 else print * endif else endif print * print *, '*** Data are being extracted. Please wait. ***' print * 440 open (unit=50, file=mopick//yrpick//'.txt', form='formatted', + access='sequential', status='old') print *, ' Processing file: ', mopick, yrpick hdrct=hdrct+1 read (unit=50, fmt=5070) header if (hdrct .eq. 1) then write (unit=40, fmt=5070) header else endif 5070 format(A132) 180 read (unit=50, fmt=5080, end=959) stnf, yrf, mof, daf, dataf dayrun=((yrf)*10000)+(mof*100)+daf 5080 format(I6.6,2X,I4,I2.2,I2.2,A116) do 35 q=1,i if ((stnf .eq. stn(q)) .and. (stnf .ge. ranglo) .and. + (stnf .le. ranghi)) then if ((days .le. dayrun) .and. (dayf .gt. dayrun)) then write (unit=40, fmt=5080) stnf, yrf, mof, daf, dataf obsct=obsct+1 done=0 goto 180 else if (dayf .eq. dayrun) then write (unit=40, fmt=5080) stnf, yrf, mof, daf, dataf obsct=obsct+1 done=1 goto 180 else if (days .gt. dayrun) then goto 180 else goto 750 endif else endif 35 continue goto 180 959 continue if (done .eq. 1) then goto 750 else endif pckmos=pckmos+1 if (pckmos .eq. 13) then pckmos=1 pckyrs=pckyrs+1 else endif mopick=moabb(pckmos) yrpick=yrabb(pckyrs-1993) close (unit=50) goto 440 750 print * print *, '*** The data output file has been written. ***' close (unit=50) print * 280 print *, 'Total number of data records written out :', obsct print * print *, '*** End of program. ***' close (unit=40) stop end