c c subroutine linplt (npts,xdat,ydat,zdat) c c PROGRAM NAME: LINPLT.rat c c DATE OF FIRST VERSION: 21-Jun-83 c c PURPOSE: PLTFIL routine to plot non-histogram data c c USAGE: call LINPLT (NPTS,XDAT,YDAT,ZDAT) c c Where NPTS -- Number of data points to plot c XDAT -- X-values (REAL*4 array) c YDAT -- Y-values (REAL*4 array) c ZDAT -- Error bars (REAL*4 array) c c PROGRAMMER: Mike Collins / Eric Javel / Matt Prucka c c********************************************************************** c c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 dimensionxdat(1),ydat(1),zdat(1) real*8da,db,dc,dd,de,df byteicode(20) 1 format (i3) c c------------------------------------------------------------------------ c call newpen(ipllnw) c Sort the data into increasing X values if(.not.(sort .eq. 1.))goto 23000 c for i=1 23002 if(.not.(i.lt.npts))goto 23004 c for j=i+1 23005 if(.not.(j.le.npts))goto 23007 if(.not.(xdat(j) .lt. xdat(i)))goto 23008 a = xdat(i) xdat(i) = xdat(j) xdat(j) = a a = ydat(i) ydat(i) = ydat(j) ydat(j) = a a = zdat(i) zdat(i) = zdat(j) zdat(j) = a 23008 continue j=j+1 goto 23005 c endfor 23007 continue i=i+1 goto 23002 c endfor 23004 continue c Smooth the data, if necessary, using the ACM 3-point smoothing algorithm 23000 continue if(.not.(smooth.ne.0. .and. npts.ge.3))goto 23010 a = ydat(1) yp = ydat(npts-2) c First point ydat(1)=ydat(1)*5./6.+ydat(2)/3.-ydat(3)/6. c for i=2 23012 if(.not.(i.le.npts-1))goto 23014 c Middle points yn = ydat(i) ydat(i) = (a+yn+ydat(i+1)) / 3. a = yn i=i+1 goto 23012 c endfor 23014 continue c Last point ydat(npts) = ydat(npts)*5./6. + a/3. - yp/6. c Set up for error bars and dashed lines 23010 continue sym2 = hitsym / 2. eb = amax1(sym2,avgaxl/100.) space=avgaxl/50. dash=(typlin-1.)*space/4. if(.not.(dbflg))goto 23015 type *,' linplt: dash,space =',dash,space 23015 continue if(.not.(dbflg))goto 23017 type *,' linplt: pltype,xcycle,ycycle =',pltype,xcycle,ycycle c c Plot the data values c 23017 continue c for i=1 23019 if(.not.(i.le.npts))goto 23021 c Scale this and the next data value onto the plot call pos (xdat(i),ydat(i),xp,yp) call pos (xdat(i+1),ydat(i+1),xn,yn) c Draw the symbol if it's specified if(.not.(pltype .ne. 2.))goto 23022 call symbol(xp,yp,ifix(symnum),0.) c Plot the error bar if it exists and it sticks out beyond the symbol 23022 continue a = abs(zdat(i)) if(.not.(a .gt. 0.))goto 23024 if(.not.(ycycle .eq. 0.))goto 23026 call pos (xdat(i),ydat(i)+a,xp,top) call pos (xdat(i),ydat(i)-a,xp,bot) goto 23027 c else 23026 continue call pos (xdat(i),ydat(i)*a,xp,top) call pos (xdat(i),ydat(i)/a,xp,bot) 23027 continue if(.not.(top-bot .ge. hitsym))goto 23028 c Top half call plot2 (xp,yp+sym2,3) call plot2 (xp ,top,2) call plot2 (xp-eb,top,3) call plot2 (xp+eb,top,2) c Bottom half call plot2 (xp-eb,bot,3) call plot2 (xp+eb,bot,2) call plot2 (xp ,bot,3) call plot2 (xp,yp-sym2,2) 23028 continue c Plot the lines if lines are specified 23024 continue if(.not.(pltype.ne.1. .and. i.lt.npts))goto 23030 c If it's a "symbols+lines" plot, juggle the starting c and ending positions of the line so that the lines c don't go through the symbols. The lines begin and c end one-half of a symbol height away from the datum. if(.not.(pltype .eq. 3.))goto 23032 delx = xn - xp dely = yn - yp a = sqrt(delx*delx + dely*dely) if(.not.(a .gt. 0.))goto 23034 a = sym2 / a xp = xp + delx*a yp = yp + dely*a xn = xn - delx*a yn = yn - dely*a 23034 continue c lines -- If it's a "lines only" plot, don't c pick the pen up after the first point 23032 continue if(.not.(i.eq.1.or.pltype.eq.3))goto 23036 call dshlin(xp,yp,xn,yn,dash,space,0) goto 23037 c else 23036 continue call dshlin(xp,yp,xn,yn,dash,space,1) 23037 continue 23030 continue i=i+1 goto 23019 c endfor 23021 continue return end c c subroutine pos (x,y,xp,yp) c c Subroutine to scale an (X,Y) datum into position (XP,YP) on the page c c c Common block for PLT parameters c real*8prmnam,txtnam,keywrd bytexlabel,ylabel,rlabel,xfmt,yfmt,rfmt,msg,filonm(14) bytefilinm(40) logical*1dataon,pltfnd,msgflg,finflg,modflg,conton,axflg,newpag, & ecflg,typerr,dbflg c common /params/xmin,xmax,xint,xcycle,xpct,xlen,xllc,ymin,ymax, & yint,ycycle,ypct,ylen,yllc,rmin,rmax,rint,rcycle,rpct,pltype, & typlin,pltlin,symnum,sizsym,solid,sizann,wtlnan,xanlab,yanlab, & ranlab,yhor,grid,sizlab,wtlnlb,ticmrk,shade,echo,wtlnax,openax, & sizmsg,wtlnms,xmsg,ymsg,angmsg,datmsg,sizfac,smooth,header,sort, & unused(1) common /flags/dataon,pltfnd,msgflg,finflg,modflg,conton,axflg, & newpag,ecflg,typerr,dbflg common /names/prmnam(50),txtnam(6),keywrd(25),filinm,filonm common /text/xlabel(52),ylabel(52),rlabel(52),xfmt(6),yfmt(6), & rfmt(6),msg(256) common /misc/ifrom,ito,inow,ipage,model,lunin,lunout c common /axes/rxmin,rxmax,rymin,rymax,rxlen,rylen,rxllc,ryllc, & pxmin,pxmax,pymin,pymax,pxlen,pylen,pxllc,pyllc common /size/tiklen,hitann,hitlab,hitsym,hitmsg,iaxlnw,igrlnw, & ianlnw,ilblnw,ipllnw,imslnw,avgaxl common /msks/ msk1,msk2,msk3,msk4,msk5 c X-axis value if(.not.(xcycle .eq. 0.))goto 23038 a = xpct/100. xp = pxlen * (a*(x-pxmin)/(pxmax-pxmin) + (1.-a)/2.) + pxllc goto 23039 c else 23038 continue if(.not.(x .gt. 0.))goto 23040 xp=pxlen*alog10(x/pxmin)/alog10(pxmax/pxmin)+pxllc goto 23041 c else 23040 continue xp=0. 23041 continue 23039 continue c Y-axis value if(.not.(ycycle .eq. 0.))goto 23042 a = ypct/100. yp = pylen * (a*(y-pymin)/(pymax-pymin) + (1.-a)/2.) + pyllc goto 23043 c else 23042 continue if(.not.(y .gt. 0.))goto 23044 yp=pylen*alog10(y/pymin)/alog10(pymax/pymin)+pyllc goto 23045 c else 23044 continue yp=0. 23045 continue 23043 continue return end