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 c
00020 c
00021 c--- subroutine shade
00022 c
00023 c--- creates complete cross-hatch density map
00024 c note: negative cross hatches are circles
00025 c
00026 c--- created 11.aug.80
00027 c
00028 subroutine shade (a,m,n,sc,xmin,xmax,ymin,ymax,msiz,nsiz)
00029 save
00030 c--- a real array of data
00031 c m,n subset of a to be plotted
00032 c sc scale parameter:
00033 c sc < 0 then k = -sc*ln(a)
00034 c sc = 0 then k = sc*a
00035 c xmin,xmax,ymin,ymax delineates plotting area
00036 c msiz,nsiz dimensions of a
00037 c
00038 real*4 a(msiz,nsiz)
00039 da=0.3490658504
00040 dx=(xmax-xmin)/m
00041 dy=(ymax-ymin)/n
00042 if (sc) 10,30,20
00043 10 scx=abs(sc)
00044 y=ymin-dy/2.
00045 yp=ymin
00046 ym=ymin-dy
00047 do 19 j=1,n
00048 y=y+dy
00049 yp=yp+dy
00050 ym=ym+dy
00051 x=xmin-dx/2.
00052 xp=xmin
00053 xm=xmin-dx
00054 do 19 i=1,m
00055 x=x+dx
00056 xp=xp+dx
00057 xm=xm+dx
00058 k=nint(scx*alog(a(i,j)))
00059 if (k) 15,19,11
00060 11 ddx=dx/(k+1.)
00061 ddy=dy/(k+1.)
00062 do 14 kk=1,k
00063 xx=xm+kk*ddx
00064 yy=ym+kk*ddy
00065 call plot(xm,yy,3)
00066 call plot(xp,yy,2)
00067 call plot(xx,ym,3)
00068 call plot(xx,yp,2)
00069 14 continue
00070 go to 19
00071 15 ddx=.5*dx/(-k+1.)
00072 ddy=.5*dy/(-k+1.)
00073 do 17 kk=1,-k
00074 call plot(x,y+kk*ddy,3)
00075 do 17 kkk=1,18
00076 xx=x+kk*ddx*sin(kkk*da)
00077 yy=y+kk*ddy*cos(kkk*da)
00078 call plot(xx,yy,2)
00079 17 continue
00080 19 continue
00081 go to 30
00082 20 y=ymin-dy/2.
00083 yp=ymin
00084 ym=ymin-dy
00085 do 29 j=1,n
00086 y=y+dy
00087 yp=yp+dy
00088 ym=ym+dy
00089 x=xmin-dx/2.
00090 xp=xmin
00091 xm=xmin-dx
00092 do 29 i=1,m
00093 x=x+dx
00094 xp=xp+dx
00095 xm=xm+dx
00096 k=nint(sc*a(i,j))
00097 if (k) 25,29,21
00098 21 ddx=dx/(k+1.)
00099 ddy=dy/(k+1.)
00100 do 24 kk=1,k
00101 xx=xm+kk*ddx
00102 yy=ym+kk*ddy
00103 call plot(xm,yy,3)
00104 call plot(xp,yy,2)
00105 call plot(xx,ym,3)
00106 call plot(xx,yp,2)
00107 24 continue
00108 go to 29
00109 25 ddx=.5*dx/(-k+1.)
00110 ddy=.5*dy/(-k+1.)
00111 do 27 kk=1,-k
00112 call plot(x,y+kk*ddy,3)
00113 do 27 kkk=1,18
00114 xx=x+kk*ddx*sin(kkk*da)
00115 yy=y+kk*ddy*cos(kkk*da)
00116 call plot(xx,yy,2)
00117 27 continue
00118 29 continue
00119 30 return
00120 end
