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 subroutine contor1 (z,x,y,mm,nn,conv,userplot)
00022 save
00023 external userplot
00024 dimension z(mm,nn),x(mm),y(nn)
00025 c
00026 c this routine finds the beginnings of all contour lines at level conv.
00027 c first the edges are searched for lines intersecting the edge (open
00028 c lines) then the interior is searched for lines which do not intersect
00029 c the edge (closed lines). beginnings are checked against icont to prevent
00030 c re-tracing of lines.
00031 c
00032 c subroutine userplot converts from (x,y) coordinates to
00033 c the desired rectangular output grid. if the original grid
00034 c is already rectangular and correctly scaled (see mcinit),
00035 c just set userplot = plot in the call to contor.
00036 c
00037 common /cinfo/ ix,iy,idx,idy,is,iss,cv,inx(8),iny(8)
00038 common icont(65536)
00039 data inx(1),inx(2),inx(3),inx(4),inx(5),inx(6),inx(7),inx(8)/
00040 1 -1 , -1 , 0 , 1 , 1 , 1 , 0 , -1 /
00041 data iny(1),iny(2),iny(3),iny(4),iny(5),iny(6),iny(7),iny(8)/
00042 1 0 , 1 , 1 , 1 , 0 , -1 , -1 , -1 /
00043 c
00044 do 1 i=1,mm*nn+1
00045 1 icont(i)=0
00046 l = ll
00047 m = mm
00048 n = nn
00049 cv = conv
00050 iss = 0
00051 do 102 ip1=2,m
00052 i = ip1-1
00053 if (z(i,1).ge.cv .or. z(ip1,1).lt.cv) go to 101
00054 ix = ip1
00055 iy = 1
00056 idx = -1
00057 idy = 0
00058 is = 1
00059 call drline (z,x,y,m,n,userplot)
00060 101 if (z(ip1,n).ge.cv .or. z(i,n).lt.cv) go to 102
00061 ix = i
00062 iy = n
00063 idx = 1
00064 idy = 0
00065 is = 5
00066 call drline (z,x,y,m,n,userplot)
00067 102 continue
00068 do 104 jp1=2,n
00069 j = jp1-1
00070 if (z(m,j).ge.cv .or. z(m,jp1).lt.cv) go to 103
00071 ix = m
00072 iy = jp1
00073 idx = 0
00074 idy = -1
00075 is = 7
00076 call drline (z,x,y,m,n,userplot)
00077 103 if (z(1,jp1).ge.cv .or. z(1,j).lt.cv) go to 104
00078 ix = 1
00079 iy = j
00080 idx = 0
00081 idy = 1
00082 is = 3
00083 call drline (z,x,y,m,n,userplot)
00084 104 continue
00085 iss = 1
00086 do 108 jp1=3,n
00087 j = jp1-1
00088 do 107 ip1=2,m
00089 i = ip1-1
00090 if (z(i,j).ge.cv .or. z(ip1,j).lt.cv) go to 107
00091 if(icont(i+m*(j-1)).ne.0)go to 107
00092 icont(i+m*(j-1))=1
00093 ix = ip1
00094 iy = j
00095 idx = -1
00096 idy = 0
00097 is = 1
00098 c
00099 c note: start contour only if
00100 c
00101 c z(ix-1,iy) .lt. cv .le. z(ix,iy)
00102 c
00103 c all closed contours must have this ordering somewhere
00104 c in the grid.
00105 c
00106 call drline (z,x,y,m,n,userplot)
00107 107 continue
00108 108 continue
00109 end
