c revised by tang for SiB2_DHM c tangqh@iis.u-tokyo.ac.jp c 2005/9/18 program sod integer i, j, m, q, ct, nv, stnmsc integer stnch(1), stn(1), 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 integer latmin,latmax,lonmin,lonmax integer lati,loni,elevi latmin=2900 latmax=4300 lonmin=9400 lonmax=12100 open (unit=10, file='stnlist.txt', form='formatted', + access='sequential', status='old') open (unit=100, file='station_wmo.txt', form='formatted', + access='sequential', status='unknown') do 15 j=1,14 read (unit=10, fmt=5010) filler 5010 format(A80) 15 continue 110 read (unit=10, fmt=5041, end=999) stnmsc, call, city, + cntry, lati, loni, elevi c 5040 format(I6.6,1X,A4,3X,A19,1X,A2,1X,A5,1X,A6,1X,A5) 5041 format(I6.6,1X,A4,3X,A19,1X,A2,1X,I5,1X,I6,1X,I5) 5042 format(I,3f15.5) pckyrs=1994 pckmos=1 pckdas=1 pckyrf=2000 pckmof=12 pckdaf=31 if (city.ne.'BOGUS CHINESE ') then if (lati.le.latmax.and.lati.ge.latmin) then if (loni.le.lonmax.and.loni.ge.lonmin) then obsct=1 stn(1) = stnmsc call abstract(stn,pckyrs,pckmos, pckdas, pckyrf, - pckmof, pckdaf,obsct) if (obsct.gt.0) then c datfile='' c write(datfile,'(I6.6)') stn(1) c datfile(7:10)='.txt' c hdrct=0 c open (unit=400, file=datfile, form='formatted', access= c + 'sequential', status='old') c hdrct=hdrct+1 c if (hdrct .eq. 1) then c read (unit=400, fmt=5071) header c endif c 5071 format(A132) c hdrct=0 c 811 read (unit=400, fmt=5081, end=9591) stnf, yrf, mof, daf, dataf c hdrct=hdrct+1 c goto 811 c 5081 format(I6.6,2X,I4,I2.2,I2.2,A116) c 9591 continue c if (hdrct.gt.0) then write(100,5042)stnmsc,real(loni)/100, real(lati)/100, real(elevi) c endif endif !(obsct.gt.0) endif !(search box) endif !(search box) endif !(city.ne.'BOGUS CHINESE ') 25 continue goto 110 999 continue close (unit=10) close (unit=100) end subroutine abstract _ (stn,pckyrs,pckmos, pckdas, pckyrf, pckmof, pckdaf,obsct) integer i, j, m, q, ct, nv, stnmsc integer stnch(1), stn(1), 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 days=(pckyrs*10000)+(pckmos*100)+pckdas dayf=(pckyrf*10000)+(pckmof*100)+pckdaf C***************************************************** C The user selects an option from the menu here. C***************************************************** cdel read (*, fmt=5020) ch ch = 'A' 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.' 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***************************************************** cx if ((morech .eq. 'Y') .or. (morech .eq. 'y')) then cx goto 220 cx else cx 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***************************************************** 220 print * chs=0 cx if ((ch .eq. 'A') .or. (ch .eq. 'a')) then ct=1 c stnch(1) =719850 !CN cx 230 read (*, fmt=5030, err=230) stnch(ct) 5030 format(I6) 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***************************************************** C*************************************************** C The user can select more stations by entering 'Y' here. C*************************************************** cx print * cx print *, 'Would you like to select more stations? (Y/N)' cx 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*************************************************** cx if ((morech .eq. 'Y') .or. (morech .eq. 'y')) then cx close (unit=10) cx goto 200 cx else cx endif C*************************************************** C The files are closed here. C*************************************************** 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*************************************************** cx read (*, fmt=5010) datfile datfile='' write(datfile,'(I6.6)') stn(1) datfile(7:10)='.txt' hdrct=0 open (unit=40, file=datfile, form='formatted', access= + 'sequential', status='unknown') cx read (*, fmt=5260) pckyrs, pckmos, pckdas 5260 format(I4,2(I2)) c read (*, fmt=5260) pckyrf, pckmof, pckdaf mopick=moabb(pckmos) yrpick=yrabb(pckyrs-1993) C*************************************************** C An output file for the data is entered here. C*************************************************** cx read (*, fmt=5020) limch limch='n' 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 write(*,*) '*** Data are being extracted. Please wait. ***' write(*,'(A18,I7)') 'Station Number:',stn(1) write(*,'(A18,6I5)')'Date:',pckyrs,pckmos,pckdas,pckyrf,pckmof,pckdaf 440 open (unit=50, file=mopick//yrpick//'.txt', form='formatted', + access='sequential', status='old') c 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) i=1 do 35 q=1,i if ((stnf .eq. stn(q)) .and. (stnf .ge. ranglo) .and. + (stnf .le. ranghi)) then c print *, stnf,stn(q),q, dayrun,days,dayf 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 if (pckyrs.gt.pckyrf) then goto 750 endif mopick=moabb(pckmos) yrpick=yrabb(pckyrs-1993) close (unit=50) goto 440 750 print *, '*** The data output file has been written. ***' close (unit=50) 280 print *, 'Total number of data records written out :', obsct close (unit=40) end