c 'XYPLOT' accepts data from the keyboard for plotting as graphs c of calibrated data on the LaserWriter, c using the LAPLOT routines modified to allow more channels c of data (and called LAPLXY in this form). c program xyplot virtual wave(32,321) dimension xtil(2,7),ytil(2,7),gtil(10),xtimod(2) dimension npta(2,32),ixchn(2,32),iychn(2,32),ijon(2,32),isym(2,32) real*8 curtil(32) data curtil /32*'12345678'/ data xtimod /2*0./ data ijon(1,1),ijon(1,2),ijon(1,3),ijon(1,4) /4*1/ data ijon(1,5),ijon(1,6),ijon(1,7),ijon(1,8) /4*1/ data ijon(1,9),ijon(1,10),ijon(1,11),ijon(1,12) /4*1/ data ijon(1,13),ijon(1,14),ijon(1,15),ijon(1,16) /4*1/ data isym(1,1),isym(1,2),isym(1,3),isym(1,4) /121,21,122,22/ data isym(1,5),isym(1,6),isym(1,7),isym(1,8) /123,23,124,24/ data isym(1,9),isym(1,10),isym(1,11),isym(1,12) /125,25,221,222/ data isym(1,13),isym(1,14),isym(1,15),isym(1,16)/223,224,225,123/ data ixchn(1,1),ixchn(1,2),ixchn(1,3),ixchn(1,4) /1,3,5,7/ data iychn(1,1),iychn(1,2),iychn(1,3),iychn(1,4) /2,4,6,8/ data ixchn(1,5),ixchn(1,6),ixchn(1,7),ixchn(1,8) /9,11,13,15/ data iychn(1,5),iychn(1,6),iychn(1,7),iychn(1,8) /10,12,14,16/ data ixchn(1,9),ixchn(1,10),ixchn(1,11),ixchn(1,12) /17,19,21,23/ data iychn(1,9),iychn(1,10),iychn(1,11),iychn(1,12) /18,20,22,24/ data ixchn(1,13),ixchn(1,14),ixchn(1,15),ixchn(1,16)/25,27,29,31/ data iychn(1,13),iychn(1,14),iychn(1,15),iychn(1,16)/26,28,30,32/ c--------+---------+---------+---------+---------+---------+---------+ 10 format(i5) 20 format(a1) iret='N' c c get the data 100 type 101 101 format('$How many curves (max. 16) are there to plot on this g', & 'raph? ') accept 10,ncurv do 102 icurv=ncurv+1,32 npta(1,icurv)=0 ixchn(1,icurv)=0 102 iychn(1,icurv)=0 do 150 icurv=1,ncurv ichx=(icurv-1)*2+1 ichy=ichx+1 type 105 105 format('$How many data pairs are there to enter on this curve? ') accept 10,npta(1,icurv) type 110 110 format('$Please enter the first data pair as x,y ') accept 120,wave(ichx,1),wave(ichy,1) 120 format(2f12.5) if (npta(1,icurv).eq.1) go to 150 do 140 i=2,npta(1,icurv) type 130 130 format('$Next x,y ? ') accept 120,wave(ichx,i),wave(ichy,i) 140 continue 150 continue 160 type 165 165 format('$Do you wish to change any data points? ') accept 20,iyn if (iyn.ne.'Y') go to 230 c------------------------------------------------------------------------- c correction of entries 167 do 220 icurv=1,ncurv ichx=(icurv-1)*2+1 ichy=ichx+1 type * type *,'curve',icurv ! this line gives warning during compilation type *,'-------------' do 170 j=1,npta(1,icurv) type *,j,wave(ichx,j),wave(ichy,j) !warning given during compilation 170 continue 180 type 190 190 format('$Do you wish to change any of these points? ') accept 20,iyn if (iyn.ne.'Y') go to 220 type 200 200 format('$Which point? ') accept 10,ipoint type 210 210 format('$Enter the revised x,y ') accept 120,wave(ichx,ipoint),wave(ichy,ipoint) go to 180 220 continue go to 160 c------------------------------------------------------------------------- 230 if (iret.eq.'Y') go to 240 type 235 235 format('$Do you want to use the default symbols? ') accept 20,iyn if (iyn.eq.'Y') go to 265 go to 250 240 type 245 245 format('$Do you want to change the symbols? ') accept 20,iyn if (iyn.ne.'Y') go to 265 250 type 255,ncurv 255 format('$Enter the'i3' symbols to be used: ') accept 260,(isym(1,i),i=1,ncurv) 260 format(16i5) 265 type 270 270 format('$Do you want straight lines drawn between the points? ') accept 20,iyn if (iyn.ne.'Y') go to 280 do 275 i=1,ncurv 275 isym(1,i)=iabs(isym(1,i)) go to 290 280 do 285 i=1,ncurv 285 isym(1,i)=-iabs(isym(1,i)) 290 continue if (iret.ne.'Y') go to 305 type 300 300 format('$Do you want to change any of the titles? ') accept 20,iyn if (iyn.ne.'Y') go to 410 305 jsw=ipeek("44) call ipoke("44,"40000.or.ipeek("44)) type 310 310 format(' ',40(' '),40('-')) type 311 311 format('$Enter the graph title (up to 40 chars.) ') accept 320,gtil 320 format(10a4) type 330 330 format(' ',45(' '),16('-')) type 331 331 format('$Enter the X-axis title (up to 16 characters) ') accept 340,xtil(1,1),xtil(1,2),xtil(1,3),xtil(1,4) 340 format (4a4) type 330 type 351 351 format('$Enter the Y-axis title (up to 16 characters) ') accept 340,ytil(1,1),ytil(1,2),ytil(1,3),ytil(1,4) call ipoke("44,jsw) c------------------------------------------------------------ 410 nax=-1 ! minus for A4 paper in WAPLOT type 415 415 format('$Vertical format? ') accept 20,ifat nay=1 if (ifat.eq.'Y') nay=-1 call laplxy(nax,nay,xtimod,wave,npta,ijon,ixchn,iychn, & xtil,ytil,gtil,curtil,isym) type 418 418 format('$Re-plot the graph? ') accept 20,iret if (iret.ne.'Y') go to 430 type 420 420 format('$Do you wish to change any data points? ') accept 20,iyn if (iyn.eq.'Y') go to 167 go to 230 c------------------------------------------------------------- 430 call exit end