linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

New TECS Version Sept. 2001 M.Z.

Browse Source
This commit is contained in:
cvs
2001-09-03 14:30:38 +00:00
parent db6c355f44
commit 33e7751176
12 changed files with 797 additions and 514 deletions
Download Patch File Download Diff File Expand all files Collapse all files

418
tecs/tecs_plot.f90
View File

@@ -1,101 +1,114 @@
subroutine tecs_plot(pars, naux)
subroutine tecs_plot(auxpar)
character(len=*) pars ! parameters to plot
integer naux ! number of auxiliary, non-T parameters
character(len=*) auxpar
integer, parameter :: dmax=1000, nmax=5, nmenu=11, chartfreq=1
integer, parameter :: dmax=800, nmax=5, tmax=4, amax=3, nmenu=13, chartperiod=5, naux=1
integer, parameter :: minRange=60, maxRange=7*24*3600
integer, parameter :: oneDay = 24*3600
integer, parameter :: zoom=1, right=2, live=3
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
real*4 ex,ey,fx,fy,row,ticks,tim0,tim1,menuwid
integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday
integer nset
integer ncol, nset, mode
integer first,last,step,tbase,lastj
integer colorList(nmax)/5,3,2,4,8/
integer color(nmax)
integer retLen(nmax)
integer sel/0/, sel1, sel2, auxsel/1/
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 text(2,nmenu)*16/ &
'L' ,'live off' &
,'z' ,'sel. zoom' &
,'+' ,'zoom in' &
,'-' ,'zoom out' &
,'x' ,'show all' &
,'2d' ,'2 days' &
,'1h' ,'1 hour' &
,'15m' ,'15 min' &
,'31.7t','goto date' &
,'c' ,'show P/He/Aux' &
,'s' ,'select T' &
,'f' ,'write file' &
,'q' ,'quit'/
character weekdays(7)*4/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/
character buf*8, device*8, name*40, filnam*128, numb*16
character buf*8, device*8, name*40, filnam*128, numb*16, title*64, pars*64
character(len=4) tpar(tmax)/'Te', 'Tr', 'Tm', 'Ts'/
character(len=4) apar(amax)/'P', 'He', 'Aux'/
character(len=16) parnam(nmax)
external tplot_close
logical gap, done
logical live, xwin, zoom, right, saveit
logical saveit
integer iret, lund, numl, mon, day
! functions
integer sys_gmt_off, myc_now, myc_time, myc_date, tecs_get_data, tecs_get_mult
integer sys_gmt_off, myc_now, myc_time, myc_date, tecs_get_data, tecs_get_mult, tecs_get_par
data window/0./
if (window==0) window=1800.
saveit=.false.
zoom=.false.
right=.true.
mode=live
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 pgqcol(i,ncol)
! print *,i,ncol,' colors ',device
if (ncol>=8 .and. device /= 'VT125') then
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)
endif
call pgask(.false.)
l=0
x1=0
step=0
do i=1,amax
if (auxpar == apar(i)) then
auxsel=i
endif
enddo
1 iret=tecs_get_mult(pars, t, nset, yy0)
1 pars=' '
nset=0
do i=1,tmax
nset=nset+1
color(nset)=colorList(i)
parnam(nset)=tpar(i)
pars=trim(pars)//' '//parnam(nset)
enddo
nset=nset+1
color(nset)=colorList(5)
parnam(nset)=apar(auxsel)
pars=trim(pars)//' '//parnam(nset)
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
else if (mode >= right) then
step=window/(dmax-1)+0.99
last=t
first=t-min(dmax*step-1,nint(window)-step)
else
if (.not. zoom) then
if (mode==zoom) then
x2=(x1+x2+window)/2
x1=x2-window
endif
@@ -106,42 +119,37 @@ subroutine tecs_plot(pars, naux)
endif
if (step == 0) step=1
iret=tecs_get_data(pars, first, last, step, yd, dmax, nmax, retLen)
tbase=first-mod(first,7*oneDay)
iret=tecs_get_data(pars, first, last, step, tbase, xd, 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
x2 = last - tbase
if (mode >= right) then
x1=x2-window
else
x1 = first - tbase;
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)
do i=1,nset
leng=retLen(i)
do while (leng > 1 .and. yd(leng,i) == undef)
leng=leng-1
enddo
if (live .and. leng>0) then
xd(leng,j)=tim0
yd(leng,j)=yy0(j)
if (leng == 1) leng=0
retLen(i)=leng
if (mode==live .and. leng>0) then
xd(leng,i)=tim0
yd(leng,i)=yy0(i)
endif
enddo
if (sel /= 0) then
do while (sel < nset .and. retLen(sel) == 0)
sel=sel+1
enddo
if (sel >= nset) sel = 0
endif
if (saveit) goto 9
if (live) then
if (mode==live) then
x2=max(tim0,x2)+min(1800., window*0.5)
endif
@@ -155,8 +163,15 @@ subroutine tecs_plot(pars, naux)
i1=1
i2=nset-naux
if (sel==0) then
sel1=i1
sel2=i2
else
sel1=sel
sel2=sel
endif
do rl=1,2
if (zoom) then
if (mode==zoom) then
ymin(1)=y1
ymax(1)=y2
else
@@ -164,7 +179,7 @@ subroutine tecs_plot(pars, naux)
ymax(rl)=-1e30
ylast1=ymin(rl)
ylast2=ymax(rl)
do i=i1,i2
do i=sel1,sel2
do j=1,retLen(i)
if (yd(j,i)/=undef) then
ymin(rl)=min(ymin(rl),yd(j,i))
@@ -183,7 +198,7 @@ subroutine tecs_plot(pars, naux)
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
if (mode==live) then
ymin(rl)=min(ymin(rl),max(0.0,ylast1-ey*0.4))
ymax(rl)=max(ymax(rl),ylast2+ey*0.4)
endif
@@ -196,11 +211,10 @@ subroutine tecs_plot(pars, naux)
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
do i=i1,i2
call pgsci(color(i))
lastj=1
do j=1,retLen(i)
@@ -220,22 +234,25 @@ subroutine tecs_plot(pars, naux)
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"
if (retLen(i) > 0) then
name=parnam(i)
if (name=="Tm") then
name="Main Sensor"
elseif (name=="Ts") then
name="Sample Sensor"
elseif (name=="Tr") then
name="SetPoint"
endif
if (sel == i) name=trim(name)//'*'
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
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
else
call pgsch(0.7)
call pgtbox('ZCIST', ticks, 0, 'BCVINMST', 0.0, 0)
call pgtbox('B', 0.0, 0, ' ', 0.0, 0)
@@ -243,39 +260,46 @@ subroutine tecs_plot(pars, naux)
call pgsch(1.0)
if (parnam(nset) == 'P' .or. parnam(nset) == 'p') then
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
elseif (parnam(nset) == 'He') then
title='%'
iret=tecs_get_par('heUnits', title, 0)
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Helium ['//trim(title)//']')
else
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(nset))
endif
endif
i1=nset-naux+1
i2=nset
sel1=i1
sel2=i2
enddo
call pgsch(0.8)
call pgsch(0.7)
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'
if (mode==live) then
text(2,1)='live off'
else
text(1)='live on'
text(2,1)='live on'
endif
ex=0.0
text(2,10)='show '//apar(mod(auxsel,3)+1)
menuwid=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
call pglen(5, trim(text(2,i)), fx, fy)
call pgmtxt('T', 3.0, menuwid, 0.0, '|'//text(1,i))
call pgmtxt('T', 2.5, menuwid, 0.0, '|')
call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,i))
menuwid=menuwid+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=')
call pgmtxt('T', 3.0, menuwid, 0.0, '|')
call pgmtxt('T', 2.5, menuwid, 0.0, '|')
call pgmtxt('T', 2.0, menuwid, 0.0, '|')
menuwid=menuwid+0.01
call pgsch(0.8)
done=.false.
row=(ymax(rl)-ymin(rl))/30.
ey=ymin(rl)-row*3.5
@@ -300,7 +324,7 @@ subroutine tecs_plot(pars, naux)
i=i+1
enddo
if (.not. done) then
n=nint(x2)/oneDay*oneDay;
n=nint(x2)/oneDay*oneDay
i=nint(x1)-n
j=nint(x2)-n
if (i < 0) then
@@ -321,17 +345,29 @@ subroutine tecs_plot(pars, naux)
call pgmtxt('B', 3.5, ex, ex, weekdays(thisday)//buf(7:8)//'.'//buf(5:6))
endif
iret=tecs_get_par('device', title, 0)
if (iret < 0) goto 99
i=index(title, '(')
if (i > 2 ) then
title=title(1:i-1)
else
title='test - no device'
endif
call pgmtxt('T', -1.5, 0.02, 0.0, title)
call pgsclp(1)
call get_key(key, 0, 0) ! purge buffer
call purge_keys ! 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)
7 if (mode==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, chartperiod)
i=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -i)
do while (key == char(0)) ! no key pressed
iret=tecs_get_mult(pars, t, nset, yy1)
@@ -347,9 +383,9 @@ subroutine tecs_plot(pars, naux)
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
do i=i1,i2
if (yy0(i) /= undef .and. yy1(i) /= undef) then
if ((sel==0 .or. sel==i) .and. (yy1(i) < ymin(rl) .or. yy1(i) > ymax(rl))) then
call pgpage
window=x2-x1
goto 1
@@ -366,11 +402,11 @@ subroutine tecs_plot(pars, naux)
tim0=tim1
endif
call get_key(key, 0, chartfreq)
i=chartperiod-mod(myc_now(), chartperiod)
call get_cursor(ex, ey, key, -i)
enddo
else
call pgcurs(ex, ey, key)
call must_purge
call get_cursor(ex, ey, key, 0)
endif
rl=1
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
@@ -378,28 +414,51 @@ subroutine tecs_plot(pars, naux)
8 if (key>='a') key=char(ichar(key)-32)
if (key=='-') then
window=min(window*2, 8.0*oneDay)
if (mode==zoom) then
x1=x1-(x2-x1)/2
x2=x2+(x2-x1)/3
y1=y1-(y2-y1)/2
y2=y2+(y2-y1)/3
endif
elseif (key=='X') then
window=0
live=.false.
mode=0
elseif (key=='+' .or. key==',') then
window=max(winmin,window/2)
if (mode==zoom) then
if (ex==undef) then
ex=(x1+x2)/2
ey=(min(y1,ymax(1))+max(y1,ymin(1)))/2
end if
fx=max(winmin,x2-x1)
fy=max(y2-y1,1e-3,y2*1e-5)
x1=ex-fx/4
x2=ex+fx/4
y1=ey-fy/4
y2=ey+fy/4
endif
elseif (key=='Z') then
call pgsci(1)
if (live) then
if (ex==undef) then
call pgmtxt('T', 0.5, 0.0, 0.0, 'click on two opposite corners of a selection rectangle')
call pgcurs(ex, ey, key)
call get_cursor(ex, ey, key, 0)
else
call pgmtxt('T', 0.5, 0.0, 0.0, 'click on second corner of selection rectangle')
endif
call pgsci(5)
call pgsci(6)
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
call pgmove(xmin, ey)
call pgdraw(xmax, ey)
call pgmove(ex, ymin(rl))
call pgdraw(ex, ymax(rl))
if (device(1:1) .eq. 'X') then
fx=ex
fy=ey
call get_cursor(fx, fy, key, 2)
else
call get_cursor(fx, fy, key, 0)
endif
x1=max(xmin,min(ex,fx))
x2=min(xmax,max(ex,fx))
if (x1>=x2) then
@@ -413,42 +472,36 @@ subroutine tecs_plot(pars, naux)
y1=ymin(1)
y2=ymax(1)
endif
zoom=.true.
live=.false.
right=.false.
mode=zoom
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))
call pgmtxt('T', 2.0, menuwid, 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
! call get_cursor(ex, ey, key, -chartperiod)
! if (key/=char(0)) goto 8
if (mode==zoom) mode=0
goto 7
elseif (key == 'D') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(oneDay*ex)))
right=.true.
if (mode < right) mode=right
x1=0
elseif (key == 'H') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(3600*ex)))
right=.true.
if (mode < right) mode=right
x1=0
elseif (key == 'M') then
ex=1
read(numb, *, iostat=i) ex
window=min(maxRange,max(minRange, nint(60*ex)))
right=.true.
if (mode < right) mode=right
x1=0
elseif (key == 'T' .or. numl>0 .and. (key==char(13) .or. key==char(10))) then
j=index(numb,'.')
@@ -457,27 +510,32 @@ subroutine tecs_plot(pars, naux)
read(numb(1:j-1), *, iostat=i) day
mon=0
read(numb(j+1:numl), *, iostat=i) mon
tbase = myc_time(day+mon*100);
tbase = myc_time(day+mon*100)
else
read(numb, *, iostat=i) day
tbase = myc_time(day);
tbase = myc_time(day)
endif
x1=0
x2=oneDay
window=x2
live=.false.
right=.false.
mode=0
elseif (key == 'L') then
live=.not. live
if (live) then
right=.true.
if (mode == live) then
mode=right
else
mode=live
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 9
elseif (key == 'S') then
sel=sel+1
if (sel > tmax) sel=0
elseif (key == 'C') then
auxsel=auxsel+1
if (auxsel > amax) auxsel=1
elseif (mode==live) then
goto 7
endif
numl=0
@@ -486,8 +544,8 @@ subroutine tecs_plot(pars, naux)
goto 1
99 call tecs_write_msg(6)
9 continue
call tplot_close
call get_key(key, 0, 0) ! purge type-ahead-buffer
call pgclos
call purge_keys
print *
if (saveit) then
lund=41
@@ -525,22 +583,37 @@ subroutine tecs_plot(pars, naux)
end subroutine
subroutine get_key(key, tmo1, tmo2)
integer tmo1, tmo2
character key*1
logical purge/.false./
subroutine get_cursor(x, y, key, mode)
character*1 key
real*4 x, y
integer mode
integer with_timeout/-1/
integer l
character res*32
key=char(0)
if (purge) then
purge=.false.
call sys_get_key(key, tmo1)
if (key/=char(0) .and. key/=char(13)) return
if (with_timeout<0) then
with_timeout=0
call pgqinf('VERSION', res, l)
if (res(l:l)=='+') then
call pgqinf('TYPE', res, l)
if (res(1:1)=='X') then
with_timeout=1
end if
end if
end if
if (with_timeout>0 .or. mode>=0) then
call pgband(mode, 0, x, y, x, y, key)
else
call sys_get_key(key, -mode)
endif
if (tmo2>0) call sys_get_key(key, tmo2)
return
end subroutine
entry must_purge
purge=.true.
subroutine purge_keys
character key*1
key=' '
do while (key/=char(0))
call sys_get_key(key, 0)
end do
end subroutine
subroutine set_win(rl, x1, x2, y1, y2)
@@ -555,8 +628,3 @@ subroutine set_win(rl, x1, x2, y1, y2)
call pgswin(x1,x2,y1,y2)
end subroutine
subroutine tplot_close
call pgclos
! call dlog_close_r
end subroutine