C rpc_hilo.f based on MTS web RPC-3 info & Octal data file dump info. C Copyright (C) 1998 SAE Fatigue Design and Evaluation Committee C This program is free software; you can redistribute it and/or C modify it under the terms of the GNU General Public License as C published by the Free Software Foundation; either version 2 of the C license, or (at your option) any later version. C C This program is distributed in the hope tha it will be useful, C but WITHOUT ANY WARRANTY; without even the implied warranty of C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C GNU General PUblic License for more details. C C You should have received a copy of the GNU General PUblic License C along with this program; if not, write to the Free Software C Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA C Try also their web site: http://www.gnu.org/copyleft/gpl.html C--------------------------------------------------------------------------- c Sun compile: f77 -g rpc_hilo.f -o rpc_hilo c usage: rpc_hilo [-g] infilename >outfilename c -g gives raw integer*2 hilos for each group C This program is based on rpc2ascii.f, but altered to read the data and C compute for each channel a HIGH, LOW, MEAN for each group, and, at C the end of all reading, the overall values. C It appears that the RPC3 time histories are arranged as follows: C A file consists of a HEADER set of records, and a DATA set of records. C c The "time" axis is unitized into Groups and Frames. C The total number of FRAMES gives the length of each channel. C C In the file points for each channel appear in Groups of points. C The record size is 512 bytes, so that in order to extract a C group for a channel we need to read a bunch of records. C Frame size, is often an approximate C function of samples / sec/chan. Thus a Frame is about 1 sec C of data for a channel. C The data itself is integer*2 and needs to be converted to C real units using the SCALE.CHAN_n multiplier values. There C does not seem to be a mean shift value. c------- C NOTE! c There seems to be some type of Machine dependence of the C binary files. In fact there are at least 3 types of RPC-3 files: C PC, HPunix, and Sun etc. Some of them have the bytes swapped. C Probably HP and APOLLO. VAX and DEC also may have 1/4 of the c record length. Presumably we are also faced with the RPC-1, 2 and c 3 forms. I think we will only play with RPC-3 c------- C C CHARACTER*512 REC512 character*128 REC128(4), filename, argv character*1 REC1(512) equivalence (REC512, REC128(1), REC1(1)) C the above equivalence allows the record to be addressed c in 3 ways - same data character*32 key,filetype,keyvalue32(3) character*96 keyvalue96 character*1 keyvalue1(96) equivalence (keyvalue96, keyvalue32(1),keyvalue1(1)) character*5 key5(6) equivalence (key,key5(1)) c note that the two fields do not exactly match. hopefull f77 will c forgive but not forget. C channel description stuff. Dimension now for 128 chans max. character*32 chan_units(128) character*98 chan_desc(128) real chan_scale(128) real chan_ulimit(128) real chan_llimit(128) integer chan_map(128) c ncode channel stuff: real chan_stat1(128,5) integer chan_stat2(128,3) C File inquire stuff c character*24 saccess, sform c integer ichecklength, ichecknextrec c logical sexist character*10 delimiter c-------------------------------------------- You may need to tune this section c Data storage integer*2 idatraw(256) CCC integer*2 idata(65536,24) c Data storage for high, low, mean etc. One set for each chan. integer*2 igrouphigh(3600,24) integer*2 igroupmean(3600,24) integer*2 igrouplow (3600,24) integer*2 itothigh(24) integer*2 itotmean(24) integer*2 itotlow(24) real rtothigh(24) real rtotlow(24) real rtotmean(24) C we could do max slew rates too. later. logical lgrouphilos C!!!!-----------------change above lines for no of channels!!!!! N.B.! C if you chan number is smaller, dont worry about it. maxchans=24 C for the hilo function we dont need max data. though we should c have a max group equal to the dimension above c maxdata=65536 maxgroup=3600 ireclength=512 C------------------------------------------------------------------------------- IER = 0 IREC = 0 NHEAD = 0 C IVALUE = 0 c Example filename="sal6-.rsp" c Fetch filename from command line, and see if -g too lgrouphilos=.false. if(iargc().NE.1 .and. iargc().NE.2 )then write(0,*)" Usage: rpc_hilo [-g] infile > outfile" stop endif if(iargc().eq.1)then C called with filename only, leave group hilos off call getarg(1,argv) read(argv,*)filename write(0,*)" Opening file : ",filename write(6,*)" Opening file : ",filename go to 40 endif if(iargc().eq.2)then C called with argument and filename. Expect argument first call getarg(1,argv) if(argv.eq."-g")then lgrouphilos=.true. write(0,*)" -g : Group hilos requested." go to 30 endif write(0,*)" Unknown arg: ",argv 30 continue C now get filename call getarg(2,argv) read(argv,*)filename write(0,*)" Opening file : ",filename write(6,*)" Opening file : ",filename go to 40 endif 40 continue IER = 0 IFILE = 92 OPEN (UNIT=IFILE,FILE=filename, & STATUS='OLD', ACCESS='DIRECT', RECL=ireclength, & ERR=999,IOSTAT=IER, FILEOPT='NOPAD') c The 'NOPAD'option above means that if you read beyond the actual c record you will error out. It still lets you read records c that are not there, however. c Check on stuff c INQUIRE(FILE=filename,ACCESS=saccess,FORM=sform,EXIST=sexist, c & RECL=ichecklength,NEXTREC=ichecknextrec) c write(6,*)" File INQUIRE gives:", c & "FILE= ",filename, c & "ACCESS= ",saccess,", FORM= ",sform,", EXIST=",sexist, c & "RECL=",ichecklength,", NEXTREC=",ichecknextrec GO TO 10 999 write(0,*) 'RPC FILE OPEN ERROR' WRITE(0,'('' HEADR READ ERROR. IREC, IOSTAT='',2I5)') & IREC,IER stop 10 continue 100 CONTINUE c Get first record IREC = IREC+1 READ(IFILE,REC=IREC,ERR=998,IOSTAT=ioerr) REC512 c change the nulls to blanks ? maybe this is dumb do 120 j=1,512 if(REC1(j).lt." " .or. REC1(j).gt."~")REC1(j)=" " 120 continue write(6,*)(REC128(i),i=1,4) C Hopefully FORMAT BINARY read(REC128(1),*)KEY, keyvalue96 if(key.ne."FORMAT")then write(0,*)" Error: 1st rec rpc file, didnt find: FORMAT" stop endif write(6,*)key," ",keyvalue96 C Hopefully next is NUM_HEADER_BLOCKS 44 (e.g.) read(REC128(2),*)key, nhead write(6,*)key," ",nhead, " = no. of header records" C Next should be NUM_PARAMS 66 (e.g.) read(REC128(3),*)key, numpar if(key.ne."NUM_PARAMS")then write(0,*)" Error: 1st rec rpc file, didnt find: ", & "NUM_PARAMS " stop endif write(6,*)key," ",numpar C Next should be FILE_TYPE TIME_HISTORY(e.g.) read(REC128(4),*)key, filetype if(key.ne."FILE_TYPE")then write(0,*)" Error: 1st rec rpc file, didnt find: ", & "FILE_TYPE " stop endif if(filetype.ne."TIME_HISTORY")then write(0,*)" Error: 1st rec rpc file, type is not ", & "TIME_HISTORY " stop endif write(6,*)key," ",filetype C--------------------------------------- get rest of header----------- C Loop for the rest of the records in the header do 300 i=2,nhead IREC = IREC+1 READ(IFILE,REC=IREC,ERR=998,IOSTAT=ioerr) REC512 do 220 j=1,512 C Get rid on null characters if(REC1(j).lt." " .or. REC1(j).gt."~")REC1(j)=" " 220 continue C There may be 4 key,value pairs in each record do 250 jkeys=1,4 read(REC128(jkeys),"(A32,A96)")key, keyvalue96 if(key.eq." " .and. keyvalue96 .eq." ")go to 250 c Decode for the stuff we need to read this file if(key.eq."DELTA_T")then read(keyvalue96 ,*)deltatime isamplerate=ifix(1.0/deltatime) write(6,*)" Found DELTA_T = ",deltatime, & " implied sample rate = ",isamplerate go to 250 endif if(key.eq."PTS_PER_FRAME")then read(keyvalue96 ,*)nptsperframe write(6,*)"PTS_PER_FRAME ",nptsperframe go to 250 endif if(key.eq."CHANNELS")then read(keyvalue96 ,*)nchans write(6,*)"CHANNELS ",nchans if(nchans.gt.maxchans)then write(0,*)" Oops, data storage array needs to be wider", & " to accomodate this number of chans. Needs recompile." & ," Stopping now.." stop endif go to 250 endif if(key.eq."PTS_PER_GROUP")then read(keyvalue96 ,*)nptspergroup write(6,*)" PTS_PER_GROUP = ",nptspergroup go to 250 endif if(key.eq."FRAMES")then read(keyvalue96 ,*)nframes write(6,*)" No. of FRAMES = ",nframes go to 250 endif C Look for some of the channel descriptor stuff if(key5(1).eq."UNITS")then call GETCHAN(key,ichan) C save only the first 32 chars of the units field chan_units(ichan)=keyvalue32(1) write(6,*)" UNITS ch ",ichan," : ",chan_units(ichan) go to 250 endif if(key5(1).eq."DESC.")then call GETCHAN(key,ichan) chan_desc(ichan)=keyvalue96 write(6,*)" DESCRIPTOR ch ",ichan," : ",keyvalue96 go to 250 endif if(key5(1).eq."SCALE")then call GETCHAN(key,ichan) read(keyvalue96,*)chan_scale(ichan) write(6,*)" SCALE ch ",ichan," = ",chan_scale(ichan) go to 250 endif if(key5(1).eq."UPPER")then call GETCHAN(key,ichan) read(keyvalue96,*)chan_ulimit(ichan) write(6,*)" UPPER LIMIT ch ",ichan," = ",chan_ulimit(ichan) go to 250 endif if(key5(1).eq."LOWER")then call GETCHAN(key,ichan) read(keyvalue96,*)chan_llimit(ichan) write(6,*)" LOWER LIMIT ch ",ichan," = ",chan_llimit(ichan) go to 250 endif if(key5(1).eq."MAP.C")then call GETCHAN(key,ichan) C This is some sort of channel number mapping. Probably confusing C so just set it equal to chan number during file creation. read(keyvalue96,*)chan_map(ichan) write(6,*)" MAP ch ",ichan," = ",chan_map(ichan) go to 250 endif C See if ncode has added some of their own wrinkles. C nCode seems to have some pre-calculated statistics about each C channel. We will find out what they mean later. if(key5(1).eq."NCODE")then if(key5(2).eq."_STAT" .and. key5(3).eq."1_CHA")then c found the ncode NCODE_STAT1_CHAN_ descriptor c There should be 5 real nos in the keyvalue files seperated by commas call GETCHAN(key,ichan) c Sun seems to need blanks rather than commas, so change them c do 242 j=1,96 c if(keyvalue1(j).eq.",")keyvalue1(j)=" " c 242 continue read(keyvalue96,*)(chan_stat1(ichan,j),j=1,5) write(6,*)" NCODE_STAT1_CHAN_",ichan," = ", & (chan_stat1(ichan,j),j=1,5) go to 250 endif if(key5(2).eq."_STAT" .and. key5(3).eq."2_CHA")then c found the ncode NCODE_STAT2_CHAN_ descriptor c There should be 3 integer nos in the keyvalue files seperated by commas call GETCHAN(key,ichan) c do 243 j=1,96 c if(keyvalue1(j).eq.",")keyvalue1(j)=" " c 243 continue read(keyvalue96,*)(chan_stat2(ichan,j),j=1,3) write(6,*)" NCODE_STAT2_CHAN_",ichan," = ", & (chan_stat2(ichan,j),j=1,3) go to 250 endif endif write(6,*)key,keyvalue96 250 continue 300 continue c Each point is 2 bytes. Each record is 512 bytes, thus c (integer*2) 256 pts. nptsperrec=ireclength/2 write(6,*) nrecsperframe= nptsperframe/nptsperrec write(6,*)" Given ",nptsperrec," pts/rec (2 byte pts), thus :", & " No. of Records per frame = ",nrecsperframe C Similarly, the recs per group: nrecspergroup=nptspergroup/nptsperrec write(6,*)" No. of Records per group = ",nrecspergroup c Given the number of frames in the file (the time axis), nframespergroup=nptspergroup/nptsperframe write(6,*)" There are ",nframespergroup," frames per group" ngroups=nframes/nframespergroup ntotpointsperchannel=ngroups*nptspergroup write(6,*)" Time axis is ",nframes," FRAMES, or ", & ngroups," GROUPS, or",ntotpointsperchannel," points" totaltime=ntotpointsperchannel * deltatime write(6,*)" Total time span of file = ",totaltime delimiter="BEGIN DATA" write(6,"(A10)")delimiter write(0,*) "Reading data records..." c Loop for no of groups total do 490 loop1=1,ngroups c Loop for each channel do 470 loop2=1,nchans isum=0 c Loop for each record in each channels group do 450 loop3=1,nrecspergroup c get one rec IREC = IREC+1 Cbug write(0,*)" Reading Group ",loop1,", Chan ",loop2 Cbug & ," Rec= ",IREC," Loc = ",jrecbegin,jrecend READ(IFILE,REC=IREC,END=950,ERR=890,IOSTAT=ioerr) idatraw if(loop3 .eq. 1)then c Set up the counters for this group ihigh=idatraw(1) ilow= idatraw(1) endif do 430 i=1,nptsperrec itemp=idatraw(i) isum=isum+itemp if(ihigh.lt. itemp)ihigh=itemp if(ilow .gt. itemp) ilow= itemp 430 continue c end of record loop3 450 continue c ok, chan is done reading this group. Save the stats igrouphigh(loop1,loop2)= ihigh igrouplow (loop1,loop2)= ilow igroupmean(loop1,loop2)= isum/nptspergroup c end of channel loop2 for this group no. 470 continue c End of group loop1 490 continue C Write out the High values for all chans & groups---------------- write(6,*) write(6,*) &"GRP --------------------Ch Highs ------------------------" do 535 loop1=1,ngroups do 533 loop2=1,nchans if(loop1 .eq.1 )then c initilize the overall high scanner itothigh(loop2)=igrouphigh(loop1,loop2) endif if(itothigh(loop2) .lt. igrouphigh(loop1,loop2) ) & itothigh(loop2)=igrouphigh(loop1,loop2) 533 continue if(lgrouphilos) &write(6,"(128I6)")loop1,(igrouphigh(loop1,j),j=1,nchans) 535 continue write(6,*) write(6,"(' TOT ',128I6)")(itothigh(j),j=1,nchans) do 536 loop2=1,nchans 536 rtothigh(loop2)=float(itothigh(loop2))*chan_scale(loop2) write(6,"(' Real ',32G10.3)")(rtothigh(j),j=1,nchans) write(6,*) C Write out the mean values for all chans & groups---------------- write(6,*) write(6,*) &"GRP --------------------Ch Means------------------------" do 545 loop1=1,ngroups do 543 loop2=1,nchans if(loop1 .eq.1 )then c initilize the overall mean scanner itotmean(loop2)=0 endif itotmean(loop2)= itotmean(loop2)+igroupmean(loop1,loop2) 543 continue if(lgrouphilos) & write(6,"(128I6)")loop1,(igroupmean(loop1,j),j=1,nchans) 545 continue write(6,*) write(6,"(' TOT ',128I6)")((itotmean(j)/ngroups),j=1,nchans) do 546 loop2=1,nchans 546 rtotmean(loop2)=float(itotmean(loop2))/float(ngroups) * & chan_scale(loop2) write(6,"(' Real ',32G10.3)")(rtotmean(j),j=1,nchans) write(6,*) C Write out the Lows values for all chans & groups---------------- write(6,*) write(6,*) &"GRP --------------------Ch Lows-------------------------" do 555 loop1=1,ngroups do 553 loop2=1,nchans if(loop1 .eq.1 )then c initilize the overall low scanner itotlow(loop2)=igrouplow(loop1,loop2) endif if(itotlow(loop2) .gt. igrouplow(loop1,loop2) ) & itotlow(loop2)=igrouplow(loop1,loop2) 553 continue if(lgrouphilos) & write(6,"(128I6)")loop1,(igrouplow(loop1,j),j=1,nchans) 555 continue write(6,*) write(6,"(' TOT ',128I6)")(itotlow(j),j=1,nchans) do 556 loop2=1,nchans 556 rtotlow(loop2)=float(itotlow(loop2))*chan_scale(loop2) write(6,"(' Real ',32G10.3)")(rtotlow(j),j=1,nchans) write(6,*) c Output a summary, vertically for easy reading write(6,*)filename write(6,*) do 558 i=1,nchans 558 write(6,"(i3,1x,a96)" )i,chan_desc(i) write(6,*) write(6,*) write(6,*)" Ch High Mean Low" & ," Range Units" do 560 i=1,nchans range=rtothigh(i)-rtotlow(i) write(6,559)i,rtothigh(i),rtotmean(i),rtotlow(i), & range,chan_units(i) 559 format(i3,4(1x,f10.3),2x,a32) 560 continue stop 890 write(0,*)" Error reading data from rec. no. ",IREC stop 950 write(0,*)" End of File while reading REC no. =",IREC stop 998 write(0,*)"Header rec read error. Rec_no=",IREC, & " IOSTAT= ",ioerr stop END C c--------------------------------------------------------------------- SUBROUTINE GETCHAN(stringinput,ichan) c s/r to parse a string from back to front and look for the channel c number. Incoming data looks like : LOWER_LIMIT.CHAN_1 character*32 stringinput, string32, dummy character*1 string1(32) equivalence (string32, string1(1)) c looking from back to front find the first "_" and change it c to a blank. Then format free read a dummy string and an integer string32=stringinput j=33 do 100 i=1,32 j=j-1 if(string1(j).eq. "_")then c found it string1(j)=" " read(string32,*)dummy,ichan return endif 100 continue c Got back to begining and didnt find it. Throw bomb out write(0,*)" ERROR in s/r GETCHAN. Cannot find underscore ", & " in string :",string32 write(0,*)" This error could occur while trying to decode ", & " the header info in the RPC file header.", & " Save your output file to find where the last ", & " (prior) output line occurred, then try a " write(0,*) " od -c rpc_input_file | more" write(0,*) " to find where and what the next line is. Then ", & " reprogram the source code rpc2ascii.f" write(0,*)" Stopping on error now." stop end