1014 lines
23 KiB
Fortran
1014 lines
23 KiB
Fortran
subroutine tecs_plot(reserved)
|
|
|
|
character*(*) reserved
|
|
|
|
integer dmax, nmax, nmenu, chartperiod, naux, nwin
|
|
parameter (dmax=1024, nmax=12, nmenu=13, nwin=4
|
|
1 , chartperiod=5, naux=1)
|
|
! dmax*nmax*4 should be less than COC_RES_LEN in coc_util.h
|
|
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(nwin),ymax(nwin),window
|
|
real*4 xd(dmax, nmax),yd(dmax,nmax), yy0(nmax), yy1(nmax)
|
|
real*4 ylast1,ylast2
|
|
real*4 y1/0.0/,y2/0.0/
|
|
real*4 ex,ey,fx,fy,row,ticks,tim0,tim1,menuwid
|
|
real*4 dx,dy
|
|
real*4 ylim(nmax) ! limits of sensor label text
|
|
integer l,j,n,t,leng,i1,i2,rl,startday,thisday
|
|
integer iostat
|
|
integer nset
|
|
integer ncol, mode
|
|
integer is ! 1...nset
|
|
integer im ! 1...nmax
|
|
integer first,last,step,tbase,lastj
|
|
integer retLen(nmax)
|
|
logical focus(nmax)/3*.true.,9*.false./
|
|
logical omit(nmax)/12*.false./
|
|
logical fixleft/.false./
|
|
logical yzoom
|
|
integer winconf(nwin) ! number of windows below actual
|
|
integer showsets
|
|
integer nextfocus
|
|
real winh
|
|
integer nticks
|
|
character key*1
|
|
character text(2,nmenu)*16/
|
|
1 'L' ,'live off'
|
|
1 ,'z' ,'sel. zoom'
|
|
1 ,'+' ,'zoom in'
|
|
1 ,'-' ,'zoom out'
|
|
1 ,'2d' ,'2 days'
|
|
1 ,'1h' ,'1 hour'
|
|
1 ,'15m' ,'15 min'
|
|
1 ,'31.7t','goto date'
|
|
1 ,'a' ,'all chan'
|
|
1 ,'c' ,'clear chan'
|
|
1 ,'s' ,'focus'
|
|
1 ,'f' ,'write file'
|
|
1 ,'q' ,'quit'/
|
|
character weekdays(7)*4/
|
|
1 'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/
|
|
character buf*8, device*8, name*40, filnam*128, numb*16
|
|
character title*64, pars*64, allpars*64
|
|
character*4 parnam(nmax)
|
|
1 /'Tm','Ts','Tr','Te','Tk','T1','T2','T3','T4','P','He','Aux'/
|
|
integer unit(nmax)
|
|
1 / 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 4/ ! 1: Kelvin, 2: Watt, 3: %, 4: other
|
|
integer color(nmax)
|
|
1 / 2, 4, 3, 5, 6, 8, 14, 15, 13, 2, 2, 2/
|
|
integer isx(nmax)/12*1/ ! at begin all channels selected
|
|
integer imx(nmax)
|
|
save imx
|
|
integer idx(nmax)
|
|
logical gap, done
|
|
logical saveit
|
|
integer iret, lund, numl, mon, day
|
|
integer pars_len, title_len, text_len, name_len
|
|
character line*132
|
|
real x0
|
|
logical loop
|
|
integer tdif
|
|
integer fact
|
|
|
|
! functions
|
|
integer myc_now, myc_time, myc_date, get_data
|
|
integer tecs_get_mult, tecs_get_par
|
|
integer pgopen
|
|
|
|
data window/0./
|
|
|
|
fact=1
|
|
read(reserved, *, iostat=iostat) fact
|
|
if (fact .lt. 1) fact=1
|
|
if (window .eq. 0) window=1800.
|
|
saveit=.false.
|
|
mode=live
|
|
yzoom=.false.
|
|
iret=pgopen(' ')
|
|
|
|
call pgqinf('TYPE', device, l)
|
|
if (device .eq. 'NULL' .or. iret .le. 0) then
|
|
call pgclos
|
|
iret=pgopen('?')
|
|
call pgqinf('TYPE', device, l)
|
|
if (device .eq. 'NULL' .or. iret .le. 0) then
|
|
print *,'No PGPLOT-Device defined'
|
|
goto 9
|
|
endif
|
|
call sys_setenv('PGPLOT_DEV', '/'//device)
|
|
endif
|
|
|
|
call pgqcol(j,ncol)
|
|
! print *,j,ncol,' colors ',device
|
|
if (ncol .ge. 8 .and. device .ne. '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
|
|
allpars=' '
|
|
do im=1,nmax
|
|
call str_trim(allpars, allpars, l)
|
|
allpars=allpars(1:l)//' '//parnam(im)
|
|
enddo
|
|
showsets=1
|
|
nextfocus=0
|
|
|
|
1 continue
|
|
|
|
iret=tecs_get_mult(allpars, t, nmax, yy1)
|
|
if (iret .lt. 0) goto 99
|
|
tdif=myc_now()-t
|
|
tdif=tdif-mod(tdif+1800*25, 3600)+1800 ! round to next full hour
|
|
if (tdif .gt. 7200 .or. tdif .lt. -7200) then ! a hack
|
|
t=myc_now()
|
|
tdif=0
|
|
endif
|
|
if (tdif .ne. 0) then
|
|
print *,'time difference ',tdif/3600,' h'
|
|
endif
|
|
t=t+tdif
|
|
if (showsets .eq. 1) then ! select only channels which have NOW a signal
|
|
do im=1,nmax
|
|
if (isx(im) .eq. 0 .and. yy1(im) .ne. undef) then
|
|
isx(im)=1
|
|
endif
|
|
enddo
|
|
else if (showsets .eq. 2) then ! select all channels
|
|
do im=1,nmax
|
|
isx(im)=1
|
|
focus(im)=unit(im) .eq. 1
|
|
enddo
|
|
endif
|
|
is=0
|
|
pars=' '
|
|
do im=1,nmax
|
|
if (omit(im)) then
|
|
isx(im)=0
|
|
omit(im)=.false.
|
|
else if (isx(im) .ne. 0) then
|
|
is=is+1
|
|
isx(im)=is
|
|
imx(is)=im
|
|
call str_trim(pars, pars, pars_len)
|
|
pars=pars(1:pars_len)//' '//parnam(im)
|
|
endif
|
|
enddo
|
|
nset=is
|
|
|
|
if (window .eq. 0) then
|
|
last=t
|
|
step=maxRange/dmax
|
|
window=maxRange
|
|
first=t-min(dmax*step-1,maxRange-step)
|
|
else if (mode .ge. right) then
|
|
last=t
|
|
if (fixleft) then
|
|
window=last-tbase-x1
|
|
fixleft=.false.
|
|
endif
|
|
step=window/(dmax-2)+0.99
|
|
last=t
|
|
first=t-min(dmax*step-1,nint(window))
|
|
! if (first .ne. t-nint(window)) then
|
|
! print *,'t-shift',first-(t-nint(window))
|
|
! endif
|
|
else
|
|
if (mode .eq. 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 .eq. 0) step=1
|
|
|
|
if (step .gt. 60) then ! normalize step
|
|
step=(step+59)/60*60
|
|
else if (step .gt. 30) then
|
|
step=60
|
|
else if (step .gt. 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-tdif, last-tdif, step*fact, tbase-tdif
|
|
1 , xd, yd, dmax, nmax, retLen)
|
|
if (iret .lt. 0) goto 99
|
|
|
|
x2 = last - tbase
|
|
if (mode .ge. right) then
|
|
x1=x2-window
|
|
else
|
|
x1 = first - tbase
|
|
endif
|
|
tim0=t-tbase
|
|
|
|
do is=1,nset
|
|
im=imx(is)
|
|
leng=retLen(is)
|
|
do while (leng .gt. 1 .and. yd(leng,is) .eq. undef)
|
|
leng=leng-1
|
|
enddo
|
|
if (leng .eq. 1) leng=0
|
|
retLen(is)=leng
|
|
yy0(is)=yy1(im)
|
|
if (leng .gt. 0) then
|
|
if (mode .eq. live) then
|
|
xd(leng,is)=tim0
|
|
yd(leng,is)=yy0(is)
|
|
endif
|
|
omit(im)=.false.
|
|
! else if (showsets .eq. 2) then ! next time omit unused channels
|
|
! omit(im)=.true.
|
|
endif
|
|
enddo
|
|
|
|
showsets=0
|
|
|
|
j=0
|
|
do im=1,nmax
|
|
is=isx(im)
|
|
if (focus(im)) then
|
|
if (is .ne. 0 .and. unit(im) .eq. 1) then
|
|
if (retLen(is) .gt. 0) then
|
|
j=j+1 ! focus o.k.
|
|
goto 2
|
|
endif
|
|
endif
|
|
focus(im)=.false.
|
|
if (j .eq. 0 .and. im .lt. nmax) focus(im+1)=.true.
|
|
2 continue
|
|
endif
|
|
enddo
|
|
if (j .eq. 0) then
|
|
if (nextfocus .ne. 0) then
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (retLen(is) .gt. 0 .and. unit(im) .eq. 1) focus(im)=.true.
|
|
enddo
|
|
else if (.not. yzoom) then
|
|
y1=ymin(1)
|
|
y2=ymax(1)
|
|
yzoom=.true.
|
|
endif
|
|
endif
|
|
nextfocus=0
|
|
if (saveit) goto 9
|
|
if (mode .eq. live) then
|
|
x2=max(tim0,x2)+min(1800., window*0.5)
|
|
endif
|
|
|
|
if (window .gt. 36*3600) then
|
|
ticks=12*3600
|
|
if (window .lt. 60*3600) then
|
|
nticks=6
|
|
else
|
|
nticks=2
|
|
endif
|
|
elseif (window .gt. 18*3600) then
|
|
ticks=6*3600
|
|
if (window .lt. 30*3600) then
|
|
nticks=6
|
|
else
|
|
nticks=3
|
|
endif
|
|
elseif (window .gt. 10*3600) then
|
|
ticks=2*3600
|
|
nticks=2
|
|
elseif (window .gt. 3*3600) then
|
|
ticks=3600
|
|
if (window .lt. 5*3600) then
|
|
nticks=6
|
|
else
|
|
nticks=2
|
|
endif
|
|
elseif (window .gt. 6000) then
|
|
ticks=1200
|
|
nticks=2
|
|
elseif (window .gt. 1800) then
|
|
ticks=600
|
|
if (window .lt. 3600) then
|
|
nticks=5
|
|
else
|
|
nticks=2
|
|
endif
|
|
elseif (window .gt. 900) then
|
|
ticks=300
|
|
nticks=5
|
|
elseif (window .gt. 600) then
|
|
ticks=120
|
|
nticks=2
|
|
elseif (window .gt. 120) then
|
|
ticks=60
|
|
if (window .lt. 300) then
|
|
nticks=6
|
|
else
|
|
nticks=2
|
|
endif
|
|
else
|
|
ticks=30
|
|
nticks=3
|
|
endif
|
|
|
|
do rl=1,nwin
|
|
winconf(rl)=nwin-rl ! number of windows to follow
|
|
enddo
|
|
|
|
do rl=1,nwin
|
|
if (yzoom .and. rl .eq. 1) then
|
|
if (y2 .gt. y1) then
|
|
ymin(1)=y1
|
|
ymax(1)=y2
|
|
endif
|
|
else
|
|
ymin(rl)=1e30
|
|
ymax(rl)=-1e30
|
|
ylast1=ymin(rl)
|
|
ylast2=ymax(rl)
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (unit(im) .eq. rl .and. (focus(im) .or. rl .gt. 1)) then
|
|
do j=1,retLen(is)
|
|
if (yd(j,is) .ne. undef) then
|
|
ymin(rl)=min(ymin(rl),yd(j,is))
|
|
ymax(rl)=max(ymax(rl),yd(j,is))
|
|
endif
|
|
enddo
|
|
do j=max(1,retLen(is)-4),retLen(is)
|
|
if (yd(j,is) .ne. undef) then
|
|
ylast1=min(ylast1,yd(j, is))
|
|
ylast2=max(ylast2,yd(j, is))
|
|
endif
|
|
enddo
|
|
endif
|
|
enddo
|
|
|
|
ey=(ymax(rl)-ymin(rl))
|
|
fy=abs(ymax(rl))
|
|
ymax(rl)=ymax(rl)+max(fy*0.02,ey*0.01)
|
|
ymin(rl)=ymin(rl)-max(fy*0.02,ey*0.01)
|
|
if (mode .eq. 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
|
|
do j=1,rl-1
|
|
winconf(j)=winconf(j)-1
|
|
enddo
|
|
ymax(rl)=1.0
|
|
ymin(rl)=0
|
|
elseif (ymax(rl) .eq. ymin(rl)) then
|
|
ymax(rl)=ymin(rl)*1.00001+1.0
|
|
ymin(rl)=-1.0e-3
|
|
endif
|
|
enddo
|
|
|
|
winh=0.9/(winconf(1)+3.5)
|
|
|
|
do rl=1,nwin
|
|
|
|
if (rl .gt. 1) then
|
|
if (winconf(rl) .eq. winconf(rl-1)) goto 6 ! window empty
|
|
endif
|
|
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
do is=nset,1,-1
|
|
im=imx(is)
|
|
if (unit(im) .eq. rl) then
|
|
call pgsci(color(im))
|
|
l=0
|
|
lastj=1
|
|
do j=1,retLen(is)
|
|
if (yd(j,is) .eq. undef) then
|
|
if (j .gt. lastj) then
|
|
call pgline(j-lastj, xd(lastj,is), yd(lastj,is))
|
|
endif
|
|
lastj=j+1
|
|
else
|
|
l=j
|
|
endif
|
|
enddo
|
|
if (retLen(is) .gt. lastj)
|
|
1 call pgline(retLen(is)+1-lastj, xd(lastj,is), yd(lastj,is))
|
|
retLen(is)=l
|
|
endif
|
|
enddo
|
|
call pgsci(1)
|
|
if (rl .eq. 1) then
|
|
call pgsch(1.0)
|
|
call pgtbox('ZHXYBINST', ticks, nticks, 'BCINMST1', 0.0, 0)
|
|
call pgtbox('C', 0.0, 0, ' ', 0.0, 0)
|
|
ey=0.0
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (unit(im) .eq. rl .and. retLen(is) .gt. 0) then
|
|
name=parnam(im)
|
|
if (name .eq. 'Tm') then
|
|
name='Main'
|
|
elseif (name .eq. 'Ts') then
|
|
name='Sample'
|
|
elseif (name .eq. 'Tr') then
|
|
name='Set'
|
|
endif
|
|
call str_trim(name, name, name_len)
|
|
if (focus(im)) 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(im))
|
|
call pgmtxt ('L', 2.5, ey, 0.0, name(1:name_len))
|
|
ey=ey+fy+0.04
|
|
endif
|
|
ylim(is)=ymin(1)+(ey-0.02)*(ymax(1)-ymin(1))
|
|
enddo
|
|
call pgsci(1)
|
|
call pgmtxt ('L', 2.5, ey, 0.0, 'T [K]')
|
|
else
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (unit(im) .eq. rl) goto 5
|
|
enddo
|
|
im=0
|
|
5 if (im .ne. 0) then
|
|
call pgsch(4*winh)
|
|
call pgtbox('ZCIST', ticks, nticks, 'BINST1', 0.0, 0)
|
|
call pgtbox('B', 0.0, 0, 'CIVMST', 0.0, 0)
|
|
call pgsci(color(im))
|
|
call pgsch(1.0)
|
|
if (parnam(im) .eq. 'P' .or. parnam(im) .eq. 'p') then
|
|
call pgmtxt ('L', 2.5, 0.5, 0.5, 'Power [W]')
|
|
elseif (parnam(im) .eq. '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,
|
|
1 'Helium ['//title(1:title_len)//']')
|
|
else
|
|
call pgmtxt ('L', 2.5, 0.5, 0.5, parnam(im))
|
|
endif
|
|
endif
|
|
endif
|
|
6 continue
|
|
enddo
|
|
|
|
call pgsch(0.7)
|
|
rl=1
|
|
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
call pgsci(1)
|
|
call pgsclp(0)
|
|
if (mode .eq. live) then
|
|
text(2,1)='live off'
|
|
else
|
|
text(2,1)='live on'
|
|
endif
|
|
menuwid=0.0
|
|
do j=1,nmenu
|
|
call str_trim(text(2,j), text(2,j), text_len)
|
|
call pglen(5, text(2,j)(1:text_len), fx, fy)
|
|
call pgmtxt('T', 3.0, menuwid, 0.0, '|'//text(1,j))
|
|
call pgmtxt('T', 2.5, menuwid, 0.0, '|')
|
|
call pgmtxt('T', 2.0, menuwid, 0.0, '|'//text(2,j))
|
|
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
|
|
j=max(0,int((x1+oneDay/2)/oneDay))
|
|
|
|
ex=(j+0.5)*oneDay
|
|
do while (ex .le. x2)
|
|
done=.true.
|
|
write(buf,'(i8.8)') myc_date(nint(ex)+tbase)
|
|
call pgptxt(ex, ey, 0.0, 0.5,
|
|
1 weekdays(mod(j,7)+1)//buf(7:8)//'.'//buf(5:6))
|
|
ex=ex-12*3600
|
|
if (ex .gt. x1) then
|
|
call pgmove(ex, ey)
|
|
call pgdraw(ex, ey+row)
|
|
endif
|
|
ex=ex+oneDay
|
|
if (ex .lt. x2) then
|
|
call pgmove(ex, ey)
|
|
call pgdraw(ex, ey+row)
|
|
endif
|
|
j=j+1
|
|
ex=(j+0.5)*oneDay
|
|
enddo
|
|
if (.not. done) then
|
|
n=nint(x2)/oneDay*oneDay
|
|
l=nint(x1)-n
|
|
j=nint(x2)-n
|
|
if (l .lt. 0) then
|
|
if (-l .gt. j) then
|
|
ex=0.0
|
|
l=nint(x1)+tbase
|
|
else
|
|
ex=1.0
|
|
l=nint(x2)+tbase
|
|
endif
|
|
else
|
|
ex=0.5
|
|
l=nint(x2)+tbase
|
|
endif
|
|
thisday=mod(l/oneDay,7)+1
|
|
write(buf,'(i8.8)') myc_date(l)
|
|
call pgmtxt('B', 3.5, ex, ex,
|
|
1 weekdays(thisday)//buf(7:8)//'.'//buf(5:6))
|
|
endif
|
|
|
|
iret=tecs_get_par('device', title, 0)
|
|
if (iret .lt. 0) goto 99
|
|
j=index(title, '(')
|
|
if (j .gt. 2 ) then
|
|
title=title(1:j-1)
|
|
else if (title .eq. ' ') then
|
|
title='test - no device'
|
|
endif
|
|
|
|
if (mode .eq. live) then
|
|
call pgmtxt('T', -1.5, 0.02, 0.0, title)
|
|
endif
|
|
call pgsclp(1)
|
|
|
|
call purge_keys ! purge buffer
|
|
|
|
numl=0
|
|
numb=' '
|
|
7 ex=undef
|
|
if (mode .eq. live) then
|
|
! if (device(1:1) .eq. '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)
|
|
j=chartperiod-mod(myc_now(), chartperiod)
|
|
call get_cursor(ex, ey, key, -j)
|
|
|
|
do while (key .eq. char(0) .or. key .eq. ' ') ! no key or space key pressed
|
|
iret=tecs_get_mult(pars, t, nset, yy1)
|
|
if (iret .lt. 0) goto 99
|
|
t=t+tdif
|
|
tim1=t-tbase
|
|
if (tim1 .gt. x2) then
|
|
call pgpage
|
|
fixleft=.true.
|
|
goto 1
|
|
endif
|
|
if (tim1 .gt. tim0) then
|
|
do rl=1,nwin
|
|
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
|
|
do is=nset,1,-1
|
|
im=imx(is)
|
|
if (unit(im) .eq. rl) then
|
|
if (yy0(is) .ne. undef .and. yy1(is) .ne. undef) then
|
|
if ((focus(im) .or. unit(im) .gt. 1) .and.
|
|
1 (yy1(is) .lt. ymin(rl) .or.
|
|
1 yy1(is) .gt. ymax(rl))) then
|
|
call pgpage
|
|
fixleft=.true.
|
|
goto 1
|
|
endif
|
|
call pgsci(color(im))
|
|
call pgmove(tim0, yy0(is))
|
|
call pgdraw(tim1, yy1(is))
|
|
endif
|
|
yy0(is)=yy1(is)
|
|
endif
|
|
enddo
|
|
enddo
|
|
tim0=tim1
|
|
|
|
endif
|
|
j=chartperiod-mod(myc_now(), chartperiod)
|
|
rl=1
|
|
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
|
|
call get_cursor(ex, ey, key, -j)
|
|
enddo
|
|
else
|
|
call get_cursor(ex, ey, key, 0)
|
|
endif
|
|
rl=1
|
|
call set_win(rl,winh,winconf,x1,x2,ymin(rl),ymax(rl))
|
|
|
|
8 if (key .ge. 'a') key=char(ichar(key)-32)
|
|
if (key .eq. '-') then
|
|
window=min(window*2, 8.0*oneDay)
|
|
if (mode .eq. zoom) then
|
|
x1=x1-(x2-x1)/2
|
|
x2=x2+(x2-x1)/3
|
|
endif
|
|
if (yzoom) then
|
|
y1=y1-(y2-y1)/2
|
|
y2=y2+(y2-y1)/3
|
|
endif
|
|
elseif (key .eq. 'X') then
|
|
window=0
|
|
mode=0
|
|
yzoom=.false.
|
|
elseif (key .eq. '+' .or. key .eq. ',') then
|
|
window=max(winmin,window/2)
|
|
if (ex .eq. undef) then
|
|
ex=(x1+x2)/2
|
|
ey=(min(y2,ymax(1))+max(y1,ymin(1)))/2
|
|
end if
|
|
if (mode .eq. zoom) then
|
|
fx=max(winmin,x2-x1)
|
|
x1=ex-fx/4
|
|
x2=ex+fx/4
|
|
endif
|
|
if (yzoom) then
|
|
fy=max(y2-y1,1e-3,y2*1e-5)
|
|
y1=ey-fy/4
|
|
y2=ey+fy/4
|
|
endif
|
|
elseif (key .eq. 'Z') then
|
|
call pgsci(1)
|
|
if (ex .eq. undef) then
|
|
call pgmtxt('T', 0.5, 0.0, 0.0,
|
|
1 '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,
|
|
1 '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 .ge. 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 .ge. y2) then
|
|
y1=ymin(1)
|
|
y2=ymax(1)
|
|
endif
|
|
if (y1 .ne. ymin(1) .or. y2 .ne. ymax(2)) then
|
|
yzoom=.true.
|
|
endif
|
|
if (x1 .ne. xmin .or. x2 .ne. xmax) then
|
|
mode=zoom
|
|
endif
|
|
elseif (key .eq. 'J') then
|
|
dx=ex-(xmax+xmin)*0.5
|
|
dy=ey-(ymax(1)+ymin(1))*0.5
|
|
x1=xmin+dx
|
|
x2=xmax+dx
|
|
y1=ymin(1)+dy
|
|
y2=ymax(1)+dy
|
|
mode=zoom
|
|
yzoom=.true.
|
|
elseif (key .ge. '0' .and. key .le. '9' .or. key .eq. '.') 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
|
|
! if (mode .eq. zoom) mode=0
|
|
goto 7
|
|
elseif (key .eq. 'D') then
|
|
ex=1
|
|
read(numb, *, iostat=iostat) ex
|
|
window=min(maxRange,max(minRange, nint(oneDay*ex)))
|
|
if (mode .lt. right) mode=right
|
|
yzoom=.false.
|
|
x1=0
|
|
elseif (key .eq. 'H') then
|
|
ex=1
|
|
read(numb, *, iostat=iostat) ex
|
|
window=min(maxRange,max(minRange, nint(3600*ex)))
|
|
if (mode .lt. right) mode=right
|
|
yzoom=.false.
|
|
x1=0
|
|
elseif (key .eq. 'M') then
|
|
ex=1
|
|
read(numb, *, iostat=iostat) ex
|
|
window=min(maxRange,max(minRange, nint(60*ex)))
|
|
if (mode .lt. right) mode=right
|
|
yzoom=.false.
|
|
x1=0
|
|
elseif (key .eq. 'T' .or. numl .gt. 0 .and.
|
|
1 (key .eq. char(13) .or. key .eq. char(10))) then
|
|
j=index(numb,'.')
|
|
day=0
|
|
if (j .gt. 1 .and. j .lt. numl) then
|
|
read(numb(1:j-1), *, iostat=iostat) day
|
|
mon=0
|
|
read(numb(j+1:numl), *, iostat=iostat) mon
|
|
tbase = myc_time(day+mon*100)
|
|
else
|
|
read(numb, *, iostat=iostat) day
|
|
tbase = myc_time(day)
|
|
endif
|
|
x1=0
|
|
x2=oneDay
|
|
window=x2
|
|
mode=0
|
|
yzoom=.false.
|
|
elseif (key .eq. 'L') then
|
|
if (mode .eq. live) then
|
|
mode=right
|
|
else
|
|
mode=live
|
|
endif
|
|
elseif (key .eq. 'F') then
|
|
saveit=.true.
|
|
elseif (key .eq. 'Q' .or. key .eq. char(13)
|
|
1 .or. key .eq. char(10)) then
|
|
goto 9
|
|
elseif (key .eq. 'A') then
|
|
showsets=2
|
|
yzoom=.false.
|
|
elseif (key .eq. 'C') then ! clear set
|
|
if (ex .lt. x1) then
|
|
if (ey .ge. ymin(1) .and.
|
|
1 ey .le. ymax(1)) then
|
|
do is=1,nset
|
|
if (ey .lt. ylim(is)) then
|
|
im=imx(is)
|
|
omit(im)=.true.
|
|
goto 1
|
|
endif
|
|
enddo
|
|
else
|
|
ey=(ymin(1)-ey)/(ymax(1)-ymin(1))*3.0+0.5
|
|
if (ey .gt. 1.0) then
|
|
do im=1,nmax
|
|
j=unit(im)
|
|
if (winconf(1)-winconf(j) .eq. int(ey)) then
|
|
omit(im)=.true.
|
|
endif
|
|
enddo
|
|
endif
|
|
endif
|
|
endif
|
|
elseif (key .eq. 'S') then ! toggle focus
|
|
if (ex .lt. x1) then
|
|
if (ey .ge. ymin(1) .and.
|
|
1 ey .le. ymax(1)) then
|
|
do is=1,nset
|
|
if (ey .lt. ylim(is)) then
|
|
im=imx(is)
|
|
focus(im)=.not. focus(im)
|
|
goto 89
|
|
endif
|
|
enddo
|
|
endif
|
|
endif
|
|
j=nset
|
|
n=0
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (focus(im)) then
|
|
focus(im)=.false.
|
|
j=is
|
|
n=n+1
|
|
endif
|
|
enddo
|
|
if (n .gt. 1) then
|
|
if (j .gt. 3) then ! was "all", set to "default"
|
|
focus(1)=.true.
|
|
focus(2)=.true.
|
|
focus(3)=.true.
|
|
else ! was "default" select 1
|
|
focus(1)=.true.
|
|
endif
|
|
goto 89
|
|
endif
|
|
nextfocus=1
|
|
do is=1,nset
|
|
im=imx(is)
|
|
if (im .gt. j) then ! select next
|
|
focus(im)=.true.
|
|
goto 89
|
|
endif
|
|
enddo
|
|
! select all
|
|
do is=1,nset
|
|
im=imx(is)
|
|
focus(im)=.true.
|
|
enddo
|
|
89 yzoom=.false.
|
|
elseif (mode .eq. 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')
|
|
|
|
line='hour'
|
|
call str_trim(line, line, l)
|
|
do is=1,nset
|
|
im=imx(is)
|
|
idx(is)=0
|
|
do j=1,retlen(is)
|
|
if (yd(j,is) .ne. undef) then
|
|
idx(is)=1
|
|
l=l+1
|
|
line(l:l)=char(9)
|
|
call str_trim(line(l+1:), parnam(im), text_len)
|
|
l=l+max(9,text_len)
|
|
goto 109
|
|
endif
|
|
enddo
|
|
109 continue
|
|
enddo
|
|
write(lund, '(a)') line(1:l)
|
|
|
|
n=1
|
|
x0=0
|
|
do while (x0 .lt. 3e7)
|
|
x0=4e7
|
|
do is=1,nmax ! find next x
|
|
if (idx(is) .gt. 0 .and. idx(is) .lt. retlen(is)) then
|
|
x0=min(x0,xd(idx(is),is))
|
|
endif
|
|
enddo
|
|
if (x0 .lt. 3e7) then
|
|
write(line,'(f9.4)') x0/3600.
|
|
l=9
|
|
do is=1,nmax
|
|
if (idx(is) .gt. 0) then
|
|
l=l+1
|
|
line(l:l)=char(9)
|
|
if (idx(is) .le. retlen(is)) then
|
|
if (xd(idx(is),is) .lt. x0+1) then
|
|
write(line(l+1:), '(f9.4)')
|
|
1 max(-999.,min(9999.,yd(idx(is),is)))
|
|
l=l+9
|
|
idx(is)=idx(is)+1
|
|
endif
|
|
endif
|
|
endif
|
|
enddo
|
|
write(lund, '(a)') line(1:l)
|
|
n=n+1
|
|
endif
|
|
enddo
|
|
close(lund)
|
|
print *, n, ' lines written to ',filnam(1:48)
|
|
endif
|
|
|
|
end
|
|
|
|
|
|
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 .lt. 0) then
|
|
with_timeout=0
|
|
call pgqinf('VERSION', res, l)
|
|
if (res(l:l) .eq. '+') then
|
|
call pgqinf('TYPE', res, l)
|
|
if (res(1:1) .eq. 'X') then
|
|
with_timeout=1
|
|
end if
|
|
end if
|
|
end if
|
|
if (with_timeout .gt. 0 .or. mode .ge. 0) then
|
|
call pgband(mode, 0, x, y, x, y, key)
|
|
else
|
|
call sys_get_key(key, -mode)
|
|
endif
|
|
end
|
|
|
|
|
|
subroutine purge_keys
|
|
character key*1
|
|
key=' '
|
|
do while (key .ne. char(0))
|
|
call sys_get_key(key, 0)
|
|
end do
|
|
end
|
|
|
|
|
|
subroutine set_win(rl, winh, winconf, x1, x2, y1, y2)
|
|
integer rl
|
|
real winh
|
|
integer winconf(*)
|
|
real x1, x2, y1, y2
|
|
|
|
real b
|
|
|
|
if (rl .eq. 1) then
|
|
call pgsvp(0.07,0.93,0.9-3*winh,0.9)
|
|
else
|
|
b=winconf(rl)*winh
|
|
call pgsvp(0.07,0.93,b+0.01,b+winh-0.01)
|
|
endif
|
|
|
|
call pgswin(x1,x2,y1,y2)
|
|
end
|
|
|
|
|
|
integer function get_data(pars, first, last, step, tbase
|
|
1 , 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=12)
|
|
integer tecs_get_data
|
|
|
|
integer i,j,rl(maxn),m,k,n,mm
|
|
|
|
if (nmax .gt. maxn) stop 'get_data: nmax>maxn'
|
|
if (last-first .le. oneDay) then
|
|
get_data=tecs_get_data(pars, first, last, step, tbase
|
|
1 , 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)
|
|
1 , min(last,(i+1)*oneDay-step), step, tbase
|
|
1 , xd(m+1, 1), yd(m+1, 1), dmax, nmax, rl)
|
|
if (get_data .lt. 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
|
|
if (m .gt. 0) then
|
|
print '(a,$)',' .'
|
|
endif
|
|
m=mm
|
|
enddo
|
|
endif
|
|
end
|