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
00020 subroutine fr lnydr(x,y1,y2,dys,dym,dyl,
00021 $ iax,ilab,nlab,ndec,lpow)
00022 save
00023 c
00024 c As for frlnxdr, but for the y-axis
00025 c
00026 c Draw y-axis, tick marks and numbers for linear case (ndec nonzero),
00027 c and major tick marks and numbers for the logarithmic case (ndec = 0).
00028 c
00029 c iax = 1 for bottom axis, 2 for top.
00030 c ilab = 0 for no labels, 1 for labels
00031 c nlab = estimated number of spaces for labels
00032 c
00033 c ndec = -1 ==> integer format
00034 c ndec = 0 ==> log axes, want to plot 10^n
00035 c ndec > 0: number of places to right of decimal point
00036 c lpow = 0 ==> F format, E format (lpow = exponent) otherwise
00037 c
00038 c No numbers are drawn for nonzero lmode, regardless of ilab.
00039 c N.B. Variable "ilab" is redundant, now.
00040 c
00041 character*80 device
00042 common/plot device/device,aspect,idev
00043 common/scales/xl,xr,dinchx,ybot,ytop,dinchy,rlen,slen
00044 common/dev status/idevon,idevpen,idevwt
00045 common/fr hts/htl,htn/fr wts/iwts(4)/fr rotn/irot
00046 common/fr ticks/tiks(3),tikl/fr int/iframe
00047 common/fr conf/scent,rnuml,rnumr,snumt,snumb,dsnums,jrot,stopnum
00048 common/fr tik level/jtik level
00049 common/fr bare/ibare
00050 common/fontc1/dum2(5),rrmax,rrmin,ssmax,ssmin
00051 common/fr setax/kax,lax
00052 c
00053 dimension dy(3)
00054 character*80 string
00055 c
00056 common/fr lby/lmode
00057 data mode/1/
00058 c
00059 cinch(xa,xs,di) = (xa-xs)*di
00060 c
00061 if (lax.lt.0) return
00062 c
00063 c Draw axes.
00064 c ---------
00065 c
00066 dy(1) = dys
00067 dy(2) = dym
00068 dy(3) = dyl
00069 rax = cinch(x,xl,dinchx)
00070 s1 = cinch(y1,ybot,dinchy)
00071 s2 = cinch(y2,ybot,dinchy)
00072 if (iwts(1).gt.0) then
00073 jwt = idevwt
00074 call weight(iwts(1))
00075 end if
00076 call plot(rax,s1,3)
00077 call plot(rax,s2,2)
00078 c
00079 if (lax.eq.1.and.iax.eq.2) return
00080 if (lax.eq.2.and.iax.eq.1) return
00081 c
00082 c Draw tick marks.
00083 c ---------------
00084 c
00085 dr = 1.
00086 if (iax.eq.2) dr = -1.
00087 do j = jtik level,3
00088 if (dy(j).ne.0.) then
00089 rtik = rax+dr*tiks(j)
00090 call fr lnfnc(y1,y2,dy(j),mode,firsty,ny)
00091 ds = dy(j)*dinchy
00092 s = cinch(firsty,ybot,dinchy)
00093 do i = 1,ny
00094 call plot(rax,s,3)
00095 call plot(rtik,s,2)
00096 s = s+ds
00097 end do
00098 end if
00099 end do
00100 if (iwts(1).gt.0) call weight(jwt)
00101 jrot = irot
00102 c
00103 if (lmode.ne.0) return
00104 if (lax.eq.0.and.iax.eq.2) return
00105 if (lax.eq.3.and.iax.eq.1) return
00106 c
00107 c Add numeric labels.
00108 c ------------------
00109 c
00110 yscale = max(abs(y1),abs(y2))
00111 c
00112 c Labels are horizontal (left to right) if jrot = 0, horizontal otherwise.
00113 c
00114 dsnums = ds
00115 c
00116 c Get the actual length of the numbers for use below.
00117 c
00118 c Definitions: the maximum width of the numeric labels is xlnum
00119 c the maximum height of the numeric labels is dsnum
00120 c
00121 if (ibare.eq.1) then
00122 c
00123 c A device-specific number-drawing routine will be used, so
00124 c pretty output is not expected. Just estimate the space
00125 c requirements.
00126 c
00127 if (ndec.ne.0) then
00128 nnum = 0
00129 if (firsty.lt.0.) nnum = 1
00130 if (ndec.gt.0) nnum = nnum+ndec
00131 mm = 0
00132 do k = 1,ny
00133 y = firsty+(k-1.)*dyl
00134 if (abs(y).lt.1.) then
00135 nn = 1
00136 else
00137 nn = log10(abs(y))+1
00138 end if
00139 if (nn.gt.mm) mm = nn
00140 end do
00141 nnum = nnum+mm
00142 xlnum = htn*(nnum+.5)
00143 else
00144 xlnum = 2.*htn
00145 mm = 0
00146 do k = 1,ny
00147 y = firsty+(k-1.)*dyl
00148 nn = 0
00149 if (y.lt.0.) nn = 1
00150 if (abs(y).ge.1.) nn = nn+1+log10(abs(y))
00151 mm = max(mm,nn)
00152 end do
00153 xlnum = xlnum+.5333*mm*htn
00154 end if
00155 else
00156 c
00157 c Simbol will be used, so we can determine the sizes exactly.
00158 c
00159 xlnum = 0.
00160 do k=1,ny
00161 y = firsty + (k-1.)*dyl
00162 call make_number_string(y,ndec,lpow,string,nsym,yscale)
00163 call sim size(htn,string,nsym,dx,dum)
00164 xlnum = max(xlnum, dx)
00165 end do
00166 if (idev.eq.7.or.idev.eq.8) xlnum = 1.1*xlnum
00167 c
00168 c Modify xlnum in case of extra labels in the logarithmic case:
00169 c
00170 if (ndec.eq.0.and.nx.le.3) xlnum = 2.*xlnum
00171 end if
00172 c
00173 c Nominal symbol height:
00174 c
00175 dsnum = 1.5*htn
00176 if (jrot.ne.0) dsnum = 1.3*xlnum
00177 c
00178 c Check that the number size is OK.
00179 c
00180 100 if (dsnum.gt.ds) then
00181 c
00182 c Label is too tall.
00183 c
00184 fac = ds/dsnum
00185 if (jrot.ne.0.and.fac.lt..4) then
00186 jrot = 0
00187 dsnum = 1.5*htn
00188 go to 100
00189 end if
00190 htn = htn*fac
00191 xlnum = xlnum*fac
00192 dsnum = ds
00193 end if
00194 c
00195 if (iax.eq.1) then
00196 call getlhe(space)
00197 space = -space - htl
00198 else
00199 call getrhe(space)
00200 space = space - x - htl
00201 end if
00202 c
00203 if (space.gt.0.and.jrot.eq.0.and.xlnum.gt..9*space) then
00204 c
00205 c Too wide...
00206 c
00207 htn = htn*.9*space/xlnum
00208 xlnum = .9*space
00209 end if
00210 c
00211 c See if the first label should be moved up.
00212 c -----------------------------------------
00213 c
00214 c (There is a lot of repeated code here--there is probably a much
00215 c better way of writing this.)
00216 c
00217 y = firsty
00218 s1 = cinch(firsty,ybot,dinchy)
00219 half = .5*htn
00220 strlen = xlnum
00221 strlen2 = .5*strlen
00222 c
00223 call pushstr
00224 if (jrot.eq.0) then
00225 if (iax.eq.1) then
00226 call strpos(1.,.5)
00227 else
00228 call strpos(0.,.5)
00229 end if
00230 else
00231 if (iax.eq.1) then
00232 call strpos(.5,0.)
00233 else
00234 call strpos(.5,1.)
00235 end if
00236 end if
00237 c
00238 if (jrot.eq.0) then
00239 th = 0.
00240 if (iax.eq.1) then
00241 r = rax-half
00242 else
00243 r = rax+half
00244 end if
00245 else
00246 th = 90.
00247 if (iax.eq.1) then
00248 r = rax-htn
00249 else
00250 r = rax+htn
00251 end if
00252 end if
00253 s = s1
00254 c
00255 smin = half ! Only offset the first y-axis
00256 if (th.eq.90.) smin = strlen2 ! label if it really would
00257 if (s1.lt.smin) s = s+smin ! extend below the x-axis.
00258 c
00259 c Reference point for first number is (r, s).
00260 c
00261 if (iwts(2).gt.0) then
00262 jwt = idevwt
00263 call weight(iwts(2))
00264 end if
00265 c
00266 if (iax.eq.2) th = -th
00267 c
00268 c Draw the number and initialize bookkeeping.
00269 c
00270 if (ibare.eq.1) then
00271 if (ndec.eq.0) then
00272 call lognum(r,s,htn,y,th,-1)
00273 rnummin = r
00274 else
00275 call fr numbr(r,s,htn,y,th,ndec)
00276 rnummin = rrmin
00277 end if
00278 else
00279 call make_number_string(y,ndec,lpow,string,nsym,yscale)
00280 call simbol(r,s,htn,string,th,nsym)
00281 end if
00282 c
00283 rnummax = rnummin + xlnum
00284 c
00285 snumb = 0.
00286 snumt = slen
00287 rnuml = 0.
00288 rnumr = 0.
00289 inumset = 0
00290 c
00291 if (jrot.eq.0) then
00292 sref = s - half
00293 else
00294 sref = s - strlen2
00295 end if
00296 c
00297 c sref is the level of the bottom of the current numerical label.
00298 c
00299 dstrue = ds
00300 if (ndec.eq.0.and.ny.le.3.and.abs(dyl-1.).lt..01) then
00301 c
00302 c In this case, we must take into account the fact that
00303 c intermediate numbers are being inserted, and that the bottom
00304 c label could be above the centerline...
00305 c
00306 dstrue = .5*ds
00307 isign = 1
00308 if (sref.gt.scent) isign = -1
00309 end if
00310 c
00311 if ( (sref-scent) * (sref+isign*dstrue-scent) .le. 0. ) then
00312 c
00313 c This number and the next straddle the centerline.
00314 c The vertical whitespace for the label lies between snumb
00315 c and snumt. The y-label will be centered there.
00316 c
00317 inumset = 1
00318 c
00319 snumt = sref+dstrue
00320 c
00321 if (jrot.ne.0) then
00322 rnuml = r-htn
00323 rnumr = r
00324 snumb = s+strlen2
00325 else
00326 rnuml = r-strlen
00327 rnumr = r
00328 if (ndec.eq.0) then
00329 snumb = sref+1.2*htn
00330 else
00331 snumb = sref+htn
00332 end if
00333 end if
00334 end if
00335 c
00336 c Draw the remaining numbers.
00337 c --------------------------
00338 c
00339 c Undo any offset:
00340 c
00341 if (s1.lt.smin) s = s-smin
00342 c
00343 do i = 2,ny
00344 s = s+ds
00345 y = y+dyl
00346 c
00347 if (ibare.eq.1) then
00348 if (ndec.eq.0) then
00349 call lognum(r,s,htn,y,th,-1)
00350 rnummin = min(rnummin,r)
00351 rnummax = max(rnummax,r+strlen)
00352 else
00353 call fr numbr(r,s,htn,y,th,ndec)
00354 rnummin = min(rnummin,rrmin)
00355 rnummax = max(rnummax,rrmax)
00356 end if
00357 else
00358 call make_number_string(y,ndec,lpow,string,nsym,yscale)
00359 call simbol(r,s,htn,string,th,nsym)
00360 c
00361 c Still have to deal with intermediates...
00362 c
00363 if (ndec.eq.0.and.ny.le.3.and.abs(dyl-1.).lt..01) then
00364 s3 = s-.5229*ds
00365 if (s3.ge.s1) then
00366 call format_string(10.**(y-.5*dyl),-1,
00367 $ string,nsym,1)
00368 call simbol(r,s3,htn,string,th,nsym)
00369 end if
00370 c
00371 if (i.eq.2) then
00372 s3 = s-1.5229*ds
00373 if (s3.ge.s1) then
00374 call format_string(10.**(y-1.5*dyl),-1,
00375 $ string,nsym,1)
00376 call simbol(r,s3,htn,string,th,nsym)
00377 end if
00378 end if
00379 c
00380 if (i.eq.ny) then
00381 s3 = s+.4771*ds
00382 if (s3.le.s2) then
00383 call format_string(10.**(y+.5*dyl),-1,
00384 $ string,nsym,1)
00385 call simbol(r,s3,htn,string,th,nsym)
00386 end if
00387 end if
00388 end if
00389 c
00390 rnummin = min(rnummin,rrmin)
00391 rnummax = max(rnummax,rrmax)
00392 end if
00393 c
00394 c Bookeeping (same as before):
00395 c
00396 if (inumset.eq.0) then
00397 if (jrot.eq.0) then
00398 sref = s - half
00399 else
00400 sref = s - strlen2
00401 end if
00402 c
00403 if (sref.le.scent.and.sref+dstrue.gt.scent) then
00404 inumset = 1
00405 c
00406 snumt = sref+dstrue
00407 c
00408 if (jrot.ne.0) then
00409 rnuml = r-htn
00410 rnumr = r
00411 snumb = s+strlen2
00412 else
00413 rnuml = r-strlen
00414 rnumr = r
00415 snumb = sref+htn
00416 c
00417 c Old version:
00418 c
00419 c if (ndec.eq.0) then
00420 c snumb = sref+1.2*htn
00421 c else
00422 c snumb = sref+htn
00423 c end if
00424 c
00425 end if
00426 end if
00427 end if
00428 end do
00429 c
00430 c Restore settings.
00431 c
00432 if (iwts(2).gt.0) call weight(jwt)
00433 iframe = 1
00434 call popstr
00435 c
00436 rnuml = rnummin
00437 rnumr = max(rnummax,rnuml+htn*jrot+strlen*(1-jrot))
00438 c
00439 snumb = max(0.,snumb)
00440 snumt = min(slen,snumt)
00441 stopnum = s
00442 c
00443 c Force the label to be above the centerline.
00444 c
00445 if (.5*(snumb+snumt).lt.scent) then
00446 snumb = snumb + dstrue
00447 snumt = snumt + dstrue
00448 end if
00449 c
00450 end
00451
00452
00453 subroutine make_number_string(y,ndec,lpow,string,nsym,yscale)
00454 character*(*) string
00455 common /fr plain/ iplain
00456 c
00457 parameter (TOL = 1.e-6)
00458 c
00459 if (lpow.eq.0.or.(ndec.ne.0.and.abs(y)/yscale.lt.TOL)) then
00460 call numsym(y,ndec,string,nsym)
00461 if (iplain.eq.1) call convert_to_plain(string, nsym)
00462 else
00463 if (ndec.eq.0) then
00464 call format_string(10.**y,ndec,string,nsym,0)
00465 else
00466 call exp_string(y,ndec,string,nsym,1)
00467 end if
00468 end if
00469 c
00470 end
