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
00021
00022 subroutine drline (z,xx,yy,mm,nn,userplot)
00023 save
00024 external userplot
00025 dimension z(mm,nn),xx(mm),yy(nn)
00026 c
00027 c this routine traces a contour line when given the beginning by contor1.
00028 c
00029 common /cinfo/ ix,iy,idx,idy,is,iss,cv,inx(8),iny(8)
00030 common icont(65536)
00031 c
00032 c(p1,p2) = (p1-cv)/(p1-p2)
00033 c
00034 m = mm
00035 n = nn
00036 c
00037 c store initial info for termination criterion.
00038 c
00039 ix0 = ix
00040 iy0 = iy
00041 is0 = is
00042 c
00043 c go to first point.
00044 c
00045 if (idx.ne.0) then
00046 y = yy(iy)
00047 isub = ix+idx
00048 x = c(z(ix,iy),z(isub,iy))*(xx(isub)-xx(ix))+xx(ix)
00049 else
00050 x = xx(ix)
00051 isub = iy+idy
00052 y = c(z(ix,iy),z(ix,isub))*(yy(iy+idy)-yy(iy))+yy(iy)
00053 end if
00054 call userplot (x,y,3)
00055 c
00056 c look for next crossing.
00057 c
00058 106 is = is+1
00059 if (is .gt. 8) is = is-8
00060 idx = inx(is)
00061 idy = iny(is)
00062 ix2 = ix+idx
00063 iy2 = iy+idy
00064 if (iss .ne. 0) go to 107
00065 if (ix2.gt.m.or.iy2.gt.n.or.ix2.lt.1.or.iy2.lt.1) go to 120
00066 107 if (cv.gt.z(ix2,iy2)) go to 109
00067 108 is = is+4
00068 ix = ix2
00069 iy = iy2
00070 go to 106
00071 109 if (is/2*2 .eq. is) go to 106
00072 c
00073 c draw next contour segment.
00074 c
00075 if (idx.ne.0) then
00076 y = yy(iy)
00077 isub = ix+idx
00078 x = c(z(ix,iy),z(isub,iy))*(xx(isub)-xx(ix))+xx(ix)
00079 else
00080 x = xx(ix)
00081 isub = iy+idy
00082 y = c(z(ix,iy),z(ix,isub))*(yy(isub)-yy(iy))+yy(iy)
00083 end if
00084 call userplot (x,y,2)
00085 if (is .eq. 1) icont(ix-1+m*(iy-1))=1
00086 c
00087 c mark presence of contour in this cell.
00088 c
00089 if (iss .eq. 0) go to 106
00090 if (ix.ne.ix0 .or. iy.ne.iy0 .or. is.ne.is0) go to 106
00091 c
00092 c end of line
00093 c
00094 120 return
00095 end
