program plotpg c Purpose - General purpose plotting routine integer pgbegin,ilw(10),n(500) character*80 device,xlbl,ylbl,toplbl,fildat,label character*80 sline,filnm,scommnd,replist(100) character*25 spar(10),scom,dum,querry,spar1,spar2,spar3 character*1 snx,sny character txt(500)*4,ch*1,name*10,golabel*15,comfile*20 logical*1 text,errx,erry,line,point,polar,pair,bin,center logical*1 hist,rewind,lwswitch,spherical,rotphi,rottheta logical*1 autoscale,filesw,prnt,nmstrg,interact,points logical*1 dash_inbound,record,repeat,eofsw real a(15),x(500),y(500),x1(500),x2(500),y1(500),y2(500) real p(2),q(2),z(500),z2(500) integer ipts(500) call getarg(1,comfile) if (comfile .ne. ' ') open(unit=5,file=comfile,readonly) inchni = 11 inchn = inchni print*, '===========================================================' print*, ' Version 2.2' print*, 'This is PLOTPG, a facility which allows either interactive or' print*, 'command file operation of PGPLOT. With this facility, you' print*, 'need not write a program to make plots with PGPLOT. The' print*, 'data you want plotted just need to be in a file with any' print*, 'number of columns. You specify the file with the command ' print*, 'DATAFILE followed by the name of the file and the number' print*, 'of columns in the file. The program will read your data' print*, 'file in free format (not very good with strings). You' print*, 'specify which columns in the data file are to be used for' print*, 'x and y data values via the command XYCOLUMN.' print*, 'PLOTPG will prompt you for the "Plotting Command File:";' print*, 'the response "terminal" or CR will allow the session to be' print*, 'interactive, otherwise you can respond with the filename ' print*, 'of a command list. The commands are recorded in ' print*, 'the file "plt.plt". Once produced, "plt.plt" can be copied,' print*, 'edited, and then used as the command file for similar plots.' print*, ' A program by Ed Shaya ' print*, '===========================================================' ls = 1 8 print*, ' Plotting Command File [For interactive - ''terminal'']:' read(*,'(a)') filnm if (filnm .eq. 'help') goto 140 print*, filnm if (filnm(1:8) .eq. 'terminal' .or. filnm .eq. ' ') then interact = 1 inchn = 5 else open(inchn,file = filnm,status='old',readonly,err=8) end if filesw = 0 indata = 12 iout = 10 open(iout, file = 'plt.plt', status = 'unknown') 20 print *, 'Graphics device/type: [/tek] ' read(*,'(a)') device if (device .eq. ' ') device = '/tek' print *,'Number of sections in X direction: (usual 1)' read(*,'(a)') snx if (snx .eq. ' ') then nx = 1 ny = 1 goto 40 end if read(snx,'(i1)') nx if (nx .eq. 0) nx = 1 print *,'Number of sections in Y direction: (usual 1)' read(*,'(a)') sny read(sny,'(i1)') ny if (ny .eq. 0) ny = 1 40 if (.not.(pgbegin(12,device,nx,ny) .eq. 1)) goto 20 c ##==== set line width arrays ===# do kk = 1,10 ilw(kk) = kk end do autoscale = 0 lwswitch = 1 just = 0 axis = 0 if (interact) write(*,*) ' Begin commands.' 100 if (repeat) then jline = jline + 1 sline = replist(jline) if (jline .eq. jlinet) then jline = 0 repcnt = repcnt + 1 if (repcnt .eq. nreps-1) then repeat = 0 end if end if else read(inchn,110) sline write(iout,111) sline 110 format(a80) 111 format (a69) end if if (sline(1:1) .eq. '%') goto 100 if (record) then jline = jline + 1 replist(jline) = sline end if call split_line(sline,spar) scom = spar(1) if (scom .eq. ' ') go to 100 if (scom .eq. '$') then ln = index(sline,'$') scommnd = sline(ln+1:30+ln) write(*,*) ln,scommnd kcom = system(scommnd) else if (scom .eq. 'help') then if (spar(2) .eq. ' ') then scommnd = 'more /mnt1/ejs/utils/plotpg.hlp' else 140 scommnd = 'grep ^'//spar(2)//'/mnt1/ejs/utils/plotpg.hlp' end if kcom = system(scommnd) else if (scom .eq. 'repeat') then read(spar(2),*,end=900) nreps spar1 = 'NUMBER_OF_REPEATS' jline = 0 repcnt = 0 record = 1 else if (scom .eq. 'endrepeat') then jlinet = jline - 1 jline = 0 record = 0 repeat = 1 else if (scom .eq. 'goto') then golabel = spar(2) let = index(golabel,' ') golabel(let:let) = ':' eofsw = 0 175 do while (golabel .ne. spar(1)) read(inchn,110,end=180) sline call split_line(sline,spar) end do go to 100 180 if (eofsw) then write(*,*) 'Missing Label ',golabel stop else eofsw = 1 end if rewind inchn go to 175 else if (scom .eq. 'terminal') then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' else if (scom .eq. 'commandfile') then inchn = inchni interact = 0 if (spar(2) .ne. ' ') then close(inchn) open(unit=inchn,file=spar(2),status='old',readonly) end if else if (scom .eq. 'xlabel') then xlbl = spar(2) ln1 = 0 do jj = 3, 10 ln = index(xlbl(ln1+1:),' ') xlbl = xlbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'ylabel') then ln1 = 0 ylbl = spar(2) do jj = 3, 10 ln = index(ylbl(ln1+1:),' ') ylbl = ylbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'tlabel') then ln1 = 0 toplbl = spar(2) do jj = 3, 10 ln = index(toplbl(ln1+1:),' ') toplbl = toplbl(1:ln1+ln)//spar(jj) ln1 = ln1 + ln end do else if (scom .eq. 'setc') then spar1 = 'SETC' read(spar(2),*,end=900) csize call pgsetc(csize) else if (scom .eq. 'setlw') then spar1 = 'LSIZE' read(spar(2),*,end=900) lsize call grsetlw(ilw(lsize)) else if (scom .eq. 'setfont') then spar1 = 'IFONT' read(spar(2),*,end=900) ifont call grsetfont(ifont) else if (scom .eq. 'lwswitch') then if (lwswitch .eq. 1) then lwswitch = 0 do kk = 1,10 ilw(kk) = 1 end do else lwswitch = 1 do kk = 1,10 ilw(kk) = kk end do end if else if (scom .eq. 'datafile') then fildat = spar(2) spar1 = 'FILENAME' spar2 = 'NCOL' read(spar(3),*,end=950) ncol close(indata) indata = indata + 1 open(unit=indata,file=fildat,status = 'old',readonly, x err = 80) filesw = 1 goto 90 80 write(*,'(a25,a25)') 'Unable to find datafile ',fildat filesw = 0 goto 100 90 continue else if (scom .eq. 'pair') then pair = 1 spar1 = 'ND2' read(spar(2),*,end=900) nx2 read(spar(3),*,end=220) ny2 else if (scom .eq. 'dash_inbound') then dash_inbound = 1 220 else if (scom .eq. 'spherical') then spherical = 1 spar1 = 'NTHETA' spar2 = 'NPHI' spar3 = 'ND' read(spar(2),*,end=970) ntheta read(spar(3),*,end=970) nphi read(spar(4),*,end=970) nd else if (scom .eq. 'rottheta') then rottheta = 1 spar1 = 'THETA' read(spar(2),*,end=900) theta else if (scom .eq. 'rotphi') then rotphi = 1 spar1 = 'PHI' read(spar(2),*,end=900) phi else if (scom .eq. 'polar') then polar = 1 spar1 = 'NTHETA' spar2 = 'ND' read(spar(2),*,end=950) ntheta read(spar(3),*,end=950) nd else if (scom .eq. 'xycolumn') then spar1 = 'NX' spar2 = 'NY' read(spar(2),*,end=950) nx read(spar(3),*,end=950) ny else if (scom .eq. 'xyzcolumn') then spar1 = 'NX' spar2 = 'NY' spar3 = 'NZ' read(spar(2),*,end=970) nx read(spar(3),*,end=970) ny read(spar(4),*,end=970) nz else if (scom .eq. 'point') then point = 1 spar1 = 'IPT' read(spar(2),*,end=900) ipt else if (scom .eq. 'points') then points = 1 spar1 = 'NCOL_POINT_SYMBOL' read(spar(2),*,end=900) nipts else if (scom .eq. 'line') then line = 1 else if (scom .eq. 'errx') then errx = 1 spar1 = 'N_COL_ERRX1' spar2 = 'N_COL_ERRX2' spar3 = 'ERRXTYPE' read(spar(2),*,end=970) nerrx1 read(spar(3),*,end=970) nerrx2 read(spar(4),*,end=970) errxt else if (scom .eq. 'erry') then erry = 1 spar1 = 'N_COL_ERRY1' spar2 = 'N_COL_ERRY2' spar3 = 'ERRYTYPE' read(spar(2),*,end=970) nerry1 read(spar(3),*,end=970) nerry2 read(spar(4),*,end=970) erryt else if (scom .eq. 'text') then text = 1 spar1 = 'N_COL' read(spar(2),*,end=900) namcol else if (scom .eq. 'hist') then spar1 = 'DAT_MIN' spar2 = 'DAT_MAX' hist = 1 read(spar(2),*,end=950) datmin read(spar(3),*,end=950) datmax else if (scom .eq. 'curse') then call pgupdt(1) if (spar(2) .ne. ' ') then read(spar(2),*,end=900) xcoord read(spar(3),*,end=900) ycoord end if call pgcurse(xcoord,ycoord,ch) write(*,*) ch,xcoord,ycoord else if (scom .eq. 'labels') then call pgupdt(1) nlabel = 1 write(*,*) ' Present character size is ',csize write(*,*) ' Begin placing labels [ to end]' 500 print *,' Label ', nlabel read(*,'(a)') label if (label .eq. '') then if (interact) write(*,*) ' Continue commands' goto 100 end if print *,' X,Y position of label' read(*,*) xcoord,ycoord call pgtext(xcoord,ycoord,label) nlabel = nlabel + 1 goto 500 else if (scom .eq. 'setls') then spar1 = 'LINE_STYLE' read(spar(2),*,end=900) ls call grsetls(ls) else if (scom .eq. 'draw') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgdraw(xcoord,ycoord) else if (scom .eq. 'move') then spar1 = 'X' spar2 = 'Y' read(spar(2),*,end=950) xcoord read(spar(3),*,end=950) ycoord call pgmove(xcoord,ycoord) else if (scom .eq. 'bin') then spar1 = 'CENTER [LOGICAL]' read(spar(2),*,end=900) center bin = 1 else if (scom .eq. 'just') then just = 1 else if (scom .eq. 'axis') then spar1 = 'NAXIS' read(spar(2),*,end=900) naxis else if (scom .eq. 'env') then if (autoscale) then write(*,*) ' Autoscale is on.' write(*,*) ' Axes drawn during plot execution.' else spar1 = 'XMIN XMAX' spar2 = 'YMIN YMAX' read(spar(2),*,end=950) xmin read(spar(3),*,end=950) xmax read(spar(4),*,end=950) ymin read(spar(5),*,end=950) ymax xcoord = (xmax-xmin)/2. ycoord = (ymax-ymin)/2. call pgenv(xmin,xmax,ymin,ymax,just,naxis) just = 0 end if else if (scom .eq. 'autoscale') then if (autoscale) then autoscale = 0 else autoscale = 1 end if else if (scom .eq. 'label') then call pglabel(xlbl,ylbl,toplbl) else if (scom .eq. 'skip') then if (.not. filesw) goto 800 spar1 = 'NLINES' read(spar(2),*,end=900) nlines do jj = 1, nlines read(indata,'(a)') dum end do write(*,'(i5,a,a20)') nlines,' lines skipped in ',fildat else if (scom .eq. 'rewind') then rewind = 1 if (rewind) rewind(indata) else if (scom .eq. 'print') then prnt = 1 else if (scom .eq. 'noprint') then prnt = 0 else if (scom .eq. 'strings') then nmstrg = 1 else if (scom .eq. 'nostrings') then nmstrg = 0 else if (scom .eq. 'vport') then spar1 = 'XLEFT XRIGHT' spar2 = 'YBOT YTOP' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgvport(xleft,xright,ybot,ytop) else if (scom .eq. 'advance') then call pgadvance else if (scom .eq. 'vstand') then call pgvstand else if (scom .eq. 'window') then spar1 = 'X1 X2' spar2 = 'Y1 Y2' read(spar(2),*,end=950) xleft read(spar(3),*,end=950) xright read(spar(4),*,end=950) ybot read(spar(5),*,end=950) ytop call pgwindow(xleft,xright,ybot,ytop) else if (scom .eq. 'box') then spar1 = 'XOPT XTICK' spar2 = 'NXSUB YOPT' spar3 = 'YTICK NYSUB' read(spar(2),*,end=980) xopt read(spar(3),*,end=980) xtick read(spar(4),*,end=980) nxsub read(spar(5),*,end=980) yopt read(spar(5),*,end=980) ytick read(spar(5),*,end=980) nysub call pgbox(xopt,xtick,nxsub,yopt,ytick,nysub) else if (scom .eq. 'plot') then spar1 = 'NDATA_PTS' read(spar(2),*,end=900) ntot if (ntot .gt. 500) then ntot = 500 write(*,*) ' Only 500 points can be plotted at a time' end if if (.not. filesw) goto 800 call pgupdt(0) C #== READ IN DATA AND SET X, Y AND ERROR ARRAYS ===# j = 0 do i = 1, ntot if (nmstrg) then read(indata,*,end=850) name,(a(j),j=2,ncol) else read(indata,*,end=850) (a(j),j=1,ncol) end if if (spherical) then x(i) = a(nd)*cos(a(ntheta))*sin(a(nphi)) y(i) = a(nd)*sin(a(ntheta))*sin(a(nphi)) z(i) = a(nd)*cos(a(nphi)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) z2(i) = a(nx2)*z(i)/a(nd) end if else if (polar) then x(i) = a(nd)*cos(a(ntheta)) y(i) = a(nd)*sin(a(ntheta)) if (pair) then x2(i) = a(nx2)*x(i)/a(nd) y2(i) = a(nx2)*y(i)/a(nd) end if else if (hist) then x(i) = a(nx) else x(i) = a(nx) y(i) = a(ny) if (pair) then x2(i) = a(nx2) y2(i) = a(ny2) end if if (rotphi) z(i) = a(nz) end if if (points) then ipts(i) = a(nipts) end if if (errx) then x1(i) = x(i) - a(nerrx1) x2(i) = x(i) + a(nerrx2) end if if (erry) then y1(i) = y(i) - a(nerry1) y2(i) = y(i) + a(nerry2) end if if (text) then if (nmstrg .and. namcol .eq. 1) then txt(i) = name else n(i) = a(namcol) if (n(i) .le. 9) then write(txt(i),'(i1)') n(i) else if (n(i) .le. 99) then write(txt(i),'(i2)') n(i) else if (n(i) .le. 999) then write(txt(i),'(i3)') n(i) end if end if end if if (prnt) print *,i,name,x(i),y(i) if (rottheta) then x(i) = x(i)*cos(theta)+y(i)*sin(theta) y(i) = -x(i)*sin(theta)+y(i)*cos(theta) if (pair) then x2(i) = x2(i)*cos(theta)+y2(i)*sin(theta) y2(i) = -x2(i)*sin(theta)+y2(i)*cos(theta) end if end if if (rotphi) then y(i) = y(i)*cos(phi)+z(i)*sin(phi) if (pair) y2(i) = y2(i)*cos(phi)+z2(i)*sin(phi) end if end do 850 itot = i - 1 write(*,'(i4,a17,a20)') itot,' lines read from ',fildat if (text) then do k = 1,itot call pgtext(x(k),y(k),txt(k)) end do end if if (autoscale) then xmina = x(1) ymina = y(1) xmaxa = x(1) ymaxa = y(1) do ijk = 2, itot if (x(ijk) .gt. xmaxa) xmaxa = x(ijk) if (y(ijk) .gt. ymaxa) ymaxa = y(ijk) if (x(ijk) .lt. xmina) xmina = x(ijk) if (y(ijk) .lt. ymina) ymina = y(ijk) end do plusx = (xmaxa-xmina)*.05 plusy = (ymaxa-ymina)*.05 xmina = xmina - plusx xmaxa = xmaxa + plusx ymina = ymina - plusy ymaxa = ymaxa + plusy call pgenv(xmina,xmaxa,ymina,ymaxa,just,axis) end if if (point) call pgpoint(itot,x,y,ipt) if (points) call pgpoint(itot,x,y,ipts) if (line) call pgline(itot,x,y) if (bin) call pgbin(itot,x,y,center) if (hist) call pghist(itot,x,datmin,datmax,itot,1) if (pair) then do i = 1, itot p(1) = x(i) q(1) = y(i) p(2) = x2(i) q(2) = y2(i) if (dash_inbound) then if (p(1)**2+q(1)**2 .gt. p(2)**2+q(2)**2) then call grsetls(4) else call grsetls(1) end if end if call pgline(2,p,q) end do call grsetls(ls) end if if (errx) then call pgerrx(itot,x1,x2,y,errxt) end if if (erry) then call pgerry(itot,x,y1,y2,erryt) end if pair = 0 spherical = 0 rotphi = 0 rottheta = 0 polar = 0 line = 0 point = 0 points = 0 errx = 0 erry = 0 text = 0 labels = 0 hist = 0 rewind = 0 else if (scom .eq. 'quit') then goto 999 else write(*,*) ' Do not understand ',scom write(iout,*) ' Do not understand ',scom end if go to 100 800 write(*,*) 'No datafile chosen. Use command DATAFILE.' goto 980 900 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17)') scom,spar1 go to 980 950 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17,2x,a17)') scom,spar1,spar2 go to 980 970 write(*,*) ' Command "',scom,'" requires more parameters.' write(*,'(a15,2x,a17,2x,a17,2x,a17)') scom,spar1,spar2,spar3 go to 980 980 if (.not.interact) then inchn = 5 interact = 1 write(*,*) ' Enter commands interactively' write(*,985) ' Type "commandfile" to return control to ',filnm 985 format(a,a17) end if go to 100 999 call pgupdt(1) call pgend close(indata) if (device .eq. '/ps') then write(*,'(a)') ' Send plot to laserwriter?' read(*,'(a)') querry if (querry(1:1) .eq. 'y') then kcom = system('print -v PGPLOT.PS') write(*,*) ' Printing' end if end if end