563 lines
13 KiB
Fortran
563 lines
13 KiB
Fortran
subroutine tecs_plot(pars, naux)
|
|
|
|
character(len=*) pars ! parameters to plot
|
|
integer naux ! number of auxiliary, non-T parameters
|
|
|
|
integer, parameter :: dmax=1000, nmax=5, nmenu=11, chartfreq=1
|
|
integer, parameter :: minRange=60, maxRange=7*24*3600
|
|
integer, parameter :: oneDay = 24*3600
|
|
real, parameter :: winmin=60., undef=-1.125/1024./1024./1024.
|
|
|
|
real*4 x1,x2,xmin,xmax,ymin(2),ymax(2),window
|
|
real*4 xd(dmax, nmax),yd(dmax,nmax), yy0(nmax), yy1(nmax)
|
|
real*4 ylast1,ylast2,y1,y2
|
|
real*4 ex,ey,fx,fy,row,ticks,tim0,tim1
|
|
integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday
|
|
integer nset
|
|
integer first,last,step,tbase,lastj
|
|
integer color(nmax)
|
|
integer retLen(nmax)
|
|
character key*1
|
|
character text(nmenu)*12/ &
|
|
'live off','sel. zoom','zoom in','zoom out','show all','n days','n hours','n min','date','file','quit'/
|
|
character keys*(nmenu)/'LZ+-XDHMTFQ'/
|
|
character weekdays(7)*4/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/
|
|
character buf*8, device*8, name*40, filnam*128, numb*16
|
|
character(len=16) parnam(nmax)
|
|
external tplot_close
|
|
logical gap, done
|
|
logical live, xwin, zoom, right, saveit
|
|
integer iret, lund, numl, mon, day
|
|
|
|
! functions
|
|
integer sys_gmt_off, myc_now, myc_time, myc_date, tecs_get_data, tecs_get_mult
|
|
|
|
data window/0./
|
|
|
|
if (window==0) window=1800.
|
|
saveit=.false.
|
|
zoom=.false.
|
|
right=.true.
|
|
call pgopen(" ")
|
|
|
|
call pgscr(0, 1.0, 1.0, 1.0)
|
|
call pgscr(1, 0.0, 0.0, 0.0)
|
|
call pgscr(2, 1.0, 0.0, 0.0)
|
|
call pgscr(3, 0.0, 1.0, 0.0)
|
|
call pgscr(4, 0.0, 0.0, 1.0)
|
|
call pgscr(5, 0.0, 1.0, 1.0)
|
|
call pgscr(6, 1.0, 0.0, 1.0)
|
|
call pgscr(7, 1.0, 1.0, 0.0)
|
|
call pgscr(8, 1.0, 0.5, 0.0)
|
|
|
|
call pgqinf('TYPE', device, l)
|
|
if (device=='NULL') then
|
|
print *,'No PGPLOT-Device defined'
|
|
goto 9
|
|
endif
|
|
live=device(1:1)/='X' ! live switched off by default on X-Windows
|
|
|
|
nset=1
|
|
l=1
|
|
i=1
|
|
do while (i <= nmax)
|
|
do while (l < len(pars) .and. pars(l:l) <= ' ')
|
|
l=l+1
|
|
enddo
|
|
if (pars(l:l) > ' ') then
|
|
j=l
|
|
do while (l < len(pars) .and. pars(l:l) > ' ')
|
|
l=l+1
|
|
enddo
|
|
parnam(i)=pars(j:l)
|
|
nset=i
|
|
if (l == len(pars)) i=nmax
|
|
else
|
|
i=nmax
|
|
endif
|
|
i=i+1
|
|
enddo
|
|
|
|
call pgask(.false.)
|
|
l=0
|
|
x1=0
|
|
step=0
|
|
|
|
1 iret=tecs_get_mult(pars, t, nset, yy0)
|
|
if (iret < 0) goto 99
|
|
if (window == 0) then
|
|
last=t
|
|
step=maxRange/dmax
|
|
window=maxRange
|
|
first=t-min(dmax*step-1,maxRange-step)
|
|
else if (right .or. live) then
|
|
step=window/(dmax-1)+0.99
|
|
last=t
|
|
first=t-min(dmax*step-1,nint(window)-step)
|
|
else
|
|
if (.not. zoom) then
|
|
x2=(x1+x2+window)/2
|
|
x1=x2-window
|
|
endif
|
|
if (x1 .gt. x2-minRange) x1=x2-minRange
|
|
step=(x2-x1)/(dmax-1)+0.99
|
|
last=nint(x2)+tbase
|
|
first=nint(x1)+tbase
|
|
endif
|
|
if (step == 0) step=1
|
|
|
|
iret=tecs_get_data(pars, first, last, step, yd, dmax, nmax, retLen)
|
|
if (iret < 0) goto 99
|
|
! do i=1,nmax
|
|
! if (retLen(i) > 0) nset=i
|
|
! enddo
|
|
! if (nset == 0) then
|
|
! retLen(1)=0
|
|
! nset=1
|
|
! endif
|
|
color(1)=2
|
|
color(2)=4
|
|
color(3)=3
|
|
color(4)=5
|
|
color(5)=8
|
|
if (naux > 0) color(nset)=8
|
|
|
|
tbase=first-mod(first,7*oneDay);
|
|
x2 = last - tbase;
|
|
if (right .or. live) then
|
|
x1=x2-window
|
|
else
|
|
x1 = first - tbase;
|
|
endif
|
|
tim0=t-tbase
|
|
do j=1,nset
|
|
leng=retLen(j)
|
|
do i=1,leng
|
|
xd(i,j)=(float(i-1)*(last-tbase)+float(leng-i)*(first-tbase))/(leng-1)
|
|
enddo
|
|
if (live .and. leng>0) then
|
|
xd(leng,j)=tim0
|
|
yd(leng,j)=yy0(j)
|
|
endif
|
|
enddo
|
|
if (saveit) goto 9
|
|
if (live) then
|
|
x2=max(tim0,x2)+min(1800., window*0.5)
|
|
endif
|
|
|
|
if (window>50*3600) then
|
|
ticks=8*3600
|
|
elseif (window>25*3600) then
|
|
ticks=4*3600
|
|
else
|
|
ticks=0.0 ! automatic
|
|
endif
|
|
|
|
i1=1
|
|
i2=nset-naux
|
|
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,retLen(i)
|
|
if (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,retLen(i)-4),retLen(i)
|
|
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))
|
|
ymax(rl)=ymax(rl)+max(fy*0.0075,ey*0.01)
|
|
ymin(rl)=ymin(rl)-max(fy*0.005,ey*0.01)
|
|
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) < ymin(rl)) then
|
|
ymax(rl)=1.0
|
|
ymin(rl)=0
|
|
elseif (ymax(rl) == ymin(rl)) then
|
|
ymax(rl)=ymin(rl)*1.00001+1.0
|
|
ymin(rl)=-1.0e-3
|
|
endif
|
|
zoom=.false.
|
|
|
|
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
do i=i2,i1,-1
|
|
call pgsci(color(i))
|
|
lastj=1
|
|
do j=1,retLen(i)
|
|
if (yd(j,i)==undef) then
|
|
if (j>lastj) then
|
|
call pgline(j-lastj, xd(lastj,i), yd(lastj,i))
|
|
endif
|
|
lastj=j+1
|
|
endif
|
|
enddo
|
|
if (retLen(i) > lastj) call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i))
|
|
enddo
|
|
call pgsci(1)
|
|
if (rl == 1) then
|
|
call pgsch(1.0)
|
|
call pgtbox('ZHXYBINST', ticks, 0, 'BCINMST', 0.0, 0)
|
|
call pgtbox('C', 0.0, 0, ' ', 0.0, 0)
|
|
ey=0.0
|
|
do i=i1,i2
|
|
name=parnam(i)
|
|
if (name=="Tm") then
|
|
name="Main Sensor"
|
|
elseif (name=="Ts") then
|
|
name="Sample Sensor"
|
|
elseif (name=="Tr") then
|
|
name="SetPoint"
|
|
endif
|
|
call pglen(5, trim(name), fx, fy)
|
|
call pgsci(color(i))
|
|
call pgmtxt ('L', 2.5, ey, 0.0, trim(name))
|
|
ey=ey+fy+0.04
|
|
enddo
|
|
call pgsci(1)
|
|
call pgmtxt ('L', 2.5, ey, 0.0, 'T [K]')
|
|
else if (naux > 0) then
|
|
call pgsch(0.7)
|
|
call pgtbox('ZCIST', ticks, 0, 'BCVINMST', 0.0, 0)
|
|
call pgtbox('B', 0.0, 0, ' ', 0.0, 0)
|
|
call pgsci(color(nset))
|
|
call pgsch(1.0)
|
|
if (parnam(nset) == 'P' .or. parnam(nset) == 'p') then
|
|
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
|
|
else
|
|
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset))
|
|
endif
|
|
endif
|
|
i1=nset-naux+1
|
|
i2=nset
|
|
enddo
|
|
|
|
call pgsch(0.8)
|
|
rl=1
|
|
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
call pgsci(1)
|
|
call pgsclp(0)
|
|
if (live) then
|
|
text(1)='live off'
|
|
else
|
|
text(1)='live on'
|
|
endif
|
|
ex=0.0
|
|
do i=1,nmenu
|
|
call pglen(5, trim(text(i)), fx, fy)
|
|
call pgmtxt('T', 3.0, ex, 0.0, '|'//keys(i:i))
|
|
call pgmtxt('T', 2.5, ex, 0.0, '|')
|
|
call pgmtxt('T', 2.0, ex, 0.0, '|'//text(i))
|
|
ex=ex+fx+0.01
|
|
enddo
|
|
call pgmtxt('T', 3.0, ex, 0.0, '|')
|
|
call pgmtxt('T', 2.5, ex, 0.0, '|')
|
|
call pgmtxt('T', 2.0, ex, 0.0, '|')
|
|
call pgmtxt('T', 3.0, 0.8, 0.0, 'any digit to enter n')
|
|
call pgmtxt('T', 2.0, 0.8, 0.0, 'n=')
|
|
|
|
done=.false.
|
|
row=(ymax(rl)-ymin(rl))/30.
|
|
ey=ymin(rl)-row*3.5
|
|
i=max(0,int((x1+oneDay/2)/oneDay))
|
|
|
|
do
|
|
ex=(i+0.5)*oneDay
|
|
if (ex > x2) EXIT
|
|
done=.true.
|
|
write(buf,'(i8.8)') myc_date(nint(ex)+tbase)
|
|
call pgptxt(ex, ey, 0.0, 0.5, weekdays(mod(i,7)+1)//buf(7:8)//'.'//buf(5:6))
|
|
ex=ex-12*3600
|
|
if (ex > x1) then
|
|
call pgmove(ex, ey)
|
|
call pgdraw(ex, ey+row)
|
|
endif
|
|
ex=ex+oneDay
|
|
if (ex < x2) then
|
|
call pgmove(ex, ey)
|
|
call pgdraw(ex, ey+row)
|
|
endif
|
|
i=i+1
|
|
enddo
|
|
if (.not. done) then
|
|
n=nint(x2)/oneDay*oneDay;
|
|
i=nint(x1)-n
|
|
j=nint(x2)-n
|
|
if (i < 0) then
|
|
if (-i > j) then
|
|
ex=0.0
|
|
i=nint(x1)+tbase
|
|
else
|
|
ex=1.0
|
|
i=nint(x2)+tbase
|
|
endif
|
|
else
|
|
ex=0.5
|
|
i=nint(x2)+tbase
|
|
endif
|
|
thisday=mod(i/oneDay,7)+1
|
|
write(buf,'(i8.8)') myc_date(i)
|
|
! call pgptxt((x1+x2)/2, ey, 0.0, ex, weekdays(mod(thisday,7)+1)//buf(7:8)//'.'//buf(5:6))
|
|
call pgmtxt('B', 3.5, ex, ex, weekdays(thisday)//buf(7:8)//'.'//buf(5:6))
|
|
endif
|
|
|
|
call pgsclp(1)
|
|
|
|
call get_key(key, 0, 0) ! purge buffer
|
|
|
|
numl=0
|
|
numb=' '
|
|
7 if (live) then
|
|
if (device(1:1)=='X') then
|
|
call pgmtxt('T', 0.5, 0.0, 0.0, 'LIVE MODE (click on text window before pressing any further key)')
|
|
endif
|
|
call get_key(key, 0, chartfreq)
|
|
|
|
do while (key == char(0)) ! no key pressed
|
|
iret=tecs_get_mult(pars, t, nset, yy1)
|
|
if (iret<0) goto 99
|
|
tim1=t-tbase
|
|
if (tim1 > x2) then
|
|
call pgpage
|
|
window=x2-x1
|
|
goto 1
|
|
endif
|
|
if (tim1 > tim0) then
|
|
i1=1
|
|
i2=nset-naux
|
|
do rl=1,2
|
|
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
do i=i2,i1,-1
|
|
if (yy0(i) .ne. undef .and. yy1(i) .ne. undef) then
|
|
if (yy1(i) < ymin(rl) .or. yy1(i) > ymax(rl)) then
|
|
call pgpage
|
|
window=x2-x1
|
|
goto 1
|
|
endif
|
|
call pgsci(color(i))
|
|
call pgmove(tim0, yy0(i))
|
|
call pgdraw(tim1, yy1(i))
|
|
endif
|
|
yy0(i)=yy1(i)
|
|
enddo
|
|
i1=nset-naux+1
|
|
i2=nset
|
|
enddo
|
|
tim0=tim1
|
|
|
|
endif
|
|
call get_key(key, 0, chartfreq)
|
|
enddo
|
|
else
|
|
call pgcurs(ex, ey, key)
|
|
call must_purge
|
|
endif
|
|
rl=1
|
|
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
8 if (key>='a') key=char(ichar(key)-32)
|
|
if (key=='-') then
|
|
window=min(window*2, 8.0*oneDay)
|
|
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', 0.5, 0.0, 0.0, 'click on two opposite corners of a selection rectangle')
|
|
call pgcurs(ex, ey, key)
|
|
else
|
|
call pgmtxt('T', 0.5, 0.0, 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 >= '0' .and. key <= '9' .or. key == '.') then ! number
|
|
if (numl .lt. len(numb)) then
|
|
numl=numl+1
|
|
numb(numl:numl)=key
|
|
call pgsci(1)
|
|
call pgsch(0.8)
|
|
call pgmtxt('T', 2.0, 0.825, 0.0, numb(1:numl))
|
|
endif
|
|
if (device(1:1)=='X' .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 == 'D') then
|
|
ex=1
|
|
read(numb, *, iostat=i) ex
|
|
window=min(maxRange,max(minRange, nint(oneDay*ex)))
|
|
right=.true.
|
|
x1=0
|
|
elseif (key == 'H') then
|
|
ex=1
|
|
read(numb, *, iostat=i) ex
|
|
window=min(maxRange,max(minRange, nint(3600*ex)))
|
|
right=.true.
|
|
x1=0
|
|
elseif (key == 'M') then
|
|
ex=1
|
|
read(numb, *, iostat=i) ex
|
|
window=min(maxRange,max(minRange, nint(60*ex)))
|
|
right=.true.
|
|
x1=0
|
|
elseif (key == 'T' .or. numl>0 .and. (key==char(13) .or. key==char(10))) then
|
|
j=index(numb,'.')
|
|
day=0
|
|
if (j > 1 .and. j < numl) then
|
|
read(numb(1:j-1), *, iostat=i) day
|
|
mon=0
|
|
read(numb(j+1:numl), *, iostat=i) mon
|
|
tbase = myc_time(day+mon*100);
|
|
else
|
|
read(numb, *, iostat=i) day
|
|
tbase = myc_time(day);
|
|
endif
|
|
x1=0
|
|
x2=oneDay
|
|
window=x2
|
|
live=.false.
|
|
right=.false.
|
|
elseif (key == 'L') then
|
|
live=.not. live
|
|
if (live) then
|
|
right=.true.
|
|
endif
|
|
elseif (key == 'F') then
|
|
saveit=.true.
|
|
elseif (key=='Q' .or. key==char(13) .or. key==char(10)) then
|
|
goto 9
|
|
elseif (key == 'R') then
|
|
elseif (live) then
|
|
goto 7
|
|
endif
|
|
numl=0
|
|
numb=' '
|
|
call pgpage
|
|
goto 1
|
|
99 call tecs_write_msg(6)
|
|
9 continue
|
|
call tplot_close
|
|
call get_key(key, 0, 0) ! purge type-ahead-buffer
|
|
print *
|
|
if (saveit) then
|
|
lund=41
|
|
print '(x,a,$)', 'Filename: '
|
|
read(*,'(a)') filnam
|
|
open(lund, file=filnam, status='unknown', carriagecontrol='list')
|
|
|
|
gap=.false.
|
|
do j=1,nset
|
|
if (j == 1) then
|
|
write(lund, *) ' time [h]',char(9),' Tm [K]'
|
|
elseif (j == 2) then
|
|
write(lund,*)
|
|
write(lund, *) ' time [h]',char(9),' Ts [K]'
|
|
else
|
|
write(lund,*)
|
|
write(lund, *) ' time [h]',char(9), ' ',trim(parnam(j))
|
|
endif
|
|
|
|
do i=1,retLen(j)
|
|
if (yd(i,j)==undef) then
|
|
if (gap) then
|
|
write(lund, '(f9.4,2a)') xd(i,j)/3600., char(9), ' '
|
|
gap=.false.
|
|
endif
|
|
else
|
|
write(lund, '(f9.4,a,f9.4)') xd(i,j)/3600., char(9), max(-999.,min(9999.,yd(i,j)))
|
|
gap=.true.
|
|
endif
|
|
enddo
|
|
enddo
|
|
close(lund)
|
|
print *, retLen(1)+1, ' lines written to ',filnam(1:48)
|
|
endif
|
|
|
|
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 set_win(rl, x1, x2, y1, y2)
|
|
integer rl
|
|
real x1, x2, y1, y2
|
|
|
|
if (rl == 1) then
|
|
call pgsvp(0.07,0.93,0.3,0.9)
|
|
else
|
|
call pgsvp(0.07,0.93,0.01,0.20)
|
|
endif
|
|
|
|
call pgswin(x1,x2,y1,y2)
|
|
end subroutine
|
|
|
|
subroutine tplot_close
|
|
call pgclos
|
|
! call dlog_close_r
|
|
end subroutine
|