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 lgydr(x,y1,y2,dexps,dexpm,dexpl,iax,ilab)
00021 save
00022 c
00023 c As for logxdr, but for the y-axis.
00024 c
00025 dimension tiks(8)
00026 common/scales/xl,xr,dinchx,ybot,ytop,dinchy,rlen,slen
00027 common/dev status/idevon,idevpen,idevwt
00028 common/fr tik level/jtik level
00029 common/fr hts/htl,htn/fr wts/iwts(4)/fr ticks/tikk(3),tikl
00030 common/fr setax/kax,lax
00031 c
00032 data ntik,tiks/8,.301003,.4771213,.60206,.69897,.7781513,
00033 * .845098,.90309,.9542425/
00034 c
00035 cinch(dumx,dor,dinch)=(dumx-dor)*dinch
00036 c
00037 if (lax.lt.0) return
00038 c
00039 nlab=3
00040 ndec=0
00041 lpow = 1
00042 call fr lnydr(x,y1,y2,dexps,dexpm,dexpl,
00043 $ iax,ilab,nlab,ndec,lpow)
00044 c
00045 if (abs(dexpm).ne.1.) return
00046 if (abs(dinchy).le..5) return
00047 if (jtik level.ne.1) return
00048 if (lax.eq.1.and.iax.eq.2) return
00049 if (lax.eq.2.and.iax.eq.1) return
00050 c
00051 c Add markers for integers.
00052 c
00053 dr=1.
00054 if (iax.eq.2) dr=-dr
00055 rax=cinch(x,xl,dinchx)
00056 rtik=rax+dr*tikl
00057 ya=y1
00058 yb=y2
00059 if (yb.le.ya) then
00060 ya=y2
00061 yb=y1
00062 end if
00063 c
00064 call fr lnfnc(ya,yb,1.,1,fexp,nexp)
00065 c
00066 fexp=fexp-1.
00067 nexp=nexp+1
00068 if (iwts(1).gt.0)then
00069 jwt=idevwt
00070 call weight(iwts(1))
00071 end if
00072 c
00073 c Add logarithmically spaced tick marks.
00074 c
00075 do i=1,nexp
00076 do j=1,ntik
00077 exp=fexp+tiks(j)
00078 if (exp.ge.ya) then
00079 if (exp.gt.yb) go to 100
00080 s=cinch(exp,ybot,dinchy)
00081 call plot(rax,s,3)
00082 rt = rtik
00083 c
00084 c Note test here is 4, not 3 because nexp was incremented above.
00085 c
00086 if (nexp.le.4.and.j.eq.2) rt = rax+dr*tikk(3)
00087 call plot(rt,s,2)
00088 end if
00089 end do
00090 fexp=fexp+1.
00091 end do
00092 c
00093 100 if (iwts(1).gt.0) call weight(jwt)
00094 c
00095 end
