subroutine tecs_plot(reserved) character*(*) reserved integer dmax, nmax, nmenu, naux, nwin parameter (dmax=1024, nmax=12, nmenu=13, nwin=4, 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) integer chartperiod/5/ 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. iret = tecs_get_mult(' logperiod ', t, 1, dx) if (iret .lt. 0) goto 99 chartperiod = nint(dx) if (chartperiod .lt. 1) chartperiod=5 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+chartperiod-1)/chartperiod*chartperiod 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 numb=numb(j+1:numl) j=index(numb,'.') if (j .gt. 0) numb(j:)=' ' read(numb, *, 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=zoom 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