From ef5a7eeaa757efa06cd6f70c69110da5161d921f Mon Sep 17 00:00:00 2001 From: cvs Date: Thu, 22 Aug 2002 12:01:22 +0000 Subject: [PATCH] changed tecs_plot.f90 to tecs_plot.f M.Z. --- tecs/tecs_plot.f90 | 692 --------------------------------------------- 1 file changed, 692 deletions(-) delete mode 100644 tecs/tecs_plot.f90 diff --git a/tecs/tecs_plot.f90 b/tecs/tecs_plot.f90 deleted file mode 100644 index bf0c6242..00000000 --- a/tecs/tecs_plot.f90 +++ /dev/null @@ -1,692 +0,0 @@ -subroutine tecs_plot(auxpar) - - character(len=*) auxpar - - integer, parameter :: dmax=400, nmax=9, tmax=8, 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,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 - -! 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 - print *,'No PGPLOT-Device defined' - goto 9 - 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) - pars=trim(pars)//' '//parnam(nset) - enddo - nset=nset+1 - color(nset)=colorList(3) - 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 (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 - 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 - 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 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.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 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, 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, *) - write(lund, *) ' time [h]',char(9), ' ',trim(parnam(j)) - 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, 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