420 lines
10 KiB
Fortran
420 lines
10 KiB
Fortran
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)<ymin(rl) .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
|