Subroutine LAPLXY (nax,nay,xtimod,wave,npta,join,ixchn,iychn, & xtil,ytil,gtil,curtil,isym) c c--------------------------------------------------------------------- c c A maximum of eight pairs of axes can be drawn and up to eight c channels of data can be plotted on each pair of axes if a time c scale is used. c c Both x & y directions can be separated into eight axes (maximum), c but the total number of pairs must be less than nine. c c Descriptions of arguments and called subroutines are given in c LAPLOT.TXT c c LAPLV is a version of LAPLOV which is able to plot a variable c no. of points on each curve. (i.e. npta(e,f).ne.constant) c c LAPLXY is LAPLV altered to allow more curves on an XY-plot, and c is called by XYPLOT c--------------------------------------------------------------------- c c Declarations c Virtual wave(32,321) Real *8 curtil(32) Real *4 xtil(2,7),ytil(2,7),gtil(10) Real *4 rmax(32),rmin(32),title(10) Real *4 xsc(32),ysc(32),xtimod(2) Dimension ixr(2),iyr(2),nptchn(32),isym(2,32) Dimension ixchn(2,32),iychn(2,32),join(2,32),npta(2,32) Integer a,b,c,d,e,f,g,p,q,t,u,v,w,z Logical*1 log(40) c ncrvmx=32 ngphmx=2 nchmx=ncrvmx c--------------------------------------------------------------------- c c Data inputs (device-specific) c c------to define the plotting dimensions of x & y & a relative starting c origin, and to define separation between the upper end of one c axis & the origin of the next axis, ie. the space for labels and c title on x & y direction. c call grid (nax,nay,ixdim,iydim,ixo,iyo,ia,iv,ixgap,iygap, & ixstt,ityn,itxn,iystt,lxoffx,lyoffx,lxoffy,lyoffy, & iszn,insetx,insety,icusiz,length,iyspc,iszct,iszgt) c--------------------------------------------------------------------- c (1)--'npta(e,f)' indicates the number of points to be plotted on each c curve (f), on each graph (e). c c (2)--'nptchn' indicates the end point which defines the maximum c and minimum in each channel by the subroutine 'mxnpnt', c If a channel in 'wave' has no data, nptchn(x) is set c to be 0. Therefore subroutine 'mxnpnt' returns with c max = min = 0 for channel x. c 5 ntot=nax*nay d type *,' <5>... ' d type *,' ntot=nax*nay ' d type *,ntot do 10 e=1,ntot do 8 f=1,ncrvmx if ( ixchn(e,f).eq. 0) go to 6 ifg=ixchn(e,f) d type *,' e,f,npta(e,f),ifg,ixchn(e,f) ' d type *, e,f,npta(e,f),ifg,ixchn(e,f) nptchn(ifg)=npta(e,f) 6 if ( iychn(e,f).eq. 0) go to 8 ief=iychn(e,f) d type *,' e,f,npta(e,f),ief,iychn(e,f) ' d type *, e,f,npta(e,f),ief,iychn(e,f) nptchn(ief)=npta(e,f) 8 continue 10 continue d do 12 itil=1,ncrvmx d type 11, curtil(itil) d 11 format ( ' ',a8 ) d 12 continue c c--------------------------------------------------------------------- c c Calculations of constants c c------length of each axis 50 nxgap=nax-1 ixlen=(ixdim-ixgap*nxgap)/nax nygap=nay-1 iylen=(iydim-iygap*nygap)/nay c c------length of the titles xsize=float(ixlen*3/5) ysize=iylen*1.0 jxo=ixstt/nax !starting point jyo=iystt/nay ! of a title c c--------------------------------------------------------------------- c c Origin for each pair of axes : each pair is assigned to a number c in a way that the top left hand corner is no. 1 and the number is c increased as it goes down the row, and further increased as it c goes to the next row, & so on. c d=0 do 100, a=1,nax ixrdum=ixo+(ixgap+ixlen)*(a-1) c=nay do 100, b=1,nay d=d+1 ixr(d)=ixrdum iyr(d)=iyo+(iygap+iylen)*(c-1) c=c-1 100 continue c c--------------------------------------------------------------------- c c Call subroutine to get the max. & min. values for each channel, c the values in array 'nptchn' may be required to change if c no. of points for each channel is different. c call vxypnt (wave,nptchn,rmax,rmin) d type *,' <103>... ' d do 103 ijk=1,nchmx d type *,' rmax(ijk)=',rmax(ijk),' rmin(ijk)=',rmin(ijk) d 103 continue c--------------------------------------------------------------------- c c Start the plotting routine, the sequences are: c (1) find the upper & lower bounds for both x & y axes c (2) print the numerical labels & title c (3) plot the waveform(s) c (4) go to next origin c c-------------------------------------------- c if (ispy("372).ge.0) go to 104 ! jump if running under RT11 call iovir ! map PAR 6 to the I/O page 104 if (iv.eq.1) go to 110 encode (26,105,log) 10 105 format('595 0 translate 90 rotate'a1) call sendl(log,26) c 110 encode (8,115,log) 10 115 format('newpath'a1) call sendl(log,8) c c-------------------------------------------- iz=0 do 1000, p=1,ngphmx if ( p .gt. ntot ) go to 2000 xint=0. yint=0. xup=0. yup=0. c c------Choose the first available channel as the upper & c lower reference. kndx=ixchn(p,1) if (kndx.eq.0) go to 150 xup= rmax(kndx) xlo= rmin(kndx) go to 151 150 xup=0. xlo=0. 151 continue kndy=iychn(p,1) if (kndy.eq.0) go to 155 yup= rmax(kndy) ylo= rmin(kndy) go to 156 155 yup=0. ylo=0. 156 continue d type *,' <156>... ' d type *,' ixchn(p,1)=',ixchn(p,1),' kndx=',kndx d type *,' iychn(p,1)=',iychn(p,1),' kndy=',kndy c c Upper & lower values for each pair of axes c rmxx=0. rmnx=0. rmxy=0. rmny=0. do 300, q=1,ncrvmx c------x axis if ( ixchn(p,q) .eq. 0 ) go to 200 indx=ixchn(p,q) rmxx= rmax(indx) rmnx= rmin(indx) if ( rmxx .gt. xup ) xup=rmxx if ( rmnx .lt. xlo ) xlo=rmnx c------y axis 200 if ( iychn(p,q) .eq. 0 ) go to 300 indy=iychn(p,q) rmxy= rmax(indy) rmny= rmin(indy) if ( rmxy .gt. yup ) yup=rmxy if ( rmny .lt. ylo ) ylo=rmny d type *,' <200>-<300>... ' d type *,' q= ',q d type *,' rmxx=',rmxx,' rmnx=',rmnx d type *,' xup=',xup,' xlo=',xlo d type *,' rmxy=',rmxy,' rmny=',rmny d type *,' yup=',yup,' ylo=',ylo 300 continue ilogm=0 call extrem (xup,xlo,xupn,xlon,nticx,xtico,xticp,xint,ilogm) ilogm=0 call extrem (yup,ylo,yupn,ylon,nticy,ytico,yticp,yint,ilogm) 307 continue d type *,' <307>... ' d type *,' xupn=',xupn,' xticp=',xticp d type *,' xlon=',xlon,' xtico=',xtico d type *,' nticx=',nticx,' xint=',xint d type *,' yupn=',yupn,' yticp=',yticp d type *,' ylon=',ylon,' ytico=',ytico d type *,' nticy=',nticy,' yint=',yint c--------------------------------------------------------------------- nptmax=npta(p,1) do 308, f=1,ncrvmx if (npta(p,f).gt.nptmax) nptmax=npta(p,f) 308 continue 309 if (xint.ne.0.) go to 310 intlex=ixlen/5 ! standard interval between ticks nticx=5 ! five ticks as standard xsc(p)= float(ixlen)/(nptmax-1) go to 315 310 xsc(p)=float(ixlen) /(xupn-xlon) ! x-scale for axis p in plotter c units per data unit 315 if (yint.ne.0.) go to 320 intley=iylen/5 nticy=5 ysc(p)= float(iylen)/(nptmax-1) go to 321 320 ysc(p)=float(iylen) /(yupn-ylon) ! y-scale for axis p 321 continue c--------------------------------------------------------------------- c constants for axes ixdero=0 ixderp=0 iydero=0 ! plotter units from y-axis start to 1st tick iyderp=0 ! plotter units from top tick to end of y-axis if (yint.eq.0.) go to 322 ydero=ytico-ylon yderp=yupn-yticp iydero=irnd(ysc(p)*ydero) iyderp=irnd(ysc(p)*yderp) intley=irnd(ysc(p)*(yticp-ytico)/nticy) ! interval between ticks c recalculate the y-scale to take account of round-off approximation ysc(p)=intley*nticy/(yticp-ytico) 322 if (xint.eq.0.) go to 325 xdero=xtico-xlon xderp=xupn-xticp ixdero=irnd(xsc(p)*xdero) ixderp=irnd(xsc(p)*xderp) intlex=irnd(xsc(p)*(xticp-xtico)/nticx) c recalculate the x-scale xsc(p)=intlex*nticx/(xticp-xtico) c------Draw axes 325 call lintyp (01) ! use same pen d type *,' <325>... ' d type *,' ydero=',ydero,' yderp=',yderp d type *,' xdero=',xdero,' xderp=',xderp d type *,' iydero=',iydero,' iyderp=',iyderp d type *,' ixdero=',ixdero,' ixderp=',ixderp d type *,' intlex=',intlex,' intley=',intley d type *,' xsc(p)=',xsc(p),' ysc(p)=',ysc(p) d type *,' ixr(p)=',ixr(p),' iyr(p)=',iyr(p) c------draw x axis if (ixdero.eq.0) go to 326 ixstar=ixr(p)+ixdero call ladrw (0,1,ixr(p),iyr(p),ixdero,0,0) call axislw ( 1,intlex,nticx,ixstar,iyr(p) ) go to 327 326 call axislw ( 1,intlex,nticx,ixr(p),iyr(p) ) 327 if (ixderp.eq.0.) go to 328 call ladrw (7,0,ixderp,0,0,0,0) c------draw y axis 328 if (iydero.eq.0) go to 329 iystar=iyr(p)+iydero call ladrw (0,1,ixr(p),iyr(p),0,iydero,0) call axislw ( 0,intley,nticy,ixr(p),iystar ) go to 330 329 call axislw ( 0,intley,nticy,ixr(p),iyr(p) ) 330 if (iyderp.eq.0.) go to 331 call ladrw (7,0,0,iyderp,0,0,0) c------draw line through zero if cross-over occurs 331 if (yupn.le.0. .or. ylon.ge.0.) go to 332 iyzero=irnd(-ytico*ysc(p))+iydero+iyr(p) ixendp=ixlen + ixr(p) call ladrw (0,0,ixr(p),iyzero,ixendp,iyzero,0) c--------------------------------------------------------------------- c Numerical labels & titles c c------y axis numbers 332 if ( ytil(p,1) .eq. '0' ) go to 400 yboval=ylon iyn=iyr(p) if (ylon.eq.ytico) go to 333 yboval=ytico iyn=iyr(p)+iydero 333 nty=nticy+1 do 360, u=1,nty ij=u-1 ynubel=yboval+yint*ij call ladrw (4,0,ixr(p),iyn,0,0,0) ! pos'n. for numerical labels if ((yupn-ylon).lt.1..or.amod(yint, 0.1).gt.0.001 & .or.amod(yboval,0.1).gt.0.001) go to 350 if ((yupn-ylon).lt.15..or.amod(yint, 1.).gt.0.01 & .or.amod(yboval,1.).gt.0.01) go to 340 335 call ladrw (5,0,lxoffy,lyoffy,0,0,3,iszn,0,0,0,ynubel) d type *,' y axis no.----<335> ' go to 360 340 if (yupn.lt.1000. .and. ylon.gt.-100.) go to 345 go to 335 345 call ladrw (5,0,lxoffy,lyoffy,0,0,4,iszn,0,0,0,ynubel) d type *,' y axis no.----<345> ' go to 360 350 call ladrw (5,0,lxoffy,lyoffy,0,0,5,iszn,0,0,0,ynubel) d type *,' y axis no.----<350> ' 360 iyn=iyn+intley c------y title if ( ytil(p,1) .eq. '1' ) go to 400 iypo=intley*nticy ityp=-(iypo+iydero) + jyo cd type *,' iypo=',iypo,' jyo=',jyo,' ityp=',ityp do 370, jk=1,7 370 title(jk)=ytil(p,jk) nchary=len(title) call parse(title,40,nchary) c type *,'nchary = ',nchary c type 371,title c371 format(' ',10a4) scaley=ysize/nchary isy=irnd(scaley/icusiz) c type *,'isy = ',isy if (isy.gt.5) isy=5 ! max. character size if (isy.le.2 .or. ia.eq.4) isy=3 ! min. character size (--> A4) call ladrw (5,0,itxn,ityp,0,0,6,isy,1,0,0,0,title) ! vertically c--------------------------------------------------------------------- c x axis number 400 if ( xtil(p,1) .eq. '0' ) go to 500 ixn=0 xboval=xlon if (xlon.eq.xtico) go to 410 ixn=ixdero xboval=xtico 410 ntx=nticx+1 innyy=iyr(p)+lyoffx do 450, v=1,ntx ki=v-1 if ( xtimod(p) .lt. 0. ) xtimod(p)=1. if ( xtimod(p) .eq. 0. ) go to 430 xtimln=( xtimod(p) - 0. )/5. xnubel=0. + xtimln*ki go to 440 430 xnubel=xboval + xint*ki 440 innxx=ixr(p)+ixn+lxoffx call ladrw (4,0,innxx,innyy,0,0,0) d if (v.eq.1) type *,' v=',v, ' ixn=',ixn,' intlex=',intlex d if (v.eq.1) type *,' innxx=',innxx, ' innyy=',innyy if (xtimod(p).eq.0..and.amod(xint,1.).lt.0.01 & .and.amod(xboval,1.).lt.0.01) go to 444 if ((xtimod(p).eq.1.) & .or.(xtimod(p).eq.0..and.amod(xint, 0.1).lt.0.001 & .and.amod(xboval,0.1).lt.0.001)) go to 443 if (xtimod(p).lt.99.99) go to 442 if (xtimod(p).lt.999.9) go to 441 call ladrw (5,0,0,0,0,0,3,iszn,0,0,0,xnubel) go to 445 441 call ladrw (5,0,0,0,0,0,4,iszn,0,0,0,xnubel) go to 445 442 call ladrw (5,0,0,0,0,0,5,iszn,0,0,0,xnubel) go to 445 443 call ladrw (5,0,0,0,0,0,4,iszn,0,0,0,xnubel) go to 445 444 call ladrw (5,0,0,0,0,0,3,iszn,0,0,0,xnubel) 445 ixn=ixn+intlex 450 continue c------x axis title if ( xtil(p,1) .eq. '1' ) go to 500 do 470, kk=1,7 470 title(kk)=xtil(p,kk) ncharx=len(title) call parse(title,40,ncharx) scalex=xsize/float(ncharx) isx=scalex/icusiz-1. if (isx.gt.5) isx=5 if (isx.le.2 .or. ia.eq.4) isx=3 itxp=-ixlen+jxo call ladrw (5,0,itxp,ityn,0,0,6,isx,0,0,0,0,title) c c--------------------------------------------------------------------- c c Plot waveform(s). c 500 z=0 iloc='up' if (ntot.lt.4) insety=1.5*insety iyt=iyr(p)+iylen+insety ixt=ixr(p)+ixlen+insetx if (iloc.eq.'dn') iyt=iyr(p)+300 ! specific to WX4675 if (iloc.eq.'md') iyt=iyr(p)+600 do 700, t=1,ncrvmx if ( xtimod(p) .ne. 0. ) inx=-1 if ( ixchn(p,t) .eq. 0 ) go to 600 inx= ixchn(p,t) 600 if ( iychn(p,t) .eq. 0 ) go to 610 iny= iychn(p,t) 610 if ( ixchn(p,t).eq.0 .and. iychn(p,t).eq.0 ) go to 700 if (inx.eq.0 .or. iny.eq.0 ) go to 700 ilnpen=join(p,t) call lintyp (ilnpen) ismbl=isym(p,t) z=z+1 iz=iz+1 type 620, p,z 620 format(' Plotting routine: axis no.'i2', waveform no.'i2) if (ismbl.lt.0) go to 660 c------plot the lines making up the graph curve do 650 w=1,npta(p,z) ywave=sngl(wave(iny,w)) iy=irnd((ywave-ylon)*ysc(p))+iyr(p) if (inx.eq.-1) go to 630 xwave=sngl(wave(inx,w)) ix=irnd((xwave-xlon)*xsc(p))+ixr(p) go to 640 630 inc=w-1 ix= irnd(inc*xsc(p))+ixr(p) 640 if (w.eq.1) call ladrw (4,0,ix,iy,0,0,0) call ladrw (6,0,ix,iy,0,0,0) 650 continue encode (15,655,log) 10 655 format('stroke newpath'a1) call sendl(log,15) c c------add the symbols if so required 660 if (ismbl.eq.0) go to 700 ismbl=iabs(ismbl) do 690 w=1,npta(p,z) ywave=sngl(wave(iny,w)) iy=irnd((ywave-ylon)*ysc(p))+iyr(p) if (inx.eq.-1) go to 670 xwave=sngl(wave(inx,w)) ix=irnd((xwave-xlon)*xsc(p))+ixr(p) go to 680 670 inc=w-1 ix= irnd(inc*xsc(p))+ixr(p) 680 call ladrw (4,0,ix,iy,0,0,1,0,0,ismbl) 690 continue c c------horizontal sample of this line-type, and curve title 700 continue d type *,' <650>...inc,ix,iy,iz,curtil=', inc,ix,iy,iz,curtil(iz) if (curtil(iz).eq.'12345678') go to 900 long=length if (ntot.lt.4) long=(length*4)/3 call ladrw (0,1,ixt,iyt,long,0,0) ! horizontal line call ladrw (5,0,10,0,0,0,7,iszct,0,0,0,0,0,curtil(iz)) ! title iyt=iyt-iyspc 900 continue 1000 continue c--------------------------------------------------------------------- c Print graph title 2000 call lintyp (01) ixpos=ixo+ixdim/10 iypos=iyo+iydim+10 call ladrw (4,0,ixpos,iypos,0,0,6,iszgt,0,0,0,0,gtil) !a4 paper c--------------------------------------------------------------------- 2400 encode (16,2420,log) 10 2420 format('stroke showpage'a1) call sendl(log,16) c return end