00001
00002 c
00003 c Copyright (c) 1986,1987,1988,1989,1990,1991,1992,1993,
00004 c by Steve McMillan, Drexel University, Philadelphia, PA.
00005 c
00006 c All rights reserved.
00007 c
00008 c Redistribution and use in source and binary forms are permitted
00009 c provided that the above copyright notice and this paragraph are
00010 c duplicated in all such forms and that any documentation,
00011 c advertising materials, and other materials related to such
00012 c distribution and use acknowledge that the software was developed
00013 c by the author named above.
00014 c
00015 c THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
00016 c IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
00017 c WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
00018 c
00019 subroutine fr lnxdr(y,x1,x2,dxs,dxm,dxl,
00020 $ iax,ilab,nlab,ndec,lpow)
00021 save
00022 c
00023 c Draw x-axis, tick marks and numbers for linear case (ndec nonzero),
00024 c and major tick marks and numbers for the logarithmic case (ndec = 0).
00025 c
00026 c iax = 1 for bottom axis, 2 for top.
00027 c ilab = 0 for no labels, 1 for labels
00028 c nlab = estimated number of spaces for labels
00029 c
00030 c ndec = -1 ==> integer format
00031 c ndec = 0 ==> log axes, want to plot 10^n
00032 c ndec > 0: number of places to right of decimal point
00033 c lpow = 0 ==> F format, E format (lpow = exponent) otherwise
00034 c
00035 c No numbers are drawn for nonzero lmode, regardless of ilab.
00036 c
00037 dimension dx(3)
00038 common/scales/xl,xr,dinchx,ybot,ytop,dinchy,rlen,slen
00039 common/dev status/idevon,idevpen,idevwt
00040 common/fr hts/htl,htn/fr wts/iwts(4)
00041 common/fr ticks/tiks(3),tikl
00042 common/fr xnums/xnumbot
00043 c
00044 common/fr bare/ibare
00045 common/fr lbx/lmode
00046 common/fr tik level/jtik level
00047 c
00048 character*80 string
00049 parameter (TOL = 1.e-6, WTOL = 0.75)
00050 c
00051 data mode/1/jtik level/1/
00052 c
00053 data theta/0./
00054 c
00055 cinch(xa,xs,di)=(xa-xs)*di
00056 c
00057 dx(1)=dxs
00058 dx(2)=dxm
00059 dx(3)=dxl
00060 sax=cinch(y,ybot,dinchy)
00061 r1=cinch(x1,xl,dinchx)
00062 r2=cinch(x2,xl,dinchx)
00063 c
00064 if (iwts(1).gt.0) then
00065 jwt=idevwt
00066 call weight(iwts(1))
00067 end if
00068 c
00069 call plot(r1,sax,3)
00070 call plot(r2,sax,2)
00071 c
00072 ds=1.
00073 if (iax.eq.2) ds=-1.
00074 c
00075 c Draw the tick marks: j = 1, 2, 3 correspond to small, medium and
00076 c large tick marks, respectively. Tick sizes are set in eframe.
00077 c
00078 do j=jtik level,3
00079 if (dx(j).ne.0) then
00080 stik=sax+ds*tiks(j)
00081 c
00082 call fr lnfnc(x1,x2,dx(j),mode,firstx,nx)
00083 c
00084 dr=dx(j)*dinchx
00085 r=cinch(firstx,xl,dinchx)
00086 do i=1,nx
00087 call plot(r,sax,3)
00088 call plot(r,stik,2)
00089 r=r+dr
00090 end do
00091 end if
00092 end do
00093 c
00094 if (iwts(1).gt.0) call weight(jwt)
00095 if (ilab.eq.0.or.lmode.ne.0) return
00096 c
00097 c Now add the numbers.
00098 c -------------------
00099 c
00100 c Numbers will be placed at intervals of dx1, starting at firstx.
00101 c Offset is above or below the axis, depending on iax.
00102 c Amount of offset scales with htn.
00103 c
00104 c Determine placement above or below the axis...
00105 c
00106 htnsave = htn
00107 c
00108 x=firstx
00109 r=cinch(firstx,xl,dinchx)
00110 c
00111 c First determine the width of a "typical" number string...
00112 c
00113 if (ibare.eq.1.or.(ndec.ne.0.and.lpow.eq.0)) then
00114 if (ibare.eq.1) then
00115 c
00116 c Just use the nominal width of the number string.
00117 c
00118 wid=.85*htn*(nlab+.5)
00119 else
00120 call numsym(x1,ndec,string,nsym)
00121 call sim size(htn,string,nsym,wid,dum)
00122 call numsym(x2,ndec,string,nsym)
00123 call sim size(htn,string,nsym,wid2,dum)
00124 if (wid2.gt.wid) wid = wid2
00125 end if
00126 c
00127 else
00128 if (ndec.eq.0) then
00129 c
00130 c Nominal dimensions:
00131 c
00132 c wid = .85*2.5*htn
00133 c
00134 c Better:
00135 c
00136 call sim size(htn,'10^+n',5,wid,dum)
00137 c
00138 else
00139 call exp_string(x1,ndec,string,nsym,1)
00140 call sim size(htn,string,nsym,wid,dum)
00141 call exp_string(x2,ndec,string,nsym,1)
00142 call sim size(htn,string,nsym,wid2,dum)
00143 if (wid2.gt.wid) wid = wid2
00144 end if
00145 end if
00146 c
00147 c Reduce the scale if the estimated size is too great.
00148 c
00149 if (wid.gt.WTOL*dr) htn=htn*WTOL*dr/wid
00150 c
00151 c ...then determine the vertical offset...
00152 c
00153 if (ibare.eq.1.or.(ndec.ne.0.and.lpow.eq.0)) then
00154 if (iax.eq.1) then
00155 s=sax-1.5*htn
00156 else
00157 s=sax+.5*htn
00158 end if
00159 else
00160 if (iax.eq.1) then
00161 s=sax-1.75*htn
00162 else
00163 s=sax+.5*htn
00164 end if
00165 end if
00166 c
00167 c ...and update the data on the bottom of the number field.
00168 c
00169 if (iax.eq.1)then
00170 xnumbot=s
00171 if (ndec.ne.0) xnumbot=xnumbot-.5*htn
00172 end if
00173 c
00174 if (iwts(2).gt.0)then
00175 jwt=idevwt
00176 call weight(iwts(2))
00177 end if
00178 c
00179 c Plot the numbers.
00180 c
00181 call pushstr
00182 call strpos(.5,0.)
00183 c
00184 rleft=cinch(x1,xl,dinchx)
00185 rright=cinch(x2,xl,dinchx)
00186 if (rleft.gt.rright) then
00187 temp = rleft
00188 rleft = rright
00189 rright = temp
00190 end if
00191 c
00192 xscale = max(abs(x1),abs(x2))
00193 do i=1,nx
00194 if (lpow.eq.0.or.ibare.eq.1
00195 $ .or.(ndec.ne.0.and.abs(x)/xscale .lt. TOL)) then
00196 call fr numbr(r,s,htn,x,theta,ndec)
00197 else
00198 if (ndec.eq.0) then
00199 c
00200 c Logarithmic plot.
00201 c
00202 c First see if we need any intermediate labels.
00203 c Note that there will still be cases where no labels
00204 c appear (narrow ranges in logarithmic plots...).
00205 c
00206 if (nx.le.3.and.abs(dxl-1.).lt..01) then
00207 r3 = r-.5229*dr
00208 if (r3.ge.rleft) then
00209 call format_string(10.**(x-.5*dxl),-1,
00210 $ string,nsym,1)
00211 call simbol(r3,s,htn,string,theta,nsym)
00212 end if
00213 if (i.eq.nx) then
00214 r3 = r+.4771*dr
00215 if (r3.le.rright) then
00216 call format_string(10.**(x+.5*dxl),-1,
00217 $ string,nsym,1)
00218 call simbol(r3,s,htn,string,theta,nsym)
00219 end if
00220 end if
00221 end if
00222 c
00223 call format_string(10.**x,ndec,string,nsym,0)
00224 call simbol(r,s,htn,string,theta,nsym)
00225 c
00226 else
00227 c
00228 c Exponential format on a linear plot.
00229 c
00230 call exp_string(x,ndec,string,nsym,1)
00231 end if
00232 c
00233 call simbol(r,s,htn,string,theta,nsym)
00234 c
00235 end if
00236 r=r+dr
00237 x=x+dxl
00238 end do
00239 c
00240 call popstr
00241 c
00242 if (iwts(2).gt.0) call weight(jwt)
00243 c
00244 c DON'T restore the height here if we want changes to propogate
00245 c to the y-axis labels.
00246 c
00247 call getyfollowsx(iy)
00248 if (iy.eq.0) htn = htnsave
00249 c
00250 end
00251
00252
00253 subroutine setyfollowsx(iy)
00254 c
00255 c If ixy = 0, then the y number sizes will be INDEPENDENT of
00256 c changes made by frlnxdr. If ixy = 1, changes in the x-axis
00257 c number sizes will propogate to the y axis.
00258 c
00259 save
00260 common /yfollowsx/ixy
00261 data ixy/1/
00262 c
00263 ixy = iy
00264 if (ixy.ne.0) ixy = 1
00265 return
00266 c
00267 entry getyfollowsx(iy)
00268 iy = ixy
00269 end
00270
00271
00272 subroutine format_string(x,ndec,string,nsym,icoef)
00273 character*(*) string
00274 parameter (TOL = 0.1)
00275 c
00276 common /fr plain/ iplain
00277 c
00278 c Call exp_string, but check for special cases first.
00279 c
00280 isp = 1
00281 if (abs(x/.01-1.).lt.TOL) then
00282 string = '0.01'
00283 nsym = 4
00284 else if (abs(x/.03-1.).lt.TOL) then
00285 string = '0.03'
00286 nsym = 4
00287 else if (abs(x/.1-1.).lt.TOL) then
00288 string = '0.1'
00289 nsym = 3
00290 else if (abs(x/.3-1.).lt.TOL) then
00291 string = '0.3'
00292 nsym = 3
00293 else if (abs(x/1.-1.).lt.TOL) then
00294 string = '1'
00295 nsym = 1
00296 else if (abs(x/3.-1.).lt.TOL) then
00297 string = '3'
00298 nsym = 1
00299 else if (abs(x/10.-1.).lt.TOL) then
00300 string = '10'
00301 nsym = 2
00302 else if (abs(x/30.-1.).lt.TOL) then
00303 string = '30'
00304 nsym = 2
00305 else if (abs(x/100.-1.).lt.TOL) then
00306 string = '100'
00307 nsym = 3
00308 else if (abs(x/300-1.).lt.TOL) then
00309 string = '300'
00310 nsym = 3
00311 else
00312 isp = 0
00313 call exp_string(x,ndec,string,nsym,icoef)
00314 end if
00315 c
00316 if (isp.eq.1.and.iplain.eq.1)
00317 $ call convert_to_plain(string, nsym)
00318 c
00319 end
00320
00321
00322 subroutine exp_string(x,ndec,string,nsym,icoef)
00323 character*(*)string
00324 character*10 is
00325 c
00326 common /fr plain/ iplain
00327 c
00328 c Convert x into a "simbol" string in exponential format.
00329 c Skip the leading exponent if icoef = 0.
00330 c
00331 call compoz(x,f,n)
00332 c
00333 if (icoef.eq.0) then
00334 string(1:2) = '10'
00335 nsym = 2
00336 else
00337 c
00338 c We probably don't want exponential format if n = -1, 0, or 1.
00339 c
00340 if (abs(n).le.1) then
00341 c
00342 c May need to add or remove decimal digits to maintain
00343 c precision in this case.
00344 c
00345 call numsym(x,ndec-n,string,nsym)
00346 else
00347 call numsym(f,ndec,string,nsym)
00348 nt = 11
00349 string(nsym+1:nsym+nt) = '%@%@ %@@*10'
00350 nsym = nsym + nt
00351 end if
00352 end if
00353 c
00354 if (icoef.eq.0.or.abs(n).gt.1) then
00355 write(is,'(i10)')n
00356 do i=1,10
00357 if (is(i:i).gt.' ') then
00358 string(nsym+1:nsym+1) = '^'
00359 string(nsym+2:nsym+2) = is(i:i)
00360 nsym = nsym + 2
00361 end if
00362 end do
00363 end if
00364 c
00365 if (iplain.eq.1) call convert_to_plain(string, nsym)
00366 c
00367 c write(6,*)'x, str = ',x,' ',string(1:nsym)
00368 c
00369 end
00370
00371
00372 subroutine convert_to_plain(string, nsym)
00373 character*(*) string
00374 character*80 strtmp
00375 c
00376 c Make digits plain font.
00377 c
00378 ns = nsym
00379 strtmp = string
00380 nsym = 0
00381 do i=1,ns
00382 if (strtmp(i:i).lt.'0'.or.strtmp(i:i).gt.'9') then
00383 nsym = nsym + 1
00384 string(nsym:nsym) = strtmp(i:i)
00385 else
00386 nsym = nsym + 1
00387 string(nsym:nsym) = '@'
00388 nsym = nsym + 1
00389 string(nsym:nsym) = strtmp(i:i)
00390 end if
00391 end do
00392 c
00393 end
