M.Z.
This commit is contained in:
cvs
711
tecs/tecs_plot.f
711
tecs/tecs_plot.f
@ -1,711 +0,0 @@
|
|||||||
subroutine tecs_plot(auxpar)
|
|
||||||
|
|
||||||
character(len=*) auxpar
|
|
||||||
|
|
||||||
integer dmax, nmax, tmax, amax, nmenu, chartperiod, naux
|
|
||||||
parameter (dmax=400, nmax=9, tmax=8, amax=3, nmenu=13, chartperiod=5, naux=1)
|
|
||||||
integer minRange, maxRange, oneDay
|
|
||||||
parameter (minRange=60, maxRange=7*24*3600, oneDay=24*3600)
|
|
||||||
integer zoom, right, live
|
|
||||||
parameter (zoom=1, right=2, live=3)
|
|
||||||
real winmin, undef
|
|
||||||
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,menuwid
|
|
||||||
integer l,j,i,n,t,leng,i1,i2,rl,startday,thisday
|
|
||||||
integer ncol, nset, mode
|
|
||||||
integer first,last,step,tbase,lastj
|
|
||||||
integer colorList(nmax)/5,3,2,4,6,8,14,15,8/
|
|
||||||
integer color(nmax)
|
|
||||||
integer retLen(nmax)
|
|
||||||
integer sel/0/, sel1, sel2, auxsel/1/
|
|
||||||
character key*1
|
|
||||||
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, title*64, pars*64
|
|
||||||
character(len=4) tpar(tmax)/'Te', 'Tr', 'Tm', 'Ts', 'T1', 'T2', 'T3', 'T4'/
|
|
||||||
character(len=4) apar(amax)/'P', 'He', 'Aux'/
|
|
||||||
character(len=16) parnam(nmax)
|
|
||||||
logical gap, done
|
|
||||||
logical saveit
|
|
||||||
integer iret, lund, numl, mon, day
|
|
||||||
integer pars_len, title_len, text_len, name_len
|
|
||||||
|
|
||||||
! functions
|
|
||||||
integer sys_gmt_off, myc_now, myc_time, myc_date, get_data, tecs_get_mult, tecs_get_par
|
|
||||||
|
|
||||||
data window/0./
|
|
||||||
|
|
||||||
if (window==0) window=1800.
|
|
||||||
saveit=.false.
|
|
||||||
mode=live
|
|
||||||
call pgopen(' ')
|
|
||||||
|
|
||||||
call pgqinf('TYPE', device, l)
|
|
||||||
if (device=='NULL') then
|
|
||||||
call pgclos
|
|
||||||
call pgopen('?')
|
|
||||||
call pgqinf('TYPE', device, l)
|
|
||||||
if (device=='NULL') then
|
|
||||||
print *,'No PGPLOT-Device defined'
|
|
||||||
goto 9
|
|
||||||
endif
|
|
||||||
endif
|
|
||||||
|
|
||||||
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.)
|
|
||||||
call pgupdt
|
|
||||||
l=0
|
|
||||||
x1=0
|
|
||||||
step=0
|
|
||||||
do i=1,amax
|
|
||||||
if (auxpar == apar(i)) then
|
|
||||||
auxsel=i
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
|
|
||||||
1 pars=' '
|
|
||||||
nset=0
|
|
||||||
do i=1,tmax
|
|
||||||
nset=nset+1
|
|
||||||
color(nset)=colorList(i)
|
|
||||||
parnam(nset)=tpar(i)
|
|
||||||
call str_trim(pars, pars, pars_len)
|
|
||||||
pars=pars(1:pars_len)//' '//parnam(nset)
|
|
||||||
enddo
|
|
||||||
nset=nset+1
|
|
||||||
color(nset)=colorList(3)
|
|
||||||
parnam(nset)=apar(auxsel)
|
|
||||||
call str_trim(pars, pars, pars_len)
|
|
||||||
pars=pars(1:pars_len)//' '//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 (mode >= right) then
|
|
||||||
step=window/(dmax-2)+0.99
|
|
||||||
last=t
|
|
||||||
first=t-min(dmax*step-1,nint(window))
|
|
||||||
else
|
|
||||||
if (mode==zoom) then
|
|
||||||
x2=(x1+x2+window)/2
|
|
||||||
x1=x2-window
|
|
||||||
endif
|
|
||||||
if (x1 .gt. x2-minRange) x1=x2-minRange
|
|
||||||
step=(x2-x1)/(dmax-2)+0.99
|
|
||||||
last=x2+tbase
|
|
||||||
first=x1-step+tbase
|
|
||||||
endif
|
|
||||||
if (step == 0) step=1
|
|
||||||
|
|
||||||
if (step>60) then ! normalize step
|
|
||||||
step=(step+59)/60*60
|
|
||||||
else if (step>30) then
|
|
||||||
step=60
|
|
||||||
elseif (step>20) then
|
|
||||||
step=30
|
|
||||||
else
|
|
||||||
step=(step+4)/5*5
|
|
||||||
endif
|
|
||||||
first=last-(last-first+step-1)/step*step ! round first
|
|
||||||
! print *,step,last-first
|
|
||||||
tbase=first-mod(first,7*oneDay)
|
|
||||||
iret=get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retLen)
|
|
||||||
if (iret < 0) goto 99
|
|
||||||
|
|
||||||
x2 = last - tbase
|
|
||||||
if (mode >= right) then
|
|
||||||
x1=x2-window
|
|
||||||
else
|
|
||||||
x1 = first - tbase
|
|
||||||
endif
|
|
||||||
tim0=t-tbase
|
|
||||||
do i=1,nset
|
|
||||||
leng=retLen(i)
|
|
||||||
do while (leng > 1 .and. yd(leng,i) == undef)
|
|
||||||
leng=leng-1
|
|
||||||
enddo
|
|
||||||
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 (mode==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
|
|
||||||
if (sel==0) then
|
|
||||||
sel1=i1
|
|
||||||
sel2=i2
|
|
||||||
else
|
|
||||||
sel1=sel
|
|
||||||
sel2=sel
|
|
||||||
endif
|
|
||||||
do rl=1,2
|
|
||||||
if (mode==zoom .and. rl==1) then
|
|
||||||
ymin(1)=y1
|
|
||||||
ymax(1)=y2
|
|
||||||
else
|
|
||||||
ymin(rl)=1e30
|
|
||||||
ymax(rl)=-1e30
|
|
||||||
ylast1=ymin(rl)
|
|
||||||
ylast2=ymax(rl)
|
|
||||||
do i=sel1,sel2
|
|
||||||
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 (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
|
|
||||||
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
|
|
||||||
|
|
||||||
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
||||||
|
|
||||||
do i=i1,i2
|
|
||||||
call pgsci(color(i))
|
|
||||||
l=0
|
|
||||||
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
|
|
||||||
else
|
|
||||||
l=j
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
if (retLen(i) > lastj) call pgline(retLen(i)+1-lastj, xd(lastj,i), yd(lastj,i))
|
|
||||||
retLen(i)=l
|
|
||||||
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
|
|
||||||
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
|
|
||||||
call str_trim(name, name, name_len)
|
|
||||||
if (sel == i) then
|
|
||||||
name=name(1:name_len)//'*'
|
|
||||||
call str_trim(name, name, name_len)
|
|
||||||
endif
|
|
||||||
call pglen(5, name(1:name_len), fx, fy)
|
|
||||||
call pgsci(color(i))
|
|
||||||
call pgmtxt ('L', 2.5, ey, 0.0, name(1:name_len))
|
|
||||||
ey=ey+fy+0.04
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
call pgsci(1)
|
|
||||||
call pgmtxt ('L', 2.5, ey, 0.0, 'T [K]')
|
|
||||||
else
|
|
||||||
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]')
|
|
||||||
elseif (parnam(nset) == 'He') then
|
|
||||||
title='%'
|
|
||||||
iret=tecs_get_par('heUnits', title, 0)
|
|
||||||
call str_trim(title, title, title_len)
|
|
||||||
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Helium ['//title(1:title_len)//']')
|
|
||||||
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.7)
|
|
||||||
rl=1
|
|
||||||
call set_win(rl,x1,x2,ymin(rl),ymax(rl))
|
|
||||||
|
|
||||||
call pgsci(1)
|
|
||||||
call pgsclp(0)
|
|
||||||
if (mode==live) then
|
|
||||||
text(2,1)='live off'
|
|
||||||
else
|
|
||||||
text(2,1)='live on'
|
|
||||||
endif
|
|
||||||
text(2,10)='show '//apar(mod(auxsel,3)+1)
|
|
||||||
menuwid=0.0
|
|
||||||
do i=1,nmenu
|
|
||||||
call str_trim(text(2,i), text(2,i), text_len)
|
|
||||||
call pglen(5, text(2,i)(1:text_len), 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, 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
|
|
||||||
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
|
|
||||||
|
|
||||||
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 purge_keys ! purge buffer
|
|
||||||
|
|
||||||
numl=0
|
|
||||||
numb=' '
|
|
||||||
7 ex=undef
|
|
||||||
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) .or. key == ' ') ! no key or space 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=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
|
|
||||||
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
|
|
||||||
i=chartperiod-mod(myc_now(), chartperiod)
|
|
||||||
call get_cursor(ex, ey, key, -i)
|
|
||||||
enddo
|
|
||||||
else
|
|
||||||
call get_cursor(ex, ey, key, 0)
|
|
||||||
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)
|
|
||||||
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
|
|
||||||
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(y2,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 (ex==undef) then
|
|
||||||
call pgmtxt('T', 0.5, 0.0, 0.0, 'click on two opposite corners of a selection rectangle')
|
|
||||||
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(6)
|
|
||||||
xmin=x1
|
|
||||||
xmax=x2
|
|
||||||
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
|
|
||||||
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
|
|
||||||
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, menuwid, 0.0, numb(1:numl))
|
|
||||||
endif
|
|
||||||
! 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)))
|
|
||||||
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)))
|
|
||||||
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)))
|
|
||||||
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,'.')
|
|
||||||
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
|
|
||||||
mode=0
|
|
||||||
elseif (key == 'L') then
|
|
||||||
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 == 'S') then
|
|
||||||
sel=sel+1
|
|
||||||
if (sel > tmax) sel=0
|
|
||||||
if (mode==zoom) mode=0
|
|
||||||
elseif (key == 'C') then
|
|
||||||
auxsel=auxsel+1
|
|
||||||
if (auxsel > amax) auxsel=1
|
|
||||||
elseif (mode==live) then
|
|
||||||
goto 7
|
|
||||||
endif
|
|
||||||
numl=0
|
|
||||||
numb=' '
|
|
||||||
call pgpage
|
|
||||||
goto 1
|
|
||||||
99 call tecs_write_msg(6)
|
|
||||||
9 continue
|
|
||||||
call pgclos
|
|
||||||
call purge_keys
|
|
||||||
print *
|
|
||||||
if (saveit) then
|
|
||||||
lund=41
|
|
||||||
print '(x,a,$)', 'Filename: '
|
|
||||||
read(*,'(a)') filnam
|
|
||||||
open(lund, file=filnam, status='unknown') ! , carriagecontrol='list')
|
|
||||||
|
|
||||||
l=0
|
|
||||||
i2=0
|
|
||||||
do i1=1,nset
|
|
||||||
if (i1 > nset-naux) then
|
|
||||||
j=i1
|
|
||||||
else
|
|
||||||
j=nset-i1+(1-naux)
|
|
||||||
endif
|
|
||||||
|
|
||||||
gap=.false.
|
|
||||||
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
|
|
||||||
if (i2/=i1) then
|
|
||||||
if (l > 0) write(lund, *)
|
|
||||||
call str_trim(parnam(j), parnam(j), text_len)
|
|
||||||
write(lund, *) ' time [h]',char(9), ' ',parnam(j)(1:text_len)
|
|
||||||
l=l+1
|
|
||||||
i2=i1
|
|
||||||
endif
|
|
||||||
write(lund, '(f9.4,a,f9.4)') xd(i,j)/3600., char(9), max(-999.,min(9999.,yd(i,j)))
|
|
||||||
l=l+1
|
|
||||||
gap=.true.
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
enddo
|
|
||||||
close(lund)
|
|
||||||
print *, l, ' lines written to ',filnam(1:48)
|
|
||||||
endif
|
|
||||||
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
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
|
|
||||||
end subroutine
|
|
||||||
|
|
||||||
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)
|
|
||||||
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
|
|
||||||
|
|
||||||
integer function get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retlen)
|
|
||||||
character pars*(*)
|
|
||||||
integer first, last, step, tbase, dmax, nmax, retlen(nmax)
|
|
||||||
real*4 xd(dmax,nmax), yd(dmax,nmax)
|
|
||||||
|
|
||||||
integer oneDay, maxn
|
|
||||||
parameter (oneDay = 24*3600, maxn=9)
|
|
||||||
integer tecs_get_data
|
|
||||||
|
|
||||||
integer i,j,rl(maxn),m,k,n,mm
|
|
||||||
|
|
||||||
if (nmax > maxn) stop 'get_data: nmax>maxn'
|
|
||||||
if (last-first <= oneDay) then
|
|
||||||
get_data=tecs_get_data(pars, first, last, step, tbase, xd, yd, dmax, nmax, retLen)
|
|
||||||
else
|
|
||||||
do j=1,nmax
|
|
||||||
retlen(j)=0
|
|
||||||
enddo
|
|
||||||
m=0
|
|
||||||
do i=first/oneDay,last/oneDay
|
|
||||||
get_data=tecs_get_data(pars, max(first,i*oneDay), min(last,(i+1)*oneDay-step), step, tbase &
|
|
||||||
, xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl)
|
|
||||||
if (get_data<0) return
|
|
||||||
mm=0
|
|
||||||
do j=1,nmax
|
|
||||||
n=retlen(j)
|
|
||||||
do k=m+1,m+rl(j)
|
|
||||||
n=n+1
|
|
||||||
xd(n,j)=xd(k,j)
|
|
||||||
yd(n,j)=yd(k,j)
|
|
||||||
enddo
|
|
||||||
retlen(j)=n
|
|
||||||
mm=max(mm,n)
|
|
||||||
enddo
|
|
||||||
! print *,mm-m,' points read'
|
|
||||||
m=mm
|
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
end function
|
|
||||||
Reference in New Issue
Block a user