subroutine tecs_plot(file) character(len=*) file integer, parameter :: dmax=500, nset=3, nmenu=9, chartfreq=2 real, parameter :: winmin=60., undef=-65535.0 real*4 x1,x2,xmin,xmax,ymin(2),ymax(2),window real*4 xd(dmax),yd(dmax,nset) real*4 ylast1,ylast2,y1,y2 real*4 ex,ey,fx,fy,hmenu,wmenu,ymenu,ticks real*4 xbox(8), ybox(8) integer l,j,i,t0,t1,ntot,i1,i2,rl,n,startday,thisday integer first,last,tbase,lastj integer color(3)/2,4,3/ character key*1 character text(nmenu)*12/ & 'live off','sel. zoom','zoom in','zoom out','show all','n days','n hours','n min','quit'/ character keys*(nmenu)/'LZ+-XDHMQ'/ character weekdays(7)*3/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/ character buf*8 external tplot_close logical live, xwin, zoom, right integer iret, numb integer dlog_open_r, dlog_get, dlog_close_r data window/1800./ zoom=.false. right=.true. call pgopen(" ") call pgqinf('TYPE', buf, l) if (buf=='NULL') then print *,'No PGPLOT-Device defined' goto 9 endif xwin=(buf(1:1)=='X') live=.not. xwin ! live switched off by default on X-Windows call pgask(.false.) l=0 iret=dlog_open_r(file, first, last, tbase) if (iret<0) then call err_txt('dlog_open_r') goto 99 endif xmax=0 x1=0 1 if (right .or. window==0 .or. live) then ntot=dlog_get(dmax, nset, tbase, -window*1.1, 0.0, undef, xd, yd) if (ntot<=0) then if (ntot<0) then call err_txt('dlog_get') goto 99 endif x2=last-tbase else x2=maxval(xd(1:ntot)) endif if (live) then if (x1 .eq. 0) then x1=max(x2-window,xd(1)) else window=x2-x1 endif x2=max(x1+window,x2+min(window*0.2,max(window*0.01,300.))) elseif (window==0) then x1=minval(xd(1:ntot)) window=x2-x1 else x1=x2-window endif else if (.not. zoom) then x2=(x1+x2+window)/2 x1=x2-window endif ntot=dlog_get(dmax, nset, tbase, x1-window*0.1, x2+window*0.1, undef, xd, yd) endif if (ntot<0) then call err_txt('dlog_get') goto 99 endif if (ntot>0) then xmin=minval(xd(1:ntot)) xmax=maxval(xd(1:ntot)) else xmin=x1 xmax=x2 endif call pgsvp(0.07,0.93,0.1,0.9) ! define window size if (xmax<=xmin) then xmax=xmin+1 ! l=0 ! print *,'no points found' ! print * ! goto 9 endif call pgsch(1.0) i1=1 i2=2 do rl=1,2 if (zoom) then ymin(1)=y1 ymax(1)=y2 else ymin(rl)=1e30 ymax(rl)=-1e30 ylast1=ymin(rl) ylast2=ymax(rl) do i=i1,i2 do j=1,ntot if (xd(j) >= x1 .and. xd(j) <= x2 .and. yd(j,i)/=undef) then ymin(rl)=min(ymin(rl),yd(j,i)) ymax(rl)=max(ymax(rl),yd(j,i)) endif enddo do j=max(1,ntot-4),ntot if (yd(j, i)/=undef) then ylast1=min(ylast1,yd(j, i)) ylast2=max(ylast2,yd(j, i)) endif enddo enddo ey=(ymax(rl)-ymin(rl)) fy=abs(ymax(rl)) if (rl==1) then ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.25) ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01) else ymax(rl)=ymax(rl)+max(fy*0.1,ey*0.01) ymin(rl)=ymin(rl)-max(fy,ey*4) endif if (live) then ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4)) ymax(rl)=max(ymax(rl),ylast2+ey*0.4) endif endif if (ymax(rl) .lt. ymin(rl)) then ymax(rl)=1 ymin(rl)=0 elseif (ymax(rl) .eq. ymin(rl)) then ymax(rl)=ymin(rl)+1.0 ymin(rl)=0 endif zoom=.false. call pgswin(x1,x2,ymin(rl),ymax(rl)) do i=i1,i2 call pgsci(color(i)) n=0 lastj=1 do j=1,ntot if (yd(j,i)==undef) then if (j>lastj) call pgline(j-lastj, xd(lastj), yd(lastj,i)) lastj=j+1 endif enddo if (ntot .gt. lastj) call pgline(ntot+1-lastj, xd(lastj), yd(lastj,i)) enddo i1=3 i2=3 enddo rl=2 call pgsci(1) ! call pgtbox(' ', 0.0, 0, 'CIMST', 0.0, 0) ey=ymax(rl)-(ymax(rl)-ymin(rl))*0.20 call pgsch(0.7) call pgaxis('N', x1, ey, x1, ymax(rl), ey, ymax(rl), 0, 0, 0.5, 0.0, 0.0, -1.0, 0.0) rl=1 call pgswin(x1,x2,ymin(rl),ymax(rl)) ey=ymax(rl)-(ymax(rl)-ymin(rl))*0.21 call pgsch(1.0) call pgaxis('N', x1, ymin(rl), x1, ey, ymin(rl), ey, 0, 0, 0.5, 0.0, 0.5, -1.0, 0.0) if (window>50*3600) then ticks=8*3600 elseif (window>25*3600) then ticks=4*3600 else ticks=0.0 ! automatic endif call pgtbox('ZHXYBCINST', ticks, 0, 'CIMST', 0.0, 0) call pgmtxt ('L', 2.5, 0.4, 0.5, 'T [K]') call pgsci(color(1)) call pgmtxt ('L', 2.5, 0.2, 0.5, 'Main Sensor') call pgsci(color(2)) call pgmtxt ('L', 2.5, 0.6, 0.5, 'Sample Sensor') call pgsci(color(3)) call pgmtxt ('L', 2.5, 0.9, 0.5, 'Power [W]') call pgsci(1) call pgsclp(0) hmenu=(ymax(rl)-ymin(rl))/15. ymenu=ymax(rl)+hmenu*0.5 wmenu=(x2-x1)/(nmenu+2) if (live) then text(1)='live off' else text(1)='live on' endif call pgsch(0.7) do i=1,nmenu xbox(1)=x1+(i-0.7)*wmenu ybox(1)=ymenu+hmenu xbox(2)=xbox(1) ybox(2)=ymenu+hmenu*0.5 xbox(3)=x1+(i-0.95)*wmenu ybox(3)=ybox(2) xbox(4)=xbox(3) ybox(4)=ybox(1) xbox(5)=xbox(1) ybox(5)=ybox(1) call pgline(5, xbox, ybox) call pgptxt(x1+(i-0.9)*wmenu, ymenu+0.65*hmenu, 0.0, 0.0, keys(i:i)) call pgptxt(x1+(i-0.9)*wmenu, ymenu+0.15*hmenu, 0.0, 0.0, text(i)) enddo call pgmtxt('T', 3.5, 1.0, 1.0, 'any digit to enter n') call pgmtxt('T', 2.0, 0.9, 1.0, 'n=') thisday=(x1+x2)/2/(24*3600) ey=ymin(rl)-hmenu*1.5 i=max(0,int((x1+12*3600)/(24*3600))) do ex=(i+0.5)*24*3600 if (ex>x2) EXIT thisday=0 call pgptxt(ex, ey, 0.0, 0.5, weekdays(mod(i,7)+1)) ex=ex-12*3600 if (ex .gt. x1) then call pgmove(ex, ey) call pgdraw(ex, ey+hmenu/2) endif ex=ex+24*3600 if (ex .lt. x2) then call pgmove(ex, ey) call pgdraw(ex, ey+hmenu/2) endif i=i+1 enddo if (thisday>0) then call pgptxt((x1+x2)/2, ey, 0.0, 0.5, weekdays(mod(thisday,7)+1)) endif call pgsclp(1) call get_key(key, 0, 0) ! purge buffer numb=0 7 if (live) then if (xwin) then call pgmtxt('T', 1.0, 1.0, 1.0, 'LIVE MODE (click on text window before pressing any further key)') endif call get_key(key, 0, chartfreq) do while (key .eq. char(0)) ! no key pressed ntot=dlog_get(dmax, nset, tbase, xmax-0.5, 1e10, undef, xd, yd) if (ntot<0) then call err_txt('dlog_open_r 2') goto 99 endif if (ntot .gt. 1) then i1=1 i2=2 do rl=1,2 call pgswin(x1,x2,ymin(rl),ymax(rl)) do i=i1,i2 call pgsci(color(i)) n=0 lastj=1 do j=1,ntot if (yd(j,i)==undef) then if (j>lastj) call pgline(j-lastj, xd(lastj), yd(lastj,i)) lastj=j+1 elseif (xd(j)>x2 .or. yd(j,i)ymax(rl)) then call pgpage window=x2-x1 goto 1 endif enddo if (ntot .gt. lastj) call pgline(ntot+1-lastj, xd(lastj), yd(lastj,i)) enddo i1=3 i2=3 enddo xmax=max(xmax,xd(ntot)) endif call get_key(key, 0, chartfreq) enddo else call pgcurs(ex, ey, key) call must_purge endif rl=1 call pgswin(x1,x2,ymin(rl),ymax(rl)) 8 if (key>='a') key=char(ichar(key)-32) if (ey>ymenu) then i=max(0,min(nmenu,int((ex-x1)/wmenu+1))) key=keys(i:i) ex=(x1+x2)/2 endif if (key=='-') then window=min(window*2, 8*24*3600.) elseif (key=='X') then window=0 live=.false. elseif (key=='+' .or. key==',') then window=max(winmin,window/2) elseif (key=='Z') then call pgsci(1) if (live) then call pgmtxt('T', 1.0, 0.0, 0.0, 'click on two opposite corners of a selection rectangle') call pgcurs(ex, ey, key) else call pgmtxt('T', 1.0, 0.3, 0.0, 'click on second corner of selection rectangle') endif call pgsci(5) xmin=x1 xmax=x2 call pgmove(xmin, ey) call pgdraw(xmax, ey) call pgmove(ex, ymin(rl)) call pgdraw(ex, ymax(rl)) call pgcurs(fx, fy, key) call must_purge x1=max(xmin,min(ex,fx)) x2=min(xmax,max(ex,fx)) if (x1>=x2) then x1=xmin x2=xmax endif window=x2-x1 y1=max(ymin(1),min(ey,fy)) y2=min(ymax(1),max(ey,fy)) if (y1>=y2) then y1=ymin(1) y2=ymax(1) endif zoom=.true. live=.false. right=.false. elseif (key .ge. '0' .and. key .le. '9') then numb=numb*10+(ichar(key)-ichar('0')) if (numb>0) then write(buf, '(i8)') numb l=1 do while (buf(l:l)==' ') l=l+1 enddo call pgsci(1) call pgmtxt('T', 2.0, 0.9, 0.0, buf(l:)) endif if (xwin .and. .not. live) then call pgcurs(ex, ey, key) call must_purge else call get_key(key, 2, 10) endif if (key/=char(0)) goto 8 goto 7 elseif (key .eq. 'D') then window=min(7*24*3600,24*3600*max(1,numb)) right=.true. x1=0 elseif (key .eq. 'H') then window=min(7*24*3600,3600*max(1,numb)) right=.true. x1=0 elseif (key .eq. 'M') then window=min(7*24*3600,60*max(1,numb)) right=.true. x1=0 elseif (key .eq. 'L') then live=.not. live if (live) then right=.true. x2=xmax endif elseif (key=='Q' .or. key==char(13)) then goto 9 elseif (live) then goto 7 endif numb=0 call pgpage goto 1 99 call tecs_write_error(6) 9 continue call tplot_close call get_key(key, 0, 0) ! purge type-ahead-buffer print * end subroutine subroutine get_key(key, tmo1, tmo2) integer tmo1, tmo2 character key*1 logical purge/.false./ key=char(0) if (purge) then purge=.false. call sys_get_key(key, tmo1) if (key/=char(0) .and. key/=char(13)) return endif if (tmo2>0) call sys_get_key(key, tmo2) return entry must_purge purge=.true. end subroutine subroutine tplot_close call pgclos call dlog_close_r end subroutine