program jslaph * C *Purpose : Convert JASL archiving to processing format for c hourly data. * c *I/O files c name unit type comment c ------------ ----- ------ ----------------------- c hssspyy.dat 15 in archive format hourly data c STAINFO.DIN 08 in station dictionary c Vpsssyy.DAT 20 out monthly VP data for p:version, c sss : stat num, yy: year c *for as many years as exists c c *interactive input : name of archive data file and units of archive data. c Plus file version and station number for TSLC files. c *routines called: c name purpose c --------- ------------------------- c userinf obtain info from user c ioschek check status of OPEN C isetday find # days in month c term write out terminator records c writit write out header c stadin fill in station dictionary info * c ***Declare Variables. c *data buffer. dimension idata(24) c *desired station number and version of output files. character vstn*4 c *input filename. character arfile*11 c *output filename. character fout*11 * character stanum*3, staname*21, lat*6, long*7, + timerid*3, ewhem*1, timref*1, strdate*8, + country*14 * c *Declare common. common / stadic / stanum, staname, lat, long, timerid, + ewhem, timref, strdate, country * c *Compile-time initialization. data ic1, ic2 / 1, 2 / data fout / 'vasssyy.dat' / data arfile / 'hsssayy.dat'/ data idata / 24*9999 / data iout / 20 / * C *Obtain info from user. call userin( vstn, isy4, numyr ) * c *Put file version and station number in file names. fout(2:5) = vstn arfile(2:4) = vstn(2:4) arfile(5:5) = vstn(1:1) * c *obtain info from station dictionary. call stadin( vstn(2:4) ) * c *loop thru each year itot = isy4 + numyr - 1 do 7 iy4 = isy4, itot c *build filenames. if( iy4 .lt. 1900 ) then iy2 = iy4 - 1800 arfile(1:1) = 'g' fout(1:1) = 'u' elseif( iy4 .ge. 1900 .and. iy4 .lt. 2000 ) then iy2 = iy4 - 1900 arfile(1:1) = 'h' fout(1:1) = 'v' elseif( iy4 .ge. 2000 ) then iy2 = iy4 - 2000 arfile(1:1) = 'i' fout(1:1) = 'w' endif write(arfile(6:7),'(i2.2)') iy2 write(fout(6:7),'(i2.2)') iy2 c *Open archive and processing data files. open(unit=15,file=arfile,status='OLD',iostat=ios) call ioschek( 'bad open', ios, 15 ) open(unit=iout,file=fout,status='NEW',iostat=ios) call ioschek( 'bad open', ios, iout ) c *skip header read(15,*) * c ****Begin Master Loop**** c * c *Read in a record, reformat, and write out. if new month, c *then place 2 records of 9999999's as terminators and create c *new header. c * idtest = 0 iytest = 0 imtest = 0 0001 read(15,2000,end=9000) iyear, mo, iday, idata * c *Check for new month and find # days in month if so. if( mo .ne. imtest ) call isetday( iyear, mo, nxdays ) * c *Create header. if( iyear .ne. iytest .or. + mo .ne. imtest ) call writit( iy2, mo, 2, iout ) * c *Write out data. write(iout,3000) vstn(2:4), staname(1:7), iyear, mo, iday,ic1, + (idata(i),i=1,12) write(iout,3000) vstn(2:4), staname(1:7), iyear, mo, iday,ic2, + (idata(i),i=13,24) * c *Check for new month and place in terminator records if so. if( iday .eq. nxdays )call term( iout ) * c *Reintinitialize data and counters. do 50 ih = 1, 24 idata(ih) = 9999 50 continue idtest = iday imtest = mo iytest = iyear * goto 0001 * c *********End Master Loop********* 9000 continue * close(15) close(iout) 7 continue * 2000 format(11x,i4,i2,i2,1x,12i5/20x,12i5) 3000 format(a3,a7,1x,i4,i2,i2,i1,12i5) * stop 'ok boss' end c =============================================================== subroutine userin( vstn, isy4, numyr ) * c *Purpose: Pass info interactively from user. * character vstn*4 * write(6,100) 100 format(//////////////////////, + ' Convert JASL Archive to Processing format',/, + ' for hourly Sea Level Data ',/, +' note:need file STAINFO.DIN on same directory as executable.',/, +///) * write(6,500) 500 format(' Enter version and station # (i.e a032) : ',$) read(5,'(a)') vstn * write(6,1100) 1100 format(/,1x,'Enter start year (ie. 1978) : ',$) read(5,'(i4)') isy4 * write(6,1300) 1300 format(/,1x,'Enter # of consecutive years : ',$) read(5,'(i3)') numyr * * return end * ================================================================== subroutine ioschek( comment, ios, iunit ) * c *Purpose : test status of ios. c c *Arguments: c name type i/o comment c comment char i short statement about test c ios int i ios value c iunit int i io unit * c *P. Caldwell/ 26 Jan 88 * * ----------------------------------------------------- * character*25 comment * if( ios .ne. 0 ) then write(6,1000) comment, ios, iunit stop 'abort' endif 1000 format(1x,a25,1x,' ios = ',i2,' unit = ',i2) * return end * ===================================================================== SUBROUTINE STADIN( dstn ) * c *Purpose : Fill variables from station dictionary and place in common. * c *Dummy argument : dstn - desired station number * c *I/O files c name unit type comment c ------------- ---- ---- ---------------------- c stainfo.din 08 in station dictionary * c *Routine called : IOSCHEK * c *Note : variable timerid : time meridian c ewhem : east or west hemisphere c timref : 0 is time as 1 to 24 hours for each day c 1 0 to 23 * C *P. Caldwell / 4-28-88 * * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * C *Declare Variables. character dstn*3, stanum*3, staname*21, lat*6, long*7, + timerid*3, ewhem*1, timref*1, strdate*8, + country*14 c *local buffer character stadict*80 * c *Declare common. common / stadic / stanum, staname, lat, long, timerid, + ewhem, timref, strdate, country * open(unit=08,file='stainfo.din', + status='OLD',iostat=ios) call ioschek( 'bad open ', ios, 08 ) * do 10 i = 1, 500 read(8,'(a)',end=20) stadict if( dstn .eq. stadict(4:6))goto 20 10 continue 20 continue * stanum = dstn staname = stadict(8:28) lat = stadict(29:34) long = stadict(36:42) timerid = stadict(44:46) ewhem = stadict(42:42) timref = stadict(48:48) strdate = stadict(50:57) country = stadict(59:72) * close (08) return end * ======================================================== subroutine ISETDAY ( iyr, imon, nday ) * c *purpose : Find # days in month. PASS AN INTEGER MONTH. * c * Arguments : c name type i/o comment c iyr int in year in partial form, eg 71 c imon int in index for month, eg 3 for MAR c nday int out # days in month * c *P. Caldwell/ 11 Feb 88 * -------------------------------------------------------- * c *Declare variables. dimension nmon(12) c c *Assignments. data nmon / 31, 28, 31, 30, 31, 30, + 31, 31, 30, 31, 30, 31 / * c *Obtain # days in month, check for leap year. if( imon .eq. 2 ) then if( mod(iyr,4) .eq. 0 ) then nday = 29 else nday = 28 endif else nday = nmon(imon) endif * return end * ============================================================= SUBROUTINE WRITIT( iyear, mo, iun, iout ) * c *Purpose : write out VP monthly format header for given yr,mo. * *Note : iun is units code see data statement below. * iout is the io unit #. C *P. Caldwell / 4-28-88 * * - - - - - - - - - - - - - - - - - - - - - - - - - - - - * C *Declare Variables. c *station dictionary parms. character stanum*3, staname*21, lat*6, long*7, + timerid*3, ewhem*1, timref*1, strdate*8, + country*14 c *other parms. character month(12)*3, units(3)*1 * c *Declare common. common / stadic / stanum, staname, lat, long, timerid, + ewhem, timref, strdate, country * c *Compile-time initialization. data month / 'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', + 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC' / data units / 'F ', 'M', 'C' / * c *find # days in month. call isetday( iyear, mo, numday ) * write(iout,6000) stanum, staname(1:8), lat(1:5), lat(6:6), + long(1:6), long(7:7), + month(mo), iyear, units(iun), numday 6000 format(a3,a8,3x,'LAT=',a5,2x,a1,' LONG=',a6,2x,a1, + ' TMZONE=GMT REF=00000 60 ',A3,1X, + i2.2,1x,a1,1x,i2) return end SUBROUTINE TERM( iout ) * c *Purpose: create two terminator records of 999999's to c * be placed at the end of each month of data. c write(iout,1000) write(iout,1000) 1000 format(20('9999')) return end