# program starlo # # # # # This program : # 1. Extracts data from the Starlog data logger # 2. Sets up the header block. # 3. Inserts cycle and logging programs. # # NOTE: # We throw away the first log due to a nasty value - probably # because we slid the plug home causing noise. # # Set the terminal to SLAVE and assign it a name of LO: # # The data file contains one header record in following format # # # 0 - 2 first day (3) # 3 - 5 first month(3) # 6 - 8 first year (3) # 9 -11 first hour (3) # 12-14 first min (3) # 15-17 last day (3) # 18-20 last month (3) # 21-23 last year (3) # 24-26 last hour (3) # 27-29 last min (3) # 30-32 num bytes/log (3) # 33-38 log int mins (6) # # # logical tcmd,action,prog,print,data integer*4 opcode(20),ltime,ctime,numlgs,il,li integer*4 pline(5),op1,op2,ifstm byte pnme(20),bline(20),ibel,datfil(30) integer ibuf(42),oneop(5) common action,prog,data common /date/ idf,imf,iyf,ifsth,ifstm,idl,iml,iyl,lasth,lastm,ibpl,li data opcode/'END ','SCL ','DIR ','ADD ','AVE ','GET ','EXT ',_ 'DIVK','NEG ','MULK','TOT ','MUL ','LIM ','MOV ',_ 'ADDK','JMP ','MULH','JMPA','MAX ','MIN '/ data ctime/2/,ltime/600/,ibel/7/ data oneop/5,6,7,9,18/ data print/.false./ equivalence (pline,bline) # open (unit=2,name='LO:',type='OLD',err=333) # write(5,('0 PROGRAM STARTLOG',/)) # # ############################################ # PROGRAM LISTING # ############################################ # repeat { write(5,('$Do you want the logger programs listed (Y/N) ?')) read(5,(a1))ians call cnvtuc(1,ians) } until (ians.eq.'Y'.or.ians.eq.'N') if (ians.eq.'Y') { call logdmp(ibuf,opcode,print) } # # ######################################### # CHANGE LOGGER PROGRAM # ######################################### # # repeat { write(5,('$Do you want the logger programs changed (Y/N) ?')) read(5,(a1))ians call cnvtuc(1,ians) } until (ians.eq.'N'.or.ians.eq.'Y') if (ians.eq.'Y') { write(5,('0Both CYCLE and LOG programs will be updated')) write(5,('$Enter name of file containing program code ->')) read(5,(20a1))pnme pnme(20)=0 open (unit=1,name=pnme,type='OLD',READONLY) logadd=128 istat=0 action=.false. call readcm(pline,istat) while (istat.eq.0) { do i=1,20 if(bline(i).eq.9)bline(i)=' ' # Remove tabs if (bline(1).eq.'*') { action=.true. #loging action required do i=2,20 bline(i-1)=bline(i) } call cnvtuc(4,bline) tcmd=.false. do icmd=1,20 { if (opcode(icmd).eq.pline(1)) { tcmd=.true. break } } if (.not.tcmd) { write (5,('0Invalid program statement [ ',5a4,' ]',_ /,'****** ABORT ******',a1))pline,ibel call exit (255) } ibuf(1)=icmd-1 if (icmd.eq.1) # If an END statement { prog=.true. action=.false. call putlog(ibuf,logadd,1,j) logadd=logadd+1 } else { ij=5 do j=1,2 { do i=ij,20 { if (bline(i).ne.' ') break } if (bline(i).eq.'C'.or.bline(i).eq.'c') i=i+1 call ascbin(16,bline(i),10,op2,jstat) if (jstat.eq.16) { do i=1,5 if (icmd.eq.oneop(i)) break if (i.eq.6) { write (5,('0Invalid operator [ ',5a4,' ]',_ /,'****** ABORT ******',a1))pline,ibel call exit(255) } } if (j.eq.1) { op1=op2 ij=22-jstat } } ibuf(2)=op1 ibuf(3)=op2 prog=.true. call putlog(ibuf,logadd,3,jstat) logadd=logadd+3 } call readcm(pline,istat) } prog=.false. call logdmp(ibuf,opcode,print) } # # # ############################################# # EXTRACT DATA FROM LOGGER # ############################################# # # repeat { write(5,('$Do you want to suck data from the logger (Y/N) ?')) read(5,(a1))ians call cnvtuc(1,ians) } until (ians.eq.'Y'.or.ians.eq.'N') if (ians.eq.'Y') { print=.true. call logdmp(ibuf,opcode,print) if (data) { write (5,('$Enter filename to store data ->')) read (5,(30a1))datfil datfil(30)=0 open (unit=4,name=datfil,type='NEW') write(4,(' ',11i3,i6))idf,imf,iyf,ifsth,ifstm,idl,iml,iyl,lasth,lastm_ ,ibpl,li call countb(nchns) call getlog(ibuf,5,2,istat) il=ibuf(2) il=il*256 istart=1024 ict=0 write(5,('0')) for (numlgs=(ibuf(1)+il-1024)/nchns ; numlgs.gt.0 ; numlgs=numlgs-1) { call getlog(ibuf,istart,nchns,istat) if (ict.gt.0) write (4,(' ',24i4))(ibuf(i),i=1,nchns) istart=istart+nchns ict=ict+1 if (mod(ict,20).eq.0) write (5,('+',i4,' logs read - continuing'))ict } write (5,('+',i4,' Total logs read '))ict close (unit=4) } } # # # ################################################### # INITIALIZE AND ARM LOGGER # ################################################### # # # repeat { write(5,('$Shall we INITIALIZE and ARM the logger (Y/N) ?')) read(5,(a1))ians call cnvtuc(1,ians) } until (ians.eq.'Y'.or.ians.eq.'N') if (ians.eq.'N') { write(5,('0Program STARLOG finished')) stop } write(5,('$Enter the logger serial number ->')) read(5,(i4))iserl write(5,('$Enter the site number ->')) read(5,(i4))isite ibuf(1)=mod(iserl,256) ibuf(2)=iserl/256 prog=.false. call putlog(ibuf,246,2,istat) ibuf(1)=mod(isite,256) ibuf(2)=isite/256 ibuf(3)=0 call putlog(ibuf,240,3,istat) write(5,('0NOTE: the cycle time is strapped in the logger',/_ ' and can only be changed by re-strapping',/_ ' normally the strap is for 2 secs.')) write(5,('$Enter CYCLE TIME in secs ->')) read(5,*)ctime ltime=-1 while (ltime.le.0) { write(5,('$Enter the LOGGING INTERVAL in mins ->')) read(5,*)ltime } ltime=ltime*60 icdown=ltime/ctime lcycl=ctime*4 # do i=1,7 { ibuf(i)=0 } call putlog(ibuf,0,5,istat) #Set bytes 0-4 in logger ibuf(1)=mod(icdown,256) ibuf(2)=icdown/256 ibuf(3)=ibuf(1) ibuf(4)=ibuf(2) ibuf(5)=lcycl call putlog(ibuf,11,5,istat) #Set bytes 11-15 in logger do i=1,42 ibuf(i)=0 call putlog(ibuf,24,40,istat) #Set bytes 24-119 to zero call putlog(ibuf,64,40,istat) call putlog(ibuf,104,16,istat) # # stop 333 write (5,('0Device "LO:" does not exist',a1))ibel stop end # # ################################### # ********* END OF MAINLINE ******* ################################### # # # # # #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine getlog(ibuf,istart,inum,istat) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # # Where: # IBUF = Binary buffer to collect data # ISTART= Integer logger start address # INUM = Integer number of charaters to xfer. # ISTAT = -1 for inum too large (>42) # 0 successfull # # integer*4 iblk,islab,num logical fun,first,action,prog,data integer parm(6),isb(2),ibuf(1) byte hexin(86),getcmd(7) common action,prog,data data fun/"4630/ data first/.true./ # if (inum.gt.42) { istat=-1 return } getcmd(1)='G' parm(5)=7 parm(3)=1 call getadr(parm,hexin,,,getcmd) iblk=istart/256 islab=mod(istart,256) if ((islab+inum).gt.256) { num=256-islab is=2 call binasc(num,2,16,getcmd(6),is) parm(2)=num*2+2 # is=2 call binasc(iblk,2,16,getcmd(2),is) is=2 call binasc(islab,2,16,getcmd(4),is) isb(2)=0 while (isb(2).ne.parm(2)) call wtqio(fun,2,7,,isb,parm) ipt=isb(2)-1 call getadr(parm,hexin(ipt),,,getcmd) iblk=iblk+1 islab=0 num=inum-num } else num=inum is=2 call binasc(num,2,16,getcmd(6),is) parm(2)=num*2+2 # is=2 call binasc(iblk,2,16,getcmd(2),is) is=2 call binasc(islab,2,16,getcmd(4),is) isb(2)=0 while (isb(2).ne.parm(2)) call wtqio(fun,2,7,,isb,parm) j=1 do i=1,inum { call ascbin(2,hexin(j),16,num) if (i.eq.1) { if (num.ne.0) { if ((128.and.num).eq.0) action=.true. else action=.false. } else action=.false. } ibuf(i)=num j=j+2 } istat=0 return end # # # # # # #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine putlog(ibuf,istart,inum,istat) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # # integer*4 num,iblk,islab integer parm(6),parm1(6),ibuf(1) logical first,fun,action,prog,data byte putcmd(7),hexbuf(84) common action,prog,data data first/.true./ data fun/"410/ # # if (inum.gt.42) { istat=-1 return } putcmd(1)="P" parm(2)=7 call getadr(parm,putcmd) call getadr(parm1,hexbuf) is=2 num=inum call binasc(num,2,16,putcmd(6),is) parm1(2)=inum*2 iblk=istart/256 islab=mod(istart,256) is=2 call binasc(iblk,2,16,putcmd(2),is) IS=2 call binasc(islab,2,16,putcmd(4),is) j=1 do i=1,inum { is=2 num=ibuf(i) if (i.eq.1) { if (prog) { if (action) { num=num.and.127 #clear no-action bit action=.false. } else { num=num.or.128 #set no-action bit } prog=.false. } } call binasc(num,2,16,hexbuf(j),is) j=j+2 } call wtqio(fun,2,7,,,parm) call wtqio(fun,2,7,,,parm1) istat=0 return end # # # # # # #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine logdmp(ibuf,opcode,print) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # This routine prints the logger header block and programs # # logical first,cyprog,action,prog,print,data real xcum(2) integer*4 opcode(1),jmnth(12),ifstm,logint,lastlg,icur,numlgs integer*4 lastl,li,i4,pcmd(5) byte dat(9),fnme(30),ibel integer ibuf(1),mcr(2) common action,prog,data common /date/ idf,imf,iyf,ifsth,ifstm,idl,iml,iyl,lasth,lastm,ibytes,li data jmnth/'Jan-','Feb-','Mar-','Apr-','May-','Jun-','Jul-',_ 'Aug-','Sep-','Oct-','Nov-','Dec-'/ data first/.true./,ibel/7/ data mcr/3rMCR,3r.../,pcmd/'PRI ','=STA','RLOG','.DAT','/DE '/ # if (first) { if (print) { open(unit=3,name='starlog.dat',type='NEW') } else { write(5,('$Where shall I list the program ? ')) read(5,(30a1))fnme fnme(30)=0 open(unit=3,name=fnme,type='NEW') first=.false. } } call getlog(ibuf,240,8,istat) #Get logger ID call date(dat) write (3,('1*** STARLOG HEADER AND PROGRAM DUMP *** ',9A1,/))dat iserl=ibuf(7)+256*ibuf(8) isite=ibuf(1)+256*ibuf(2) call countb(ibytes) write (3,('0Logger Serial No. ',i4,/,' Logger Site No. ',i4))iserl,isite call getlog(ibuf,0,16,istat) li=ibuf(7) li=li*256 i4=ibuf(6) numlgs=(i4+li)-1024 numlgs=numlgs/ibytes if (numlgs.eq.0) { write(3,('0 THIS LOGGER CONTAINS NO DATA')) write(5,('0 THIS LOGGER CONTAINS NO DATA',a1))ibel data=.false. } else { data=.true. ioflow=2.and.ibuf(5) if (ioflow.ne.0) { write (3,('0WARNING - The logger data area has been OVERFLOWED')) } scs=secnds(0.) imin=scs/60. call idate(im,id,iy) call jdate(im,id,iy,jdat,n) i4=jdat icur=i4*1440-(1440-imin) # Current minutes is=1 do j=1,2 { acum=0. xmul=1. do i=is,is+3 { a=ibuf(i) acum=acum+a*xmul xmul=xmul*256. } xcum(j)=acum is=8 } lastl=xcum(1)-xcum(2) lastl=lastl*ibuf(16)/240 lastlg=icur-lastl iyl=iy if (lastlg.lt.0.) { iyl=iy-1 call jdate(12,31,iyl,jd,n) i4=jd lastlg=i4*1440+icur-lastl } log=((ibuf(14)+ibuf(15)*256)*ibuf(16)/4)/60 logint=log*numlgs ifstm=lastlg-logint # First log time in minutes iyf=iyl if (ifstm.lt.0) { iyf=iy-1 call jdate(12,31,iyf,jd,n) i4=jd ifstm=i4*1440+lastlg-logint } ifstd=ifstm/1440+1 # First log time in days ifsth=mod(ifstm,1440)/60 ifstm=mod(ifstm,1440)-ifsth*60 call cdate(ifstd,imf,idf,iyf) lastd=lastlg/1440+1 # Last log in days lasth=mod(lastlg,1440)/60 lastm=mod(lastlg,1440)-lasth*60 call cdate(lastd,iml,idl,iyl) # write (3,('0Logger Start Time :',i2,'-',a4,i2,' ',i2,':'i2))_ idf,jmnth(imf),iyf,ifsth,ifstm write (3,(' Logger End Time :',i2,'-',a4,i2,' ',i2,':'i2))_ idl,jmnth(iml),iyl,lasth,lastm } write (3,('0Hardware Cycle Time :',i4,' secs.'))ibuf(16)/4 li=(ibuf(14)+ibuf(15)*256)*ibuf(16)/4 li=li/60 write (3,('0Logging Interval :',i4,' mins.'))li write (3,(' Number of Log Intervals :',i6))numlgs write (3,(' Number of Bytes/Log-int :',i6,/))ibytes # write (3,('0******** Start of Program Listing ********',/)) cyprog=.true. istart=128 while (istart.lt.240) { call getlog(ibuf,istart,3,istat) if ((ibuf(1).and.127).eq.0) { if (cyprog) { cyprog=.false. write (3,('0********* End of Cycle Program *********',/)) istart=istart+1 next } else { write (3,('0********* End of Log Program *********',/)) break } } else { indx=ibuf(1)+1 indx=indx.and.127 if (action) { write (3,(' *',a4,' ',2i4))_ opcode(indx),ibuf(2),ibuf(3) action=.false. } else write (3,(' ',a4,' ',2i4))_ opcode(indx),ibuf(2),ibuf(3) istart=istart+3 } } if (print) { close(unit=3) call spawn(mcr,,,1,,,,pcmd,20) call waitfr(1) print=.false. write(5,('0HEADER BLOCK has been printed on LP:')) write(5,('0 START of data extraction - please wait !',/,a1))ibel } return end # # # # # #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine readcm(pline,istat) #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ # integer*4 pline(5) istat=0 read(1,100,end=10)pline 100 format(5a4) return 10 istat=-10 return end # # # #~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine countb(ichns) #~~~~~~~~~~~~~~~~~~~~~~~~~~~ # # # Count number of bytes logged integer ibuf(42) logical action,prog,data common action,prog,data # istart=128 iloop=0 ichns=0 while (iloop.lt.2) { ibuf(1)=1 while ((ibuf(1).and.127).ne.0) { call getlog(ibuf,istart,3,istat) if (action)ichns=ichns+1 istart=istart+3 } istart=istart-2 iloop=iloop+1 } return end